diff --git a/.github/CODEOWNERS b/.github/CODEOWNERS index b63244ca64c2..b954b5420f51 100644 --- a/.github/CODEOWNERS +++ b/.github/CODEOWNERS @@ -7,15 +7,21 @@ /CONTRIBUTING.md @rocq-prover/contributing-process-maintainers +.mailmap @rocq-prover/contributing-process-maintainers + +CREDITS @rocq-prover/contributing-process-maintainers +LICENSE @rocq-prover/contributing-process-maintainers + +########## Fallback for /dev/ ########### + +/dev/ @rocq-prover/dev-tools-maintainers + ########## Build system ########## /Makefile @rocq-prover/build-maintainers -/dev/tools/make_git_revision.sh @rocq-prover/build-maintainers /configure @rocq-prover/build-maintainers -/tools/configure/* @rocq-prover/build-maintainers - -/tools/coqdep/ @rocq-prover/build-maintainers +/config/ @rocq-prover/build-maintainers /boot/ @rocq-prover/build-maintainers @@ -49,6 +55,8 @@ /doc/ @rocq-prover/doc-maintainers /dev/doc/ @rocq-prover/doc-maintainers +*.mld @rocq-prover/doc-maintainers + /doc/changelog/*/*.rst /dev/doc/changes.md # Trick to avoid getting review requests @@ -108,9 +116,11 @@ /kernel/vconv.* @rocq-prover/vm-native-maintainers /kernel/genOpcodeFiles.* @rocq-prover/vm-native-maintainers -/kernel/sorts.* @rocq-prover/universes-maintainers -/kernel/uGraph.* @rocq-prover/universes-maintainers -/kernel/univ.* @rocq-prover/universes-maintainers +/kernel/sorts.* @rocq-prover/universes-maintainers +/kernel/uGraph.* @rocq-prover/universes-maintainers +/kernel/univ.* @rocq-prover/universes-maintainers +/kernel/pConstraints.* @rocq-prover/universes-maintainers +/kernel/qGraph.* @rocq-prover/universes-maintainers ########## Library ########## @@ -124,49 +134,50 @@ ########## Standard library and plugins ########## -/theories/Corelib/ @rocq-prover/stdlib-maintainers +/theories/Corelib/ @rocq-prover/stdlib-maintainers -/theories/Corelib/Classes/ @rocq-prover/typeclasses-maintainers +/theories/Corelib/Classes/ @rocq-prover/typeclasses-maintainers -/theories/Corelib/Compat/ @rocq-prover/compat-maintainers +/theories/Corelib/Compat/ @rocq-prover/compat-maintainers -/plugins/btauto/ @rocq-prover/btauto-maintainers +/plugins/btauto/ @rocq-prover/btauto-maintainers -/plugins/cc/ @rocq-prover/cc-maintainers +/plugins/cc/ @rocq-prover/cc-maintainers -/plugins/derive/ @rocq-prover/derive-maintainers -/theories/Corelib/derive/ @rocq-prover/derive-maintainers +/plugins/derive/ @rocq-prover/derive-maintainers +/theories/Corelib/derive/ @rocq-prover/derive-maintainers -/plugins/extraction/ @rocq-prover/extraction-maintainers -/theories/Corelib/extraction/ @rocq-prover/extraction-maintainers +/plugins/extraction/ @rocq-prover/extraction-maintainers +/theories/Corelib/extraction/ @rocq-prover/extraction-maintainers -/plugins/firstorder/ @rocq-prover/firstorder-maintainers +/plugins/firstorder/ @rocq-prover/firstorder-maintainers -/plugins/funind/ @rocq-prover/funind-maintainers +/plugins/funind/ @rocq-prover/funind-maintainers -/plugins/ltac/ @rocq-prover/ltac-maintainers +/plugins/ltac/ @rocq-prover/ltac-maintainers -/plugins/micromega/ @rocq-prover/micromega-maintainers +/plugins/micromega/ @rocq-prover/micromega-maintainers -/plugins/nsatz/ @rocq-prover/nsatz-maintainers +/plugins/nsatz/ @rocq-prover/nsatz-maintainers -/plugins/ring/ @rocq-prover/ring-maintainers +/plugins/ring/ @rocq-prover/ring-maintainers -/plugins/ssrmatching/ @rocq-prover/ssreflect-maintainers -/theories/Corelib/ssrmatching/ @rocq-prover/ssreflect-maintainers +/plugins/ssrmatching/ @rocq-prover/ssreflect-maintainers +/theories/Corelib/ssrmatching/ @rocq-prover/ssreflect-maintainers -/plugins/ssr/ @rocq-prover/ssreflect-maintainers -/theories/Corelib/ssr/ @rocq-prover/ssreflect-maintainers +/plugins/ssr/ @rocq-prover/ssreflect-maintainers +/plugins/ssrrewrite/ @rocq-prover/ssreflect-maintainers +/theories/Corelib/ssr/ @rocq-prover/ssreflect-maintainers -/test-suite/ssr/ @rocq-prover/ssreflect-maintainers +/test-suite/ssr/ @rocq-prover/ssreflect-maintainers -/plugins/syntax/ @rocq-prover/parsing-maintainers +/plugins/syntax/ @rocq-prover/parsing-maintainers -/plugins/rtauto/ @rocq-prover/rtauto-maintainers +/plugins/rtauto/ @rocq-prover/rtauto-maintainers -/plugins/ltac2/ @rocq-prover/ltac2-maintainers -/theories/Ltac2 @rocq-prover/ltac2-maintainers +/plugins/ltac2/ @rocq-prover/ltac2-maintainers +/theories/Ltac2 @rocq-prover/ltac2-maintainers ########## Pretyper ########## @@ -198,29 +209,35 @@ ########## Number ########## -/interp/numTok.* @rocq-prover/number-maintainers -/kernel/float64* @rocq-prover/number-maintainers -/kernel/uint63* @rocq-prover/number-maintainers -/plugins/syntax/g_number_string.mlg @rocq-prover/number-maintainers +/interp/numTok.* @rocq-prover/number-maintainers +/kernel/float64* @rocq-prover/number-maintainers +/kernel/uint63* @rocq-prover/number-maintainers +/plugins/syntax/g_number_string.mlg @rocq-prover/number-maintainers /plugins/syntax/int63_syntax_plugin.mllib @rocq-prover/number-maintainers -/plugins/syntax/number.ml @rocq-prover/number-maintainers +/plugins/syntax/number.ml @rocq-prover/number-maintainers /plugins/syntax/number_string_notation_plugin.mllib @rocq-prover/number-maintainers -/test-suite/output/*Number* @rocq-prover/number-maintainers -/test-suite/primitive/float/ @rocq-prover/number-maintainers -/test-suite/primitive/sint63/ @rocq-prover/number-maintainers -/test-suite/primitive/uint63/ @rocq-prover/number-maintainers -/theories/Corelib/Init/Decimal.v @rocq-prover/number-maintainers -/theories/Corelib/Init/Hexadecimal.v @rocq-prover/number-maintainers -/theories/Corelib/Init/Nat.v @rocq-prover/number-maintainers -/theories/Corelib/Init/Number.v @rocq-prover/number-maintainers -/theories/Corelib/Numbers/ @rocq-prover/number-maintainers -/theories/Corelib/Floats/ @rocq-prover/number-maintainers +/test-suite/output/*Number* @rocq-prover/number-maintainers +/test-suite/primitive/float/ @rocq-prover/number-maintainers +/test-suite/primitive/sint63/ @rocq-prover/number-maintainers +/test-suite/primitive/uint63/ @rocq-prover/number-maintainers +/theories/Corelib/Init/Decimal.v @rocq-prover/number-maintainers +/theories/Corelib/Init/Hexadecimal.v @rocq-prover/number-maintainers +/theories/Corelib/Init/Nat.v @rocq-prover/number-maintainers +/theories/Corelib/Init/Number.v @rocq-prover/number-maintainers +/theories/Corelib/Numbers/ @rocq-prover/number-maintainers +/theories/Corelib/Floats/ @rocq-prover/number-maintainers ########## Tools ########## +/tools/ @rocq-prover/dev-tools-maintainers + +/tools/configure/* @rocq-prover/build-maintainers +/tools/coqdep/ @rocq-prover/build-maintainers + /tools/coqdoc/ @rocq-prover/coqdoc-maintainers /test-suite/coqdoc/ @rocq-prover/coqdoc-maintainers /tools/coqwc* @rocq-prover/coqdoc-maintainers +/tools/rocqwc* @rocq-prover/coqdoc-maintainers /test-suite/coqwc/ @rocq-prover/coqdoc-maintainers /tools/coq_makefile* @rocq-prover/coq-makefile-maintainers @@ -230,14 +247,16 @@ /tools/TimeFileMaker.py @rocq-prover/coq-makefile-maintainers /tools/make-*-tim*.py @rocq-prover/coq-makefile-maintainers -/tools/coq_tex* @silene +/tools/coq_tex* @silene +/tools/rocqtex* @silene # Secondary maintainer @gares ########## Toplevel ########## -/toplevel/ @rocq-prover/toplevel-maintainers -/topbin/ @rocq-prover/toplevel-maintainers -/sysinit/ @rocq-prover/toplevel-maintainers +/toplevel/ @rocq-prover/toplevel-maintainers +/topbin/ @rocq-prover/toplevel-maintainers +/sysinit/ @rocq-prover/toplevel-maintainers +/dev/ml_toplevel/ @rocq-prover/toplevel-maintainers ########## Vernacular ########## @@ -258,10 +277,17 @@ ########## Developer tools ########## -/dev/tools/ @rocq-prover/dev-tools-maintainers +/dev/tools/ @rocq-prover/dev-tools-maintainers + +/dev/tools/make_git_revision.sh @rocq-prover/build-maintainers + +.gitattributes @rocq-prover/dev-tools-maintainers +.gitignore @rocq-prover/dev-tools-maintainers +.ocp-indent @rocq-prover/dev-tools-maintainers ########## Dune ########## -/.ocamlinit @rocq-prover/build-maintainers -*dune* @rocq-prover/build-maintainers -*.opam @rocq-prover/build-maintainers @erikmd +/.ocamlinit @rocq-prover/build-maintainers +*dune* @rocq-prover/build-maintainers +*.opam @rocq-prover/build-maintainers @Justme0606 +*.opam.template @rocq-prover/build-maintainers @Justme0606 diff --git a/.gitignore b/.gitignore index bef014111c2a..39c39c189743 100644 --- a/.gitignore +++ b/.gitignore @@ -104,6 +104,9 @@ result # documentation +doc/unreleased.rst +doc/refman-html +doc/refman-pdf doc/common/version.tex doc/faq/html/ doc/faq/axioms.eps diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 4a5f4e5c820f..bd5fc9890774 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -41,7 +41,7 @@ variables: # echo $(md5sum dev/ci/docker/old_ubuntu_lts/Dockerfile | head -c 10) # echo $(md5sum dev/ci/docker/edge_ubuntu/Dockerfile | head -c 10) BASE_CACHEKEY: "old_ubuntu_lts-V2025-11-14-69405188ee" - EDGE_CACHEKEY: "edge_ubuntu-V2025-12-02-e6edb0cc32" + EDGE_CACHEKEY: "edge_ubuntu-V2026-05-22-20228d7d42" BASE_IMAGE: "$CI_REGISTRY_IMAGE:$BASE_CACHEKEY" EDGE_IMAGE: "$CI_REGISTRY_IMAGE:$EDGE_CACHEKEY" @@ -449,7 +449,7 @@ doc:refman: artifacts: paths: - _build/log - - _build/default/doc/refman-html + - doc/refman-html doc:refman-pdf: extends: .doc-template @@ -458,7 +458,7 @@ doc:refman-pdf: artifacts: paths: - _build/log - - _build/default/doc/refman-pdf + - doc/refman-pdf doc:init: extends: .doc-template @@ -488,16 +488,17 @@ doc:refman:deploy: - rm -rf _deploy/$CI_COMMIT_REF_NAME/api - rm -rf _deploy/$CI_COMMIT_REF_NAME/refman - rm -rf _deploy/$CI_COMMIT_REF_NAME/corelib - - rm -rf _deploy/$CI_COMMIT_REF_NAME/refman-stdlib - - rm -rf _deploy/$CI_COMMIT_REF_NAME/stdlib + - if [ $CI_COMMIT_REF_NAME = "master" ] ; then rm -rf _deploy/$CI_COMMIT_REF_NAME/refman-stdlib ; fi + - if [ $CI_COMMIT_REF_NAME = "master" ] ; then rm -rf _deploy/$CI_COMMIT_REF_NAME/stdlib ; fi - mkdir -p _deploy/$CI_COMMIT_REF_NAME - cp -rv _build/default/_doc/_html _deploy/$CI_COMMIT_REF_NAME/api - - cp -rv _build/default/doc/refman-html _deploy/$CI_COMMIT_REF_NAME/refman + - cp -rv _build_ci/refman/refman-html _deploy/$CI_COMMIT_REF_NAME/refman - cp -rv _build/default/doc/corelib/html _deploy/$CI_COMMIT_REF_NAME/corelib - - cp -rv saved_build_ci/stdlib/_build/default/doc/refman-html _deploy/$CI_COMMIT_REF_NAME/refman-stdlib - - cp -rv saved_build_ci/stdlib/_build/default/doc/stdlib/html _deploy/$CI_COMMIT_REF_NAME/stdlib + - if [ $CI_COMMIT_REF_NAME = "master" ] ; then cp -rv saved_build_ci/stdlib/_build/default/doc/refman-html _deploy/$CI_COMMIT_REF_NAME/refman-stdlib ; fi + - if [ $CI_COMMIT_REF_NAME = "master" ] ; then cp -rv saved_build_ci/stdlib/_build/default/doc/stdlib/html _deploy/$CI_COMMIT_REF_NAME/stdlib ; fi - cd _deploy/$CI_COMMIT_REF_NAME/ - - git add api refman corelib refman-stdlib stdlib + - git add api refman corelib + - if [ $CI_COMMIT_REF_NAME = "master" ] ; then git add refman-stdlib stdlib ; fi - git commit -m "Documentation of branch “$CI_COMMIT_REF_NAME” at $CI_COMMIT_SHORT_SHA" - git push # TODO: rebase and retry on failure @@ -716,6 +717,7 @@ library:ci-coquelicot: - build:edge+flambda - library:ci-stdlib+flambda - plugin:ci-elpi_hb + - plugin:ci-micromega - library:ci-mathcomp stage: build-3+ @@ -751,6 +753,7 @@ library:ci-fcsl_pcm: - build:edge+flambda - library:ci-stdlib+flambda - plugin:ci-elpi_hb + - plugin:ci-micromega - library:ci-mathcomp stage: build-2 @@ -824,6 +827,7 @@ library:ci-oddorder: needs: - build:edge+flambda - plugin:ci-elpi_hb + - plugin:ci-micromega - library:ci-mathcomp stage: build-3+ @@ -832,6 +836,7 @@ library:ci-fourcolor: needs: - build:edge+flambda - plugin:ci-elpi_hb + - plugin:ci-micromega - library:ci-mathcomp stage: build-3+ @@ -869,6 +874,7 @@ library:ci-mathcomp: needs: - build:edge+flambda - plugin:ci-elpi_hb # for Hierarchy Builder + - plugin:ci-micromega stage: build-2 variables: SAVE_BUILD_CI: "1" # for mathcomp_test @@ -878,6 +884,7 @@ library:ci-mathcomp_test: needs: - build:edge+flambda - plugin:ci-elpi_hb + - plugin:ci-micromega - library:ci-mathcomp stage: build-3+ @@ -887,24 +894,16 @@ library:ci-mczify: - build:edge+flambda - library:ci-stdlib+flambda - plugin:ci-elpi_hb + - plugin:ci-micromega - library:ci-mathcomp stage: build-3+ -library:ci-algebra_tactics: - extends: .ci-template-flambda - needs: - - build:edge+flambda - - library:ci-stdlib+flambda - - plugin:ci-elpi_hb - - library:ci-mathcomp - - library:ci-mczify - stage: build-3+ - library:ci-finmap: extends: .ci-template-flambda needs: - build:edge+flambda - plugin:ci-elpi_hb + - plugin:ci-micromega - library:ci-mathcomp stage: build-3+ @@ -913,6 +912,7 @@ library:ci-bigenough: needs: - build:edge+flambda - plugin:ci-elpi_hb + - plugin:ci-micromega - library:ci-mathcomp stage: build-3+ @@ -924,6 +924,7 @@ library:ci-analysis: - library:ci-finmap - library:ci-bigenough - plugin:ci-elpi_hb # for Hierarchy Builder + - plugin:ci-micromega stage: build-3+ variables: SAVE_BUILD_CI: "1" # for analysis_stdlib @@ -937,6 +938,7 @@ library:ci-analysis_stdlib: - library:ci-bigenough - library:ci-analysis - plugin:ci-elpi_hb # for Hierarchy Builder + - plugin:ci-micromega - library:ci-stdlib+flambda stage: build-3+ @@ -1047,6 +1049,7 @@ library:ci-deriving: - build:edge+flambda - library:ci-stdlib+flambda - plugin:ci-elpi_hb + - plugin:ci-micromega - library:ci-mathcomp stage: build-3+ @@ -1056,19 +1059,20 @@ library:ci-mathcomp_word: - build:edge+flambda - library:ci-stdlib+flambda - plugin:ci-elpi_hb + - plugin:ci-micromega - library:ci-mathcomp stage: build-2 -.library:ci-jasmin: # disabled until repaired +library:ci-jasmin: extends: .ci-template-flambda needs: - build:edge+flambda - library:ci-stdlib+flambda - plugin:ci-elpi_hb + - plugin:ci-micromega - library:ci-mathcomp - library:ci-mathcomp_word - library:ci-mczify - - library:ci-algebra_tactics - library:ci-ext_lib - library:ci-paco - library:ci-itree @@ -1080,6 +1084,7 @@ library:ci-http: - build:edge+flambda - library:ci-stdlib+flambda - plugin:ci-elpi_hb + - plugin:ci-micromega - library:ci-mathcomp - library:ci-menhir - library:ci-ext_lib @@ -1201,9 +1206,15 @@ plugin:ci-metarocq: - build:edge+flambda - library:ci-stdlib+flambda - plugin:ci-equations + - library:ci-ext_lib stage: build-2 timeout: 1h 30min +plugin:ci-micromega: + extends: .ci-template-flambda + needs: + - build:edge+flambda + plugin:ci-mtac2: extends: .ci-template-flambda needs: @@ -1240,6 +1251,7 @@ plugin:ci-quickchick: - library:ci-ext_lib - library:ci-simple_io - plugin:ci-elpi_hb + - plugin:ci-micromega - library:ci-mathcomp stage: build-3+ variables: @@ -1253,6 +1265,7 @@ plugin:ci-quickchick_test: - library:ci-ext_lib - library:ci-simple_io - plugin:ci-elpi_hb + - plugin:ci-micromega - library:ci-mathcomp - plugin:ci-quickchick stage: build-3+ @@ -1266,6 +1279,7 @@ plugin:ci-relation_algebra: - build:edge+flambda - library:ci-stdlib+flambda - plugin:ci-elpi_hb + - plugin:ci-micromega - library:ci-mathcomp - plugin:ci-aac_tactics stage: build-3+ @@ -1295,13 +1309,11 @@ library:ci-rupicola: - library:ci-bedrock2 stage: build-3+ -# Disabled until a new maintainer is available -# -# plugin:ci-coq_lsp: -# extends: .ci-template-flambda -# needs: -# - build:edge+flambda -# - library:ci-stdlib+flambda +plugin:ci-rocq_lsp: + extends: .ci-template-flambda + needs: + - build:edge+flambda + - library:ci-stdlib+flambda plugin:ci-vsrocq: extends: .ci-template-flambda @@ -1333,14 +1345,15 @@ doc:ci-refman: - build:edge+flambda - library:ci-stdlib+flambda - plugin:ci-elpi_hb + - plugin:ci-micromega - library:ci-mathcomp - library:ci-mczify stage: build-3+ + after_script: [] # disable save build_ci artifacts: paths: - - _build/log - - _build/default/doc/refman-html - - _build/default/doc/refman-pdf + - _build_ci/refman/refman-html + - _build_ci/refman/refman-pdf pipeline-stats: image: $EDGE_IMAGE diff --git a/.mailmap b/.mailmap index d9c4cb26dc9e..f1565d1ba1b2 100644 --- a/.mailmap +++ b/.mailmap @@ -30,6 +30,7 @@ Frédéric Besson fbesson BESSON Frederic Frédéric Besson fajb Siddharth Bhat Siddharth +Eric Bistal < > ericbistal-coder Lasse Blaauwbroek Lasse Blaauwbroek Lasse Blaauwbroek LasseBlaauwbroek Martin Bodin Martin Bodin @@ -50,6 +51,7 @@ Arthur Charguéraud charguer chluebi <42419603+chluebi@users.noreply.github.com> Tej Chajed tchajed Jeffrey Chang <72239159+JeffreyChang12@users.noreply.github.com> JeffreyChang12 <72239159+JeffreyChang12@users.noreply.github.com> +Dan Christensen jdchristensen Xavier Clerc xclerc Xavier Clerc xclerc Cyril Cohen Cyril Cohen @@ -57,10 +59,12 @@ Cyril Cohen Cyril Cohen CohenCyril Juan Conejero Juan C Pierre Corbineau corbinea +Pierre Corbineau PierreCorbineau Judicaël Courant courant Pierre Courtieu courtieu Pierre Courtieu Matafou Julien Cretin ia0 +Tomás Díaz TDiazT David Delahaye delahaye Maxime Dénès mdenes Maxime Dénès Maxime Denes @@ -151,6 +155,7 @@ Larry Darryl Lee Jr. llee454@gmail.com Larry D. Lee Jr Rodolphe Lepigre rlepigre Rodolphe Lepigre rlepigre-skylabs-ai +Yann Leray yannl35133 Xavier Leroy Xavier Leroy Pierre Letouzey letouzey Pierre Letouzey letouzey @@ -159,6 +164,7 @@ Yishuai Li Yishuai Li Yishuai Li Assia Mahboubi amahboub Kenji Maillard Kenji Maillard +Kenji Maillard kyoDralliam Evgeny Makarov emakarov Gregory Malecha Gregory Malecha Gregory Malecha Gregory Malecha diff --git a/Makefile b/Makefile index b9286c32576e..c604a4a5abd4 100644 --- a/Makefile +++ b/Makefile @@ -33,6 +33,9 @@ HIDE := $(if $(VERBOSE),,@) # use DUNEOPT=--display=short for a more verbose build # DUNEOPT=--display=short +# unset to disable jobserver integration (-j argument of make will be ignored) +WITHJOBS:=dev/tools/with-jobs.sh + help: @echo "" @echo "Welcome to Rocq's Dune-based build system. If you are final user type" @@ -161,7 +164,7 @@ MAIN_TARGETS:=rocq-runtime.install coq-core.install rocq-core.install \ coqide-server.install rocq-devtools.install world: dunestrap - dune build $(DUNEOPT) $(MAIN_TARGETS) + +$(WITHJOBS) dune build $(DUNEOPT) $(MAIN_TARGETS) rocqide: dune build $(DUNEOPT) rocqide.install @@ -175,11 +178,19 @@ check: test-suite: dunestrap dune runtest --no-buffer $(DUNEOPT) -refman-html: dunestrap - dune build --no-buffer @refman-html +.PHONY: doc/unreleased.rst +doc/unreleased.rst: + cat doc/changelog/00-title.rst doc/changelog/*/*.rst > $@ + +WITHPYPATH:=PYTHONPATH=_build/default/config:doc/tools:$$PYTHONPATH -refman-pdf: dunestrap - dune build --no-buffer @refman-pdf +refman-html: world doc/unreleased.rst + rm -rf doc/refman-html + +$(WITHPYPATH) $(WITHJOBS) dune exec -- sphinx-build -q -W -b html doc/sphinx doc/refman-html +refman-pdf: world doc/unreleased.rst + rm -rf doc/refman-pdf + +$(WITHPYPATH) $(WITHJOBS) dune exec -- sphinx-build -q -W -b latex doc/sphinx doc/refman-pdf + $(MAKE) -C doc/refman-pdf LATEXMKOPTS=-silent corelib-html: dunestrap dune build @corelib-html diff --git a/Makefile.ci b/Makefile.ci index 8cc4d67c17ce..70708e47a530 100644 --- a/Makefile.ci +++ b/Makefile.ci @@ -28,7 +28,6 @@ CI_PLATFORM_FULL= \ ci-mathcomp \ ci-mathcomp_word \ ci-mczify \ - ci-algebra_tactics \ ci-finmap \ ci-bigenough \ ci-analysis \ @@ -43,72 +42,7 @@ CI_PLATFORM_FULL= \ ci-stdlib \ ci-unicoq -CI_TARGETS= \ - $(CI_PLATFORM_FULL) \ - ci-argosy \ - ci-async_test \ - ci-atbr \ - ci-autosubst \ - ci-autosubst_ocaml \ - ci-bbv \ - ci-bedrock2 \ - ci-bedrock2_examples \ - ci-category_theory \ - ci-ceres \ - ci-coinduction \ - ci-color \ - ci-compcert \ - ci-coqtail \ - ci-coqutil \ - ci-cross_crypto \ - ci-coq_lsp \ - ci-coq_performance_tests \ - ci-coq_tools \ - ci-deriving \ - ci-elpi_test \ - ci-hb_test \ - ci-engine_bench \ - ci-equations_test \ - ci-fcsl_pcm \ - ci-fiat_crypto \ - ci-fiat_crypto_legacy \ - ci-fiat_crypto_ocaml \ - ci-fiat_parsers \ - ci-fourcolor \ - ci-http \ - ci-itree \ - ci-itree_io \ - ci-jasmin \ - ci-json \ - ci-kami \ - ci-lean_importer \ - ci-ltac2_compiler \ - ci-mathcomp_test \ - ci-metarocq \ - ci-neural_net_interp \ - ci-oddorder \ - ci-paco \ - ci-parsec \ - ci-perennial \ - ci-quickchick_test \ - ci-refman \ - ci-rewriter \ - ci-riscv_coq \ - ci-rupicola \ - ci-sf \ - ci-smtcoq \ - ci-smtcoq_trakt \ - ci-stalmarck \ - ci-stdlib_doc \ - ci-stdlib_test \ - ci-tactician \ - ci-tlc \ - ci-trakt \ - ci-unimath \ - ci-verdi_raft \ - ci-vsrocq \ - ci-vst \ - ci-waterproof +CI_TARGETS:=$(filter-out ci-common,$(patsubst dev/ci/scripts/%.sh,%,$(wildcard dev/ci/scripts/ci-*.sh))) CI_VIRTUAL_TARGETS= \ ci-elpi_hb \ @@ -138,7 +72,7 @@ ci-color: ci-bignums ci-lean_importer: ci-stdlib -ci-mathcomp: ci-elpi_hb +ci-mathcomp: ci-elpi_hb ci-micromega ci-coqprime: ci-bignums ci-coquelicot: ci-mathcomp ci-stdlib @@ -175,7 +109,6 @@ ci-fourcolor: ci-mathcomp ci-oddorder: ci-mathcomp ci-fcsl_pcm: ci-mathcomp ci-stdlib ci-mczify: ci-mathcomp ci-stdlib -ci-algebra_tactics: ci-mczify ci-mathcomp_test: ci-mathcomp ci-mathcomp_word: ci-mathcomp ci-stdlib ci-finmap: ci-mathcomp @@ -196,7 +129,7 @@ ci-ext_lib: ci-stdlib ci-itauto: ci-stdlib -ci-jasmin: ci-mathcomp_word ci-algebra_tactics ci-itree +ci-jasmin: ci-mathcomp_word ci-itree ci-autosubst: ci-stdlib ci-iris: ci-autosubst @@ -221,7 +154,7 @@ ci-flocq: ci-stdlib ci-menhir: ci-stdlib -ci-metarocq: ci-equations +ci-metarocq: ci-equations ci-ext_lib ci-neural_net_interp: ci-stdlib @@ -236,7 +169,7 @@ ci-perennial: ci-stdlib ci-aac_tactics: ci-stdlib ci-relation_algebra: ci-aac_tactics ci-mathcomp -ci-coq_lsp: ci-stdlib +ci-rocq_lsp: ci-stdlib ci-sf: ci-stdlib diff --git a/boot/dune b/boot/dune index d0383dc297ad..bb3985163855 100644 --- a/boot/dune +++ b/boot/dune @@ -7,7 +7,3 @@ ; until ocaml/dune#4892 fixed ; (private_modules util) (libraries rocq-runtime.config rocq-runtime.clib)) - -(deprecated_library_name - (old_public_name coq-core.boot) - (new_public_name rocq-runtime.boot)) diff --git a/boot/usage.ml b/boot/usage.ml index 21246a0d2697..ba1a2bbc43c8 100644 --- a/boot/usage.ml +++ b/boot/usage.ml @@ -40,8 +40,6 @@ let print_usage_common co command = \n\ \n -load-vernac-source f load Rocq file f.v (Load \"f\".)\ \n -l f (idem)\ -\n -load-vernac-source-verbose f load Rocq file f.v (Load Verbose \"f\".)\ -\n -lv f (idem)\ \n -require lib load Rocq library lib (Require lib)\ \n -require-import lib, -ri lib\ \n load and import Rocq library lib\ @@ -49,7 +47,7 @@ let print_usage_common co command = \n -require-export lib, -re lib\ \n load and transitively import Rocq library lib\ \n (equivalent to Require Export lib.)\ -\n -require-from root lib, -rfrom root lib +\n -require-from root lib, -rfrom root lib\ \n load Rocq library lib (From root Require lib.)\ \n -require-import-from root lib, -rifrom root lib\ \n load and import Rocq library lib\ diff --git a/checker/checkFlags.ml b/checker/checkFlags.ml index 568d2aaa9609..b851234fa661 100644 --- a/checker/checkFlags.ml +++ b/checker/checkFlags.ml @@ -18,8 +18,10 @@ let set_local_flags flags env = check_guarded = flags.check_guarded; check_positive = flags.check_positive; check_universes = flags.check_universes; + check_eliminations = flags.check_eliminations; conv_oracle = flags.conv_oracle; share_reduction = flags.share_reduction; + unfold_dep_heuristic = flags.unfold_dep_heuristic; allow_uip = flags.allow_uip; (* These flags may not *) enable_VM = envflags.enable_VM; diff --git a/checker/checkInductive.ml b/checker/checkInductive.ml index e5dcd76b48cb..b7f2019c6869 100644 --- a/checker/checkInductive.ml +++ b/checker/checkInductive.ml @@ -16,6 +16,8 @@ open Util [@@@ocaml.warning "+9+27"] +type ind_retroknowledge = (int * CPrimitives.prim_ind_ex) option + exception InductiveMismatch of MutInd.t * string let check mind field b = if not b then raise (InductiveMismatch (mind,field)) @@ -172,8 +174,8 @@ let check_same_record r1 r2 = match r1, r2 with let check_packet mind ind { mind_typename; mind_arity_ctxt; mind_user_arity; mind_record; mind_sort; mind_consnames; mind_user_lc; mind_nrealargs; mind_nrealdecls; mind_squashed; mind_nf_lc; - mind_consnrealargs; mind_consnrealdecls; mind_recargs; mind_relevance; - mind_nb_constant; mind_nb_args; mind_reloc_tbl } = + mind_consnrealargs; mind_consnrealdecls; mind_automaton; mind_relevance; + mind_relies_on_indices_not_mattering; mind_nb_constant; mind_nb_args; mind_reloc_tbl } = let check = check mind in ignore mind_typename; (* passed through *) @@ -194,17 +196,23 @@ let check_packet mind ind check "mind_consnrealargs" (Array.equal Int.equal ind.mind_consnrealargs mind_consnrealargs); check "mind_consnrealdecls" (Array.equal Int.equal ind.mind_consnrealdecls mind_consnrealdecls); - check "mind_recargs" (Rtree.equal eq_recarg ind.mind_recargs mind_recargs); + check "mind_automaton" (Rtree.Automaton.equal eq_recarg ind.mind_automaton mind_automaton); check "mind_relevant" (Sorts.relevance_equal ind.mind_relevance mind_relevance); + (* mind_relies_on_indices_not_mattering is computed using the universe graph at type-checking time. + During original compilation, the graph may be incomplete (constructor constraints + not yet added), making the check conservative (true). During re-checking, the + graph has all final constraints, so the check may compute false. + Accept when the original is conservatively true but re-check computes false. *) + check "mind_relies_on_indices_not_mattering" (ind.mind_relies_on_indices_not_mattering || not mind_relies_on_indices_not_mattering); check "mind_nb_args" Int.(equal ind.mind_nb_args mind_nb_args); check "mind_nb_constant" Int.(equal ind.mind_nb_constant mind_nb_constant); check "mind_reloc_tbl" (eq_reloc_tbl ind.mind_reloc_tbl mind_reloc_tbl); () -let check_inductive env mind mb = +let check_inductive env mind mb retro = let entry = to_entry mind mb in let { mind_packets; mind_finite; mind_hyps; mind_univ_hyps; mind_nparams; mind_nparams_rec; mind_params_ctxt; @@ -214,6 +222,10 @@ let check_inductive env mind mb = (* Locally set typing flags for further typechecking *) let env = CheckFlags.set_local_flags mb.mind_typing_flags env in let mib, not_prim_record = Indtypes.check_inductive env ~sec_univs:None mind entry in + let () = match retro with + | None -> () + | Some (i, CPrimitives.PIE retro) -> Safe_typing.check_register_ind (mind, i) retro (mib, mib.mind_packets.(i)) + in assert (Option.is_empty not_prim_record); mib in @@ -242,8 +254,8 @@ let check_inductive env mind mb = add_mind mind mb env -let check_inductive env mind mb : Environ.env = +let check_inductive env mind mb retro : Environ.env = NewProfile.profile "check_inductive" ~args:(fun () -> [("name", `String (MutInd.to_string mind))]) - (fun () -> check_inductive env mind mb) + (fun () -> check_inductive env mind mb retro) () diff --git a/checker/checkInductive.mli b/checker/checkInductive.mli index f73ec7c5c15a..ecf54e17e24b 100644 --- a/checker/checkInductive.mli +++ b/checker/checkInductive.mli @@ -11,9 +11,11 @@ open Names open Environ +type ind_retroknowledge = (int * CPrimitives.prim_ind_ex) option + exception InductiveMismatch of MutInd.t * string (** Some field of the inductive is different from what the kernel infers. *) (*s The following function does checks on inductive declarations. *) -val check_inductive : env -> MutInd.t -> Declarations.mutual_inductive_body -> env +val check_inductive : env -> MutInd.t -> Declarations.mutual_inductive_body -> ind_retroknowledge -> env diff --git a/checker/checkLibrary.ml b/checker/checkLibrary.ml index 6a7c2f35c7ee..eac6f3539b8d 100644 --- a/checker/checkLibrary.ml +++ b/checker/checkLibrary.ml @@ -12,6 +12,8 @@ open Pp open Util open Names +[@@@warning "-unused-field"] (* marshalled data *) + let chk_pp = Feedback.msg_notice let pr_dirpath dp = str (DirPath.to_string dp) @@ -441,6 +443,6 @@ let recheck_library senv ~norec ~admit ~check = Flags.if_verbose Feedback.msg_notice (fnl()++hv 2 (str "Ordered list:" ++ fnl() ++ prlist (fun (dir,_) -> pr_dirpath dir ++ fnl()) needed)); - let senv = List.fold_left (check_one_lib nochk) (senv, Cmap.empty) needed in + let senv = List.fold_left (check_one_lib nochk) (senv, Mod_checking.empty_opaques) needed in Flags.if_verbose Feedback.msg_notice (str"Modules were successfully checked"); senv diff --git a/checker/checkLibrary.mli b/checker/checkLibrary.mli index 7a218a9a7da5..3ab33ac4a298 100644 --- a/checker/checkLibrary.mli +++ b/checker/checkLibrary.mli @@ -30,4 +30,4 @@ val add_load_path : physical_path * logical_path -> unit val recheck_library : safe_environment -> norec:object_file list -> admit:object_file list -> - check:object_file list -> safe_environment * Cset.t Cmap.t + check:object_file list -> safe_environment * Mod_checking.opaques diff --git a/checker/check_stat.ml b/checker/check_stat.ml index e4bf1a999376..d5a7662cc318 100644 --- a/checker/check_stat.ml +++ b/checker/check_stat.ml @@ -22,8 +22,6 @@ let print_memory_stat () = Format.print_flush() end -let output_context = ref false - let pr_impredicative_set env = if is_impredicative_set env then str "Theory: Set is impredicative" else str "Theory: Set is predicative" @@ -39,13 +37,7 @@ let pr_assumptions ass axs = hv 2 (str ass ++ str ":" ++ fnl() ++ prlist_with_sep fnl str axs) let pr_axioms env opac = - let add c cb acc = - if Declareops.constant_has_body cb then acc else - match Cmap.find_opt c opac with - | None -> Cset.add c acc - | Some s -> Cset.union s acc in - let csts = fold_constants add env Cset.empty in - let csts = Cset.fold (fun c acc -> Constant.to_string c :: acc) csts [] in + let csts = List.map Constant.to_string opac in pr_assumptions "Axioms" csts let pr_type_in_type env = @@ -62,20 +54,29 @@ let pr_nonpositive env = let inds = fold_inductives (fun c cb acc -> if not cb.mind_typing_flags.check_positive then MutInd.to_string c :: acc else acc) env [] in pr_assumptions "Inductives whose positivity is assumed" inds -let print_context env opac = - if !output_context then begin - Feedback.msg_notice - (hov 0 - (fnl() ++ str"CONTEXT SUMMARY" ++ fnl() ++ - str"===============" ++ fnl() ++ fnl() ++ - str "* " ++ hov 0 (pr_impredicative_set env ++ fnl()) ++ fnl() ++ - str "* " ++ hov 0 (pr_rewrite_rules env ++ fnl()) ++ fnl() ++ - str "* " ++ hov 0 (pr_axioms env opac ++ fnl()) ++ fnl() ++ - str "* " ++ hov 0 (pr_type_in_type env ++ fnl()) ++ fnl() ++ - str "* " ++ hov 0 (pr_unguarded env ++ fnl()) ++ fnl() ++ - str "* " ++ hov 0 (pr_nonpositive env ++ fnl())) - ) - end +let pr_indices_matter env = + let inds = fold_inductives (fun c cb acc -> + if cb.mind_typing_flags.indices_matter then acc + else if Array.exists (fun mip -> mip.mind_relies_on_indices_not_mattering) cb.mind_packets + then MutInd.to_string c :: acc + else acc) env [] in + pr_assumptions "Inductives relying on indices not mattering" inds + +let print_context env opac = match opac with +| None -> () +| Some opac -> + Feedback.msg_notice + (hov 0 + (fnl() ++ str"CONTEXT SUMMARY" ++ fnl() ++ + str"===============" ++ fnl() ++ fnl() ++ + str "* " ++ hov 0 (pr_impredicative_set env ++ fnl()) ++ fnl() ++ + str "* " ++ hov 0 (pr_rewrite_rules env ++ fnl()) ++ fnl() ++ + str "* " ++ hov 0 (pr_axioms env opac ++ fnl()) ++ fnl() ++ + str "* " ++ hov 0 (pr_type_in_type env ++ fnl()) ++ fnl() ++ + str "* " ++ hov 0 (pr_unguarded env ++ fnl()) ++ fnl() ++ + str "* " ++ hov 0 (pr_nonpositive env ++ fnl()) ++ fnl() ++ + str "* " ++ hov 0 (pr_indices_matter env ++ fnl())) + ) let stats env opac = print_context env opac; diff --git a/checker/check_stat.mli b/checker/check_stat.mli index 56c055a9dfab..d4a4109fe3b0 100644 --- a/checker/check_stat.mli +++ b/checker/check_stat.mli @@ -8,6 +8,5 @@ (* * (see LICENSE file for the text of the license) *) (************************************************************************) val memory_stat : bool ref -val output_context : bool ref -val stats : Environ.env -> Names.Cset.t Names.Cmap.t -> unit +val stats : Environ.env -> Names.Constant.t list option -> unit diff --git a/checker/coqchk_main.ml b/checker/coqchk_main.ml index 8ec2cf428ad2..bc3b5b68a4ca 100644 --- a/checker/coqchk_main.ml +++ b/checker/coqchk_main.ml @@ -40,10 +40,10 @@ let dirpath_of_string s = | [] -> CheckLibrary.default_root_prefix | dir -> DirPath.make (List.map Id.of_string dir) let path_of_string s = - if Filename.check_suffix s ".vo" then CheckLibrary.PhysicalFile s + if Filename.check_suffix s ".vo" then Ok (CheckLibrary.PhysicalFile s) else match parse_dir s with - | [] -> invalid_arg "path_of_string" - | l::dir -> CheckLibrary.LogicalFile {dirpath=dir; basename=l} + | [] -> Error () + | l::dir -> Ok (CheckLibrary.LogicalFile {dirpath=dir; basename=l}) let get_version env () = match env with @@ -146,25 +146,42 @@ let indices_matter = ref false let enable_vm = ref false +let output_context = ref false + +let warn_no_bytecode = + CWarnings.create ~name:"bytecode-compiler-disabled" ~category:CWarnings.CoreCategories.bytecode_compiler + Pp.(fun () -> + str "Bytecode compiler is disabled," ++ spc() ++ + str "-bytecode-compiler option ignored.") + let make_senv () = let senv = Safe_typing.empty_environment in let senv = Safe_typing.set_impredicative_set !impredicative_set senv in let senv = Safe_typing.set_indices_matter !indices_matter senv in - let senv = Safe_typing.set_VM !enable_vm senv in + let senv = + if !enable_vm && not Coq_config.bytecode_compiler then begin + warn_no_bytecode (); + senv + end else Safe_typing.set_VM !enable_vm senv + in let senv = Safe_typing.set_allow_sprop true senv in (* be smarter later *) Safe_typing.set_native_compiler false senv +let try_add_path s l = match path_of_string s with +| Ok path -> path :: l +| Error () -> CErrors.user_err (str "Invalid path " ++ qstring s) + let admit_list = ref ([] : CheckLibrary.object_file list) let add_admit s = - admit_list := path_of_string s :: !admit_list + admit_list := try_add_path s !admit_list let norec_list = ref ([] : CheckLibrary.object_file list) let add_norec s = - norec_list := path_of_string s :: !norec_list + norec_list := try_add_path s !norec_list let compile_list = ref ([] : CheckLibrary.object_file list) let add_compile s = - compile_list := path_of_string s :: !compile_list + compile_list := try_add_path s !compile_list (*s Parsing of the command line. We no longer use [Arg.parse], in order to use share [Usage.print_usage] @@ -256,7 +273,7 @@ let explain_exn = function let msg = if CDebug.(get_flag misc) then str "." ++ spc() ++ - UGraph.explain_universe_inconsistency Sorts.QVar.raw_pr Univ.Level.raw_pr i + UGraph.explain_universe_inconsistency Sorts.raw_printer i else mt() in hov 0 (str "Error: Universe inconsistency" ++ msg ++ str ".") @@ -264,7 +281,7 @@ let explain_exn = function let msg = if CDebug.(get_flag misc) then str "." ++ spc() ++ - QGraph.explain_elimination_error Sorts.QVar.raw_pr e + QGraph.explain_elimination_error Sorts.Quality.raw_printer e else mt() in hov 0 (str "Error: Elimination error" ++ msg ++ str ".") @@ -395,7 +412,7 @@ let parse_args argv = | ("-v"|"--version") :: _ -> version () | ("-m" | "--memory") :: rem -> Check_stat.memory_stat := true; parse rem | ("-o" | "--output-context") :: rem -> - Check_stat.output_context := true; parse rem + output_context := true; parse rem | "-admit" :: s :: rem -> add_admit s; parse rem | "-admit" :: [] -> usage 1 @@ -460,5 +477,11 @@ let run senv = let main () = let senv = init() in let senv, opac = run senv in + let opac = + if !output_context then + let env = Safe_typing.env_of_safe_env senv in + Some (Mod_checking.constants_of_opaques env opac) + else None + in Check_stat.stats (Safe_typing.env_of_safe_env senv) opac; exit 0 diff --git a/checker/dune b/checker/dune index 3000d289abf4..d6bc40dbff4d 100644 --- a/checker/dune +++ b/checker/dune @@ -10,10 +10,6 @@ (wrapped true) (libraries rocq-runtime.boot rocq-runtime.kernel)) -(deprecated_library_name - (old_public_name coq-core.checklib) - (new_public_name rocq-runtime.checklib)) - (executable (name rocqchk) (public_name rocqchk) diff --git a/checker/mod_checking.ml b/checker/mod_checking.ml index 2727491ecb5e..42d0f6416702 100644 --- a/checker/mod_checking.ml +++ b/checker/mod_checking.ml @@ -8,28 +8,48 @@ open Environ (** {6 Checking constants } *) +type cset = { cset : KerName.Set.t } +type opaques = Cset_env.t Names.Cmap_env.t + +let empty_cset = { cset = KerName.Set.empty } +let empty_opaques = Cmap_env.empty + +let add_opaque_cb kn cb opac accu = + if Declareops.constant_has_body cb then accu + else match Cmap_env.find_opt kn opac with + | None -> Cset_env.add kn accu + | Some s -> Cset_env.union s accu + +let constants_of_opaques env opac = + let add c cb acc = add_opaque_cb c cb opac acc in + let csts = fold_constants add env Cset_env.empty in + Cset_env.fold (fun c acc -> c :: acc) csts [] + +type check_state = { + st_opaques : opaques; + st_retro : (int * CPrimitives.prim_ind_ex) Mindmap_env.t * CPrimitives.prim_type_ex Cmap_env.t; +} + +let empty_state = { + st_opaques = empty_opaques; + st_retro = (Mindmap_env.empty, Cmap_env.empty); +} + let indirect_accessor : (Opaqueproof.opaque -> Opaqueproof.opaque_proofterm) ref = ref (fun _ -> assert false) let set_indirect_accessor f = indirect_accessor := f -let register_opacified_constant env opac kn cb = +let register_opacified_constant env chkst kn cb = + let opac = chkst.st_opaques in let rec gather_consts s c = match Constr.kind c with - | Constr.Const (c, _) -> Cset.add c s + | Constr.Const (c, _) -> Cset_env.add c s | _ -> Constr.fold gather_consts s c in - let wo_body = - Cset.fold - (fun kn s -> - if Declareops.constant_has_body (lookup_constant kn env) then s else - match Cmap.find_opt kn opac with - | None -> Cset.add kn s - | Some s' -> Cset.union s' s) - (gather_consts Cset.empty cb) - Cset.empty - in - Cmap.add kn wo_body opac + let fold c accu = add_opaque_cb c (lookup_constant c env) opac accu in + let wo_body = Cset_env.fold fold (gather_consts Cset_env.empty cb) Cset_env.empty in + { chkst with st_opaques = Cmap_env.add kn wo_body opac } exception BadConstant of Constant.t * Pp.t @@ -76,23 +96,37 @@ let check_constant_declaration env opac kn cb opacify = end | None -> () in + let retro, opac = match Cmap_env.find_opt kn (snd opac.st_retro) with + | None -> None, opac + | Some retro -> + let (ind_retro, cst_retro) = opac.st_retro in + let opac = { opac with st_retro = (ind_retro, Cmap_env.remove kn cst_retro) } in + Some retro, opac + in match body with - | Some body when opacify -> register_opacified_constant env opac kn body - | Some _ | None -> opac + | Some body when opacify -> retro, register_opacified_constant env opac kn body + | Some _ | None -> retro, opac let check_constant_declaration env opac kn cb opacify = - let opac = NewProfile.profile "check_constant" ~args:(fun () -> + let retro, opac = NewProfile.profile "check_constant" ~args:(fun () -> [("name", `String (Constant.to_string kn))]) (fun () -> check_constant_declaration env opac kn cb opacify) () in - Environ.add_constant kn cb env, opac + let env = Environ.add_constant kn cb env in + let env = match retro with + | None -> env + | Some (CPrimitives.PTE prm) -> + (* TODO: Some checking is performed by this function, but it looks too lightweight *) + Primred.add_retroknowledge env (Retroknowledge.Register_type (prm, kn)) + in + env, opac let check_quality_mask env qmask lincheck = let open Sorts.Quality in match qmask with | PQConstant QSProp -> if Environ.sprop_allowed env then lincheck else Type_errors.error_not_allowed_sprop env - | PQConstant (QProp | QType) -> lincheck + | PQConstant (QProp | QType) | PQGlobal _ -> lincheck | PQVar qio -> Partial_subst.maybe_add_quality qio () lincheck let check_instance_mask env udecl umask lincheck = @@ -141,6 +175,7 @@ and get_holes_profiles_head env nargs ndecls lincheck = function check_instance_mask env mib.mind_universes u lincheck | PHInt _ | PHFloat _ | PHString _ -> lincheck | PHSort PSSProp -> if Environ.sprop_allowed env then lincheck else Type_errors.error_not_allowed_sprop env + | PHSort PSGlobal (_, io) | PHSort PSType io -> Partial_subst.maybe_add_univ io () lincheck | PHSort PSQSort (qio, uio) -> lincheck @@ -207,22 +242,22 @@ let mk_mtb sign delta = Mod_declarations.make_module_type sign delta let rec collect_constants_without_body sign mp accu = let collect_field s lab = function | SFBconst cb -> - let c = Constant.make2 mp lab in - if Declareops.constant_has_body cb then s else Cset.add c s + let c = KerName.make mp lab in + if Declareops.constant_has_body cb then s else { cset = KerName.Set.add c s.cset } | SFBmodule msb -> collect_constants_without_body (mod_type msb) (MPdot(mp,lab)) s | SFBmind _ | SFBrules _ | SFBmodtype _ -> s in match sign with - | MoreFunctor _ -> Cset.empty (* currently ignored *) + | MoreFunctor _ -> empty_cset (* currently ignored *) | NoFunctor struc -> List.fold_left (fun s (lab,mb) -> collect_field s lab mb) accu struc -let rec check_mexpr env opac mse mp_mse res = match mse with +let rec check_mexpr env mse mp_mse res = match mse with | MEident mp -> let mb = lookup_module mp env in let mb = Modops.strengthen_and_subst_module_body mp mb mp_mse false in mod_type mb, mod_delta mb | MEapply (f,mp) -> - let sign, delta = check_mexpr env opac f mp_mse res in + let sign, delta = check_mexpr env f mp_mse res in let farg_id, farg_b, fbody_b = Modops.destr_functor sign in let state = (Environ.universes env, Conversion.checked_universes) in let _ : UGraph.t = Subtyping.check_subtypes state env mp (MPbound farg_id) farg_b in @@ -236,17 +271,16 @@ let rec check_mexpr env opac mse mp_mse res = match mse with Modops.subst_signature subst mp_mse fbody_b, Mod_subst.subst_codom_delta_resolver subst delta | MEwith _ -> CErrors.user_err Pp.(str "Unsupported 'with' constraint in module implementation") -let rec check_mexpression env opac sign mbtyp mp_mse res = match sign with +let rec check_mexpression env sign mbtyp mp_mse res = match sign with | MEMoreFunctor body -> let arg_id, mtb, mbtyp = Modops.destr_functor mbtyp in let env' = Modops.add_module_parameter arg_id mtb env in - let body, delta = check_mexpression env' opac body mbtyp mp_mse res in + let body, delta = check_mexpression env' body mbtyp mp_mse res in MoreFunctor(arg_id,mtb,body), delta - | MENoFunctor me -> check_mexpr env opac me mp_mse res + | MENoFunctor me -> check_mexpr env me mp_mse res let rec check_module env opac mp mb opacify = Flags.if_verbose Feedback.msg_notice (str " checking module: " ++ str (ModPath.to_string mp)); - let env = Modops.add_retroknowledge (mod_retroknowledge mb) env in let delta_mb = mod_delta mb in let opac = check_signature env opac (mod_type mb) mp delta_mb opacify @@ -258,7 +292,7 @@ let rec check_module env opac mp mb opacify = let sign_struct = Modops.annotate_struct_body sign_struct (mod_type mb) in let opac = check_signature env opac sign_struct mp reso opacify in Some (sign_struct, reso), opac - | Algebraic me -> Some (check_mexpression env opac me (mod_type mb) mp delta_mb), opac + | Algebraic me -> Some (check_mexpression env me (mod_type mb) mp delta_mb), opac | Abstract|FullStruct -> None, opac in let () = match optsign with @@ -275,19 +309,27 @@ let rec check_module env opac mp mb opacify = and check_module_type env mp mty = Flags.if_verbose Feedback.msg_notice (str " checking module type: " ++ str (ModPath.to_string @@ mp)); - let _ : _ Cmap.t = - check_signature env Cmap.empty (mod_type mty) mp (mod_delta mty) Cset.empty in + let _ : check_state = + check_signature env empty_state (mod_type mty) mp (mod_delta mty) empty_cset in () and check_structure_field env opac mp lab res opacify = function | SFBconst cb -> let kn = KerName.make mp lab in let kn = Mod_subst.constant_of_delta_kn res kn in - check_constant_declaration env opac kn cb (Cset.mem kn opacify) + check_constant_declaration env opac kn cb (KerName.Set.mem (Constant.canonical kn) opacify.cset) | SFBmind mib -> let kn = KerName.make mp lab in let kn = Mod_subst.mind_of_delta_kn res kn in - CheckInductive.check_inductive env kn mib, opac + let retro = Mindmap_env.find_opt kn (fst opac.st_retro) in + let opac = match retro with + | None -> opac + | Some _ -> + let (ind_retro, cst_retro) = opac.st_retro in + let opac = { opac with st_retro = (Mindmap_env.remove kn ind_retro, cst_retro) } in + opac + in + CheckInductive.check_inductive env kn mib retro, opac | SFBmodule msb -> let mp = MPdot(mp, lab) in let opac = check_module env opac mp msb opacify in @@ -304,7 +346,7 @@ and check_signature env opac sign mp_mse res opacify = match sign with | MoreFunctor (arg_id, mtb, body) -> let () = check_module_type env (MPbound arg_id) mtb in let env' = Modops.add_module_parameter arg_id mtb env in - let opac = check_signature env' opac body mp_mse res Cset.empty in + let opac = check_signature env' opac body mp_mse res empty_cset in opac | NoFunctor struc -> let (_:env), opac = List.fold_left (fun (env, opac) (lab,mb) -> @@ -312,8 +354,52 @@ and check_signature env opac sign mp_mse res opacify = match sign with in opac -let check_module env opac mp mb = +let eq_prim_ind (type a b) (p : a CPrimitives.prim_ind) (q : b CPrimitives.prim_ind) = + String.equal (CPrimitives.prim_ind_to_string p) (CPrimitives.prim_ind_to_string q) + +let get_retroknowlege env retro = + let fold (imap, cmap, extind) = function + | Retroknowledge.Register_ind (prm, (ind, i)) -> + (* Tolerate redeclarations because the kernel allows it somehow *) + let check_prm map = match Mindmap_env.find_opt ind map with + | None -> () + | Some (_, CPrimitives.PIE prm') -> + if not (eq_prim_ind prm prm') then + CErrors.user_err Pp.(str "Inconsistent primitive registration for inductive " ++ MutInd.print ind ++ str ".") + in + let () = check_prm imap in + let () = check_prm extind in + (* It is allowed to register inductives coming from another library, so we have + to account for that. *) + if Environ.mem_mind ind env then + let spec = Inductive.lookup_mind_specif env (ind, i) in + let () = Safe_typing.check_register_ind (ind, i) prm spec in + (imap, cmap, Mindmap_env.add ind (i, CPrimitives.PIE prm) extind) + else + (Mindmap_env.add ind (i, CPrimitives.PIE prm) imap, cmap, extind) + | Retroknowledge.Register_type (prm, cst) -> + let () = assert (not (Cmap_env.mem cst cmap)) in + let () = assert (not (Environ.mem_constant cst env)) in + (imap, Cmap_env.add cst (CPrimitives.PTE prm) cmap, extind) + in + let (imap, cmap, _) = List.fold_left fold (Mindmap_env.empty, Cmap_env.empty, Mindmap_env.empty) retro in + (imap, cmap) + +let check_module env opac retro mp mb = + let retro = get_retroknowlege env retro in + let st = { st_opaques = opac; st_retro = retro } in + let { st_opaques = opac; st_retro = (imap, cmap) } = check_module env st mp mb empty_cset in + let () = match Mindmap_env.choose_opt imap, Cmap_env.choose_opt cmap with + | None, None -> () + | Some (ind, _), (None | Some _) -> + CErrors.user_err Pp.(str "Retroknowledge registration for unknown inductive " ++ MutInd.print ind ++ str ".") + | None, Some (cst, _) -> + CErrors.user_err Pp.(str "Retroknowledge registration for unknown constant " ++ Constant.print cst ++ str ".") + in + opac + +let check_module env opac retro mp mb = NewProfile.profile "check_module" ~args:(fun () -> [("name", `String (ModPath.to_string mp))]) - (fun () -> check_module env opac mp mb Cset.empty) + (fun () -> check_module env opac retro mp mb) () diff --git a/checker/mod_checking.mli b/checker/mod_checking.mli index 138de74f4ed3..2795a82c85a0 100644 --- a/checker/mod_checking.mli +++ b/checker/mod_checking.mli @@ -8,8 +8,13 @@ (* * (see LICENSE file for the text of the license) *) (************************************************************************) +type opaques + val set_indirect_accessor : (Opaqueproof.opaque -> Opaqueproof.opaque_proofterm) -> unit -val check_module : Environ.env -> Names.Cset.t Names.Cmap.t -> Names.ModPath.t -> Mod_declarations.module_body -> Names.Cset.t Names.Cmap.t +val check_module : Environ.env -> opaques -> Retroknowledge.action list -> Names.ModPath.t -> Mod_declarations.module_body -> opaques exception BadConstant of Names.Constant.t * Pp.t + +val constants_of_opaques : Environ.env -> opaques -> Names.Constant.t list +val empty_opaques : opaques diff --git a/checker/safe_checking.ml b/checker/safe_checking.ml index 7b8e014dfb7c..6c1a208902a2 100644 --- a/checker/safe_checking.ml +++ b/checker/safe_checking.ml @@ -14,18 +14,18 @@ let import senv opac clib vmtab digest = let senv = Safe_typing.check_flags_for_library clib senv in let dp = Safe_typing.dirpath_of_library clib in let mb = Safe_typing.module_of_library clib in + let retro = Safe_typing.retroknowledge_of_library clib in let env = Safe_typing.env_of_safe_env senv in let qualities, univs = Safe_typing.univs_of_library clib in let check_quality q = - Sorts.QVar.is_global q && - not (QGraph.is_declared (Sorts.Quality.QVar q) (Environ.qualities env)) + not (QGraph.is_declared (Sorts.Quality.QGlobal q) (Environ.qualities env)) in - let () = assert (Sorts.QVar.Set.for_all check_quality (fst qualities)) in - let env = push_qualities ~rigid:true qualities env in + let () = assert (Sorts.QGlobal.Set.for_all check_quality (fst qualities)) in + let env = Environ.push_qualities (Sorts.Quality.Set.of_qglobals @@ fst qualities) env in + let env = Environ.merge_elim_constraints ~rigid:true (snd qualities) env in let env = push_context_set ~strict:true univs env in - let env = Modops.add_retroknowledge (Mod_declarations.mod_retroknowledge mb) env in let env = Environ.link_vm_library vmtab env in - let opac = Mod_checking.check_module env opac (Names.ModPath.MPfile dp) mb in + let opac = Mod_checking.check_module env opac retro (Names.ModPath.MPfile dp) mb in let (_,senv) = Safe_typing.import clib vmtab digest senv in senv, opac let import senv opac clib vmtab digest : _ * _ = diff --git a/checker/safe_checking.mli b/checker/safe_checking.mli index 3d529fe0673c..14cc27293c25 100644 --- a/checker/safe_checking.mli +++ b/checker/safe_checking.mli @@ -14,10 +14,10 @@ open Safe_typing val import : safe_environment - -> Names.Cset.t Names.Cmap.t + -> Mod_checking.opaques -> compiled_library -> Vmlibrary.on_disk - -> vodigest -> safe_environment * Names.Cset.t Names.Cmap.t + -> vodigest -> safe_environment * Mod_checking.opaques val unsafe_import : safe_environment diff --git a/checker/values.ml b/checker/values.ml index 40dc07760549..a41559712549 100644 --- a/checker/values.ml +++ b/checker/values.ml @@ -185,14 +185,14 @@ let v_level = v_tuple "level" [|v_int;v_raw_level|] let v_expr = v_tuple "levelexpr" [|v_level;v_int|] let v_univ = v_list v_expr -let v_qglobal = v_pair v_dp v_id +let v_qglobal = v_tuple "qglobal" [|v_dp; v_int|] (* perhaps the "Unif" constructor should be forbidden in vo files *) -let v_qvar = v_sum "qvar" 0 [|[|v_int|];[|v_string;v_int|];[|v_qglobal|]|] +let v_qvar = v_sum "qvar" 0 [|[|v_int|];[|v_int|];[|v_string;v_int|]|] let v_constant_quality = v_enum "constant_quality" 3 -let v_quality = v_sum "quality" 0 [|[|v_qvar|];[|v_constant_quality|]|] +let v_quality = v_sum "quality" 0 [|[|v_qvar|];[|v_constant_quality|];[|v_qglobal|]|] let v_elim_cstrs = v_annot_c @@ -219,11 +219,13 @@ let v_variance = v_enum "variance" 3 let v_instance = v_annot_c ("instance", v_pair (v_array v_quality) (v_array v_level)) let v_abs_context = v_tuple "abstract_universe_context" [|v_pair (v_array v_name) (v_array v_name); v_cstrs|] let v_univ_context_set = v_tuple "universe_context_set" [|v_hset v_level;v_univ_cstrs|] -let v_sort_context_set = v_tuple "sort_context_set" [|v_set v_qvar; v_elim_cstrs|] (** kernel/term *) -let v_sort = v_sum "sort" 3 (*SProp, Prop, Set*) [|[|v_univ(*Type*)|];[|v_qvar;v_univ(*QSort*)|]|] +let v_sort = v_sum "sort" 3 (*SProp, Prop, Set*) + [|[|v_univ(*Type*)|]; + [|v_qglobal;v_univ|]; + [|v_qvar;v_univ(*QSort*)|]|] let v_relevance = v_sum "relevance" 2 [|[|v_qvar|]|] let v_binder_annot x = v_tuple "binder_annot" [|x;v_relevance|] @@ -355,9 +357,9 @@ let v_cst_def = let v_typing_flags = v_tuple "typing_flags" - [|v_bool; v_bool; v_bool; + [|v_bool; v_bool; v_bool; v_bool; v_oracle; v_bool; v_bool; - v_bool; v_bool; v_bool; v_bool; v_bool|] + v_bool; v_bool; v_bool; v_bool; v_bool; v_bool|] let v_univs = v_sum "universes" 1 [|[|v_abs_context|]|] @@ -389,7 +391,7 @@ let v_reloc = v_sum "vm_reloc" 0 [| let v_vm_patches = v_tuple "vm_patches" [|v_array v_reloc|] let v_vm_pbody_code index = - v_sum "pbody_code" 1 [| + v_sum "pbody_code" 2 [| [|v_array v_bool; index; v_vm_patches|]; [|v_cst|]; |] @@ -417,7 +419,7 @@ let v_cb = v_tuple "constant_body" v_cst_def; v_constr; v_relevance; - v_opt v_vm_indirect_code; + v_vm_indirect_code; v_univs; v_bool; v_typing_flags|] @@ -428,17 +430,13 @@ let v_recarg_type = v_sum "recarg_type" 0 let v_recarg = v_sum "recarg" 1 (* Norec *) [|[|v_recarg_type|] (* Mrec *)|] -let v_wfp = - fix (fun v_wfp -> - v_sum_c ("wf_paths",0, - [|[|v_int;v_int|]; (* Rtree.Param *) - [|v_recarg;v_array (v_array v_wfp)|]; (* Rtree.Node *) - [|v_int;v_array v_wfp|] (* Rtree.Rec *) - |])) +let v_automaton = + v_tuple "automaton" + [|v_int; v_array (v_pair v_recarg (v_array (v_array v_int)))|] let v_squash_info = v_sum "squash_info" 1 [|[|v_set v_quality|]|] -let v_has_eta = v_enum "has_eta" 2 +let v_has_eta = v_enum "has_eta" 3 let v_record_info = v_sum "record_info" 2 [| [| v_id; v_array v_id; v_array v_relevance; v_array v_constr; v_has_eta |] |] @@ -457,8 +455,9 @@ let v_one_ind = v_tuple "one_inductive_body" v_array (v_pair v_rctxt v_constr); v_array v_int; v_array v_int; - v_wfp; + v_automaton; v_relevance; + v_bool; v_int; v_int; v_vm_reloc_table|] @@ -493,18 +492,23 @@ let v_retro_action = |] let v_retroknowledge = - v_sum "module_retroknowledge" 0 [|[|v_list v_retro_action|]|] + v_list v_retro_action let v_puniv = v_opt v_int let v_pqvar = v_opt v_int -let v_quality_pattern = v_sum "quality_pattern" 0 [|[|v_pqvar|];[|v_constant_quality|]|] +let v_quality_pattern = v_sum "quality_pattern" 0 [| + [|v_pqvar|]; + [|v_constant_quality|]; + [|v_qglobal|]; +|] let v_instance_mask = v_pair (v_array v_quality_pattern) (v_array v_puniv) let v_sort_pattern = v_sum_c ("sort_pattern", 3, - [|[|v_puniv|]; (* PSType *) - [|v_pqvar; v_puniv|] (* PSQSort *) + [|[|v_puniv|]; (* PSType *) + [|v_qglobal; v_puniv|]; (* PSGlobal *) + [|v_pqvar; v_puniv|]; (* PSQSort *) |]) let [_v_hpattern;v_elimination;_v_head_elim;_v_patarg] : _ Vector.t = @@ -584,10 +588,10 @@ let [_v_sfb;_v_struc;_v_sign;_v_mexpr;_v_impl;v_module;_v_modtype] : _ Vector.t [|v_resolver; v_struc|]|]) (* Struct *) and v_module = v_tuple_c ("module_body", - [|v_sum_c ("when_mod_body", 0, [|[|v_impl|]|]);v_sign;v_opt v_mexpr;v_resolver;v_retroknowledge|]) + [|v_sum_c ("when_mod_body", 0, [|[|v_impl|]|]);v_sign;v_opt v_mexpr;v_resolver|]) and v_modtype = v_tuple_c ("module_type_body", - [|v_noimpl;v_sign;v_opt v_mexpr;v_resolver;v_unit|]) + [|v_noimpl;v_sign;v_opt v_mexpr;v_resolver|]) in [v_sfb;v_struc;v_sign;v_mexpr;v_impl;v_module;v_modtype]) @@ -597,7 +601,14 @@ let v_vodigest = v_sum_c ("module_impl",0, [| [|v_string|]; [|v_string;v_string| let v_deps = v_array (v_tuple "dep" [|v_dp;v_vodigest|]) let v_flags = v_tuple "flags" [|v_bool|] (* Allow Rewrite Rules *) let v_compiled_lib = - v_tuple "compiled" [|v_dp; v_module; v_univ_context_set; v_sort_context_set; v_deps; v_flags|] + v_tuple "compiled" + [|v_dp; + v_module; + v_univ_context_set; + (v_pair (v_set v_qglobal) v_elim_cstrs); + v_deps; + v_flags; + v_retroknowledge|] (** Toplevel structures in a vo (see Cic.mli) *) diff --git a/checker/votour.ml b/checker/votour.ml index 5fdbb911c761..99fd9d625e86 100644 --- a/checker/votour.ml +++ b/checker/votour.ml @@ -10,6 +10,9 @@ open Values +(* several records are defined to receive marshalled data *) +[@@@warning "-unused-field"] + (** {6 Interactive visit of a vo} *) let max_string_length = 1024 @@ -463,9 +466,9 @@ let visit_vo f = Printf.printf "File format: %ld\n%!" version; Printf.printf "The file has %d segments, choose the one to visit:\n" (Array.length segments); - Array.iteri (fun i ObjFile.{ name; pos; header } -> + Array.iteri (fun i ObjFile.{ name; pos; header; hash } -> let size = if Sys.word_size = 64 then header.size64 else header.size32 in - Printf.printf " %d: %s, starting at byte %Ld (size %iw)\n" i name pos size) + Printf.printf " %d: %s, starting at byte %Ld (size %iw, hash %s)\n" i name pos size (Digest.to_hex hash)) segments; match read_num (Array.length segments) with | CmdChild seg -> diff --git a/clib/cList.ml b/clib/cList.ml index b720d2027f32..128711ba4bec 100644 --- a/clib/cList.ml +++ b/clib/cList.ml @@ -19,7 +19,7 @@ include List type 'a cell = { head : 'a; mutable tail : 'a list; -} +} [@@warning "-unused-field"] external cast : 'a cell -> 'a list = "%identity" diff --git a/clib/cSig.mli b/clib/cSig.mli index 7e7734e008ac..44821793fc34 100644 --- a/clib/cSig.mli +++ b/clib/cSig.mli @@ -72,6 +72,7 @@ module type SetS = sig val to_rev_seq : t -> elt Seq.t val add_seq : elt Seq.t -> t -> t val of_seq : elt Seq.t -> t + val map : (elt -> elt) -> t -> t end (** OCaml set operations which require the order structure to be efficient. *) diff --git a/clib/dune b/clib/dune index 8b293908eb4a..b9aec8e12920 100644 --- a/clib/dune +++ b/clib/dune @@ -11,10 +11,6 @@ (memprof-limits -> memprof_coq.memprof.ml)) str unix threads)) -(deprecated_library_name - (old_public_name coq-core.clib) - (new_public_name rocq-runtime.clib)) - (executable (name unicodetable_gen) (modules unicodetable_gen)) diff --git a/clib/dyn.ml b/clib/dyn.ml index 71805bb1aecf..f144d82347b6 100644 --- a/clib/dyn.ml +++ b/clib/dyn.ml @@ -43,6 +43,7 @@ sig val create : string -> 'a tag val eq : 'a tag -> 'b tag -> ('a, 'b) CSig.eq option + val compare : 'a tag -> 'b tag -> int val repr : 'a tag -> string val dump : unit -> (int * string) list @@ -103,6 +104,8 @@ module Self : PreS = struct dyntab := Int.Map.add hash s !dyntab; hash + let compare = Int.compare + let eq : 'a 'b. 'a tag -> 'b tag -> ('a, 'b) CSig.eq option = fun h1 h2 -> if Int.equal h1 h2 then Some (Obj.magic CSig.Refl) else None diff --git a/clib/dyn.mli b/clib/dyn.mli index bd16457d52e8..367bc6e4fb56 100644 --- a/clib/dyn.mli +++ b/clib/dyn.mli @@ -55,6 +55,9 @@ sig val eq : 'a tag -> 'b tag -> ('a, 'b) CSig.eq option (** [eq t1 t2] returns [Some witness] if [t1] is the same as [t2], [None] otherwise. *) + val compare : 'a tag -> 'b tag -> int + (** Invariant: [compare a b = 0] iff [eq a b = Some witness]. *) + val repr : 'a tag -> string (** [repr tag] returns the name of the type represented by [tag]. *) diff --git a/clib/memprof_coq.memprof.ml b/clib/memprof_coq.memprof.ml index 72fac052d846..114889cdb298 100644 --- a/clib/memprof_coq.memprof.ml +++ b/clib/memprof_coq.memprof.ml @@ -1,7 +1,11 @@ (* From memprof_limits, see also https://gitlab.com/gadmm/memprof-limits/-/issues/7 *) +let is_real_memprof = true + let is_interrupted () = Memprof_limits.is_interrupted () [@@inline] +let limit_allocations = Memprof_limits.limit_allocations + module Resource_bind = Memprof_limits.Resource_bind (* Not exported by memprof limits :( *) diff --git a/clib/memprof_coq.mli b/clib/memprof_coq.mli index 3849c4036859..ba5a73079d06 100644 --- a/clib/memprof_coq.mli +++ b/clib/memprof_coq.mli @@ -1,6 +1,10 @@ (* From memprof-limits *) +val is_real_memprof : bool + val is_interrupted : unit -> bool +val limit_allocations : limit:Int64.t -> (unit -> 'a) -> ('a * Int64.t, exn) result + module Masking : sig val with_resource : diff --git a/clib/memprof_coq.std.ml b/clib/memprof_coq.std.ml index 4b58c1e45087..d10a3f6df9ec 100644 --- a/clib/memprof_coq.std.ml +++ b/clib/memprof_coq.std.ml @@ -1,5 +1,9 @@ +let is_real_memprof = false + let is_interrupted _ = false [@@inline] +let limit_allocations ~limit:_ f = Ok (f(), 0L) + module Resource_bind = struct let ( let& ) f scope = f ~scope end diff --git a/clib/range.ml b/clib/range.ml index 6e8aed74fbf1..5d9ffe780a4e 100644 --- a/clib/range.ml +++ b/clib/range.ml @@ -42,6 +42,20 @@ let rec get l i = match l with | Cons (h, t, rem) -> if i < h then tree_get h t i else get rem (i - h) +let rec tree_set h t i v = match t with +| Leaf x -> + if i = 0 then Leaf v else oob () +| Node (x, t1, t2) -> + if i = 0 then Node (v, t1, t2) + else + let h = h / 2 in + if i <= h then Node (x, tree_set h t1 (i - 1) v, t2) else Node (x, t1, tree_set h t2 (i - h - 1) v) + +let rec set l i v = match l with +| Nil -> oob () +| Cons (h, t, rem) -> + if i < h then Cons (h, tree_set h t i v, rem) else Cons (h, t, set rem (i - h) v) + let length l = let rec length accu = function | Nil -> accu diff --git a/clib/range.mli b/clib/range.mli index 956e8e52a970..1bc712668467 100644 --- a/clib/range.mli +++ b/clib/range.mli @@ -37,3 +37,4 @@ val skipn : int -> 'a t -> 'a t (** {5 Indexing operations} *) val get : 'a t -> int -> 'a +val set : 'a t -> int -> 'a -> 'a t diff --git a/clib/unicode.ml b/clib/unicode.ml index 266059bd5e7a..59ca54c3f4e6 100644 --- a/clib/unicode.ml +++ b/clib/unicode.ml @@ -122,6 +122,7 @@ let classify = mk_lookup_table_from_unicode_tables_for IdentSep [ single 0x005F; (* Underscore. *) + single 0x2017; (* Double low line. *) single 0x00A0; (* Non breaking space, overrides Sep *) ]; mk_lookup_table_from_unicode_tables_for IdentPart @@ -147,31 +148,66 @@ let utf8_of_unicode n = then [next_utf8 s i] returns [(j,n)] where: - [j] indicates the position of the next UTF-8 character - [n] represents the UTF-8 character at index [i] *) + +type size = +| Sz1 +| Sz2 +| Sz3 +| Sz4 + +let size_to_int = function +| Sz1 -> 1 +| Sz2 -> 2 +| Sz3 -> 3 +| Sz4 -> 4 + +let unsafe_char_code s i = Char.code @@ String.unsafe_get s i +[@@ocaml.inline always] + let next_utf8 s i = let err () = invalid_arg "utf8" in let l = String.length s - i in if l = 0 then raise End_of_input - else let a = Char.code s.[i] in if a <= 0x7F then - 1, a + else let a = unsafe_char_code s i in if a <= 0x7F then + Sz1 else if a land 0x40 = 0 || l = 1 then err () - else let b = Char.code s.[i+1] in if b land 0xC0 <> 0x80 then err () + else let b = unsafe_char_code s (i + 1) in if b land 0xC0 <> 0x80 then err () else if a land 0x20 = 0 then - 2, (a land 0x1F) lsl 6 + (b land 0x3F) + Sz2 else if l = 2 then err () - else let c = Char.code s.[i+2] in if c land 0xC0 <> 0x80 then err () + else let c = unsafe_char_code s (i + 2) in if c land 0xC0 <> 0x80 then err () else if a land 0x10 = 0 then - 3, (a land 0x0F) lsl 12 + (b land 0x3F) lsl 6 + (c land 0x3F) + Sz3 else if l = 3 then err () - else let d = Char.code s.[i+3] in if d land 0xC0 <> 0x80 then err () + else let d = unsafe_char_code s (i + 3) in if d land 0xC0 <> 0x80 then err () else if a land 0x08 = 0 then - 4, (a land 0x07) lsl 18 + (b land 0x3F) lsl 12 + - (c land 0x3F) lsl 6 + (d land 0x3F) + Sz4 else err () +let get_next_utf8 s i k = match k with +| Sz1 -> + let a = unsafe_char_code s i in + a +| Sz2 -> + let a = unsafe_char_code s i in + let b = unsafe_char_code s (i + 1) in + (a land 0x1F) lsl 6 + (b land 0x3F) +| Sz3 -> + let a = unsafe_char_code s i in + let b = unsafe_char_code s (i + 1) in + let c = unsafe_char_code s (i + 2) in + (a land 0x0F) lsl 12 + (b land 0x3F) lsl 6 + (c land 0x3F) +| Sz4 -> + let a = unsafe_char_code s i in + let b = unsafe_char_code s (i + 1) in + let c = unsafe_char_code s (i + 2) in + let d = unsafe_char_code s (i + 3) in + (a land 0x07) lsl 18 + (b land 0x3F) lsl 12 + (c land 0x3F) lsl 6 + (d land 0x3F) + let is_utf8 s = let rec check i = - let (off, _) = next_utf8 s i in - check (i + off) + let off = next_utf8 s i in + check (i + size_to_int off) in try check 0 with End_of_input -> true | Invalid_argument _ -> false @@ -217,7 +253,7 @@ let is_valid_ident_initial = function let initial_refutation j n s = if is_valid_ident_initial (classify n) then None else - let c = String.sub s 0 j in + let c = String.sub s 0 (size_to_int j) in Some (false, "Invalid character '"^c^"' at beginning of identifier \""^s^"\".") @@ -228,7 +264,7 @@ let is_valid_ident_trailing = function let trailing_refutation i j n s = if is_valid_ident_trailing (classify n) then None else - let c = String.sub s i j in + let c = String.sub s i (size_to_int j) in Some (false, "Invalid character '"^c^"' in identifier \""^s^"\".") @@ -250,16 +286,18 @@ let is_letter = function let ident_refutation s = if s = ".." then None else try - let j, n = next_utf8 s 0 in + let j = next_utf8 s 0 in + let n = get_next_utf8 s 0 j in match initial_refutation j n s with |None -> begin try let rec aux i = - let j, n = next_utf8 s i in + let j = next_utf8 s i in + let n = get_next_utf8 s i j in match trailing_refutation i j n s with - |None -> aux (i + j) + |None -> aux (i + size_to_int j) |x -> x - in aux j + in aux (size_to_int j) with End_of_input -> None end |x -> x @@ -278,20 +316,23 @@ let lowercase_unicode = let lowercase_first_char s = assert (s <> ""); - let j, n = next_utf8 s 0 in + let j = next_utf8 s 0 in + let n = get_next_utf8 s 0 j 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 + let n = next_utf8 s 0 in + let v = get_next_utf8 s 0 n in + if ((* optim *) size_to_int n = 1 && s.[0] != '_') || not (is_ident_sep (classify v)) then None else begin - let n = ref n in + let n = ref (size_to_int n) in let p = ref 0 in while !n < String.length s && - let n', v = next_utf8 s !n in - p := n'; + let n' = next_utf8 s !n in + let v = get_next_utf8 s !n n' in + p := size_to_int n'; (* Test if not letter *) - ((* optim *) n' = 1 && (s.[!n] = '_' || s.[!n] = '\'')) + ((* optim *) size_to_int n' = 1 && (s.[!n] = '_' || s.[!n] = '\'')) || let st = classify v in is_ident_sep st || is_ident_part st do n := !n + !p @@ -321,9 +362,10 @@ let ascii_of_ident s = let out = Buffer.create (2*len) in Buffer.add_substring out s 0 !i; while !i < len do - let j, n = next_utf8 s !i in + let j = next_utf8 s !i in + let n = get_next_utf8 s !i j in if n >= 128 then - (Printf.bprintf out "_UU%04x_" n; i := !i + j) + (Printf.bprintf out "_UU%04x_" n; i := !i + size_to_int j) else if has_UU !i then (Buffer.add_string out "_UUU"; i := !i + 3) else diff --git a/config/coq_config.mli b/config/coq_config.mli index 74c1bbd11139..0569d20c67f9 100644 --- a/config/coq_config.mli +++ b/config/coq_config.mli @@ -63,7 +63,7 @@ val has_natdynlink : bool (* used in coqdoc *) val wwwcoq : string -val wwwstdlib : string +val wwwcorelib : string (* used in rocqide *) val wwwrefman : string diff --git a/config/dune b/config/dune index 3fa9d4dcdc96..fb11fbee2401 100644 --- a/config/dune +++ b/config/dune @@ -5,10 +5,6 @@ (modules coq_config) (wrapped false)) -(deprecated_library_name - (old_public_name coq-core.config) - (new_public_name rocq-runtime.config)) - (library (name byte_config) (synopsis "Rocq Configuration Variables (for bytecode only)") @@ -18,10 +14,6 @@ (libraries compiler-libs.toplevel) (modes byte)) -(deprecated_library_name - (old_public_name coq-core.config.byte) - (new_public_name rocq-runtime.config.byte)) - (executable (name list_plugins) (modules list_plugins)) (rule (targets plugin_list) (deps (source_tree %{project_root}/plugins)) diff --git a/coqpp/coqpp_ast.mli b/coqpp/coqpp_ast.mli index 149260db3a96..d63843d63260 100644 --- a/coqpp/coqpp_ast.mli +++ b/coqpp/coqpp_ast.mli @@ -49,6 +49,7 @@ type assoc = | LeftA | RightA | NonA +| BothA type gram_symbol = | GSymbString of string @@ -93,10 +94,14 @@ type grammar_ext = { gramext_entries : grammar_entry list; } +type tacext_depr = + | Depr of code + | Warn of code + type tactic_ext = { tacext_name : string; tacext_level : int option; - tacext_deprecated : code option; + tacext_deprecated : tacext_depr option; tacext_rules : tactic_rule list; } @@ -139,7 +144,7 @@ type argument_ext = { argext_name : string; argext_rules : tactic_rule list; argext_type : argument_type option; - argext_interp : (string option * code) option; + argext_interp : code option; argext_glob : code option; argext_subst : code option; argext_rprinter : code option; diff --git a/coqpp/coqpp_lex.mll b/coqpp/coqpp_lex.mll index 87fcfe95618e..e7e0d2c3fa8e 100644 --- a/coqpp/coqpp_lex.mll +++ b/coqpp/coqpp_lex.mll @@ -105,6 +105,7 @@ rule extend = parse | "DECLARE" { DECLARE } | "PLUGIN" { PLUGIN } | "DEPRECATED" { DEPRECATED } +| "WARN" { WARN } | "CLASSIFIED" { CLASSIFIED } | "STATE" { STATE } | "PRINTED" { PRINTED } @@ -129,6 +130,7 @@ rule extend = parse | "LEFTA" { LEFTA } | "RIGHTA" { RIGHTA } | "NONA" { NONA } +| "BOTHA" { BOTHA } | "IGNORE" { IGNORE } | "KEYWORDS" { KEYWORDS } (** Standard *) diff --git a/coqpp/coqpp_main.ml b/coqpp/coqpp_main.ml index c5e87618e0de..ff3c74100ca7 100644 --- a/coqpp/coqpp_main.ml +++ b/coqpp/coqpp_main.ml @@ -189,6 +189,7 @@ let print_assoc fmt = function | LeftA -> fprintf fmt "Gramlib.Gramext.LeftA" | RightA -> fprintf fmt "Gramlib.Gramext.RightA" | NonA -> fprintf fmt "Gramlib.Gramext.NonA" +| BothA -> fprintf fmt "Gramlib.Gramext.BothA" let is_token s = match string_split s with | [s] -> is_uident s @@ -546,7 +547,8 @@ let print_ast fmt ext = let deprecation fmt = function | None -> () - | Some { code } -> fprintf fmt "~deprecation:(%s) " code + | Some (Depr { code }) -> fprintf fmt "~deprecation:(%s) " code + | Some (Warn { code }) -> fprintf fmt "~warn:(%s) " code in let pr fmt () = let level = match ext.tacext_level with None -> 0 | Some i -> i in @@ -680,10 +682,8 @@ let print_ast fmt arg = fprintf fmt "@[Tacentries.ArgSubstFun (fun s v -> v)@]" in let interp fmt () = match arg.argext_interp, arg.argext_type with - | Some (None, f), (None | Some _) -> + | Some f, (None | Some _) -> fprintf fmt "@[Tacentries.ArgInterpSimple (%a)@]" print_code f - | Some (Some kind, f), (None | Some _) -> - fatal (Printf.sprintf "Unknown kind %s of interpretation function" kind) | None, Some t -> fprintf fmt "@[Tacentries.ArgInterpWit (%a)@]" print_wit t | None, None -> diff --git a/coqpp/coqpp_parse.mly b/coqpp/coqpp_parse.mly index 27dfa1b67a67..b2129bc8e1cf 100644 --- a/coqpp/coqpp_parse.mly +++ b/coqpp/coqpp_parse.mly @@ -67,12 +67,12 @@ let rhs_loc n = %token IDENT QUALID %token STRING %token INT -%token VERNAC TACTIC GRAMMAR DOC_GRAMMAR EXTEND END DECLARE PLUGIN DEPRECATED ARGUMENT +%token VERNAC TACTIC GRAMMAR DOC_GRAMMAR EXTEND END DECLARE PLUGIN DEPRECATED WARN ARGUMENT %token RAW_PRINTED GLOB_PRINTED %token SYNTERP COMMAND CLASSIFIED STATE PRINTED TYPED INTERPRETED GLOBALIZED SUBSTITUTED BY AS %token BANGBRACKET HASHBRACKET LBRACKET RBRACKET PIPE ARROW FUN COMMA EQUAL STAR %token LPAREN RPAREN COLON SEMICOLON -%token GLOBAL TOP FIRST LAST BEFORE AFTER LEVEL LEFTA RIGHTA NONA +%token GLOBAL TOP FIRST LAST BEFORE AFTER LEVEL LEFTA RIGHTA NONA BOTHA %token IGNORE KEYWORDS %token EOF @@ -160,14 +160,9 @@ glob_printed_opt: | GLOB_PRINTED BY CODE { Some $3 } ; -interpreted_modifier_opt: -| { None } -| LBRACKET IDENT RBRACKET { Some $2 } -; - interpreted_opt: | { None } -| INTERPRETED interpreted_modifier_opt BY CODE { Some ($2,$4) } +| INTERPRETED BY CODE { Some $3 } ; globalized_opt: @@ -284,7 +279,8 @@ tactic_extend: tactic_deprecated: | { None } -| DEPRECATED CODE { Some $2 } +| DEPRECATED CODE { Some (Depr $2) } +| WARN CODE { Some (Warn $2) } ; tactic_level: @@ -381,6 +377,7 @@ assoc: | LEFTA { LeftA } | RIGHTA { RightA } | NONA { NonA } +| BOTHA { BothA } ; levels: diff --git a/dev/bench/bench.sh b/dev/bench/bench.sh index 6e40e014fe50..37202ededc15 100755 --- a/dev/bench/bench.sh +++ b/dev/bench/bench.sh @@ -49,8 +49,9 @@ check_variable () { : "${old_coq_version:=dev}" : "${num_of_iterations:=1}" : "${timeout:=3h}" -: "${coq_opam_packages:=rocq-stdlib rocq-bignums coq-hott coq-performance-tests-lite coq-engine-bench-lite rocq-elpi rocq-mathcomp-boot rocq-mathcomp-order rocq-mathcomp-ssreflect rocq-mathcomp-fingroup rocq-mathcomp-algebra rocq-mathcomp-solvable rocq-mathcomp-field rocq-mathcomp-character coq-mathcomp-odd-order coq-mathcomp-analysis coq-math-classes coq-corn coq-compcert rocq-equations rocq-metarocq-utils rocq-metarocq-common rocq-metarocq-template rocq-metarocq-pcuic rocq-metarocq-safechecker rocq-metarocq-erasure rocq-metarocq-translations coq-color coq-coqprime coq-coqutil coq-bedrock2 coq-rewriter coq-fiat-core coq-fiat-parsers coq-fiat-crypto-with-bedrock coq-unimath coq-coquelicot coq-iris-examples coq-verdi coq-verdi-raft coq-fourcolor coq-rewriter-perf-SuperFast coq-vst coq-category-theory coq-neural-net-interp-computed-lite}" +: "${coq_opam_packages:=rocq-stdlib rocq-bignums coq-hott coq-performance-tests-lite coq-engine-bench-lite rocq-elpi rocq-mathcomp-boot rocq-mathcomp-order rocq-mathcomp-ssreflect rocq-mathcomp-finite-group rocq-mathcomp-algebra rocq-mathcomp-solvable rocq-mathcomp-field rocq-mathcomp-group-representation coq-mathcomp-odd-order coq-mathcomp-analysis coq-math-classes coq-corn coq-compcert rocq-equations rocq-metarocq-utils rocq-metarocq-common rocq-metarocq-template rocq-metarocq-pcuic rocq-metarocq-safechecker rocq-metarocq-erasure rocq-metarocq-translations coq-color coq-coqprime coq-coqutil coq-bedrock2 coq-rewriter coq-fiat-core coq-fiat-parsers coq-fiat-crypto-with-bedrock coq-unimath coq-coquelicot coq-iris-examples coq-verdi coq-verdi-raft coq-fourcolor coq-rewriter-perf-SuperFast coq-vst coq-category-theory coq-neural-net-interp-computed-lite}" : "${coq_native:=}" +: "${auto_overlays:=1}" # example: coq-hott.dev git+https://github.com/some-user/coq-hott#some-branch # (make sure to include the version for the opam package, note that just https won't work) @@ -92,6 +93,37 @@ log_dir=$working_dir/logs mkdir "$log_dir" export COQ_LOG_DIR=$log_dir +# maps CI project (first arg of "overlay") +# to space separated list of opam packages which use the project's url +declare -A auto_overlay_map +auto_overlay_map[elpi]="rocq-elpi" +auto_overlay_map[equations]="rocq-equations" +auto_overlay_map[metarocq]="rocq-metarocq-utils rocq-metarocq-common rocq-metarocq-template rocq-metarocq-pcuic rocq-metarocq-safechecker rocq-metarocq-erasure rocq-metarocq-translations" + +if [ "$auto_overlays" ]; then + CI_PULL_REQUEST="${CI_COMMIT_REF_NAME#pr-}" + overlay() { + local project=$1 + local ov_url=$2 + local ov_ref=$3 + local ov_prnumber=$4 + local ov_prbranch=$5 + : "${ov_prbranch:=$ov_ref}" + + if [ "$CI_PULL_REQUEST" = "$ov_prnumber" ]; then + for package in ${auto_overlay_map[$project]}; do + new_opam_override_urls="$package.dev git+$ov_url#$ov_ref $new_opam_override_urls" + done + fi + } + for overlay in dev/ci/user-overlays/*.sh; do + # the directory can be empty + if [ -e "$overlay" ]; then + . "$overlay" + fi + done +fi + echo "DEBUG: ocaml -version = $(ocaml -version)" echo "DEBUG: working_dir = $working_dir" echo "DEBUG: new_ocaml_switch = $new_ocaml_switch" @@ -111,6 +143,7 @@ echo "DEBUG: old_opam_override_urls = $old_opam_override_urls" echo "DEBUG: coq_pr_number = $coq_pr_number" echo "DEBUG: coq_pr_comment_id = $coq_pr_comment_id" echo "DEBUG: coq_native = $coq_native" +echo "DEBUG: auto_overlays = $auto_overlays" # We put local binaries such as opam in .bin and extend PATH BIN=$(pwd)/.bin @@ -190,12 +223,6 @@ if [ ! -w "$working_dir" ]; then exit 1 fi -coq_opam_packages_on_separate_lines=$(echo "$coq_opam_packages" | sed 's/ /\n/g') -if [ $(echo "$coq_opam_packages_on_separate_lines" | wc -l) != $(echo "$coq_opam_packages_on_separate_lines" | sort | uniq | wc -l) ]; then - echo "ERROR: The provided set of OPAM packages contains duplicates." - exit 1 -fi - # -------------------------------------------------------------------------------- # Tell coqbot to update the initial comment, if we know which one to update @@ -679,6 +706,10 @@ $skipped_packages" done done +# postprocess full vosize log (sort by % change then absolute change) +sort -r -n -k 5 -k 4 "$log_dir/vosize.log" > "$log_dir/vosize.sorted.log" +mv "$log_dir/vosize.sorted.log" "$log_dir/vosize.log" + # Since we do not upload all files, store a list of the files # available so that if we at some point want to tweak which files we # upload, we'll know which ones are available for upload diff --git a/dev/bench/benchUtil.ml b/dev/bench/benchUtil.ml index 1e5e2d57b070..5124e87101e8 100644 --- a/dev/bench/benchUtil.ml +++ b/dev/bench/benchUtil.ml @@ -32,9 +32,14 @@ type memory = { minor_words : string; major_collect : int; minor_collect : int; + heap_words : int option; } -type data = { time : measure; memory : memory option; instructions : int option } +type data = { + time : measure; + memory : memory option; + instructions : int option; +} let dummy_data = { time = dummy_measure; memory = None; instructions = None } diff --git a/dev/bench/benchUtil.mli b/dev/bench/benchUtil.mli index 13a7ccaeee33..b098b0578ea7 100644 --- a/dev/bench/benchUtil.mli +++ b/dev/bench/benchUtil.mli @@ -29,9 +29,14 @@ type memory = { minor_words : string; major_collect : int; minor_collect : int; + heap_words : int option; } -type data = { time : measure; memory : memory option; instructions : int option } +type data = { + time : measure; + memory : memory option; + instructions : int option; +} val dummy_data : data diff --git a/dev/bench/htmloutput.ml b/dev/bench/htmloutput.ml index e8b76af07d6c..0dbe6cd05747 100644 --- a/dev/bench/htmloutput.ml +++ b/dev/bench/htmloutput.ml @@ -42,16 +42,22 @@ let pp_collect ~need_comma which c = (if need_comma then ", " else "") c which (if c = 1 then "collection" else "collections") +let pp_heap ~need_comma = function + | None -> need_comma, "" + | Some heap -> + true, Printf.sprintf "%s%.3G w max heap size" (if need_comma then ", " else "") (float_of_int heap) + let pp_memory ch = function | None -> () - | Some {major_words; minor_words; major_collect; minor_collect} -> + | Some {major_words; minor_words; major_collect; minor_collect; heap_words} -> (* need_comma <-> prefix is nontrivial *) let need_comma, minor_words = pp_words ~need_comma:false "minor" minor_words in let need_comma, major_words = pp_words ~need_comma "major" major_words in let need_comma, minor_collect = pp_collect ~need_comma "minor" minor_collect in let need_comma, major_collect = pp_collect ~need_comma "major" major_collect in + let need_comma, heap = pp_heap ~need_comma heap_words in if need_comma then - Printf.fprintf ch " (%s%s%s%s)" minor_words major_words minor_collect major_collect + Printf.fprintf ch " (%s%s%s%s%s)" minor_words major_words minor_collect major_collect heap let pp_instr ch = function | None -> () @@ -68,7 +74,7 @@ let totals = Array.fold_left (fun acc (_,data) -> all_data in -let maxq = +let maxtime = Array.fold_left (fun max (_,data) -> Array.fold_left (fun max d -> let dq = d.time.q in @@ -79,6 +85,18 @@ let maxq = Q.zero all_data in +let maxheap = + Array.fold_left (fun max (_,data) -> + Array.fold_left (fun max d -> + Option.fold_left (fun max mem -> + Option.fold_left (fun max heap -> Stdlib.max max heap) + max mem.heap_words) + max d.memory) + max + data) + 0 all_data +in + let () = out {| @@ -91,14 +109,16 @@ in let () = data_files |> Array.iteri (fun i _ -> let color = colors.(i) in out -{|.time%d { +{|.measure%d { background-color: %s; height: %d%%; top: %d%%; z-index: -1; position: absolute; - opacity: 50%%; + opacity: 0%%; } +#time:checked ~ pre .time { opacity: 50%%; } +#memory:checked ~ pre .memory { opacity: 50%%; } |} (i+1) color (100 / ndata) (100 / ndata * i)) in @@ -139,6 +159,17 @@ in let () = out "\n" in +let () = + out {| +|} +in + +let () = + if maxheap > 0 then + out {| +|} +in + let () = out "
" in
 
 let last_seen_line = ref 0 in
@@ -162,9 +193,14 @@ Line: %d
     let () = out {|">|} in
 
     let () = data |> Array.iteri (fun k d ->
-        out {|
|}
+        out {|
|}
           (k+1)
-          (percentage d.time.q ~max:maxq))
+          (percentage d.time.q ~max:maxtime);
+        let heap = Option.bind d.memory (fun m -> m.heap_words) in
+        heap |> Option.iter (fun heap ->
+            out {|
|}
+              (k+1)
+              (percentage (Q.of_int heap) ~max:(Q.of_int maxheap))))
     in
 
     let text = loc.text in
diff --git a/dev/bench/profparser.ml b/dev/bench/profparser.ml
index c4ebfca28ccd..c63bb06f4def 100644
--- a/dev/bench/profparser.ml
+++ b/dev/bench/profparser.ml
@@ -116,6 +116,9 @@ let mk_memory (lnum, l) =
       minor_words = YBU.(to_string @@ member "minor_words" args);
       major_collect = YBU.(to_int @@ member "major_collect" args);
       minor_collect = YBU.(to_int @@ member "minor_collect" args);
+      heap_words =
+        (try Some YBU.(to_int @@ member "heap_words" args)
+         with YBU.Type_error _ -> None);
     }
   with YBU.Type_error (msg,_) -> die "line %d: %s" lnum msg
 
@@ -139,7 +142,8 @@ let mk_time start stop =
 
 let get_instr (lnum, l) =
   let args = assoc "args" l in
-  YBU.(to_int @@ member "instr" args)
+  try Some YBU.(to_int @@ member "instr" args)
+  with YBU.Type_error _ -> None
 
 let rec process_cmds acc = function
   | [] -> acc
@@ -150,7 +154,7 @@ let rec process_cmds acc = function
     let src_chars = get_src_chars ~lnum:(fst start_event) hdr in
     let time = mk_time start_ts end_ts in
     let memory = mk_memory end_event in
-    let instructions = Some (get_instr end_event) in
+    let instructions = get_instr end_event in
     process_cmds ((src_chars, { time; memory; instructions; }) :: acc) rest
   | [_] -> die "ill parenthesized events"
 
diff --git a/dev/bench/timelog2html.ml b/dev/bench/timelog2html.ml
index f789028223f3..730d483cd87b 100644
--- a/dev/bench/timelog2html.ml
+++ b/dev/bench/timelog2html.ml
@@ -74,7 +74,7 @@ let file_data data_file =
     data_file, CArray.of_list data
   else
     let data = Timelogparser.parse ~file:data_file in
-    data_file, data |> CArray.map_of_list (fun (loc, time) -> loc, { BenchUtil.time; memory = None; instructions = None })
+    data_file, data |> CArray.map_of_list (fun (loc, time) -> loc, { BenchUtil.dummy_data with time; })
 
 let main args =
   let opts, (vfile, data_files) = parse_args defaults args in
diff --git a/dev/ci/README-developers.md b/dev/ci/README-developers.md
index 1141b8771a79..c7d46ab0b486 100644
--- a/dev/ci/README-developers.md
+++ b/dev/ci/README-developers.md
@@ -164,6 +164,22 @@ a global build. This is very convenient when using `merlin` as you
 will get a coherent view of all the broken plugins, with full
 incremental cross-project rebuild.
 
+### Merlin for plugins in _build_ci
+
+Merlin can be made to use the locally built Rocq when looking at plugins files in `_build_ci`.
+
+- for plugins built with `rocq makefile` (eg `bignums`): add `make
+  .merlin` to the CI script (after "configure" commands if any), or
+  source `ci-env.sh` and run `make .merlin` in the plugin's directory.
+
+- for plugins built with `dune`: use composed build: uncomment `(dirs
+  (:standard _build_ci))` in Rocq's toplevel `dune` file, then run
+  `dune build @check`. Do not commit the modified Rocq dune file.
+
+  `dune build @check` will test every project in your `_build_ci`
+  which has dune files. To restrict to a specific project `foo`, add a
+  file `_build_ci/dune` containing `(dirs foo)`.
+
 Advanced GitLab CI information
 ------------------------------
 
diff --git a/dev/ci/README-users.md b/dev/ci/README-users.md
index 1143681eca02..bd5033e692cb 100644
--- a/dev/ci/README-users.md
+++ b/dev/ci/README-users.md
@@ -81,9 +81,8 @@ as "plugins"] do have some special requirements:
 ### Add your project by submitting a pull request
 
 Add a new `ci-mydev.sh` script to [`dev/ci/scripts`](scripts); 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.
+variables in [`ci-basic-overlay.sh`](ci-basic-overlay.sh); add dependency information (if nontrivial) to [`Makefile.ci`](../../Makefile.ci) and a new job to
+[`.gitlab-ci.yml`](../../.gitlab-ci.yml) so that this new script is run.
 Have a look at [#17241](https://github.com/rocq-prover/rocq/pull/17241/files) for an
 example. **Do not hesitate to submit an incomplete pull request if you need
 help to finish it.**
@@ -94,8 +93,8 @@ Some important points:
   [`ci-basic-overlay.sh`](ci-basic-overlay.sh).
 
 - Let `$job` be the name of the new job as used for the name of
-  the added script file `dev/ci/scripts/ci-$job.sh`. Then the added target
-  in `Makefile.ci` must be named `ci-$job` and the added job in
+  the added script file `dev/ci/scripts/ci-$job.sh`. This implicitly adds a target
+  in `Makefile.ci` named `ci-$job` and the added job in
   `.gitlab-ci.yml` must be named `library:$job` or
   `plugin:$job`. `$job` must be a valid shell variable name,
   typically this means replacing dashs (`-`) with underscores (`_`).
diff --git a/dev/ci/ci-basic-overlay.sh b/dev/ci/ci-basic-overlay.sh
index 31b0d1534e14..b97e041df281 100644
--- a/dev/ci/ci-basic-overlay.sh
+++ b/dev/ci/ci-basic-overlay.sh
@@ -62,6 +62,12 @@ function subproject {
   : "${!var_submodule_branch:=$submodule_branch}"
 }
 
+########################################################################
+# Micromega
+########################################################################
+project micromega "https://github.com/rocq-community/micromega-plugin" "master"
+# Contact @proux01 on github
+
 ########################################################################
 # MathComp
 ########################################################################
@@ -77,9 +83,6 @@ project oddorder "https://github.com/math-comp/odd-order" "master"
 project mczify "https://github.com/math-comp/mczify" "master"
 # Contact @pi8027 on github
 
-project algebra_tactics "https://github.com/math-comp/algebra-tactics" "master"
-# Contact @pi8027, @proux01 on github
-
 project finmap "https://github.com/math-comp/finmap" "master"
 # Contact @CohenCyril on github
 
@@ -266,15 +269,15 @@ project coinduction "https://github.com/damien-pous/coinduction" "master"
 # Contact @damien-pous on github
 
 ########################################################################
-# coq-lsp
+# rocq-lsp
 ########################################################################
-project coq_lsp "https://github.com/ejgallego/coq-lsp" "main"
-# Contact @ejgallego on github
+project rocq_lsp "https://github.com/rocq-community/rocq-lsp" "main"
+# Contact @SkySkimmer on github
 
 ########################################################################
 # Equations
 ########################################################################
-project equations "https://github.com/mattam82/Coq-Equations" "main"
+project equations "https://github.com/rocq-prover/equations" "main"
 # Contact @mattam82 on github
 
 ########################################################################
@@ -549,5 +552,5 @@ project autosubst_ocaml "https://github.com/uds-psl/autosubst-ocaml" "master"
 ########################################################################
 # Trakt
 ########################################################################
-project trakt "https://github.com/ecranceMERCE/trakt" "coq-master"
+project trakt "https://github.com/rocq-trakt/trakt" "coq-master"
 # Contact @ckeller on github
diff --git a/dev/ci/ci-reset.sh b/dev/ci/ci-reset.sh
index b591bd7354ac..4bdd9d4cba34 100755
--- a/dev/ci/ci-reset.sh
+++ b/dev/ci/ci-reset.sh
@@ -11,6 +11,16 @@ ci_dir="$(dirname "$0")"
 git_reset()
 {
   local project=$1
+
+  # Special handling of iris reverse deps, see ci-iris.sh
+  if [ "$project" = "iris" ]; then
+    iris_CI_REF=$(grep -F '"rocq-iris-heap-lang"' < "${CI_BUILD_DIR}"/iris_examples/*-iris-examples.opam | sed 's/.*"dev\.[0-9][0-9.-]*\.\([0-9a-z][0-9a-z]*\)".*/\1/')
+  [ -n "$iris_CI_REF" ] || { echo "Could not find Iris dependency version" && exit 1; }
+  elif [ "$project" = "stdpp" ]; then
+    stdpp_CI_REF=$(grep -F '"rocq-stdpp"' < "${CI_BUILD_DIR}/iris/rocq-iris.opam" | sed 's/.*"dev\.[0-9][0-9.-]*\.\([0-9a-z][0-9a-z]*\)".*/\1/')
+    [ -n "$stdpp_CI_REF" ] || { echo "Could not find stdpp dependency version" && exit 1; }
+  fi
+
   local dest="${CI_BUILD_DIR}/$project"
   local ref_var="${project}_CI_REF"
   local ref="${!ref_var}"
diff --git a/dev/ci/docker/edge_ubuntu/Dockerfile b/dev/ci/docker/edge_ubuntu/Dockerfile
index e89cfb23ba1b..f2f6b68bd3bc 100644
--- a/dev/ci/docker/edge_ubuntu/Dockerfile
+++ b/dev/ci/docker/edge_ubuntu/Dockerfile
@@ -56,7 +56,7 @@ ENV COMPILER="4.14.2" \
     BASE_OPAM="zarith.1.13 ounit2.2.2.6 camlzip.1.13" \
     CI_OPAM="ocamlgraph.2.0.0 cppo.1.6.9" \
     BASE_OPAM_EDGE="dune.3.14.0 dune-build-info.3.14.0 dune-release.2.0.0 ocamlfind.1.9.6 odoc.2.3.1" \
-    CI_OPAM_EDGE="elpi.3.0.1 ppx_import.1.10.0 cmdliner.1.1.1 sexplib.v0.15.1 ppx_sexp_conv.v0.15.1 ppx_hash.v0.15.0 ppx_compare.v0.15.0 ppx_deriving_yojson.3.7.0 yojson.2.1.0 uri.4.2.0 ppx_yojson_conv.v0.15.1 ppx_inline_test.v0.15.1 ppx_assert.v0.15.0 ppx_optcomp.v0.15.0 lsp.1.16.2 sel.0.8.0" \
+    CI_OPAM_EDGE="memprof-limits.0.3.0 elpi.3.7.1 ppx_import.1.10.0 cmdliner.1.1.1 sexplib.v0.15.1 ppx_sexp_conv.v0.15.1 ppx_hash.v0.15.0 ppx_compare.v0.15.0 ppx_deriving_yojson.3.7.0 yojson.2.1.0 uri.4.2.0 ppx_yojson_conv.v0.15.1 ppx_inline_test.v0.15.1 ppx_assert.v0.15.0 ppx_optcomp.v0.15.0 lsp.1.16.2 sel.0.8.0" \
     COQIDE_OPAM_EDGE="lablgtk3-sourceview3.3.1.3"
 
 # EDGE+flambda switch, we install CI_OPAM as to be able to use
diff --git a/dev/ci/scripts/ci-algebra_tactics.sh b/dev/ci/scripts/ci-algebra_tactics.sh
deleted file mode 100644
index a8b6b5c63ea7..000000000000
--- a/dev/ci/scripts/ci-algebra_tactics.sh
+++ /dev/null
@@ -1,17 +0,0 @@
-#!/usr/bin/env bash
-
-set -e
-
-ci_dir="$(dirname "$0")"
-. "${ci_dir}/ci-common.sh"
-
-git_download algebra_tactics
-
-if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi
-
-export COQEXTRAFLAGS='-native-compiler no'
-
-( cd "${CI_BUILD_DIR}/algebra_tactics"
-  make
-  make install
-)
diff --git a/dev/ci/scripts/ci-common.sh b/dev/ci/scripts/ci-common.sh
index 7416decce4d9..fb163b5764ae 100644
--- a/dev/ci/scripts/ci-common.sh
+++ b/dev/ci/scripts/ci-common.sh
@@ -144,7 +144,7 @@ git_download()
     mkdir -p "$dest"
     pushd "$dest"
     local commit
-    commit=$(git ls-remote "$giturl" "refs/heads/$ref" | cut -f 1)
+    commit=$(git ls-remote --branches "$giturl" "refs/heads/$ref" | cut -f 1)
     if [[ "$commit" == "" ]]; then
       # $ref must have been a tag or hash, not a branch
       commit="$ref"
diff --git a/dev/ci/scripts/ci-elpi.sh b/dev/ci/scripts/ci-elpi.sh
index daa2e12ab4c5..77eab990c85d 100644
--- a/dev/ci/scripts/ci-elpi.sh
+++ b/dev/ci/scripts/ci-elpi.sh
@@ -11,7 +11,6 @@ if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi
 
 ( cd "${CI_BUILD_DIR}/elpi"
   touch dune-workspace
-  make dune-files
   dune build --root  . --only-packages=rocq-elpi @install
   dune install --root . rocq-elpi --prefix="$CI_INSTALL_DIR"
 )
diff --git a/dev/ci/scripts/ci-elpi_test.sh b/dev/ci/scripts/ci-elpi_test.sh
index 845ea61494e9..885e622a2eee 100644
--- a/dev/ci/scripts/ci-elpi_test.sh
+++ b/dev/ci/scripts/ci-elpi_test.sh
@@ -8,6 +8,6 @@ ci_dir="$(dirname "$0")"
 if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi
 
 ( cd "${CI_BUILD_DIR}/elpi"
-  make -j1 all-tests
+  make -j1 all-tests-no-plugins
   make -j1 all-examples
 )
diff --git a/dev/ci/scripts/ci-iris.sh b/dev/ci/scripts/ci-iris.sh
index c8392d52477f..d9f53fba921f 100644
--- a/dev/ci/scripts/ci-iris.sh
+++ b/dev/ci/scripts/ci-iris.sh
@@ -8,7 +8,7 @@ ci_dir="$(dirname "$0")"
 git_download iris_examples
 
 # Extract required version of Iris (avoiding "+" which does not work on MacOS :( *)
-iris_CI_REF=$(grep -F '"rocq-iris-heap-lang"' < "${CI_BUILD_DIR}/iris_examples/coq-iris-examples.opam" | sed 's/.*"dev\.[0-9][0-9.-]*\.\([0-9a-z][0-9a-z]*\)".*/\1/')
+iris_CI_REF=$(grep -F '"rocq-iris-heap-lang"' < "${CI_BUILD_DIR}"/iris_examples/*-iris-examples.opam | sed 's/.*"dev\.[0-9][0-9.-]*\.\([0-9a-z][0-9a-z]*\)".*/\1/')
 [ -n "$iris_CI_REF" ] || { echo "Could not find Iris dependency version" && exit 1; }
 
 # Download Iris
diff --git a/dev/ci/scripts/ci-mathcomp_test.sh b/dev/ci/scripts/ci-mathcomp_test.sh
index d960a4aa7d1d..37b66a409946 100644
--- a/dev/ci/scripts/ci-mathcomp_test.sh
+++ b/dev/ci/scripts/ci-mathcomp_test.sh
@@ -7,6 +7,8 @@ ci_dir="$(dirname "$0")"
 
 if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi
 
+export COQEXTRAFLAGS='-native-compiler no'
+
 ( cd "${CI_BUILD_DIR}/mathcomp"
   make test-suite
 )
diff --git a/dev/ci/scripts/ci-micromega.sh b/dev/ci/scripts/ci-micromega.sh
new file mode 100644
index 000000000000..b198faa63f5b
--- /dev/null
+++ b/dev/ci/scripts/ci-micromega.sh
@@ -0,0 +1,15 @@
+#!/usr/bin/env bash
+
+set -e
+
+ci_dir="$(dirname "$0")"
+. "${ci_dir}/ci-common.sh"
+
+git_download micromega
+
+if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi
+
+( cd "${CI_BUILD_DIR}/micromega"
+  dune build --root . --only-packages=rocq-micromega-plugin @install
+  dune install --root . rocq-micromega-plugin --prefix=$CI_INSTALL_DIR
+)
diff --git a/dev/ci/scripts/ci-refman.sh b/dev/ci/scripts/ci-refman.sh
index e53eea181403..fabf480d3f04 100644
--- a/dev/ci/scripts/ci-refman.sh
+++ b/dev/ci/scripts/ci-refman.sh
@@ -7,7 +7,17 @@ ci_dir="$(dirname "$0")"
 
 if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi
 
-sed -i.bak doc/dune -e '/package coq-core/ d'
-sed -i.bak doc/dune -e '/package rocq-core/ d'
-ROCQRST_EXTRA=all dune build --no-buffer @refman-html
-ROCQRST_EXTRA=all dune build --no-buffer @refman-pdf
+root=$PWD
+
+make doc/unreleased.rst
+
+mkdir -p "$CI_BUILD_DIR/refman"
+cd "$CI_BUILD_DIR/refman"
+
+export ROCQRST_EXTRA=all
+export PYTHONPATH="$root/_build/default/config:$root/doc/tools:$PYTHONPATH"
+
+sphinx-build -q -W -b html "$root/doc/sphinx" -j "$NJOBS" refman-html
+
+sphinx-build -q -W -b latex "$root/doc/sphinx" -j "$NJOBS" refman-pdf
+make -C refman-pdf LATEXMKOPTS=-silent
diff --git a/dev/ci/scripts/ci-coq_lsp.sh b/dev/ci/scripts/ci-rocq_lsp.sh
similarity index 91%
rename from dev/ci/scripts/ci-coq_lsp.sh
rename to dev/ci/scripts/ci-rocq_lsp.sh
index 684a1d386c82..a005985f5671 100644
--- a/dev/ci/scripts/ci-coq_lsp.sh
+++ b/dev/ci/scripts/ci-rocq_lsp.sh
@@ -5,7 +5,7 @@ set -e
 ci_dir="$(dirname "$0")"
 . "${ci_dir}/ci-common.sh"
 
-git_download coq_lsp
+git_download rocq_lsp
 
 if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi
 
@@ -14,7 +14,7 @@ if [ -n "${GITLAB_CI}" ]; then
   export ROCQRUNTIMELIB="$PWD/_install_ci/lib/rocq-runtime"
 fi
 
-( cd "${CI_BUILD_DIR}/coq_lsp"
+( cd "${CI_BUILD_DIR}/rocq_lsp"
   dune build --root . --only-packages=coq-lsp @install
   # Tests
   _build/install/default/bin/coq-lsp --version
diff --git a/dev/ci/user-overlays/20812-SkySkimmer-extensible-attributes.sh b/dev/ci/user-overlays/20812-SkySkimmer-extensible-attributes.sh
new file mode 100644
index 000000000000..b7ff01607f0e
--- /dev/null
+++ b/dev/ci/user-overlays/20812-SkySkimmer-extensible-attributes.sh
@@ -0,0 +1 @@
+overlay mtac2 https://github.com/SkySkimmer/Mtac2 extensible-attributes 20812
diff --git a/dev/ci/user-overlays/21450-TDiazT-elab-sorts.sh b/dev/ci/user-overlays/21450-TDiazT-elab-sorts.sh
new file mode 100644
index 000000000000..007c47f501bc
--- /dev/null
+++ b/dev/ci/user-overlays/21450-TDiazT-elab-sorts.sh
@@ -0,0 +1 @@
+overlay equations https://github.com/TDiazT/Coq-Equations elab-sorts 21450
diff --git a/dev/ci/user-overlays/21521-mattam82-strat-pattern-ltac.sh b/dev/ci/user-overlays/21521-mattam82-strat-pattern-ltac.sh
new file mode 100644
index 000000000000..b1b542a945fb
--- /dev/null
+++ b/dev/ci/user-overlays/21521-mattam82-strat-pattern-ltac.sh
@@ -0,0 +1 @@
+overlay tactician https://github.com/mattam82/coq-tactician strat-pattern-ltac 21521
diff --git a/dev/ci/user-overlays/21531-Yann-Leray-stricter-type-in-type.sh b/dev/ci/user-overlays/21531-Yann-Leray-stricter-type-in-type.sh
new file mode 100644
index 000000000000..094dca07c3fc
--- /dev/null
+++ b/dev/ci/user-overlays/21531-Yann-Leray-stricter-type-in-type.sh
@@ -0,0 +1,3 @@
+overlay hierarchy_builder https://github.com/Yann-Leray/hierarchy-builder stricter-type-in-type 21531
+
+overlay lean_importer https://github.com/Yann-Leray/rocq-lean-import stricter-type-in-type 21531
diff --git a/dev/ci/user-overlays/21542-SkySkimmer-ltac2-scoped-notations.sh b/dev/ci/user-overlays/21542-SkySkimmer-ltac2-scoped-notations.sh
new file mode 100644
index 000000000000..94197871800c
--- /dev/null
+++ b/dev/ci/user-overlays/21542-SkySkimmer-ltac2-scoped-notations.sh
@@ -0,0 +1 @@
+overlay waterproof https://github.com/SkySkimmer/coq-waterproof ltac2-scoped-notations 21542
diff --git a/dev/ci/user-overlays/21566-SkySkimmer-build-by-status.sh b/dev/ci/user-overlays/21566-SkySkimmer-build-by-status.sh
new file mode 100644
index 000000000000..973f169ddcb8
--- /dev/null
+++ b/dev/ci/user-overlays/21566-SkySkimmer-build-by-status.sh
@@ -0,0 +1 @@
+overlay rewriter https://github.com/SkySkimmer/rewriter build-by-status 21566
diff --git a/dev/ci/user-overlays/21568-SkySkimmer-gentac-up.sh b/dev/ci/user-overlays/21568-SkySkimmer-gentac-up.sh
new file mode 100644
index 000000000000..fe6f23d6404e
--- /dev/null
+++ b/dev/ci/user-overlays/21568-SkySkimmer-gentac-up.sh
@@ -0,0 +1,5 @@
+overlay tactician https://github.com/SkySkimmer/coq-tactician gentac-up 21568
+
+overlay mtac2 https://github.com/SkySkimmer/Mtac2 gentac-up 21568
+
+overlay waterproof https://github.com/SkySkimmer/coq-waterproof gentac-up 21568
diff --git a/dev/ci/user-overlays/21571-SkySkimmer-rew-strar-ast.sh b/dev/ci/user-overlays/21571-SkySkimmer-rew-strar-ast.sh
new file mode 100644
index 000000000000..254a0c012094
--- /dev/null
+++ b/dev/ci/user-overlays/21571-SkySkimmer-rew-strar-ast.sh
@@ -0,0 +1 @@
+overlay tactician https://github.com/SkySkimmer/coq-tactician rew-strar-ast 21571
diff --git a/dev/ci/user-overlays/21572-ppedrot-move-ftactic-to-ltac.sh b/dev/ci/user-overlays/21572-ppedrot-move-ftactic-to-ltac.sh
new file mode 100644
index 000000000000..a0edda9833b1
--- /dev/null
+++ b/dev/ci/user-overlays/21572-ppedrot-move-ftactic-to-ltac.sh
@@ -0,0 +1,5 @@
+overlay elpi https://github.com/ppedrot/coq-elpi move-ftactic-to-ltac 21572
+
+overlay equations https://github.com/ppedrot/Coq-Equations move-ftactic-to-ltac 21572
+
+overlay tactician https://github.com/ppedrot/coq-tactician move-ftactic-to-ltac 21572
diff --git a/dev/ci/user-overlays/21574-SkySkimmer-genconstr.sh b/dev/ci/user-overlays/21574-SkySkimmer-genconstr.sh
new file mode 100644
index 000000000000..199f6ce7e9ae
--- /dev/null
+++ b/dev/ci/user-overlays/21574-SkySkimmer-genconstr.sh
@@ -0,0 +1,5 @@
+overlay tactician https://github.com/SkySkimmer/coq-tactician genconstr 21574
+
+overlay elpi https://github.com/SkySkimmer/coq-elpi genconstr 21574
+
+overlay equations https://github.com/SkySkimmer/Coq-Equations genconstr 21574
diff --git a/dev/ci/user-overlays/21617-SkySkimmer-tac2abbrev-up.sh b/dev/ci/user-overlays/21617-SkySkimmer-tac2abbrev-up.sh
new file mode 100644
index 000000000000..2066fe7cee89
--- /dev/null
+++ b/dev/ci/user-overlays/21617-SkySkimmer-tac2abbrev-up.sh
@@ -0,0 +1 @@
+overlay ltac2_compiler https://github.com/SkySkimmer/coq-ltac2-compiler tac2abbrev-up 21617
diff --git a/dev/ci/user-overlays/21627-SkySkimmer-intern-constr-in-tac.sh b/dev/ci/user-overlays/21627-SkySkimmer-intern-constr-in-tac.sh
new file mode 100644
index 000000000000..bbfb664490b7
--- /dev/null
+++ b/dev/ci/user-overlays/21627-SkySkimmer-intern-constr-in-tac.sh
@@ -0,0 +1,3 @@
+overlay elpi https://github.com/SkySkimmer/coq-elpi intern-constr-in-tac 21627
+
+overlay tactician https://github.com/SkySkimmer/coq-tactician intern-constr-in-tac 21627
diff --git a/dev/ci/user-overlays/21630-SkySkimmer-geninterp-ltac.sh b/dev/ci/user-overlays/21630-SkySkimmer-geninterp-ltac.sh
new file mode 100644
index 000000000000..530d15f2bfb0
--- /dev/null
+++ b/dev/ci/user-overlays/21630-SkySkimmer-geninterp-ltac.sh
@@ -0,0 +1,7 @@
+overlay elpi https://github.com/SkySkimmer/coq-elpi geninterp-ltac 21630
+
+overlay equations https://github.com/SkySkimmer/Coq-Equations geninterp-ltac 21630
+
+overlay tactician https://github.com/SkySkimmer/coq-tactician geninterp-ltac 21630
+
+overlay relation_algebra https://github.com/SkySkimmer/relation-algebra geninterp-ltac 21630
diff --git a/dev/ci/user-overlays/21646-SkySkimmer-match-style.sh b/dev/ci/user-overlays/21646-SkySkimmer-match-style.sh
new file mode 100644
index 000000000000..451ac46c8d23
--- /dev/null
+++ b/dev/ci/user-overlays/21646-SkySkimmer-match-style.sh
@@ -0,0 +1,9 @@
+overlay elpi https://github.com/SkySkimmer/coq-elpi match-style 21646
+
+overlay equations https://github.com/SkySkimmer/Coq-Equations match-style 21646
+
+overlay paramcoq https://github.com/SkySkimmer/paramcoq match-style 21646
+
+overlay metarocq https://github.com/SkySkimmer/metarocq match-style 21646
+
+overlay quickchick https://github.com/SkySkimmer/QuickChick match-style 21646
diff --git a/dev/ci/user-overlays/21655-SkySkimmer-genarg-correct-typ.sh b/dev/ci/user-overlays/21655-SkySkimmer-genarg-correct-typ.sh
new file mode 100644
index 000000000000..976f9f2137cc
--- /dev/null
+++ b/dev/ci/user-overlays/21655-SkySkimmer-genarg-correct-typ.sh
@@ -0,0 +1,5 @@
+overlay elpi https://github.com/SkySkimmer/coq-elpi genarg-correct-typ 21655
+
+overlay equations https://github.com/SkySkimmer/Coq-Equations genarg-correct-typ 21655
+
+overlay tactician https://github.com/SkySkimmer/coq-tactician genarg-correct-typ 21655
diff --git a/dev/ci/user-overlays/21669-SkySkimmer-eval-ref.sh b/dev/ci/user-overlays/21669-SkySkimmer-eval-ref.sh
new file mode 100644
index 000000000000..0738af4e38f6
--- /dev/null
+++ b/dev/ci/user-overlays/21669-SkySkimmer-eval-ref.sh
@@ -0,0 +1,3 @@
+overlay metarocq https://github.com/SkySkimmer/metarocq eval-ref 21669
+
+overlay rewriter https://github.com/SkySkimmer/rewriter eval-ref 21669
diff --git a/dev/ci/user-overlays/21680-SkySkimmer-wit-tac-value.sh b/dev/ci/user-overlays/21680-SkySkimmer-wit-tac-value.sh
new file mode 100644
index 000000000000..1eef3b5cccce
--- /dev/null
+++ b/dev/ci/user-overlays/21680-SkySkimmer-wit-tac-value.sh
@@ -0,0 +1,9 @@
+overlay coqhammer https://github.com/SkySkimmer/coqhammer wit-tac-value 21680
+
+overlay elpi https://github.com/SkySkimmer/coq-elpi wit-tac-value 21680
+
+overlay equations https://github.com/SkySkimmer/Coq-Equations wit-tac-value 21680
+
+overlay relation_algebra https://github.com/SkySkimmer/relation-algebra wit-tac-value 21680
+
+overlay metarocq https://github.com/SkySkimmer/metarocq wit-tac-value 21680
diff --git a/dev/ci/user-overlays/21708-gares-elpi-361.sh b/dev/ci/user-overlays/21708-gares-elpi-361.sh
new file mode 100644
index 000000000000..ef43d094af69
--- /dev/null
+++ b/dev/ci/user-overlays/21708-gares-elpi-361.sh
@@ -0,0 +1 @@
+overlay elpi https://github.com/LPCIC/coq-elpi revamp-ltac-API 21708
diff --git a/dev/ci/user-overlays/21737-Yann-Leray-ustate-of-names.sh b/dev/ci/user-overlays/21737-Yann-Leray-ustate-of-names.sh
new file mode 100644
index 000000000000..e9740f2adc11
--- /dev/null
+++ b/dev/ci/user-overlays/21737-Yann-Leray-ustate-of-names.sh
@@ -0,0 +1 @@
+overlay vsrocq https://github.com/Yann-Leray/vsrocq ustate-of-names 21737
diff --git a/dev/ci/user-overlays/21742-FissoreD-mode-class.sh b/dev/ci/user-overlays/21742-FissoreD-mode-class.sh
new file mode 100644
index 000000000000..0d01c1e77fad
--- /dev/null
+++ b/dev/ci/user-overlays/21742-FissoreD-mode-class.sh
@@ -0,0 +1 @@
+overlay elpi https://github.com/FissoreD/coq-elpi coq-21742 21742
diff --git a/dev/ci/user-overlays/21758-gares-fix-ci-elpi-xml.sh b/dev/ci/user-overlays/21758-gares-fix-ci-elpi-xml.sh
new file mode 100644
index 000000000000..deecd1193379
--- /dev/null
+++ b/dev/ci/user-overlays/21758-gares-fix-ci-elpi-xml.sh
@@ -0,0 +1 @@
+overlay elpi https://github.com/LPCIC/coq-elpi fix-rocq-ci 21758
diff --git a/dev/ci/user-overlays/21760-SkySkimmer-simpl-indtypig.sh b/dev/ci/user-overlays/21760-SkySkimmer-simpl-indtypig.sh
new file mode 100644
index 000000000000..609d5840d03a
--- /dev/null
+++ b/dev/ci/user-overlays/21760-SkySkimmer-simpl-indtypig.sh
@@ -0,0 +1 @@
+overlay equations https://github.com/SkySkimmer/Coq-Equations simpl-indtypig 21760
diff --git a/dev/ci/user-overlays/21767-SkySkimmer-qglobal-not-qvar.sh b/dev/ci/user-overlays/21767-SkySkimmer-qglobal-not-qvar.sh
new file mode 100644
index 000000000000..f9e2caf7f5a3
--- /dev/null
+++ b/dev/ci/user-overlays/21767-SkySkimmer-qglobal-not-qvar.sh
@@ -0,0 +1,15 @@
+overlay coqhammer https://github.com/SkySkimmer/coqhammer qglobal-not-qvar 21767
+
+overlay elpi https://github.com/SkySkimmer/coq-elpi qglobal-not-qvar 21767
+
+overlay equations https://github.com/SkySkimmer/Coq-Equations qglobal-not-qvar 21767
+
+overlay lean_importer https://github.com/SkySkimmer/rocq-lean-import qglobal-not-qvar 21767
+
+overlay unicoq https://github.com/SkySkimmer/unicoq qglobal-not-qvar 21767
+
+overlay paramcoq https://github.com/SkySkimmer/paramcoq qglobal-not-qvar 21767
+
+overlay tactician https://github.com/SkySkimmer/coq-tactician qglobal-not-qvar 21767
+
+overlay metarocq https://github.com/SkySkimmer/metarocq qglobal-not-qvar 21767
diff --git a/dev/ci/user-overlays/21811-thomas-lamiaux-genScheme.sh b/dev/ci/user-overlays/21811-thomas-lamiaux-genScheme.sh
new file mode 100644
index 000000000000..815eff3c5b00
--- /dev/null
+++ b/dev/ci/user-overlays/21811-thomas-lamiaux-genScheme.sh
@@ -0,0 +1 @@
+overlay elpi https://github.com/thomas-lamiaux/coq-elpi genScheme 21811
diff --git a/dev/ci/user-overlays/21820-SkySkimmer-only-above.sh b/dev/ci/user-overlays/21820-SkySkimmer-only-above.sh
new file mode 100644
index 000000000000..90728415e951
--- /dev/null
+++ b/dev/ci/user-overlays/21820-SkySkimmer-only-above.sh
@@ -0,0 +1,9 @@
+overlay elpi https://github.com/SkySkimmer/coq-elpi only-above 21820
+
+overlay equations https://github.com/SkySkimmer/Coq-Equations only-above 21820
+
+overlay mtac2 https://github.com/SkySkimmer/Mtac2 only-above 21820
+
+overlay rewriter https://github.com/SkySkimmer/rewriter only-above 21820
+
+overlay waterproof https://github.com/SkySkimmer/coq-waterproof only-above 21820
diff --git a/dev/ci/user-overlays/21833-ppedrot-rm-non-global-hint.sh b/dev/ci/user-overlays/21833-ppedrot-rm-non-global-hint.sh
new file mode 100644
index 000000000000..0669c1521a17
--- /dev/null
+++ b/dev/ci/user-overlays/21833-ppedrot-rm-non-global-hint.sh
@@ -0,0 +1 @@
+overlay waterproof https://github.com/ppedrot/coq-waterproof rm-non-global-hint 21833
diff --git a/dev/ci/user-overlays/21863-ppedrot-constr-type-as-first-order-data.sh b/dev/ci/user-overlays/21863-ppedrot-constr-type-as-first-order-data.sh
new file mode 100644
index 000000000000..967189b6a957
--- /dev/null
+++ b/dev/ci/user-overlays/21863-ppedrot-constr-type-as-first-order-data.sh
@@ -0,0 +1,11 @@
+overlay aac_tactics https://github.com/ppedrot/aac-tactics constr-type-as-first-order-data 21863
+
+overlay equations https://github.com/ppedrot/Coq-Equations constr-type-as-first-order-data 21863
+
+overlay mtac2 https://github.com/ppedrot/Mtac2 constr-type-as-first-order-data 21863
+
+overlay smtcoq https://github.com/ppedrot/smtcoq constr-type-as-first-order-data 21863
+
+overlay stalmarck https://github.com/ppedrot/stalmarck constr-type-as-first-order-data 21863
+
+overlay itauto https://gitlab.inria.fr/pedrot/itauto constr-type-as-first-order-data 21863
diff --git a/dev/ci/user-overlays/21924-gares-bump-elpi-3.7.sh b/dev/ci/user-overlays/21924-gares-bump-elpi-3.7.sh
new file mode 100644
index 000000000000..ba1e75f0838c
--- /dev/null
+++ b/dev/ci/user-overlays/21924-gares-bump-elpi-3.7.sh
@@ -0,0 +1,4 @@
+overlay elpi https://github.com/LPCIC/coq-elpi elpi-3.7 21924
+
+# unneeded and makes HB slower
+# overlay hierarchy_builder https://github.com/math-comp/hierarchy-builder hierarchy-builder.elpi-3.7 21924
diff --git a/dev/ci/user-overlays/21955-SkySkimmer-rm-core.sh b/dev/ci/user-overlays/21955-SkySkimmer-rm-core.sh
new file mode 100644
index 000000000000..b778ec03b189
--- /dev/null
+++ b/dev/ci/user-overlays/21955-SkySkimmer-rm-core.sh
@@ -0,0 +1,17 @@
+overlay coq_performance_tests https://github.com/SkySkimmer/coq-performance-tests rm-core 21955
+
+overlay simple_io https://github.com/SkySkimmer/coq-simple-io rm-core 21955
+
+overlay autosubst_ocaml https://github.com/SkySkimmer/autosubst-ocaml rm-core 21955
+
+overlay coqhammer https://github.com/SkySkimmer/coqhammer rm-core 21955
+
+overlay metarocq https://github.com/SkySkimmer/metarocq rm-core 21955
+
+overlay mtac2 https://github.com/SkySkimmer/Mtac2 rm-core 21955
+
+overlay smtcoq https://github.com/SkySkimmer/smtcoq rm-core 21955
+
+overlay tactician https://github.com/SkySkimmer/coq-tactician rm-core 21955
+
+overlay quickchick https://github.com/SkySkimmer/QuickChick rm-core 21955
diff --git a/dev/ci/user-overlays/21957-SkySkimmer-sort-conflict.sh b/dev/ci/user-overlays/21957-SkySkimmer-sort-conflict.sh
new file mode 100644
index 000000000000..cd4e65282cfc
--- /dev/null
+++ b/dev/ci/user-overlays/21957-SkySkimmer-sort-conflict.sh
@@ -0,0 +1 @@
+overlay rocq_lsp https://github.com/SkySkimmer/rocq-lsp sort-conflict 21957
diff --git a/dev/ci/user-overlays/21986-ppedrot-hints-rm-canord-globref.sh b/dev/ci/user-overlays/21986-ppedrot-hints-rm-canord-globref.sh
new file mode 100644
index 000000000000..e2fbe245f31f
--- /dev/null
+++ b/dev/ci/user-overlays/21986-ppedrot-hints-rm-canord-globref.sh
@@ -0,0 +1 @@
+overlay elpi https://github.com/ppedrot/coq-elpi hints-rm-canord-globref 21986
diff --git a/dev/ci/user-overlays/21987-SkySkimmer-context-secvar.sh b/dev/ci/user-overlays/21987-SkySkimmer-context-secvar.sh
new file mode 100644
index 000000000000..d0bb28df466e
--- /dev/null
+++ b/dev/ci/user-overlays/21987-SkySkimmer-context-secvar.sh
@@ -0,0 +1,34 @@
+overlay equations https://github.com/SkySkimmer/equations context-secvar 21987
+
+overlay elpi https://github.com/SkySkimmer/coq-elpi context-secvar 21987
+
+#overlay mathcomp https://github.com/SkySkimmer/math-comp context-secvar 21987
+
+#overlay tlc https://github.com/SkySkimmer/tlc context-secvar 21987
+
+overlay kami https://github.com/SkySkimmer/kami context-secvar 21987
+# Make PRs against https://github.com/mit-plv/kami base branch rv32i
+
+overlay metarocq https://github.com/SkySkimmer/metarocq context-secvar 21987
+
+overlay bedrock2 https://github.com/SkySkimmer/bedrock2 context-secvar 21987
+# Make PRs against https://github.com/mit-plv/bedrock2 base branch master
+
+overlay coqutil https://github.com/SkySkimmer/coqutil context-secvar 21987
+# Make PRs against https://github.com/mit-plv/coqutil base branch master
+
+overlay fiat_crypto https://github.com/SkySkimmer/fiat-crypto context-secvar 21987
+
+#overlay ceres https://github.com/SkySkimmer/coq-ceres context-secvar 21987
+
+overlay unicoq https://github.com/SkySkimmer/unicoq context-secvar 21987
+
+overlay mtac2 https://github.com/SkySkimmer/Mtac2 context-secvar 21987
+
+overlay rocq_lsp https://github.com/SkySkimmer/rocq-lsp context-secvar 21987
+
+overlay tactician https://github.com/SkySkimmer/coq-tactician context-secvar 21987
+
+overlay vsrocq https://github.com/SkySkimmer/vsrocq context-secvar 21987
+
+overlay waterproof https://github.com/SkySkimmer/coq-waterproof context-secvar 21987
diff --git a/dev/ci/user-overlays/21999-ppedrot-hints-unfolds-use-env-set.sh b/dev/ci/user-overlays/21999-ppedrot-hints-unfolds-use-env-set.sh
new file mode 100644
index 000000000000..d6cd621b042c
--- /dev/null
+++ b/dev/ci/user-overlays/21999-ppedrot-hints-unfolds-use-env-set.sh
@@ -0,0 +1 @@
+overlay equations https://github.com/ppedrot/equations hints-unfolds-use-env-set 21999
diff --git a/dev/ci/user-overlays/22001-SkySkimmer-gene-eqs-vars.sh b/dev/ci/user-overlays/22001-SkySkimmer-gene-eqs-vars.sh
new file mode 100644
index 000000000000..9571c2f59f88
--- /dev/null
+++ b/dev/ci/user-overlays/22001-SkySkimmer-gene-eqs-vars.sh
@@ -0,0 +1,4 @@
+overlay kami https://github.com/SkySkimmer/kami gene-eqs-vars 22001
+# Make PRs against https://github.com/mit-plv/kami base branch rv32i
+
+overlay itree https://github.com/SkySkimmer/InteractionTrees gene-eqs-vars 22001
diff --git a/dev/ci/user-overlays/22016-ppedrot-reduce-sort-quality-of.sh b/dev/ci/user-overlays/22016-ppedrot-reduce-sort-quality-of.sh
new file mode 100644
index 000000000000..7c0a09dc70c3
--- /dev/null
+++ b/dev/ci/user-overlays/22016-ppedrot-reduce-sort-quality-of.sh
@@ -0,0 +1 @@
+overlay equations https://github.com/ppedrot/equations reduce-sort-quality-of 22016
diff --git a/dev/ci/user-overlays/22070-ppedrot-kernel-abstract-univ-inductive.sh b/dev/ci/user-overlays/22070-ppedrot-kernel-abstract-univ-inductive.sh
new file mode 100644
index 000000000000..a35ea4aee16e
--- /dev/null
+++ b/dev/ci/user-overlays/22070-ppedrot-kernel-abstract-univ-inductive.sh
@@ -0,0 +1,5 @@
+overlay elpi https://github.com/ppedrot/coq-elpi kernel-abstract-univ-inductive 22070
+
+overlay equations https://github.com/ppedrot/equations kernel-abstract-univ-inductive 22070
+
+overlay paramcoq https://github.com/ppedrot/paramcoq kernel-abstract-univ-inductive 22070
diff --git a/dev/ci/user-overlays/22077-SkySkimmer-red-ef-eon.sh b/dev/ci/user-overlays/22077-SkySkimmer-red-ef-eon.sh
new file mode 100644
index 000000000000..10c762601bbb
--- /dev/null
+++ b/dev/ci/user-overlays/22077-SkySkimmer-red-ef-eon.sh
@@ -0,0 +1 @@
+overlay reduction_effects https://github.com/SkySkimmer/reduction-effects red-ef-eon 22077
diff --git a/dev/ci/user-overlays/22090-ppedrot-abstract-context-val.sh b/dev/ci/user-overlays/22090-ppedrot-abstract-context-val.sh
new file mode 100644
index 000000000000..b0028a004e8b
--- /dev/null
+++ b/dev/ci/user-overlays/22090-ppedrot-abstract-context-val.sh
@@ -0,0 +1 @@
+overlay rocq_lsp https://github.com/ppedrot/rocq-lsp abstract-context-val 22090
diff --git a/dev/doc/critical-bugs.md b/dev/doc/critical-bugs.md
index 586dbaf6b980..dae77afd6099 100644
--- a/dev/doc/critical-bugs.md
+++ b/dev/doc/critical-bugs.md
@@ -25,13 +25,22 @@ This file recollects knowledge about critical bugs found in Coq since version 8.
       - [guard checker forgot to check non-structural arguments of fixpoint](#guard-checker-forgot-to-check-non-structural-arguments-of-fixpoint)
       - [guard checker incorrectly detects match on match as returning a subterm](#guard-checker-incorrectly-detects-match-on-match-as-returning-a-subterm)
       - [guard checker does incorrect reduction across inner fixpoint, accepting wrong fixpoints](#guard-checker-does-incorrect-reduction-across-inner-fixpoint-accepting-wrong-fixpoints)
+      - [guard checker does not account for cross calls to compute uniform arguments of a nested mutual fixpoint](#guard-checker-does-not-account-for-cross-calls-to-compute-uniform-arguments-of-a-nested-mutual-fixpoint)
+      - [guard checker does not check for correct recursive calls when passed as uniform argument in a nested fixpoint](#guard-checker-does-not-check-for-correct-recursive-calls-when-passed-as-uniform-argument-in-a-nested-fixpoint)
+      - [guard checker does not count argument-less recursive calls to compute uniform arguments of a nested mutual fixpoint](#guard-checker-does-not-count-argument-less-recursive-calls-to-compute-uniform-arguments-of-a-nested-mutual-fixpoint)
+      - [guard checker does not check arguments of recursive calls in uniformity analysis](#guard-checker-does-not-check-arguments-of-recursive-calls-in-uniformity-analysis)
+      - [guard checker sometimes does reduction in the wrong context, accepting wrong fixpoints](#guard-checker-sometimes-does-reduction-in-the-wrong-context-accepting-wrong-fixpoints)
+      - [guard checker sometimes forgets to check lambda domains in nested fixpoints](#guard-checker-sometimes-forgets-to-check-lambda-domains-in-nested-fixpoints)
     - [Module system](#module-system)
       - [missing universe constraints in typing "with" clause of a module type](#missing-universe-constraints-in-typing-with-clause-of-a-module-type)
       - [universe constraints for module subtyping not stored in vo files](#universe-constraints-for-module-subtyping-not-stored-in-vo-files)
       - [module subtyping disrespected squashing status of inductives](#module-subtyping-disrespected-squashing-status-of-inductives)
       - [Functor inlining drops universe substitution](#functor-inlining-drops-universe-substitution)
       - [Primitives are incorrectly considered convertible to anything by module subtyping](#primitives-are-incorrectly-considered-convertible-to-anything-by-module-subtyping)
-      - [missing substitution when strengthening functors](#missing-substitution-when-strengthening-functors)
+      - [Missing substitution when strengthening functors](#missing-substitution-when-strengthening-functors)
+      - [Missing substitution when strengthening aliased functors](#missing-substitution-when-strengthening-aliased-functors)
+      - [Incorrect subtyping rule for universe polymorphic "with Definition".](#incorrect-subtyping-rule-for-universe-polymorphic-with-definition)
+      - [Subtyping ignored elimination constraints](#subtyping-ignored-elimination-constraints)
     - [Universes](#universes)
       - [issue with two parameters in the same universe level](#issue-with-two-parameters-in-the-same-universe-level)
       - [universe polymorphism can capture global universes](#universe-polymorphism-can-capture-global-universes)
@@ -40,6 +49,12 @@ This file recollects knowledge about critical bugs found in Coq since version 8.
       - [universe constraints erroneously discarded when forcing an asynchronous proof containing delayed monomorphic constraints inside a universe polymorphic section](#universe-constraints-erroneously-discarded-when-forcing-an-asynchronous-proof-containing-delayed-monomorphic-constraints-inside-a-universe-polymorphic-section)
       - [Set+2 incorrectly simplified to Set+1](#set2-incorrectly-simplified-to-set1)
       - [variance inference for section universes ignored use of section universes in inductives and axioms defined before the inductive being inferred](#variance-inference-for-section-universes-ignored-use-of-section-universes-in-inductives-and-axioms-defined-before-the-inductive-being-inferred)
+      - [Missing substitution for relevance of product domain in lazy](#missing-substitution-for-relevance-of-product-domain-in-lazy)
+      - [Missing stack conversion for irrelevant-to-relevant match](#missing-stack-conversion-for-irrelevant-to-relevant-match)
+      - [Incorrect discharge of sort polymorphic inductive squashing with section polymorphic sort](#incorrect-discharge-of-sort-polymorphic-inductive-squashing-with-section-polymorphic-sort)
+      - [Missing universe substitution in primitive array instance in lazy](#missing-universe-substitution-in-primitive-array-instance-in-lazy)
+      - [Double universe substitution in letins from indices in match return clause](#double-universe-substitution-in-letins-from-indices-in-match-return-clause)
+      - [Double universe substitution in letins from constructor arguments in match branches](#double-universe-substitution-in-letins-from-constructor-arguments-in-match-branches)
     - [Primitive projections](#primitive-projections)
       - [check of guardedness of extra arguments of primitive projections missing](#check-of-guardedness-of-extra-arguments-of-primitive-projections-missing)
       - [records based on primitive projections became possibly recursive without the guard condition being updated](#records-based-on-primitive-projections-became-possibly-recursive-without-the-guard-condition-being-updated)
@@ -64,8 +79,10 @@ This file recollects knowledge about critical bugs found in Coq since version 8.
       - [conversion would compare the mutated version of primitive arrays instead of undoing mutation where needed](#conversion-would-compare-the-mutated-version-of-primitive-arrays-instead-of-undoing-mutation-where-needed)
       - [tactic code could mutate a global cache of values for section variables](#tactic-code-could-mutate-a-global-cache-of-values-for-section-variables)
       - [incorrect handling of universe polymorphism](#incorrect-handling-of-universe-polymorphism)
+      - [Forgotten universe substitution with Register Inline on universe polymorphic definition](#forgotten-universe-substitution-with-register-inline-on-universe-polymorphic-definition)
     - [Side-effects](#side-effects)
       - [polymorphic side-effects inside monomorphic definitions incorrectly handled as not inlined](#polymorphic-side-effects-inside-monomorphic-definitions-incorrectly-handled-as-not-inlined)
+      - [Section variables used in side effects not checked by Proof using](#section-variables-used-in-side-effects-not-checked-by-proof-using)
     - [Forgetting unsafe flags](#forgetting-unsafe-flags)
       - [unsafe typing flags used inside a section would not be reported by Print Assumptions after closing the section](#unsafe-typing-flags-used-inside-a-section-would-not-be-reported-by-print-assumptions-after-closing-the-section)
     - [Conflicts with axioms in library](#conflicts-with-axioms-in-library)
@@ -75,7 +92,7 @@ This file recollects knowledge about critical bugs found in Coq since version 8.
       - [Incorrect specification of PrimFloat.leb](#incorrect-specification-of-primfloatleb)
       - [Incorrect implementation of SFclassify.](#incorrect-implementation-of-sfclassify)
       - [nativenorm reading back closures as arbitrary floating-point values](#nativenorm-reading-back-closures-as-arbitrary-floating-point-values)
-      - [guard condition issue made it inconsistent with univalence](#guard-condition-issue-made-it-inconsistent-with-univalence)
+      - [guard condition issue made it inconsistent with propositional extensionality in library Sets](#guard-condition-issue-made-it-inconsistent-with-propositional-extensionality-in-library-sets)
     - [Deserialization](#deserialization)
       - [deserialization of .vo data not properly checked](#deserialization-of-vo-data-not-properly-checked)
   - [Probably non exploitable fixed bugs](#probably-non-exploitable-fixed-bugs)
@@ -264,11 +281,71 @@ and lack of checking of relevance marks on constants in coqchk
 - introduced: V8.16 ([#15434](https://github.com/rocq-prover/rocq/pull/15434))
 - impacted released versions: V8.16 to V9.0.0
 - impacted coqchk versions: Same
-- fixed in: V9.0.1, V9.1.0
+- fixed in: V9.0.1, V9.1.0 ([#20648](https://github.com/rocq-prover/rocq/issues/20648))
 - found by: Yann Leray
 - exploit / GH issue: [#20555](https://github.com/rocq-prover/rocq/issues/20555)
 - risk: unknown (no development in CI was affected)
 
+#### guard checker does not account for cross calls to compute uniform arguments of a nested mutual fixpoint
+- component: guard checking
+- introduced: V8.20 ([#17986](https://github.com/rocq-prover/rocq/pull/17986))
+- impacted released versions: V8.20, V9.0, V9.1
+- impacted coqchk versions: Same
+- fixed in: V9.2.0 ([#21684](https://github.com/rocq-prover/rocq/pull/21684))
+- found by: Tristan Stérin
+- exploit / GH issue: [#21682](https://github.com/rocq-prover/rocq/issues/21682)
+- risk: unknown (no development in CI was affected)
+
+#### guard checker does not check for correct recursive calls when passed as uniform argument in a nested fixpoint
+- component: guard checking
+- introduced: V9.0.1, V9.1.0 ([#20648](https://github.com/rocq-prover/rocq/issues/20648), see 2 above)
+- impacted released versions: V9.0.1, V9.1.0, V9.1.1
+- impacted coqchk versions: Same
+- fixed in: V9.2.0 ([#21684](https://github.com/rocq-prover/rocq/pull/21684))
+- found by: Tristan Stérin
+- exploit / GH issue: [#21683](https://github.com/rocq-prover/rocq/issues/21683)
+- risk: unknown (no development in CI was affected)
+
+#### guard checker does not count argument-less recursive calls to compute uniform arguments of a nested mutual fixpoint
+- component: guard checking
+- introduced: V8.20 ([#17986](https://github.com/rocq-prover/rocq/pull/17986))
+- impacted released versions: V8.20, V9.0, V9.1
+- impacted coqchk versions: Same
+- fixed in: V9.2.0 ([#21684](https://github.com/rocq-prover/rocq/pull/21684))
+- found by: Tristan Stérin
+- exploit / GH issue: [#21701](https://github.com/rocq-prover/rocq/issues/21701)
+- risk: unknown (no development in CI was affected)
+
+#### guard checker does not check arguments of recursive calls in uniformity analysis
+- component: guard checking
+- introduced: V8.20 ([#17986](https://github.com/rocq-prover/rocq/pull/17986))
+- impacted released versions: V8.20, V9.0, V9.1
+- impacted coqchk versions: Same
+- fixed in: V9.2.0 ([#21798](https://github.com/rocq-prover/rocq/pull/21798))
+- found by: Pierre-Marie Pédrot
+- exploit / GH issue: [#21797](https://github.com/rocq-prover/rocq/issues/21797)
+- risk: unknown (no development in CI was affected)
+
+#### guard checker sometimes does reduction in the wrong context accepting wrong fixpoints
+- component: guard checking
+- introduced: V8.16 ([#15453](https://github.com/rocq-prover/rocq/pull/15453))
+- impacted released versions: V8.16, V8.17, V8.19, V8.20, V9.0, V9.1, V9.2.0
+- impacted coqchk versions: Same
+- fixed in: V9.3 ([#21845](https://github.com/rocq-prover/rocq/pull/21845))
+- found by: Yann Leray
+- exploit / GH issue: [#21839](https://github.com/rocq-prover/rocq/issues/21839)
+- risk: unknown (no development in CI was affected)
+
+#### guard checker sometimes forgets to check lambda domains in nested fixpoints
+- component: guard checking
+- introduced: V8.20 ([#17986](https://github.com/rocq-prover/rocq/pull/17986))
+- impacted released versions: V8.20, V9.0, V9.1, V9.2.0
+- impacted coqchk versions: Same
+- fixed in: V9.2.1, V9.3 ([#22022](https://github.com/rocq-prover/rocq/pull/22022))
+- found by: Yann Leray
+- exploit / GH issue: [#22021](https://github.com/rocq-prover/rocq/issues/22021)
+- risk: low (no known way to exploit the issue)
+
 ### Module system
 
 #### missing universe constraints in typing "with" clause of a module type
@@ -345,6 +422,43 @@ and lack of checking of relevance marks on constants in coqchk
 - exploit: see issue
 - risk: could be exploited by mistake when using heavy module machinery
 
+#### Missing substitution when strengthening aliased functors
+
+- component: modules
+- introduced: 8.5 for the kernel (c5b699f), 8.10 for the checker (#8773)
+- impacted released versions: 8.5-9.1
+- impacted coqchk version: 8.10-9.1
+- fixed in: V9.2.0
+- found by: Tristan Stérin
+- GH issue number: rocq-prover/rocq#21685
+- exploit: see issue
+- risk: could be exploited by mistake when using heavy module machinery
+
+#### Incorrect subtyping rule for universe polymorphic "with Definition".
+
+- component: modules
+- introduced: 8.5
+- impacted released versions: 8.5-9.1
+- impacted coqchk version: none
+- fixed in: V9.2.0
+- found by: Tristan Stérin
+- GH issue number: rocq-prover/rocq#21702
+- exploit: see issue
+- risk: moderate, requires uncommon features
+
+#### Subtyping ignored elimination constraints
+
+- component: modules, sort polymorphism
+- introduced: V9.2+rc1
+- impacted released versions: none
+- impacted coqchk versions: none
+- fixed in: V9.2.0
+- found by: Yann Leray
+- GH issue number: rocq-prover/rocq#21750
+- exploit: see issue
+- risk: high when combining module subyping with sort polymorphism
+  (but not possible in non-rc version)
+
 ### Universes
 
 #### issue with two parameters in the same universe level
@@ -449,6 +563,81 @@ fix.
 - exploit: see rocq-prover/rocq#15916
 - risk: could be used inadvertently in developments with complex universe usage, only when using cumulative inductives declared in sections. coqchk still works.
 
+#### Missing substitution for relevance of product domain in lazy
+
+- component: lazy reduction, sort polymorphism
+- introduced: V8.19 (with sort polymorphism, [1e7473812cec](https://github.com/rocq-prover/rocq/commit/1e7473812cec6e735394ca5f5fbefb9c78600893))
+- impacted released versions: V8.19 to V9.1 including patch releases
+- impacted coqchk versions: same
+- fixed in: V9.2 [rocq-prover/rocq#21697](https://github.com/rocq-prover/rocq/pull/21697)
+- found by: Tristan Stérin, Gaëtan Gilbert
+- exploit: not fully worked out, see bug_21691.v for example error
+- risk: low (needs sort polymorphism and to exploit the incorrect
+  substitution from a reduction done by the kernel instead of in the
+  higher layers)
+
+#### Missing stack conversion for irrelevant-to-relevant match
+
+- component: conversion, SProp
+- introduced: V8.16 ([57081c1ae01a](https://github.com/rocq-prover/rocq/commit/57081c1ae01a742033dec44a2a42bffa08a9f5af))
+  (V8.13 with the introduction of Definitional UIP for the Definitional UIP variant)
+- impacted released versions: V8.16 to V9.1 including patch releases (V8.13 to V9.1 for Definitional UIP variant)
+- impacted coqchk versions: same
+- fixed in: V9.2 [rocq-prover/rocq#21696](https://github.com/rocq-prover/rocq/pull/21696)
+- found by: Tristan Stérin, Gaëtan Gilbert
+- exploit: see bug_21690.v
+- risk: without Definitional UIP, believed to only contradict axioms incompatible with equality reflection (i.e. no axiom-free proof of False).
+  With Definitional UIP, could be used inadvertently.
+
+#### Incorrect discharge of sort polymorphic inductive squashing with section polymorphic sort
+
+- component: sections, sort polymorphism
+- introduced: V9.1 ([0706a177b5cb](https://github.com/rocq-prover/rocq/commit/0706a177b5cb4c829108ec8953d6087161ddb8b4))
+- impacted released versions: V9.1 including patch releases
+- impacted coqchk versions: none
+- fixed in: V9.2 [rocq-prover/rocq#21699](https://github.com/rocq-prover/rocq/pull/21699)
+- found by: Tristan Stérin, Gaëtan Gilbert
+- exploit: bug_21694.v
+- risk: needs a sort polymorphic inductive declared in a section with
+  a section polymorphic sort and sort polymorphism in the inductive command (cf bug file)
+
+#### Missing universe substitution in primitive array instance in lazy
+
+- component: lazy, primitive arrays
+- introduced: V8.17 ([2db83c8a7e5b](https://github.com/rocq-prover/rocq/commit/2db83c8a7e5b823d2c8d25ef07dac40b38408d3c))
+- impacted released versions: V8.17 to V9.1 including patch releases
+- impacted coqchk versions: same
+- fixed in: V9.2 [rocq-prover/rocq#21698](https://github.com/rocq-prover/rocq/pull/21698)
+- found by: Tristan Stérin, Gaëtan Gilbert
+- exploit: not fully worked out, see bug_21692.v for example error
+- risk: low, the instance on primitive array literals is irrelevant for conversion
+
+#### Double universe substitution in letins from indices in match return clause
+
+- component: conversion
+- introduced: V8.14 ([d72e5c154f](https://github.com/rocq-prover/rocq/commit/d72e5c154faeea1d55387bc8c039d97f63ebd1c4))
+- impacted released versions: V8.14 to V9.1 including patch releases
+- impacted coqchk versions: same
+- fixed in: V9.2 [rocq-prover/rocq#21688](https://github.com/rocq-prover/rocq/pull/21688)
+- found by: Gaëtan Gilbert
+- exploit: no full exploit known, anomaly in bug_21689.v
+- risk: low (needs to use universe substitution in letin from the
+  inductive indices to incorrectly convert match return clauses and
+  somehow derive inconsistency from there)
+
+#### Double universe substitution in letins from constructor arguments in match branches
+
+- component: conversion
+- introduced: V8.17 ([2db83c8a7e](https://github.com/rocq-prover/rocq/commit/2db83c8a7e5b823d2c8d25ef07dac40b38408d3c))
+- impacted released versions: V8.17 to V9.2.0
+- impacted coqchk versions: same
+- fixed in: V9.2.1, V9.3 [rocq-prover/rocq#21972](https://github.com/rocq-prover/rocq/pull/21972)
+- found by: Yann Leray
+- exploit: no full exploit known, anomaly in bug_21970.v
+- risk: unknown (needs to use universe substitution in letin from the
+  constructor arguments to incorrectly convert branches
+  and derive inconsistency from there)
+
 ### Primitive projections
 
 #### check of guardedness of extra arguments of primitive projections missing
@@ -725,6 +914,21 @@ For instance `α` and `__U03b1_` were the same in the native compiler.
 - exploit: see issue
 - risk: ??
 
+#### Forgotten universe substitution with Register Inline on universe polymorphic definition
+
+- component: VM and native
+- introduced: V8.5
+- impacted released versions: V8.5-V9.1 (all patch versions)
+- impacted coqchk versions: same (only when using -bytecode-compiler yes)
+- fixed in: V9.2.0
+- found by: Gaëtan Gilbert
+- GH issue number: rocq-prover/rocq#21736
+- exploit: see issue
+- risk: requires Register Inline on universe polymorphic constant
+- additional note: does not seem to be exploitable before 8.8 (until 8.6 Register
+  Inline fails with anomaly on universe polymorphic constants, and before
+  8.8 Register Inline only affects native which fails in ocamlopt)
+
 ### Side-effects
 
 #### polymorphic side-effects inside monomorphic definitions incorrectly handled as not inlined
diff --git a/dev/doc/release-process.md b/dev/doc/release-process.md
index 9ad550d95fb3..bb9c42180737 100644
--- a/dev/doc/release-process.md
+++ b/dev/doc/release-process.md
@@ -10,7 +10,9 @@
 
 - [ ] Create both the upcoming final release (`X.X.0`) and the following major release (`Y.Y+rc1`) milestones if they do not already exist.
 - [ ] Send an announcement of the upcoming branching date on the Rocq development category on Discourse (rocq+rocq-development@discoursemail.com) and ask people to remove from the `X.X+rc1` milestone any feature and clean up PRs that they already know won't be ready on time.
-- [ ] Prepare a PR on `master` (not yet to be merged) changing the version name to the next major version and both magic numbers in [`tools/configure/configure.ml`](../../tools/configure/configure.ml). For example, for `8.5`, the version name will be `8.5+alpha` while the magic numbers will end with `80490`.
+- [ ] Prepare a PR on `master` (not yet to be merged) changing the version to the next minor version in [`tools/configure/configure.ml`](../../tools/configure/configure.ml).
+  For example, for `9.3`, `minor` will be `3`.
+  On master the `patch` value is always `Alpha`, so `rocq -version` will print `9.3+alpha` and the magic number will be `90299` (the release magic will be `90300` so we take the first number before that).
   This PR should be opened before the branching date to have time to deal with CI issues, but should not be merged until branching.
 
 ## On the branching date ##
@@ -18,7 +20,8 @@
 - [ ] Merge the above PR and create the `vX.X` branch from the last merge commit before this one (using this name will ensure that the branch will be automatically protected).
 - [ ] Set the next major version alpha tag using `git tag -s` (you can leave the tag message empty).  The `VY.Y+alpha` tag marks the first commit to be in `master` and not in the `vX.X` release branch (be careful about small `v` for branches and big `V` for tags). Note that this commit is the first commit in the first PR merged in master, not the merge commit for that PR. Therefore, if you proceeded as described above, this should be the commit updating the version and magic numbers.  After tagging, double-check that `git describe` picks up the tag you just made (if not, you tagged the wrong commit).
 - [ ] Push the new tag with `git push upstream VY.Y+alpha --dry-run` (remove the `--dry-run` and redo if everything looks OK).
-- [ ] In the milestone, add to the description a line like `@coqbot: backport to v8.20 (move rejected PRs to: https://github.com/rocq-prover/rocq/milestone/60)`
+- [ ] In the milestone, add to the description a line like `@coqbot: backport to v9.2 (move rejected PRs to: https://github.com/coq/coq/milestone/69)`
+- [ ] If there are still milestones open for previous major releases, complete their description so that the pull requests that are merged in these milestones are also requested for backporting to the new branch. For instance: `@coqbot: backport to v9.1 (move rejected PRs to: https://github.com/rocq-prover/rocq/milestone/66); backport to v9.2 (move rejected PRs to: https://github.com/coq/coq/milestone/69)` (use as many `; ` separated instructions as needed)
 - [ ] Monitor the [Release management project](https://github.com/orgs/rocq-prover/projects/11) in which coqbot will keep track of PRs to be backported (according to the previous command)
   The release manager is the person responsible for merging PRs that target the release branch and backporting appropriate PRs (mostly safe bug fixes, user message improvements and documentation updates) that are merged into `master`.
 - [ ] For major releases, you can create new views in the above project by using the "Duplicate view" button in the menu of the views from the previous major release. After duplicating the view, you can edit the filter to match the field for the new branch, update the fields displayed, rename the view, and "save", so that the view is shared with everyone. This is best done after the first PR requiring backporting has been merged, because the new field will have been created by coqbot at that point.
@@ -47,7 +50,7 @@ Be sure the PR is not draft for better visibility and ask everyone in the dev te
 - [ ] When doing so, add the new milestone to the coqbot command in the description of still-open previous milestones. For instance, when creating a milestone `8.20.1`, if there is an open milestone `8.19.3`, something tagged with the milestone `8.19.3` means: to be backported to the `v8.19` *and* the `v8.20` branches. The coqbot syntax is `@coqbot: backport to v8.19 (move rejected PRs to: ); backport to v8.20 (move rejected PRs to: ); ...`.
 - [ ] Ensure the release changelog has been merged (for release candidates the release summary can be left empty, it is required only for the final release).
 - [ ] In a PR against `vX.X` (for testing):
-  - Update the version number in [`tools/configure/configure.ml`](../../tools/configure/configure.ml).
+  - Update the `patch` version number in [`tools/configure/configure.ml`](../../tools/configure/configure.ml).
   - Only update the magic numbers for the final release.
   - Set `is_a_released_version` to `true`.
 - [ ] Set the tag `VX.X...` using `git tag -s`.
diff --git a/dev/dune-dbg.in b/dev/dune-dbg.in
index a69eba3d738d..f66976fec19c 100755
--- a/dev/dune-dbg.in
+++ b/dev/dune-dbg.in
@@ -47,4 +47,8 @@ while [[ $# -gt 0 ]]; do
 done
 
 export ROCQLIB=$PWD/_build/install/default/lib/coq
-ocamldebug "${opts[@]}" $(ocamlfind query -recursive -i-format rocq-runtime.dev) $(ocamlfind query -i-format -descendants rocq-runtime.vernac) -I +threads -I dev $exe "$@"
+ocamldebug "${opts[@]}" \
+           $(ocamlfind query -recursive -i-format rocq-runtime.dev) \
+           $(ocamlfind query -recursive -i-format rocq-runtime.coqargs) \
+           $(ocamlfind query -i-format -descendants rocq-runtime.vernac) \
+           -I +threads -I dev $exe "$@"
diff --git a/dev/tools/coqdev.el b/dev/tools/coqdev.el
index 15ab26bb3ccf..c8768f55a3fa 100644
--- a/dev/tools/coqdev.el
+++ b/dev/tools/coqdev.el
@@ -194,6 +194,16 @@ Otherwise return `nil'."
      2 (3 . 4) (5 . 6)))
   (add-to-list 'compilation-error-regexp-alist 'coq-backtrace))
 
+;; regexp parser for rocqtop errors in the refman
+(with-eval-after-load 'compile
+  (push
+   '(rocq-refman
+     "\\(sphinx.errors.ExtensionError: .*/_build/default/\\(.*\\):\\(.*\\):\\) Error while sending the following to rocqtop:"
+     2 3 nil nil 1)
+   compilation-error-regexp-alist-alist)
+
+  (push 'rocq-refman compilation-error-regexp-alist))
+
 (defvar bug-reference-bug-regexp)
 (defvar bug-reference-url-format)
 (defun coqdev-setup-bug-reference-mode ()
diff --git a/dev/tools/list-contributors.sh b/dev/tools/list-contributors.sh
index 6afa02b78211..c49bbccdeef0 100755
--- a/dev/tools/list-contributors.sh
+++ b/dev/tools/list-contributors.sh
@@ -1,20 +1,20 @@
 #!/usr/bin/env bash
 # For compat with OSX which has a non-gnu sed which doesn't support -z
-SED=`(which gsed || which sed) 2> /dev/null`
+SED=`(command -v gsed || command -v sed) 2> /dev/null`
 
 if [ $# != 1 ]; then
   echo "usage: $0 rev0..rev1"
   exit 1
 fi
 
-git shortlog -s -n --no-merges --group=author --group=trailer:Co-authored-by $1 | cut -f2 | sort -k 2 | grep -v -e "coqbot" -e "^$" > contributors.tmp
+git shortlog -s -n --no-merges --group=author --group=trailer:Co-authored-by $1 | cut -f2 | sort -k 2 | grep -v -e "coqbot" -e "copilot" -e "^$" > contributors.tmp
 
 cat contributors.tmp | wc -l | xargs echo "Contributors:"
 cat contributors.tmp | $SED -z "s/\n/, /g"
 echo
 rm contributors.tmp
 
-git shortlog -s -n --merges --group=author --group=trailer:Co-authored-by $1 | cut -f2 | sort -k 2 | grep -v -e "coqbot" -e "^$" > assignees.tmp
+git shortlog -s -n --merges --group=author --group=trailer:Co-authored-by $1 | cut -f2 | sort -k 2 | grep -v -e "coqbot" -e "copilot" -e "^$" > assignees.tmp
 
 cat assignees.tmp | wc -l | xargs echo "Assignees:"
 cat assignees.tmp | $SED -z "s/\n/, /g"
diff --git a/dev/tools/with-jobs.sh b/dev/tools/with-jobs.sh
new file mode 100755
index 000000000000..3aa051d6ed44
--- /dev/null
+++ b/dev/tools/with-jobs.sh
@@ -0,0 +1,83 @@
+#!/usr/bin/env bash
+
+# integrate with make jobserver:
+# if MAKEFLAGS contains -j and jobserver info,
+# we consume the -j jobs (blocking until they're all available)
+# and pass the -j $jobs on to our subcommand "$@"
+# if there's no jobserver info we just run the subcommand "$@"
+
+# DO NOT LET MAKE RUN THIS IN PARALLEL IT WILL DEADLOCK
+# (ie use .NOTPARALLEL, a .NOTPARALLEL makefile recursively calling make
+# (or any jobserver aware tool) does not block parallelism)
+
+jobs=
+server_in=
+server_out=
+mode=
+
+for o in $MAKEFLAGS; do
+  case "$o" in
+    "n")
+      echo "Skipping $* (make -n)"
+      exit 0;;
+    "-j"*)
+      jobs=${o#-j}
+      if [ "$jobs" = "" ]; then jobs=infinite; fi;;
+    "--jobserver-auth=fifo:"*)
+      server=${o#--jobserver-auth=fifo:}
+      server_in=$server
+      server_out=$server
+      mode=fifo
+      ;;
+    "--jobserver-auth="*","*)
+      server=${o#--jobserver-auth=}
+      server_in=${server%,*}
+      server_out=${server#*,}
+      mode=pipes
+      ;;
+    "--jobserver-auth="*)
+      >&2 echo "Unsupported jobserver mode ($o)"
+      exit 1;;
+  esac
+done
+export -n MAKEFLAGS
+
+if ! [ "$mode" ]; then
+  if [ "$jobs" = "" ]; then
+    exec "$@"
+  elif [ "$jobs" = 1 ]; then
+    exec "$@" -j 1
+  elif [ "$jobs" = infinite ]; then
+    if command -v nproc &> /dev/null; then
+      exec "$@" -j "$(nproc)"
+    elif command -v sysctl &> /dev/null; then
+      exec "$@" -j "$(sysctl -n hw.physicalcpu)"
+    else
+      exec "$@"
+    fi
+  else
+    >&2 echo "Cannot run -j $jobs without jobserver"
+    exit 1
+  fi
+elif ! [ "$jobs" ]; then
+  >&2 echo "Missing -j info for jobserver use"
+  exit 1
+elif [ "$mode" = fifo ]; then
+  # $((jobs - 1)): there is an implicit job for the current process (IIUC)
+  # (-j 1 doesn't have a jobserver)
+  # TODO give back tokens if we get interrupted (otherwise make may complain?)
+  read -rn $((jobs - 1)) chars < "$server_in"
+  ( set -x; "$@" -j "$jobs" )
+  res=$?
+  printf '%s' "$chars" > "$server_out"
+  exit $res
+elif [ "$mode" = pipes ]; then
+  read -rn $((jobs - 1)) chars <& "$server_in"
+  ( set -x; "$@" -j "$jobs" )
+  res=$?
+  printf '%s' "$chars" >& "$server_out"
+  exit $res
+else
+  >&2 assert false
+  exit 1
+fi
diff --git a/dev/top_printers.dbg b/dev/top_printers.dbg
index 8a53f90aee75..820577644760 100644
--- a/dev/top_printers.dbg
+++ b/dev/top_printers.dbg
@@ -41,6 +41,7 @@ install_printer Top_printers.ppmindmapenvgen
 install_printer Top_printers.ppididmap
 install_printer Top_printers.ppconstrunderbindersidmap
 install_printer Top_printers.ppevarsubst
+install_printer Top_printers.ppgenlam
 install_printer Top_printers.ppunbound_ltac_var_map
 install_printer Top_printers.ppclosure
 install_printer Top_printers.ppclosedglobconstr
diff --git a/dev/top_printers.ml b/dev/top_printers.ml
index ce63fd9e216a..d0a4a803dd77 100644
--- a/dev/top_printers.ml
+++ b/dev/top_printers.ml
@@ -174,6 +174,8 @@ let prconstrunderbindersidmap = pridmap (fun _ (l,c) ->
 
 let ppconstrunderbindersidmap l = pp (prconstrunderbindersidmap l)
 
+let ppgenlam l = pp (Genlambda.pp_lam l)
+
 let ppunbound_ltac_var_map l = ppidmap (fun _ arg ->
   str"") l
 
@@ -222,7 +224,7 @@ let genppj f j = let (c,t) = f j in (c ++ str " : " ++ t)
 let ppj j = pp (genppj (envpp pr_ljudge_env) j)
 
 let ppsubst s = pp (Mod_subst.debug_pr_subst s)
-let ppdelta s = pp (Mod_subst.debug_pr_delta s)
+let ppdelta s = pp (Mod_subst.debug_pr_delta (fun c -> pr_constr c.UVars.univ_abstracted_value) s)
 
 let pp_idpred s = pp (pr_idpred s)
 let pp_cpred s = pp (pr_cpred s)
@@ -287,33 +289,36 @@ let pprelevance (r:Sorts.relevance) = match r with
   | RelevanceVar q -> pp (surround (str "RelevanceVar " ++ spc() ++ Sorts.QVar.raw_pr q))
 let pperelevance r = pprelevance (EConstr.Unsafe.to_relevance r)
 
+let qprinter = UnivNames.quality_printer UnivNames.empty_binders
+let sprinter = UnivNames.sort_printer UnivNames.empty_binders
 let prlev l = UnivNames.pr_level_with_global_universes l
-let prqvar q = UnivNames.pr_quality_with_global_universes q
+let prqvar q = UnivNames.pr_quality_with_global_universes (QVar q)
+let prquality q = UnivNames.pr_quality_with_global_universes q
 let ppqvarset l = pp (hov 1 (str "{" ++ prlist_with_sep spc prqvar (QVar.Set.elements l) ++ str "}"))
-let ppqset qs = pp (hov 1 (str "{" ++ prlist_with_sep spc (Quality.pr prqvar) (Quality.Set.elements qs) ++ str "}"))
+let ppqset qs = pp (hov 1 (str "{" ++ prlist_with_sep spc prquality (Quality.Set.elements qs) ++ str "}"))
 let ppuniverse_set l = pp (Level.Set.pr prlev l)
-let ppuniverse_instance l = pp (Instance.pr prqvar prlev l)
+let ppuniverse_instance l = pp (Instance.pr sprinter l)
 let ppuniverse_einstance l = ppuniverse_instance (EConstr.Unsafe.to_instance l)
-let ppuniverse_context l = pp (UVars.UContext.pr prqvar prlev l)
+let ppuniverse_context l = pp (UVars.UContext.pr sprinter l)
 let ppuniverse_subst l = pp (UnivSubst.pr_universe_subst Level.raw_pr l)
 let ppuniverse_opt_subst l = pp (UnivFlex.pr Level.raw_pr l)
-let ppqvar_subst l = pp (UVars.pr_quality_level_subst QVar.raw_pr l)
+let ppqvar_subst l = pp (UVars.pr_quality_level_subst Quality.raw_printer l)
 let ppuniverse_level_subst l = pp (UVars.pr_universe_level_subst Level.raw_pr l)
 let pppoly_flags f = pp (PolyFlags.pr f)
 let ppustate l = pp (UState.pr l)
 let ppconstraints c = pp (UnivConstraints.pr Level.raw_pr c)
-let ppqconstraints c = pp (ElimConstraints.pr prqvar c)
+let ppqconstraints c = pp (ElimConstraints.pr qprinter c)
 let ppuniverseconstraints c = pp (UnivProblem.Set.pr c)
 let ppuniverse_context_future c =
   let ctx = Future.force c in
     ppuniverse_context ctx
 let ppuniverses u = pp (UGraph.pr_universes Level.raw_pr (UGraph.repr u))
-let ppqualities q = pp (QGraph.pr_qualities Quality.raw_pr q)
-let ppelim_constraints cstrs = pp (Sorts.ElimConstraints.pr prqvar cstrs)
+let ppqualities q = pp (QGraph.pr_qualities Quality.raw_printer q)
+let ppelim_constraints cstrs = pp (Sorts.ElimConstraints.pr qprinter cstrs)
 let ppnamedcontextval e =
   let env = Global.env () in
   let sigma = Evd.from_env env in
-  pp (pr_named_context env sigma (named_context_of_val e))
+  pp (pr_named_context_of (Environ.reset_with_named_context e env) sigma)
 
 let ppaucontext auctx =
   let {quals = qnas; univs = unas} = AbstractContext.names auctx in
@@ -325,13 +330,14 @@ let ppaucontext auctx =
   in
   let prqvar l = prgen prqvar Sorts.QVar.var_index qnas l in
   let prlev l = prgen prlev Level.var_index unas l in
-  pp (UContext.pr prqvar prlev (AbstractContext.repr auctx))
+  let prqglobal q = prquality (QGlobal q) in
+  pp (UContext.pr { pru = prlev; prq = { prvar = prqvar; prglobal = prqglobal } } (AbstractContext.repr auctx))
 
 let pp_partialfsubst psubst =
-  pp (Partial_subst.pr (fun f -> pr_constr (CClosure.term_of_fconstr f)) (Quality.pr prqvar) (Universe.pr prlev) psubst)
+  pp (Partial_subst.pr (fun f -> pr_constr (CClosure.term_of_fconstr f)) prquality (Universe.pr prlev) psubst)
 
 let pp_partialsubst psubst =
-  pp (Partial_subst.pr pr_econstr (Quality.pr prqvar) (Universe.pr prlev) psubst)
+  pp (Partial_subst.pr pr_econstr prquality (Universe.pr prlev) psubst)
 
 let ppenv e = pp
   (str "[" ++ pr_named_context_of e Evd.empty ++ str "]" ++ spc() ++
@@ -431,7 +437,8 @@ let constr_display csr =
     | Prop -> "Prop"
     | Type u -> univ_display u;
         "Type("^(string_of_int !cnt)^")"
-    | QSort (q, u) -> univ_display u; Printf.sprintf "QSort(%s, %i)" (Sorts.QVar.to_string q) !cnt
+    | GSort (q, u) -> univ_display u; Printf.sprintf "GSort(%s, %i)" (Sorts.QGlobal.to_string q) !cnt
+    | VSort (q, u) -> univ_display u; Printf.sprintf "VSort(%s, %i)" (Sorts.QVar.to_string q) !cnt
 
   and universes_display l =
     let qs, us = Instance.to_array l in
@@ -593,8 +600,10 @@ let print_pure_constr csr =
     | Prop -> print_string "Prop"
     | Type u -> open_hbox();
         print_string "Type("; pp (Universe.raw_pr u); print_string ")"; close_box()
-    | QSort (q, u) -> open_hbox();
-        print_string "QSort("; pp (QVar.raw_pr q); print_string ", "; pp (Universe.raw_pr u); print_string ")"; close_box()
+    | GSort (q, u) -> open_hbox();
+        print_string "GSort("; pp (str @@ QGlobal.to_string q); print_string ", "; pp (Universe.raw_pr u); print_string ")"; close_box()
+    | VSort (q, u) -> open_hbox();
+        print_string "VSort("; pp (QVar.raw_pr q); print_string ", "; pp (Universe.raw_pr u); print_string ")"; close_box()
 
   and name_display x = match x.binder_name with
     | Name id -> print_string (Id.to_string id)
@@ -653,7 +662,7 @@ let ppgenargargt arg = pp (str (Genarg.ArgT.repr arg))
 
 let ppist ist =
   let pr id arg = prgenarginfo arg in
-  pp (pridmap pr ist.Geninterp.lfun)
+  pp (pridmap pr ist.Ltac_plugin.Tacinterp.lfun)
 
 (**********************************************************************)
 (* Vernac-level debugging commands                                    *)
diff --git a/dev/top_printers.mli b/dev/top_printers.mli
index 3d1791a2e798..6c618c65725e 100644
--- a/dev/top_printers.mli
+++ b/dev/top_printers.mli
@@ -98,6 +98,8 @@ val ppevarsubst :
 val ppunbound_ltac_var_map :
   'a Genarg.generic_argument Names.Id.Map.t -> unit
 
+val ppgenlam : _ Genlambda.lambda -> 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
@@ -203,7 +205,7 @@ val ppgenarginfo : Geninterp.Val.t -> unit
 
 val ppgenargargt : ('a, 'b, 'c) Genarg.ArgT.tag -> unit
 
-val ppist : Geninterp.interp_sign -> unit
+val ppist : Ltac_plugin.Tacinterp.interp_sign -> unit
 
 val raw_string_of_ref : ?loc:Loc.t -> Names.Id.Set.t -> Names.GlobRef.t -> Libnames.qualid
 val short_string_of_ref : ?loc:Loc.t -> Names.Id.Set.t -> Names.GlobRef.t -> Libnames.qualid
diff --git a/dev/vm_printers.ml b/dev/vm_printers.ml
index 9c6091bbf39a..7b42d1006e57 100644
--- a/dev/vm_printers.ml
+++ b/dev/vm_printers.ml
@@ -23,7 +23,8 @@ let ppsort = function
   | Set -> print_string "Set"
   | Prop -> print_string "Prop"
   | Type _ -> print_string "Type"
-  | QSort _ -> print_string "QSort"
+  | GSort _ -> print_string "GSort"
+  | VSort _ -> print_string "VSort"
 
 let print_idkey idk =
   match idk with
diff --git a/doc/Makefile.docgram b/doc/Makefile.docgram
index e78384058722..5f158279158a 100644
--- a/doc/Makefile.docgram
+++ b/doc/Makefile.docgram
@@ -38,7 +38,7 @@ REAL_DOC_MLGS := $(wildcard */*.mlg plugins/*/*.mlg)
 # omit SSR MLGS and chapter for now
 SSR_MLGS := \
 	plugins/ssr/ssrparser.mlg plugins/ssr/ssrtacs.mlg plugins/ssr/ssrvernac.mlg \
-  plugins/ssrmatching/g_ssrmatching.mlg
+  plugins/ssrmatching/g_ssrmatching.mlg plugins/ssrrewrite/ssrrewrite.mlg
 REAL_DOC_MLGS := $(filter-out $(SSR_MLGS),$(REAL_DOC_MLGS))
 SSR_RSTS := doc/sphinx/proof-engine/ssreflect-proof-language.rst
 DOC_RSTS := $(filter-out $(SSR_RSTS),$(DOC_RSTS))
diff --git a/doc/changelog/01-kernel/21416-record-postponed-eta-Changed.rst b/doc/changelog/01-kernel/21416-record-postponed-eta-Changed.rst
new file mode 100644
index 000000000000..6abac6d4c65b
--- /dev/null
+++ b/doc/changelog/01-kernel/21416-record-postponed-eta-Changed.rst
@@ -0,0 +1,6 @@
+- **Changed:**
+  Sort-polymorphic records can now have primitive projections
+  with eta conversion depending on instantiation,
+  which is checked at runtime
+  (`#21416 `_,
+  by Tomas Diaz).
diff --git a/doc/changelog/01-kernel/21438-primitive-postponed-eta-Changed.rst b/doc/changelog/01-kernel/21438-primitive-postponed-eta-Changed.rst
deleted file mode 100644
index 203fd8dba039..000000000000
--- a/doc/changelog/01-kernel/21438-primitive-postponed-eta-Changed.rst
+++ /dev/null
@@ -1,5 +0,0 @@
-- **Changed:**
-  Records in `Type` and `Prop`, with only fields in `SProp`,
-  can now have primitive projections but without eta conversion.
-  (`#21438 `_,
-  by Tomas Diaz).
diff --git a/doc/changelog/01-kernel/21451-safe-typing-assert-qualities-Removed.rst b/doc/changelog/01-kernel/21451-safe-typing-assert-qualities-Removed.rst
deleted file mode 100644
index 2cedf5680474..000000000000
--- a/doc/changelog/01-kernel/21451-safe-typing-assert-qualities-Removed.rst
+++ /dev/null
@@ -1,4 +0,0 @@
-- **Removed:**
-  the ability to define monomorphic sorts within sections
-  (`#21451 `_,
-  by Pierre-Marie Pédrot).
diff --git a/doc/changelog/01-kernel/21465-better-mod-type-errors-Changed.rst b/doc/changelog/01-kernel/21465-better-mod-type-errors-Changed.rst
deleted file mode 100644
index 38e15ed78c81..000000000000
--- a/doc/changelog/01-kernel/21465-better-mod-type-errors-Changed.rst
+++ /dev/null
@@ -1,6 +0,0 @@
-- **Changed:**
-  Error messages for module signature mismatches and "with Definition"
-  constraint failures are now more detailed
-  (`#21465 `_,
-  fixes `#21464 `_,
-  by Jason Gross).
diff --git a/doc/changelog/01-kernel/21514-unfold-dep-heuristic-names-Added.rst b/doc/changelog/01-kernel/21514-unfold-dep-heuristic-names-Added.rst
new file mode 100644
index 000000000000..8d077f0248c8
--- /dev/null
+++ b/doc/changelog/01-kernel/21514-unfold-dep-heuristic-names-Added.rst
@@ -0,0 +1,11 @@
+- **Added:**
+  new flag :flag:`Kernel Conversion Dep Heuristic` that enables a heuristic for
+  smarter constant unfolding during conversion. When enabled, if two constants
+  have the same strategy level (see :cmd:`Strategy`) and one constant's
+  definition depends on the other, the dependent constant is unfolded first.
+  This can significantly speed up conversions in cases like checking ``c1 =
+  c2`` vs ``c2 = c1`` where one definition wraps the other. The flag defaults
+  to off, preserving the existing behavior of preferentially unfolding the
+  right-hand side first (`#21514
+  `_, fixes `#21509
+  `_, by Jason Gross).
diff --git a/doc/changelog/01-kernel/21531-stricter-type-in-type-Fixed.rst b/doc/changelog/01-kernel/21531-stricter-type-in-type-Fixed.rst
new file mode 100644
index 000000000000..820ff4cb86e1
--- /dev/null
+++ b/doc/changelog/01-kernel/21531-stricter-type-in-type-Fixed.rst
@@ -0,0 +1,6 @@
+- **Fixed:**
+  Unset Universe Checking doesn't confuse sorts anymore, only allowing Type in Type
+  (`#21531 `_,
+  fixes `#20241 `_
+  and `#20667 `_,
+  by Yann Leray).
diff --git a/doc/changelog/01-kernel/21663-rr-match-global-sorts-Added.rst b/doc/changelog/01-kernel/21663-rr-match-global-sorts-Added.rst
new file mode 100644
index 000000000000..b7519df48ed5
--- /dev/null
+++ b/doc/changelog/01-kernel/21663-rr-match-global-sorts-Added.rst
@@ -0,0 +1,4 @@
+- **Added:**
+  Added support for matching on specific global sorts in rewrite rules
+  (`#21663 `_,
+  by Yann Leray).
diff --git a/doc/changelog/01-kernel/21774-track-indices-matter-Added.rst b/doc/changelog/01-kernel/21774-track-indices-matter-Added.rst
new file mode 100644
index 000000000000..4f298959c6cd
--- /dev/null
+++ b/doc/changelog/01-kernel/21774-track-indices-matter-Added.rst
@@ -0,0 +1,6 @@
+- **Added:**
+  kernel now tracks reliance on ``-indices-matter`` not being passed, and
+  prints this information in the checker, and in :cmd:`Print Assumptions`
+  when ``-indices-matter`` is passed
+  (`#21774 `_,
+  by Jason Gross).
diff --git a/doc/changelog/01-kernel/21845-guard-fix-subterm-Fixed.rst b/doc/changelog/01-kernel/21845-guard-fix-subterm-Fixed.rst
new file mode 100644
index 000000000000..0dda46ceba0e
--- /dev/null
+++ b/doc/changelog/01-kernel/21845-guard-fix-subterm-Fixed.rst
@@ -0,0 +1,5 @@
+- **Fixed:**
+  Pass the correct environment in a reduction call inside the guard checker
+  (`#21845 `_,
+  fixes `#21839 `_,
+  by Yann Leray).
diff --git a/doc/changelog/01-kernel/21896-guard-incl-wf-paths-Fixed.rst b/doc/changelog/01-kernel/21896-guard-incl-wf-paths-Fixed.rst
new file mode 100644
index 000000000000..bd540c040004
--- /dev/null
+++ b/doc/changelog/01-kernel/21896-guard-incl-wf-paths-Fixed.rst
@@ -0,0 +1,5 @@
+- **Fixed:**
+  Fix regression that prevented some mutual fixpoints involving nested inductives
+  (`#21896 `_,
+  fixes `#21892 `_,
+  by Yann Leray).
diff --git a/doc/changelog/01-kernel/22058-einductive-contract-case-Fixed.rst b/doc/changelog/01-kernel/22058-einductive-contract-case-Fixed.rst
new file mode 100644
index 000000000000..1d99724dc98e
--- /dev/null
+++ b/doc/changelog/01-kernel/22058-einductive-contract-case-Fixed.rst
@@ -0,0 +1,5 @@
+- **Fixed:**
+  ``EConstr.contract_case`` no longer anomalies when Case branches
+  contain evar-backed Lambda bodies (e.g., from ``Constr.in_context``)
+  (`#22058 `_,
+  by Jason Gross).
diff --git a/doc/changelog/02-specification-language/20662-suggest-glob-error-Added.rst b/doc/changelog/02-specification-language/20662-suggest-glob-error-Added.rst
deleted file mode 100644
index 3c6ae111ad11..000000000000
--- a/doc/changelog/02-specification-language/20662-suggest-glob-error-Added.rst
+++ /dev/null
@@ -1,4 +0,0 @@
-- **Added:**
-  when a reference is not found in the current environment, the error suggests similar names
-  (`#20662 `_,
-  by Gaëtan Gilbert).
diff --git a/doc/changelog/02-specification-language/21417-elab-elim-constraints-Added.rst b/doc/changelog/02-specification-language/21417-elab-elim-constraints-Added.rst
deleted file mode 100644
index 45aee2d0ea1c..000000000000
--- a/doc/changelog/02-specification-language/21417-elab-elim-constraints-Added.rst
+++ /dev/null
@@ -1,4 +0,0 @@
-- **Added:**
-  implicit elaboration of :ref:`elimination constraints `
-  (`#21417 `_,
-  by Tomas Diaz).
diff --git a/doc/changelog/02-specification-language/21450-elab-sorts-Added.rst b/doc/changelog/02-specification-language/21450-elab-sorts-Added.rst
new file mode 100644
index 000000000000..a09b4fd15bb6
--- /dev/null
+++ b/doc/changelog/02-specification-language/21450-elab-sorts-Added.rst
@@ -0,0 +1,4 @@
+- **Added:**
+  elaboration of implicit sort qualities, controlled by the flag :flag:`Collapse Sorts ToType`
+  (`#21450 `_,
+  by Tomas Diaz).
diff --git a/doc/changelog/02-specification-language/21611-of-ampersand.rst b/doc/changelog/02-specification-language/21611-of-ampersand.rst
new file mode 100644
index 000000000000..0f086e21b45d
--- /dev/null
+++ b/doc/changelog/02-specification-language/21611-of-ampersand.rst
@@ -0,0 +1,7 @@
+- **Added:**
+  new syntactic sugars `& T` for anonymous binders `(_ : T)`
+  and `of T & ... & T` for anonymous binders in constructors, enabling the
+  `Variant t := C1 of a & b & c | C2 x y of P x & Q y.` syntax.
+  This adds the new reserved keyword `of`
+  (`#21611 `_,
+  by Pierre Roux).
diff --git a/doc/changelog/02-specification-language/21627-intern-constr-in-tac-Fixed.rst b/doc/changelog/02-specification-language/21627-intern-constr-in-tac-Fixed.rst
new file mode 100644
index 000000000000..ed227ace742b
--- /dev/null
+++ b/doc/changelog/02-specification-language/21627-intern-constr-in-tac-Fixed.rst
@@ -0,0 +1,6 @@
+- **Fixed:**
+  tactic definitions (:cmd:`Ltac`, :cmd:`Ltac2`, tactic notations, etc)
+  correctly check that universe names are declared instead of delaying the error to when the tactic is used
+  (`#21627 `_,
+  fixes `#21616 `_,
+  by Gaëtan Gilbert).
diff --git a/doc/changelog/02-specification-language/21899-janno-typeclasses-debug-Changed.rst b/doc/changelog/02-specification-language/21899-janno-typeclasses-debug-Changed.rst
new file mode 100644
index 000000000000..45ef9e57768c
--- /dev/null
+++ b/doc/changelog/02-specification-language/21899-janno-typeclasses-debug-Changed.rst
@@ -0,0 +1,5 @@
+- **Changed:**
+  External hints now emit a new log entry starting with "running HINT on GOAL" before the tactic code is executed; all hints had their log entry for a successful application changed from just "HINT on GOAL" to "applied HINT on GOAL"
+  (`#21899 `_,
+  fixes `#21898 `_,
+  by Jan-Oliver Kaiser).
diff --git a/doc/changelog/03-notations/20816-abbrev-mod-Changed.rst b/doc/changelog/03-notations/20816-abbrev-mod-Changed.rst
deleted file mode 100644
index 29566c4e4799..000000000000
--- a/doc/changelog/03-notations/20816-abbrev-mod-Changed.rst
+++ /dev/null
@@ -1,7 +0,0 @@
-- **Changed:**
-  :cmd:`Abbreviation` no longer adds a printing rule when a surrounding module is imported
-  (i.e. when it would need to print a qualified name). :attr:`global` can be used
-  to retrieve the previous behavior
-  (`#20816 `_,
-  fixes `#20668 `_,
-  by Gaëtan Gilbert).
diff --git a/doc/changelog/03-notations/20855-abbreviation-Deprecated.rst b/doc/changelog/03-notations/20855-abbreviation-Deprecated.rst
deleted file mode 100644
index 8888c3f3f373..000000000000
--- a/doc/changelog/03-notations/20855-abbreviation-Deprecated.rst
+++ /dev/null
@@ -1,5 +0,0 @@
-- **Deprecated:**
-  use of "Notation" keyword for :cmd:`abbreviations `,
-  use "Abbreviation" instead
-  (`#20855 `_,
-  by Pierre Roux).
diff --git a/doc/changelog/03-notations/20857-qualified-custom-Changed.rst b/doc/changelog/03-notations/20857-qualified-custom-Changed.rst
deleted file mode 100644
index ba94dd8a4d76..000000000000
--- a/doc/changelog/03-notations/20857-qualified-custom-Changed.rst
+++ /dev/null
@@ -1,5 +0,0 @@
-- **Changed:**
-  :cmd:`custom entry ` names are now qualified.
-  A compatibility layer provides deprecated access with unqualified names without needing to import their module, as long as it is unambiguous
-  (`#20857 `_,
-  by Gaëtan Gilbert).
diff --git a/doc/changelog/03-notations/21107-test-strict-right-assoc-Added.rst b/doc/changelog/03-notations/21107-test-strict-right-assoc-Added.rst
deleted file mode 100644
index a24c456a14b2..000000000000
--- a/doc/changelog/03-notations/21107-test-strict-right-assoc-Added.rst
+++ /dev/null
@@ -1,4 +0,0 @@
-- **Added:**
-  a warning for non closed notations at level 0
-  (`#21107 `_,
-  by Pierre Roux).
diff --git a/doc/changelog/03-notations/21159-refine-common-prefix-Changed.rst b/doc/changelog/03-notations/21159-refine-common-prefix-Changed.rst
deleted file mode 100644
index 61c31c965092..000000000000
--- a/doc/changelog/03-notations/21159-refine-common-prefix-Changed.rst
+++ /dev/null
@@ -1,9 +0,0 @@
-- **Changed:**
-  the ``notation-incompatible-prefix`` no longer warns about
-  common prefixes followed by terminal symbols. For instance
-  ``"x #0`` and ``"x #0 #1"`` are not incompatible since our
-  parser isn't exactly LL1, considering successive terminal
-  symbols as a single token. Note that this change has an
-  impact on the default levels of such notations
-  (`#21159 `_,
-  by Pierre Roux).
diff --git a/doc/changelog/03-notations/21671-binder-constr-Changed.rst b/doc/changelog/03-notations/21671-binder-constr-Changed.rst
new file mode 100644
index 000000000000..ff1345cf574f
--- /dev/null
+++ b/doc/changelog/03-notations/21671-binder-constr-Changed.rst
@@ -0,0 +1,34 @@
+- **Changed:**
+  Until 8.19 term level 200 contained a sub-entry `binder_constr`
+  (containing e.g. `forall`) and notations declared at level 200 were
+  redirected to `binder_constr`. In 8.19 `binder_constr` was moved to
+  level 10, keeping the redirection for notations declared at level 200.
+
+  `binder_constr` has now been removed with its parsing rules put
+  directly at level 10, and non left recursive notations declared at
+  level 200 are redirected to level 10. Any right recursion in such a
+  redirected notation is still interpreted as though it was really in
+  right associative level 200, i.e. the right recursion is at
+  level 200. Left recursive notations are not redirected.
+
+  The redirection will be removed in the future and is therefore
+  deprecated. To keep the current behaviour, declare your notations at
+  level 10 and any recursion at level 200. For instance,
+
+  .. rocqdoc::
+
+     Reserved Notation "'exists' x .. y , p"
+       (at level 200, x binder).
+
+  becomes
+
+  .. rocqdoc::
+
+     Reserved Notation "'exists' x .. y , p"
+       (at level 10, x binder, p at level 200).
+
+  Finally note that any `associativity` annotation on notations
+  declared at level 200 are currrently ignored to avoid interfering
+  with the redirection to left-associative level 10 (`#21671
+  `_, by Gaëtan
+  Gilbert).
diff --git a/doc/changelog/04-tactics/20045-cmorphisms-params-Fixed.rst b/doc/changelog/04-tactics/20045-cmorphisms-params-Fixed.rst
deleted file mode 100644
index 08cc2ea0cf2f..000000000000
--- a/doc/changelog/04-tactics/20045-cmorphisms-params-Fixed.rst
+++ /dev/null
@@ -1,5 +0,0 @@
-- **Fixed:**
-  ``setoid_rewrite`` now correctly picks up ``Params`` instances when rewriting in ``Type``
-  (`#20045 `_,
-  fixes `#20044 `_,
-  by quarkcool).
diff --git a/doc/changelog/04-tactics/20175-janno-unif-red-prim.rst b/doc/changelog/04-tactics/20175-janno-unif-red-prim.rst
new file mode 100644
index 000000000000..a6a4e9370b65
--- /dev/null
+++ b/doc/changelog/04-tactics/20175-janno-unif-red-prim.rst
@@ -0,0 +1,6 @@
+- **Fixed:**
+  Support primitive operations in old and new unification
+  (`#20175 `_,
+  fixes `#18259 `_
+  and `#20155 `_,
+  by Jan-Oliver Kaiser).
diff --git a/doc/changelog/04-tactics/20614-induction-schemes-Changed.rst b/doc/changelog/04-tactics/20614-induction-schemes-Changed.rst
deleted file mode 100644
index f35f781f4387..000000000000
--- a/doc/changelog/04-tactics/20614-induction-schemes-Changed.rst
+++ /dev/null
@@ -1,6 +0,0 @@
-- **Changed:**
-  tactics such as :tacn:`induction` find eliminators (like `nat_rect`)
-  through the :cmd:`Register Scheme` table (which is automatically populated by :cmd:`Scheme` and automatic scheme declarations)
-  instead of by name (the lookup by name remains for now for backward compatibility)
-  (`#20614 `_,
-  by Gaëtan Gilbert).
diff --git a/doc/changelog/04-tactics/20614-induction-schemes-Deprecated.rst b/doc/changelog/04-tactics/20614-induction-schemes-Deprecated.rst
deleted file mode 100644
index 7c42d322a445..000000000000
--- a/doc/changelog/04-tactics/20614-induction-schemes-Deprecated.rst
+++ /dev/null
@@ -1,5 +0,0 @@
-- **Deprecated:**
-  tactics such as :tacn:`induction` finding eliminators (like `nat_rect`) by name
-  instead of through the :cmd:`Register Scheme` table (which is automatically populated by :cmd:`Scheme` and automatic scheme declarations)
-  (`#20614 `_,
-  by Gaëtan Gilbert).
diff --git a/doc/changelog/04-tactics/20698-master-Fixed.rst b/doc/changelog/04-tactics/20698-master-Fixed.rst
deleted file mode 100644
index 13313ddb7090..000000000000
--- a/doc/changelog/04-tactics/20698-master-Fixed.rst
+++ /dev/null
@@ -1,4 +0,0 @@
-- **Fixed:**
-  a sequence `Import M. Remove Hints h. Import M.` where `M` exports hints `h` would not re-add `h` after its removal
-  (`#20698 `_,
-  by Gaëtan Gilbert).
diff --git a/doc/changelog/04-tactics/20780-fix-univpoly-cs-unification-Fixed.rst b/doc/changelog/04-tactics/20780-fix-univpoly-cs-unification-Fixed.rst
deleted file mode 100644
index d9c72b15617a..000000000000
--- a/doc/changelog/04-tactics/20780-fix-univpoly-cs-unification-Fixed.rst
+++ /dev/null
@@ -1,5 +0,0 @@
-- **Fixed:**
-  Canonical structure resolution in tactic unification in presence of
-  universe polymorphism (`#20780 `_,
-  fixes `#20779 `_,
-  by Matthieu Sozeau).
diff --git a/doc/changelog/04-tactics/20810-cctac-primitive-values-Added.rst b/doc/changelog/04-tactics/20810-cctac-primitive-values-Added.rst
deleted file mode 100644
index efc4ffcac1b0..000000000000
--- a/doc/changelog/04-tactics/20810-cctac-primitive-values-Added.rst
+++ /dev/null
@@ -1,5 +0,0 @@
-- **Added:**
-  congruence tactics now handle primitive ints, floats and strings
-  (`#20810 `_,
-  fixes `#20011 `_,
-  by Pierre-Marie Pédrot).
diff --git a/doc/changelog/04-tactics/21108-rew-hint-cat-Fixed.rst b/doc/changelog/04-tactics/21108-rew-hint-cat-Fixed.rst
deleted file mode 100644
index e12636d3c5cd..000000000000
--- a/doc/changelog/04-tactics/21108-rew-hint-cat-Fixed.rst
+++ /dev/null
@@ -1,5 +0,0 @@
-- **Fixed:**
-  rewrite hints are controlled by the `hints` import category
-  (`#21108 `_,
-  fixes `#21106 `_,
-  by Gaëtan Gilbert).
diff --git a/doc/changelog/04-tactics/21129-intuition-stop-using-auto-with-star-Removed.rst b/doc/changelog/04-tactics/21129-intuition-stop-using-auto-with-star-Removed.rst
deleted file mode 100644
index f94903044659..000000000000
--- a/doc/changelog/04-tactics/21129-intuition-stop-using-auto-with-star-Removed.rst
+++ /dev/null
@@ -1,6 +0,0 @@
-- **Removed:**
-  the implicit call to `auto with *` in intuition solver, that
-  was deprecated since 8.17
-  (`#21129 `_,
-  fixes `#4949 `_,
-  by Pierre-Marie Pédrot).
diff --git a/doc/changelog/04-tactics/21172-rm-destauto-Removed.rst b/doc/changelog/04-tactics/21172-rm-destauto-Removed.rst
deleted file mode 100644
index b6a411910c15..000000000000
--- a/doc/changelog/04-tactics/21172-rm-destauto-Removed.rst
+++ /dev/null
@@ -1,5 +0,0 @@
-- **Removed:**
-  the `destauto` tactic, which was deprecated in 8.20
-  (`#21172 `_,
-  fixes `#11537 `__,
-  by Pierre-Marie Pédrot).
diff --git a/doc/changelog/04-tactics/21193-factor-tc-hint-exact-Changed.rst b/doc/changelog/04-tactics/21193-factor-tc-hint-exact-Changed.rst
deleted file mode 100644
index afd91a988229..000000000000
--- a/doc/changelog/04-tactics/21193-factor-tc-hint-exact-Changed.rst
+++ /dev/null
@@ -1,6 +0,0 @@
-- **Changed:**
-  type class hints without hypotheses used via functor
-  applications are applied with their type from the module
-  type rather than the module instance
-  (`#21193 `_,
-  by Pierre-Marie Pédrot).
diff --git a/doc/changelog/04-tactics/21245-no-auto-scheme-Deprecated.rst b/doc/changelog/04-tactics/21245-no-auto-scheme-Deprecated.rst
deleted file mode 100644
index a93404d13c0e..000000000000
--- a/doc/changelog/04-tactics/21245-no-auto-scheme-Deprecated.rst
+++ /dev/null
@@ -1,7 +0,0 @@
-- **Deprecated:**
-  dynamically generating schemes when needed in tactics.
-  This was mostly used for rewriting and equality schemes of the registered equality type
-  (`eq` when using the Corelib) for tactics such as :tacn:`discriminate`.
-  These schemes are now explicitly declared for `eq` in the Corelib
-  (`#21245 `_,
-  by Gaëtan Gilbert).
diff --git a/doc/changelog/04-tactics/21356-nested_rec3-Added.rst b/doc/changelog/04-tactics/21356-nested_rec3-Added.rst
deleted file mode 100644
index d39a5ca34dd6..000000000000
--- a/doc/changelog/04-tactics/21356-nested_rec3-Added.rst
+++ /dev/null
@@ -1,6 +0,0 @@
-- **Added:**
-  Induction hypotheses are now generated for nested arguments provided
-  a `All` predicate, and a theorem to prove it have been registered with
-  the keys `All` and `AllForall`.
-  (`#21356 `_,
-  by Thomas Lamiaux).
diff --git a/doc/changelog/04-tactics/21429-sparse_param-Added.rst b/doc/changelog/04-tactics/21429-sparse_param-Added.rst
deleted file mode 100644
index 495865295269..000000000000
--- a/doc/changelog/04-tactics/21429-sparse_param-Added.rst
+++ /dev/null
@@ -1,5 +0,0 @@
-- **Added:**
-  Add a `Scheme All` command to generate the `All` predicate and its theorem
-  for inductive types used for the eliminators of nested inductive types
-  (`#21429 `_,
-  by Thomas Lamiaux).
diff --git a/doc/changelog/04-tactics/21521-strat-pattern-ltac-Added.rst b/doc/changelog/04-tactics/21521-strat-pattern-ltac-Added.rst
new file mode 100644
index 000000000000..7815d5c8d411
--- /dev/null
+++ b/doc/changelog/04-tactics/21521-strat-pattern-ltac-Added.rst
@@ -0,0 +1,5 @@
+- **Added:**
+  Add :n:`matches` and :n:`tactic` :ref:`strategies `
+  to :tacn:`rewrite_strat` for :ref:`Ltac1 ` and :ref:`Ltac2 ` tactics
+  (`#21521 `_,
+  by Matthieu Sozeau and Mathis Bouverot-Dupuis).
diff --git a/doc/changelog/04-tactics/21631-stop-zeta-rewrite-Changed.rst b/doc/changelog/04-tactics/21631-stop-zeta-rewrite-Changed.rst
new file mode 100644
index 000000000000..4d950665245b
--- /dev/null
+++ b/doc/changelog/04-tactics/21631-stop-zeta-rewrite-Changed.rst
@@ -0,0 +1,5 @@
+- **Changed:**
+  Stop zeta-normalizing generalized rewriting proofs for better
+  sharing and performance
+  (`#21631 `_,
+  by Matthieu Sozeau).
diff --git a/doc/changelog/04-tactics/21676-constr-quotation-abstract-no-inline-Changed.rst b/doc/changelog/04-tactics/21676-constr-quotation-abstract-no-inline-Changed.rst
new file mode 100644
index 000000000000..eedbb8da8c38
--- /dev/null
+++ b/doc/changelog/04-tactics/21676-constr-quotation-abstract-no-inline-Changed.rst
@@ -0,0 +1,7 @@
+- **Changed:**
+  :tacn:`abstract`-ed subproofs within tactic quotations are not
+  inlined any more. The previous behavior can be restored through
+  the deprecated :flag:`Inline Abstract Subproof` flag
+  (`#21676 `_,
+  fixes `#7905 `_,
+  by Pierre-Marie Pédrot).
diff --git a/doc/changelog/04-tactics/21811-genScheme-Changed.rst b/doc/changelog/04-tactics/21811-genScheme-Changed.rst
new file mode 100644
index 000000000000..4c449063cdba
--- /dev/null
+++ b/doc/changelog/04-tactics/21811-genScheme-Changed.rst
@@ -0,0 +1,5 @@
+- **Changed:**
+  Generalize DeclareScheme to be able to register schemes for any GlobRef,
+  and not just for inductive types
+  (`#21811 `_,
+  by Thomas Lamiaux).
diff --git a/doc/changelog/04-tactics/21833-rm-non-global-hint-Removed.rst b/doc/changelog/04-tactics/21833-rm-non-global-hint-Removed.rst
new file mode 100644
index 000000000000..0b445b8223e2
--- /dev/null
+++ b/doc/changelog/04-tactics/21833-rm-non-global-hint-Removed.rst
@@ -0,0 +1,5 @@
+- **Removed:**
+  the ability to use non-reference hints in `using` clauses
+  of :tacn:`auto`-like tactics
+  (`#21833 `_,
+  by Pierre-Marie Pédrot).
diff --git a/doc/changelog/04-tactics/21862-cleanup-hints-globref-Changed.rst b/doc/changelog/04-tactics/21862-cleanup-hints-globref-Changed.rst
new file mode 100644
index 000000000000..13972b158b31
--- /dev/null
+++ b/doc/changelog/04-tactics/21862-cleanup-hints-globref-Changed.rst
@@ -0,0 +1,9 @@
+- **Changed:**
+  hints from a functor argument whose underlying reference is
+  marked Inline in the functor parameter type are not expanded
+  into their inlined value anymore at application time. This
+  prevents arbitrary terms from flowing into hint databases.
+  This change is not backwards compatible but breakage should
+  be extremely uncommon
+  (`#21862 `_,
+  by Pierre-Marie Pédrot).
diff --git a/doc/changelog/04-tactics/21928-arrayall-Changed.rst b/doc/changelog/04-tactics/21928-arrayall-Changed.rst
new file mode 100644
index 000000000000..23af292eb2ab
--- /dev/null
+++ b/doc/changelog/04-tactics/21928-arrayall-Changed.rst
@@ -0,0 +1,4 @@
+- **Changed:**
+  Extend generation of eliminators to handle nesting with Primitive Arrays
+  (`#21928 `_,
+  by Léo Soudant).
diff --git a/doc/changelog/04-tactics/21987-context-secvar-Changed.rst b/doc/changelog/04-tactics/21987-context-secvar-Changed.rst
new file mode 100644
index 000000000000..5f8714bf4b94
--- /dev/null
+++ b/doc/changelog/04-tactics/21987-context-secvar-Changed.rst
@@ -0,0 +1,5 @@
+- **Changed:**
+  :tacn:`clear` checks that identifiers are bound even when they are ltac variables
+  (typically in `match goal with H : _ |- _ => foo H; clear H end`, `clear` now fails if `foo` cleared H where before it would succeed without doing anything)
+  (`#21987 `_,
+  by Gaëtan Gilbert).
diff --git a/doc/changelog/04-tactics/21987-context-secvar-Fixed.rst b/doc/changelog/04-tactics/21987-context-secvar-Fixed.rst
new file mode 100644
index 000000000000..58be0ef1c22a
--- /dev/null
+++ b/doc/changelog/04-tactics/21987-context-secvar-Fixed.rst
@@ -0,0 +1,11 @@
+- **Fixed:**
+  the proof engine now keeps track of which hypotheses are section variables
+  instead of assuming that a variable sharing a name with a section variable is a section variable.
+  In particular :tacn:`destruct` now clears non-section-variable variables which share a name with a section variable.
+  Note that modifying a section variable (e.g. with `apply in`) makes it a non-section-variable
+  (`#21987 `_,
+  fixes `#18858 `_
+  and `#12304 `_
+  and `#11487 `_
+  and `#6773 `_,
+  by Gaëtan Gilbert).
diff --git a/doc/changelog/04-tactics/22001-gene-eqs-vars-Changed.rst b/doc/changelog/04-tactics/22001-gene-eqs-vars-Changed.rst
new file mode 100644
index 000000000000..a0ff941c6401
--- /dev/null
+++ b/doc/changelog/04-tactics/22001-gene-eqs-vars-Changed.rst
@@ -0,0 +1,6 @@
+- **Changed:**
+  :tacn:`generalize_eqs_vars` (used in :tacn:`dependent induction`)
+  does less useless generalizations
+  (`#22001 `_,
+  fixes `#22000 `_,
+  by Gaëtan Gilbert).
diff --git a/doc/changelog/06-Ltac2-language/20561-ltac2-custom-entry-Added.rst b/doc/changelog/06-Ltac2-language/20561-ltac2-custom-entry-Added.rst
deleted file mode 100644
index 59751fad624d..000000000000
--- a/doc/changelog/06-Ltac2-language/20561-ltac2-custom-entry-Added.rst
+++ /dev/null
@@ -1,4 +0,0 @@
-- **Added:**
-  :cmd:`Ltac2 Custom Entry` making it possible to define more complex :cmd:`Ltac2 Notation`\s
-  (`#20561 `_,
-  by Gaëtan Gilbert).
diff --git a/doc/changelog/06-Ltac2-language/20759-ltac2-nota-levels-Changed.rst b/doc/changelog/06-Ltac2-language/20759-ltac2-nota-levels-Changed.rst
deleted file mode 100644
index eaa67628b5a0..000000000000
--- a/doc/changelog/06-Ltac2-language/20759-ltac2-nota-levels-Changed.rst
+++ /dev/null
@@ -1,12 +0,0 @@
-- **Changed:**
-  :cmd:`Ltac2 Notation` without an explicit level puts the notation at level `1` instead of `5`
-  when it starts with a string which is an identifier.
-  Various notations have consequently changed level (e.g. `apply`).
-  (`#20759 `_,
-  fixes `#20616 `_,
-  by Gaëtan Gilbert).
-- **Changed:**
-  well parenthesized notations (`match!`, `lazy_match!`, etc) are now at level `0` instead of `5`,
-  and `now` is at level `1` instead of `6` (its argument is still at level `6`)
-  (`#20759 `_,
-  by Gaëtan Gilbert).
diff --git a/doc/changelog/06-Ltac2-language/20794-ltac2-equal-for-ref.rst b/doc/changelog/06-Ltac2-language/20794-ltac2-equal-for-ref.rst
deleted file mode 100644
index 6b5254934356..000000000000
--- a/doc/changelog/06-Ltac2-language/20794-ltac2-equal-for-ref.rst
+++ /dev/null
@@ -1,4 +0,0 @@
-- **Added:**
-  ``Ltac2.Reference.equal``
-  (`#20794 `_,
-  by Pierre Rousselin).
diff --git a/doc/changelog/06-Ltac2-language/20855-abbreviation-Deprecated.rst b/doc/changelog/06-Ltac2-language/20855-abbreviation-Deprecated.rst
deleted file mode 100644
index 2eaa48454ae6..000000000000
--- a/doc/changelog/06-Ltac2-language/20855-abbreviation-Deprecated.rst
+++ /dev/null
@@ -1,5 +0,0 @@
-- **Deprecated:**
-  use of "Notation" keyword for :cmd:`abbreviations `,
-  use "Abbreviation" instead
-  (`#20855 `_,
-  by Pierre Roux).
diff --git a/doc/changelog/06-Ltac2-language/20882-ltac2-set-local-Added.rst b/doc/changelog/06-Ltac2-language/20882-ltac2-set-local-Added.rst
deleted file mode 100644
index 298bd027221e..000000000000
--- a/doc/changelog/06-Ltac2-language/20882-ltac2-set-local-Added.rst
+++ /dev/null
@@ -1,6 +0,0 @@
-- **Added:**
-  :cmd:`Ltac2 Set` supports :attr:`local` and :attr:`export`
-  (the default behaviour of `local` in sections and `export` outside sections has not changed)
-  (`#20882 `_,
-  fixes `#20879 `_,
-  by Gaëtan Gilbert).
diff --git a/doc/changelog/06-Ltac2-language/21023-ltac2-option-filter-Added.rst b/doc/changelog/06-Ltac2-language/21023-ltac2-option-filter-Added.rst
deleted file mode 100644
index 2f5d82b964bc..000000000000
--- a/doc/changelog/06-Ltac2-language/21023-ltac2-option-filter-Added.rst
+++ /dev/null
@@ -1,4 +0,0 @@
-- **Added:**
-  ``Ltac2.Option.filter``
-  (`#21023 `_,
-  by Jason Gross).
diff --git a/doc/changelog/06-Ltac2-language/21054-fix-ltac2-pat-parsing-Fixed.rst b/doc/changelog/06-Ltac2-language/21054-fix-ltac2-pat-parsing-Fixed.rst
deleted file mode 100644
index b373a06b27e1..000000000000
--- a/doc/changelog/06-Ltac2-language/21054-fix-ltac2-pat-parsing-Fixed.rst
+++ /dev/null
@@ -1,5 +0,0 @@
-- **Fixed:**
-  associativity of `::` in Ltac2 `match` patterns (:n:`@tac2pat2`)
-  (`#21054 `_,
-  fixes `#21045 `_,
-  by Gaëtan Gilbert).
diff --git a/doc/changelog/06-Ltac2-language/21094-ltac2-lpreterm-Added.rst b/doc/changelog/06-Ltac2-language/21094-ltac2-lpreterm-Added.rst
deleted file mode 100644
index 246c9d33c601..000000000000
--- a/doc/changelog/06-Ltac2-language/21094-ltac2-lpreterm-Added.rst
+++ /dev/null
@@ -1,5 +0,0 @@
-- **Added:**
-  :ref:`syntactic class ` `lpreterm` parsing terms
-  at precedence levl 200 and interpreting them as preterms
-  (`#21094 `_,
-  by Gaëtan Gilbert).
diff --git a/doc/changelog/06-Ltac2-language/21096-ltac2-message-lconstr-Added.rst b/doc/changelog/06-Ltac2-language/21096-ltac2-message-lconstr-Added.rst
deleted file mode 100644
index df3b5380e15c..000000000000
--- a/doc/changelog/06-Ltac2-language/21096-ltac2-message-lconstr-Added.rst
+++ /dev/null
@@ -1,4 +0,0 @@
-- **Added:**
-  `Ltac2.Message.of_lconstr` to print terms without surrounding parentheses
-  (`#21096 `_,
-  by Gaëtan Gilbert).
diff --git a/doc/changelog/06-Ltac2-language/21162-tac2relevance-Added.rst b/doc/changelog/06-Ltac2-language/21162-tac2relevance-Added.rst
deleted file mode 100644
index b6e2464d776a..000000000000
--- a/doc/changelog/06-Ltac2-language/21162-tac2relevance-Added.rst
+++ /dev/null
@@ -1,4 +0,0 @@
-- **Added:**
-  module `Ltac2.Constr.Relevance` for APIs about proof relevance annotations
-  (`#21162 `_,
-  by Gaëtan Gilbert).
diff --git a/doc/changelog/06-Ltac2-language/21178-tac2mod-Added.rst b/doc/changelog/06-Ltac2-language/21178-tac2mod-Added.rst
deleted file mode 100644
index 5bf68ddc90be..000000000000
--- a/doc/changelog/06-Ltac2-language/21178-tac2mod-Added.rst
+++ /dev/null
@@ -1,4 +0,0 @@
-- **Added:**
-  APIs for module introspection in `Ltac2.Module`
-  (`#21178 `_,
-  by Gaëtan Gilbert).
diff --git a/doc/changelog/06-Ltac2-language/21215-ltac2-custom-const-Added.rst b/doc/changelog/06-Ltac2-language/21215-ltac2-custom-const-Added.rst
deleted file mode 100644
index e57243b70ee3..000000000000
--- a/doc/changelog/06-Ltac2-language/21215-ltac2-custom-const-Added.rst
+++ /dev/null
@@ -1,5 +0,0 @@
-- **Added:**
-  :ref:`syntactic_classes` parsing terms support parsing at a specific level
-  and parsing :ref:`custom-entries`
-  (`#21215 `_,
-  by Gaëtan Gilbert).
diff --git a/doc/changelog/06-Ltac2-language/21222-tac2-solve-constraints-Added.rst b/doc/changelog/06-Ltac2-language/21222-tac2-solve-constraints-Added.rst
deleted file mode 100644
index 2b98db879b47..000000000000
--- a/doc/changelog/06-Ltac2-language/21222-tac2-solve-constraints-Added.rst
+++ /dev/null
@@ -1,4 +0,0 @@
-- **Added:**
-  `Ltac2.Unification.solve_constraints` (cf :tacn:`solve_constraints`)
-  (`#21222 `_,
-  by Gaëtan Gilbert).
diff --git a/doc/changelog/06-Ltac2-language/21239-tac2pr-things-Added.rst b/doc/changelog/06-Ltac2-language/21239-tac2pr-things-Added.rst
deleted file mode 100644
index 81c3e3f5e353..000000000000
--- a/doc/changelog/06-Ltac2-language/21239-tac2pr-things-Added.rst
+++ /dev/null
@@ -1,5 +0,0 @@
-- **Added:**
-  `Ltac2.Constant.print`, `Ltac2.Ind.print`, `Ltac2.Constructor.print`,
-  `Ltac2.Proj.print`, `Ltac2.Ident.print`, `Ltac2.Message.of_preterm`
-  (`#21239 `_,
-  by Gaëtan Gilbert).
diff --git a/doc/changelog/06-Ltac2-language/21264-tac2setglobal-Added.rst b/doc/changelog/06-Ltac2-language/21264-tac2setglobal-Added.rst
deleted file mode 100644
index e2f7e8458084..000000000000
--- a/doc/changelog/06-Ltac2-language/21264-tac2setglobal-Added.rst
+++ /dev/null
@@ -1,4 +0,0 @@
-- **Added:**
-  :cmd:`Ltac2 Set` supports attribute :attr:`global`
-  (`#21264 `_,
-  by Gaëtan Gilbert).
diff --git a/doc/changelog/06-Ltac2-language/21285-constr-delims-Deprecated.rst b/doc/changelog/06-Ltac2-language/21285-constr-delims-Deprecated.rst
deleted file mode 100644
index 709dafd8a613..000000000000
--- a/doc/changelog/06-Ltac2-language/21285-constr-delims-Deprecated.rst
+++ /dev/null
@@ -1,8 +0,0 @@
-- **Deprecated:**
-  syntactic classes parsing terms (`constr`, `lconstr`, etc.)
-  taking more than one :n:`@scope_key` argument without qualifying it with `delimiters`
-  (e.g. `constr(type, function)` should be `constr(delimiters(type, function))`
-  but a single argument like `constr(type)` is not deprecated).
-  See :n:`@ltac2_constr_synclass_arg`
-  (`#21285 `_,
-  by Gaëtan Gilbert).
diff --git a/doc/changelog/06-Ltac2-language/21299-ltac2-compact-Added.rst b/doc/changelog/06-Ltac2-language/21299-ltac2-compact-Added.rst
deleted file mode 100644
index 74a77ff00fa1..000000000000
--- a/doc/changelog/06-Ltac2-language/21299-ltac2-compact-Added.rst
+++ /dev/null
@@ -1,4 +0,0 @@
-- **Added:**
-  :flag:`Ltac2 Backtrace Compact` to reduce the output of :flag:`Ltac2 Backtrace`
-  (`#21299 `_,
-  by Gaëtan Gilbert).
diff --git a/doc/changelog/06-Ltac2-language/21334-ltac2-info-Added.rst b/doc/changelog/06-Ltac2-language/21334-ltac2-info-Added.rst
deleted file mode 100644
index 073b41e10f6f..000000000000
--- a/doc/changelog/06-Ltac2-language/21334-ltac2-info-Added.rst
+++ /dev/null
@@ -1,5 +0,0 @@
-- **Added:**
-  `Message.of_exninfo` and `Control.current_exninfo`
-  (`#21334 `_,
-  fixes `#21312 `_,
-  by Gaëtan Gilbert).
diff --git a/doc/changelog/06-Ltac2-language/21542-ltac2-scoped-notations-Added.rst b/doc/changelog/06-Ltac2-language/21542-ltac2-scoped-notations-Added.rst
new file mode 100644
index 000000000000..b1e4375e1bee
--- /dev/null
+++ b/doc/changelog/06-Ltac2-language/21542-ltac2-scoped-notations-Added.rst
@@ -0,0 +1,7 @@
+- **Added:**
+  scopes for :cmd:`Ltac2 Notation` to pick the interpretation at (Ltac2) typechecking time instead of parsing time,
+  similar to term notation scopes
+  (`#21542 `_,
+  fixes `#16538 `_
+  and `#17330 `_,
+  by Gaëtan Gilbert).
diff --git a/doc/changelog/06-Ltac2-language/21558-ltac2-transparent-state-Added.rst b/doc/changelog/06-Ltac2-language/21558-ltac2-transparent-state-Added.rst
new file mode 100644
index 000000000000..e96bc2524591
--- /dev/null
+++ b/doc/changelog/06-Ltac2-language/21558-ltac2-transparent-state-Added.rst
@@ -0,0 +1,6 @@
+- **Added:**
+  Low-level operations to manipulate transparent states:
+  1. Set-like operations (union, intersection, difference).
+  2. Operations to add/remove/test membership of constants, variables, and primitive projections.
+  (`#21558 `_,
+  by Mathis Bouverot-Dupuis).
diff --git a/doc/changelog/06-Ltac2-language/21617-tac2abbrev-up-Added.rst b/doc/changelog/06-Ltac2-language/21617-tac2abbrev-up-Added.rst
new file mode 100644
index 000000000000..c72827fd2bd5
--- /dev/null
+++ b/doc/changelog/06-Ltac2-language/21617-tac2abbrev-up-Added.rst
@@ -0,0 +1,6 @@
+- **Added:**
+  :cmd:`Ltac2 Abbreviation` typecheck the body at declaration time instead of when they are used.
+  This means incorrect abbreviations produce errors at declaration time, and also means quotations may be used inside abbreviations
+  (e.g. `Ltac2 Abbreviation foo := @foo.`)
+  (`#21617 `_,
+  by Gaëtan Gilbert).
diff --git a/doc/changelog/06-Ltac2-language/21642-redoer-goals-Added.rst b/doc/changelog/06-Ltac2-language/21642-redoer-goals-Added.rst
new file mode 100644
index 000000000000..2c0f3a767fcf
--- /dev/null
+++ b/doc/changelog/06-Ltac2-language/21642-redoer-goals-Added.rst
@@ -0,0 +1,5 @@
+- **Added:**
+  `Ltac2.Control.reorder_goals`
+  (`#21642 `_,
+  fixes `#20087 `_,
+  by Gaëtan Gilbert).
diff --git a/doc/changelog/06-Ltac2-language/21658-ltac2-scheme-lookup-Added.rst b/doc/changelog/06-Ltac2-language/21658-ltac2-scheme-lookup-Added.rst
new file mode 100644
index 000000000000..b90f492724a5
--- /dev/null
+++ b/doc/changelog/06-Ltac2-language/21658-ltac2-scheme-lookup-Added.rst
@@ -0,0 +1,5 @@
+- **Added:**
+  ``Scheme.lookup`` in Ltac2 to look up registered inductive schemes
+  (elimination, case analysis, etc.) by scheme kind (`#21658
+  `_, fixes `#20987
+  `_, by Jason Gross).
diff --git a/doc/changelog/06-Ltac2-language/21762-ltac2-strategy-Added.rst b/doc/changelog/06-Ltac2-language/21762-ltac2-strategy-Added.rst
new file mode 100644
index 000000000000..ae441c3f1b1e
--- /dev/null
+++ b/doc/changelog/06-Ltac2-language/21762-ltac2-strategy-Added.rst
@@ -0,0 +1,6 @@
+- **Added:**
+  :tacn:`with_strategy` to Ltac2, to allow temporarily changing the strategy
+  level of constants during tactic execution, with automatic restoration
+  afterward
+  (`#21762 `_,
+  by Jason Gross).
diff --git a/doc/changelog/06-Ltac2-language/21819-janno-ltac2-syntax-Added.rst b/doc/changelog/06-Ltac2-language/21819-janno-ltac2-syntax-Added.rst
new file mode 100644
index 000000000000..02d2317d23a0
--- /dev/null
+++ b/doc/changelog/06-Ltac2-language/21819-janno-ltac2-syntax-Added.rst
@@ -0,0 +1,4 @@
+- **Added:**
+  Add OCaml-inspired `@@` and `|>` notations
+  (`#21819 `_,
+  by Jan-Oliver Kaiser).
diff --git a/doc/changelog/06-Ltac2-language/21881-sprop-case-scheme-Added.rst b/doc/changelog/06-Ltac2-language/21881-sprop-case-scheme-Added.rst
new file mode 100644
index 000000000000..f4f1a7c76272
--- /dev/null
+++ b/doc/changelog/06-Ltac2-language/21881-sprop-case-scheme-Added.rst
@@ -0,0 +1,6 @@
+- **Added:**
+  ``Scheme.scase_dep`` and ``Scheme.scase_nodep`` in Ltac2 for SProp case
+  analysis scheme kinds, and support for registering SProp case schemes via the
+  ``Scheme`` command
+  (`#21881 `_,
+  by Jason Gross).
diff --git a/doc/changelog/06-Ltac2-language/22092-ltac2-match-level-Changed.rst b/doc/changelog/06-Ltac2-language/22092-ltac2-match-level-Changed.rst
new file mode 100644
index 000000000000..40cc44085b92
--- /dev/null
+++ b/doc/changelog/06-Ltac2-language/22092-ltac2-match-level-Changed.rst
@@ -0,0 +1,4 @@
+- **Changed:**
+  Parse ``match`` expressions at level 0 instead of level 5
+  (`#22092 `_,
+  by Rodolphe Lepigre).
diff --git a/doc/changelog/07-ssreflect/20707-ssrpat-FO-ignore-imparg-Changed.rst b/doc/changelog/07-ssreflect/20707-ssrpat-FO-ignore-imparg-Changed.rst
deleted file mode 100644
index 904b62f02288..000000000000
--- a/doc/changelog/07-ssreflect/20707-ssrpat-FO-ignore-imparg-Changed.rst
+++ /dev/null
@@ -1,10 +0,0 @@
-- **Changed:**
-  rewrite pattern selection algorithm made more robust in face of changes
-  to implicit arguments shape. This changes can result in a different
-  pattern selection in some corner cases.
-  The option `Set SsrMatching LegacyFoUnif` can be used to obtain the
-  previous behavior when repairing scripts
-  (`#20707 `_,
-  fixes `#16763 `_,
-  by Enrico Tassi with help from Georges Gonthier, Pierre Roux and
-  Quentin Vermande).
diff --git a/doc/changelog/07-ssreflect/21107-test-strict-right-assoc-Changed.rst b/doc/changelog/07-ssreflect/21107-test-strict-right-assoc-Changed.rst
deleted file mode 100644
index b83ee8adb92f..000000000000
--- a/doc/changelog/07-ssreflect/21107-test-strict-right-assoc-Changed.rst
+++ /dev/null
@@ -1,4 +0,0 @@
-- **Changed:**
-  level of notation ``'Under[ _ ]`` in `ssrunder.v` from 8 to 0
-  (`#21107 `_,
-  by Pierre Roux).
diff --git a/doc/changelog/07-ssreflect/21244-fix-ssrintro-Changed.rst b/doc/changelog/07-ssreflect/21244-fix-ssrintro-Changed.rst
deleted file mode 100644
index aa8effd00184..000000000000
--- a/doc/changelog/07-ssreflect/21244-fix-ssrintro-Changed.rst
+++ /dev/null
@@ -1,6 +0,0 @@
-- **Changed:**
-  level of ``tactic => intro_pattern`` notation to a left-associative
-  notation level with higher priority than level 3, rather than being
-  repeated in levels 3 (right-associative) and 4 (left-associative)
-  (`#21244 `_,
-  by Pierre Roux).
diff --git a/doc/changelog/07-ssreflect/21478-ssreflect-rw-Changed.rst b/doc/changelog/07-ssreflect/21478-ssreflect-rw-Changed.rst
new file mode 100644
index 000000000000..82bf5fe59af0
--- /dev/null
+++ b/doc/changelog/07-ssreflect/21478-ssreflect-rw-Changed.rst
@@ -0,0 +1,12 @@
+- **Changed:**
+  ``rewrite`` tactic for ``rw``. Since this was the major cause of
+  conflict with legacy tactics, ssreflect can now be loaded with less
+  conflicts through ``From Corelib Require Import ssreflect_rw.``.
+  For backward compatibility
+  ``From Corelib Require Import ssreflect.``
+  still loads a ``rewrite`` wrapper to ``rw`` as well as the
+  ``if  is  then  else ``
+  and ``if  isn't  then  else ``
+  syntactic sugars for match
+  (`#21478 `_,
+  by Pierre Roux).
diff --git a/doc/changelog/07-ssreflect/21611-of-ampersand-of-Removed.rst b/doc/changelog/07-ssreflect/21611-of-ampersand-of-Removed.rst
new file mode 100644
index 000000000000..c2b0d6113d31
--- /dev/null
+++ b/doc/changelog/07-ssreflect/21611-of-ampersand-of-Removed.rst
@@ -0,0 +1,5 @@
+- **Removed:**
+  the `of T` syntax for anonymous binders outside of constructors,
+  use `& T` instead
+  (`#21611 `_,
+  by Pierre Roux).
diff --git a/doc/changelog/07-ssreflect/22096-fix-ssr-univpoly-Fixed.rst b/doc/changelog/07-ssreflect/22096-fix-ssr-univpoly-Fixed.rst
new file mode 100644
index 000000000000..633bc2d48147
--- /dev/null
+++ b/doc/changelog/07-ssreflect/22096-fix-ssr-univpoly-Fixed.rst
@@ -0,0 +1,6 @@
+- **Fixed:**
+  Handling of universe polymorphism by ssrmatching (e.g. :tacn:`unlock` and :tacn:`rw` tactics),
+  now recording appropriate universe unifications.
+  (`#22096 `_,
+  fixes `#22086 `_,
+  by Matthieu Sozeau).
diff --git a/doc/changelog/08-vernac-commands-and-options/17266-alloc-limit-Added.rst b/doc/changelog/08-vernac-commands-and-options/17266-alloc-limit-Added.rst
new file mode 100644
index 000000000000..f29eb052248a
--- /dev/null
+++ b/doc/changelog/08-vernac-commands-and-options/17266-alloc-limit-Added.rst
@@ -0,0 +1,4 @@
+- **Added:**
+  :cmd:`AllocLimit` and :tacn:`alloc_limit` to enforce allocation limits during execution
+  (`#17266 `_,
+  by Gaëtan Gilbert).
diff --git a/doc/changelog/08-vernac-commands-and-options/19761-hintdb_doc.rst b/doc/changelog/08-vernac-commands-and-options/19761-hintdb_doc.rst
deleted file mode 100644
index 06a086cd0ce8..000000000000
--- a/doc/changelog/08-vernac-commands-and-options/19761-hintdb_doc.rst
+++ /dev/null
@@ -1,5 +0,0 @@
-- **Added:**
-  Additional documentation of Create HintDb (discriminated), proof search
-  tactic performance, matching process and hint transparency
-  (`#19761 `_,
-  by Jim Fehrle).
diff --git a/doc/changelog/08-vernac-commands-and-options/20698-rm-loose-hint-Removed.rst b/doc/changelog/08-vernac-commands-and-options/20698-rm-loose-hint-Removed.rst
deleted file mode 100644
index a8e3e0720ba1..000000000000
--- a/doc/changelog/08-vernac-commands-and-options/20698-rm-loose-hint-Removed.rst
+++ /dev/null
@@ -1,4 +0,0 @@
-- **Removed:**
-  flag `Loose Hint Behavior` which appears to have behaved as `Strict` regardless of how it was set for the last few versions
-  (`#20698 `_,
-  by Gaëtan Gilbert).
diff --git a/doc/changelog/08-vernac-commands-and-options/20827-print_hintdb_patterns-Changed.rst b/doc/changelog/08-vernac-commands-and-options/20827-print_hintdb_patterns-Changed.rst
deleted file mode 100644
index db7563b1658b..000000000000
--- a/doc/changelog/08-vernac-commands-and-options/20827-print_hintdb_patterns-Changed.rst
+++ /dev/null
@@ -1,6 +0,0 @@
-- **Changed:**
-  Default patterns displayed by :cmd:`Print HintDb` now show
-  pattern holes using the name from the original theorem
-  (e.g. :n:`?n` instead of :n:`?M3135`)
-  (`#20827 `_,
-  by Jim Fehrle).
diff --git a/doc/changelog/08-vernac-commands-and-options/21082-mutual-fixpoint-names-Fixed.rst b/doc/changelog/08-vernac-commands-and-options/21082-mutual-fixpoint-names-Fixed.rst
deleted file mode 100644
index 9a3d2793ab90..000000000000
--- a/doc/changelog/08-vernac-commands-and-options/21082-mutual-fixpoint-names-Fixed.rst
+++ /dev/null
@@ -1,5 +0,0 @@
-- **Fixed:**
-  Properly test for duplicate names in mutual blocks
-  (`#21082 `_,
-  fixes `#20766 `_,
-  by Yann Leray).
diff --git a/doc/changelog/08-vernac-commands-and-options/21103-show_cmd_diffs-Changed.rst b/doc/changelog/08-vernac-commands-and-options/21103-show_cmd_diffs-Changed.rst
deleted file mode 100644
index 5d4d01628d88..000000000000
--- a/doc/changelog/08-vernac-commands-and-options/21103-show_cmd_diffs-Changed.rst
+++ /dev/null
@@ -1,8 +0,0 @@
-- **Changed:**
-  :cmd:`Show` and :n:`Show goalnum` now show diffs (if enabled) in rocqtop.
-  Added :cmd:`Show Diffs` :n:`goalname` to show diffs for a named goal.
-  For emacs support; still no diffs shown for these commands in other
-  IDEs
-  (`#21103 `_,
-  fixes `#20793 `_,
-  by Jim Fehrle).
diff --git a/doc/changelog/08-vernac-commands-and-options/21114-hintdb-strict-check-Deprecated.rst b/doc/changelog/08-vernac-commands-and-options/21114-hintdb-strict-check-Deprecated.rst
deleted file mode 100644
index 713fdbecada9..000000000000
--- a/doc/changelog/08-vernac-commands-and-options/21114-hintdb-strict-check-Deprecated.rst
+++ /dev/null
@@ -1,5 +0,0 @@
-- **Deprecated:**
-  implicitly creating hint databases when declaring hints.
-  (`#21114 `_,
-  fixes `#4117 `_,
-  by Pierre-Marie Pédrot).
diff --git a/doc/changelog/08-vernac-commands-and-options/21163-scheme-attr-Added.rst b/doc/changelog/08-vernac-commands-and-options/21163-scheme-attr-Added.rst
deleted file mode 100644
index d6d93cd81cc4..000000000000
--- a/doc/changelog/08-vernac-commands-and-options/21163-scheme-attr-Added.rst
+++ /dev/null
@@ -1,5 +0,0 @@
-- **Added:**
-  attribute :attr:`schemes` to control automatic scheme declaration
-  (`#21163 `_,
-  fixes `#19480 `_,
-  by Gaëtan Gilbert).
diff --git a/doc/changelog/08-vernac-commands-and-options/21195-elimination-constraints-Added.rst b/doc/changelog/08-vernac-commands-and-options/21195-elimination-constraints-Added.rst
deleted file mode 100644
index e563f9cf7cdd..000000000000
--- a/doc/changelog/08-vernac-commands-and-options/21195-elimination-constraints-Added.rst
+++ /dev/null
@@ -1,5 +0,0 @@
-- **Added:**
-  Parsing of elimination constraints in prenex polymorphic definitions
-  as well as in constraints declaration :g:`Constraint s1 -> s2.`
-  (`#21195 `_,
-  by Johann Rosain).
diff --git a/doc/changelog/08-vernac-commands-and-options/21203-create-hint-rewrite-db-Added.rst b/doc/changelog/08-vernac-commands-and-options/21203-create-hint-rewrite-db-Added.rst
deleted file mode 100644
index 4e966ccca5cc..000000000000
--- a/doc/changelog/08-vernac-commands-and-options/21203-create-hint-rewrite-db-Added.rst
+++ /dev/null
@@ -1,5 +0,0 @@
-- **Added:**
-  a :cmd:`Create Rewrite HintDb` command to explicitly declare
-  rewrite hint databases
-  (`#21203 `_,
-  by Pierre-Marie Pédrot).
diff --git a/doc/changelog/08-vernac-commands-and-options/21206-deprecate-implicit-hint-rewrite-db-creation-Deprecated.rst b/doc/changelog/08-vernac-commands-and-options/21206-deprecate-implicit-hint-rewrite-db-creation-Deprecated.rst
deleted file mode 100644
index c533c4fd26ba..000000000000
--- a/doc/changelog/08-vernac-commands-and-options/21206-deprecate-implicit-hint-rewrite-db-creation-Deprecated.rst
+++ /dev/null
@@ -1,6 +0,0 @@
-- **Deprecated:**
-  creating implicitly rewrite hint databases through the
-  :cmd:`Hint Rewrite` command. One must now do it explicitly
-  through :cmd:`Create Rewrite HintDb`
-  (`#21206 `_,
-  by Pierre-Marie Pédrot).
diff --git a/doc/changelog/08-vernac-commands-and-options/21241-no-opt-schemes-Changed.rst b/doc/changelog/08-vernac-commands-and-options/21241-no-opt-schemes-Changed.rst
deleted file mode 100644
index 22049b73450d..000000000000
--- a/doc/changelog/08-vernac-commands-and-options/21241-no-opt-schemes-Changed.rst
+++ /dev/null
@@ -1,5 +0,0 @@
-- **Changed:**
-  `_rec` schemes are not defined using `_rect` schemes anymore.
-  In particular `eq_rec` is not defined using `eq_rect`
-  (`#21241 `_,
-  by Gaëtan Gilbert).
diff --git a/doc/changelog/08-vernac-commands-and-options/21248-scheme-rewriting-Added.rst b/doc/changelog/08-vernac-commands-and-options/21248-scheme-rewriting-Added.rst
deleted file mode 100644
index 954d53eb4009..000000000000
--- a/doc/changelog/08-vernac-commands-and-options/21248-scheme-rewriting-Added.rst
+++ /dev/null
@@ -1,4 +0,0 @@
-- **Added:**
-  :cmd:`Scheme Rewriting` to explicitly declare rewriting schemes for a given inductive
-  (`#21248 `_,
-  by Gaëtan Gilbert).
diff --git a/doc/changelog/08-vernac-commands-and-options/21313-copilot-fix-dependent-types-support-Fixed.rst b/doc/changelog/08-vernac-commands-and-options/21313-copilot-fix-dependent-types-support-Fixed.rst
deleted file mode 100644
index 1dc3dd81ffde..000000000000
--- a/doc/changelog/08-vernac-commands-and-options/21313-copilot-fix-dependent-types-support-Fixed.rst
+++ /dev/null
@@ -1,5 +0,0 @@
-- **Fixed:**
-  Fix Derive command to handle dependent types correctly
-  (`#21313 `_,
-  fixes `#21292 `_,
-  by copilot-swe-agent[bot]).
diff --git a/doc/changelog/08-vernac-commands-and-options/21326-indtab_globref-Changed.rst b/doc/changelog/08-vernac-commands-and-options/21326-indtab_globref-Changed.rst
deleted file mode 100644
index bb6f10401dc7..000000000000
--- a/doc/changelog/08-vernac-commands-and-options/21326-indtab_globref-Changed.rst
+++ /dev/null
@@ -1,4 +0,0 @@
-- **Changed:**
-  Generalize :cmd:`Register Scheme` from constants to constants, or inductive types, or constructors
-  (`#21326 `_,
-  by Thomas Lamiaux).
diff --git a/doc/changelog/08-vernac-commands-and-options/21332-derive-gname-Changed.rst b/doc/changelog/08-vernac-commands-and-options/21332-derive-gname-Changed.rst
deleted file mode 100644
index a088af87e52c..000000000000
--- a/doc/changelog/08-vernac-commands-and-options/21332-derive-gname-Changed.rst
+++ /dev/null
@@ -1,5 +0,0 @@
-- **Changed:**
-  :cmd:`Derive` names the existential variables it generates according using the name of the constant they will define
-  (e.g. `Derive X in X as x` binds `X` to an evar named `?X` instead of an anonymous evar (which would print as `?Goal`))
-  (`#21332 `_,
-  by Gaëtan Gilbert).
diff --git a/doc/changelog/08-vernac-commands-and-options/21419-sort-poly-flags-Changed.rst b/doc/changelog/08-vernac-commands-and-options/21419-sort-poly-flags-Changed.rst
deleted file mode 100644
index 98c7fcfac05e..000000000000
--- a/doc/changelog/08-vernac-commands-and-options/21419-sort-poly-flags-Changed.rst
+++ /dev/null
@@ -1,4 +0,0 @@
-- **Changed:**
-  Generalized universe polymorphism flag structure (ML API change)
-  (`#21419 `_,
-  by Matthieu Sozeau).
diff --git a/doc/changelog/08-vernac-commands-and-options/21437-print-assumptions-recursive-Changed.rst b/doc/changelog/08-vernac-commands-and-options/21437-print-assumptions-recursive-Changed.rst
deleted file mode 100644
index 2c70125ccd9d..000000000000
--- a/doc/changelog/08-vernac-commands-and-options/21437-print-assumptions-recursive-Changed.rst
+++ /dev/null
@@ -1,5 +0,0 @@
-- **Changed:**
-  :cmd:`Print Assumptions` now recurses into the types of axioms
-  (`#21437 `_,
-  fixes `#21436 `_,
-  by Jason Gross).
diff --git a/doc/changelog/08-vernac-commands-and-options/21443-copilot-add-fully-qualified-identifiers-Added.rst b/doc/changelog/08-vernac-commands-and-options/21443-copilot-add-fully-qualified-identifiers-Added.rst
deleted file mode 100644
index 69edea0d97dd..000000000000
--- a/doc/changelog/08-vernac-commands-and-options/21443-copilot-add-fully-qualified-identifiers-Added.rst
+++ /dev/null
@@ -1,6 +0,0 @@
-- **Added:**
-  :flag:`Printing Fully Qualified` to print all names (global references, modules,
-  module types, universes, etc) using fully qualified paths
-  (`#21443 `_,
-  fixes `#11852 `_,
-  by Jason Gross).
diff --git a/doc/changelog/08-vernac-commands-and-options/21473-fix-printing-Fixed.rst b/doc/changelog/08-vernac-commands-and-options/21473-fix-printing-Fixed.rst
index 106c6d059e88..41ac55a7ed7d 100644
--- a/doc/changelog/08-vernac-commands-and-options/21473-fix-printing-Fixed.rst
+++ b/doc/changelog/08-vernac-commands-and-options/21473-fix-printing-Fixed.rst
@@ -1,4 +1,5 @@
 - **Fixed:** fallback printing of inductives using
-  ```` should be rarer (it should in any case only
-  happen rarely from module errors) (`#21473
-  `_, by Jason Gross).
+  ```` now prints correctly
+  (though with possibly more qualification than needed)
+  (it should in any case only happen rarely from module errors)
+  (`#21484 `_, by Gaëtan Gilbert).
diff --git a/doc/changelog/08-vernac-commands-and-options/21477-print-assumptions-list-Changed.rst b/doc/changelog/08-vernac-commands-and-options/21477-print-assumptions-list-Changed.rst
deleted file mode 100644
index d00cb6237d91..000000000000
--- a/doc/changelog/08-vernac-commands-and-options/21477-print-assumptions-list-Changed.rst
+++ /dev/null
@@ -1,6 +0,0 @@
-- **Changed:**
-  :cmd:`Print Assumptions`, :cmd:`Print Opaque Dependencies`, :cmd:`Print
-  Transparent Dependencies`, and :cmd:`Print All Dependencies` now accept lists
-  of globals instead of single references
-  (`#21477 `_,
-  by Jason Gross).
diff --git a/doc/changelog/08-vernac-commands-and-options/21578-fix-induction-scheme-sprop-Fixed.rst b/doc/changelog/08-vernac-commands-and-options/21578-fix-induction-scheme-sprop-Fixed.rst
new file mode 100644
index 000000000000..6ab77ba393bd
--- /dev/null
+++ b/doc/changelog/08-vernac-commands-and-options/21578-fix-induction-scheme-sprop-Fixed.rst
@@ -0,0 +1,6 @@
+- **Fixed:** The default name of the induction principle in :g:`SProp`
+  generated by :g:`Scheme Induction for T Sort SProp` is now correct. It is now
+  :g:`T_sind`, instead of :g:`T_inds`. Similarly for :g:`Case`, the name will
+  now be :g:`T_scase` instead of :g:`T_cases`.
+  (`#21578 `_,
+  by Jean Caspar).
diff --git a/doc/changelog/08-vernac-commands-and-options/21626-noverbose-Removed.rst b/doc/changelog/08-vernac-commands-and-options/21626-noverbose-Removed.rst
new file mode 100644
index 000000000000..8ae1234f6166
--- /dev/null
+++ b/doc/changelog/08-vernac-commands-and-options/21626-noverbose-Removed.rst
@@ -0,0 +1,7 @@
+- **Removed:**
+  `-verbose` and `load-vernac-source-verbose` (`-lv`).
+  `-verbose` has been ignored for several versions.
+  `-lv` would print the input file (as-is from source, not pretty printed)
+  which does not seem useful
+  (`#21626 `_,
+  by Gaëtan Gilbert).
diff --git a/doc/changelog/08-vernac-commands-and-options/21645-print-regular-match-Added.rst b/doc/changelog/08-vernac-commands-and-options/21645-print-regular-match-Added.rst
new file mode 100644
index 000000000000..d344628c80bb
--- /dev/null
+++ b/doc/changelog/08-vernac-commands-and-options/21645-print-regular-match-Added.rst
@@ -0,0 +1,4 @@
+- **Added:**
+  flag :flag:`Printing Regular Matches` to disable alternate match syntaxes
+  (`#21645 `_,
+  by Gaëtan Gilbert).
diff --git a/doc/changelog/08-vernac-commands-and-options/21779-set-indices-matter-Added.rst b/doc/changelog/08-vernac-commands-and-options/21779-set-indices-matter-Added.rst
new file mode 100644
index 000000000000..5ebaf28a94c9
--- /dev/null
+++ b/doc/changelog/08-vernac-commands-and-options/21779-set-indices-matter-Added.rst
@@ -0,0 +1,6 @@
+- **Added:**
+  flag :flag:`Indices Matter` to set ``-indices-matter`` locally,
+  controlling whether the types of indices of inductive types
+  contribute universe constraints
+  (`#21779 `_,
+  by Jason Gross).
diff --git a/doc/changelog/08-vernac-commands-and-options/21823-genAbout-Changed.rst b/doc/changelog/08-vernac-commands-and-options/21823-genAbout-Changed.rst
new file mode 100644
index 000000000000..23dabd266def
--- /dev/null
+++ b/doc/changelog/08-vernac-commands-and-options/21823-genAbout-Changed.rst
@@ -0,0 +1,4 @@
+- **Changed:**
+  Generalize `About` to be able to handle several definitions at once
+  (`#21823 `_,
+  by Thomas Lamiaux).
diff --git a/doc/changelog/08-vernac-commands-and-options/21825-print-assumptions-globals-types-Fixed.rst b/doc/changelog/08-vernac-commands-and-options/21825-print-assumptions-globals-types-Fixed.rst
new file mode 100644
index 000000000000..f3852f52da28
--- /dev/null
+++ b/doc/changelog/08-vernac-commands-and-options/21825-print-assumptions-globals-types-Fixed.rst
@@ -0,0 +1,6 @@
+- **Fixed:**
+  :cmd:`Print Assumptions` now also traverses the types of global
+  definitions, not just their bodies, to detect dependencies on axioms
+  that appear only in the type
+  (`#21825 `_,
+  by Jason Gross).
diff --git a/doc/changelog/08-vernac-commands-and-options/21865-warn-missing-proof-Added.rst b/doc/changelog/08-vernac-commands-and-options/21865-warn-missing-proof-Added.rst
new file mode 100644
index 000000000000..39bf234415e0
--- /dev/null
+++ b/doc/changelog/08-vernac-commands-and-options/21865-warn-missing-proof-Added.rst
@@ -0,0 +1,4 @@
+- **Added:**
+  warning when an interactive proof is not started by :cmd:`Proof`, and error when :cmd:`Proof` is used multiple times or is used after a tactic has been used
+  (`#21865 `_,
+  by Gaëtan Gilbert).
diff --git a/doc/changelog/08-vernac-commands-and-options/21867-pr-debug-delta-resolver-Added.rst b/doc/changelog/08-vernac-commands-and-options/21867-pr-debug-delta-resolver-Added.rst
new file mode 100644
index 000000000000..1af8325f62c1
--- /dev/null
+++ b/doc/changelog/08-vernac-commands-and-options/21867-pr-debug-delta-resolver-Added.rst
@@ -0,0 +1,5 @@
+- **Added:**
+  a `Print Debug Delta` vernacular command to print debug
+  information about module delta-resolvers
+  (`#21867 `_,
+  by Pierre-Marie Pédrot).
diff --git a/doc/changelog/08-vernac-commands-and-options/21934-print-flat-Added.rst b/doc/changelog/08-vernac-commands-and-options/21934-print-flat-Added.rst
new file mode 100644
index 000000000000..9b4445d8f32a
--- /dev/null
+++ b/doc/changelog/08-vernac-commands-and-options/21934-print-flat-Added.rst
@@ -0,0 +1,4 @@
+- **Added:**
+  :cmd:`Print Grammar` with argument `Tree` to print the factorizations done by the grammar engine
+  (`#21934 `_,
+  by Gaëtan Gilbert).
diff --git a/doc/changelog/08-vernac-commands-and-options/21947-asymmetric-patterns-no-implicits-Changed.rst b/doc/changelog/08-vernac-commands-and-options/21947-asymmetric-patterns-no-implicits-Changed.rst
new file mode 100644
index 000000000000..179d430365c2
--- /dev/null
+++ b/doc/changelog/08-vernac-commands-and-options/21947-asymmetric-patterns-no-implicits-Changed.rst
@@ -0,0 +1,8 @@
+- **Changed:**
+  the behavior of the :flag:`Asymmetric Patterns` flag, which no
+  longer disactivates implicit arguments in patterns. Set the
+  compatibility flag :flag:`Asymmetric Patterns No Implicits` to
+  retrieve the previous behavior
+  (`#21947 `_,
+  fixes `#21769 `_,
+  by Pierre Roux).
diff --git a/doc/changelog/08-vernac-commands-and-options/22017-GeneralizePrint-Changed.rst b/doc/changelog/08-vernac-commands-and-options/22017-GeneralizePrint-Changed.rst
new file mode 100644
index 000000000000..3545344f864c
--- /dev/null
+++ b/doc/changelog/08-vernac-commands-and-options/22017-GeneralizePrint-Changed.rst
@@ -0,0 +1,4 @@
+- **Changed:**
+  Generalize Print command to print multiples definitions
+  (`#22017 `_,
+  by Elsa Rabu).
diff --git a/doc/changelog/09-cli-tools/20878-dep-coqlib-extra-Fixed.rst b/doc/changelog/09-cli-tools/20878-dep-coqlib-extra-Fixed.rst
deleted file mode 100644
index 3cbf1429360a..000000000000
--- a/doc/changelog/09-cli-tools/20878-dep-coqlib-extra-Fixed.rst
+++ /dev/null
@@ -1,6 +0,0 @@
-- **Fixed:**
-  ``rocq dep`` now handles non .vo dependencies from the ``ROCQPATH``
-  environment variable
-  (`#20878 `_,
-  fixes `#20835 `_,
-  by Gaëtan Gilbert).
diff --git a/doc/changelog/09-cli-tools/20907-corelib-header-Added.rst b/doc/changelog/09-cli-tools/20907-corelib-header-Added.rst
deleted file mode 100644
index a6ce57cc0001..000000000000
--- a/doc/changelog/09-cli-tools/20907-corelib-header-Added.rst
+++ /dev/null
@@ -1,5 +0,0 @@
-- **Added:**
-  :ref:`rocq doc ` replaces `@@TITLE@@` with the page title in custom HTML headers
-  (`#20907 `_,
-  fixes `#2511 `_,
-  by Gaëtan Gilbert).
diff --git a/doc/changelog/09-cli-tools/21038-fix21035-Changed.rst b/doc/changelog/09-cli-tools/21038-fix21035-Changed.rst
deleted file mode 100644
index 97db0cf58104..000000000000
--- a/doc/changelog/09-cli-tools/21038-fix21035-Changed.rst
+++ /dev/null
@@ -1,5 +0,0 @@
-- **Changed:**
-  in ``-emacs`` mode, goals are no longer spontaneously printed
-  (`#21038 `_,
-  fixes `#21035 `_,
-  by Pierre Roux).
diff --git a/doc/changelog/09-cli-tools/21423-rocq-wc-Proof-Fixed.rst b/doc/changelog/09-cli-tools/21423-rocq-wc-Proof-Fixed.rst
new file mode 100644
index 000000000000..7286abe00b17
--- /dev/null
+++ b/doc/changelog/09-cli-tools/21423-rocq-wc-Proof-Fixed.rst
@@ -0,0 +1,5 @@
+- **Fixed:**
+  ``rocq wc`` now handles tactics containing the word ``Proof`` correctly.
+  (`#21423 `_,
+  fixes `#21422 `_,
+  by Johannes Hostert).
diff --git a/doc/changelog/09-cli-tools/21950-coqdoc-alectryon-Added.rst b/doc/changelog/09-cli-tools/21950-coqdoc-alectryon-Added.rst
new file mode 100644
index 000000000000..d366b665b11b
--- /dev/null
+++ b/doc/changelog/09-cli-tools/21950-coqdoc-alectryon-Added.rst
@@ -0,0 +1,4 @@
+- **Added:**
+  New Alectryon Markdown backend for `rocq doc`
+  (`#21950 `_,
+  by Dario Halilovic).
diff --git a/doc/changelog/11-corelib/17876-master+gramlib-support-for-non-assoc-and-non-recovery-Changed.rst b/doc/changelog/11-corelib/17876-master+gramlib-support-for-non-assoc-and-non-recovery-Changed.rst
deleted file mode 100644
index 51563b47f05a..000000000000
--- a/doc/changelog/11-corelib/17876-master+gramlib-support-for-non-assoc-and-non-recovery-Changed.rst
+++ /dev/null
@@ -1,5 +0,0 @@
-- **Changed:**
-  Level of ``_~0`` and ``_~1`` reserved notations (used for positive
-  numbers) from level 7 to level 1
-  (`#17876 `_,
-  by Pierre Roux).
diff --git a/doc/changelog/11-corelib/20018-strengthen_fix_eq-Added.rst b/doc/changelog/11-corelib/20018-strengthen_fix_eq-Added.rst
deleted file mode 100644
index 02afd8b84330..000000000000
--- a/doc/changelog/11-corelib/20018-strengthen_fix_eq-Added.rst
+++ /dev/null
@@ -1,4 +0,0 @@
-- **Added:**
-  a slightly more general variant of Fix_eq which is sometimes more convenient
-  (`#20018 `_,
-  by Owen Conoly).
diff --git a/doc/changelog/11-corelib/21211-parray-notation-Changed.rst b/doc/changelog/11-corelib/21211-parray-notation-Changed.rst
deleted file mode 100644
index e965bde4f678..000000000000
--- a/doc/changelog/11-corelib/21211-parray-notation-Changed.rst
+++ /dev/null
@@ -1,4 +0,0 @@
-- **Changed:**
-  level of postfix notations in `PrimArray` to level 1
-  (`#21211 `_,
-  by Pierre Roux).
diff --git a/doc/changelog/11-corelib/21248-scheme-rewriting-Changed.rst b/doc/changelog/11-corelib/21248-scheme-rewriting-Changed.rst
deleted file mode 100644
index c45e9ccd91b8..000000000000
--- a/doc/changelog/11-corelib/21248-scheme-rewriting-Changed.rst
+++ /dev/null
@@ -1,6 +0,0 @@
-- **Changed:**
-  rewriting schemes for `eq·` and `eq_true` are explicitly declared in `Init.Logic`
-  instead of dynamically when a tactic needs them.
-  For instance `EqdepFacts.internal_eq_rew_dep` does not exist anymore and instead `Logic.eq_rew_dep` is available
-  (`#21248 `_,
-  by Gaëtan Gilbert).
diff --git a/doc/changelog/11-corelib/21971-number-nota-Changed.rst b/doc/changelog/11-corelib/21971-number-nota-Changed.rst
new file mode 100644
index 000000000000..4ce3ec400b94
--- /dev/null
+++ b/doc/changelog/11-corelib/21971-number-nota-Changed.rst
@@ -0,0 +1,4 @@
+- **Changed:**
+  number notations for `nat` `Number.int` and `Number.uint` are now declared in `NumberNotations` submodules of `Nat` and `Number`. The submodules are exported from `Nat` and `Number` (which are not imported by default) and from `Prelude` (which is imported by default) so visible changes should be rare
+  (`#21971 `_,
+  by Gaëtan Gilbert).
diff --git a/doc/changelog/13-extraction/21350-issue-21176-Fixed.rst b/doc/changelog/13-extraction/21350-issue-21176-Fixed.rst
deleted file mode 100644
index 6113920aea3e..000000000000
--- a/doc/changelog/13-extraction/21350-issue-21176-Fixed.rst
+++ /dev/null
@@ -1,5 +0,0 @@
-- **Fixed:**
-  Added "effect" as a recognized keyword for ocaml extraction
-  (`#21350 `_,
-  fixes `#21176 `_,
-  by Dan Rostovtsev).
diff --git a/doc/changelog/14-misc/19987-fold-evd-Changed.rst b/doc/changelog/14-misc/19987-fold-evd-Changed.rst
deleted file mode 100644
index 770f535117e3..000000000000
--- a/doc/changelog/14-misc/19987-fold-evd-Changed.rst
+++ /dev/null
@@ -1,4 +0,0 @@
-- **Changed:**
-  The unification algorithm (evarconv) may need to unfold its two input terms to succeed. Now, when one of the terms is an evar, it instantiates it with the folded version of the other term. In other words, tactics now unfold less than before, which may change the behavior of subsequent tactics.
-  (`#19987 `_,
-  by Quentin Vermande).
diff --git a/doc/changelog/14-misc/20809-autonaming-goals-Added.rst b/doc/changelog/14-misc/20809-autonaming-goals-Added.rst
deleted file mode 100644
index e029c092af4f..000000000000
--- a/doc/changelog/14-misc/20809-autonaming-goals-Added.rst
+++ /dev/null
@@ -1,5 +0,0 @@
-- **Added:**
-  Goal names can be automatically generated for :tacn:`induction`,
-  :tacn:`destruct` and :tacn:`eapply` by using the :flag:`Generate Goal Names` flag
-  (`#20809 `_,
-  by Dario Halilovic).
diff --git a/doc/changelog/14-misc/20813-better-names-for-induction-principle-cases-Changed.rst b/doc/changelog/14-misc/20813-better-names-for-induction-principle-cases-Changed.rst
deleted file mode 100644
index b7bc131f3ce7..000000000000
--- a/doc/changelog/14-misc/20813-better-names-for-induction-principle-cases-Changed.rst
+++ /dev/null
@@ -1,4 +0,0 @@
-- **Changed:**
-  Hypotheses of generated induction schemes use the constructor name instead of `f`, `f0`, etc
-  (`#20813 `_,
-  by Dario Halilovic).
diff --git a/doc/changelog/14-misc/21306-ramp-up-cond-Changed.rst b/doc/changelog/14-misc/21306-ramp-up-cond-Changed.rst
deleted file mode 100644
index adbb488f9033..000000000000
--- a/doc/changelog/14-misc/21306-ramp-up-cond-Changed.rst
+++ /dev/null
@@ -1,5 +0,0 @@
-- **Changed:**
-  use `Gc.ramp_up` while executing :cmd:`Require` on OCaml 5.4 and later.
-  This should partially mitigate the performance lost since OCaml 4.14
-  (`#21306 `_,
-  by Gaëtan Gilbert).
diff --git a/doc/changelog/14-misc/21852-warnerror-legacy-loading-Removed.rst b/doc/changelog/14-misc/21852-warnerror-legacy-loading-Removed.rst
new file mode 100644
index 000000000000..561da3291ae0
--- /dev/null
+++ b/doc/changelog/14-misc/21852-warnerror-legacy-loading-Removed.rst
@@ -0,0 +1,6 @@
+- **Removed:**
+  legacy loading mode for plugins, that was deprecated in Rocq 9.0.
+  To adapt, change your ``Declare ML Module "legacy:current".``
+  to ``Declare ML Module "current".``
+  (`#21852 `_,
+  by Pierre Roux).
diff --git a/doc/corelib/index-list.html.template b/doc/corelib/index-list.html.template
index 2e8228ac8a98..43b5d3498687 100644
--- a/doc/corelib/index-list.html.template
+++ b/doc/corelib/index-list.html.template
@@ -113,6 +113,7 @@ through the Require Import command.

   

     theories/Corelib/ssrmatching/ssrmatching.v
     theories/Corelib/ssr/ssrclasses.v
+    theories/Corelib/ssr/ssreflect_rw.v
     theories/Corelib/ssr/ssreflect.v
     theories/Corelib/ssr/ssrbool.v
     theories/Corelib/ssr/ssrfun.v
@@ -157,6 +158,7 @@ through the Require Import command.

     theories/Ltac2/Ref.v
     theories/Ltac2/Reference.v
     theories/Ltac2/Rewrite.v
+    theories/Ltac2/Scheme.v
     theories/Ltac2/Std.v
     theories/Ltac2/String.v
     theories/Ltac2/TransparentState.v
@@ -173,6 +175,7 @@ through the Require Import command.

     theories/Corelib/Compat/Coq820.v
     theories/Corelib/Compat/Rocq90.v
     theories/Corelib/Compat/Rocq91.v
+    theories/Corelib/Compat/Rocq92.v
     theories/Ltac2/Compat/Coq818.v
     theories/Ltac2/Compat/Coq819.v
   

diff --git a/doc/dune b/doc/dune
deleted file mode 100644
index d342c1761176..000000000000
--- a/doc/dune
+++ /dev/null
@@ -1,41 +0,0 @@
-(rule
- (targets unreleased.rst)
- (deps (source_tree changelog))
- (action (with-stdout-to %{targets} (bash "cat changelog/00-title.rst changelog/*/*.rst"))))
-
-(alias
- (name refman-deps)
- (deps
-  ; We could use finer dependencies here so the build is faster:
-  ;
-  ; - vo files: generated by sphinx after parsing the doc, promoted,
-  ; - Static files:
-  ;   + %{bin:coqdoc} etc...
-  ;   + config/coq_config.py
-  ;   + tools/coqdoc/coqdoc.css
-  (package rocq-runtime)
-  (package rocq-core)
-  (source_tree sphinx)
-  (source_tree tools/rocqrst)
-  ../config/coq_config.py
-  unreleased.rst
-  (env_var SPHINXWARNOPT)
-  (env_var ROCQRST_EXTRA)))
-
-(rule
- (targets
-  (dir refman-html))
- (alias refman-html)
- (deps (alias refman-deps))
- (action
-  (run env sphinx-build -q %{env:SPHINXWARNOPT=-W} -b html sphinx %{targets})))
-
-(rule
- (targets
-  (dir refman-pdf))
- (alias refman-pdf)
- (deps ../ide/rocqide/coq.png  (alias refman-deps))
- (action
-  (progn
-   (run env sphinx-build -q %{env:SPHINXWARNOPT=-W} -b latex sphinx %{targets})
-   (chdir %{targets} (run make LATEXMKOPTS=-silent)))))
diff --git a/doc/plugin_tutorial/tuto1/src/g_tuto1.mlg b/doc/plugin_tutorial/tuto1/src/g_tuto1.mlg
index 0f0a2e1678b2..fe07dd76f378 100644
--- a/doc/plugin_tutorial/tuto1/src/g_tuto1.mlg
+++ b/doc/plugin_tutorial/tuto1/src/g_tuto1.mlg
@@ -22,7 +22,7 @@ open Stdarg
 (*
  * This command prints an input from the user.
  *
- * A list with allowable inputs can be found in interp/stdarg.mli,
+ * A list with allowable inputs can be found in tactics/stdarg.mli,
  * plugin/ltac/extraargs.mli, and plugin/ssr/ssrparser.mli
  * (remove the wit_ prefix), but not all of these are allowable
  * (unit and bool, for example, are not usable from within here).
diff --git a/doc/plugin_tutorial/tuto2/src/g_tuto2.mlg b/doc/plugin_tutorial/tuto2/src/g_tuto2.mlg
index 89d86c206e03..ac219c94f801 100644
--- a/doc/plugin_tutorial/tuto2/src/g_tuto2.mlg
+++ b/doc/plugin_tutorial/tuto2/src/g_tuto2.mlg
@@ -237,7 +237,7 @@ END
    This variable i then can be used in the interpretation rule.
 
    To see value of which Ocaml types can be bound this way,
-   look at the wit_* function declared in interp/stdarg.mli
+   look at the wit_* function declared in tactics/stdarg.mli
    (in the Coq's codebase). There are more examples in tuto1.
 
    If we drop the wit_ prefix, we will get the token
diff --git a/doc/plugin_tutorial/tuto3/src/tuto_tactic.ml b/doc/plugin_tutorial/tuto3/src/tuto_tactic.ml
index 30c08dee43c5..6fa5f8080d87 100644
--- a/doc/plugin_tutorial/tuto3/src/tuto_tactic.ml
+++ b/doc/plugin_tutorial/tuto3/src/tuto_tactic.ml
@@ -102,8 +102,8 @@ let two_lambda_pattern sigma term =
   function like *)
 let get_type_of_hyp env id =
   match EConstr.lookup_named id env with
-  | Context.Named.Declaration.LocalAssum (_, ty) -> ty
-  | _ -> CErrors.user_err (let open Pp in
+  | LocalAssum (_, ty) -> ty
+  | LocalDef _ -> CErrors.user_err (let open Pp in
                              str (Names.Id.to_string id) ++
                              str " is not a plain hypothesis")
 
diff --git a/doc/sphinx/addendum/generalized-rewriting.rst b/doc/sphinx/addendum/generalized-rewriting.rst
index 03488da68d87..d89d5866ecaa 100644
--- a/doc/sphinx/addendum/generalized-rewriting.rst
+++ b/doc/sphinx/addendum/generalized-rewriting.rst
@@ -9,9 +9,11 @@ This chapter presents the extension of several equality related
 tactics to work over user-defined structures (called setoids) that are
 equipped with ad-hoc equivalence relations meant to behave as
 equalities. Actually, the tactics have also been generalized to
-relations weaker than equivalences (e.g. rewriting systems). The
-toolbox also extends the automatic rewriting capabilities of the
-system, allowing the specification of custom strategies for rewriting.
+relations weaker than equivalences (e.g. rewriting systems).
+The toolbox also extends the automatic rewriting capabilities of the
+system, allowing the specification of :ref:`custom strategies `
+for rewriting *or* applying :ref:`conversions ` (in that case,
+requiring no proof terms).
 
 This documentation is adapted from the previous setoid documentation
 by Claudio Sacerdoti Coen (based on previous work by Clément Renard).
@@ -482,7 +484,7 @@ It is used in two cases:
      constraint can be automatically discharged.
 
    + Compatibility with ssreflect's rewrite:
-     The :tacn:`rewrite (ssreflect)` tactic uses generalized rewriting when possible, by
+     The :tacn:`rw` tactic uses generalized rewriting when possible, by
      checking that a ``RewriteRelation R`` instance exists when rewriting with a
      term of type ``R t u``.
 
@@ -973,10 +975,10 @@ Strategies for rewriting
 Usage
 ~~~~~
 
-.. tacn:: rewrite_strat @rewstrategy {? in @ident }
+.. tacn:: rewrite_strat @rewstrategy2 {? in @ident }
    :name: rewrite_strat
 
-   Rewrite using :n:`@rewstrategy` in the conclusion or in the hypothesis :n:`@ident`.
+   Rewrite using :n:`@rewstrategy2` in the conclusion or in the hypothesis :n:`@ident`.
 
    .. exn:: Nothing to rewrite.
 
@@ -1009,11 +1011,23 @@ on the programmable rewriting strategies with generic traversals by Visser et al
 the Stratego transformation language :cite:`Visser01`. Rewriting strategies
 are applied using the :tacn:`rewrite_strat` tactic.
 
-.. insertprodn rewstrategy rewstrategy0
+The :tacn:`rewrite_strat` tactic is more general than :tacn:`setoid_rewrite` as
+it can also be used to apply arbitrary :ref:`conversion strategies `
+in terms, that need not be justified by proof terms and congruence lemmas, as
+all terms are congruent for conversion in Rocq's theory. For example,
+the `eval` and `fold` strategies do not produce proofs: they can be used to apply
+:ref:`conversions ` at selected subterms. The :n:`tactic` strategy
+further allows arbitrary customization of strategies through :ref:`Ltac1 ` or :ref:`Ltac2 ` tactics.
+
+The following describes the :ref:`Ltac1 ` version of the strategies. An :ref:`Ltac2 ` version
+with the same primitives is available in the :g:`Ltac2.Rewrite` module.
+
+.. insertprodn rewstrategy2 rewstrategy0
 
 .. prodn::
-   rewstrategy ::= fix @ident := @rewstrategy1
+   rewstrategy2 ::= fix @ident := @rewstrategy1
    | {+; @rewstrategy1 }
+   | @rewstrategy1
    rewstrategy1 ::= <- @one_term
    | progress @rewstrategy1
    | try @rewstrategy1
@@ -1030,13 +1044,15 @@ are applied using the :tacn:`rewrite_strat` tactic.
    | terms {* @one_term }
    | eval @red_expr
    | fold @one_term
+   | matches @one_term
+   | tactic @ltac_expr
    | @rewstrategy0
    | old_hints @ident
    rewstrategy0 ::= @one_term
    | fail
    | id
    | refl
-   | ( @rewstrategy )
+   | ( @rewstrategy2 )
 
 :n:`@one_term`
    lemma, left to right
@@ -1053,13 +1069,19 @@ are applied using the :tacn:`rewrite_strat` tactic.
 :n:`<- @one_term`
    lemma, right to left
 
+:n:`terms {* @one_term }`
+   rewrite with any of the lemmas
+
+:n:`hints @ident`
+   rewrite with any of the rewrite hints from the given rewrite hint database
+
 :n:`progress @rewstrategy1`
    progress
 
 :n:`try @rewstrategy1`
    try catch
 
-:n:`@rewstrategy ; @rewstrategy1`
+:n:`{+; @rewstrategy1 }`
    composition
 
 :n:`choice {+ @rewstrategy0 }`
@@ -1090,33 +1112,62 @@ are applied using the :tacn:`rewrite_strat` tactic.
    rewriting :n:`(a && b) && c` with `andbC` gives :n:`c && (a && b)`.
 
 :n:`bottomup @rewstrategy1`
-   bottom-up
+   bottom-up: recursively processes subterms of the term before applying the strategy
 
 :n:`topdown @rewstrategy1`
-   top-down
-
-:n:`hints @ident`
-   apply hints from hint database
-
-:n:`terms {* @one_term }`
-   any of the terms
+   top-down: applies the strategy or goes into subterms, recursively
 
 :n:`eval @red_expr`
-   apply reduction
+   apply a reduction, see :ref:`conversions `.
+   This is a conversion rule.
 
 :n:`fold @term`
-   unify
+   if the current term unifies with :n:`@term`, replace it with :n:`@term`.
+   This is a conversion rule.
 
 :n:`fix @ident := @rewstrategy1`
    fixpoint operator, where :math:`\texttt{fix }f := v` evaluates to
    :math:`\subst{v}{f}{(\texttt{fix }f := v)}`
 
-:n:`( @rewstrategy )`
-   to be documented
+:n:`( @rewstrategy2 )`
+   parenthesizes for disambiguation, applies :n:`@rewstrategy2`
 
 :n:`old_hints @ident`
    to be documented
 
+:n:`matches @one_term`
+   This strategy is the identity (:n:`id`) if the current term matches
+   the given pattern, and :n:`fail` otherwise.
+
+:n:`tactic @ltac_expr`
+   The tactic is applied to a goal of shape :n:`?R lhs ?rhs` in the environment
+   of `lhs`. It can instantiate the relation
+   :n:`?R` and right-hand-side :n:`?rhs` with terms of its choice.
+   The tactic must solve the goal to succeed. This inserts
+   the proof term as a witness of a rewriting from :n:`lhs` to :n:`?rhs` using relation :n:`?R`.
+   The following strategy starts from the new term :n:`?rhs`. If the tactic fails, the
+   strategy fails.
+
+   The :ref:`Ltac2 ` variant has a different interface. :n:`Ltac2.Strategy.tactic` takes
+   a tactic of type :n:`constr -> constr -> constr option -> rewrite_result` parameterized by a
+   carrier type, the left-hand side :n:`lhs` (of the carrier type) to be rewritten and an optional
+   relation on the carrier type.  It returns an :n:`Ltac2.Strategy.rewrite_result`.
+   The tactic is run on a single goal of type :n:`unit` and context the environment of the :n:`lhs` term. It should not solve the goal, but rather simply return a :n:`rewrite_result`. The result can be:
+
+   + a :n:`Success s` where :n:`s : Ltac2.Strategy.rewrite_success` is a record containing
+     a relation :n:`rel`, a right-hand-side :n:`rhs` and a proof :n:`prf` which should be
+     of type :n:`rel lhs rhs`.
+
+   + a :n:`Fail` constructor indicating the strategy failed, i.e. behaving like :n:`fail`.
+
+   + an :n:`Identity` constructor indicating the strategy succeeded with no rewrite, i.e.,
+     behaving like :n:`id`.
+
+   A failure of the tactic is raised to the toplevel :tacn:`rewrite_strat` call.
+   In both cases, if the successful proof :n:`prf` is syntactically of the shape
+   :n:`core.eq.refl ?carrier ?t`, the rewrite is turned into a *conversion*, which
+   just corresponds to a type cast in the proof term and does not require inferring
+   congruence proofs as conversion is applicable anywhere in a term.
 
 Conceptually, a few of these are defined in terms of the others:
 
@@ -1160,6 +1211,9 @@ if it reduces the subterm under consideration. The ``fold`` strategy takes
 a :token:`term` and tries to *unify* it to the current subterm, converting it to :token:`term`
 on success. It is stronger than the tactic ``fold``.
 
+The ``tactic`` strategy allows to express custom rewriting strategies and
+subterm selection choices.
+
 .. note::
    The symbol ';' is used to separate sequences of tactics as well as
    sequences of rewriting strategies.
@@ -1181,12 +1235,14 @@ on success. It is stronger than the tactic ``fold``.
       Set Printing Parentheses.
       Local Open Scope bool_scope.
       Goal forall a b c : bool, a && b && c = true.
+      Proof.
       rewrite_strat innermost andbC.
 
    .. rocqtop:: none
 
       Abort.
       Goal forall a b c : bool, a && b && c = true.
+      Proof.
 
    Using :n:`outermost` instead gives this result:
 
diff --git a/doc/sphinx/addendum/implicit-coercions.rst b/doc/sphinx/addendum/implicit-coercions.rst
index 98a066464ba9..e0ef8ff838be 100644
--- a/doc/sphinx/addendum/implicit-coercions.rst
+++ b/doc/sphinx/addendum/implicit-coercions.rst
@@ -167,14 +167,6 @@ Coercion Classes
      :term:`reversible coercion`. By default coercions are not reversible except for
      :cmd:`Record` fields specified using :g:`:>`.
 
-  .. attr:: nonuniform
-
-     Silence the non uniform inheritance warning.
-
-     .. deprecated:: 8.18
-
-        Use the :attr:`warnings` attribute instead with "-uniform-inheritance".
-
   .. exn:: @qualid not declared.
 
      :token:`qualid` is not defined globally.
diff --git a/doc/sphinx/addendum/ring.rst b/doc/sphinx/addendum/ring.rst
index 5a1ce2821722..f7462cc08c57 100644
--- a/doc/sphinx/addendum/ring.rst
+++ b/doc/sphinx/addendum/ring.rst
@@ -166,10 +166,12 @@ Concrete usage
     Goal forall a b c:Z, 
         (a + b + c) ^ 2 = 
          a * a + b ^ 2 + c * c + 2 * a * b + 2 * a * c + 2 * b * c.
+    Proof.
     intros; ring.
     Abort.
     Goal forall a b:Z, 
          2 * a * b = 30 -> (a + b) ^ 2 = a ^ 2 + b ^ 2 + 30.
+    Proof.
     intros a b H; ring [H].
     Abort.
 
@@ -572,10 +574,12 @@ Dealing with fields
     Open Scope R_scope.
     Goal forall x,
            x <> 0 -> (1 - 1 / x) * x - x + 1 = 0.
+    Proof.
     intros; field; auto.
     Abort.
     Goal forall x y, 
            y <> 0 -> y = x -> x / y = 1.
+    Proof.
     intros x y H H1; field [H1]; auto.
     Abort.
 
@@ -589,6 +593,7 @@ Dealing with fields
       (x * y > 0)%R ->
       (x * (1 / x + x / (x + y)))%R =
       ((- 1 / y) * y * (- x * (x / (x + y)) - 1))%R.
+      Proof.
 
       intros; field.
 
@@ -723,6 +728,7 @@ for Coq’s type checker. Let us see why:
   Open Scope Z_scope.
   Goal forall x y z : Z, 
          x + 3 + y + y * z = x + 3 + y + z * y.
+  Proof.
   intros; rewrite (Zmult_comm y z); reflexivity.
   Save foo.
   Print foo.
diff --git a/doc/sphinx/addendum/sprop.rst b/doc/sphinx/addendum/sprop.rst
index 24637946253f..e373e65a00fb 100644
--- a/doc/sphinx/addendum/sprop.rst
+++ b/doc/sphinx/addendum/sprop.rst
@@ -134,6 +134,8 @@ non-:math:`\SProp` sorts (through record η-extensionality).
    Goal forall (A : SProp) (r : rBox A), r = {| runbox := r.(runbox A) |}.
    Proof. intros A r. Fail reflexivity. Abort.
 
+.. _record-eta-restriction:
+
 In contrast, primitive records in relevant sorts with at least one relevant field
 are allowed and have η-conversion.
 
@@ -145,6 +147,36 @@ are allowed and have η-conversion.
                 s = {| spr1 := s.(spr1 A P); spr2 := s.(spr2 A P) |}.
    Proof. intros A P s. reflexivity. Qed.
 
+Sort polymorphic primitive records are allowed and η-conversion depends on
+the actual instantiation of sorts.
+
+.. rocqtop:: in
+
+    Set Universe Polymorphism.
+
+    Inductive eq@{s; u} (A : Type@{s;u}) (a : A) : A -> Prop :=
+      eq_refl : eq A a a.
+
+    Arguments eq {_}.
+    Arguments eq_refl {_ _}.
+
+   Record RSToS'@{s s'; u u'| s' -> s +} (A : Type@{s;u}): Type@{s';u'} := {
+     rsprj : A
+   }.
+
+   (* Conversion when record is in Type and field in SProp fails correctly *)
+   Goal forall (A:SProp) (rs : RSToS'@{SProp Type; 0 0} A),
+                  eq rs {| rsprj := rs.(rsprj A) |}.
+   Proof. intros A rs. Fail reflexivity. Abort.
+
+   (* Conversion when record and field are instantiated to SProp checks correctly *)
+   Goal forall (A:SProp) (rs : RSToS'@{SProp SProp; 0 0} A),
+                  eq rs {| rsprj := rs.(rsprj A) |}.
+   Proof. intros A rs. reflexivity. Qed.
+
+   Unset Universe Polymorphism.
+
+
 Encodings for strict propositions
 ---------------------------------
 
@@ -189,7 +221,7 @@ Definitional UIP
 Definitional UIP involves a special reduction rule through which
 reduction depends on conversion. Consider the following code:
 
-.. rocqtop:: in
+.. rocqtop:: reset in
 
    Set Definitional UIP.
 
@@ -221,25 +253,30 @@ Non Termination with UIP
 ++++++++++++++++++++++++
 
 The special reduction rule of UIP combined with an impredicative sort
+(including `SProp`)
 breaks termination of reduction
 :cite:`abel19:failur_normal_impred_type_theor`:
 
 .. rocqtop:: all
 
-   Axiom all_eq : forall (P Q:Prop), P -> Q -> seq P Q.
+   Axiom all_eq : forall (P Q:Set), seq P Q.
+
+   Definition transport (P Q:Set) (x:P) : Q
+     := match all_eq P Q with srefl _ => x end.
+
+   Record Box (A:SProp) : Set := box { unbox : A }.
+   Arguments box {_}. Arguments unbox {_}.
 
-   Definition transport (P Q:Prop) (x:P) (y:Q) : Q
-   := match all_eq P Q x y with srefl _ => x end.
+   Definition transportS (P Q : SProp) (x:P) : Q
+     := unbox (transport (Box P) (Box Q) (box x)).
 
-   Definition top : Prop := forall P : Prop, P -> P.
+   Definition top : SProp := forall P : SProp, P -> P.
 
-   Definition c : top :=
-     fun P p =>
-     transport
-     (top -> top)
-     P
-     (fun x : top => x (top -> top) (fun x => x) x)
-     p.
+   Definition c : top := fun P p =>
+     transportS
+       (top -> top)
+       P
+       (fun x : top => x (top -> top) (fun x => x) x).
 
    Fail Timeout 1 Eval lazy in c (top -> top) (fun x => x) c.
 
diff --git a/doc/sphinx/addendum/type-classes.rst b/doc/sphinx/addendum/type-classes.rst
index 220935e33cad..c8855e38d5d6 100644
--- a/doc/sphinx/addendum/type-classes.rst
+++ b/doc/sphinx/addendum/type-classes.rst
@@ -59,9 +59,6 @@ proof mode with no open goals is started.
    #[refine] Instance unit_EqDec' : EqDec unit := { eqb x y := true }.
    Proof. intros [] [];reflexivity. Defined.
 
-Note that if you finish the proof with :cmd:`Qed` the entire instance
-will be opaque, including the fields given in the initial term.
-
 Alternatively, in :flag:`Program Mode` if one does not give all the
 members in the Instance declaration, Rocq generates obligations for the
 remaining fields, e.g.:
@@ -369,16 +366,7 @@ Command summary
    Like :cmd:`Definition`, it also supports the :attr:`program`
    attribute to switch the type checking to `Program` (chapter
    :ref:`programs`) and to use the obligation mechanism to manage missing
-   fields.
-
-   Finally, it supports the lighter :attr:`refine` attribute:
-
-   .. attr:: refine
-
-      This :term:`attribute` can be used to leave holes or not provide all
-      fields in the definition of an instance and open the tactic mode
-      to fill them.  It works exactly as if no :term:`body` had been given and
-      the :tacn:`refine` tactic has been used first.
+   fields, and it also supports the lighter :attr:`refine` attribute:
 
    .. cmd:: Declare Instance @ident_decl {* @binder } : @term {? @hint_info }
 
diff --git a/doc/sphinx/addendum/universe-polymorphism.rst b/doc/sphinx/addendum/universe-polymorphism.rst
index 400f40336e3e..671955f64fa5 100644
--- a/doc/sphinx/addendum/universe-polymorphism.rst
+++ b/doc/sphinx/addendum/universe-polymorphism.rst
@@ -612,7 +612,7 @@ Printing universes
    names (adjusting constraints to preserve the implied transitive
    constraints between kept universes). :n:`@debug_univ_name` is
    :n:`@qualid` for named universes (e.g. `eq.u0`), and :n:`@string`
-   for raw universe expressions (e.g. `"Stdlib.Init.Logic.1"`).
+   for raw universe expressions (e.g. `"Corelib.Init.Logic.1"`).
 
    By default when printing a subgraph `Print Universes` attempts to
    find and print the source of the constraints. This can be
@@ -800,8 +800,6 @@ To be able to instantiate a sort with `Prop` or `SProp`, we must
 quantify over :gdef:`sort qualities`. Definitions which quantify over
 sort qualities are called :gdef:`sort polymorphic`.
 
-All sort quality variables must be explicitly bound.
-
 .. rocqtop:: all
 
    Polymorphic Definition sort@{s ; u} := Type@{s;u}.
@@ -840,6 +838,7 @@ witness these temporary variables.
 .. rocqtop:: in
 
    Goal True.
+   Proof.
    Set Printing Universes.
 
 .. rocqtop:: all abort
@@ -855,6 +854,29 @@ witness these temporary variables.
 Sort polymorphic inductives may be declared when every instantiation
 is valid.
 
+.. flag:: Collapse Sorts ToType
+
+   When set, unbound sort variables are collapsed to `Type` during minimization of universes.
+   Unsetting this flag will preserve sort variables during implicit elaboration of sort-polymorphic terms,
+   if :flag:`Universe Polymorphism` is set.
+   The flag is set by default.
+
+   For instance, defining the `list` type, without explicit sorts, should elaborate two implicit ones:
+   One for the type of parameter `A`, and one for the `list` type itself.
+
+   .. rocqtop:: all
+
+      Unset Collapse Sorts ToType.
+
+      Inductive list (A : Type) : Type :=
+      | nil : list A
+      | cons : A -> list A -> list A.
+
+      Set Printing Universes.
+      About list.
+
+      Set Collapse Sorts ToType.
+
 .. _elim-constraints:
 
 Elimination of Sort-Polymorphic Inductives
@@ -953,7 +975,10 @@ It means that `s` and `s'` can respectively be instantiated to e.g., `Type` and
 
    As with universe level constraints, elimination constraints can be elaborated
    automatically if the constraints are denoted extensible with `+` **or** if they
-   are totally omitted. For instance, the two following definitions are legal.
+   are totally omitted. In addition, when unsetting :flag:`Collapse Sorts ToType`,
+   the definition may be left completely implicit, elaborating both sort variables and
+   elimination constraints.
+   For instance, the three following definitions are legal.
 
    .. rocqtop:: all
 
@@ -975,6 +1000,16 @@ It means that `s` and `s'` can respectively be instantiated to e.g., `Type` and
                 | inr y => fr y
                 end.
 
+      Unset Collapse Sorts ToType.
+
+      Definition sum_elim_implicit (A B : Type) (P : sum A B -> Type)
+        (fl : forall (x : A), P (inl x)) (fr : forall (y : B), P (inr y))
+        (v : sum A B) : P v :=
+            match v with
+                | inl x => fl x
+                | inr y => fr y
+                end.
+
 .. note::
 
     These restrictions ignore :flag:`Definitional UIP`.
diff --git a/doc/sphinx/changes.rst b/doc/sphinx/changes.rst
index 467ebc130810..e5baacbc3f49 100644
--- a/doc/sphinx/changes.rst
+++ b/doc/sphinx/changes.rst
@@ -8,6 +8,630 @@ Recent changes
 
    .. include:: ../unreleased.rst
 
+Version 9.2
+-----------
+
+.. contents::
+   :local:
+   :depth: 1
+
+Summary of changes
+~~~~~~~~~~~~~~~~~~
+
+We highlight some of the most impactful changes here:
+
+- :ref:`Reenable support for `native_compute`<92native>` when compiled with OCaml 5.
+  As it relies on some architecture-specific code, only some x86 setups are supported for now
+- Records in `Type` and `Prop`, with only fields in `SProp`,
+  can now have :ref:`primitive projections but without eta conversion<92etarecord>`.
+- Implicit elaboration of :ref:`elimination constraints <92elimconstraints>`
+- :ref:`Parsing of elimination constraints<92elimparsing>` in prenex polymorphic definitions
+  as well as in constraints declaration :g:`Constraint s1 -> s2.`
+- :ref:`Induction hypotheses are now generated for nested arguments<92nested>` provided
+  an `All` predicate, and a theorem to prove it, have been registered with
+  the keys `All` and `AllForall`.
+- Add a `Scheme All` command to :ref:`generate the All predicate<92nestedscheme>` and its theorem
+  for inductive types used for the eliminators of nested inductive types
+- Tactics such as :tacn:`induction` find eliminators (like `nat_rect`)
+  through the :cmd:`Register Scheme` table (which is automatically populated by :cmd:`Scheme` and automatic scheme declarations)
+  instead of by name (the lookup by name remains for now for backward compatibility)
+- attribute :attr:`schemes` to :ref:`control automatic scheme declaration<92scheme>`.
+- :ref:`Goal names can be automatically generated<92goalnames>` for :tacn:`induction`,
+  :tacn:`destruct` and :tacn:`eapply` by using the :flag:`Generate Goal Names` flag
+- congruence tactics now :ref:`handle primitive ints, floats and strings<92congruence>`
+- :cmd:`Ltac2 Custom Entry` making it possible to define :ref:`more complex<92ltac2>` :cmd:`Ltac2 Notation`\s
+  and many other additions to Ltac2 (see below for details).
+- :flag:`Printing Fully Qualified` to :ref:`print all names<92printfully>` (global references, modules,
+  module types, universes, etc) using fully qualified paths
+- :ref:`Generalized universe polymorphism flag<92mlapi>` structure (ML API change)
+
+See the `Changes in 9.2.0`_ section below for the detailed list of changes,
+including potentially breaking changes marked with **Changed**.
+Rocq's `reference manual for 9.2 `_,
+documentation of the 9.2 `corelib `__
+and `developer documentation of the 9.2 ML API `_
+are also available.
+
+Théo Zimmermann, with help from Jason Gross and Gaëtan Gilbert, maintained
+`coqbot `__ used to run Rocq's CI and other
+pull request management tasks.
+
+Jason Gross maintained the `bug minimizer `_
+and its `automatic use through coqbot `_.
+
+Ali Caglayan, Emilio Jesús Gallego Arias, Rudi Grinberg and Rodolphe Lepigre maintained the
+`Dune build system for OCaml and Coq/Rocq `_
+used to build the Rocq Prover itself and many Rocq projects.
+
+The `opam repository `_ for Rocq packages has been maintained by
+Guillaume Claret, Guillaume Melquiond, Karl Palmskog, Matthieu Sozeau
+and Enrico Tassi with contributions from many users. The up-to-date list
+of packages is `available on the Rocq website `_.
+
+Erik Martin-Dorel maintained the
+`Rocq Docker images `_ and
+the `docker-keeper `_ compiler
+used to build and keep those images up to date (note that the tool is not Rocq specific).
+Erik Martin-Dorel and Théo Zimmermann maintained the
+`docker-coq-action `_
+container action (which is applicable to any opam project hosted on GitHub).
+
+Cyril Cohen, Vincent Laporte, Pierre Roux and Théo Zimmermann
+maintained the `Nix toolbox `_.
+The docker-coq-action and the Nix toolbox are used by many Rocq projects for continuous integration.
+
+Rocq 9.2 was made possible thanks to the following 35 reviewers:
+Eric Bistal, Dan Christensen, Cyril Cohen, Pierre Corbineau, Pierre Courtieu,
+Julien Cretin, Tomás Díaz, Andres Erbsen, Jian Fang, Jim Fehrle, Gaëtan Gilbert,
+Jason Gross, Hugo Herbelin, Emilio Jesús Gallego Arias, Ralf Jung, Jan-Oliver Kaiser,
+Thomas Lamiaux, Olivier Laurent, Rodolphe Lepigre, Yann Leray,
+Kenji Maillard, Guillaume Melquiond, Guillaume Munch-Maccagnoni, Karl Palmskog,
+Clément Pit-Claudel, Pierre-Marie Pédrot, Pierre Rousselin, Pierre Roux, Radosław Rowicki,
+Matthieu Sozeau, Nicolas Tabareau, Enrico Tassi, Li-yao Xia, Théo Zimmermann.
+
+See the `Rocq Team `_ page for
+more details on Rocq's development teams.
+
+The 43 contributors to the 9.2 version are:
+Charles C Norton, Ilan, Jean Caspar, quarkcool, Lionel Blatter, Mathis Bouverot,
+Jeffrey Chang, Owen Conoly, Quentin Corradi, Julien Cretin, Tomás Díaz, Andres Erbsen,
+Jim Fehrle, Gaëtan Gilbert, Jason Gross, Dario Halilovic, Hugo Herbelin,
+Emilio Jesús Gallego Arias, Jan-Oliver Kaiser, Thomas Lamiaux, Rodolphe Lepigre,
+Yann Leray, Gregory Malecha, Bruno Martinez, Guillaume Melquiond, Jan Midtgaard,
+Patrick Nicodemus, Charles Norton, Clément Pit-Claudel, Pierre-Marie Pédrot,
+Johann Rosain, Dan Rostovtsev, Pierre Rousselin, Pierre Roux, Matthieu Sozeau, Nicolas Tabareau,
+Enrico Tassi, Laurent Thery, Quentin Vermande, Théo Winterhalter, Théo Zimmermann.
+
+The Rocq community at large helped improve this new version via
+the GitHub issue and pull request system,
+the `Discourse forum `__ and the
+`Rocq Zulip chat `_.
+
+Nicolas Tabareau is the release manager of Rocq 9.2.
+This release is the result of 486 merged PRs, closing 80 issues.
+
+| Nantes, March 2026
+| Nicolas Tabareau for the Rocq development team
+
+Changes in 9.2.0
+~~~~~~~~~~~~~~~~
+
+.. contents::
+   :local:
+
+
+Kernel
+^^^^^^
+
+.. _92etarecord:
+
+- **Changed:**
+  Records in `Type` and `Prop`, with only fields in `SProp`,
+  can now have primitive projections but without eta conversion.
+  (`#21438 `_,
+  by Tomas Diaz).
+- **Changed:**
+  Error messages for module signature mismatches and "with Definition"
+  constraint failures are now more detailed
+  (`#21465 `_,
+  fixes `#21464 `_,
+  by Jason Gross).
+
+  .. _92native:
+
+- **Changed:**
+  Reenable support for `native_compute` when compiled with OCaml 5. As it relies on some architecture-specific code, only some x86 setups are supported for now
+  (`#21540 `_,
+  fixes `#13940 `_,
+  by Guillaume Melquiond).
+- **Removed:**
+  the ability to define monomorphic sorts within sections
+  (`#21451 `_,
+  by Pierre-Marie Pédrot).
+- **Fixed:**
+  Fix the detection and treatment of uniform arguments of nested fixpoints
+  (`#21684 `_,
+  fixes `#21682 `_
+  and `#21683 `_
+  and `#21701 `_,
+  by Yann Leray).
+
+Specification language, type inference
+^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+
+- **Added:**
+  when a reference is not found in the current environment, the error suggests similar names
+  (`#20662 `_,
+  by Gaëtan Gilbert).
+
+  .. _92elimconstraints:
+
+- **Added:**
+  implicit elaboration of elimination constraints
+  (`#21417 `_,
+  by Tomas Diaz).
+
+Notations
+^^^^^^^^^
+
+- **Changed:**
+  :cmd:`Abbreviation` no longer adds a printing rule when a surrounding module is imported
+  (i.e. when it would need to print a qualified name). :attr:`global` can be used
+  to retrieve the previous behavior
+  (`#20816 `_,
+  fixes `#20668 `_,
+  by Gaëtan Gilbert).
+- **Changed:**
+  :cmd:`custom entry ` names are now qualified.
+  A compatibility layer provides deprecated access with unqualified names without needing to import their module, as long as it is unambiguous
+  (`#20857 `_,
+  by Gaëtan Gilbert).
+- **Changed:**
+  the ``notation-incompatible-prefix`` no longer warns about
+  common prefixes followed by terminal symbols. For instance
+  ``"x #0`` and ``"x #0 #1"`` are not incompatible since our
+  parser isn't exactly LL1, considering successive terminal
+  symbols as a single token. Note that this change has an
+  impact on the default levels of such notations
+  (`#21159 `_,
+  by Pierre Roux).
+- **Deprecated:**
+  use of "Notation" keyword for :cmd:`abbreviations `,
+  use "Abbreviation" instead
+  (`#20855 `_,
+  by Pierre Roux).
+- **Added:**
+  a warning for non closed notations at level 0
+  (`#21107 `_,
+  by Pierre Roux).
+
+Tactics
+^^^^^^^
+
+- **Changed:**
+  tactics such as :tacn:`induction` find eliminators (like `nat_rect`)
+  through the :cmd:`Register Scheme` table (which is automatically populated by :cmd:`Scheme` and automatic scheme declarations)
+  instead of by name (the lookup by name remains for now for backward compatibility)
+  (`#20614 `_,
+  by Gaëtan Gilbert).
+- **Changed:**
+  type class hints without hypotheses used via functor
+  applications are applied with their type from the module
+  type rather than the module instance
+  (`#21193 `_,
+  by Pierre-Marie Pédrot).
+- **Removed:**
+  the implicit call to `auto with *` in intuition solver, that
+  was deprecated since 8.17
+  (`#21129 `_,
+  fixes `#4949 `_,
+  by Pierre-Marie Pédrot).
+- **Removed:**
+  the `destauto` tactic, which was deprecated in 8.20
+  (`#21172 `_,
+  fixes `#11537 `__,
+  by Pierre-Marie Pédrot).
+- **Deprecated:**
+  tactics such as :tacn:`induction` finding eliminators (like `nat_rect`) by name
+  instead of through the :cmd:`Register Scheme` table (which is automatically populated by :cmd:`Scheme` and automatic scheme declarations)
+  (`#20614 `_,
+  by Gaëtan Gilbert).
+- **Deprecated:**
+  dynamically generating schemes when needed in tactics.
+  This was mostly used for rewriting and equality schemes of the registered equality type
+  (`eq` when using the Corelib) for tactics such as :tacn:`discriminate`.
+  These schemes are now explicitly declared for `eq` in the Corelib
+  (`#21245 `_,
+  by Gaëtan Gilbert).
+
+  .. _92congruence:
+
+- **Added:**
+  congruence tactics now handle primitive ints, floats and strings
+  (`#20810 `_,
+  fixes `#20011 `_,
+  by Pierre-Marie Pédrot).
+
+  .. _92nested:
+
+- **Added:**
+  Induction hypotheses are now generated for nested arguments provided
+  an `All` predicate, and a theorem to prove it, have been registered with
+  the keys `All` and `AllForall`.
+  (`#21356 `_,
+  by Thomas Lamiaux).
+
+  .. _92nestedscheme:
+
+- **Added:**
+  Add a `Scheme All` command to generate the `All` predicate and its theorem
+  for inductive types used for the eliminators of nested inductive types
+  (`#21429 `_,
+  by Thomas Lamiaux).
+- **Fixed:**
+  ``setoid_rewrite`` now correctly picks up ``Params`` instances when rewriting in ``Type``
+  (`#20045 `_,
+  fixes `#20044 `_,
+  by quarkcool).
+- **Fixed:**
+  a sequence `Import M. Remove Hints h. Import M.` where `M` exports hints `h` would not re-add `h` after its removal
+  (`#20698 `_,
+  by Gaëtan Gilbert).
+- **Fixed:**
+  Canonical structure resolution in tactic unification in presence of
+  universe polymorphism (`#20780 `_,
+  fixes `#20779 `_,
+  by Matthieu Sozeau).
+- **Fixed:**
+  rewrite hints are controlled by the `hints` import category
+  (`#21108 `_,
+  fixes `#21106 `_,
+  by Gaëtan Gilbert).
+- **Changed:**
+  The unification algorithm (evarconv) may need to unfold its two input terms to succeed. Now, when one of the terms is an evar, it instantiates it with the folded version of the other term. In other words, tactics now unfold less than before, which may change the behavior of subsequent tactics.
+  (`#19987 `_,
+  by Quentin Vermande).
+- **Changed:**
+  Hypotheses of generated induction schemes use the constructor name instead of `f`, `f0`, etc
+  (`#20813 `_,
+  by Dario Halilovic).
+
+  .. _92goalnames:
+
+- **Added:**
+  Goal names can be automatically generated for :tacn:`induction`,
+  :tacn:`destruct` and :tacn:`eapply` by using the :flag:`Generate Goal Names` flag
+  (`#20809 `_,
+  by Dario Halilovic).
+- **Fixed:**
+  :n:`autorewrite*` was failing if any of the possible rewritings
+  failed to solve its generated side-conditions
+  (`#21803 `_,
+  fixes `#7672 `_
+  and `#4976 `_,
+  by Matthieu Sozeau).
+
+Ltac2 language
+^^^^^^^^^^^^^^
+
+- **Changed:**
+  :cmd:`Ltac2 Notation` without an explicit level puts the notation at level `1` instead of `5`
+  when it starts with a string which is an identifier.
+  Various notations have consequently changed level (e.g. `apply`).
+  (`#20759 `_,
+  fixes `#20616 `_,
+  by Gaëtan Gilbert).
+- **Changed:**
+  well parenthesized notations (`match!`, `lazy_match!`, etc) are now at level `0` instead of `5`,
+  and `now` is at level `1` instead of `6` (its argument is still at level `6`)
+  (`#20759 `_,
+  by Gaëtan Gilbert).
+- **Deprecated:**
+  use of "Notation" keyword for :cmd:`abbreviations `,
+  use "Abbreviation" instead
+  (`#20855 `_,
+  by Pierre Roux).
+- **Deprecated:**
+  syntactic classes parsing terms (`constr`, `lconstr`, etc.)
+  taking more than one :n:`@scope_key` argument without qualifying it with `delimiters`
+  (e.g. `constr(type, function)` should be `constr(delimiters(type, function))`
+  but a single argument like `constr(type)` is not deprecated).
+  See :n:`@ltac2_constr_synclass_arg`
+  (`#21285 `_,
+  by Gaëtan Gilbert).
+
+  .. _92ltac2:
+
+- **Added:**
+  :cmd:`Ltac2 Custom Entry` making it possible to define more complex :cmd:`Ltac2 Notation`\s
+  (`#20561 `_,
+  by Gaëtan Gilbert).
+- **Added:**
+  ``Ltac2.Reference.equal``
+  (`#20794 `_,
+  by Pierre Rousselin).
+- **Added:**
+  :cmd:`Ltac2 Set` supports :attr:`local` and :attr:`export`
+  (the default behaviour of `local` in sections and `export` outside sections has not changed)
+  (`#20882 `_,
+  fixes `#20879 `_,
+  by Gaëtan Gilbert).
+- **Added:**
+  ``Ltac2.Option.filter``
+  (`#21023 `_,
+  by Jason Gross).
+- **Added:**
+  :ref:`syntactic class ` `lpreterm` parsing terms
+  at precedence level 200 and interpreting them as preterms
+  (`#21094 `_,
+  by Gaëtan Gilbert).
+- **Added:**
+  `Ltac2.Message.of_lconstr` to print terms without surrounding parentheses
+  (`#21096 `_,
+  by Gaëtan Gilbert).
+- **Added:**
+  module `Ltac2.Constr.Relevance` for APIs about proof relevance annotations
+  (`#21162 `_,
+  by Gaëtan Gilbert).
+- **Added:**
+  APIs for module introspection in `Ltac2.Module`
+  (`#21178 `_,
+  by Gaëtan Gilbert).
+- **Added:**
+  :ref:`syntactic_classes` parsing terms support parsing at a specific level
+  and parsing :ref:`custom-entries`
+  (`#21215 `_,
+  by Gaëtan Gilbert).
+- **Added:**
+  `Ltac2.Unification.solve_constraints` (cf :tacn:`solve_constraints`)
+  (`#21222 `_,
+  by Gaëtan Gilbert).
+- **Added:**
+  `Ltac2.Constant.print`, `Ltac2.Ind.print`, `Ltac2.Constructor.print`,
+  `Ltac2.Proj.print`, `Ltac2.Ident.print`, `Ltac2.Message.of_preterm`
+  (`#21239 `_,
+  by Gaëtan Gilbert).
+- **Added:**
+  APIs `Control.print_err` and `Control.print_exn` which may be used to customize printing of Ltac2 errors
+  (`#21252 `_,
+  by Gaëtan Gilbert).
+- **Added:**
+  :cmd:`Ltac2 Set` supports attribute :attr:`global`
+  (`#21264 `_,
+  by Gaëtan Gilbert).
+- **Added:**
+  :flag:`Ltac2 Backtrace Compact` to reduce the output of :flag:`Ltac2 Backtrace`
+  (`#21299 `_,
+  by Gaëtan Gilbert).
+- **Added:**
+  `Message.of_exninfo` and `Control.current_exninfo`
+  (`#21334 `_,
+  fixes `#21312 `_,
+  by Gaëtan Gilbert).
+- **Fixed:**
+  associativity of `::` in Ltac2 `match` patterns (:n:`@tac2pat2`)
+  (`#21054 `_,
+  fixes `#21045 `_,
+  by Gaëtan Gilbert).
+
+SSReflect
+^^^^^^^^^
+
+- **Changed:**
+  rewrite pattern selection algorithm made more robust in face of changes
+  to implicit arguments shape. This changes can result in a different
+  pattern selection in some corner cases.
+  The option `Set SsrMatching LegacyFoUnif` can be used to obtain the
+  previous behavior when repairing scripts
+  (`#20707 `_,
+  fixes `#16763 `_,
+  by Enrico Tassi with help from Georges Gonthier, Pierre Roux and
+  Quentin Vermande).
+- **Changed:**
+  level of notation ``'Under[ _ ]`` in `ssrunder.v` from 8 to 0
+  (`#21107 `_,
+  by Pierre Roux).
+- **Changed:**
+  level of ``tactic => intro_pattern`` notation to a left-associative
+  notation level with higher priority than level 3, rather than being
+  repeated in levels 3 (right-associative) and 4 (left-associative)
+  (`#21244 `_,
+  by Pierre Roux).
+
+Commands and options
+^^^^^^^^^^^^^^^^^^^^
+
+- **Changed:**
+  Default patterns displayed by :cmd:`Print HintDb` now show
+  pattern holes using the name from the original theorem
+  (e.g. :n:`?n` instead of :n:`?M3135`)
+  (`#20827 `_,
+  by Jim Fehrle).
+- **Changed:**
+  :cmd:`Show` and :n:`Show goalnum` now show diffs (if enabled) in rocqtop.
+  Added :cmd:`Show Diffs` :n:`goalname` to show diffs for a named goal.
+  For emacs support; still no diffs shown for these commands in other
+  IDEs
+  (`#21103 `_,
+  fixes `#20793 `_,
+  by Jim Fehrle).
+- **Changed:**
+  `_rec` schemes are not defined using `_rect` schemes anymore.
+  In particular `eq_rec` is not defined using `eq_rect`
+  (`#21241 `_,
+  by Gaëtan Gilbert).
+- **Changed:**
+  Generalize :cmd:`Register Scheme` from constants to constants, or inductive types, or constructors
+  (`#21326 `_,
+  by Thomas Lamiaux).
+- **Changed:**
+  :cmd:`Derive` names the existential variables it generates according using the name of the constant they will define
+  (e.g. `Derive X in X as x` binds `X` to an evar named `?X` instead of an anonymous evar (which would print as `?Goal`))
+  (`#21332 `_,
+  by Gaëtan Gilbert).
+
+  .. _92mlapi:
+
+- **Changed:**
+  Generalized universe polymorphism flag structure (ML API change)
+  (`#21419 `_,
+  by Matthieu Sozeau).
+- **Changed:**
+  :cmd:`Print Assumptions` now recurses into the types of axioms
+  (`#21437 `_,
+  fixes `#21436 `_,
+  by Jason Gross).
+- **Changed:**
+  :cmd:`Print Assumptions`, :cmd:`Print Opaque Dependencies`, :cmd:`Print
+  Transparent Dependencies`, and :cmd:`Print All Dependencies` now accept lists
+  of globals instead of single references
+  (`#21477 `_,
+  by Jason Gross).
+- **Removed:**
+  flag `Loose Hint Behavior` which appears to have behaved as `Strict` regardless of how it was set for the last few versions
+  (`#20698 `_,
+  by Gaëtan Gilbert).
+- **Deprecated:**
+  implicitly creating hint databases when declaring hints.
+  (`#21114 `_,
+  fixes `#4117 `_,
+  by Pierre-Marie Pédrot).
+- **Deprecated:**
+  creating implicitly rewrite hint databases through the
+  :cmd:`Hint Rewrite` command. One must now do it explicitly
+  through :cmd:`Create Rewrite HintDb`
+  (`#21206 `_,
+  by Pierre-Marie Pédrot).
+- **Added:**
+  Additional documentation of Create HintDb (discriminated), proof search
+  tactic performance, matching process and hint transparency
+  (`#19761 `_,
+  by Jim Fehrle).
+
+  .. _92scheme:
+
+- **Added:**
+  attribute :attr:`schemes` to control automatic scheme declaration
+  (`#21163 `_,
+  fixes `#19480 `_,
+  by Gaëtan Gilbert).
+
+  .. _92elimparsing:
+
+- **Added:**
+  Parsing of elimination constraints in prenex polymorphic definitions
+  as well as in constraints declaration :g:`Constraint s1 -> s2.`
+  (`#21195 `_,
+  by Johann Rosain).
+- **Added:**
+  a :cmd:`Create Rewrite HintDb` command to explicitly declare
+  rewrite hint databases
+  (`#21203 `_,
+  by Pierre-Marie Pédrot).
+- **Added:**
+  :cmd:`Scheme Rewriting` to explicitly declare rewriting schemes for a given inductive
+  (`#21248 `_,
+  by Gaëtan Gilbert).
+
+  .. _92printfully:
+
+- **Added:**
+  :flag:`Printing Fully Qualified` to print all names (global references, modules,
+  module types, universes, etc) using fully qualified paths
+  (`#21443 `_,
+  fixes `#11852 `_,
+  by Jason Gross).
+- **Fixed:**
+  Properly test for duplicate names in mutual blocks
+  (`#21082 `_,
+  fixes `#20766 `_,
+  by Yann Leray).
+- **Fixed:**
+  Fix Derive command to handle dependent types correctly
+  (`#21313 `_,
+  fixes `#21292 `_,
+  by Jason Gross).
+- **Fixed:** fallback printing of inductives using
+  ```` should be rarer (it should in any case only
+  happen rarely from module errors) (`#21473
+  `_, by Jason Gross).
+
+Command-line tools
+^^^^^^^^^^^^^^^^^^
+
+- **Changed:**
+  in ``-emacs`` mode, goals are no longer spontaneously printed
+  (`#21038 `_,
+  fixes `#21035 `_,
+  by Pierre Roux).
+- **Changed:**
+  `rocq compile` does not create empty `.vos` and `.vok` files anymore,
+  their creation is left to the makefile generated by `rocq makefile`.
+  Other build system may choose to create these empty files at their discretion
+  (`#21548 `_,
+  by Gaëtan Gilbert).
+- **Added:**
+  :ref:`rocq doc ` replaces `@@TITLE@@` with the page title in custom HTML headers
+  (`#20907 `_,
+  fixes `#2511 `_,
+  by Gaëtan Gilbert).
+- **Fixed:**
+  ``rocq dep`` now handles non .vo dependencies from the ``ROCQPATH``
+  environment variable
+  (`#20878 `_,
+  fixes `#20835 `_,
+  by Gaëtan Gilbert).
+
+Corelib
+^^^^^^^
+
+- **Changed:**
+  Level of ``_~0`` and ``_~1`` reserved notations (used for positive
+  numbers) from level 7 to level 1
+  (`#17876 `_,
+  by Pierre Roux).
+- **Changed:**
+  level of postfix notations in `PrimArray` to level 1
+  (`#21211 `_,
+  by Pierre Roux).
+- **Changed:**
+  rewriting schemes for `eq` and `eq_true` are explicitly declared in `Init.Logic`
+  instead of dynamically when a tactic needs them.
+  For instance `EqdepFacts.internal_eq_rew_dep` does not exist anymore and instead `Logic.eq_rew_dep` is available
+  (`#21248 `_,
+  by Gaëtan Gilbert).
+- **Added:**
+  a slightly more general variant of Fix_eq which is sometimes more convenient
+  (`#20018 `_,
+  by Owen Conoly).
+- **Fixed:**
+  primitive array axioms (in `ArrayAxioms`) are universe polymorphic
+  (they were inadvertently turned monomorphic in the stdlib split)
+  (`#21744 `_,
+  by Gaëtan Gilbert).
+
+Infrastructure and dependencies
+^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+
+Extraction
+^^^^^^^^^^
+
+- **Fixed:**
+  Added "effect" as a recognized keyword for ocaml extraction
+  (`#21350 `_,
+  fixes `#21176 `_,
+  by Dan Rostovtsev).
+
+Miscellaneous
+^^^^^^^^^^^^^
+
+- **Changed:**
+  use `Gc.ramp_up` while executing :cmd:`Require` on OCaml 5.4 and later.
+  This should partially mitigate the performance lost since OCaml 4.14
+  (`#21306 `_,
+  by Gaëtan Gilbert).
+
+
 Version 9.1
 -----------
 
@@ -100,7 +724,7 @@ the `Discourse forum `__ and the
 `Rocq Zulip chat `_.
 
 Gaëtan Gilbert and Pierre-Marie Pédrot are the release managers of Rocq 9.1.
-This release is the result of 397 merged PRs, closing 56 issues.
+This release is the result of 397 merged PRs, closing 66 issues.
 
 | Nantes, September 2025
 | Gaëtan Gilbert and Pierre-Marie Pédrot for the Rocq development team
@@ -338,7 +962,7 @@ Ltac2 language
   (`#20656 `_,
   by Gaëtan Gilbert).
 
-.. _91ltac2notationfix:
+  .. _91ltac2notationfix:
 
 - **Fixed:**
   Ltac2 in terms in notations is more aware of the notation variables it uses,
@@ -416,7 +1040,7 @@ Commands and options
   fixes `#20042 `_,
   by Gaëtan Gilbert).
 
-.. _91refinedef:
+  .. _91refinedef:
 
 - **Added:**
   support for the :attr:`refine` attribute to definitions and (co)fixpoints
@@ -480,7 +1104,7 @@ Infrastructure and dependencies
   (`#20576 `_,
   by Gaëtan Gilbert).
 
-.. _91relocatable:
+  .. _91relocatable:
 
 - **Added:**
   Rocq can be compile-time configured to be relocatable,
@@ -522,6 +1146,32 @@ Miscellaneous
   (`#20670 `_,
   by Gaëtan Gilbert).
 
+Changes in 9.1.1
+~~~~~~~~~~~~~~~~
+
+.. contents::
+   :local:
+
+Specification language, type inference
+^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+
+- **Fixed:** anomaly when defining a sort polymorphic inductive
+  without enabling :flag:`Universe Polymorphism`
+  (`#21479 `_,
+  fixes `#21476 `_,
+  by Yann Leray)
+
+Miscellaneous
+^^^^^^^^^^^^^
+
+- **Fixed:** compatibility with OCaml 5.4 with warnings as errors
+  (`#21261 `_,
+  by Yann Leray)
+- **Fixed:** compatibility with OCaml 5.5 with warnings as errors
+  (`#21584 `_,
+  by Yann Leray and Kate Deplaix)
+- **Changed:** various documentation updates
+
 Version 9.0
 -----------
 
@@ -1675,7 +2325,7 @@ Tactics
 Ltac language
 ^^^^^^^^^^^^^
 - **Added:**
-  In :tacn:`rewrite_strat`, :n:`@rewstrategy` now supports the fixpoint operator :n:`fix @ident := @rewstrategy1`
+  In :tacn:`rewrite_strat`, :n:`@rewstrategy2` now supports the fixpoint operator :n:`fix @ident := @rewstrategy1`
   (`#18094 `_,
   fixes `#13702 `_,
   by Jason Gross and Gaëtan Gilbert).
@@ -3464,7 +4114,7 @@ Commands and options
   (`#17333 `_,
   by Gaëtan Gilbert).
 - **Deprecated:**
-  the :attr:`nonuniform` attribute,
+  the ``nonuniform`` attribute,
   now subsumed by :attr:`warnings` with "-uniform-inheritance"
   (`#17716 `_,
   by Pierre Roux).
@@ -4189,7 +4839,7 @@ Ltac2 language
   by Jason Gross).
 - **Added:**
   ``Ltac2.Option.equal``
-  (`#16538 `_,
+  (`#16539 `_,
   by Jason Gross).
 - **Added:**
   syntax for Ltac2 record update ``{ foo with field := bar }``
@@ -5009,7 +5659,7 @@ Commands and options
   by Pierre Roux, reviewed by Gaëtan Gilbert, Ali Caglayan,
   Jason Gross, Jim Fehrle and Théo Zimmermann).
 - **Added:**
-  the :attr:`nonuniform` boolean attribute that silences the
+  the ``nonuniform`` boolean attribute that silences the
   non-uniform-inheritance warning when user needs to declare such a
   coercion on purpose
   (`#15853 `_,
@@ -9448,7 +10098,7 @@ Changes in 8.11+beta1
   relation. More precisely, assume the given context lemma has type
   `forall f1 f2, .. -> (forall i, R1 (f1 i) (f2 i)) -> R2 f1 f2`.  The
   first step performed by :tacn:`under` (since Coq 8.10) amounts to
-  calling the tactic :tacn:`rewrite `, which
+  calling the tactic :tacn:`rw`, which
   itself relies on :tacn:`setoid_rewrite` if need be. So this step was
   already compatible with a double implication or setoid equality for
   the conclusion head symbol `R2`. But a further step consists in
@@ -10478,7 +11128,7 @@ Many bug fixes and documentation improvements, in particular:
   by Andreas Lynge, review by Enrico Tassi)
 - Make the ``rewrite /t`` tactic work together with
   :flag:`Universe Polymorphism`.
-  This makes :tacn:`rewrite ` compatible with the HoTT
+  This makes :tacn:`rw` compatible with the HoTT
   library https://github.com/HoTT/HoTT
   (`#10305 `_,
   fixes `#9336 `_,
diff --git a/doc/sphinx/conf.py b/doc/sphinx/conf.py
index 8fe72967bd9d..2d32b1cde61a 100644
--- a/doc/sphinx/conf.py
+++ b/doc/sphinx/conf.py
@@ -211,6 +211,7 @@ def setup(app):
     'versions': [
         ("dev", "https://rocq-prover.org/doc/master/refman/"),
         ("stable", "https://rocq-prover.org/refman/"),
+        ("9.2", "https://rocq-prover.org/doc/v9.2/refman/"),
         ("9.1", "https://rocq-prover.org/doc/v9.1/refman/"),
         ("9.0", "https://rocq-prover.org/doc/v9.0/refman/"),
         ("8.20", "https://rocq-prover.org/doc/V8.20.1/refman/"),
diff --git a/doc/sphinx/language/core/assumptions.rst b/doc/sphinx/language/core/assumptions.rst
index 7877d5decdbb..da88b5a039b8 100644
--- a/doc/sphinx/language/core/assumptions.rst
+++ b/doc/sphinx/language/core/assumptions.rst
@@ -20,6 +20,7 @@ Binders
    | @generalizing_binder
    | ( @name : @type %| @term )
    | ' @pattern0
+   | & @term99
 
 Various constructions such as :g:`fun`, :g:`forall`, :g:`fix` and :g:`cofix`
 *bind* variables. A binding is represented by an identifier. If the binding
@@ -38,7 +39,9 @@ variable can be introduced at the same time. It is also possible to give
 the type of the variable as follows:
 :n:`(@ident : @type := @term)`.
 
-`(x : T | P)` is syntactic sugar for `(x : @Stdlib.Init.Specif.sig _ (fun x : T => P))`,
+:n:`& @term99` is syntactic sugar for the anonymous binder :n:`(_ : @term99)`.
+
+`(x : T | P)` is syntactic sugar for `(x : @Corelib.Init.Specif.sig _ (fun x : T => P))`,
 which would more typically be written `(x : {x : T | P})`.
 Since `(x : T | P)` uses `sig` directly,
 changing the notation `{x : T | P}`
diff --git a/doc/sphinx/language/core/basic.rst b/doc/sphinx/language/core/basic.rst
index 6fd34718b9c7..f0a5a7666947 100644
--- a/doc/sphinx/language/core/basic.rst
+++ b/doc/sphinx/language/core/basic.rst
@@ -189,7 +189,7 @@ Keywords
 
     _ Axiom CoFixpoint Definition Fixpoint Hypothesis Parameter Prop
     SProp Set Theorem Type Variable as at cofix else end
-    fix for forall fun if in let match return then where with
+    fix for forall fun if in let match of return then where with
 
   The following are keywords defined in notations or plugins loaded in the :term:`prelude`::
 
@@ -262,7 +262,8 @@ rest of the Rocq Prover manual: :term:`terms ` and :term:`types
      .. prodn::
         term ::= @term100
         term100 ::= @term_cast
-        | @term10
+        | @term99
+        term99 ::= @term10
         term10 ::= @term_application
         | @term_forall_or_fun
         | @term_let
diff --git a/doc/sphinx/language/core/conversion.rst b/doc/sphinx/language/core/conversion.rst
index e1b5ed9a2630..d7a038027d50 100644
--- a/doc/sphinx/language/core/conversion.rst
+++ b/doc/sphinx/language/core/conversion.rst
@@ -233,6 +233,7 @@ Examples
 
          Print Nat.add.
          Goal 1 + 1 = 2.
+         Proof.
          cbv delta.
          cbv fix.
          cbv beta.
@@ -243,6 +244,7 @@ Examples
       .. rocqtop:: all abort
 
          Goal 1 + 1 = 2.
+         Proof.
          cbv.
 
 .. _proof-irrelevance:
diff --git a/doc/sphinx/language/core/definitions.rst b/doc/sphinx/language/core/definitions.rst
index 3683e4c1c2df..e5d7dc440d3c 100644
--- a/doc/sphinx/language/core/definitions.rst
+++ b/doc/sphinx/language/core/definitions.rst
@@ -40,26 +40,26 @@ Type cast
 .. insertprodn term_cast term_cast
 
 .. prodn::
-   term_cast ::= @term100 <: @type
-   | @term100 <<: @type
-   | @term100 :> @type
-   | @term100 : @type
+   term_cast ::= @term99 <: @type
+   | @term99 <<: @type
+   | @term99 :> @type
+   | @term99 : @type
 
-The expression :n:`@term10 : @type` is a type cast expression. It enforces
-the type of :n:`@term10` to be :n:`@type`.
+The expression :n:`@term99 : @type` is a type cast expression. It enforces
+the type of :n:`@term99` to be :n:`@type`.
 
-:n:`@term10 <: @type` specifies that the virtual machine will be used
-to type check that :n:`@term10` has type :n:`@type` (see :tacn:`vm_compute`).
+:n:`@term99 <: @type` specifies that the virtual machine will be used
+to type check that :n:`@term99` has type :n:`@type` (see :tacn:`vm_compute`).
 
-:n:`@term10 <<: @type` specifies that compilation to OCaml will be used
-to type check that :n:`@term10` has type :n:`@type` (see :tacn:`native_compute`).
+:n:`@term99 <<: @type` specifies that compilation to OCaml will be used
+to type check that :n:`@term99` has type :n:`@type` (see :tacn:`native_compute`).
 
-:n:`@term10 :> @type` enforces the type of :n:`@term10` to be
+:n:`@term99 :> @type` enforces the type of :n:`@term99` to be
 :n:`@type` without leaving a trace in the produced value.
 This is a :gdef:`volatile cast`.
 
 If a scope is :ref:`bound ` to
-:n:`@type` then :n:`@term10` is interpreted in that scope.
+:n:`@type` then :n:`@term99` is interpreted in that scope.
 
 .. _gallina-definitions:
 
@@ -129,6 +129,17 @@ Section :ref:`typing-rules`.
    .. exn:: The term @term has type @type while it is expected to have type @type'.
       :undocumented:
 
+.. attr:: refine
+
+   This :term:`attribute` can be used to leave holes or not provide
+   all fields in a definition and open the tactic mode to fill them.
+   It works exactly as if no :term:`body` had been given and the
+   :tacn:`refine` tactic has been used first.
+
+   Note that if you finish the proof with :cmd:`Qed` the entire
+   definition will be opaque, including the initial term.
+
+
 .. _Assertions:
 
 Assertions and proofs
diff --git a/doc/sphinx/language/core/inductive.rst b/doc/sphinx/language/core/inductive.rst
index 7b68a55e6ed9..665e630eee9d 100644
--- a/doc/sphinx/language/core/inductive.rst
+++ b/doc/sphinx/language/core/inductive.rst
@@ -32,7 +32,7 @@ Inductive types
 
    .. prodn::
       inductive_definition ::= @ident {? @cumul_univ_decl } {* @binder } {? %| {* @binder } } {? : @type } := {? {? %| } {+| @constructor } } {? @decl_notations }
-      constructor ::= {* #[ {+, @attribute } ] } @ident {* @binder } {? @of_type_inst }
+      constructor ::= {* #[ {+, @attribute } ] } @ident {* @binder } {? of {+& @term99 } } {? @of_type_inst }
 
    Defines one or more
    inductive types and its constructors.  Rocq generates
@@ -100,6 +100,9 @@ Inductive types
    Constructor :n:`@ident`\s can come with :n:`@binder`\s, in which case
    the actual type of the constructor is :n:`forall {* @binder }, @type`.
 
+   :n:`{? of {+& @term99 } }`
+     `of T1 & ... & Tn` is syntactic sugar for anonymous binders `(_ : T1) ... (_ : Tn)`.
+
    .. exn:: Non strictly positive occurrence of @ident in @type.
 
       The types of the constructors have to satisfy a *positivity
@@ -557,6 +560,7 @@ constructions.
       .. rocqtop:: all
 
          Goal forall n:nat, plus n 0 = plus 0 n.
+         Proof.
          intros; simpl.  (* plus 0 n not reducible *)
 
       .. rocqtop:: none
@@ -566,6 +570,7 @@ constructions.
       .. rocqtop:: all
 
          Goal forall n:nat, n + 0 = 0 + n.
+         Proof.
          intros; simpl.  (* n + 0 not reducible *)
 
       .. rocqtop:: none
@@ -911,7 +916,9 @@ or :math:`s_j` must be an impredicative sort (`SProp`, `Prop`, or if `-impredica
 and the `j`\th inductive may not be eliminated to larger sorts:
 
 - for each (non parameter) constructor argument, the universe of its type must be smaller than :math:`s_j`
-- if `-indices-matter` was used, for each index the universe of its type must be smaller than :math:`s_j`
+- if ``-indices-matter`` or :flag:`Indices Matter` was used, for each index the universe of its type must be smaller than :math:`s_j`.
+  When neither ``-indices-matter`` nor :flag:`Indices Matter` is used, inductives whose indices would contribute
+  universe constraints are printed by :cmd:`Print Assumptions`.
 - if there are 2 or more constructors, `Set` must be smaller than :math:`s_j`
 - unless the inductive is a primitive record, and unless :flag:`Definitional UIP` was used,
   if there is 1 constructor, `Prop` must be smaller than :math:`s_j` (essentially this means :math:`s_j` must not be `SProp`)
diff --git a/doc/sphinx/language/core/modules.rst b/doc/sphinx/language/core/modules.rst
index 7de3dccb4c94..4f494559530f 100644
--- a/doc/sphinx/language/core/modules.rst
+++ b/doc/sphinx/language/core/modules.rst
@@ -360,11 +360,11 @@ are now available through the dot notation.
 .. cmd:: Print Namespace @dirpath
 
    Prints the names and types of all loaded constants whose fully qualified
-   names start with :n:`@dirpath`. For example, the command ``Print Namespace Stdlib.``
-   displays the names and types of all loaded constants in the standard library.
-   The command ``Print Namespace Stdlib.Init`` only shows constants defined in one
+   names start with :n:`@dirpath`. For example, the command ``Print Namespace Corelib.``
+   displays the names and types of all loaded constants in the core library.
+   The command ``Print Namespace Corelib.Init`` only shows constants defined in one
    of the files in the ``Init`` directory. The command ``Print Namespace
-   Stdlib.Init.Nat`` shows what is in the ``Nat`` library file inside the ``Init``
+   Corelib.Init.Nat`` shows what is in the ``Nat`` library file inside the ``Init``
    directory. Module names may appear in :n:`@dirpath`.
 
    .. example::
@@ -384,6 +384,11 @@ are now available through the dot notation.
          Print Namespace Top.A.
          Print Namespace Top.A.B.
 
+.. cmd:: Print Debug Delta {? @qualid }
+
+   Prints debug information about name aliasing (delta-resolvers) of the given
+   module or module type, or of the current structure if no argument is passed.
+
 .. _module_examples:
 
 Examples
@@ -400,6 +405,7 @@ Examples
     .. rocqtop:: all
 
        Definition y : bool.
+       Proof.
        exact true.
 
     .. rocqtop:: in
@@ -447,6 +453,7 @@ module can be accessed using the dot notation:
       Definition T := nat.
       Definition x := 0.
       Definition y : bool.
+      Proof.
       exact true.
       Defined.
       End M.
@@ -562,7 +569,7 @@ While qualified names always consist of a series of dot-separated :n:`@ident`\s,
 
 **File part.** Files are identified by :gdef:`logical paths `,
 which are prefixes in the form :n:`{* @ident__logical } {+ @ident__file }`, such
-as :n:`Stdlib.Init.Logic`, in which:
+as :n:`Corelib.Init.Logic`, in which:
 
 - :n:`{* @ident__logical }`, the :gdef:`logical name`, maps to one or more
   directories (or :gdef:`physical paths `) in the user's file system.
@@ -587,14 +594,14 @@ with the logical name :n:`Top` and there is no associated file system path.
 
 - :n:`@ident__base` is the base name used in the command defining
   the item.  For example, :n:`eq` in the :cmd:`Inductive` command defining it
-  in `Stdlib.Init.Logic` is the base name for `Stdlib.Init.Logic.eq`, the standard library
+  in `Corelib.Init.Logic` is the base name for `Corelib.Init.Logic.eq`, the core library
   definition of :term:`Leibniz equality`.
 
 If :n:`@qualid` is the fully qualified name of an item, Rocq
 always interprets :n:`@qualid` as a reference to that item.  If :n:`@qualid` is also a
 partially qualified name for another item, then you must provide a more-qualified
 name to uniquely identify that other item.  For example, if there are two
-fully qualified items named `Foo.Bar` and `Stdlib.X.Foo.Bar`, then `Foo.Bar` refers
+fully qualified items named `Foo.Bar` and `Corelib.X.Foo.Bar`, then `Foo.Bar` refers
 to the first item and `X.Foo.Bar` is the shortest name for referring to the second item.
 
 Definitions with the :attr:`local` attribute are only accessible with
diff --git a/doc/sphinx/language/core/records.rst b/doc/sphinx/language/core/records.rst
index 9782aee6fc66..b9c85f715f76 100644
--- a/doc/sphinx/language/core/records.rst
+++ b/doc/sphinx/language/core/records.rst
@@ -282,6 +282,7 @@ Constructing records
       .. rocqtop:: in
 
          Theorem one_two_irred : forall x y z:nat, x * y = 1 /\ x * z = 2 -> x = 1.
+         Proof.
          Admitted.
 
          (* Record form: top and bottom can be inferred from other fields *)
@@ -406,7 +407,7 @@ flag.
 There are currently two ways to introduce primitive records types:
 
 #. Through the :cmd:`Record` command, in which case the type has to be
-   non-recursive. The defined type enjoys eta-conversion definitionally,
+   non-recursive. The defined type has eta-conversion definitionally, in most cases (See :ref:`sprop ` for exceptions),
    that is the generalized form of surjective pairing for records:
    `r` ``= Build_``\ `R` ``(``\ `r`\ ``.(``\ |p_1|\ ``) …`` `r`\ ``.(``\ |p_n|\ ``))``.
    Eta-conversion allows to define dependent elimination for these types as well.
diff --git a/doc/sphinx/language/core/variants.rst b/doc/sphinx/language/core/variants.rst
index e298a3fff620..c0e499a339b9 100644
--- a/doc/sphinx/language/core/variants.rst
+++ b/doc/sphinx/language/core/variants.rst
@@ -158,7 +158,7 @@ to apply specific treatments accordingly.
    term_match ::= match {+, @case_item } {? return @term100 } with {? %| } {*| @eqn } end
    case_item ::= @term100 {? as @name } {? in @pattern }
    eqn ::= {+| {+, @pattern } } => @term
-   pattern ::= @pattern : @term
+   pattern ::= @pattern10 : @term
    | @pattern10
    pattern10 ::= @pattern10 as @name
    | @pattern10 {* @pattern1 }
diff --git a/doc/sphinx/language/extensions/canonical.rst b/doc/sphinx/language/extensions/canonical.rst
index c70a1a2d0e8b..b7da1c151fc3 100644
--- a/doc/sphinx/language/extensions/canonical.rst
+++ b/doc/sphinx/language/extensions/canonical.rst
@@ -425,6 +425,7 @@ structure.
 .. rocqtop:: all
 
      Lemma lele_eq (e : type) (x y : obj e) : x <= y -> y <= x -> x == y.
+     Proof.
 
      now intros; apply (compat _ _ (extra _ (class_of e)) x y); split.
 
@@ -465,14 +466,14 @@ following proofs are omitted for brevity.
 .. rocqtop:: all
 
   Lemma nat_LEQ_compat (n m : nat) : n <= m /\ m <= n <-> n == m.
-
+  Proof.
   Admitted.
 
   Definition nat_LEQmx := LEQ.Mixin nat_LEQ_compat.
 
   Lemma pair_LEQ_compat (l1 l2 : LEQ.type) (n m : LEQ.obj l1 * LEQ.obj l2) :
      n <= m /\ m <= n <-> n == m.
-
+  Proof.
   Admitted.
 
   Definition pair_LEQmx l1 l2 := LEQ.Mixin (pair_LEQ_compat l1 l2).
@@ -498,13 +499,13 @@ subsection we show how to make them more compact.
            (pair_LEQmx l1 l2)).
 
      Example test_algebraic (n m : nat) : n <= m -> m <= n -> n == m.
-
+     Proof.
      now apply (lele_eq n m).
 
      Qed.
 
      Example test_algebraic2 (n m : nat * nat) : n <= m -> m <= n -> n == m.
-
+     Proof.
      now apply (lele_eq n m). Qed.
 
   End Add_instance_attempt.
diff --git a/doc/sphinx/language/extensions/evars.rst b/doc/sphinx/language/extensions/evars.rst
index 85efe17b0915..a99cf3a0947b 100644
--- a/doc/sphinx/language/extensions/evars.rst
+++ b/doc/sphinx/language/extensions/evars.rst
@@ -113,6 +113,7 @@ it will create new existential variable(s) when :tacn:`apply` would fail.
       .. rocqtop:: none reset
 
          Goal forall i j : nat, i = j.
+         Proof.
          intros.
 
       .. rocqtop:: all
@@ -178,6 +179,7 @@ automatically as a side effect of other tactics.
       Set Printing Goal Names.
 
       Goal forall p n m : nat, n = p -> p = m -> n = m.
+      Proof.
 
    .. rocqtop:: all
 
@@ -197,6 +199,7 @@ automatically as a side effect of other tactics.
       Set Printing Goal Names.
 
       Goal forall p n m : nat, n = p -> p = m -> n = m.
+      Proof.
       intros x y z H1 H2.
       eapply eq_trans. (* creates ?y : nat as a shelved goal *)
 
diff --git a/doc/sphinx/language/extensions/match.rst b/doc/sphinx/language/extensions/match.rst
index ea689e8db62e..8269a5b1d6b6 100644
--- a/doc/sphinx/language/extensions/match.rst
+++ b/doc/sphinx/language/extensions/match.rst
@@ -24,10 +24,10 @@ patterns. As an extension, multiple nested patterns or disjunction of
 patterns are allowed, as in ML-like languages
 (cf. :ref:`multiple-patterns` and :ref:`nested-patterns`).
 
-The extension just acts as a macro that is expanded during parsing
-into a sequence of match on simple patterns. Especially, a
-construction defined using the extended match is generally printed
-under its expanded form (see :flag:`Printing Matching`).
+The extension is expanded during :term:`type inference` into a
+sequence of match on simple patterns. Printing by default attempts to
+reconstruct the factorized syntax (see :flag:`Printing Matching`), but
+is often not successful and prints the expanded form.
 
 .. _if-then-else:
 
@@ -82,24 +82,22 @@ declared as such (see :ref:`controlling-match-pp`).
 Irrefutable patterns: the destructuring let variants
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
-Pattern-matching on terms inhabiting inductive type having only one
-constructor can be alternatively written using :g:`let … in …`
+Pattern-matching where all cases are captured by a single pattern
+(":gdef:`irrefutable pattern`", typically for inductive types with a single
+constructor) can be alternatively written using :g:`let … in …`
 constructions. There are two variants of them.
 
 .. insertprodn destructuring_let destructuring_let
 
 .. prodn::
    destructuring_let ::= let ( {*, @name } ) {? {? as @name } return @term100 } := @term in @term
-   | let ' @pattern := @term {? return @term100 } in @term
-   | let ' @pattern in @pattern := @term return @term100 in @term
+   | let ' @pattern {? in @pattern } := @term {? return @term100 } in @term
 
 
-First destructuring let syntax
-++++++++++++++++++++++++++++++
+.. _let-tuple:
 
-.. todo explain that this applies to all of the "let" constructs (Gallina, Ltac1 and Ltac2)
-   also add "irrefutable pattern" to the glossary
-   note that in Ltac2 an upper case ident is a constructor, lower case is a variable
+Let-tuple syntax
+++++++++++++++++
 
 The expression :n:`let ( {*, @ident__i } ) := @term__0 in @term__1`
 performs case analysis on :n:`@term__0` whose type must be an
@@ -132,26 +130,22 @@ pattern can either be done using :g:`match` or the :g:`let` construction
 If term inhabits an inductive type with one constructor `C`, we have an
 equivalence between
 
-::
-
-   let (ident₁, …, identₙ) [dep_ret_type] := term in term'
+:n:`let ( {* @name__i } ) {? {? as @name__as } return @term__ret } := @term__0 in @term__1`
 
 and
 
-::
+:n:`match @term__0 {? {? as @name__as } return @term__ret } with C {* @name__i } => @term__1 end`
 
-   match term [dep_ret_type] with
-   C ident₁ … identₙ => term'
-   end
+(if the parameters of `C` are implicit arguments or :flag:`Asymmetric Patterns` is set).
 
+In practice type inference may use slightly different heuristics for the different syntaxes.
 
-Second destructuring let syntax
-+++++++++++++++++++++++++++++++
+Let-pattern syntax
+++++++++++++++++++
 
-Another destructuring let syntax is available for inductive types with
-one constructor by giving an arbitrary pattern instead of just a tuple
-for all the arguments. For example, the preceding example can be
-written:
+Another destructuring let syntax is available by giving an arbitrary
+pattern (which must be irrefutable) instead of just a tuple for all
+the arguments. For example, the preceding example can be written:
 
 .. rocqtop:: reset all
 
@@ -171,10 +165,35 @@ patterns to do the deconstruction. For example:
    Definition proj1_sig' (A:Set) (P:A->Prop) (t:{ x:A | P x }) : A :=
    let 'x With p := t in x.
 
+We can also match on multiple constructors:
+
+.. rocqtop:: all
+
+   Check fun A (x : A + A) => let '(inl y | inr y) := x in y.
+
 When printing definitions which are written using this construct it
 takes precedence over let printing directives for the datatype under
 consideration (see Section :ref:`controlling-match-pp`).
 
+In general
+
+:n:`let ' @pattern {? in @pattern__in } := @term__0 {? return @term__ret } in @term__1`
+
+is desugared into
+
+:n:`match @term__0 {? as @name__as } {? in @pattern__in } {? return @term__ret } with @pattern => @term__1 end`
+
+where if :n:`@pattern` is a name then it is used to provide
+:n:`@name__as`, otherwise the `as` annotation is left implicit.
+
+.. note::
+
+   In the "let-tuple" syntax, `let (x, y) := ...` handles
+   any inductive type with a unique constructor and 2 arguments.
+
+   In the "let-pattern" syntax, `let '(x, y) := ...` handles the inductive
+   type whose constructor is produced by the `(_, _)` notation (by
+   default `prod` whose constructor is `pair`).
 
 .. _controlling-match-pp:
 
@@ -283,7 +302,7 @@ Printing matching on irrefutable patterns
 ++++++++++++++++++++++++++++++++++++++++++
 
 If an inductive type has just one constructor, pattern matching can be
-written using the first destructuring let syntax.
+written using the :ref:`let-tuple syntax `.
 
 .. table:: Printing Let @qualid
 
@@ -329,6 +348,19 @@ This example emphasizes what the printing settings offer.
 
        Print snd.
 
+Printing regular match syntax
++++++++++++++++++++++++++++++
+
+.. flag:: Printing Regular Matches
+
+   When enabled, this flag makes printing avoid the alternate case
+   analysis syntaxes (with :ref:`if ` and :ref:`let
+   `), overriding :table:`Printing If` and
+   :table:`Printing Let` and disregarding the syntax used to input the
+   case analysis (so e.g. `let 'tt := tt in tt` will be printed using `match`).
+
+   This flag is off by default.
+
 Conventions about unused pattern-matching variables
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
@@ -632,6 +664,15 @@ When we use parameters in patterns there is an error message:
      end).
    Unset Asymmetric Patterns.
 
+.. flag:: Asymmetric Patterns No Implicits
+
+   This compatibility :term:`flag` (off by default) disactivates
+   implicit arguments in patterns when :flag:`Asymmetric Patterns` is
+   on, thus recovering the behavior of :flag:`Asymmetric Patterns`
+   before Rocq 9.3.
+
+   .. deprecated:: 9.3
+
 Implicit arguments in patterns
 ------------------------------
 
diff --git a/doc/sphinx/practical-tools/coq-commands.rst b/doc/sphinx/practical-tools/coq-commands.rst
index 5159223980b6..cb787ec90d6f 100644
--- a/doc/sphinx/practical-tools/coq-commands.rst
+++ b/doc/sphinx/practical-tools/coq-commands.rst
@@ -326,9 +326,6 @@ and ``rocq repl``, unless stated otherwise:
 :-q: Do not to load the default resource file.
 :-l *file*, -load-vernac-source *file*: Load and execute the Rocq
   script from *file.v*.
-:-lv *file*, -load-vernac-source-verbose *file*: Load and execute the
-  Rocq script from *file.v*. Write its contents to the standard output as
-  it is executed.
 :-require *qualid*: Load Rocq compiled library :n:`@qualid`.
   This is equivalent to running :cmd:`Require` :n:`@qualid`
   (note: the short form `-r *qualid*` is intentionally not provided to
@@ -372,8 +369,6 @@ and ``rocq repl``, unless stated otherwise:
   order of command-line options.
 :-load-vernac-object *qualid*: Obsolete synonym of :n:`-require qualid`.
 :-batch: Exit just after argument parsing. Available for ``rocq repl`` only.
-:-verbose: Output the content of the input file as it is compiled.
-  This option is available for ``rocq compile`` only.
 :-native-compiler (yes|no|ondemand): Enable the :tacn:`native_compute`
   reduction machine and precompilation to ``.cmxs`` files for future use
   by :tacn:`native_compute`.
@@ -454,8 +449,7 @@ and ``rocq repl``, unless stated otherwise:
   instead of a ``.vo`` file, and to load ``.vos`` files instead of ``.vo`` files
   when interpreting :cmd:`Require` commands.
 :-vok: Indicate Rocq to check a file completely, to load ``.vos`` files instead
-  of ``.vo`` files when interpreting :cmd:`Require` commands, and to output an empty
-  ``.vok`` files upon success instead of writing a ``.vo`` file.
+  of ``.vo`` files when interpreting :cmd:`Require` commands. No ``.vo`` file is written.
 :-w (all|none|w₁,…,wₙ): Configure the display of warnings. This
   option expects all, none or a comma-separated list of warning names or
   categories (see Section :ref:`controlling-display`).
@@ -467,8 +461,7 @@ and ``rocq repl``, unless stated otherwise:
   removed tokens.  Requires that ``-color`` is enabled.  (see Section
   :ref:`showing_diffs`).
 :-beautify: Pretty-print each command to *file.beautified* when
-  compiling *file.v*, in order to get old-fashioned
-  syntax/definitions/notations.
+  compiling *file.v*. Very buggy.
 :-emacs, -ide-slave: Start a special toplevel to communicate with a
   specific IDE.
 :-impredicative-set: Change the logical theory of Rocq by declaring the
@@ -595,10 +588,7 @@ which is similar to ``foo.vo`` except that all opaque proofs are skipped in
 the compilation process.
 
 The compilation using ``rocq c -vok foo.v`` checks that the file ``foo.v``
-correctly compiles, including all its opaque proofs. If the compilation
-succeeds, then the output is a file called ``foo.vok``, with empty contents.
-This file is only a placeholder indicating that ``foo.v`` has been successfully
-compiled. (This placeholder is useful for build systems such as ``make``.)
+correctly compiles, including all its opaque proofs.
 
 When compiling a file ``bar.v`` that depends on ``foo.v`` (for example via
 a ``Require Foo.`` command), if the compilation command is ``rocq c -vos bar.v``
@@ -606,6 +596,10 @@ or ``rocq c -vok bar.v``, then the file ``foo.vos`` gets loaded (instead of
 ``foo.vo``). A special case is if file ``foo.vos`` exists and has empty
 contents, and ``foo.vo`` exists, then ``foo.vo`` is loaded.
 
+Empty `.vos` and `.vok` files are created by the `.vo` targets of
+`rocq makefile`, and an empty `.vok` by the `.vok` targets of `rocq
+makefile`.
+
 Appart from the aforementioned case where ``foo.vo`` can be loaded in place
 of ``foo.vos``, in general the ``.vos`` and ``.vok`` files live totally
 independently from the ``.vo`` files.
@@ -675,12 +669,14 @@ in sections without :cmd:`Proof using` are fully processed (much slower).
 
 **Interaction with standard compilation**
 
-When compiling a file ``foo.v`` using ``rocq compile`` in the standard way (i.e., without
-``-vos`` nor ``-vok``), an empty file ``foo.vos`` and an empty file ``foo.vok``
-are created in addition to the regular output file ``foo.vo``.
-If ``rocq compile`` is subsequently invoked on some other file ``bar.v`` using option
-``-vos`` or ``-vok``, and that ``bar.v`` requires ``foo.v``, if Rocq finds an
-empty file ``foo.vos``, then it will load ``foo.vo`` instead of ``foo.vos``.
+When compiling a file ``foo.v`` using ``rocq compile`` invoked through
+the makefile generated by `rocq makefile` for a `.vo` target, an empty
+file ``foo.vos`` and an empty file ``foo.vok`` are created in addition
+to the regular output file ``foo.vo``. If ``rocq compile`` is
+subsequently invoked on some other file ``bar.v`` using option
+``-vos`` or ``-vok``, and that ``bar.v`` requires ``foo.v``, if Rocq
+finds an empty file ``foo.vos``, then it will load ``foo.vo`` instead
+of ``foo.vos``.
 
 The purpose of this feature is to allow users to benefit from the ``-vos``
 option even if they depend on libraries that were compiled in the traditional
diff --git a/doc/sphinx/practical-tools/coqide.rst b/doc/sphinx/practical-tools/coqide.rst
index eb4ce5226703..767061fbf787 100644
--- a/doc/sphinx/practical-tools/coqide.rst
+++ b/doc/sphinx/practical-tools/coqide.rst
@@ -434,10 +434,10 @@ mathematical symbols ∀ and ∃, you may define:
 .. rocqtop:: in
 
    Notation "∀ x .. y , P" := (forall x, .. (forall y, P) ..)
-     (at level 200, x binder, y binder, right associativity)
+     (at level 10, x binder, y binder, P at level 200)
      : type_scope.
    Notation "∃ x .. y , P" := (exists x, .. (exists y, P) ..)
-     (at level 200, x binder, y binder, right associativity)
+     (at level 10, x binder, y binder, P at level 200)
      : type_scope.
 
 A small set of such notations are already defined in the Coq library
diff --git a/doc/sphinx/practical-tools/utilities.rst b/doc/sphinx/practical-tools/utilities.rst
index 35c1688fc70b..2858df8660c6 100644
--- a/doc/sphinx/practical-tools/utilities.rst
+++ b/doc/sphinx/practical-tools/utilities.rst
@@ -18,30 +18,30 @@ Installing the Rocq Prover and Rocq packages with opam
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
 The easiest way to install the Rocq Prover is with the
-`Coq Platform `_, which relies
+`Rocq Platform `_, which relies
 on the `opam package manager `_.
 
-The Coq platform installation process provides options to automatically install
+The Rocq platform installation process provides options to automatically install
 some of the most frequently used packages at the
 same time.  While there's currently no guarantee that user-developed packages
 will compile on the current version of Rocq, all packages
-that Coq platform installs should compile without difficulty--this is part of
-the Coq platform release process.
+that Rocq platform installs should compile without difficulty--this is part of
+the Rocq platform release process.
 
 Once you've installed Rocq, you can search for additional user-developed packages
 from the `package list `_ or other opam repositories.
 These commands may be helpful:
 
-- `opam list "coq-*"` to see the list of available and installed packages
-- `opam list "coq-*" --installed` to see the list of installed packages
+- `opam list "rocq-*"` to see the list of available and installed packages
+- `opam list "rocq-*" --installed` to see the list of installed packages
 - `opam install ` to install a package on your system.
 - `opam update` as needed to update the list of available packages
 
 For example, this command shows the installed packages with the package name,
 its version and short description::
 
-   $ opam list "coq-*" --installed
-   coq-bignums               8.15.0          Bignums, the Coq library of arbitrary large numbers
+   $ opam list "rocq-*" --installed
+   rocq-bignums               9.0.0          Bignums, the Rocq library of arbitrary large numbers
 
 Note that packages marked `released` in the package list web page are more stable
 than those marked `extra-dev`.  To install `extra-dev` packages,
@@ -55,7 +55,7 @@ While this is the easiest way to install packages, it is not the only way.
 You will then need to find the :term:`logical name` used to refer to the package
 in :cmd:`Require` commands.  There are a couple ways to do this:
 
-- If you installed with opam, use :n:`opam show --list-files coq-bignums | head -n1` -
+- If you installed with opam, use :n:`opam show --list-files rocq-bignums | head -n1` -
   the last component of the filename is the logical name (`Bignums`).
 
 - On Linux, :n:`ls $(rocq c -where)/user-contrib` shows the logical names of all
@@ -92,7 +92,7 @@ For a project that has only a single file, you can create the file wherever you
 and then step through it in one of the IDEs for Rocq, such as
 :ref:`coqintegrateddevelopmentenvironment`,
 `ProofGeneral `_,
-`vsCoq `_
+`vsRocq `_
 and `Coqtail `_.
 
 If your project has multiple files in a single directory that depend on each
@@ -109,38 +109,41 @@ If your project files are in multiple directories, you would also need to pass
 additional command-line -Q and -R parameters to your IDE.  More details to manage
 and keep track of.
 
-Instead, by creating a `_CoqProject` file, you can automatically generate
+Instead, by creating a `_RocqProject` file, you can automatically generate
 a makefile that applies the correct dependencies when it compiles your project.
-In addition, the IDEs find and interpret `_CoqProject` files, so project files
+In addition, the IDEs find and interpret `_RocqProject` files, so project files
 spread over multiple directories will work seamlessly.  If you're editing `dir/foo.v`,
-the IDEs apply settings from the `_CoqProject` file in `dir` or the closest
+the IDEs apply settings from the `_RocqProject` file in `dir` or the closest
 ancestor directory.
 
-The `_CoqProject` file identifies the :term:`logical path` to associate with the
-directories containing your compiled files.  The `_CoqProject` file is normally
+.. warning::
+   Some IDEs still look for the old name `_CoqProject`.
+
+The `_RocqProject` file identifies the :term:`logical path` to associate with the
+directories containing your compiled files.  The `_RocqProject` file is normally
 in the top directory of the project.  Occasionally it may be useful to have
-additional `_CoqProject` files in subdirectories, for example in order to pass
+additional `_RocqProject` files in subdirectories, for example in order to pass
 different startup parameters to Rocq for particular scripts.
 
 .. _building_with_coqproject:
 
-Building a project with _CoqProject (overview)
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Building a project with _RocqProject (overview)
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
 Note: building with `dune` is experimental.  See :ref:`building_dune`.
 
-The `_CoqProject` file contains the information needed to generate a makefile
-for building your project.  Your `_CoqProject` file should be in
+The `_RocqProject` file contains the information needed to generate a makefile
+for building your project.  Your `_RocqProject` file should be in
 the top directory of your project's source tree.  We recommend using the
 :term:`logical name` of the project as the name of the top directory.
 
-**Note:** Make sure that `_CoqProject` has no file extension.  On Windows, some
+**Note:** Make sure that `_RocqProject` has no file extension.  On Windows, some
 tools such as Notepad invisibly append `.txt` even when you ask to save the file
-as `_CoqProject`.  Also, File Manager doesn't display file extensions.  You may
+as `_RocqProject`.  Also, File Manager doesn't display file extensions.  You may
 be better off using a command line interface and an editor such as `vi` that
 always show file extensions.
 
-For example, here is a minimal `_CoqProject` file for the `MyPackage` project
+For example, here is a minimal `_RocqProject` file for the `MyPackage` project
 (the logical name of the package), which includes all the ``.v`` files (and
 other file types) in the `theories` directory and its subdirectories::
 
@@ -179,20 +182,20 @@ a bit; it shows the logical names defined in the Rocq process.
 
 Then:
 
-- Generate a makefile from `_CoqProject` with
-  :n:`rocq makefile -f _CoqProject -o CoqMakefile` and
+- Generate a makefile from `_RocqProject` with
+  :n:`rocq makefile -f _RocqProject -o RocqMakefile` and
 
-- Compile your project with :n:`make -f CoqMakefile` as needed.
+- Compile your project with :n:`make -f RocqMakefile` as needed.
 
 If you add more files to your project that are not in directories listed
-in `_CoqProject`, update `_CoqProject` and re-run `rocq makefile` and `make`.
+in `_RocqProject`, update `_RocqProject` and re-run `rocq makefile` and `make`.
 
 .. todo we should use a standard name for the makefile so IDEs can find it.
-   Maybe you should be allowed to include "-o MAKEFILENAME" in the `_CoqProject`,
+   Maybe you should be allowed to include "-o MAKEFILENAME" in the `_RocqProject`,
    maybe default to "makefile"; provide a name only if you want to use a wrapper
    Then mandate that the file be called simply "makefile" so IDEs can find it.
 
-We recommend checking `CoqMakefile` and `CoqMakefile.conf` into your source code
+We recommend checking `RocqMakefile` and `RocqMakefile.conf` into your source code
 control system.  Also we recommend updating them with `rocq makefile` when you switch
 to a new version of Rocq.
 
@@ -278,7 +281,7 @@ Each directory may contain multiple `.v`/`.vo` files.  For example,
 is often sufficient in :cmd:`Require` instead of a fully qualified
 name.
 
-In :cmd:`Require` commands referring to the current package (if `_CoqProject`
+In :cmd:`Require` commands referring to the current package (if `_RocqProject`
 uses `-R`) can be referenced with a short name without
 a `From` clause provided that the logical path is unambiguous (as if they are
 available through `-R`).  In contrast, :cmd:`Require` commands that load files from other
@@ -287,8 +290,8 @@ or include a `From` clause (as if they are available through `-Q`).  This is don
 to reduce the number of ambiguous logical paths.  We encourage using `From`
 clauses.
 
-Note that if you use a `_CoqProject` file, the `ROCQPATH` environment variable is not helpful.
-If you use `ROCQPATH` without a `_CoqProject`, a file in `MyPackage/theories/SubDir/File.v` will be
+Note that if you use a `_RocqProject` file, the `ROCQPATH` environment variable is not helpful.
+If you use `ROCQPATH` without a `_RocqProject`, a file in `MyPackage/theories/SubDir/File.v` will be
 loaded with the logical name `MyPackage/theories/SubDir.File`, which may not be what you want.
 
 If you associate the same logical name with more than one directory, Rocq
@@ -301,15 +304,15 @@ Modifying multiple interdependent projects at the same time
 If you want to modify multiple interdependent projects simultaneously,
 good practice recommends that
 all of them should be uninstalled.  Since the IDEs only apply a single
-`_CoqProject` file for each script, the best way to make them work properly is to
-temporarily edit the `_CoqProject` for each project so it includes the other
+`_RocqProject` file for each script, the best way to make them work properly is to
+temporarily edit the `_RocqProject` for each project so it includes the other
 uninstalled projects it depends on, then regenerate the makefile.  This may
-make your `_CoqProject` system dependent.  Such dependencies shouldn't be
+make your `_RocqProject` system dependent.  Such dependencies shouldn't be
 present in published packages.
 
 For example, if
 project `A` requires project `B`, add `-Q  B` to the
-`_CoqProject` in `A`.  This will override any installed version of `B` only
+`_RocqProject` in `A`.  This will override any installed version of `B` only
 when you're working on scripts in `A`.
 
 If you want to build all the related projects at once, you're
@@ -327,7 +330,7 @@ The directory structure of installed packages (i.e., in the `user-contrib` direc
 of the Rocq installation) differs from that generally used for the project source tree.
 The installed directory structure omits the paths given in the `-R` and `-Q`
 parameters that are not part of the logical name of a file.  For example,
-consider the following `_CoqProject` file.
+consider the following `_RocqProject` file.
 
   -R theories MyPackage
   theories/File1.v
@@ -337,21 +340,21 @@ The compiled file `theories/File1.vo` will be installed in
 the directory `user-contrib/MyPackage` and
 `theories/SubDir/File2.vo` in `user-contrib/MyPackage/SubDir`.
 
-Use :n:`make -f CoqMakefile install` to install a project from a directory.
+Use :n:`make -f RocqMakefile install` to install a project from a directory.
 
 If you try to step through scripts in installed packages (e.g. to understand
 the proofs therein), you may get unexpected failures for two reasons:
 
-* `_CoqProject` files often have at least one `-R` parameter, while
+* `_RocqProject` files often have at least one `-R` parameter, while
   installed packages are loaded with the less-permissive `-Q` option described in
   the :cmd:`Require` command, which may cause a :cmd:`Require` to fail.  One workaround is
-  to create a `_CoqProject` file containing the line `-R . ` in
-  `user-contrib/`.  In this case, the `_CoqProject` doesn't
+  to create a `_RocqProject` file containing the line `-R . ` in
+  `user-contrib/`.  In this case, the `_RocqProject` doesn't
   need to list all the source files.
 
-* Sometimes, the `_CoqProject` file specifies options that affect the
+* Sometimes, the `_RocqProject` file specifies options that affect the
   behavior of Rocq, such as `-impredicative-set`.  These can similarly be
-  added in `_CoqProject` files in `user-contrib`.
+  added in `_RocqProject` files in `user-contrib`.
 
 Another way to get around these problems is to download the source tree for the
 project in a new directory and compile it before stepping through its scripts.
@@ -384,9 +387,9 @@ files and possibly some ``.ml`` ones (a Rocq plugin). The main piece of
 metadata needed in order to build the project are the command line
 options to ``rocq compile`` (e.g. ``-R``, ``-Q``, ``-I``, see :ref:`command
 line options `). Collecting the list of files
-and options is the job of the ``_CoqProject`` file.
+and options is the job of the ``_RocqProject`` file.
 
-A ``_CoqProject`` file may contain the following kinds of entries in any order,
+A ``_RocqProject`` file may contain the following kinds of entries in any order,
 separated by whitespace:
 
 * Selected options of `rocq compile`, which are forwarded directly to it. Currently these
@@ -399,7 +402,7 @@ separated by whitespace:
 * Comments, started with an unquoted ``#`` and continuing to the end of the
   line.
 
-A simple example of a ``_CoqProject`` file follows:
+A simple example of a ``_RocqProject`` file follows:
 
 ::
 
@@ -428,19 +431,19 @@ is given. The generated file makes the plugin available
 to the :cmd:`Declare ML Module` as ``my-package.plugin``. If the generated file
 doesn't suit your needs (for instance because it depends on some OCaml
 packages) or your project has multiple plugins, then create a file named
-``META.my-package`` and list it in the ``_CoqProject`` file.
+``META.my-package`` and list it in the ``_RocqProject`` file.
 You can use ``ocamlfind lint META.my-package`` to lint the hand written file.
 Typically ``my-package`` is the name of the ``OPAM`` package for your
-project (which conventionally starts with ``coq-``). If the project
+project (which conventionally starts with ``rocq-``). If the project
 includes a ``.mlg`` file (to be pre-processed by ``rocq pp-mlg``) that
 declares a plugin, then the given name must match the ``findlib`` plugin
 name, e.g. ``DECLARE PLUGIN "my-package.plugin"``.
 
-The ``-native-compiler`` option given in the ``_CoqProject`` file overrides
+The ``-native-compiler`` option given in the ``_RocqProject`` file overrides
 the global one passed at configure time.
 
 RocqIDE, Proof General, VsCoq and Coqtail all
-understand ``_CoqProject`` files and can be used to invoke Rocq with the desired options.
+understand ``_RocqProject`` files and can be used to invoke Rocq with the desired options.
 
 The ``rocq makefile`` utility can be used to set up a build infrastructure
 for the Rocq project based on makefiles. We recommend
@@ -448,55 +451,55 @@ invoking ``rocq makefile`` this way:
 
 ::
 
-    rocq makefile -f _CoqProject -o CoqMakefile
+    rocq makefile -f _RocqProject -o RocqMakefile
 
 
 This command generates the following files:
 
-CoqMakefile
+RocqMakefile
   is a makefile for ``GNU Make`` with targets to build the project
   (e.g. generate .vo or .html files from .v or compile .ml* files)
   and install it in the ``user-contrib`` directory where the Rocq
   library is installed.
 
-CoqMakefile.conf
+RocqMakefile.conf
   contains make variables assignments that reflect
-  the contents of the ``_CoqProject`` file as well as the path relevant to
+  the contents of the ``_RocqProject`` file as well as the path relevant to
   Rocq.
 
 Run ``rocq makefile --help`` for a description of command line options.
 
-The recommended approach is to invoke ``CoqMakefile`` from a standard
+The recommended approach is to invoke ``RocqMakefile`` from a standard
 ``Makefile`` in the following form:
 
 .. example::
 
   ::
 
-      # KNOWNTARGETS will not be passed along to CoqMakefile
-      KNOWNTARGETS := CoqMakefile extra-stuff extra-stuff2
+      # KNOWNTARGETS will not be passed along to RocqMakefile
+      KNOWNTARGETS := RocqMakefile extra-stuff extra-stuff2
       # KNOWNFILES will not get implicit targets from the final rule, and so
       # depending on them won't invoke the submake
       # Warning: These files get declared as PHONY, so any targets depending
       # on them always get rebuilt
-      KNOWNFILES   := Makefile _CoqProject
+      KNOWNFILES   := Makefile _RocqProject
 
-      .DEFAULT_GOAL := invoke-coqmakefile
+      .DEFAULT_GOAL := invoke-rocqmakefile
 
-      CoqMakefile: Makefile _CoqProject
-              $(COQBIN)rocq makefile -f _CoqProject -o CoqMakefile
+      RocqMakefile: Makefile _RocqProject
+              $(COQBIN)rocq makefile -f _RocqProject -o RocqMakefile
 
-      invoke-coqmakefile: CoqMakefile
-              $(MAKE) --no-print-directory -f CoqMakefile $(filter-out $(KNOWNTARGETS),$(MAKECMDGOALS))
+      invoke-rocqmakefile: RocqMakefile
+              $(MAKE) --no-print-directory -f RocqMakefile $(filter-out $(KNOWNTARGETS),$(MAKECMDGOALS))
 
-      .PHONY: invoke-coqmakefile $(KNOWNFILES)
+      .PHONY: invoke-rocqmakefile $(KNOWNFILES)
 
       ####################################################################
       ##                      Your targets here                         ##
       ####################################################################
 
       # This should be the last rule, to handle any targets not declared above
-      %: invoke-coqmakefile
+      %: invoke-rocqmakefile
               @true
 
 The advantage of a wrapper, compared to directly calling the generated
@@ -508,12 +511,12 @@ Including the generated makefile with an include directive is
 discouraged, since the contents of this file, including variable names and
 status of rules, may change in the future.
 
-Use the optional file ``CoqMakefile.local`` to extend
-``CoqMakefile``. In particular, you can declare custom actions to run
+Use the optional file ``RocqMakefile.local`` to extend
+``RocqMakefile``. In particular, you can declare custom actions to run
 before or after the build process. Similarly you can customize the
 install target or even provide new targets. See
 :ref:`rocqmakefilelocal` for extension-point documentation. Although
-you can use all variables defined in ``CoqMakefile`` in the *recipes*
+you can use all variables defined in ``RocqMakefile`` in the *recipes*
 of rules that you write and in the definitions of any variables that
 you assign with ``=``, many variables are not available for use if you
 assign variable values with ``:=`` nor to define the *targets* of
@@ -521,13 +524,13 @@ rules nor in top-level conditionals such as ``ifeq``. Additionally,
 you must use `secondary expansion
 `_
 to make use of such variables in the prerequisites of rules. To access
-variables defined in ``CoqMakefile`` in rule target computation,
+variables defined in ``RocqMakefile`` in rule target computation,
 top-level conditionals, and ``:=`` variable assignment, for example to
 add new dependencies to compiled outputs, use the optional file
-``CoqMakefile.local-late``.  See :ref:`rocqmakefilelocallate` for a
+``RocqMakefile.local-late``.  See :ref:`rocqmakefilelocallate` for a
 non-exhaustive list of variables.
 
-The extensions of files listed in ``_CoqProject`` determine
+The extensions of files listed in ``_RocqProject`` determine
 how they are built. In particular:
 
 
@@ -555,33 +558,33 @@ line. Comments are ignored.
 
 Quoting arguments to rocq c
 +++++++++++++++++++++++++++
-Any string in a ``_CoqProject`` file may be enclosed in double quotes to include
+Any string in a ``_RocqProject`` file may be enclosed in double quotes to include
 whitespace characters or ``#``. For example, use ``-arg "-w all"`` to pass the
 argument ``-w all`` to `rocq compile`. If the argument to `rocq compile` needs some quotes as well,
 use single-quotes inside the double-quotes. For example ``-arg "-set 'Default
 Goal Selector=!'"`` gets passed to `rocq compile` as ``-set 'Default Goal Selector=!'``.
 
-But note, that single-quotes in a ``_CoqProject`` file are only special
+But note, that single-quotes in a ``_RocqProject`` file are only special
 characters if they appear in the string following ``-arg``. And on their own
-they don't quote spaces. For example ``-arg 'foo bar'`` in ``_CoqProject`` is
-equivalent to ``-arg foo "bar'"`` (in ``_CoqProject`` notation). ``-arg "'foo
+they don't quote spaces. For example ``-arg 'foo bar'`` in ``_RocqProject`` is
+equivalent to ``-arg foo "bar'"`` (in ``_RocqProject`` notation). ``-arg "'foo
 bar'"`` behaves differently and passes ``'foo bar'`` to `rocq compile`.
 
 Forbidden filenames
 +++++++++++++++++++
-The paths of files given in a ``_CoqProject`` file may not contain any of the
+The paths of files given in a ``_RocqProject`` file may not contain any of the
 following characters: ``\n``, ``\t``, space, ``\``, ``'``, ``"``, ``#``, ``$``,
 ``%``. These characters have special meaning in Makefiles and
 ``rocq makefile`` doesn't support encoding them correctly.
 
 Warning: No common logical root
 +++++++++++++++++++++++++++++++
-When a ``_CoqProject`` file contains something like ``-R theories Foo
+When a ``_RocqProject`` file contains something like ``-R theories Foo
 theories/Bar.v``, the ``install-doc`` target installs the documentation
 generated by ``rocq doc`` into ``user-contrib/Foo/``, in the folder where Rocq was
 installed.
 
-But if the ``_CoqProject`` file contains something like:
+But if the ``_RocqProject`` file contains something like:
 
 ::
 
@@ -596,16 +599,16 @@ a warning: "No common logical root" and generate a Makefile that installs the
 documentation in some folder beginning with "orphan", in the above example,
 it'd be ``user-contrib/orphan_Foo_Bar``.
 
-In this case, specify the ``-docroot`` option in _CoqProject to override
+In this case, specify the ``-docroot`` option in _RocqProject to override
 the automatically selected logical root.
 
 .. _rocqmakefilelocal:
 
-CoqMakefile.local
-+++++++++++++++++
+RocqMakefile.local
+++++++++++++++++++
 
-The optional file ``CoqMakefile.local`` is included by the generated
-file ``CoqMakefile``. It can contain two kinds of directives.
+The optional file ``RocqMakefile.local`` is included by the generated
+file ``RocqMakefile``. It can contain two kinds of directives.
 
 **Variable assignment**
 
@@ -698,11 +701,11 @@ The following makefile rules can be extended.
 
 .. _rocqmakefilelocallate:
 
-CoqMakefile.local-late
-++++++++++++++++++++++
+RocqMakefile.local-late
++++++++++++++++++++++++
 
-The optional file ``CoqMakefile.local-late`` is included at the end of the generated
-file ``CoqMakefile``.  The following is a partial list of accessible variables:
+The optional file ``RocqMakefile.local-late`` is included at the end of the generated
+file ``RocqMakefile``.  The following is a partial list of accessible variables:
 
 :COQ_VERSION:
    the version of ``rocq compile`` being used, which can be used to
@@ -722,8 +725,8 @@ file ``CoqMakefile``.  The following is a partial list of accessible variables:
 In addition, the following variables may be useful for
 deciding what targets to present via ``$(shell ...)``; these
 variables are already accessible in recipes for rules added in
-``CoqMakefile.local``, but are only accessible from top-level ``$(shell
-...)`` invocations in ``CoqMakefile.local-late``:
+``RocqMakefile.local``, but are only accessible from top-level ``$(shell
+...)`` invocations in ``RocqMakefile.local-late``:
 
 :ROCQ, COQC, COQDEP, COQDOC, CAMLC, CAMLOPTC:
    compiler binaries
@@ -992,7 +995,7 @@ Precompiling for ``native_compute``
 +++++++++++++++++++++++++++++++++++
 
 To compile files for ``native_compute``, one can use the
-``-native-compiler yes`` option of Rocq, by putting it in the ``_CoqProject``
+``-native-compiler yes`` option of Rocq, by putting it in the ``_RocqProject``
 file.
 
 The generated installation target of ``rocq makefile`` will then take care of
@@ -1000,7 +1003,7 @@ installing the extra ``.coq-native`` directories.
 
 .. note::
 
-   As an alternative to modifying ``_CoqProject``, one can set an
+   As an alternative to modifying ``_RocqProject``, one can set an
    environment variable when calling ``make``:
 
    ::
@@ -1012,19 +1015,19 @@ installing the extra ``.coq-native`` directories.
 
    ::
 
-      COQEXTRAFLAGS="-native-compiler yes" opam install coq-package
+      COQEXTRAFLAGS="-native-compiler yes" opam install rocq-package
 
 .. note::
 
    This requires all dependencies to be themselves compiled with
    ``-native-compiler yes``.
 
-The grammar of _CoqProject
-++++++++++++++++++++++++++
-A ``_CoqProject`` file encodes a list of strings using the following syntax:
+The grammar of _RocqProject
++++++++++++++++++++++++++++
+A ``_RocqProject`` file encodes a list of strings using the following syntax:
 
   .. prodn::
-     CoqProject ::= {* {| @blank | @comment | @quoted_string | @unquoted_string } }
+     RocqProject ::= {* {| @blank | @comment | @quoted_string | @unquoted_string } }
      blank ::= {| space | horizontal_tab | newline }
      comment ::= # {* comment_char } newline
      quoted_string ::= " {* quoted_char } "
@@ -1040,7 +1043,7 @@ where the following definitions apply:
 * :n:`unquoted_char` is the set of all characters except those that match :n:`@blank` or are ``#``.
 
 The parser produces a list of strings in the same order as they were
-encountered in ``_CoqProject``. Blanks and comments are removed
+encountered in ``_RocqProject``. Blanks and comments are removed
 and the double quotes of :n:`@quoted_string` tokens are removed as
 well. The list is then treated as a list of command-line arguments of
 ``rocq makefile``.
@@ -1049,10 +1052,10 @@ The semantics of ``-arg`` are as follows: the string given as argument is split
 on whitespace, but single quotes prevent splitting. The resulting list of
 strings is then passed to `rocq compile`.
 
-The current approach has a few limitations: Double quotes in a ``_CoqProject``
+The current approach has a few limitations: Double quotes in a ``_RocqProject``
 file are only special characters at the start of a string. For lack of an
 escaping mechanism, it is currently impossible to pass the following kinds of
-strings to ``rocq makefile`` using a ``_CoqProject`` file:
+strings to ``rocq makefile`` using a ``_RocqProject`` file:
 
 * strings starting with ``"``
 * strings starting with ``#`` and containing ``"``
diff --git a/doc/sphinx/proof-engine/ltac.rst b/doc/sphinx/proof-engine/ltac.rst
index d19dd63869f3..7ea13b8843a0 100644
--- a/doc/sphinx/proof-engine/ltac.rst
+++ b/doc/sphinx/proof-engine/ltac.rst
@@ -99,8 +99,8 @@ in turn have higher precedence than `;`, which is part of :token:`ltac_expr4`.
    | @ltac_expr3
    ltac_expr3 ::= @l3_tactic
    | @ltac_expr2
-   ltac_expr2 ::= @ltac_expr2 + @ltac_expr2
-   | @ltac_expr2 %|| @ltac_expr2
+   ltac_expr2 ::= @ltac_expr1 + @ltac_expr2
+   | @ltac_expr1 %|| @ltac_expr2
    | @l2_tactic
    | @ltac_expr1
    ltac_expr1 ::= @tactic_value
@@ -300,6 +300,7 @@ as a :token:`tactic_arg`.  Local symbols are also substituted into tactics:
    .. rocqtop:: reset none
 
       Goal True.
+      Proof.
 
    .. rocqtop:: all
 
@@ -475,6 +476,7 @@ Selectors can also be used nested within a tactic expression with the
    .. rocqtop:: reset in
 
       Goal 1=0 /\ 2=0 /\ 3=0.
+      Proof.
 
    .. rocqtop:: all
 
@@ -496,6 +498,7 @@ separately.  They succeed only if there is a success for each goal.  For example
    .. rocqtop:: reset none fail
 
       Goal True /\ False.
+      Proof.
 
    .. rocqtop:: out
 
@@ -702,6 +705,7 @@ We can branch with backtracking with the following structure:
       .. rocqtop:: reset none
 
          Goal True.
+         Proof.
 
       .. rocqtop:: all
 
@@ -788,6 +792,7 @@ In some cases backtracking may be too expensive.
       .. rocqtop:: reset none
 
          Goal True.
+         Proof.
 
       The :tacn:`fail` doesn't trigger the second :tacn:`idtac`:
 
@@ -812,6 +817,7 @@ In some cases backtracking may be too expensive.
 
        Tactic Notation "myfirst" "[" tactic_list_sep(tacl,"|") "]" := first tacl.
        Goal True.
+       Proof.
        myfirst [ auto | apply I ].
 
 Solving
@@ -899,6 +905,7 @@ Rocq defines an |Ltac| tactic in `Init.Tactics` to check that a tactic *fails*:
       .. rocqtop:: reset none
 
          Goal True.
+         Proof.
 
       .. rocqtop:: all fail
 
@@ -1210,6 +1217,7 @@ Pattern matching on terms: match
       .. rocqtop:: reset none
 
          Goal True.
+         Proof.
 
       .. rocqtop:: all
 
@@ -1258,6 +1266,7 @@ Pattern matching on terms: match
       .. rocqtop:: in reset
 
          Goal True.
+         Proof.
 
       .. rocqtop:: all
 
@@ -1279,6 +1288,7 @@ Pattern matching on terms: match
                     | _ => idtac
                     end.
          Goal True.
+         Proof.
 
       .. rocqtop:: all
 
@@ -1390,6 +1400,7 @@ Examples:
       .. rocqtop:: reset all
 
          Goal forall A B : Prop, A -> B -> (A->B).
+         Proof.
          intros.
          match goal with
          | H : _ |- _ => idtac "apply " H; apply H
@@ -1404,6 +1415,7 @@ Examples:
       .. rocqtop:: reset all
 
          Goal forall A B : Prop, A -> B -> (A->B).
+         Proof.
          intros.
          match reverse goal with
          | H : _ |- _ => idtac "apply " H; apply H
@@ -1421,6 +1433,7 @@ Examples:
       .. rocqtop:: reset all
 
          Goal forall A B : Prop, A -> B -> (A->B).
+         Proof.
          intros A B H.
          match goal with
          | H1 : _, H2 : _ |- _ => idtac "match " H1 H2; fail
@@ -1458,6 +1471,7 @@ produce subgoals but generates a term to be used in tactic expressions:
       .. rocqtop:: reset all
 
          Goal True /\ True.
+         Proof.
          match goal with
          | |- context G [True] => let x := context G [False] in idtac x
          end.
@@ -1492,6 +1506,7 @@ expression returns an identifier:
       .. rocqtop:: reset none
 
          Goal True -> True.
+         Proof.
 
       .. rocqtop:: out
 
@@ -1567,6 +1582,7 @@ Counting goals: numgoals
          Ltac pr_numgoals := let n := numgoals in idtac "There are" n "goals".
 
          Goal True /\ True /\ True.
+         Proof.
          split;[|split].
 
       .. rocqtop:: all abort
@@ -1601,6 +1617,7 @@ Testing boolean expressions: guard
       .. rocqtop:: in
 
          Goal True /\ True /\ True.
+         Proof.
          split;[|split].
 
       .. rocqtop:: all
@@ -1689,6 +1706,14 @@ succeeds, and results in an error otherwise.
    .. exn:: Not a variable or hypothesis.
       :undocumented:
 
+.. tacn:: is_section_var @one_term
+
+   Succeeds if :n:`@one_term` is a section variable in
+   the current local context and fails otherwise.
+
+   .. exn:: Not a section variable.
+      :undocumented:
+
 .. tacn:: is_const @one_term
 
    Succeeds if :n:`@one_term` is a global constant that is neither a (co)inductive
@@ -1710,6 +1735,7 @@ succeeds, and results in an error otherwise.
       .. rocqtop:: reset in
 
          Goal True.
+         Proof.
          is_fix (fix f (n : nat) := match n with S n => f n | O => O end).
 
 .. tacn:: is_cofix @one_term
@@ -1727,6 +1753,7 @@ succeeds, and results in an error otherwise.
 
          CoInductive Stream (A : Type) : Type :=  Cons : A -> Stream A -> Stream A.
          Goal True.
+         Proof.
          let c := constr:(cofix f : Stream unit := Cons _ tt f) in
            is_cofix c.
 
@@ -1763,6 +1790,7 @@ succeeds, and results in an error otherwise.
          Record Box {T : Type} := box { unbox : T }.
          Arguments box {_} _.
          Goal True.
+         Proof.
          is_proj (unbox (box 0)).
 
 Timing
@@ -1849,6 +1877,7 @@ different :token:`string` parameters to :tacn:`restart_timer` and
         ret.
 
       Goal True.
+      Proof.
         let v := time_constr
              ltac:(fun _ =>
                      let x := time_constr1 ltac:(fun _ => constr:(10 * 10)) in
@@ -2088,6 +2117,7 @@ Proving that a list is a permutation of a second list
    .. rocqtop:: out
 
       Goal perm nat (1 :: 2 :: 3 :: nil) (3 :: 2 :: 1 :: nil).
+      Proof.
 
    .. rocqtop:: all abort
 
@@ -2098,6 +2128,7 @@ Proving that a list is a permutation of a second list
       Goal perm nat
              (0 :: 1 :: 2 :: 3 :: 4 :: 5 :: 6 :: 7 :: 8 :: 9 :: nil)
              (0 :: 2 :: 4 :: 6 :: 8 :: 9 :: 7 :: 5 :: 3 :: 1 :: nil).
+      Proof.
 
    .. rocqtop:: all abort
 
@@ -2378,6 +2409,7 @@ Tracing execution
 
          Ltac t x := exists x; reflexivity.
          Goal exists n, n=0.
+         Proof.
 
       .. rocqtop:: all
 
diff --git a/doc/sphinx/proof-engine/ltac2.rst b/doc/sphinx/proof-engine/ltac2.rst
index e7d287f92cdc..0fc9a6cfa6df 100644
--- a/doc/sphinx/proof-engine/ltac2.rst
+++ b/doc/sphinx/proof-engine/ltac2.rst
@@ -77,9 +77,9 @@ close to OCaml. Types follow the simply-typed syntax of OCaml.
 .. insertprodn ltac2_type ltac2_typevar
 
 .. prodn::
-   ltac2_type ::= @ltac2_type -> @ltac2_type
+   ltac2_type ::= @ltac2_type2 -> @ltac2_type
    | @ltac2_type2
-   ltac2_type2 ::= @ltac2_type2 * {+* @ltac2_type1 }
+   ltac2_type2 ::= @ltac2_type1 * {+* @ltac2_type1 }
    | @ltac2_type1
    ltac2_type1 ::= @ltac2_type1 @qualid
    | @ltac2_type0
@@ -206,6 +206,7 @@ For example, `Message.print` defined in `Message.v` is used to print messages:
 .. rocqtop:: none
 
    Goal True.
+   Proof.
 
 .. rocqtop:: all abort
 
@@ -228,14 +229,14 @@ There is dedicated syntax for list and array literals.
 .. insertprodn ltac2_expr ltac2_atom
 
 .. prodn::
-   ltac2_expr ::= @ltac2_expr ; @ltac2_expr
+   ltac2_expr ::= @ltac2_expr5 ; @ltac2_expr
    | @ltac2_expr5
    ltac2_expr5 ::= fun {+ @tac2pat0 } {? : @ltac2_type } => @ltac2_expr
    | let {? rec } @ltac2_let_clause {* with @ltac2_let_clause } in @ltac2_expr
    | @ltac2_expr3
    ltac2_let_clause ::= {+ @tac2pat0 } {? : @ltac2_type } := @ltac2_expr
-   ltac2_expr3 ::= {+, @ltac2_expr3 }
-   ltac2_expr2 ::= @ltac2_expr2 :: @ltac2_expr2
+   ltac2_expr3 ::= {+, @ltac2_expr2 }
+   ltac2_expr2 ::= @ltac2_expr1 :: @ltac2_expr2
    | @ltac2_expr1
    ltac2_expr1 ::= @ltac2_expr1 {+ @ltac2_expr0 }
    | @ltac2_expr1 .( @qualid )
@@ -976,6 +977,7 @@ one from Ltac1, except that it requires the goal to be focused.
    .. rocqtop:: none
 
       Goal True.
+      Proof.
 
    In :tacn:`lazy_match!`, if :token:`ltac2_expr` fails, the :tacn:`lazy_match!` fails;
    it doesn't look for further matches.  In :tacn:`match!`, if :token:`ltac2_expr` fails
@@ -1161,6 +1163,7 @@ Match over goals
    .. rocqtop:: all abort
 
       Goal forall A B : Prop, A -> B -> (A->B).
+      Proof.
       intros.
       match! goal with
       | [ h : _ |- _ ] => let h := Control.hyp h in print (of_constr h); apply $h
@@ -1177,6 +1180,7 @@ Match over goals
    .. rocqtop:: all abort
 
       Goal forall A B : Prop, A -> B -> (A->B).
+      Proof.
       intros.
       match! reverse goal with
       | [ h : _ |- _ ] => let h := Control.hyp h in print (of_constr h); apply $h
@@ -1196,6 +1200,7 @@ Match over goals
    .. rocqtop:: all abort
 
       Goal forall A B : Prop, A -> B -> (A->B).
+      Proof.
       intros A B H.
       match! goal with
       | [ h1 : _, h2 : _ |- _ ] =>
@@ -1226,7 +1231,7 @@ Match on values
       tac2pat3 ::= @tac2pat3 %| {+| @tac2pat2 }
       | @tac2pat3 as @ident
       | @tac2pat2
-      tac2pat2 ::= @tac2pat2 :: @tac2pat2
+      tac2pat2 ::= @tac2pat1 :: @tac2pat2
       | @tac2pat1
       tac2pat1 ::= @qualid {+ @tac2pat0 }
       | @qualid
@@ -1256,7 +1261,7 @@ Match on values
 Notations
 ---------
 
-.. cmd:: Ltac2 Notation {+ @ltac2_syntax_class } {? {| : @natural | : @qualid {? ( @natural ) } } } := @ltac2_expr
+.. cmd:: Ltac2 Notation {+ @ltac2_syntax_class } {? {| : @natural | : @qualid {? ( @natural ) } } } {? % @qualid } := @ltac2_expr
 
    .. todo seems like name maybe should use lident rather than ident, considering:
 
@@ -1282,6 +1287,15 @@ Notations
    identifier (e.g. `"apply"`) the level is `1`, otherwise it is `5`.
    Custom entries must have explicit levels.
 
+   :n:`% @qualid` is the scope of the notation. By default it is
+   `Ltac2.Init.core`, which is automatically declared by the Ltac2
+   plugin. Scopes make it possible to have multiple notations with
+   identical parsing rules but different interpretations. The
+   interpretation is controlled by the stack of currently open scopes
+   (c.f. :cmd:`Ltac2 Open Scope` and :cmd:`Ltac2 Close Scope`),
+   looking in the first scope starting from the top of the stack for a
+   matching notation.
+
    When the notation is used, the values are substituted
    into the right-hand side.  In the following example, `x` is the formal parameter name and
    `constr` is its :ref:`syntactic class`.  `print` and `of_constr` are
@@ -1307,6 +1321,7 @@ Notations
       .. rocqtop:: none
 
          Goal True.
+         Proof.
 
       .. rocqtop:: all
 
@@ -1368,6 +1383,25 @@ Notations
 
       The level of a notation must be an integer between 0 and 6 inclusive.
 
+.. cmd:: Ltac2 Declare Scope @ident
+
+   Declare a new Ltac2 notation scope in the current module.
+
+.. cmd:: Ltac2 Open Scope @qualid
+
+   Add a scope to the current stack.  If the scope is already present,
+   the command moves it to the top of the stack.
+
+   This command supports locality attributes :attr:`global`, :attr:`export` and :attr:`local`.
+   In sections the default is `local`, otherwise it is `export`.
+
+.. cmd:: Ltac2 Close Scope @qualid
+
+   Remove a scope from the current stack.
+
+   This command supports locality attributes :attr:`global`, :attr:`export` and :attr:`local`.
+   In sections the default is `local`, otherwise it is `export`.
+
 .. cmd:: Ltac2 Custom Entry @ident
 
    Define a new grammar entry for Ltac2 expressions (as :cmd:`Declare
@@ -1404,8 +1438,10 @@ Abbreviations
 
    :n:`foo 0 ↦ (fun x => x ()) (fun _ => 0)`
 
-   Note that abbreviations are not type checked at all, and may result in typing
-   errors after expansion.
+   Abbreviations are typechecked at declaration time regardless of
+   :flag:`Ltac2 Typed Notations`. Unlike notations, this does not lose
+   any generality because they expand to applications instead of
+   letins.
 
    This command supports the :attr:`deprecated` attribute.
 
@@ -1596,8 +1632,7 @@ antiquotations are introduced by the syntax :n:`$@lident`.
 A few other specific syntactic classes exist to handle Ltac1-like syntax, but their use is
 discouraged and they are thus not documented.
 
-For now there is no way to declare new syntactic classes from the Ltac2 side, but this is
-planned.
+New syntactic classes may be declared from the Ltac2 side using :cmd:`Ltac2 Custom Entry`.
 
 Other nonterminals that have syntactic classes are listed here.
 
@@ -1999,6 +2034,7 @@ It has the same typing rules as `ltac2:()` except the expression must have type
      f x.
 
    Goal True.
+   Proof.
      let z := constr:(0) in
      let v := add1 z in
      idtac v.
@@ -2029,6 +2065,16 @@ Syntax changes
 Due to conflicts, a few syntactic rules have changed.
 
 - The dispatch tactical :n:`tac; [foo|bar]` is now written :n:`tac > [foo|bar]`.
+
+  * **Note on sequencing before dispatch:** Because Ltac2 does not
+    automatically delay tactic execution and due to operator precedence, a
+    sequence like ``tac1; tac2 > [foo|bar]`` is parsed as ``tac1; (tac2 > [foo|bar])``.
+    If ``tac1`` generates multiple goals, the dispatcher will attempt to apply the list
+    ``[foo|bar]`` to the subgoals generated by ``tac2`` *independently* for each goal
+    produced by ``tac1``. This typically results in an "Incorrect number of goals" error.
+    To achieve standard Ltac1 factoring, you must use parentheses to explicitly group
+    the sequence: ``(tac1; tac2) > [foo|bar]``.
+
 - Levels of a few operators have been revised. Some tacticals now parse as if
   they were normal functions. Parentheses are now required around complex
   arguments, such as abstractions. The tacticals affected are:
diff --git a/doc/sphinx/proof-engine/ssreflect-proof-language.rst b/doc/sphinx/proof-engine/ssreflect-proof-language.rst
index f266363ceff0..de877918ebc1 100644
--- a/doc/sphinx/proof-engine/ssreflect-proof-language.rst
+++ b/doc/sphinx/proof-engine/ssreflect-proof-language.rst
@@ -55,11 +55,11 @@ such as tactics to mix forward steps and generalizations as
 |SSR| adopts the point of view that rewriting, definition
 expansion and partial evaluation participate all to a same concept of
 rewriting a goal in a larger sense. As such, all these functionalities
-are provided by the :tacn:`rewrite ` tactic.
+are provided by the :tacn:`rw` tactic.
 
 |SSR| includes a little language of patterns to select subterms in
 tactics or tacticals where it matters. Its most notable application is
-in the :tacn:`rewrite ` tactic, where patterns are
+in the :tacn:`rw` tactic, where patterns are
 used to specify where the rewriting step has to take place.
 
 Finally, |SSR| supports so-called reflection steps, typically
@@ -68,8 +68,7 @@ logical view of a concept.
 
 To conclude, it is worth mentioning that |SSR| tactics can be mixed
 with non-|SSR| tactics in the same proof, or in the same Ltac
-expression. The few exceptions to this statement are described in
-section :ref:`compatibility_issues_ssr`.
+expression.
 
 
 Acknowledgments
@@ -86,9 +85,15 @@ Usage
 Getting started
 ~~~~~~~~~~~~~~~
 
-To be available, the tactics presented in this manual need the
-following minimal set of libraries to be loaded: ``ssreflect.v``,
-``ssrfun.v`` and ``ssrbool.v``.
+To be available, the tactics presented in this manual need
+``ssreflect_rw.v`` to be loaded.
+
+.. note::
+   One can also load ``ssreflect.v`` to get the deprecated ``rewrite``
+   tactic alias for :tacn:`rw` as well as the ``if  is  isn't  then _ else _`` syntax specialised to booleans.
+
 Moreover, these tactics come with a methodology
 specific to the authors of |SSR| and which requires a few options
 to be set in a different way than in their default way. All in all,
@@ -96,7 +101,7 @@ this corresponds to working in the following context:
 
 .. rocqtop:: in
 
-   From Corelib Require Import ssreflect ssrfun ssrbool.
+   From Corelib Require Import ssreflect_rw.
    Set Implicit Arguments.
    Unset Strict Implicit.
    Unset Printing Implicit Defensive.
@@ -105,77 +110,6 @@ this corresponds to working in the following context:
    :flag:`Implicit Arguments`, :flag:`Strict Implicit`,
    :flag:`Printing Implicit Defensive`
 
-.. _compatibility_issues_ssr:
-
-
-Compatibility issues
-~~~~~~~~~~~~~~~~~~~~
-
-Requiring the above modules creates an environment that is mostly
-compatible with the rest of Rocq, up to a few discrepancies.
-
-
-+ New keywords (``is``) might clash with variable, constant, tactic or
-  tactical names, or with quasi-keywords in tactic or
-  notation commands.
-+ New tactic(al)s names (:tacn:`last`, :tacn:`done`, :tacn:`have`, :tacn:`suffices`,
-  :tacn:`suff`, :tacn:`without loss`, :tacn:`wlog`, :tacn:`congr`, :tacn:`unlock`)
-  might clash with user tactic names.
-+ Identifiers with both leading and trailing ``_``, such as ``_x_``, are
-  reserved by |SSR| and cannot appear in scripts.
-+ The extensions to the :tacn:`rewrite` tactic are partly incompatible with those
-  available in current versions of Rocq; in particular, ``rewrite .. in
-  (type of k)`` or ``rewrite .. in *`` or any other variant of :tacn:`rewrite`
-  will not work, and the |SSR| syntax and semantics for occurrence selection
-  and rule chaining are different. Use an explicit rewrite direction
-  (``rewrite <- …`` or ``rewrite -> …``) to access the Rocq rewrite tactic.
-+ New symbols (``//``, ``/=``, ``//=``) might clash with adjacent
-  existing symbols.
-  This can be avoided by inserting white spaces.
-+ New constant and theorem names might clash with the user theory.
-  This can be avoided by not importing all of |SSR|:
-
-  .. rocqtop:: in
-
-     From Corelib Require ssreflect.
-     Import ssreflect.SsrSyntax.
-
-  Note that the full
-  syntax of |SSR|’s rewrite and reserved identifiers are enabled
-  only if the ssreflect module has been required and if ``SsrSyntax`` has
-  been imported. Thus a file that requires (without importing) ``ssreflect``
-  and imports ``SsrSyntax`` can be required and imported without
-  automatically enabling |SSR|’s extended rewrite syntax and
-  reserved identifiers.
-+ Some user notations (in particular, defining an infix ``;``) might
-  interfere with the "open term", parenthesis-free syntax of tactics
-  such as :tacn:`have`, :tacn:`set (ssreflect)` and :tacn:`pose (ssreflect)`.
-+ The generalization of ``if`` statements to non-Boolean conditions is turned off
-  by |SSR|, because it is mostly subsumed by Coercion to ``bool`` of the
-  ``sumXXX`` types (declared in ``ssrfun.v``) and the
-  :n:`if @term is @pattern then @term else @term` construct
-  (see :ref:`pattern_conditional_ssr`).  To use the
-  generalized form, turn off the |SSR| Boolean ``if`` notation using the command:
-  ``Close Scope boolean_if_scope``.
-+ The following flags can be unset to make |SSR| more compatible with
-  parts of Rocq.
-
-.. flag:: SsrRewrite
-
-   Controls whether the incompatible rewrite syntax is enabled (the default).
-   Disabling the :term:`flag` makes the syntax compatible with other parts of Rocq.
-
-.. flag:: SsrIdents
-
-   Controls whether tactics can refer to |SSR|-generated variables that are
-   in the form _xxx_.  Scripts with explicit references to such variables
-   are fragile; they are prone to failure if the proof is later modified or
-   if the details of variable name generation change in future releases of Rocq.
-
-   The default is on, which gives an error message when the user tries to
-   create such identifiers.  Disabling the :term:`flag` generates a warning instead,
-   increasing compatibility with other parts of Rocq.
-
 Gallina extensions
 --------------------
 
@@ -217,7 +151,7 @@ construct differs from the latter as follows.
 
     .. rocqtop:: reset none
 
-       From Corelib Require Import ssreflect.
+       From Corelib Require Import ssreflect_rw.
        Set Implicit Arguments.
        Unset Strict Implicit.
        Unset Printing Implicit Defensive.
@@ -257,7 +191,8 @@ dependent pattern matching and for aliasing the pattern (see
 Pattern conditional
 ~~~~~~~~~~~~~~~~~~~
 
-The following construct can be used for a refutable pattern matching,
+When doing ``From Corelib Require Import ssreflect`` (not ``ssreflect_rw``),
+the following construct can be used for a refutable pattern matching,
 that is, pattern testing:
 
 .. prodn::
@@ -275,15 +210,16 @@ example, the null and all list function(al)s can be defined as follows:
 
     .. rocqtop:: reset none
 
-       From Corelib Require Import ssreflect.
        Set Implicit Arguments.
        Unset Strict Implicit.
        Unset Printing Implicit Defensive.
-       Section Test.
 
    .. rocqtop:: all
 
-      Variable d: Set.
+      From Corelib Require Import ssreflect.
+
+      Section Test.
+      Variable d : Set.
       Definition null (s : list d) :=
         if s is nil then true else false.
       Variable a : d -> bool.
@@ -311,13 +247,15 @@ The latter appears to be marginally shorter, but it is quite
 ambiguous, and indeed often requires an explicit annotation
 ``(term : {_} + {_})`` to type check, which evens the character count.
 
-Therefore, |SSR| restricts by default the condition of a plain ``if``
+Therefore, ``From Corelib Require Import ssreflect`` restricts by default the condition of a plain ``if``
 construct to the standard ``bool`` type; this avoids spurious type
 annotations.
 
 .. example::
 
-   .. rocqtop:: all
+   .. rocqtop:: reset all
+
+      From Corelib Require Import ssreflect.
 
       Definition orb b1 b2 := if b1 then true else b2.
 
@@ -376,7 +314,7 @@ expressions such as
 
    .. rocqtop:: reset none
 
-      From Corelib Require Import ssreflect.
+      From Corelib Require Import ssreflect_rw.
       Set Implicit Arguments.
       Unset Strict Implicit.
       Unset Printing Implicit Defensive.
@@ -401,7 +339,7 @@ each point of use; e.g., the above definition can be written:
 
   .. rocqtop:: reset none
 
-     From Corelib Require Import ssreflect.
+     From Corelib Require Import ssreflect_rw.
      Set Implicit Arguments.
      Unset Strict Implicit.
      Unset Printing Implicit Defensive.
@@ -446,16 +384,12 @@ Anonymous arguments
 
 When in a definition, the type of a certain argument is mandatory, but
 not its name, one usually uses “arrow” abstractions for prenex
-arguments, or the ``(_ : term)`` syntax for inner arguments. In |SSR|,
-the latter can be replaced by the open syntax ``of term`` or
-(equivalently) ``& term``, which are both syntactically equivalent to a
-``(_ : term)`` expression. This feature almost behaves as the
-following extension of the binder syntax:
-
-.. prodn::
-   binder += {| & @term | of @term }
+arguments, or the ``(_ : term)`` syntax for inner arguments.
+The latter can be replaced by the open syntax ``& term``,
+which is syntactically equivalent to a
+``(_ : term)`` expression.
 
-Caveat: ``& T`` and ``of T`` abbreviations have to appear at the end
+Caveat: ``& T`` abbreviations have to appear at the end
 of a binder list. For instance, the usual two-constructor polymorphic
 type list, i.e., the one of the standard ``List`` library, can be
 defined by the following declaration:
@@ -464,14 +398,13 @@ defined by the following declaration:
 
   .. rocqtop:: reset none
 
-     From Corelib Require Import ssreflect.
      Set Implicit Arguments.
      Unset Strict Implicit.
      Unset Printing Implicit Defensive.
 
   .. rocqtop:: all
 
-     Inductive list (A : Type) : Type := nil | cons of A & list A.
+     Inductive list (A : Type) : Type := nil | cons & A & list A.
 
 
 Wildcards
@@ -518,7 +451,7 @@ For example, the tactic :tacn:`pose (ssreflect)` supports parameters:
 
    .. rocqtop:: reset none
 
-      From Corelib Require Import ssreflect.
+      From Corelib Require Import ssreflect_rw.
       Set Implicit Arguments.
       Unset Strict Implicit.
       Unset Printing Implicit Defensive.
@@ -526,6 +459,7 @@ For example, the tactic :tacn:`pose (ssreflect)` supports parameters:
    .. rocqtop:: all
 
       Lemma test : True.
+      Proof.
       pose f x y := x + y.
 
 The |SSR| :tacn:`pose (ssreflect)` tactic also supports (co)fixpoints, by providing
@@ -633,7 +567,7 @@ where:
 
    .. rocqtop:: reset none
 
-      From Corelib Require Import ssreflect.
+      From Corelib Require Import ssreflect_rw.
       Set Implicit Arguments.
       Unset Strict Implicit.
       Unset Printing Implicit Defensive.
@@ -642,6 +576,7 @@ where:
    .. rocqtop:: all
 
       Lemma test x :  f x + f x = f x.
+      Proof.
       set t := f _.
 
    .. rocqtop:: all restart
@@ -681,7 +616,7 @@ conditions.
 
    .. rocqtop:: reset none
 
-      From Corelib Require Import ssreflect.
+      From Corelib Require Import ssreflect_rw.
       Set Implicit Arguments.
       Unset Strict Implicit.
       Unset Printing Implicit Defensive.
@@ -689,6 +624,7 @@ conditions.
    .. rocqtop:: all
 
       Lemma test (x y z : nat) :  x + y = z.
+      Proof.
       set t := _ x.
 
 + In the special case where :token:`term` is of the form
@@ -702,7 +638,7 @@ conditions.
 
      .. rocqtop:: reset none
 
-        From Corelib Require Import ssreflect.
+        From Corelib Require Import ssreflect_rw.
         Set Implicit Arguments.
         Unset Strict Implicit.
         Unset Printing Implicit Defensive.
@@ -710,6 +646,7 @@ conditions.
      .. rocqtop:: all
 
         Lemma test : (let f x y z := x + y + z in f 1) 2 3 = 6.
+        Proof.
         set t := (let g y z := S y + z in g) 2.
 
   The notation ``unkeyed`` defined in ``ssreflect.v`` is a shorthand for
@@ -723,7 +660,7 @@ Moreover:
 
      .. rocqtop:: reset none
 
-        From Corelib Require Import ssreflect.
+        From Corelib Require Import ssreflect_rw.
         Set Implicit Arguments.
         Unset Strict Implicit.
         Unset Printing Implicit Defensive.
@@ -731,6 +668,7 @@ Moreover:
      .. rocqtop:: all
 
         Lemma test x y z : x + y = z.
+        Proof.
         set t := _ + _.
 
 + The type of the subterm matched should fit the type (possibly casted
@@ -743,7 +681,7 @@ Moreover:
 
      .. rocqtop:: reset none
 
-        From Corelib Require Import ssreflect.
+        From Corelib Require Import ssreflect_rw.
         Set Implicit Arguments.
         Unset Strict Implicit.
         Unset Printing Implicit Defensive.
@@ -751,6 +689,7 @@ Moreover:
      .. rocqtop:: all
 
         Lemma test : forall x : nat, x + 1 = 0.
+        Proof.
         Fail set t := _ + 1.
 
 + Typeclass inference should fill in any residual hole, but matching
@@ -776,7 +715,7 @@ An *occurrence switch* can be:
 
      .. rocqtop:: reset none
 
-        From Corelib Require Import ssreflect.
+        From Corelib Require Import ssreflect_rw.
         Set Implicit Arguments.
         Unset Strict Implicit.
         Unset Printing Implicit Defensive.
@@ -785,6 +724,7 @@ An *occurrence switch* can be:
      .. rocqtop:: all
 
         Lemma test : f 2 + f 8 = f 2 + f 2.
+        Proof.
         set x := {+1 3}(f 2).
 
   Notice that some occurrences of a given term may be
@@ -798,7 +738,7 @@ An *occurrence switch* can be:
 
      .. rocqtop:: reset none
 
-        From Corelib Require Import ssreflect.
+        From Corelib Require Import ssreflect_rw.
         Set Implicit Arguments.
         Unset Strict Implicit.
         Unset Printing Implicit Defensive.
@@ -807,6 +747,7 @@ An *occurrence switch* can be:
 
         Notation "a < b":= (le (S a) b).
         Lemma test x y : x < y -> S x < S y.
+        Proof.
         set t := S x.
 
 + A list of natural numbers ``{n1 … nm}``.
@@ -819,7 +760,7 @@ An *occurrence switch* can be:
 
      .. rocqtop:: reset none
 
-        From Corelib Require Import ssreflect.
+        From Corelib Require Import ssreflect_rw.
         Set Implicit Arguments.
         Unset Strict Implicit.
         Unset Printing Implicit Defensive.
@@ -828,6 +769,7 @@ An *occurrence switch* can be:
      .. rocqtop:: all
 
         Lemma test : f 2 + f 8 = f 2 + f 2.
+        Proof.
         set x := {-2}(f 2).
 
 
@@ -850,7 +792,7 @@ selection.
 
      .. rocqtop:: reset none
 
-        From Corelib Require Import ssreflect.
+        From Corelib Require Import ssreflect_rw.
         Set Implicit Arguments.
         Unset Strict Implicit.
         Unset Printing Implicit Defensive.
@@ -858,6 +800,7 @@ selection.
      .. rocqtop:: all
 
         Lemma test x y z : x + y = x + y + z.
+        Proof.
         set a := {2}(_ + _).
 
 Hence, in the following goal, the same tactic fails since there is
@@ -867,7 +810,7 @@ only one occurrence of the selected term.
 
      .. rocqtop:: reset none
 
-        From Corelib Require Import ssreflect.
+        From Corelib Require Import ssreflect_rw.
         Set Implicit Arguments.
         Unset Strict Implicit.
         Unset Printing Implicit Defensive.
@@ -875,6 +818,7 @@ only one occurrence of the selected term.
      .. rocqtop:: all
 
         Lemma test x y z : (x + y) + (z + z) = z + z.
+        Proof.
         Fail set a := {2}(_ + _).
 
 
@@ -898,11 +842,12 @@ context of a goal thanks to the ``in`` tactical.
 
      .. rocqtop:: reset none
 
-        From Corelib Require Import ssreflect.
+        From Corelib Require Import ssreflect_rw.
 
      .. rocqtop:: all
 
         Lemma test x t (Hx : x = 3) : x + t = 4.
+        Proof.
         set z := 3 in Hx.
 
 .. tacv:: set @ident := @term in {+ @ident} *
@@ -914,11 +859,12 @@ context of a goal thanks to the ``in`` tactical.
 
      .. rocqtop:: reset none
 
-        From Corelib Require Import ssreflect.
+        From Corelib Require Import ssreflect_rw.
 
      .. rocqtop:: all
 
         Lemma test x t (Hx : x = 3) : x + t = 4.
+        Proof.
         set z := 3 in Hx * .
 
      Indeed, remember that 4 is just a notation for (S 3).
@@ -1030,7 +976,7 @@ constants to the goal.
 
    .. rocqtop:: reset none
 
-      From Corelib Require Import ssreflect.
+      From Corelib Require Import ssreflect_rw.
       Set Implicit Arguments.
       Unset Strict Implicit.
       Unset Printing Implicit Defensive.
@@ -1038,6 +984,7 @@ constants to the goal.
    .. rocqtop:: all
 
       Lemma subnK : forall m n, n <= m -> m - n + n = m.
+      Proof.
 
    might start with
 
@@ -1045,10 +992,9 @@ constants to the goal.
 
       move=> m n le_n_m.
 
-   where ``move`` does nothing, but ``=> m n le_m_n`` changes
-   the variables and assumption of the goal in the constants
-   ``m n : nat`` and the fact ``le_n_m : n <= m``, thus exposing the
-   conclusion ``m - n + n = m``.
+   where ``move`` does nothing, but ``=> m n le_m_n`` introduces
+   the variables ``m`` and ``n`` and the hypothesis ``le_n_m : n <= m``
+   from the goal, giving the new goal ``m - n + n = m``.
 
    The ``:`` tactical is the converse of ``=>``; indeed it removes facts and
    constants from the context by turning them into variables and
@@ -1092,7 +1038,7 @@ The ``:`` tactical is used to operate on an element in the context.
 
   .. rocqtop:: reset none
 
-     From Corelib Require Import ssreflect.
+     From Corelib Require Import ssreflect_rw.
      Set Implicit Arguments.
      Unset Strict Implicit.
      Unset Printing Implicit Defensive.
@@ -1100,6 +1046,7 @@ The ``:`` tactical is used to operate on an element in the context.
   .. rocqtop:: all
 
      Lemma subnK : forall m n, n <= m -> m - n + n = m.
+     Proof.
      move=> m n le_n_m.
      elim: n m le_n_m => [|n IHn] m => [_ | lt_n_m].
 
@@ -1187,8 +1134,9 @@ The move tactic.
 
       .. rocqtop:: reset all
 
-         Require Import ssreflect.
+         From Corelib Require Import ssreflect_rw.
          Goal not False.
+         Proof.
          move.
 
    More precisely, the :tacn:`move ` tactic inspects the goal and does nothing
@@ -1257,7 +1205,7 @@ The elim tactic
 
       .. rocqtop:: reset none
 
-         From Corelib Require Import ssreflect.
+         From Corelib Require Import ssreflect_rw.
          Set Implicit Arguments.
          Unset Strict Implicit.
          Unset Printing Implicit Defensive.
@@ -1265,6 +1213,7 @@ The elim tactic
       .. rocqtop:: all
 
          Lemma test m : forall n : nat, m <= n.
+         Proof.
          elim.
 
 
@@ -1297,7 +1246,7 @@ existential metavariables of sort :g:`Prop`.
 
    .. rocqtop:: reset none
 
-      From Corelib Require Import ssreflect.
+      From Corelib Require Import ssreflect_rw.
       Set Implicit Arguments.
       Unset Strict Implicit.
       Unset Printing Implicit Defensive.
@@ -1306,6 +1255,7 @@ existential metavariables of sort :g:`Prop`.
    .. rocqtop:: all
 
       Lemma test : forall y, 1 < y -> y < 2 -> exists x : { n | n < 3 }, 0 < proj1_sig x.
+      Proof.
       move=> y y_gt1 y_lt2; apply: (ex_intro _ (exist _ y _)).
         by apply: lt_trans y_lt2 _.
       by move=> y_lt3; apply: lt_trans y_gt1.
@@ -1444,7 +1394,7 @@ If the tactic is ``move`` or ``case`` and an equation :token:`ident` is given, t
 (step 3) for :token:`d_item` is suppressed (see Section :ref:`generation_of_equations_ssr`).
 
 Intro patterns (see Section :ref:`introduction_ssr`)
-and the ``rewrite`` tactic (see Section :ref:`rewriting_ssr`)
+and the ``rw`` tactic (see Section :ref:`rewriting_ssr`)
 let one place a :token:`clear_switch` in the middle of other items
 (namely identifiers, views and rewrite rules).  This can trigger the
 addition of proof context items to the ones being explicitly
@@ -1477,7 +1427,7 @@ context to interpret wildcards; in particular, it can accommodate the
 
    .. rocqtop:: reset none
 
-      From Corelib Require Import ssreflect.
+      From Corelib Require Import ssreflect_rw.
       Set Implicit Arguments.
       Unset Strict Implicit.
       Unset Printing Implicit Defensive.
@@ -1487,6 +1437,7 @@ context to interpret wildcards; in particular, it can accommodate the
    .. rocqtop:: all
 
       Lemma test (Hfg : forall x, f x = g x) a b : f a = g b.
+      Proof.
       apply: trans_equal (Hfg _) _.
 
 This tactic is equivalent (see Section
@@ -1715,7 +1666,7 @@ Intro patterns
   (resp. :token:`occ_switch` ``<-``)
   pops the top assumption (which should be a rewritable proposition) into an
   anonymous fact, rewrites (resp. rewrites right to left) the goal with this
-  fact (using the |SSR| ``rewrite`` tactic described in Section
+  fact (using the |SSR| ``rw`` tactic described in Section
   :ref:`rewriting_ssr`, and honoring the optional occurrence selector), and
   finally deletes the anonymous fact from the context.
 ``[`` :token:`i_item` * ``| … |`` :token:`i_item` * ``]``
@@ -1769,14 +1720,17 @@ Clears are deferred until the end of the intro pattern.
 
    .. rocqtop:: reset none
 
-      From Corelib Require Import ssreflect ssrbool.
+      From Corelib Require Import ssreflect_rw.
       Set Implicit Arguments.
       Unset Strict Implicit.
       Unset Printing Implicit Defensive.
 
    .. rocqtop:: all
 
+      From Corelib Require Import ssrbool.
+
       Lemma test x y : Nat.leb 0 x = true -> (Nat.leb 0 x) && (Nat.leb y 2) = true.
+      Proof.
       move=> {x} ->.
 
 If the cleared names are reused in the same intro pattern, a renaming
@@ -1830,7 +1784,7 @@ Block introduction
 
      .. rocqtop:: reset none
 
-        From Corelib Require Import ssreflect.
+        From Corelib Require Import ssreflect_rw.
         Set Implicit Arguments.
         Unset Strict Implicit.
         Unset Printing Implicit Defensive.
@@ -1883,7 +1837,7 @@ deal with the possible parameters of the constants introduced.
 
    .. rocqtop:: reset none
 
-      From Corelib Require Import ssreflect.
+      From Corelib Require Import ssreflect_rw.
       Set Implicit Arguments.
       Unset Strict Implicit.
       Unset Printing Implicit Defensive.
@@ -1891,6 +1845,7 @@ deal with the possible parameters of the constants introduced.
    .. rocqtop:: all
 
       Lemma test (a b :nat) : a <> b.
+      Proof.
       case E : a => [|n].
 
 If the user does not provide a branching :token:`i_item` as first
@@ -1902,7 +1857,7 @@ under fresh |SSR| names.
 
    .. rocqtop:: reset none
 
-      From Corelib Require Import ssreflect.
+      From Corelib Require Import ssreflect_rw.
       Set Implicit Arguments.
       Unset Strict Implicit.
       Unset Printing Implicit Defensive.
@@ -1910,6 +1865,7 @@ under fresh |SSR| names.
    .. rocqtop:: all
 
       Lemma test (a b :nat) : a <> b.
+      Proof.
       case E : a => H.
       Show 2.
 
@@ -1969,7 +1925,7 @@ be substituted.
 
       .. rocqtop:: reset none
 
-         From Corelib Require Import ssreflect.
+         From Corelib Require Import ssreflect_rw.
          Set Implicit Arguments.
          Unset Strict Implicit.
          Unset Printing Implicit Defensive.
@@ -1995,6 +1951,7 @@ be substituted.
          | LastAdd s x : last_spec (add_last x s).
 
          Theorem lastP : forall l : list A, last_spec l.
+         Proof.
          Admitted.
 
       We are now ready to use ``lastP`` in conjunction with ``case``.
@@ -2002,6 +1959,7 @@ be substituted.
       .. rocqtop:: all
 
          Lemma test l : (length l) * 2 = length (l ++ l).
+         Proof.
          case: (lastP l).
 
       Applied to the same goal, the tactic ``case: l / (lastP l)``
@@ -2031,6 +1989,7 @@ be substituted.
       .. rocqtop:: all
 
          Lemma test l : (length l) * 2 = length (l ++ l).
+         Proof.
          case E: {1 3}l / (lastP l) => [|s x].
          Show 2.
 
@@ -2075,20 +2034,20 @@ of the time more than two levels of indentation.
 Here is a fragment of such a structured script::
 
     case E1: (abezoutn _ _) => [[| k1] [| k2]].
-    - rewrite !muln0 !gexpn0 mulg1 => H1.
-      move/eqP: (sym_equal F0); rewrite -H1 orderg1 eqn_mul1.
+    - rw !muln0 !gexpn0 mulg1 => H1.
+      move/eqP: (sym_equal F0); rw -H1 orderg1 eqn_mul1.
       by case/andP; move/eqP.
-    - rewrite muln0 gexpn0 mulg1 => H1.
+    - rw muln0 gexpn0 mulg1 => H1.
       have F1: t %| t * S k2.+1 - 1.
-        apply: (@dvdn_trans (orderg x)); first by rewrite F0; exact: dvdn_mull.
-        rewrite orderg_dvd; apply/eqP; apply: (mulgI x).
-        rewrite -{1}(gexpn1 x) mulg1 gexpn_add leq_add_sub //.
+        apply: (@dvdn_trans (orderg x)); first by rw F0; exact: dvdn_mull.
+        rw orderg_dvd; apply/eqP; apply: (mulgI x).
+        rw -{1}(gexpn1 x) mulg1 gexpn_add leq_add_sub //.
         by move: P1; case t.
-      rewrite dvdn_subr in F1; last by exact: dvdn_mulr.
-      + rewrite H1 F0 -{2}(muln1 (p ^ l)); congr (_ * _).
-        by apply/eqP; rewrite -dvdn1.
+      rw dvdn_subr in F1; last by exact: dvdn_mulr.
+      + rw H1 F0 -{2}(muln1 (p ^ l)); congr (_ * _).
+        by apply/eqP; rw -dvdn1.
       + by move: P1; case: (t) => [| [| s1]].
-    - rewrite muln0 gexpn0 mul1g => H1.
+    - rw muln0 gexpn0 mul1g => H1.
     ...
 
 
@@ -2123,7 +2082,7 @@ with a ``by``, like in:
 
 .. rocqdoc::
 
-   by apply/eqP; rewrite -dvdn1.
+   by apply/eqP; rw -dvdn1.
 
 .. tacn:: done
    :name: done
@@ -2142,7 +2101,7 @@ with a ``by``, like in:
 
       Ltac done :=
         trivial; hnf; intros; solve
-         [ do ![solve [trivial | apply: sym_equal; trivial]
+         [ do ![solve [trivial | simple refine (@sym_equal _ _ _ _); trivial]
                | discriminate | contradiction | split]
          | match goal with H : ~ _ |- _ => solve [case H; trivial] end ].
 
@@ -2188,19 +2147,19 @@ is equivalent to:
 
    .. rocqdoc::
 
-      by rewrite my_lemma1.
+      by rw my_lemma1.
 
    succeeds, then the tactic:
 
    .. rocqdoc::
 
-      by rewrite my_lemma1; apply my_lemma2.
+      by rw my_lemma1; apply my_lemma2.
 
    usually fails since it is equivalent to:
 
    .. rocqdoc::
 
-      by (rewrite my_lemma1; apply my_lemma2).
+      by (rw my_lemma1; apply my_lemma2).
 
 
 .. _selectors_ssr:
@@ -2270,7 +2229,7 @@ to the others.
 
    .. rocqtop:: reset none
 
-      From Corelib Require Import ssreflect.
+      From Corelib Require Import ssreflect_rw.
       Set Implicit Arguments.
       Unset Strict Implicit.
       Unset Printing Implicit Defensive.
@@ -2284,6 +2243,7 @@ to the others.
       | C4 n of n = 4 : test n.
 
       Lemma example n (t : test n) : True.
+      Proof.
       case: t; last 2 [move=> k| move=> l]; idtac.
 
 
@@ -2336,14 +2296,14 @@ For instance, the tactic:
 
 .. rocqdoc::
 
-   tactic; do 1? rewrite mult_comm.
+   tactic; do 1? rw mult_comm.
 
 rewrites at most one time the lemma ``mult_comm`` in all the subgoals
 generated by tactic, whereas the tactic:
 
 .. rocqdoc::
 
-   tactic; do 2! rewrite mult_comm.
+   tactic; do 2! rw mult_comm.
 
 rewrites exactly two times the lemma ``mult_comm`` in all the subgoals
 generated by ``tactic``, and fails if this rewrite is not possible in some
@@ -2368,7 +2328,7 @@ already presented the *localization* tactical ``in``, whose general syntax is:
 
 where :token:`ident` is a name in the
 context. On the left side of ``in``,
-:token:`tactic` can be ``move``, ``case``, ``elim``, ``rewrite``, ``set``,
+:token:`tactic` can be ``move``, ``case``, ``elim``, ``rw``, ``set``,
 or any tactic formed with the general iteration tactical ``do`` (see Section
 :ref:`iteration_ssr`).
 
@@ -2389,16 +2349,17 @@ between standard Ltac ``in`` and the |SSR| tactical in.
 
   .. rocqtop:: reset none
 
-     From Corelib Require Import ssreflect.
+     From Corelib Require Import ssreflect_rw.
      Set Implicit Arguments.
      Unset Strict Implicit.
      Unset Printing Implicit Defensive.
 
   .. rocqtop:: all
 
-     Ltac mytac H := rewrite H.
+     Ltac mytac H := rw H.
 
      Lemma test x y (H1 : x = y) (H2 : y = 3) : x + y = 6.
+     Proof.
      do [mytac H2] in H1 *.
 
   the last tactic rewrites the hypothesis ``H2 : y = 3`` both in
@@ -2407,7 +2368,7 @@ between standard Ltac ``in`` and the |SSR| tactical in.
 By default, ``in`` keeps the body of local definitions. To erase the body
 of a local definition during the generalization phase, the name of the
 local definition must be written between parentheses, like in
-``rewrite H in H1 (def_n) H2.``
+``rw H in H1 (def_n) H2.``
 
 .. tacv:: @tactic in {+ {| @clear_switch | {? @}@ident | ( @ident ) | ( {? @}@ident := @c_pattern ) } } {? * }
 
@@ -2464,7 +2425,7 @@ the holes are abstracted in term.
 
   .. rocqtop:: reset none
 
-     From Corelib Require Import ssreflect.
+     From Corelib Require Import ssreflect_rw.
      Set Implicit Arguments.
      Unset Strict Implicit.
      Unset Printing Implicit Defensive.
@@ -2472,17 +2433,19 @@ the holes are abstracted in term.
   .. rocqtop:: all
 
      Lemma test : True.
+     Proof.
      have: _ * 0 = 0.
 
   The invocation of ``have`` is equivalent to:
 
   .. rocqtop:: reset none
 
-     From Corelib Require Import ssreflect.
+     From Corelib Require Import ssreflect_rw.
      Set Implicit Arguments.
      Unset Strict Implicit.
      Unset Printing Implicit Defensive.
      Lemma test : True.
+     Proof.
 
   .. rocqtop:: all
 
@@ -2496,11 +2459,12 @@ tactic:
 
   .. rocqtop:: reset none
 
-     From Corelib Require Import ssreflect.
+     From Corelib Require Import ssreflect_rw.
      Set Implicit Arguments.
      Unset Strict Implicit.
      Unset Printing Implicit Defensive.
      Lemma test : True.
+     Proof.
 
   .. rocqtop:: all
 
@@ -2540,7 +2504,7 @@ statement is very short, basically when it fits in one line like in:
 
 .. rocqdoc::
 
-   have H23 : 3 + 2 = 2 + 3 by rewrite addnC.
+   have H23 : 3 + 2 = 2 + 3 by rw addnC.
 
 The possibility of using :token:`i_item` supplies a very concise syntax for
 the further use of the intermediate step. For instance,
@@ -2549,7 +2513,7 @@ the further use of the intermediate step. For instance,
 
   .. rocqtop:: reset none
 
-     From Corelib Require Import ssreflect.
+     From Corelib Require Import ssreflect_rw.
      Set Implicit Arguments.
      Unset Strict Implicit.
      Unset Printing Implicit Defensive.
@@ -2557,6 +2521,7 @@ the further use of the intermediate step. For instance,
   .. rocqtop:: all
 
      Lemma test a : 3 * a - 1 = a.
+     Proof.
      have -> : forall x, x * a = a.
 
   Note how the second goal was rewritten using the stated equality.
@@ -2577,7 +2542,7 @@ destruction of existential assumptions like in the tactic:
 
   .. rocqtop:: reset none
 
-     From Corelib Require Import ssreflect.
+     From Corelib Require Import ssreflect_rw.
      Set Implicit Arguments.
      Unset Strict Implicit.
      Unset Printing Implicit Defensive.
@@ -2585,6 +2550,7 @@ destruction of existential assumptions like in the tactic:
   .. rocqtop:: all
 
      Lemma test : True.
+     Proof.
      have [x Px]: exists x : nat, x > 0; last first.
 
 An alternative use of the ``have`` tactic is to provide the explicit proof
@@ -2604,7 +2570,7 @@ term for the intermediate lemma, using tactics of the form:
 
   .. rocqtop:: reset none
 
-     From Corelib Require Import ssreflect.
+     From Corelib Require Import ssreflect_rw.
      Set Implicit Arguments.
      Unset Strict Implicit.
      Unset Printing Implicit Defensive.
@@ -2612,6 +2578,7 @@ term for the intermediate lemma, using tactics of the form:
   .. rocqtop:: all
 
      Lemma test : True.
+     Proof.
      have H := forall x, (x, x) = (x, x).
 
   adds to the context ``H : Type -> Prop.`` This is a schematic example, but
@@ -2624,17 +2591,22 @@ The following example requires the mathcomp and mczify libraries.
 
 .. example::
 
-  .. rocqtop:: reset none warn extra-mathcomp extra-mczify
-
-     From mathcomp Require Import ssreflect ssrfun ssrbool ssrnat zify.
+  .. rocqtop:: reset none
 
      Set Implicit Arguments.
      Unset Strict Implicit.
      Unset Printing Implicit Defensive.
+     Set Warnings "-notation-overridden".
+
+  .. rocqtop:: in extra-mathcomp extra-mczify
+
+     From Corelib Require Import ssreflect_rw.
+     From mathcomp Require Import ssrfun ssrbool ssrnat zify.
 
   .. rocqtop:: all extra-mathcomp extra-mczify
 
      Lemma test : True.
+     Proof.
      have H x (y : nat) : 2 * x + y = x + x + y by lia.
 
 A proof term provided after ``:=`` can mention these bound variables
@@ -2688,6 +2660,7 @@ context entry name.
      Arguments Sub {_} _ _.
 
      Lemma test n m (H : m + 1 < n) : True.
+     Proof.
      have @i : 'I_n by apply: (Sub m); lia.
 
 Note that the subterm produced by :tacn:`lia` is in general huge and
@@ -2700,6 +2673,7 @@ For this purpose the ``[: name]`` intro pattern and the tactic
   .. rocqtop:: all abort extra-mathcomp
 
      Lemma test n m (H : m + 1 < n) : True.
+     Proof.
      have [:pm] @i : 'I_n by apply: (Sub m); abstract: pm; lia.
 
   The type of ``pm`` can be cleaned up by its annotation ``(*1*)`` by just
@@ -2713,6 +2687,7 @@ with`` have`` and an explicit term, they must be used as follows:
   .. rocqtop:: all abort extra-mathcomp
 
      Lemma test n m (H : m + 1 < n) : True.
+     Proof.
      have [:pm] @i : 'I_n := Sub m pm.
        by lia.
 
@@ -2732,6 +2707,7 @@ makes use of it).
   .. rocqtop:: all abort extra-mathcomp
 
      Lemma test n m (H : m + 1 < n) : True.
+     Proof.
      have [:pm] @i k : 'I_(n+k) by apply: (Sub m); abstract: pm k; lia.
 
 Last, notice that the use of intro patterns for abstract constants is
@@ -2746,12 +2722,13 @@ typeclass inference.
 
   .. rocqtop:: reset none
 
-     From Corelib Require Import ssreflect.
+     From Corelib Require Import ssreflect_rw.
 
      Axiom ty : Type.
      Axiom t : ty.
 
      Goal True.
+     Proof.
 
   .. rocqtop:: all
 
@@ -2831,6 +2808,7 @@ The ``have`` modifier can follow the ``suff`` tactic.
   .. rocqtop:: all abort
 
      Lemma test : G.
+     Proof.
      suff have H : P.
 
   Note that, in contrast with ``have suff``, the name H has been introduced
@@ -2891,18 +2869,22 @@ simplifies a proof. Here is an example showing the beginning of the
 proof that quotient and reminder of natural number euclidean division
 are unique.
 
-The following example requires the mathcomp and mczify libraries.
+The following example requires the mathcomp library.
 
 .. example::
 
-  .. rocqtop:: reset none warn extra-mathcomp
+  .. rocqtop:: reset none
 
-     From mathcomp Require Import ssreflect ssrfun ssrbool ssrnat.
+     Set Warnings "-notation-overridden".
 
   .. rocqtop:: all extra-mathcomp
 
+     From Corelib Require Import ssreflect_rw.
+     From mathcomp Require Import ssrfun ssrbool ssrnat.
+
      Lemma quo_rem_unicity d q1 q2 r1 r2 :
        q1*d + r1 = q2*d + r2 -> r1 < d -> r2 < d -> (q1, r1) = (q2, r2).
+     Proof.
      wlog: q1 q2 r1 r2 / q1 <= q2.
        by case: (leqP q1 q2); last symmetry; eauto.
 
@@ -2922,7 +2904,7 @@ pattern will be used to process its instance.
 
   .. rocqtop:: reset none
 
-     From Corelib Require Import ssreflect ssrfun ssrbool.
+     From Corelib Require Import ssreflect_rw ssrfun ssrbool.
      Set Implicit Arguments.
      Unset Strict Implicit.
      Unset Printing Implicit Defensive.
@@ -2937,6 +2919,7 @@ pattern will be used to process its instance.
   .. rocqtop:: all
 
      Lemma simple n (ngt0 : 0 < n ) : P n.
+     Proof.
      gen have ltnV, /andP[nge0 neq0] : n ngt0 / (0 <= n) && (n != 0); last first.
 
 
@@ -2972,7 +2955,7 @@ illustrated in the following example.
 
   .. rocqtop:: reset none
 
-     From Corelib Require Import ssreflect.
+     From Corelib Require Import ssreflect_rw.
      Set Implicit Arguments.
      Unset Strict Implicit.
      Unset Printing Implicit Defensive.
@@ -2983,6 +2966,7 @@ illustrated in the following example.
      Variable x : nat.
      Definition addx z := z + x.
      Lemma test : x <= addx x.
+     Proof.
      wlog H : (y := x) (@twoy := addx x) / twoy = 2 * y.
 
   To avoid unfolding the term captured by the pattern ``add x``, one can use
@@ -2991,7 +2975,7 @@ illustrated in the following example.
 
   .. rocqtop:: reset none
 
-     From Corelib Require Import ssreflect.
+     From Corelib Require Import ssreflect_rw.
      Set Implicit Arguments.
      Unset Strict Implicit.
      Unset Printing Implicit Defensive.
@@ -3000,6 +2984,7 @@ illustrated in the following example.
      Variable x : nat.
      Definition addx z := z + x.
      Lemma test : x <= addx x.
+     Proof.
 
   .. rocqtop:: all
 
@@ -3016,7 +3001,7 @@ intermediate results handled are properties of effectively computable
 functions. The most efficient means of establishing such results are
 computation and simplification of expressions involving such
 functions, i.e., rewriting. |SSR| therefore includes an
-extended ``rewrite`` tactic that unifies and combines most of the
+extended ``rw`` tactic that unifies and combines most of the
 rewriting functionalities.
 
 
@@ -3035,8 +3020,7 @@ The main features of the rewrite tactic are:
 
 The general form of an |SSR| rewrite tactic is:
 
-.. tacn:: rewrite {+ @rstep }
-   :name: rewrite (ssreflect)
+.. tacn:: rw {+ @rstep }
    :undocumented:
 
 The combination of a rewrite tactic with the ``in`` tactical (see Section
@@ -3086,7 +3070,7 @@ operation should be performed.
   :token:`r_item` is actually processed and is complemented with the name of
   the rewrite rule if and only if it is a simple proof context entry [#10]_.
   As a consequence, one can
-  write ``rewrite {}H`` to rewrite with ``H`` and dispose ``H`` immediately
+  write ``rw {}H`` to rewrite with ``H`` and dispose ``H`` immediately
   afterwards.
   This behavior can be avoided by putting parentheses around the rewrite rule.
 
@@ -3098,16 +3082,16 @@ A :token:`r_item` can be one of the following.
   :ref:`introduction_ssr`). Simplification operations are intertwined with the possible
   other rewrite operations specified by the list of :token:`r_item`.
 + A *folding/unfolding* :token:`r_item`. The tactic
-  ``rewrite /term`` unfolds the
+  ``rw /term`` unfolds the
   :term:`head constant` of ``term`` in every occurrence of the first matching of
   ``term`` in the goal. In particular, if ``my_def`` is a (local or global)
-  defined constant, the tactic ``rewrite /my_def.`` is analogous to:
+  defined constant, the tactic ``rw /my_def.`` is analogous to:
   ``unfold my_def``.
-  Conversely, ``rewrite -/my_def.`` is equivalent to ``fold my_def``.
+  Conversely, ``rw -/my_def.`` is equivalent to ``fold my_def``.
   When an unfold :token:`r_item` is combined with a
   redex pattern, a conversion
   operation is performed. A tactic of the form
-  ``rewrite -[term1]/term2.``
+  ``rw -[term1]/term2.``
   is equivalent to ``change term1 with term2.`` If ``term2`` is a
   single constant and ``term1`` head symbol is not ``term2``, then the head
   symbol of ``term1`` is repeatedly unfolded until ``term2`` appears.
@@ -3117,15 +3101,15 @@ A :token:`r_item` can be one of the following.
       ``eq`` is the Leibniz equality or a registered setoid
       equality;
     + a list of terms ``(t1 ,…,tn)``, each ``ti`` having a type as above, and
-      the tactic ``rewrite r_prefix (t1 ,…,tn ).``
-      is equivalent to ``do [rewrite r_prefix t1 | … | rewrite r_prefix tn ].``;
+      the tactic ``rw r_prefix (t1 ,…,tn ).``
+      is equivalent to ``do [rw r_prefix t1 | … | rw r_prefix tn ].``;
     + an anonymous rewrite lemma ``(_ : term)``, where ``term`` has a type as above.
 
   .. example::
 
      .. rocqtop:: reset none
 
-        From Corelib Require Import ssreflect.
+        From Corelib Require Import ssreflect_rw.
         Set Implicit Arguments.
         Unset Strict Implicit.
         Unset Printing Implicit Defensive.
@@ -3135,7 +3119,8 @@ A :token:`r_item` can be one of the following.
         Definition double x := x + x.
         Definition ddouble x := double (double x).
         Lemma test x : ddouble x = 4 * x.
-        rewrite [ddouble _]/double.
+        Proof.
+        rw [ddouble _]/double.
 
   .. warning::
 
@@ -3146,16 +3131,17 @@ A :token:`r_item` can be one of the following.
 
         Definition f := fun x y => x + y.
         Lemma test x y : x + y = f y x.
+        Proof.
 
      .. rocqtop:: all fail
 
-        rewrite -[f y]/(y + _).
+        rw -[f y]/(y + _).
 
      but the following script succeeds
 
      .. rocqtop:: all
 
-        rewrite -[f y x]/(y + _).
+        rw -[f y x]/(y + _).
 
 
 .. flag:: SsrOldRewriteGoalsOrder
@@ -3186,7 +3172,7 @@ In a rewrite tactic of the form:
 
 .. rocqdoc::
 
-   rewrite occ_switch [term1]term2.
+   rw occ_switch [term1]term2.
 
 ``term1`` is the explicit rewrite redex and ``term2`` is the rewrite rule.
 This execution of this tactic unfolds as follows.
@@ -3229,7 +3215,7 @@ tactic:
 
 .. rocqdoc::
 
-   rewrite /my_def {2}[f _]/= my_eq //=.
+   rw /my_def {2}[f _]/= my_eq //=.
 
 
 unfolds ``my_def`` in the goal, simplifies the second occurrence of the
@@ -3244,7 +3230,7 @@ proof of basic results on natural numbers arithmetic.
 
   .. rocqtop:: reset none
 
-     From Corelib Require Import ssreflect.
+     From Corelib Require Import ssreflect_rw.
      Set Implicit Arguments.
      Unset Strict Implicit.
      Unset Printing Implicit Defensive.
@@ -3256,11 +3242,13 @@ proof of basic results on natural numbers arithmetic.
      Axiom addSnnS : forall m n, S m + n = m + S n.
 
      Lemma addnCA m n p : m + (n + p) = n + (m + p).
-     by elim: m p => [ | m Hrec] p; rewrite ?addSnnS -?addnS.
+     Proof.
+     by elim: m p => [ | m Hrec] p; rw ?addSnnS -?addnS.
      Qed.
 
      Lemma addnC n m : m + n = n + m.
-     by rewrite -{1}[n]addn0 addnCA addn0.
+     Proof.
+     by rw -{1}[n]addn0 addnCA addn0.
      Qed.
 
 Note the use of the ``?`` switch for parallel rewrite operations in the
@@ -3280,7 +3268,7 @@ side of the equality the user wants to rewrite.
 
   .. rocqtop:: reset none
 
-     From Corelib Require Import ssreflect.
+     From Corelib Require Import ssreflect_rw.
      Set Implicit Arguments.
      Unset Strict Implicit.
      Unset Printing Implicit Defensive.
@@ -3288,7 +3276,8 @@ side of the equality the user wants to rewrite.
   .. rocqtop:: all
 
      Lemma test (H : forall t u, t + u = u + t) x y : x + y = y + x.
-     rewrite [y + _]H.
+     Proof.
+     rw [y + _]H.
 
 Note that if this first pattern matching is not compatible with the
 :token:`r_item`, the rewrite fails, even if the goal contains a
@@ -3300,7 +3289,7 @@ the equality.
 
   .. rocqtop:: reset none
 
-     From Corelib Require Import ssreflect.
+     From Corelib Require Import ssreflect_rw.
      Set Implicit Arguments.
      Unset Strict Implicit.
      Unset Printing Implicit Defensive.
@@ -3308,7 +3297,8 @@ the equality.
   .. rocqtop:: all
 
      Lemma test (H : forall t u, t + u * 0 = t) x y : x + y * 4 + 2 * 0 = x + 2 * 0.
-     Fail rewrite [x + _]H.
+     Proof.
+     Fail rw [x + _]H.
 
   Indeed, the left-hand side of ``H`` does not match
   the redex identified by the pattern ``x + y * 4``.
@@ -3323,7 +3313,7 @@ Occurrence switches and redex switches
 
   .. rocqtop:: reset none
 
-     From Corelib Require Import ssreflect.
+     From Corelib Require Import ssreflect_rw.
      Set Implicit Arguments.
      Unset Strict Implicit.
      Unset Printing Implicit Defensive.
@@ -3331,7 +3321,8 @@ Occurrence switches and redex switches
   .. rocqtop:: all
 
      Lemma test x y : x + y + 0 = x + y + y + 0 + 0 + (x + y + 0).
-     rewrite {2}[_ + y + 0](_: forall z, z + 0 = z).
+     Proof.
+     rw {2}[_ + y + 0](_: forall z, z + 0 = z).
 
 The second subgoal is generated by the use of an anonymous lemma in
 the rewrite tactic. The effect of the tactic on the initial goal is to
@@ -3352,7 +3343,7 @@ repetition.
 
   .. rocqtop:: reset none
 
-     From Corelib Require Import ssreflect.
+     From Corelib Require Import ssreflect_rw.
      Set Implicit Arguments.
      Unset Strict Implicit.
      Unset Printing Implicit Defensive.
@@ -3360,7 +3351,8 @@ repetition.
   .. rocqtop:: all
 
      Lemma test x y (z : nat) : x + 1 = x + y + 1.
-     rewrite 2!(_ : _ + 1 = z).
+     Proof.
+     rw 2!(_ : _ + 1 = z).
 
 This last tactic generates *three* subgoals because
 the second rewrite operation specified with the ``2!`` multiplier
@@ -3382,7 +3374,7 @@ rewrite operations prescribed by the rules on the current goal.
 
   .. rocqtop:: reset none
 
-     From Corelib Require Import ssreflect.
+     From Corelib Require Import ssreflect_rw.
      Set Implicit Arguments.
      Unset Strict Implicit.
      Unset Printing Implicit Defensive.
@@ -3396,7 +3388,8 @@ rewrite operations prescribed by the rules on the current goal.
      Hypothesis eqac : a = c.
 
      Lemma test : a = a.
-     rewrite (eqab, eqac).
+     Proof.
+     rw (eqab, eqac).
 
   Indeed, rule ``eqab`` is the first to apply among the ones
   gathered in the tuple passed to the rewrite tactic. This multirule
@@ -3407,8 +3400,8 @@ rewrite operations prescribed by the rules on the current goal.
 
      Definition multi1 := (eqab, eqac).
 
-  In this case, the tactic ``rewrite multi1`` is a synonym for
-  ``rewrite (eqab, eqac)``.
+  In this case, the tactic ``rw multi1`` is a synonym for
+  ``rw (eqab, eqac)``.
 
 More precisely, a multirule rewrites the first subterm to which one of
 the rules applies in a left-to-right traversal of the goal, with the
@@ -3426,7 +3419,8 @@ literal matches have priority.
       Definition multi2 := (eqab, eqd0).
 
       Lemma test : d = b.
-      rewrite multi2.
+      Proof.
+      rw multi2.
 
    Indeed, rule ``eqd0`` applies without unfolding the
    definition of ``d``.
@@ -3444,7 +3438,8 @@ repeated anew.
      Definition multi3 := (eq_adda_b, eq_adda_c, eqb0).
 
      Lemma test : 1 + a = 12 + a.
-     rewrite 2!multi3.
+     Proof.
+     rw 2!multi3.
 
   It uses ``eq_adda_b`` then ``eqb0`` on the left-hand
   side only. Without the bound ``2``, one would obtain ``0 = 0``.
@@ -3455,7 +3450,7 @@ to (universally) quantify over the parameters of a subset of rules (as
 there is special code that will omit unnecessary quantifiers for rules
 that can be syntactically extracted). It is also possible to reverse
 the direction of a rule subset, using a special dedicated syntax: the
-tactic rewrite ``(=^~ multi1)`` is equivalent to ``rewrite multi1_rev``.
+tactic rewrite ``(=^~ multi1)`` is equivalent to ``rw multi1_rev``.
 
 .. example::
 
@@ -3498,7 +3493,7 @@ the efficient operations, we gather all these rules in the definition
 
    Definition trecE := (addE, (doubleE, oddE), (mulE, add_mulE, (expE, mul_expE))).
 
-The tactic ``rewrite !trecE.``
+The tactic ``rw !trecE.``
 restores the naive version of each operation in a goal involving the
 efficient ones, e.g., for the purpose of a correctness proof.
 
@@ -3507,16 +3502,16 @@ Wildcards vs abstractions
 `````````````````````````
 
 The rewrite tactic supports :token:`r_item`\s containing holes. For example, in
-the tactic ``rewrite (_ : _ * 0 = 0).``,
+the tactic ``rw (_ : _ * 0 = 0).``,
 the term ``_ * 0 = 0`` is interpreted as ``forall n : nat, n * 0 = 0.``
 Anyway this tactic is *not* equivalent to
-``rewrite (_ : forall x, x * 0 = 0).``.
+``rw (_ : forall x, x * 0 = 0).``.
 
 .. example::
 
   .. rocqtop:: reset none
 
-     From Corelib Require Import ssreflect.
+     From Corelib Require Import ssreflect_rw.
      Set Implicit Arguments.
      Unset Strict Implicit.
      Unset Printing Implicit Defensive.
@@ -3526,13 +3521,14 @@ Anyway this tactic is *not* equivalent to
   .. rocqtop:: all
 
      Lemma test y z : y * 0 + y * (z * 0) = 0.
-     rewrite (_ : _ * 0 = 0).
+     Proof.
+     rw (_ : _ * 0 = 0).
 
   while the other tactic results in
 
   .. rocqtop:: all restart abort
 
-     rewrite (_ : forall x, x * 0 = 0).
+     rw (_ : forall x, x * 0 = 0).
 
   The first tactic requires you to prove the instance of the (missing)
   lemma that was used, while the latter requires you prove the quantified
@@ -3566,7 +3562,7 @@ cases.
 
     .. rocqtop:: reset none
 
-       From Corelib Require Import ssreflect.
+       From Corelib Require Import ssreflect_rw.
        Set Implicit Arguments.
        Unset Strict Implicit.
        Unset Printing Implicit Defensive.
@@ -3580,8 +3576,9 @@ cases.
        Axiom H : forall x, g x = 0.
 
        Lemma test : f 3 + f 3 = f 6.
+       Proof.
        (* we call the standard rewrite tactic here *)
-       rewrite -> H.
+       rewrite H.
 
     This rewriting is not possible in |SSR|, because
     there is no occurrence of the head symbol ``f`` of the rewrite rule in the
@@ -3589,23 +3586,23 @@ cases.
 
     .. rocqtop:: all restart fail
 
-       rewrite H.
+       rw H.
 
     Rewriting with ``H`` first requires unfolding the occurrences of
     ``f``
     where the substitution is to be performed (here there is a single such
-    occurrence), using tactic ``rewrite /f`` (for a global replacement of
-    ``f`` by ``g``) or ``rewrite pattern/f``, for a finer selection.
+    occurrence), using tactic ``rw /f`` (for a global replacement of
+    ``f`` by ``g``) or ``rw pattern/f``, for a finer selection.
 
     .. rocqtop:: all restart
 
-       rewrite /f H.
+       rw /f H.
 
     Alternatively, one can override the pattern inferred from ``H``
 
     .. rocqtop:: all restart
 
-       rewrite [f _]H.
+       rw [f _]H.
 
 
 Existential metavariables and rewriting
@@ -3624,7 +3621,6 @@ corresponding new goals will be generated.
 
   .. rocqtop:: reset none
 
-     From Corelib Require Import ssreflect ssrfun ssrbool.
      Set Implicit Arguments.
      Unset Strict Implicit.
      Unset Printing Implicit Defensive.
@@ -3632,6 +3628,8 @@ corresponding new goals will be generated.
 
   .. rocqtop:: all abort
 
+     From Corelib Require Import ssreflect ssrfun ssrbool.
+
      Axiom leq : nat -> nat -> bool.
      Notation "m <= n" := (leq m n) : nat_scope.
      Notation "m < n"  := (S m <= n) : nat_scope.
@@ -3644,11 +3642,12 @@ corresponding new goals will be generated.
      Axiom insubT : forall n x Px, insub n x = Some (Sub x Px).
 
      Lemma test (x : 'I_2) y : Some x = insub 2 y.
-     rewrite insubT.
+     Proof.
+     rw insubT.
 
   Since the argument corresponding to ``Px`` is not supplied by the user, the
   resulting goal should be ``Some x = Some (Sub y ?Goal).``
-  Instead, |SSR| ``rewrite`` tactic hides the existential variable.
+  Instead, |SSR| ``rw`` tactic hides the existential variable.
 
   As in :ref:`apply_ssr`, the ``ssrautoprop`` tactic is used to try to
   solve the existential variable.
@@ -3656,7 +3655,8 @@ corresponding new goals will be generated.
   .. rocqtop:: all abort
 
      Lemma test (x : 'I_2) y (H : y < 2) : Some x = insub 2 y.
-     rewrite insubT.
+     Proof.
+     rw insubT.
 
 
 As a temporary limitation, this behavior is available only if the
@@ -3681,7 +3681,7 @@ complete terms, as shown by the simple example below.
 
    .. rocqtop:: reset none
 
-      From Corelib Require Import ssreflect.
+      From Corelib Require Import ssreflect_rw.
       Set Implicit Arguments.
       Unset Strict Implicit.
       Unset Printing Implicit Defensive.
@@ -3699,12 +3699,13 @@ complete terms, as shown by the simple example below.
    .. rocqtop:: all
 
       Lemma example_map l : sumlist (map (fun m => m - m) l) = 0.
+      Proof.
 
    In this context, one cannot directly use ``eq_map``:
 
    .. rocqtop:: all fail
 
-      rewrite eq_map.
+      rw eq_map.
 
    as we need to explicitly provide the non-inferable argument ``F2``,
    which corresponds here to the term we want to obtain *after* the
@@ -3713,8 +3714,8 @@ complete terms, as shown by the simple example below.
 
    .. rocqtop:: all abort
 
-      rewrite (@eq_map _ (fun _ : nat => 0)).
-        by move=> m; rewrite subnn.
+      rw (@eq_map _ (fun _ : nat => 0)).
+        by move=> m; rw subnn.
 
    The :tacn:`under` tactic lets one perform the same operation in a more
    convenient way:
@@ -3722,7 +3723,8 @@ complete terms, as shown by the simple example below.
    .. rocqtop:: all abort
 
       Lemma example_map l : sumlist (map (fun m => m - m) l) = 0.
-      under eq_map => m do rewrite subnn.
+      Proof.
+      under eq_map => m do rw subnn.
 
 
 The under tactic
@@ -3759,8 +3761,9 @@ Let us redo the running example in interactive mode.
    .. rocqtop:: all abort
 
       Lemma example_map l : sumlist (map (fun m => m - m) l) = 0.
+      Proof.
       under eq_map => m.
-        rewrite subnn.
+        rw subnn.
         over.
 
 The execution of the Ltac expression:
@@ -3769,8 +3772,8 @@ The execution of the Ltac expression:
 
 involves the following steps.
 
-1. It performs a :n:`rewrite @term`
-   without failing like in the first example with ``rewrite eq_map.``,
+1. It performs a :n:`rw @term`
+   without failing like in the first example with ``rw eq_map.``,
    but creating evars (see :tacn:`evar`). If :n:`term` is prefixed by
    a pattern or an occurrence selector, then the modifiers are honoured.
 
@@ -3788,7 +3791,8 @@ involves the following steps.
    registered relations (w.r.t. Class ``RewriteRelation``) between a
    term and an evar, e.g., ``m - m = ?F2 m`` in the running example.
    (This support for setoid-like relations is enabled as soon as one does
-   both ``Require Import ssreflect.`` and ``Require Setoid.``)
+   both ``From Corelib Require Import ssreflect_rw.``
+   and ``From Corelib Require Setoid.``)
 
 5. If so :tacn:`under` protects these n goals against an
    accidental instantiation of the evar.
@@ -3872,7 +3876,7 @@ Notes:
 
    .. rocqtop:: reset none
 
-      From Corelib Require Import ssreflect.
+      From Corelib Require Import ssreflect_rw.
       Set Implicit Arguments.
       Unset Strict Implicit.
       Unset Printing Implicit Defensive.
@@ -3934,9 +3938,10 @@ Notes:
       Lemma test_big_nested (m n : nat) :
         \sum_(0 <= a < m | prime a) \sum_(0 <= j < n | odd (j * 1)) (a + j) =
         \sum_(0 <= i < m | prime i) \sum_(0 <= j < n | odd j) (j + i).
+      Proof.
       under eq_bigr => i prime_i do
         under eq_big => [ j | j odd_j ] do
-          [ rewrite (muln1 j) | rewrite (addnC i j) ].
+          [ rw (muln1 j) | rw (addnC i j) ].
 
    Remark how the final goal uses the name ``i`` (the name given in the
    intro pattern) rather than ``a`` in the binder of the first summation.
@@ -3979,21 +3984,23 @@ selective rewriting, blocking on the fly the reduction in the term ``t``.
 
   .. rocqtop:: reset none
 
-     From Corelib Require Import ssreflect ssrfun ssrbool.
-     From Corelib Require Import ListDef.
      Set Implicit Arguments.
      Unset Strict Implicit.
      Unset Printing Implicit Defensive.
-     Section Test.
 
   .. rocqtop:: all
 
+     From Corelib Require Import ssreflect ssrfun ssrbool.
+     From Corelib Require Import ListDef.
+     Section Test.
+
      Variable A : Type.
      Fixpoint has (p : A -> bool) (l : list A) : bool :=
        if l is cons x l then p x || (has p l) else false.
 
      Lemma test p x y l (H : p x = true) : has p ( x :: y :: l) = true.
-     rewrite {2}[cons]lock /= -lock.
+     Proof.
+     rw {2}[cons]lock /= -lock.
 
 It is sometimes desirable to globally prevent a definition from being
 expanded by simplification; this is done by adding ``locked`` in the
@@ -4003,7 +4010,7 @@ definition.
 
   .. rocqtop:: reset none
 
-     From Corelib Require Import ssreflect.
+     From Corelib Require Import ssreflect_rw.
      Set Implicit Arguments.
      Unset Strict Implicit.
      Unset Printing Implicit Defensive.
@@ -4014,7 +4021,8 @@ definition.
       Definition lid := locked (fun x : nat => x).
 
       Lemma test : lid 3 = 3.
-      rewrite /=.
+      Proof.
+      rw /=.
       unlock lid.
 
 .. tacn:: unlock {? @occ_switch } @ident
@@ -4074,7 +4082,7 @@ arithmetic operations. We define for instance:
 The operation ``addn`` behaves exactly like ``plus``, except that
 ``(addn (S n) m)`` will not simplify spontaneously to
 ``(S (addn n m))`` (the two terms, however, are convertible).
-In addition, the unfolding step ``rewrite /addn``
+In addition, the unfolding step ``rw /addn``
 will replace ``addn`` directly with ``plus``, so the ``nosimpl`` form is
 essentially invisible.
 
@@ -4116,19 +4124,20 @@ which the function is supplied:
 
       .. rocqtop:: reset none
 
-         From Corelib Require Import ssreflect.
+         From Corelib Require Import ssreflect_rw.
          Set Implicit Arguments.
          Unset Strict Implicit.
          Unset Printing Implicit Defensive.
-         Section Test.
 
       .. rocqtop:: all
 
          Lemma test (x y z : nat) (H : x = y) : x = z.
+         Proof.
          congr (_ = _) : H.
          Abort.
 
          Lemma test (x y z : nat) : x = y -> x = z.
+         Proof.
          congr (_ = _).
 
    The optional :token:`natural` forces the number of arguments for which the
@@ -4143,19 +4152,20 @@ which the function is supplied:
 
       .. rocqtop:: reset none
 
-         From Corelib Require Import ssreflect.
          Set Implicit Arguments.
          Unset Strict Implicit.
          Unset Printing Implicit Defensive.
-         Section Test.
 
       .. rocqtop:: all
 
+         From Corelib Require Import ssreflect.
+
          Definition f n :=
            if n is 0 then plus else mult.
          Definition g (n m : nat) := plus.
 
          Lemma test x y : f 0 x y = g 1 1 x y.
+         Proof.
          congr plus.
 
       This script shows that the ``congr`` tactic matches ``plus``
@@ -4166,18 +4176,18 @@ which the function is supplied:
 
       .. rocqtop:: reset none
 
-         From Corelib Require Import ssreflect.
+         From Corelib Require Import ssreflect_rw.
          Set Implicit Arguments.
          Unset Strict Implicit.
          Unset Printing Implicit Defensive.
-         Section Test.
 
       .. rocqtop:: all
 
          Lemma test n m (Hnm : m <= n) : S m + (S n - S m) = S n.
-         congr S; rewrite -/plus.
+         Proof.
+         congr S; rw -/plus.
 
-      The tactic ``rewrite -/plus`` folds back the expansion of ``plus``,
+      The tactic ``rw -/plus`` folds back the expansion of ``plus``,
       which was necessary for matching both sides of the equality with
       an application of ``S``.
 
@@ -4187,15 +4197,15 @@ which the function is supplied:
 
       .. rocqtop:: reset none
 
-         From Corelib Require Import ssreflect.
+         From Corelib Require Import ssreflect_rw.
          Set Implicit Arguments.
          Unset Strict Implicit.
          Unset Printing Implicit Defensive.
-         Section Test.
 
       .. rocqtop:: all
 
          Lemma test x y : x + (y * (y + x - x)) = x * 1 + (y + 0) * y.
+         Proof.
          congr ( _ + (_ * _)).
 
 .. _contextual_patterns_ssr:
@@ -4254,7 +4264,7 @@ in the second column.
 
 The rewrite tactic supports two more patterns obtained prefixing the
 first two with ``in``. The intended meaning is that the pattern identifies
-all subterms of the specified context. The ``rewrite`` tactic will infer a
+all subterms of the specified context. The ``rw`` tactic will infer a
 pattern for the redex looking at the rule used for rewriting.
 
 .. list-table::
@@ -4288,11 +4298,11 @@ consider the goal ``a = b`` and the tactic
 
 .. rocqdoc::
 
-   rewrite [in X in _ = X]rule.
+   rw [in X in _ = X]rule.
 
 It rewrites all occurrences of the left hand side of ``rule``
 inside ``b``  only (``a``, and the hidden type of the equality, are ignored). Note that the
-variant ``rewrite [X in _ = X]rule`` would have rewritten ``b``
+variant ``rw [X in _ = X]rule`` would have rewritten ``b``
 exactly (i.e., it would only work if ``b`` and the left-hand side
 of rule can be unified).
 
@@ -4367,17 +4377,17 @@ parentheses are required around more complex patterns.
 
   .. rocqtop:: reset none
 
-     From Corelib Require Import ssreflect.
+     From Corelib Require Import ssreflect_rw.
      Set Implicit Arguments.
      Unset Strict Implicit.
      Unset Printing Implicit Defensive.
-     Section Test.
 
   .. rocqtop:: all
 
      Lemma test a b : a + b + 1 = b + (a + 1).
+     Proof.
      set t := (X in _ = X).
-     rewrite {}/t.
+     rw {}/t.
      set t := (a + _ in X in _ = X).
 
 
@@ -4406,11 +4416,10 @@ Contextual patterns in rewrite
 
   .. rocqtop:: reset none
 
-     From Corelib Require Import ssreflect.
+     From Corelib Require Import ssreflect_rw.
      Set Implicit Arguments.
      Unset Strict Implicit.
      Unset Printing Implicit Defensive.
-     Section Test.
 
   .. rocqtop:: all
 
@@ -4422,7 +4431,8 @@ Contextual patterns in rewrite
      Axiom addnC : forall m n, m + n = n + m.
 
      Lemma test x y z f : (x.+1 + y) + f (x.+1 + y) (z + (x + y).+1) = 0.
-     rewrite [in f _ _]addSn.
+     Proof.
+     rw [in f _ _]addSn.
 
   Note: the simplification rule ``addSn`` is applied only under the ``f``
   symbol.
@@ -4430,7 +4440,7 @@ Contextual patterns in rewrite
 
   .. rocqtop:: all
 
-     rewrite addSn -[X in _ = X]addn0.
+     rw addSn -[X in _ = X]addn0.
 
   Note that the right-hand side of ``addn0`` is undetermined, but the
   rewrite pattern specifies the redex explicitly. The right-hand side
@@ -4443,13 +4453,13 @@ Contextual patterns in rewrite
 
   .. rocqtop:: all
 
-     rewrite -{2}[in X in _ = X](addn0 0).
+     rw -{2}[in X in _ = X](addn0 0).
 
   The following tactic is quite tricky:
 
   .. rocqtop:: all
 
-     rewrite [_.+1 in X in f _ X](addnC x.+1).
+     rw [_.+1 in X in f _ X](addnC x.+1).
 
   The explicit redex ``_.+1`` is important, since its :term:`head constant` ``S``
   differs from the head constant inferred from
@@ -4469,7 +4479,7 @@ Contextual patterns in rewrite
 
   .. rocqtop:: all
 
-     rewrite [x.+1 + y as X in f X _]addnC.
+     rw [x.+1 + y as X in f X _]addnC.
 
 
 Patterns for recurrent contexts
@@ -4496,7 +4506,7 @@ Shortcuts defined this way can be freely used in place of the trailing
 .. rocqdoc::
 
    set rhs := RHS.
-   rewrite [in RHS]rule.
+   rw [in RHS]rule.
    case: (a + _ in RHS).
 
 
@@ -4570,14 +4580,15 @@ generation (see Section :ref:`generation_of_equations_ssr`).
 
   .. rocqtop:: reset none
 
-     From Corelib Require Import ssreflect ListDef.
      Set Implicit Arguments.
      Unset Strict Implicit.
      Unset Printing Implicit Defensive.
-     Section Test.
 
   .. rocqtop:: all
 
+     From Corelib Require Import ssreflect ListDef.
+     Section Test.
+
      Variable d : Type.
      Fixpoint add_last (s : list d) (z : d) {struct s} : list d :=
        if s is cons x s' then cons x (add_last s' z) else z :: nil.
@@ -4598,6 +4609,7 @@ generation (see Section :ref:`generation_of_equations_ssr`).
   .. rocqtop:: all
 
      Lemma test (x : d) (l : list d): l = l.
+     Proof.
      elim/last_ind_list E : l=> [| u v]; last first.
 
 
@@ -4645,7 +4657,7 @@ Here is an example of a regular, but nontrivial, eliminator.
 
   .. rocqtop:: reset none
 
-     From Corelib Require Import ssreflect.
+     From Corelib Require Import ssreflect_rw.
      Set Implicit Arguments.
      Unset Strict Implicit.
      Unset Printing Implicit Defensive.
@@ -4657,18 +4669,20 @@ Here is an example of a regular, but nontrivial, eliminator.
                                      | 0 => True
                                      | S _ => False
                                      end -> P _x m) -> forall n : nat, P n (plus m n).
+     Proof.
      Admitted.
 
-     Section Test.
-
   .. rocqtop:: all
 
+     From Corelib Require Import ssreflect.
+
      Fixpoint plus (m n : nat) {struct n} : nat :=
        if n is S p then S (plus m p) else m.
 
      About plus_ind.
 
      Lemma test x y z : plus (plus x y) z = plus x (plus y z).
+     Proof.
 
   The following tactics are all valid and perform the same elimination
   on this goal.
@@ -4683,10 +4697,10 @@ Here is an example of a regular, but nontrivial, eliminator.
   .. rocqtop:: reset none
 
      From Corelib Require Import ssreflect.
+
      Set Implicit Arguments.
      Unset Strict Implicit.
      Unset Printing Implicit Defensive.
-     Section Test.
 
      Fixpoint plus (m n : nat) {struct n} : nat :=
        if n is S p then S (plus m p) else m.
@@ -4700,6 +4714,7 @@ Here is an example of a regular, but nontrivial, eliminator.
                                      end -> P _x m) -> forall n : nat, P n (plus m n).
 
      Lemma test x y z : plus (plus x y) z = plus x (plus y z).
+     Proof.
 
   .. rocqtop:: all
 
@@ -4714,6 +4729,7 @@ Here is an example of a regular, but nontrivial, eliminator.
   .. rocqtop:: reset none
 
      From Corelib Require Import ssreflect.
+
      Set Implicit Arguments.
      Unset Strict Implicit.
      Unset Printing Implicit Defensive.
@@ -4731,6 +4747,7 @@ Here is an example of a regular, but nontrivial, eliminator.
                                      end -> P _x m) -> forall n : nat, P n (plus m n).
 
      Lemma test x y z : plus (plus x y) z = plus x (plus y z).
+     Proof.
 
   .. rocqtop:: all
 
@@ -4749,11 +4766,10 @@ Here is an example of a truncated eliminator:
 
   .. rocqtop:: reset none
 
-     From Corelib Require Import ssreflect.
+     From Corelib Require Import ssreflect_rw.
      Set Implicit Arguments.
      Unset Strict Implicit.
      Unset Printing Implicit Defensive.
-     Section Test.
 
   .. rocqdoc::
 
@@ -4813,7 +4829,7 @@ disjunction.
 
   .. rocqtop:: reset none
 
-     From Corelib Require Import ssreflect.
+     From Corelib Require Import ssreflect_rw.
      Set Implicit Arguments.
      Unset Strict Implicit.
      Unset Printing Implicit Defensive.
@@ -4825,6 +4841,7 @@ disjunction.
      Hypothesis P2Q : forall a b, P (a || b) -> Q a.
 
      Lemma test a : P (a || a) -> True.
+     Proof.
      move=> HPa; move: {HPa}(P2Q HPa) => HQa.
 
   which transforms the hypothesis ``HPa : P a``, which has been introduced
@@ -4834,7 +4851,7 @@ disjunction.
 
   .. rocqtop:: reset none
 
-     From Corelib Require Import ssreflect.
+     From Corelib Require Import ssreflect_rw.
      Set Implicit Arguments.
      Unset Strict Implicit.
      Unset Printing Implicit Defensive.
@@ -4844,6 +4861,7 @@ disjunction.
      Hypothesis P2Q : forall a b, P (a || b) -> Q a.
 
      Lemma test a : P (a || a) -> True.
+     Proof.
 
   .. rocqtop:: all
 
@@ -4869,7 +4887,7 @@ equation-name generation mechanism (see Section :ref:`generation_of_equations_ss
 
   .. rocqtop:: reset none
 
-     From Corelib Require Import ssreflect.
+     From Corelib Require Import ssreflect_rw.
      Set Implicit Arguments.
      Unset Strict Implicit.
      Unset Printing Implicit Defensive.
@@ -4881,6 +4899,7 @@ equation-name generation mechanism (see Section :ref:`generation_of_equations_ss
      Hypothesis Q2P : forall a b, Q (a || b) -> P a \/ P b.
 
      Lemma test a b : Q (a || b) -> True.
+     Proof.
      case/Q2P=> [HPa | HPb].
 
   This view tactic performs:
@@ -4902,7 +4921,7 @@ relevant for the current goal.
 
   .. rocqtop:: reset none
 
-     From Corelib Require Import ssreflect.
+     From Corelib Require Import ssreflect_rw.
      Set Implicit Arguments.
      Unset Strict Implicit.
      Unset Printing Implicit Defensive.
@@ -4914,6 +4933,7 @@ relevant for the current goal.
      Hypothesis PQequiv : forall a b, P (a || b) <-> Q a.
 
      Lemma test a b : P (a || b) -> True.
+     Proof.
      move/PQequiv=> HQab.
 
   has the same behavior as the first example above.
@@ -4946,15 +4966,15 @@ assumption to some given arguments.
 
   .. rocqtop:: reset none
 
-     From Corelib Require Import ssreflect.
+     From Corelib Require Import ssreflect_rw.
      Set Implicit Arguments.
      Unset Strict Implicit.
      Unset Printing Implicit Defensive.
-     Section Test.
 
   .. rocqtop:: all
 
      Lemma test z : (forall x y, x + y = z -> z = x) -> z = 0.
+     Proof.
      move/(_ 0 z).
 
 
@@ -4975,18 +4995,21 @@ bookkeeping steps.
 
   .. rocqtop:: reset none
 
-     From Corelib Require Import ssreflect ssrbool.
+     From Corelib Require Import ssreflect_rw.
      Set Implicit Arguments.
      Unset Strict Implicit.
      Unset Printing Implicit Defensive.
-     Section Test.
 
   .. rocqtop:: all
 
+     From Corelib Require Import ssrbool.
+     Section Test.
+
      Variables P Q: bool -> Prop.
      Hypothesis PQequiv : forall a b, P (a || b) <-> Q a.
 
      Lemma test a : P ((~~ a) || a).
+     Proof.
      apply/PQequiv.
 
   thus in this case, the tactic ``apply/PQequiv`` is equivalent to
@@ -5031,7 +5054,7 @@ analysis:
 
   .. rocqtop:: reset none
 
-     From Corelib Require Import ssreflect.
+     From Corelib Require Import ssreflect_rw.
      Set Implicit Arguments.
      Unset Strict Implicit.
      Unset Printing Implicit Defensive.
@@ -5048,15 +5071,17 @@ analysis
 
   .. rocqtop:: reset none
 
-     From Corelib Require Import ssreflect ssrbool.
+     From Corelib Require Import ssreflect_rw.
      Set Implicit Arguments.
      Unset Strict Implicit.
      Unset Printing Implicit Defensive.
-     Section Test.
 
   .. rocqtop:: all
 
+     From Corelib Require Import ssrbool.
+
      Lemma test b : b || ~~ b = true.
+     Proof.
      by case: b.
 
   Once ``b`` is replaced by ``true`` in the first goal and by ``false`` in the
@@ -5138,7 +5163,7 @@ Let us compare the respective behaviors of ``andE`` and ``andP``.
 
   .. rocqtop:: reset none
 
-     From Corelib Require Import ssreflect ssrbool.
+     From Corelib Require Import ssreflect_rw ssrbool.
      Set Implicit Arguments.
      Unset Strict Implicit.
      Unset Printing Implicit Defensive.
@@ -5148,16 +5173,13 @@ Let us compare the respective behaviors of ``andE`` and ``andP``.
   .. rocqtop:: all
 
      Lemma test (b1 b2 : bool) : if (b1 && b2) then b1 else ~~(b1||b2).
+     Proof.
 
   .. rocqtop:: all
 
      case: (@andE b1 b2).
 
-  .. rocqtop:: none
-
-     Restart.
-
-  .. rocqtop:: all
+  .. rocqtop:: all restart
 
      case: (@andP b1 b2).
 
@@ -5179,15 +5201,17 @@ The view mechanism is compatible with reflect predicates.
 
   .. rocqtop:: reset none
 
-     From Corelib Require Import ssreflect ssrbool.
+     From Corelib Require Import ssreflect_rw.
      Set Implicit Arguments.
      Unset Strict Implicit.
      Unset Printing Implicit Defensive.
-     Section Test.
 
   .. rocqtop:: all abort
 
+     From Corelib Require Import ssrbool.
+
      Lemma test (a b : bool) (Ha : a) (Hb : b) : a /\ b.
+     Proof.
      apply/andP.
 
   Conversely
@@ -5195,6 +5219,7 @@ The view mechanism is compatible with reflect predicates.
   .. rocqtop:: all
 
      Lemma test (a b : bool) : a /\ b -> a.
+     Proof.
      move/andP.
 
 The same tactics can also be used to perform the converse operation,
@@ -5297,19 +5322,21 @@ but they also allow complex transformation, involving negations.
 
   .. rocqtop:: reset none
 
-     From Corelib Require Import ssreflect ssrbool.
+     From Corelib Require Import ssreflect_rw.
      Set Implicit Arguments.
      Unset Strict Implicit.
      Unset Printing Implicit Defensive.
-     Section Test.
 
   .. rocqtop:: all
 
+     From Corelib Require Import ssrbool.
+
      Check introN.
 
   .. rocqtop:: all
 
      Lemma test (a b : bool) (Ha : a) (Hb : b) : ~~ (a && b).
+     Proof.
      apply/andP.
 
   In fact, this last script does not
@@ -5330,16 +5357,18 @@ actually uses its propositional interpretation.
 
   .. rocqtop:: reset none
 
-     From Corelib Require Import ssreflect ssrbool.
+     From Corelib Require Import ssreflect_rw.
      Set Implicit Arguments.
      Unset Strict Implicit.
      Unset Printing Implicit Defensive.
-     Section Test.
 
   .. rocqtop:: all
 
+     From Corelib Require Import ssrbool.
+
      Lemma test (a b : bool) (pab : b && a) : b.
-     have /andP [pa ->] : (a && b) by rewrite andbC.
+     Proof.
+     have /andP [pa ->] : (a && b) by rw andbC.
 
 Interpreting goals
 ``````````````````
@@ -5393,15 +5422,17 @@ In this context, the identity view can be used when no view has to be applied:
 
   .. rocqtop:: reset none
 
-     From Corelib Require Import ssreflect ssrbool.
+     From Corelib Require Import ssreflect_rw.
      Set Implicit Arguments.
      Unset Strict Implicit.
      Unset Printing Implicit Defensive.
-     Section Test.
 
   .. rocqtop:: all
 
+     From Corelib Require Import ssrbool.
+
      Lemma test (b1 b2 b3 : bool) : ~~ (b1 || b2) = b3.
+     Proof.
      apply/idP/idP.
 
   The same goal can be decomposed in several ways, and the user may
@@ -5409,15 +5440,17 @@ In this context, the identity view can be used when no view has to be applied:
 
   .. rocqtop:: reset none
 
-     From Corelib Require Import ssreflect ssrbool.
+     From Corelib Require Import ssreflect_rw.
      Set Implicit Arguments.
      Unset Strict Implicit.
      Unset Printing Implicit Defensive.
-     Section Test.
 
   .. rocqtop:: all
 
+     From Corelib Require Import ssrbool.
+
      Lemma test (b1 b2 b3 : bool) : ~~ (b1 || b2) = b3.
+     Proof.
      apply/norP/idP.
 
 
@@ -5485,19 +5518,22 @@ pass a given hypothesis to a lemma.
 
   .. rocqtop:: reset none
 
-     From Corelib Require Import ssreflect ssrbool.
+     From Corelib Require Import ssreflect_rw.
      Set Implicit Arguments.
      Unset Strict Implicit.
      Unset Printing Implicit Defensive.
-     Section Test.
-     Variables P Q R : Prop.
 
   .. rocqtop:: all
 
+     From Corelib Require Import ssrbool.
+     Section Test.
+     Variables P Q R : Prop.
+
      Variable P2Q : P -> Q.
      Variable Q2R : Q -> R.
 
      Lemma test (p : P) : True.
+     Proof.
      move/P2Q/Q2R in p.
 
 If the list of views is of length two, ``Hint Views`` for interpreting
@@ -5518,8 +5554,8 @@ The following intro pattern ltac views are provided:
 
 One can call rewrite from an intro pattern, use with parsimony:
 
-+ ``/[1! rules]`` shortcut for ``rewrite rules``
-+ ``/[! rules]`` shortcut for ``rewrite !rules``
++ ``/[1! rules]`` shortcut for ``rw rules``
++ ``/[! rules]`` shortcut for ``rw !rules``
 
 
 Synopsis and Index
@@ -5655,7 +5691,7 @@ respectively.
 
    case analysis (see :ref:`the_defective_tactics_ssr`)
 
-.. tacv:: rewrite {+ @r_step }
+.. tacv:: rw {+ @r_step }
 
    rewrite (see :ref:`rewriting_ssr`)
 
@@ -5788,3 +5824,54 @@ Commands
   Proof`` command of Rocq proof mode.
 .. [#10] A simple proof context entry is a naked identifier (i.e., not between
   parentheses) designating a context entry that is not a section variable.
+
+.. _compatibility_issues_ssr:
+
+
+Compatibility issues
+~~~~~~~~~~~~~~~~~~~~
+
+Requiring the module `ssreflect_rw` from `Corelib`
+creates an environment that is mostly
+compatible with the rest of Rocq, up to a few discrepancies.
+
++ New tactic(al)s names (:tacn:`last`, :tacn:`done`, :tacn:`have`, :tacn:`suffices`,
+  :tacn:`suff`, :tacn:`without loss`, :tacn:`wlog`, :tacn:`congr`, :tacn:`unlock`)
+  might clash with user tactic names.
++ New symbols (``//``, ``/=``, ``//=``) might clash with adjacent
+  existing symbols.
+  This can be avoided by inserting white spaces.
++ Some user notations (in particular, defining an infix ``;``) might
+  interfere with the "open term", parenthesis-free syntax of tactics
+  such as :tacn:`have`, :tacn:`set (ssreflect)` and :tacn:`pose (ssreflect)`.
+
+In addition, requiring the backward compatibility module `ssreflect` from `Corelib`
+creates an environment that is mostly
+compatible with the rest of Rocq, up to a few discrepancies.
+
++ New keywords (``is``) might clash with variable, constant, tactic or
+  tactical names, or with quasi-keywords in tactic or
+  notation commands.
++ The extensions to the :tacn:`rewrite` tactic are partly incompatible with those
+  available in current versions of Rocq; in particular, ``rewrite .. in
+  (type of k)`` or ``rewrite .. in *`` or any other variant of :tacn:`rewrite`
+  will not work, and the |SSR| syntax and semantics for occurrence selection
+  and rule chaining are different. Use an explicit rewrite direction
+  (``rewrite <- …`` or ``rewrite -> …``) to access the Rocq rewrite tactic.
++ The generalization of ``if`` statements to non-Boolean conditions is turned off
+  by |SSR|, because it is mostly subsumed by Coercion to ``bool`` of the
+  ``sumXXX`` types (declared in ``ssrfun.v``) and the
+  :n:`if @term is @pattern then @term else @term` construct
+  (see :ref:`pattern_conditional_ssr`).  To use the
+  generalized form, turn off the |SSR| Boolean ``if`` notation using the command:
+  ``Close Scope boolean_if_scope``.
++ The following flag can be unset to make |SSR| more compatible with
+  parts of Rocq.
+
+.. flag:: SsrRewrite
+
+   Controls whether the incompatible rewrite syntax is enabled (the default).
+   Disabling the :term:`flag` makes the syntax compatible with other parts of Rocq.
+   Note that this ``rewrite`` syntax, now superseded by ``rw``, is
+   only activated when explicitly requiring the backward compatibility
+   module ``From Corelib Require Import ssreflect.``.
diff --git a/doc/sphinx/proof-engine/tactics.rst b/doc/sphinx/proof-engine/tactics.rst
index 964c854a5639..5a94cfcb7ce6 100644
--- a/doc/sphinx/proof-engine/tactics.rst
+++ b/doc/sphinx/proof-engine/tactics.rst
@@ -285,6 +285,7 @@ Examples:
       .. rocqtop:: reset none
 
          Goal forall (A: Prop) (B: Prop), (A /\ B) -> True.
+         Proof.
 
       .. rocqtop:: out
 
@@ -301,6 +302,7 @@ Examples:
       .. rocqtop:: reset none
 
          Goal forall (A: Prop) (B: Prop), (A \/ B) -> True.
+         Proof.
 
       .. rocqtop:: out
 
@@ -317,6 +319,7 @@ Examples:
       .. rocqtop:: reset none
 
          Goal forall (x:nat) (y:nat) (z:nat), (x = y) -> (y = z) -> (x = z).
+         Proof.
 
       .. rocqtop:: out
 
@@ -338,6 +341,7 @@ Examples:
       .. rocqtop:: reset none
 
          Goal forall (n m:nat),  (S n) = (S m) -> (S O)=(S (S O)) -> False.
+         Proof.
 
       .. rocqtop:: out
 
@@ -362,6 +366,7 @@ Examples:
       .. rocqtop:: out
 
          Goal A /\ (exists x:nat, B x /\ C) -> True.
+         Proof.
 
       .. rocqtop:: all
 
@@ -374,6 +379,7 @@ Examples:
       .. rocqtop:: reset out
 
          Goal forall (A: Prop) (B: Prop), A -> B.
+         Proof.
 
       .. rocqtop:: all
 
@@ -386,6 +392,7 @@ Examples:
       .. rocqtop:: reset out
 
          Goal forall (A: Prop) (B: Prop), A -> B.
+         Proof.
 
       .. rocqtop:: all
 
@@ -396,6 +403,7 @@ Examples:
       .. rocqtop:: reset out
 
          Goal forall A B C:Prop, A \/ B /\ C -> (A -> C) -> C.
+         Proof.
 
       .. rocqtop:: all
 
@@ -417,7 +425,8 @@ Examples:
       .. rocqtop:: out
 
          Example ThreeIntroPatternsCombined :
-         S (length ys) = 1 -> xs ++ ys = xs.
+           S (length ys) = 1 -> xs ++ ys = xs.
+         Proof.
 
       .. rocqtop:: all
 
@@ -624,6 +633,7 @@ Applying theorems
          | Ok : bool -> Option.
 
          Definition get : forall x:Option, x <> Fail -> bool.
+         Proof.
            refine
              (fun x:Option =>
                match x return x <> Fail -> bool with
@@ -787,6 +797,7 @@ Applying theorems
       .. rocqtop:: reset none
 
          Goal forall A B C: Prop, (A -> B -> C) -> C.
+         Proof.
 
       .. rocqtop:: out
 
@@ -802,6 +813,7 @@ Applying theorems
       .. rocqtop:: reset none
 
          Goal forall A B C: Prop, (A -> B -> C) -> (B -> C).
+         Proof.
 
       .. rocqtop:: out
 
@@ -817,6 +829,7 @@ Applying theorems
       .. rocqtop:: reset none
 
          Goal forall A B C: Prop, B -> (A -> B -> C) -> True.
+         Proof.
 
       .. rocqtop:: out
 
@@ -840,6 +853,7 @@ Applying theorems
          Axiom le_trans : forall n m p, n <= m -> m <= p -> n <= p.
 
          Goal forall (x y : nat), x <= y -> x * x <= y * y.
+         Proof.
 
       .. rocqtop:: out
 
@@ -870,6 +884,7 @@ Applying theorems
          Axiom le_trans : forall n m p, n <= m -> m <= p -> n <= p.
 
          Goal forall (x y : nat), x * x <= y * y -> x <= y.
+         Proof.
 
       .. rocqtop:: out
 
@@ -896,6 +911,7 @@ Applying theorems
       .. rocqtop:: reset none
 
          Goal forall (A B: Prop) (H1: A <-> B) (H: A), A.
+         Proof.
 
       .. rocqtop:: out
 
@@ -917,6 +933,7 @@ Applying theorems
       .. rocqtop:: reset none
 
          Goal forall x y, x + y = y + x.
+         Proof.
 
       .. rocqtop:: out
 
@@ -973,6 +990,7 @@ Applying theorems
             Definition id (x : nat) := x.
             Parameter H : forall x y, id x = y.
             Goal O = O.
+            Proof.
             Fail simple apply H.
 
       Because it reasons modulo a limited amount of conversion, :tacn:`simple apply` fails
@@ -1009,6 +1027,7 @@ Applying theorems
    .. rocqtop:: in
 
       Goal R n p.
+      Proof.
 
    The direct application of ``Rtrans`` with ``apply`` fails because no value
    for ``y`` in ``Rtrans`` is found by ``apply``:
@@ -1135,6 +1154,7 @@ Managing the local context
       .. rocqtop:: reset out
 
          Goal forall m n, m < n -> (let x := 0 in True).
+         Proof.
 
       .. rocqtop:: all
 
@@ -1148,6 +1168,7 @@ Managing the local context
       .. rocqtop:: reset out
 
          Goal forall m n, m < n -> (let x := 0 in True).
+         Proof.
 
       .. rocqtop:: all
 
@@ -1182,6 +1203,7 @@ Managing the local context
          .. rocqtop:: reset out
 
             Goal forall x y : nat, x = y -> y = x.
+            Proof.
 
          .. rocqtop:: all
 
@@ -1192,6 +1214,7 @@ Managing the local context
          .. rocqtop:: reset out
 
             Goal forall x y : nat, x = y -> y = x.
+            Proof.
 
          .. rocqtop:: all
 
@@ -1309,6 +1332,7 @@ Managing the local context
       .. rocqtop:: reset none
 
          Goal forall x :nat, x = 0 -> forall y z:nat, y=y-> 0=x.
+         Proof.
 
       .. rocqtop:: out
 
@@ -1373,6 +1397,7 @@ Managing the local context
       .. rocqtop:: reset none
 
          Goal forall n, n = 0.
+         Proof.
 
       .. rocqtop:: out
 
@@ -1576,6 +1601,7 @@ Controlling the proof flow
       .. rocqtop:: reset none
 
          Goal (forall n m: nat, n + m = m + n) -> True.
+         Proof.
 
       .. rocqtop:: out
 
@@ -1770,14 +1796,17 @@ Controlling the proof flow
       Inductive F :=. (* Another empty inductive type *)
 
       Goal F -> False.
+      Proof.
       contradiction.
       Qed.
 
       Goal forall (A : Prop), A -> ~A -> False.
+      Proof.
       contradiction.
       Qed.
 
       Goal forall (A : Type) (x : A), ~(x = x) -> False.
+      Proof.
       contradiction.
       Qed.
 
@@ -1790,6 +1819,7 @@ Controlling the proof flow
    .. rocqtop:: in
 
       Goal forall (A : Prop), 0 < 0 -> A.
+      Proof.
 
    .. rocqtop:: all
 
@@ -1852,6 +1882,7 @@ Performance-oriented tactic variants
       .. rocqtop:: all abort
 
          Goal False.
+         Proof.
            exact_no_check I.
          Fail Qed.
 
@@ -1866,6 +1897,7 @@ Performance-oriented tactic variants
         .. rocqtop:: all abort
 
             Goal False.
+            Proof.
               vm_cast_no_check I.
             Fail Qed.
 
@@ -1880,5 +1912,6 @@ Performance-oriented tactic variants
         .. rocqtop:: all abort
 
             Goal False.
+            Proof.
               native_cast_no_check I.
             Fail Qed.
diff --git a/doc/sphinx/proof-engine/vernacular-commands.rst b/doc/sphinx/proof-engine/vernacular-commands.rst
index 42f5bcbcb3cd..7b8bfd7f96fb 100644
--- a/doc/sphinx/proof-engine/vernacular-commands.rst
+++ b/doc/sphinx/proof-engine/vernacular-commands.rst
@@ -11,14 +11,16 @@ Displaying
 
 .. _Print:
 
-.. cmd:: Print {? Term } @reference {? @univ_name_list }
+.. cmd:: Print {? Term } {+, @reference {? @univ_name_list } }
 
    .. insertprodn univ_name_list univ_name_list
 
    .. prodn::
-      univ_name_list ::= @%{ {* @name } %}
+      univ_name_list ::= @%{ {* @name } {? ; {* @name } } %}
 
-   Displays definitions of terms, including opaque terms, for the object :n:`@reference`.
+   Displays definitions of terms, including opaque terms, for one or more object :n:`@reference`\s.
+   When multiple comma-separted :n: `@reference`\s are given, their information is printed
+   in order with a blank line between each.
 
    * :n:`Term` - a syntactic marker to allow printing a term
      that is the same as one of the various :n:`Print` commands.  For example,
@@ -68,9 +70,11 @@ to accessible objects.  (see Section :ref:`invocation-of-tactics`).
 :cmd:`Eval` and :cmd:`Compute` are also :token:`query_command`\s, which are
 described elsewhere
 
-.. cmd:: About @reference {? @univ_name_list }
+.. cmd:: About {+, @reference {? @univ_name_list } }
 
-   Displays information about the :n:`@reference` object, which may be the
+   Displays information about one or more definitions. When multiple
+   comma-separated :n:`@reference`\s are given, their information is printed
+   in order with a blank line between each. Each :n:`@reference` may be the
    name of any accessible defined symbol, such as a theorem, constructor,
    fixpoint or module.  If a proof is open, :n:`@reference` may refer to a
    hypothesis of the selected goal.  The information includes:
@@ -433,6 +437,11 @@ Requests to the environment
 
    Displays all the assumptions (axioms, parameters and
    variables) one or more theorems or definitions depends on.
+   It also reports inductives that rely on indices not mattering
+   (i.e., whose behavior would change under ``-indices-matter`` or :flag:`Indices Matter`),
+   as well as uses of disabled typing flags such as
+   :flag:`Guard Checking`, :flag:`Positivity Checking`,
+   :flag:`Universe Checking`, and :flag:`Definitional UIP`.
 
    The message "Closed under the global context" indicates that all the theorems and
    definitions have no dependencies.
@@ -519,7 +528,7 @@ Requests to the environment
       Locate nat.
       Locate Datatypes.O.
       Locate Init.Datatypes.O.
-      Locate Stdlib.Init.Datatypes.O.
+      Locate Corelib.Init.Datatypes.O.
       Locate I.Dont.Exist.
 
 .. _printing-flags:
@@ -605,7 +614,7 @@ file is a particular case of a module called a *library file*.
    (if :n:`From @dirpath` is given) or :n:`{* @ident__implicit. }@qualid` (if
    the optional `From` clause is absent). :n:`{* @ident__implicit. }` represents
    the parts of the fully qualified name that are implicit.  For example,
-   `From Stdlib Require Nat` loads `Stdlib.Init.Nat` and `Init` is implicit.
+   `From Corelib Require Nat` loads `Corelib.Init.Nat` and `Init` is implicit.
    :n:`@ident` is the final component of the :n:`@qualid`.
 
    If a file is found, its logical name must be the same as the one
@@ -939,6 +948,20 @@ Quitting and debugging
       for :cmd:`Timeout` commands themselves.  If unset, no timeout is
       applied.
 
+.. cmd:: AllocLimit @natural {| Mw | kw } @sentence
+
+   Executes :n:`@sentence`. If the operation allocates more than the specified limit
+   (`w` means machine words), then it is interrupted and an error message is displayed.
+
+   .. warn:: Allocation limit ignored: memprof-limits was not installed when Rocq was compiled
+      :name: no-memprof-limits
+
+      If memprof-limits was not installed when Rocq was compiled,
+      :n:`@sentence` is executed without enforcing the limit.
+
+.. tacn:: alloc_limit @natural {| Mw | kw } @ltac_expr
+
+   :cmd:`AllocLimit` as a tactical.
 
 .. cmd:: Fail @sentence
 
@@ -1066,6 +1089,12 @@ Controlling display
    after each tactic.  The information is used by the Prooftree tool in Proof
    General. (https://askra.de/software/prooftree)
 
+.. flag:: Printing Variables Status
+
+   This debug :term:`flag` prints whether each variable in the context
+   is a section variable or an hypothesis local to the current proof.
+   It is off by default.
+
 .. extracted from Gallina extensions chapter
 
 .. _printing_constructions_full:
@@ -1144,6 +1173,17 @@ Controlling Typing Flags
    This :term:`boolean attribute` is similar to the :flag:`Positivity Checking` flag, but on a per-declaration basis.
    Disable positivity checking locally with ``bypass_check(positivity)``.
 
+.. flag:: Indices Matter
+
+   When this :term:`flag` is set (it is off by default), the types of indices
+   of inductive types contribute universe constraints, just as the types of
+   constructor arguments do.  This has the same effect as the ``-indices-matter``
+   command line argument (see :ref:`command-line-options`).
+
+   When this flag is set, inductives that rely on indices not
+   mattering (which may exist by being declared when the flag was
+   unset) are printed by :cmd:`Print Assumptions`.
+
 .. flag:: Universe Checking
 
    This :term:`flag` can be used to enable/disable the checking of universes, providing a
diff --git a/doc/sphinx/proofs/automatic-tactics/auto.rst b/doc/sphinx/proofs/automatic-tactics/auto.rst
index 8828000519c8..03e057b2df1d 100644
--- a/doc/sphinx/proofs/automatic-tactics/auto.rst
+++ b/doc/sphinx/proofs/automatic-tactics/auto.rst
@@ -85,6 +85,14 @@ Tactics
       variant is very useful for getting a better understanding of automation, or
       to know what lemmas/assumptions were used.
 
+   .. warn:: Use of the non-reference term @term in “using” clauses is ignored
+
+      Any non-reference term passed in a `using` clause is ignored. We
+      recommend adding such hints to the context via the :tacn:`pose proof`
+      tactic instead. For backwards compatibility, we still parse any term
+      in `using` clause for the time being, but you should consider
+      removing them.
+
 .. _info_auto_not_exact:
 
       The tactics shown in the info or debug output currently don't
@@ -110,6 +118,7 @@ Tactics
             Hint Resolve eq_refl : db.
 
             Goal forall n, n=1 -> exists x y : nat, x = y /\ x = 0.
+            Proof.
             intros.
             do 2 eexists; subst.      (* Fix 2: replace with "do 2 (eexists; subst)." *)
 
@@ -163,6 +172,7 @@ Tactics
 
          Hint Resolve ex_intro : core.
          Goal forall P:nat -> Prop, P 0 -> exists n, P n.
+         Proof.
          eauto.
 
       `ex_intro` is declared as a hint so the proof succeeds.
@@ -203,10 +213,6 @@ Tactics
    `*`
      If present, rewrite all occurrences whose side conditions are solved.
 
-     .. todo: This may not always work as described, see #4976 #7672 and
-        https://github.com/rocq-prover/rocq/issues/1933#issuecomment-337497938 as
-        mentioned here: https://github.com/rocq-prover/rocq/pull/13343#discussion_r527801604
-
    :n:`with {+ @ident }`
      Specifies the rewriting rule bases to use.
 
@@ -269,9 +275,7 @@ the optional tactic of the ``Hint Rewrite`` command.
    .. rocqtop:: all
 
       Lemma ResAck0 : Ack 3 2 = 29.
-
-   .. rocqtop:: all
-
+      Proof.
       autorewrite with base0 using try reflexivity.
 
 .. example:: MacCarthy function
@@ -300,6 +304,7 @@ the optional tactic of the ``Hint Rewrite`` command.
    .. rocqtop:: in extra-stdlib
 
       Lemma Resg0 : g 1 110 = 100.
+      Proof.
 
    .. rocqtop:: out extra-stdlib
 
@@ -316,6 +321,7 @@ the optional tactic of the ``Hint Rewrite`` command.
    .. rocqtop:: all extra-stdlib
 
       Lemma Resg1 : g 1 95 = 91.
+      Proof.
 
    .. rocqtop:: all extra-stdlib
 
@@ -652,7 +658,8 @@ Creating Hints
          .. rocqtop:: in reset
 
             Definition one := 1.
-            Theorem thm : one = 1. reflexivity. Qed.
+            Theorem thm : one = 1.
+            Proof. reflexivity. Qed.
 
             Create HintDb db1.
             Hint Opaque one : db1.
@@ -660,6 +667,7 @@ Creating Hints
             Create HintDb db2.
 
             Goal 1 = 1.
+            Proof.
             (* "one" is not unfolded because it's opaque in db1, where bar is *)
             Fail typeclasses eauto with db1 db2 nocore.  (* fails with tc eauto *)
             Succeed eauto with db1 db2 nocore.           (* ignores the distinction *)
@@ -680,7 +688,7 @@ Creating Hints
             Definition one := 1.
             Opaque one.  (* not relevant to hint selection *)
 
-            Theorem bar: 1=1.  reflexivity.  Qed.
+            Theorem bar: 1=1. Proof. reflexivity. Qed.
 
             Create HintDb db.       (* constants, etc. transparent by default *)
             Hint Opaque one : db.   (* except for "one" *)
@@ -688,6 +696,7 @@ Creating Hints
             Set Typeclasses Debug Verbosity 1.
 
             Goal one = 1.
+            Proof.
             Fail typeclasses eauto with db nocore.  (* fail: no match for (one = 1) *)
 
             Hint Transparent one : db.
@@ -714,6 +723,7 @@ Creating Hints
             Hint Resolve I : db.
             Print HintDb db. (*  For XXX -> indicates XXX is the head constant *)
             Goal Tru.
+            Proof.
 
          .. rocqtop:: all
 
@@ -783,6 +793,7 @@ Creating Hints
             Hint Extern 5 ({?X1 = ?X2} + {?X1 <> ?X2}) =>
               generalize  X1, X2; decide equality : eqdec.
             Goal forall a b:list (nat * nat), {a = b} + {a <> b}.
+            Proof.
             info_auto with eqdec.
 
    .. cmd:: Hint Cut [ @hints_regexp ] {? : {+ @ident } }
@@ -837,13 +848,13 @@ Creating Hints
          There is no operator precedence during parsing, one can
          check with :cmd:`Print HintDb` to verify the current cut expression.
 
-   .. cmd:: Hint Mode @qualid {+ {| + | ! | - } } {? : {+ @ident } }
+   .. cmd:: Hint Mode @qualid {+ {| + | = | ! | - } } {? : {+ @ident } }
 
       Sets an optional mode of resolution for the identifier :n:`@qualid`. When
       proof search has a goal that ends in an application of :n:`@qualid` to
       arguments :n:`@arg ... @arg`, the mode tells if the hints associated with
       :n:`@qualid` can be applied or not, depending on a criterion on the arguments.
-      A mode specification is a list of ``+``, ``!`` or ``-`` items that specify if
+      A mode specification is a list of ``+``, ``=``, ``!`` or ``-`` items that specify if
       an argument of the identifier is to be treated as an input (``+``), if its
       head only is an input (``!``) or an output (``-``) of the identifier.
       Mode ``-`` matches any term, mode ``+`` matches a
@@ -853,6 +864,16 @@ Creating Hints
       ignoring casts. For a mode declaration to match a list of arguments, each argument should
       match its corresponding mode.
 
+      Mode ``=`` poses no restrictions on the *presence* of evars in the term.
+      Instead, it disallows *all* existential variables occurring in *any*
+      argument annotated with ``=`` from being instantiated during the
+      application of the hint for *any* reason. In particular, existential
+      variables occurring in several arguments with mixed modes of which at
+      least one is ``=`` will not be instantiated during hint application. This
+      restriction only applies to the unification of the hint's conclusion with
+      the query. It does not apply to subgoals generated by a successful hint
+      application. Mode ``=`` has no effect on :cmd:`Hint Extern`\s.
+
       Only :tacn:`typeclasses eauto` uses these hints.
       :cmd:`Hint Mode` is especially useful for typeclasses, when one does not want
       to support default instances and wants to avoid ambiguity in general. Setting a parameter
diff --git a/doc/sphinx/proofs/automatic-tactics/logic.rst b/doc/sphinx/proofs/automatic-tactics/logic.rst
index 21087b97443e..bf7973440ad0 100644
--- a/doc/sphinx/proofs/automatic-tactics/logic.rst
+++ b/doc/sphinx/proofs/automatic-tactics/logic.rst
@@ -20,6 +20,7 @@ Solvers for logic and equality
       .. rocqtop:: reset all
 
          Goal forall (x:nat) (P:nat -> Prop), x = 0 \/ P x -> x <> 0 -> P x.
+         Proof.
          intros.
          tauto.
 
@@ -32,6 +33,7 @@ Solvers for logic and equality
       .. rocqtop:: reset all
 
          Goal forall (A:Prop) (P:nat -> Prop), A \/ (forall x:nat, ~ A -> P x) -> forall x:nat, ~ A -> P x.
+         Proof.
          tauto.
 
    .. note::
@@ -198,12 +200,18 @@ Solvers for logic and equality
 
       .. rocqtop:: reset all
 
-         Theorem T (A:Type) (f:A -> A) (g: A -> A -> A) a b: a=(f a) -> (g b (f a))=(f (f a)) -> (g a b)=(f (g b a)) -> (g a b)=a.
+         Theorem T (A:Type) (f:A -> A) (g: A -> A -> A) a b :
+           a = (f a) -> (g b (f a)) = (f (f a)) -> (g a b) = (f (g b a)) ->
+           (g a b) = a.
+         Proof.
          intros.
          congruence.
          Qed.
 
-         Theorem inj (A:Type) (f:A -> A * A) (a c d: A) : f = pair a -> Some (f c) = Some (f d) -> c=d.
+         Theorem inj (A:Type) (f:A -> A * A) (a c d: A) :
+           f = pair a -> Some (f c) = Some (f d) ->
+           c = d.
+         Proof.
          intros.
          congruence.
          Qed.
diff --git a/doc/sphinx/proofs/writing-proofs/equality.rst b/doc/sphinx/proofs/writing-proofs/equality.rst
index fbc03ee27eea..5d9e94b20ff4 100644
--- a/doc/sphinx/proofs/writing-proofs/equality.rst
+++ b/doc/sphinx/proofs/writing-proofs/equality.rst
@@ -202,6 +202,7 @@ Rewriting with Leibniz and setoid equality
       .. rocqtop:: out
 
          Lemma example x y : x + y = y + x.
+         Proof.
 
       .. rocqtop:: all fail
 
@@ -467,6 +468,7 @@ which reduction engine to use.  See :ref:`type-cast`.)  For example:
    .. rocqtop:: all
 
       Goal 3 + 4 = 7.
+      Proof.
       Show Proof.
       Show Existentials.
       cbv.
@@ -559,6 +561,22 @@ which reduction engine to use.  See :ref:`type-cast`.)  For example:
       affects the reduction procedure used by the kernel when
       typechecking. By default sharing is activated.
 
+   .. flag:: Kernel Conversion Dep Heuristic
+
+      This flag controls a heuristic used during conversion when comparing
+      two constants. When enabled, if the two constants have the same
+      strategy level (see :cmd:`Strategy`), the heuristic prefers unfolding
+      the constant that depends on the other.
+
+      For example, if ``c1`` depends on ``c2`` (i.e., ``c1``'s definition mentions ``c2``),
+      then checking ``c1 = c2`` or ``c2 = c1`` will prefer unfolding ``c1`` first.
+      This can significantly speed up conversions in cases where one definition
+      wraps another.
+
+      By default this flag is off, and the conversion algorithm prefers
+      unfolding the right-hand side first when the two constants have the
+      same strategy level.
+
    The call-by-value strategy is the one used in ML languages: the
    arguments of a function call are systematically weakly evaluated
    first. The lazy strategy is similar to how Haskell reduces terms.
@@ -766,6 +784,7 @@ which reduction engine to use.  See :ref:`type-cast`.)  For example:
       .. rocqtop:: all
 
          Goal ~0=0.
+         Proof.
          unfold not.
 
       This :tacn:`fold` doesn't undo the preceeding :tacn:`unfold` (it makes no change):
@@ -797,6 +816,7 @@ which reduction engine to use.  See :ref:`type-cast`.)  For example:
       .. rocqtop:: all abort
 
          Goal forall x xs, fold_right and True (x::xs).
+         Proof.
          red.
          fold (fold_right and True).
 
@@ -1114,6 +1134,7 @@ unfolding.  Rocq has multiple notions of opaque:
 
          Opaque id.
          Goal id 10 = 10.
+         Proof.
          Fail unfold id.
          with_strategy transparent [id] unfold id.
 
@@ -1158,6 +1179,7 @@ unfolding.  Rocq has multiple notions of opaque:
       .. rocqtop:: all abort
 
          Goal True.
+         Proof.
          Time assert (id (fact 8) = fact 8) by reflexivity.
          Time assert (id (fact 9) = fact 9) by reflexivity.
 
@@ -1171,6 +1193,7 @@ unfolding.  Rocq has multiple notions of opaque:
       .. rocqtop:: all
 
          Goal True.
+         Proof.
          Fail Timeout 1 assert (id (fact 100) = fact 100) by reflexivity.
          Time assert (id (fact 100) = fact 100) by with_strategy -1 [id] reflexivity.
 
@@ -1188,6 +1211,7 @@ unfolding.  Rocq has multiple notions of opaque:
       .. rocqtop:: all
 
          Goal True.
+         Proof.
          Time assert (id (fact 100) = fact 100) by with_strategy -1 [id] abstract reflexivity.
          exact I.
          Time Defined.
diff --git a/doc/sphinx/proofs/writing-proofs/proof-mode.rst b/doc/sphinx/proofs/writing-proofs/proof-mode.rst
index 9e71a4c085e9..646dbaa66bc2 100644
--- a/doc/sphinx/proofs/writing-proofs/proof-mode.rst
+++ b/doc/sphinx/proofs/writing-proofs/proof-mode.rst
@@ -69,6 +69,7 @@ local context:
 .. rocqtop:: out
 
    Goal forall n m: nat, n > m -> P 1 /\ P 2.
+   Proof.
 
 After applying the :tacn:`intros` :term:`tactic`, we see hypotheses above the line.
 The names of variables (`n` and `m`) and hypotheses (`H`) appear before a colon, followed by
@@ -270,13 +271,26 @@ When the proof is completed, you can exit proof mode with commands such as
 
 .. cmd:: Proof
 
-   Is a no-op which is useful to delimit the sequence of tactic commands
-   which start a proof, after a :cmd:`Theorem` command. It is a good practice to
+   Outside sections it is a no-op which is useful to delimit the sequence of tactic commands
+   which start a proof, e.g. after a :cmd:`Theorem` command. It is a good practice to
    use :cmd:`Proof` as an opening parenthesis, closed in the script with a
-   closing :cmd:`Qed`.
+   closing :cmd:`Qed` or :cmd:`Defined`.
+
+   In sections this command is necessary to make :opt:`Default Proof Using` work.
+
+   Some IDEs may also need the presence of this command to enable
+   asynchronous execution for an interactive proof.
 
    .. seealso:: :cmd:`Proof with`
 
+   .. warn:: This interactive proof is not started by the "Proof" command
+      :name: missing-proof-command
+
+      Some features (for instance :opt:`Default Proof Using`) may not
+      work properly when interactive proofs are not delimited by
+      :cmd:`Proof` (or :cmd:`Proof using`). This warning helps find
+      such interactive proofs.
+
 .. cmd:: Proof using @section_var_expr {? with @generic_tactic }
 
    .. insertprodn section_var_expr starred_ident_ref
@@ -284,8 +298,8 @@ When the proof is completed, you can exit proof mode with commands such as
    .. prodn::
       section_var_expr ::= {* @starred_ident_ref }
       | {? - } @section_var_expr50
-      section_var_expr50 ::= @section_var_expr50 - @section_var_expr0
-      | @section_var_expr50 + @section_var_expr0
+      section_var_expr50 ::= @section_var_expr0 - @section_var_expr0
+      | @section_var_expr0 + @section_var_expr0
       | @section_var_expr0
       section_var_expr0 ::= @starred_ident_ref
       | ()
@@ -364,6 +378,7 @@ When the proof is completed, you can exit proof mode with commands such as
 
          #[using="Hn"]
          Lemma example : 0 < n.
+         Proof.
 
       .. rocqtop:: in
 
@@ -403,6 +418,7 @@ When the proof is completed, you can exit proof mode with commands such as
          Print foo.      (* Doesn't change after the End *)
          Print foo'.     (* "End" added type radix (used by radixNotZero) and radixNotZero *)
          Goal 0 = 0.
+         Proof.
 
       .. rocqtop:: in
 
@@ -638,6 +654,7 @@ Curly braces
       .. rocqtop:: all reset
 
          Goal exists n : nat, n = n.
+         Proof.
          eexists ?[x].
          reflexivity.
          [x]: exact 0.
@@ -780,6 +797,7 @@ but a name can be given by using :n:`refine ?[@ident]`, or generated using the
 
          Set Generate Goal Names.
          Goal forall n, n + 0 = n.
+         Proof.
 
       .. rocqtop:: all
 
@@ -808,6 +826,7 @@ but a name can be given by using :n:`refine ?[@ident]`, or generated using the
       .. rocqtop:: in
 
          Goal forall n : nat, even n \/ odd n.
+         Proof.
 
       .. rocqtop:: all abort
 
@@ -825,6 +844,7 @@ but a name can be given by using :n:`refine ?[@ident]`, or generated using the
          Set Generate Goal Names.
 
          Goal forall n m : nat, n + m = m + n.
+         Proof.
          intros. induction m; simpl.
          [O]: {
            induction n.
@@ -891,6 +911,7 @@ tactic that unshelves goals by name.
       .. rocqtop:: all abort
 
          Goal exists n, n=0.
+         Proof.
          refine (ex_intro _ _ _).
          all: shelve_unifiable.
          reflexivity.
@@ -936,6 +957,7 @@ Reordering goals
       .. rocqtop:: in abort
 
          Goal P 1 /\ P 2 /\ P 3 /\ P 4 /\ P 5.
+         Proof.
          repeat split.    (*  P 1, P 2, P 3, P 4, P 5 *)
          all: cycle 2.    (*  P 3, P 4, P 5, P 1, P 2 *)
          all: cycle -3.   (* P 5, P 1, P 2, P 3, P 4 *)
@@ -954,6 +976,7 @@ Reordering goals
       .. rocqtop:: in abort
 
          Goal P 1 /\ P 2 /\ P 3 /\ P 4 /\ P 5.
+         Proof.
          repeat split.    (*   P 1, P 2, P 3, P 4, P 5 *)
          all: swap 1 3.   (*  P 3, P 2, P 1, P 4, P 5 *)
          all: swap 1 -1.  (* P 5, P 2, P 1, P 4, P 3 *)
@@ -969,6 +992,7 @@ Reordering goals
       .. rocqtop:: in abort
 
          Goal P 1 /\ P 2 /\ P 3 /\ P 4 /\ P 5.
+         Proof.
          repeat split.    (*  P 1, P 2, P 3, P 4, P 5 *)
          all: revgoals.   (* P 5, P 4, P 3, P 2, P 1 *)
 
@@ -1000,8 +1024,7 @@ Proving a subgoal as a separate lemma: abstract
       The abstract tactic, while very useful, still has some known
       limitations.  See `#9146 `_ for more
       details. We recommend caution when using it in some
-      "non-standard" contexts. In particular, ``abstract`` doesn't
-      work properly when used inside quotations ``ltac:(...)``.
+      "non-standard" contexts.
       If used as part of typeclass resolution, it may produce incorrect
       terms when in polymorphic universe mode.
 
@@ -1031,6 +1054,12 @@ Proving a subgoal as a separate lemma: abstract
          :name: Proof is not complete. (abstract)
          :undocumented:
 
+   .. flag:: Inline Abstract Subproof
+
+      Restore the pre-9.3 behavior of :tacn:`abstract` inside quotations.
+
+      .. deprecated:: 9.3
+
 .. _requestinginformation:
 
 Requesting information
@@ -1059,6 +1088,7 @@ Requesting information
         .. rocqtop:: all abort
 
            Goal exists n, n = 0.
+           Proof.
            eexists ?[n].
            Show n.
 
diff --git a/doc/sphinx/proofs/writing-proofs/reasoning-inductives.rst b/doc/sphinx/proofs/writing-proofs/reasoning-inductives.rst
index c966734c0390..5ee06812765e 100644
--- a/doc/sphinx/proofs/writing-proofs/reasoning-inductives.rst
+++ b/doc/sphinx/proofs/writing-proofs/reasoning-inductives.rst
@@ -87,7 +87,8 @@ The tactics presented here specialize :tacn:`apply` and
    .. rocqtop:: reset all
 
       Print or.  (* or, represented by \/, has two constructors, or_introl and or_intror *)
-      Goal  forall P1 P2 : Prop, P1 -> P1 \/ P2.
+      Goal forall P1 P2 : Prop, P1 -> P1 \/ P2.
+      Proof.
       constructor 1.  (* equivalent to "left" *)
       apply H.  (* success *)
 
@@ -95,7 +96,8 @@ The tactics presented here specialize :tacn:`apply` and
 
    .. rocqtop:: reset none
 
-      Goal  forall P1 P2 : Prop, P1 -> P1 \/ P2.
+      Goal forall P1 P2 : Prop, P1 -> P1 \/ P2.
+      Proof.
 
    .. rocqtop:: all
 
@@ -105,7 +107,8 @@ The tactics presented here specialize :tacn:`apply` and
 
    .. rocqtop:: reset none
 
-      Goal  forall P1 P2 : Prop, P1 -> P1 \/ P2.
+      Goal forall P1 P2 : Prop, P1 -> P1 \/ P2.
+      Proof.
 
    .. rocqtop:: all
 
@@ -210,6 +213,7 @@ analysis on inductive or coinductive objects (see :ref:`variants`).
       .. rocqtop:: reset none
 
          Goal forall m n: nat, n = n -> m + n = n + m.
+         Proof.
 
       .. rocqtop:: out
 
@@ -232,6 +236,7 @@ analysis on inductive or coinductive objects (see :ref:`variants`).
       .. rocqtop:: reset none
 
          Goal forall m n: nat, n = n -> m + n = n + m.
+         Proof.
 
       .. rocqtop:: out
 
@@ -249,6 +254,7 @@ analysis on inductive or coinductive objects (see :ref:`variants`).
       .. rocqtop:: reset none
 
          Goal forall A B: Prop, A /\ B -> True.
+         Proof.
 
       .. rocqtop:: out
 
@@ -269,6 +275,7 @@ analysis on inductive or coinductive objects (see :ref:`variants`).
       .. rocqtop:: all
 
          Goal (A -> B \/ C) -> D.
+         Proof.
          intros until 1.
          destruct H.
          Show 2.
@@ -328,6 +335,7 @@ analysis on inductive or coinductive objects (see :ref:`variants`).
       .. rocqtop:: reset all
 
          Goal forall A B C:Prop, A /\ B /\ C \/ B /\ C \/ C /\ A -> C.
+         Proof.
            intros A B C H; decompose [and or] H.
            all: assumption.
          Qed.
@@ -418,6 +426,7 @@ Induction
          Axiom P : N -> Prop.
 
          Goal forall n:nat, P n.
+         Proof.
          intros.
          Fail induction n using strong.
          change N in n.
@@ -433,6 +442,7 @@ Induction
       .. rocqtop:: reset all
 
          Lemma induction_test : forall n:nat, n = n -> n <= n.
+         Proof.
          intros n H.
          induction n.
          exact (le_n 0).
@@ -444,6 +454,7 @@ Induction
       .. rocqtop:: reset all
 
          Lemma induction_test2 : forall n m:nat, n = m -> n <= m.
+         Proof.
          intros n m H.
          induction n in m, H |- *.
          Show 2.
@@ -512,6 +523,7 @@ Induction
       .. rocqtop:: reset all
 
          Lemma lt_1_r : forall n:nat, n < 1 -> n = 0.
+         Proof.
          intros n H ; induction H.
 
       Here we did not get any information on the indexes to help fulfill
@@ -524,6 +536,7 @@ Induction
 
          Require Import Stdlib.Program.Equality.
          Lemma lt_1_r : forall n:nat, n < 1 -> n = 0.
+         Proof.
          intros n H ; dependent induction H.
 
       The subgoal is cleaned up as the tactic tries to automatically
@@ -669,6 +682,7 @@ This section describes some special purpose tactics to work with
       .. rocqtop:: reset in
 
          Goal 1 <> 2.
+         Proof.
          discriminate.
          Qed.
 
@@ -684,6 +698,7 @@ This section describes some special purpose tactics to work with
       .. rocqtop:: in
 
          Goal 1 <> 2.
+         Proof.
 
       .. rocqtop:: all
 
@@ -701,6 +716,7 @@ This section describes some special purpose tactics to work with
       .. rocqtop:: reset in
 
          Goal forall n:nat, n <> S n.
+         Proof.
          intro n.
          induction n.
 
@@ -776,6 +792,7 @@ This section describes some special purpose tactics to work with
          | cons : nat -> list -> list.
          Parameter P : list -> Prop.
          Goal forall l n, P nil -> cons n l = cons 0 nil -> P l.
+         Proof.
 
       .. rocqtop:: all
 
@@ -932,6 +949,7 @@ This section describes some special purpose tactics to work with
       .. rocqtop:: in
 
          Goal forall l:list nat, contains0 (1 :: l) -> contains0 l.
+         Proof.
 
       .. rocqtop:: all
 
@@ -1008,6 +1026,7 @@ This section describes some special purpose tactics to work with
       Variable P : nat -> nat -> Prop.
       Variable Q : forall n m:nat, Le n m -> Prop.
       Goal forall n m, Le (S n) m -> P n m.
+      Proof.
 
    .. rocqtop:: out
 
@@ -1047,6 +1066,7 @@ This section describes some special purpose tactics to work with
 
       Abort.
       Goal forall n m (H:Le (S n) m), Q (S n) m H.
+      Proof.
 
    .. rocqtop:: out
 
@@ -1130,6 +1150,7 @@ Helper tactics
 
          Goal forall (P Q : Prop) (Hp : {P} + {~P}) (Hq : {Q} + {~Q}),
              P -> ~Q -> (if Hp then true else false) = (if Hq then false else true).
+         Proof.
 
       .. rocqtop:: all extra-stdlib
 
@@ -1322,7 +1343,7 @@ When generating eliminators for a predicate `P`, if an argument is nested
 with :n:`@reference`, the `All` predicate and its theorem will be looked up with the key
 :n:`All` and :n:`AllForall`, and used to enforce `P` holds on the nested argument.
 
-   .. warn:: @reference is nested using @reference. No Lemma for @reference is registered for @ident
+   .. warn:: @reference is nested using @reference. No Lemma for @reference is registered for @ident.
       :name: register-all
 
       The `All` and `AllForall` predicate need to be defined and registered before the
@@ -1331,6 +1352,8 @@ with :n:`@reference`, the `All` predicate and its theorem will be looked up with
       If they are not registered, no induction hypothesis is created for the
       nested argument.
 
+      When the nesting is done using an inductive, it is possible to generate them using :cmd:`Scheme All`.
+
 .. cmd:: Scheme All for @reference {? over {+, @ident } }
    :name: Scheme All
 
@@ -1434,6 +1457,43 @@ with :n:`@reference`, the `All` predicate and its theorem will be looked up with
       Scheme LeftTree_ind_partial := Induction for LeftTree Sort Prop.
       About LeftTree_ind_partial.
 
+.. example:: Nesting With array
+
+   The primitive type `array` has a single parameter `A : Type`
+   which behaves like the uniform-parameter of an inductive type.
+   The All and AllForall predicates must be generated manually.
+
+   .. rocqtop:: all
+
+      Set Universe Polymorphism.
+      From Corelib Require Import PrimInt63 PrimArray ArrayAxioms.
+
+      Definition array_all@{s; +} (A : Type) (P : A -> Type@{s; _}) :
+         array A -> Type@{s; _} :=
+         fun a => forall i, P a.[i].
+
+      Definition array_all_forall@{s; +} A (P : A -> Type@{s; _}) :
+         (forall a, P a) -> forall a, array_all A P a :=
+         fun H a i => H _.
+
+   They must also be registered manually afterwards.
+
+   .. rocqtop:: all
+
+      Register Scheme array_all as All for array.
+      Register Scheme array_all_forall as AllForall for array.
+
+   Then the proper eliminators and All predicate can be generated for indutcive types nesting with array.
+
+   .. rocqtop:: all
+
+      Inductive trie A := TLeaf : trie A | TNode : A -> array (trie A) -> (trie A).
+
+      Print trie_rect.
+
+      Scheme All for trie.
+      Print trie_all.
+
 Scheme Equality, and Rewriting
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
@@ -1624,6 +1684,7 @@ Generation of inversion principles with ``Derive`` ``Inversion``
   .. rocqtop:: none
 
     Goal forall (n m : nat) (H : Le (S n) m), P n m.
+    Proof.
     intros.
 
   .. rocqtop:: all
@@ -1665,6 +1726,7 @@ example, revisiting the first example of the inversion documentation:
    Parameter P : nat -> nat -> Prop.
 
    Goal forall n m:nat, Le (S n) m -> P n m.
+   Proof.
 
    intros n m H.
 
@@ -1700,6 +1762,7 @@ as well in this case, e.g.:
 
    Parameter Q : forall (n m : nat), Le n m -> Prop.
    Goal forall n m (p : Le (S n) m), Q (S n) m p.
+   Proof.
 
 .. rocqtop:: all extra-stdlib
 
@@ -1733,6 +1796,7 @@ redo what we've done manually with dependent destruction:
 .. rocqtop:: in extra-stdlib
 
    Lemma ex : forall n m:nat, Le (S n) m -> P n m.
+   Proof.
 
 .. rocqtop:: in extra-stdlib
 
@@ -1765,6 +1829,7 @@ the following example on vectors:
 
    Goal forall n, forall v : vector (S n),
             exists v' : vector n, exists a : A, v = vcons a v'.
+   Proof.
 
 .. rocqtop:: in extra-stdlib
 
diff --git a/doc/sphinx/user-extensions/syntax-extensions.rst b/doc/sphinx/user-extensions/syntax-extensions.rst
index 782af8c1634d..ac5c8c1f5b07 100644
--- a/doc/sphinx/user-extensions/syntax-extensions.rst
+++ b/doc/sphinx/user-extensions/syntax-extensions.rst
@@ -73,7 +73,7 @@ lose their role as parameters. For example:
 
 .. rocqtop:: in
 
-   Notation "'IF' c1 'then' c2 'else' c3" := (c1 /\ c2 \/ ~ c1 /\ c3) (at level 200, right associativity).
+   Notation "'IF' c1 'then' c2 'else' c3" := (c1 /\ c2 \/ ~ c1 /\ c3) (at level 10, c3 at level 200).
 
 Symbols that start with a single quote followed by at least 2
 characters must be single quoted.  For example, the symbol `'ab` is
@@ -323,7 +323,7 @@ The second, more powerful control on printing is by using :n:`@syntax_modifier`\
 .. rocqtop:: all
 
    Notation "'If' c1 'then' c2 'else' c3" := (IF_then_else c1 c2 c3)
-   (at level 200, right associativity, format
+   (at level 10, c3 at level 200, format
    "'[v   ' 'If'  c1 '/' '[' 'then'  c2  ']' '/' '[' 'else'  c3 ']' ']'").
 
 .. rocqtop:: all
@@ -719,7 +719,7 @@ Displaying information about notations
    Prints the current reserved :ref:`keywords ` and parser tokens, one
    per line. Keywords cannot be used as identifiers.
 
-.. cmd:: Print Grammar {* @ident }
+.. cmd:: Print Grammar {? Tree } {* @ident }
 
    When no :token:`ident` is provided, shows the whole grammar
    (to be specific, the grammar reachable from :term:`sentence` parsing
@@ -739,6 +739,23 @@ Displaying information about notations
 
    This command can display any nonterminal in the grammar reachable from `vernac_control`.
 
+   With `Tree`, the factorization structure used by the parsing engine
+   is displayed. Without it, factorized rules are separated.
+
+   .. example:: Printing factorized grammar
+
+      .. rocqtop:: all
+
+         Declare Custom Entry test.
+
+         Reserved Notation "'!' x '!' y" (in custom test at level 1).
+         Reserved Notation "'!' x '?' y" (in custom test).
+
+         Print Custom Grammar test.
+         Print Custom Grammar Tree test.
+
+      With `Tree` we can see that the common prefix `"!" SELF` was factorized.
+
    Most of the grammar in the documentation was updated in 8.12 to make it accurate and
    readable.  This was done using a new developer tool that extracts the grammar from the
    source code, edits it and inserts it into the documentation files.  While the
@@ -877,7 +894,7 @@ Here is the basic example of a notation using a binder:
 .. rocqtop:: in
 
    Notation "'sigma' x : A , B" := (sigT (fun x : A => B))
-     (at level 200, x name, A at level 200, right associativity).
+     (at level 10, x name, A, B at level 200).
 
 The binding variables in the right-hand side that occur as a parameter
 of the notation (here :g:`x`) dynamically bind all the occurrences
@@ -905,7 +922,7 @@ binder. Here is an example:
 .. rocqtop:: in reset
 
    Notation "'subset' ' p , P " := (sig (fun p => P))
-     (at level 200, p pattern, format "'subset'  ' p ,  P").
+     (at level 10, p pattern, P at level 200, format "'subset'  ' p ,  P").
 
 .. rocqtop:: all
 
@@ -928,9 +945,9 @@ variable. Here is an example showing the difference:
 .. rocqtop:: in
 
    Notation "'subset_bis' ' p , P" := (sig (fun p => P))
-     (at level 200, p strict pattern).
+     (at level 10, P at level 200, p strict pattern).
    Notation "'subset_bis' p , P " := (sig (fun p => P))
-     (at level 200, p name).
+     (at level 10, P at level 200, p name).
 
 .. rocqtop:: all
 
@@ -1020,7 +1037,7 @@ notation
 
 .. rocqtop:: in
 
-   Notation "'exists_different' n" := (exists p:nat, p<>n) (at level 200).
+   Notation "'exists_different' n" := (exists p:nat, p<>n) (at level 10, n at level 200).
 
 the next command fails because p does not bind in the instance of n.
 
@@ -1148,7 +1165,7 @@ is:
 
    Notation "'exists' x .. y , p" :=
      (ex (fun x => .. (ex (fun y => p)) ..))
-     (at level 200, x binder, y binder, right associativity).
+     (at level 10, x binder, y binder, p at level 200).
 
 The principle is the same as in :ref:`RecursiveNotations`
 except that in the iterator
@@ -1181,7 +1198,7 @@ example of recursive notation with closed binders:
 
    Notation "'mylet' f x .. y :=  t 'in' u":=
      (let f := fun x => .. (fun y => t) .. in u)
-     (at level 200, x closed binder, y closed binder, right associativity).
+     (at level 10, x closed binder, y closed binder, u at level 200).
 
 A recursive pattern for binders can be used in position of a recursive
 pattern for terms. Here is an example:
@@ -1190,7 +1207,7 @@ pattern for terms. Here is an example:
 
    Notation "'FUNAPP' x .. y , f" :=
      (fun x => .. (fun y => (.. (f x) ..) y ) ..)
-     (at level 200, x binder, y binder, right associativity).
+     (at level 10, x binder, y binder, f at level 200).
 
 If an occurrence of the :math:`[~]_E` is not in position of a binding
 variable but of a term, it is the name used in the binding which is
@@ -1200,7 +1217,7 @@ used. Here is an example:
 
    Notation "'exists_non_null' x .. y  , P" :=
      (ex (fun x => x <> 0 /\ .. (ex (fun y => y <> 0 /\ P)) ..))
-     (at level 200, x binder).
+     (at level 10, x binder, P at level 200).
 
 Predefined entries
 ~~~~~~~~~~~~~~~~~~
@@ -1415,7 +1432,7 @@ Similarly, to indicate that a custom entry should parse global references
 
    Notation "x" := x (in custom expr at level 0, x global).
 
-.. cmd:: Print Custom Grammar @qualid
+.. cmd:: Print Custom Grammar {? Tree } @qualid
 
    This displays the state of the grammar for terms associated with
    the custom entry :token:`ident`.
diff --git a/doc/sphinx/using/libraries/funind.rst b/doc/sphinx/using/libraries/funind.rst
index 7188916aad77..c9924555ef6c 100644
--- a/doc/sphinx/using/libraries/funind.rst
+++ b/doc/sphinx/using/libraries/funind.rst
@@ -209,6 +209,7 @@ Tactics
          Functional Scheme minus_ind := Induction for minus Sort Prop.
          Check minus_ind.
          Lemma le_minus (n m:nat) : n - m <= n.
+         Proof.
          functional induction (minus n m) using minus_ind; simpl; auto.
          Qed.
 
@@ -328,6 +329,7 @@ Generation of induction principles with ``Functional`` ``Scheme``
   .. rocqtop:: all extra-stdlib
 
     Lemma div2_le' : forall n:nat, div2 n <= n.
+    Proof.
     intro n.
     pattern n, (div2 n).
     apply div2_ind; intros.
@@ -344,6 +346,7 @@ Generation of induction principles with ``Functional`` ``Scheme``
     Reset div2_le'.
 
     Lemma div2_le : forall n:nat, div2 n <= n.
+    Proof.
     intro n.
     functional induction (div2 n).
     auto with arith.
diff --git a/doc/sphinx/using/tools/coqdoc.rst b/doc/sphinx/using/tools/coqdoc.rst
index 118becb57596..04a973f41326 100644
--- a/doc/sphinx/using/tools/coqdoc.rst
+++ b/doc/sphinx/using/tools/coqdoc.rst
@@ -302,6 +302,9 @@ suffixes ``.v`` and ``.g`` and |Latex| files by the suffix ``.tex``.
   files given on the command line are copied ‘as is’ in the final
   document . DVI and PostScript can be produced directly with the
   options ``-dvi`` and ``-ps`` respectively.
+:Alectryon output: This option creates a single Markdown file on standard output
+                   that can be understood by Alectryon. Use the option ``-o`` to
+                   redirect the output to a file.
 :TEXmacs output: To translate the input files to TEXmacs format,
   to be used by the TEXmacs Rocq interface.
 
@@ -318,6 +321,7 @@ Command line options
   :--|Latex|: Select a |Latex| output.
   :--dvi: Select a DVI output.
   :--ps: Select a PostScript output.
+  :--alectryon: Select a Markdown output for Alectryon.
   :--texmacs: Select a TEXmacs output.
   :--stdout: Write output to stdout.
   :-o file, --output file: Redirect the output into the file ‘file’
diff --git a/doc/tools/docgram/common.edit_mlg b/doc/tools/docgram/common.edit_mlg
index 81582ae83fa7..8ab6b9c2165e 100644
--- a/doc/tools/docgram/common.edit_mlg
+++ b/doc/tools/docgram/common.edit_mlg
@@ -259,7 +259,7 @@ term_forall_or_fun: [
 | "forall" open_binders "," type
 ]
 
-binder_constr: [
+term10: [
 | DELETE "forall" open_binders "," term200
 | MOVETO term_forall_or_fun "fun" open_binders "=>" term200
 | MOVETO term_let "let" name binders let_type_cstr ":=" term200 "in" term200
@@ -267,9 +267,7 @@ binder_constr: [
 | MOVETO term_fix "let" "fix" fix_decl "in" term200
 | MOVETO term_cofix "let" "cofix" cofix_body "in" term200
 | MOVETO term_let "let" [ "(" LIST0 name SEP "," ")" | "()" ] as_return_type ":=" term200 "in" term200
-| MOVETO term_let "let" "'" pattern200 ":=" term200 "in" term200
-| MOVETO term_let "let" "'" pattern200 ":=" term200 case_type "in" term200
-| MOVETO term_let "let" "'" pattern200 "in" pattern200 ":=" term200 case_type "in" term200
+| MOVETO term_let "let" "'" pattern200 OPT [ "in" pattern200 ] ":=" term200 OPT case_type "in" term200
 | MOVETO term_fix "fix" fix_decls
 | MOVETO term_cofix "cofix" cofix_decls
 ]
@@ -282,11 +280,7 @@ term_let: [
 | REPLACE "let" [ "(" LIST0 name SEP "," ")" | "()" ] as_return_type ":=" term200 "in" term200
 | WITH "let" "(" LIST0 name SEP "," ")" as_return_type ":=" term200 "in" term200
 | MOVETO destructuring_let "let" "(" LIST0 name SEP "," ")" as_return_type ":=" term200 "in" term200
-| REPLACE "let" "'" pattern200 ":=" term200 "in" term200
-| WITH "let" "'" pattern200 ":=" term200 OPT case_type "in" term200
-| DELETE "let" "'" pattern200 ":=" term200 case_type "in" term200
-| MOVETO destructuring_let "let" "'" pattern200 ":=" term200 OPT case_type "in" term200
-| MOVETO destructuring_let "let" "'" pattern200 "in" pattern200 ":=" term200 case_type "in" term200
+| MOVETO destructuring_let "let" "'" pattern200 OPT [ "in" pattern200 ] ":=" term200 OPT case_type "in" term200
 ]
 
 qualid_annotated: [
@@ -343,18 +337,18 @@ sort: [
 ]
 
 term100: [
-| REPLACE term100 "<:" term200
-| WITH term100 "<:" type
-| MOVETO term_cast term100 "<:" type
-| REPLACE term100 "<<:" term200
-| WITH term100 "<<:" type
-| MOVETO term_cast term100 "<<:" type
-| REPLACE term100 ":>" term200
-| WITH term100 ":>" type
-| MOVETO term_cast term100 ":>" type
-| REPLACE term100 ":" term200
-| WITH term100 ":" type
-| MOVETO term_cast term100 ":" type
+| REPLACE term99 "<:" term200
+| WITH term99 "<:" type
+| MOVETO term_cast term99 "<:" type
+| REPLACE term99 "<<:" term200
+| WITH term99 "<<:" type
+| MOVETO term_cast term99 "<<:" type
+| REPLACE term99 ":>" term200
+| WITH term99 ":>" type
+| MOVETO term_cast term99 ":>" type
+| REPLACE term99 ":" term200
+| WITH term99 ":" type
+| MOVETO term_cast term99 ":" type
 ]
 
 constr: [
@@ -957,6 +951,10 @@ simple_occurrences: [
 (* placeholder (yuck) *)
 ]
 
+SPLICE: [
+| memory_unit
+]
+
 simple_tactic: [
 | REPLACE "assert" "(" identref ":" lconstr ")" by_tactic
 | WITH "assert" "(" identref ":" type ")" by_tactic
@@ -1116,9 +1114,9 @@ simple_tactic: [
 | DELETE "setoid_symmetry"
 | REPLACE "setoid_symmetry" "in" hyp
 | WITH "setoid_symmetry" OPT ( "in" hyp )
-| REPLACE "rewrite_strat" rewstrategy "in" hyp
-| WITH "rewrite_strat" rewstrategy OPT ( "in" hyp )
-| DELETE "rewrite_strat" rewstrategy
+| REPLACE "rewrite_strat" rewstrategy2 "in" hyp
+| WITH "rewrite_strat" rewstrategy2 OPT ( "in" hyp )
+| DELETE "rewrite_strat" rewstrategy2
 | REPLACE "protect_fv" string "in" ident
 | WITH "protect_fv" string OPT ( "in" ident )
 | DELETE "protect_fv" string
@@ -1222,7 +1220,7 @@ printable: [
 | WITH "Visibility" OPT scope_name
 | REPLACE [ "Sorted" | ] "Universes" OPT printunivs_subgraph OPT [ [ "With" | "Without" ] "Constraint" "Sources" ] OPT ne_string
 | WITH OPT "Sorted" "Universes" OPT printunivs_subgraph OPT [ [ "With" | "Without" ] "Constraint" "Sources" ] OPT ne_string
-| DELETE "Term" smart_global OPT univ_name_list  (* readded in commands *)
+| DELETE "Term" LIST1 [ smart_global OPT univ_name_list ] SEP ","  (* readded in commands *)
 | REPLACE "Hint"
 | WITH "Hint" OPT [ "*" | smart_global ]
 | DELETE "Hint" smart_global
@@ -1363,8 +1361,8 @@ command: [
 (* show the locate options as separate commands *)
 | DELETE "Locate" locatable
 | locatable
-| REPLACE "Print" smart_global OPT univ_name_list
-| WITH "Print" OPT "Term" smart_global OPT univ_name_list
+| REPLACE "Print" LIST1 [ smart_global OPT univ_name_list ] SEP ","
+| WITH "Print" OPT "Term" LIST1 [ smart_global OPT univ_name_list ] SEP ","
 
 | REPLACE "Declare" "Scope" IDENT
 | WITH "Declare" "Scope" scope_name
@@ -1463,8 +1461,8 @@ assumpt: [
 ]
 
 constructor_type: [
-| REPLACE binders [ of_type_inst lconstr | ]
-| WITH binders OPT of_type_inst
+| REPLACE constructor_binders [ of_type_inst lconstr | ]
+| WITH constructor_binders OPT of_type_inst
 ]
 
 (* todo: is this really correct? Search for "Pvernac.register_proof_mode" *)
@@ -1536,8 +1534,8 @@ query_command: [
 | WITH "Compute" lconstr
 | REPLACE "Check" lconstr "."
 | WITH "Check" lconstr
-| REPLACE "About" smart_global OPT univ_name_list "."
-| WITH "About" smart_global OPT univ_name_list
+| REPLACE "About" LIST1 [ smart_global OPT univ_name_list ] SEP "," "."
+| WITH "About" LIST1 [ smart_global OPT univ_name_list ] SEP ","
 | REPLACE "SearchPattern" constr_pattern in_or_out_modules "."
 | WITH "SearchPattern" constr_pattern in_or_out_modules
 | REPLACE "SearchRewrite" constr_pattern in_or_out_modules "."
@@ -1580,6 +1578,8 @@ control_flag: [
 | WITH "Redirect" ne_string sentence
 | REPLACE "Timeout" natural
 | WITH "Timeout" natural sentence
+| REPLACE "AllocLimit" natural [ "Mw" | "kw" ]
+| WITH "AllocLimit" natural [ "Mw" | "kw" ] sentence
 | REPLACE "Fail"
 | WITH "Fail" sentence
 | REPLACE "Succeed"
@@ -2005,8 +2005,8 @@ SPLICE: [
 ]
 
 ltac2_expr3: [
-| REPLACE ltac2_expr3 "," LIST1 ltac2_expr2 SEP ","      (* Ltac2 plugin *)
-| WITH LIST1 ltac2_expr3 SEP "," TAG Ltac2
+| REPLACE ltac2_expr2 "," LIST1 ltac2_expr2 SEP ","      (* Ltac2 plugin *)
+| WITH LIST1 ltac2_expr2 SEP "," TAG Ltac2
 | DELETE ltac2_expr2      (* Ltac2 plugin *)
 ]
 
@@ -2093,11 +2093,15 @@ SPLICE: [
 ltac2_expr5: [
 | REPLACE "let" OPT "rec" LIST1 ltac2_let_clause SEP "with" "in" ltac2_expr6      (* Ltac2 plugin *)
 | WITH "let" OPT "rec" ltac2_let_clause LIST0 ( "with" ltac2_let_clause ) "in" ltac2_expr6 TAG Ltac2
-| MOVETO simple_tactic "match" ltac2_expr5 "with" ltac2_branches "end"      (* Ltac2 plugin *)
 | MOVETO simple_tactic "if" ltac2_expr5 "then" ltac2_expr5 "else" ltac2_expr5      (* Ltac2 plugin *)
 | DELETE simple_tactic
 ]
 
+ltac2_expr0: [
+| MOVETO simple_tactic "match" ltac2_expr5 "with" ltac2_branches "end"      (* Ltac2 plugin *)
+| DELETE simple_tactic
+]
+
 ltac2_quotations: [
 
 ]
@@ -2261,14 +2265,7 @@ as_or_and_ipat: [
 | "as" or_and_intropattern
 ]
 
-ne_rewstrategy1_list_sep_semicolon: [
-| DELETE rewstrategy1
-| REPLACE ne_rewstrategy1_list_sep_semicolon ";" rewstrategy1
-| WITH LIST1 rewstrategy1 SEP ";"
-]
-
 SPLICE: [
-| ne_rewstrategy1_list_sep_semicolon
 | clause
 | noedit_mode
 | match_list
@@ -2287,7 +2284,6 @@ SPLICE: [
 | ltac_selector
 | Constr.ident
 | attribute_list
-| term99
 | term90
 | term9
 | term8
@@ -2306,6 +2302,7 @@ SPLICE: [
 | preident
 | lpar_id_coloneq
 | binders
+| constructor_binders
 | check_module_types
 | decl_sep
 | function_fix_definition (* loses funind annotation *)
@@ -2327,7 +2324,6 @@ SPLICE: [
 | ext_module_expr
 | ext_module_type
 | test
-| binder_constr
 | atomic_constr
 | let_type_cstr
 | name_colon
@@ -2428,7 +2424,7 @@ SPLICE: [
 | tac2rec_fields
 | mut_flag
 | tac2rec_fieldexprs
-| syn_level
+| syn_target
 | firstorder_rhs
 | firstorder_using
 | ref_or_pattern_occ
diff --git a/doc/tools/docgram/doc_grammar.ml b/doc/tools/docgram/doc_grammar.ml
index e576ef41bc06..5a8da11616c0 100644
--- a/doc/tools/docgram/doc_grammar.ml
+++ b/doc/tools/docgram/doc_grammar.ml
@@ -35,7 +35,6 @@ type args = {
   check_tacs : bool;
   check_cmds : bool;
   update: bool;
-  show_warn : bool;
   verbose : bool;
   verify : bool;
 }
@@ -47,7 +46,6 @@ let default_args = {
   check_tacs = false;
   check_cmds = false;
   update = true;
-  show_warn = true;
   verbose = false;
   verify = false;
 }
@@ -482,8 +480,8 @@ let add_symdef nt file symdef_map =
   in
   symdef_map := StringMap.add nt (Filename.basename file::ent) !symdef_map
 
-let rec edit_SELF nt cur_level next_level right_assoc inner prod =
-  let subedit sym = List.hd (edit_SELF nt cur_level next_level right_assoc true [sym]) in
+let rec edit_SELF nt cur_level next_level left_assoc right_assoc inner prod =
+  let subedit sym = List.hd (edit_SELF nt cur_level next_level left_assoc right_assoc true [sym]) in
   let len = List.length prod in
   List.mapi (fun i sym ->
     match sym with
@@ -493,7 +491,7 @@ let rec edit_SELF nt cur_level next_level right_assoc inner prod =
       if inner then
         Snterm nt (* first level *)
       else if i = 0 then
-        Snterm cur_level
+        (if left_assoc then Snterm cur_level else Snterm next_level)
       else if i + 1 = len then
         (if right_assoc then Snterm cur_level else Snterm next_level)
       else
@@ -507,7 +505,7 @@ let rec edit_SELF nt cur_level next_level right_assoc inner prod =
     | Slist0sep (sym, sep) -> Slist0sep ((subedit sym), (subedit sep))
     | Sopt sym -> Sopt (subedit sym)
     | Sparen syms -> Sparen (List.map (fun sym -> subedit sym) syms)
-    | Sprod prods -> Sprod (List.map (fun prod -> edit_SELF nt cur_level next_level right_assoc true prod) prods)
+    | Sprod prods -> Sprod (List.map (fun prod -> edit_SELF nt cur_level next_level left_assoc right_assoc true prod) prods)
     | Sedit _ -> sym
     | Sedit2 _ -> sym)
   prod
@@ -614,7 +612,13 @@ let read_mlg g is_edit ast file level_renames symdef_map =
               let cur_level = nt ^ level in
               let next_level = nt ^
                   if i+1 < len then (get_label (List.nth rules (i+1)).grule_label) else "" in
-              let right_assoc = (rule.grule_assoc = Some RightA) in
+              let (left_assoc, right_assoc) =
+                match rule.grule_assoc with
+                | Some NonA | None -> (false, false)
+                | Some LeftA -> (true, false)
+                | Some RightA -> (false, true)
+                | Some BothA -> (true, true)
+              in
 
               if i = 0 && cur_level <> nt && not (StringMap.mem nt !level_renames) then begin
                 level_renames := StringMap.add nt cur_level !level_renames;
@@ -622,7 +626,7 @@ let read_mlg g is_edit ast file level_renames symdef_map =
               let cvted = List.map cvt_gram_prod rule.grule_prods in
               (* edit names for levels *)
               (* See https://camlp5.github.io/doc/html/grammars.html#b:Associativity *)
-              let edited = List.map (fun (loc,prod) -> loc, edit_SELF nt cur_level next_level right_assoc false prod) cvted in
+              let edited = List.map (fun (loc,prod) -> loc, edit_SELF nt cur_level next_level left_assoc right_assoc false prod) cvted in
               let prods_to_add =
                 if cur_level <> nt && i+1 < len then
                   edited @ [None,[Snterm next_level]]
@@ -1817,7 +1821,7 @@ let parse_args () =
         match arg with
         | "-check-cmds" -> { args with check_cmds = true }
         | "-check-tacs" -> { args with check_tacs = true }
-        | "-no-warn" -> show_warn := false; { args with show_warn = false }
+        | "-no-warn" -> show_warn := false; args
         | "-no-update" -> { args with update = false }
         | "-short" -> { args with fullGrammar = true }
         | "-verbose" -> { args with verbose = true }
diff --git a/doc/tools/docgram/fullGrammar b/doc/tools/docgram/fullGrammar
index 4c37484d9caa..dd4fdea97af4 100644
--- a/doc/tools/docgram/fullGrammar
+++ b/doc/tools/docgram/fullGrammar
@@ -82,10 +82,10 @@ term200: [
 ]
 
 term100: [
-| term100 "<:" term200
-| term100 "<<:" term200
-| term100 ":>" term200
-| term100 ":" term200
+| term99 "<:" term200
+| term99 "<<:" term200
+| term99 ":>" term200
+| term99 ":" term200
 | term99
 ]
 
@@ -101,7 +101,16 @@ term10: [
 | term10 LIST1 arg
 | "@" global univ_annot LIST0 term9
 | "@" pattern_ident LIST1 identref
-| binder_constr
+| "forall" open_binders "," term200
+| "fun" open_binders "=>" term200
+| "let" name binders let_type_cstr ":=" term200 "in" term200
+| "let" "fix" fix_decl "in" term200
+| "let" "cofix" cofix_body "in" term200
+| "let" [ "(" LIST0 name SEP "," ")" | "()" ] as_return_type ":=" term200 "in" term200
+| "let" "'" pattern200 OPT [ "in" pattern200 ] ":=" term200 OPT case_type "in" term200
+| "if" term200 as_return_type "then" term200 "else" term200
+| "fix" fix_decls
+| "cofix" cofix_decls
 | term9
 ]
 
@@ -154,21 +163,6 @@ field_def: [
 | global binders ":=" lconstr
 ]
 
-binder_constr: [
-| "forall" open_binders "," term200
-| "fun" open_binders "=>" term200
-| "let" name binders let_type_cstr ":=" term200 "in" term200
-| "let" "fix" fix_decl "in" term200
-| "let" "cofix" cofix_body "in" term200
-| "let" [ "(" LIST0 name SEP "," ")" | "()" ] as_return_type ":=" term200 "in" term200
-| "let" "'" pattern200 ":=" term200 "in" term200
-| "let" "'" pattern200 ":=" term200 case_type "in" term200
-| "let" "'" pattern200 "in" pattern200 ":=" term200 case_type "in" term200
-| "if" term200 as_return_type "then" term200 "else" term200
-| "fix" fix_decls
-| "cofix" cofix_decls
-]
-
 arg: [
 | test_lpar_id_coloneq "(" identref ":=" lconstr ")"
 | test_lpar_nat_coloneq "(" natural ":=" lconstr ")"
@@ -268,7 +262,7 @@ pattern200: [
 ]
 
 pattern100: [
-| pattern100 ":" term200
+| pattern99 ":" term200
 | pattern99
 ]
 
@@ -350,6 +344,7 @@ closed_binder: [
 | "`{" LIST1 typeclass_constraint SEP "," "}"
 | "`[" LIST1 typeclass_constraint SEP "," "]"
 | "'" pattern0
+| "&" term99
 ]
 
 one_open_binder: [
@@ -557,7 +552,7 @@ command: [
 | "Locate" locatable
 | "Type" lconstr
 | "Print" printable
-| "Print" smart_global OPT univ_name_list
+| "Print" LIST1 [ smart_global OPT univ_name_list ] SEP ","
 | "Print" "Module" "Type" global
 | "Print" "Module" global
 | "Print" "Namespace" dirpath
@@ -712,6 +707,9 @@ command: [
 | "Ltac2" "Custom" "Entry" identref      (* ltac2 plugin *)
 | "Ltac2" "Notation" ltac2def_syn      (* ltac2 plugin *)
 | "Ltac2" "Abbreviation" ltac2abbrev_syn      (* ltac2 plugin *)
+| "Ltac2" "Declare" "Scope" ident      (* ltac2 plugin *)
+| "Ltac2" "Open" "Scope" reference      (* ltac2 plugin *)
+| "Ltac2" "Close" "Scope" reference      (* ltac2 plugin *)
 | "Ltac2" "Eval" ltac2_expr6      (* ltac2 plugin *)
 | "Print" test_ltac2_ident "Ltac2" reference      (* ltac2 plugin *)
 | "Print" "Ltac2" "Type" reference      (* ltac2 plugin *)
@@ -746,7 +744,7 @@ hint: [
 ]
 
 mode: [
-| LIST1 [ "+" | "!" | "-" ]
+| LIST1 [ "+" | "=" | "!" | "-" ]
 ]
 
 int_or_var: [
@@ -830,6 +828,7 @@ control_flag: [
 | "Profile" OPT STRING
 | "Redirect" ne_string
 | "Timeout" natural
+| "AllocLimit" natural [ "Mw" | "kw" ]
 | "Fail"
 | "Succeed"
 ]
@@ -1137,8 +1136,12 @@ assumpt: [
 | LIST1 ident_decl of_type lconstr
 ]
 
+constructor_binders: [
+| binders OPT [ "of" LIST1 term99 SEP "&" ]
+]
+
 constructor_type: [
-| binders [ of_type_inst lconstr | ]
+| constructor_binders [ of_type_inst lconstr | ]
 ]
 
 constructor: [
@@ -1305,8 +1308,8 @@ ssexpr35: [
 ]
 
 ssexpr50: [
-| ssexpr50 "-" ssexpr0
-| ssexpr50 "+" ssexpr0
+| ssexpr0 "-" ssexpr0
+| ssexpr0 "+" ssexpr0
 | ssexpr0
 ]
 
@@ -1401,18 +1404,18 @@ query_command: [
 | "Eval" red_expr "in" lconstr "."
 | "Compute" lconstr "."
 | "Check" lconstr "."
-| "About" smart_global OPT univ_name_list "."
+| "About" LIST1 [ smart_global OPT univ_name_list ] SEP "," "."
 | "SearchPattern" constr_pattern in_or_out_modules "."
 | "SearchRewrite" constr_pattern in_or_out_modules "."
 | "Search" search_query search_queries "."
 ]
 
 printable: [
-| "Term" smart_global OPT univ_name_list
+| "Term" LIST1 [ smart_global OPT univ_name_list ] SEP ","
 | "All"
 | "Section" global
-| "Grammar" LIST0 IDENT
-| "Custom" "Grammar" qualid
+| "Grammar" OPT "Tree" LIST0 IDENT
+| "Custom" "Grammar" OPT "Tree" qualid
 | "Keywords"
 | "LoadPath" OPT dirpath
 | "Libraries"
@@ -1421,6 +1424,7 @@ printable: [
 | "ML" "Path"
 | "ML" "Modules"
 | "Debug" "GC"
+| "Debug" "Delta" OPT qualid
 | "Graph"
 | "Classes"
 | "Typeclasses"
@@ -1560,7 +1564,7 @@ search_queries: [
 ]
 
 univ_name_list: [
-| "@{" LIST0 name "}"
+| "@{" LIST0 name OPT [ ";" LIST0 name ] "}"
 ]
 
 syntax: [
@@ -1822,6 +1826,7 @@ simple_tactic: [
 | "is_evar" constr
 | "has_evar" constr
 | "is_var" constr
+| "is_section_var" constr
 | "is_fix" constr
 | "is_cofix" constr
 | "is_ind" constr
@@ -1838,6 +1843,7 @@ simple_tactic: [
 | "guard" test
 | "decompose" "[" LIST1 constr "]" constr
 | "optimize_heap"
+| "alloc_limit" natural memory_unit tactic
 | "with_strategy" strategy_level_or_var "[" LIST1 smart_global "]" tactic3
 | "eassumption"
 | "eexact" constr
@@ -1869,8 +1875,8 @@ simple_tactic: [
 | "autoapply" constr "with" preident
 | "decide" "equality"
 | "compare" constr constr
-| "rewrite_strat" rewstrategy "in" hyp
-| "rewrite_strat" rewstrategy
+| "rewrite_strat" rewstrategy2 "in" hyp
+| "rewrite_strat" rewstrategy2
 | "rewrite_db" preident "in" hyp
 | "rewrite_db" preident
 | "substitute" orient glob_constr_with_bindings
@@ -2110,6 +2116,11 @@ test: [
 | int_or_var comparison int_or_var
 ]
 
+memory_unit: [
+| "Mw"
+| "kw"
+]
+
 hintbases: [
 | "with" "*"
 | "with" LIST1 preident
@@ -2204,9 +2215,9 @@ ltac_expr3: [
 ]
 
 ltac_expr2: [
-| ltac_expr2 "+" ltac_expr2
+| ltac_expr1l "+" ltac_expr2
 | "tryif" ltac_expr5 "then" ltac_expr5 "else" ltac_expr2
-| ltac_expr2 "||" ltac_expr2
+| ltac_expr1l "||" ltac_expr2
 | ltac_expr1l
 ]
 
@@ -2383,12 +2394,11 @@ glob_constr_with_bindings: [
 ]
 
 rewstrategy: [
-| "fix" identref ":=" rewstrategy1
-| ne_rewstrategy1_list_sep_semicolon
 ]
 
-ne_rewstrategy1_list_sep_semicolon: [
-| ne_rewstrategy1_list_sep_semicolon ";" rewstrategy1
+rewstrategy2: [
+| "fix" identref ":=" rewstrategy1
+| LIST1 rewstrategy1 SEP ";"
 | rewstrategy1
 ]
 
@@ -2410,6 +2420,8 @@ rewstrategy1: [
 | "terms" LIST0 constr
 | "eval" red_expr
 | "fold" constr
+| "matches" constr
+| "tactic" tactic
 | rewstrategy0
 ]
 
@@ -2418,7 +2430,7 @@ rewstrategy0: [
 | "id"
 | "fail"
 | "refl"
-| "(" rewstrategy ")"
+| "(" rewstrategy2 ")"
 ]
 
 id_or_meta: [
@@ -2702,7 +2714,7 @@ tac2pat3: [
 ]
 
 tac2pat2: [
-| tac2pat2 "::" tac2pat2      (* ltac2 plugin *)
+| tac2pat1 "::" tac2pat2      (* ltac2 plugin *)
 | tac2pat1      (* ltac2 plugin *)
 ]
 
@@ -2731,14 +2743,13 @@ atomic_tac2pat: [
 ]
 
 ltac2_expr6: [
-| ltac2_expr6 ";" ltac2_expr6      (* ltac2 plugin *)
+| ltac2_expr5 ";" ltac2_expr6      (* ltac2 plugin *)
 | ltac2_expr5      (* ltac2 plugin *)
 ]
 
 ltac2_expr5: [
 | "fun" LIST1 G_LTAC2_input_fun type_cast "=>" ltac2_expr6      (* ltac2 plugin *)
 | "let" rec_flag LIST1 G_LTAC2_let_clause SEP "with" "in" ltac2_expr6      (* ltac2 plugin *)
-| "match" ltac2_expr5 "with" G_LTAC2_branches "end"      (* ltac2 plugin *)
 | "if" ltac2_expr5 "then" ltac2_expr5 "else" ltac2_expr5      (* ltac2 plugin *)
 | ltac2_expr4      (* ltac2 plugin *)
 ]
@@ -2748,12 +2759,12 @@ ltac2_expr4: [
 ]
 
 ltac2_expr3: [
-| ltac2_expr3 "," LIST1 ltac2_expr2 SEP ","      (* ltac2 plugin *)
+| ltac2_expr2 "," LIST1 ltac2_expr2 SEP ","      (* ltac2 plugin *)
 | ltac2_expr2      (* ltac2 plugin *)
 ]
 
 ltac2_expr2: [
-| ltac2_expr2 "::" ltac2_expr2      (* ltac2 plugin *)
+| ltac2_expr1 "::" ltac2_expr2      (* ltac2 plugin *)
 | ltac2_expr1      (* ltac2 plugin *)
 ]
 
@@ -2773,6 +2784,7 @@ ltac2_expr0: [
 | list_literal      (* ltac2 plugin *)
 | "{" test_qualid_with_or_lpar_or_rbrac ltac2_expr0 "with" tac2rec_fieldexprs "}"      (* ltac2 plugin *)
 | "{" tac2rec_fieldexprs "}"      (* ltac2 plugin *)
+| "match" ltac2_expr5 "with" G_LTAC2_branches "end"      (* ltac2 plugin *)
 | ltac2_atom      (* ltac2 plugin *)
 ]
 
@@ -2844,12 +2856,12 @@ let_binder: [
 ]
 
 ltac2_type5: [
-| ltac2_type5 "->" ltac2_type5      (* ltac2 plugin *)
+| ltac2_type2 "->" ltac2_type5      (* ltac2 plugin *)
 | ltac2_type2      (* ltac2 plugin *)
 ]
 
 ltac2_type2: [
-| ltac2_type2 "*" LIST1 ltac2_type1 SEP "*"      (* ltac2 plugin *)
+| ltac2_type1 "*" LIST1 ltac2_type1 SEP "*"      (* ltac2 plugin *)
 | ltac2_type1      (* ltac2 plugin *)
 ]
 
@@ -2972,14 +2984,14 @@ ltac2_syntax_class: [
 | syn_node "(" LIST1 ltac2_syntax_class SEP "," ")"      (* ltac2 plugin *)
 ]
 
-syn_level: [
+syn_target: [
 |      (* ltac2 plugin *)
 | ":" Prim.natural      (* ltac2 plugin *)
 | ":" qualid OPT [ "(" Prim.natural ")" ]      (* ltac2 plugin *)
 ]
 
 tac2def_syn: [
-| LIST1 ltac2_syntax_class syn_level ":=" ltac2_expr6      (* ltac2 plugin *)
+| LIST1 ltac2_syntax_class syn_target OPT [ "%" qualid ] ":=" ltac2_expr6      (* ltac2 plugin *)
 ]
 
 tac2abbrev_syn: [
diff --git a/doc/tools/docgram/orderedGrammar b/doc/tools/docgram/orderedGrammar
index 5b2ea3b8bdf6..bf3fca66453f 100644
--- a/doc/tools/docgram/orderedGrammar
+++ b/doc/tools/docgram/orderedGrammar
@@ -9,6 +9,10 @@ term: [
 
 term100: [
 | term_cast
+| term99
+]
+
+term99: [
 | term10
 ]
 
@@ -375,8 +379,7 @@ term_let: [
 
 destructuring_let: [
 | "let" "(" LIST0 name SEP "," ")" OPT [ OPT [ "as" name ] "return" term100 ] ":=" term "in" term
-| "let" "'" pattern ":=" term OPT ( "return" term100 ) "in" term
-| "let" "'" pattern "in" pattern ":=" term "return" term100 "in" term
+| "let" "'" pattern OPT [ "in" pattern ] ":=" term OPT ( "return" term100 ) "in" term
 ]
 
 term_forall_or_fun: [
@@ -402,6 +405,7 @@ binder: [
 | generalizing_binder
 | "(" name ":" type "|" term ")"
 | "'" pattern0
+| "&" term99
 ]
 
 implicit_binders: [
@@ -427,10 +431,10 @@ term_generalizing: [
 ]
 
 term_cast: [
-| term100 "<:" type
-| term100 "<<:" type
-| term100 ":>" type
-| term100 ":" type
+| term99 "<:" type
+| term99 "<<:" type
+| term99 ":>" type
+| term99 ":" type
 ]
 
 term_match: [
@@ -446,7 +450,7 @@ eqn: [
 ]
 
 pattern: [
-| pattern ":" term
+| pattern10 ":" term
 | pattern10
 ]
 
@@ -569,7 +573,7 @@ inductive_definition: [
 ]
 
 constructor: [
-| LIST0 [ "#[" LIST1 attribute SEP "," "]" ] ident LIST0 binder OPT of_type_inst
+| LIST0 [ "#[" LIST1 attribute SEP "," "]" ] ident LIST0 binder OPT [ "of" LIST1 term99 SEP "&" ] OPT of_type_inst
 ]
 
 import_categories: [
@@ -755,14 +759,15 @@ command: [
 | "Type" term
 | "Print" "All"
 | "Print" "Section" qualid
-| "Print" "Grammar" LIST0 ident
-| "Print" "Custom" "Grammar" qualid
+| "Print" "Grammar" OPT "Tree" LIST0 ident
+| "Print" "Custom" "Grammar" OPT "Tree" qualid
 | "Print" "Keywords"
 | "Print" "LoadPath" OPT dirpath
 | "Print" "Libraries"
 | "Print" "ML" "Path"
 | "Print" "ML" "Modules"
 | "Print" "Debug" "GC"
+| "Print" "Debug" "Delta" OPT qualid
 | "Print" "Graph"
 | "Print" "Classes"
 | "Print" "Typeclasses"
@@ -790,7 +795,7 @@ command: [
 | "Print" "Strategies"
 | "Print" "Registered"
 | "Print" "Registered" "Schemes"
-| "Print" OPT "Term" reference OPT univ_name_list
+| "Print" OPT "Term" LIST1 [ reference OPT univ_name_list ] SEP ","
 | "Print" "Module" "Type" qualid
 | "Print" "Module" qualid
 | "Print" "Namespace" dirpath
@@ -921,7 +926,7 @@ command: [
 | "String" "Notation" qualid qualid qualid OPT ( "(" number_string_via ")" ) ":" scope_name
 | "Ltac2" "Import" "Type" qualid "as" ident      (* ltac2 plugin *)
 | "Ltac2" "Custom" "Entry" ident      (* ltac2 plugin *)
-| "Ltac2" "Notation" LIST1 ltac2_syntax_class OPT [ ":" natural | ":" qualid OPT [ "(" natural ")" ] ] ":=" ltac2_expr      (* ltac2 plugin *)
+| "Ltac2" "Notation" LIST1 ltac2_syntax_class OPT [ ":" natural | ":" qualid OPT [ "(" natural ")" ] ] OPT [ "%" qualid ] ":=" ltac2_expr      (* ltac2 plugin *)
 | "SubClass" ident_decl def_body
 | thm_token ident_decl LIST0 binder ":" type LIST0 [ "with" ident_decl LIST0 binder ":" type ]
 | assumption_token OPT ( "Inline" OPT ( "(" natural ")" ) ) [ assumpt | LIST1 ( "(" assumpt ")" ) ]
@@ -1000,7 +1005,7 @@ command: [
 | "Eval" red_expr "in" term
 | "Compute" term
 | "Check" term
-| "About" reference OPT univ_name_list
+| "About" LIST1 [ reference OPT univ_name_list ] SEP ","
 | "SearchPattern" one_pattern OPT ( [ "inside" | "in" | "outside" ] LIST1 qualid )
 | "SearchRewrite" one_pattern OPT ( [ "inside" | "in" | "outside" ] LIST1 qualid )
 | "Search" LIST1 ( search_query ) OPT ( [ "inside" | "in" | "outside" ] LIST1 qualid )
@@ -1008,6 +1013,9 @@ command: [
 | "Ltac2" "Type" OPT "rec" tac2typ_def LIST0 ( "with" tac2typ_def )
 | "Ltac2" "@" "external" ident ":" ltac2_type ":=" string string
 | "Ltac2" "Abbreviation" ident ":=" ltac2_expr      (* ltac2 plugin *)
+| "Ltac2" "Declare" "Scope" ident      (* ltac2 plugin *)
+| "Ltac2" "Open" "Scope" qualid      (* ltac2 plugin *)
+| "Ltac2" "Close" "Scope" qualid      (* ltac2 plugin *)
 | "Ltac2" "Set" qualid OPT [ "as" ident ] ":=" ltac2_expr
 | "Ltac2" "Eval" ltac2_expr      (* ltac2 plugin *)
 | "Print" "Ltac2" qualid      (* ltac2 plugin *)
@@ -1021,7 +1029,7 @@ command: [
 | "Hint" "Immediate" LIST1 [ qualid | one_term ] OPT ( ":" LIST1 ident )
 | "Hint" [ "Constants" | "Projections" | "Variables" ] [ "Transparent" | "Opaque" ] OPT ( ":" LIST1 ident )
 | "Hint" [ "Transparent" | "Opaque" ] LIST1 qualid OPT ( ":" LIST1 ident )
-| "Hint" "Mode" qualid LIST1 [ "+" | "!" | "-" ] OPT ( ":" LIST1 ident )
+| "Hint" "Mode" qualid LIST1 [ "+" | "=" | "!" | "-" ] OPT ( ":" LIST1 ident )
 | "Hint" "Unfold" LIST1 qualid OPT ( ":" LIST1 ident )
 | "Hint" "Constructors" LIST1 qualid OPT ( ":" LIST1 ident )
 | "Hint" "Extern" natural OPT one_pattern "=>" generic_tactic OPT ( ":" LIST1 ident )
@@ -1030,6 +1038,7 @@ command: [
 | "Profile" OPT string sentence
 | "Redirect" string sentence
 | "Timeout" natural sentence
+| "AllocLimit" natural [ "Mw" | "kw" ] sentence
 | "Fail" sentence
 | "Succeed" sentence
 | "Drop"
@@ -1044,8 +1053,8 @@ section_var_expr: [
 ]
 
 section_var_expr50: [
-| section_var_expr50 "-" section_var_expr0
-| section_var_expr50 "+" section_var_expr0
+| section_var_expr0 "-" section_var_expr0
+| section_var_expr0 "+" section_var_expr0
 | section_var_expr0
 ]
 
@@ -1089,7 +1098,7 @@ logical_kind: [
 ]
 
 univ_name_list: [
-| "@{" LIST0 name "}"
+| "@{" LIST0 name OPT [ ";" LIST0 name ] "}"
 ]
 
 enable_notation_flag: [
@@ -1110,12 +1119,12 @@ ltac_production_item: [
 ]
 
 ltac2_type: [
-| ltac2_type "->" ltac2_type      (* ltac2 plugin *)
+| ltac2_type2 "->" ltac2_type      (* ltac2 plugin *)
 | ltac2_type2      (* ltac2 plugin *)
 ]
 
 ltac2_type2: [
-| ltac2_type2 "*" LIST1 ltac2_type1 SEP "*"      (* ltac2 plugin *)
+| ltac2_type1 "*" LIST1 ltac2_type1 SEP "*"      (* ltac2 plugin *)
 | ltac2_type1      (* ltac2 plugin *)
 ]
 
@@ -1489,6 +1498,7 @@ simple_tactic: [
 | "is_evar" one_term
 | "has_evar" one_term
 | "is_var" one_term
+| "is_section_var" one_term
 | "is_fix" one_term
 | "is_cofix" one_term
 | "is_ind" one_term
@@ -1505,6 +1515,7 @@ simple_tactic: [
 | "guard" int_or_var comparison int_or_var
 | "decompose" "[" LIST1 one_term "]" one_term
 | "optimize_heap"
+| "alloc_limit" natural [ "Mw" | "kw" ] ltac_expr
 | "with_strategy" strategy_level_or_var "[" LIST1 reference "]" ltac_expr3
 | "start" "ltac" "profiling"
 | "stop" "ltac" "profiling"
@@ -1530,7 +1541,6 @@ simple_tactic: [
 | "not_evar" one_term
 | "is_ground" one_term
 | "autoapply" one_term "with" ident
-| "rewrite_strat" rewstrategy OPT ( "in" ident )
 | "rewrite_db" ident OPT ( "in" ident )
 | "substitute" OPT [ "->" | "<-" ] one_term_with_bindings
 | "setoid_rewrite" OPT [ "->" | "<-" ] one_term_with_bindings OPT ( "at" rewrite_occs ) OPT ( "in" ident )
@@ -1543,6 +1553,7 @@ simple_tactic: [
 | "eintros" LIST0 intropattern
 | "decide" "equality"
 | "compare" one_term one_term
+| "rewrite_strat" rewstrategy2 OPT ( "in" ident )
 | "apply" LIST1 one_term_with_bindings SEP "," OPT in_hyp_as
 | "eapply" LIST1 one_term_with_bindings SEP "," OPT in_hyp_as
 | "simple" "apply" LIST1 one_term_with_bindings SEP "," OPT in_hyp_as
@@ -2083,7 +2094,7 @@ ltac2_syntax_class: [
 ]
 
 ltac2_expr: [
-| ltac2_expr ";" ltac2_expr      (* ltac2 plugin *)
+| ltac2_expr5 ";" ltac2_expr      (* ltac2 plugin *)
 | ltac2_expr5      (* ltac2 plugin *)
 ]
 
@@ -2098,11 +2109,11 @@ ltac2_let_clause: [
 ]
 
 ltac2_expr3: [
-| LIST1 ltac2_expr3 SEP ","      (* Ltac2 plugin *)
+| LIST1 ltac2_expr2 SEP ","      (* Ltac2 plugin *)
 ]
 
 ltac2_expr2: [
-| ltac2_expr2 "::" ltac2_expr2      (* ltac2 plugin *)
+| ltac2_expr1 "::" ltac2_expr2      (* ltac2 plugin *)
 | ltac2_expr1      (* ltac2 plugin *)
 ]
 
@@ -2179,7 +2190,7 @@ tac2pat3: [
 ]
 
 tac2pat2: [
-| tac2pat2 "::" tac2pat2      (* ltac2 plugin *)
+| tac2pat1 "::" tac2pat2      (* ltac2 plugin *)
 | tac2pat1      (* ltac2 plugin *)
 ]
 
@@ -2216,8 +2227,12 @@ rewrite_occs: [
 ]
 
 rewstrategy: [
+]
+
+rewstrategy2: [
 | "fix" ident ":=" rewstrategy1
 | LIST1 rewstrategy1 SEP ";"
+| rewstrategy1
 ]
 
 rewstrategy1: [
@@ -2237,6 +2252,8 @@ rewstrategy1: [
 | "terms" LIST0 one_term
 | "eval" red_expr
 | "fold" one_term
+| "matches" one_term
+| "tactic" ltac_expr
 | rewstrategy0
 | "old_hints" ident
 ]
@@ -2246,7 +2263,7 @@ rewstrategy0: [
 | "fail"
 | "id"
 | "refl"
-| "(" rewstrategy ")"
+| "(" rewstrategy2 ")"
 ]
 
 l3_tactic: [
@@ -2281,8 +2298,8 @@ ltac_expr3: [
 ]
 
 ltac_expr2: [
-| ltac_expr2 "+" ltac_expr2
-| ltac_expr2 "||" ltac_expr2
+| ltac_expr1 "+" ltac_expr2
+| ltac_expr1 "||" ltac_expr2
 | l2_tactic
 | ltac_expr1
 ]
diff --git a/doc/tools/rocqrst/rocqdomain.py b/doc/tools/rocqrst/rocqdomain.py
index b167182f99b2..65051ffcce90 100644
--- a/doc/tools/rocqrst/rocqdomain.py
+++ b/doc/tools/rocqrst/rocqdomain.py
@@ -873,6 +873,7 @@ def add_rocq_output_1(self, repl, node):
 
         if options['restart']:
             repl.sendone('Restart.')
+            repl.sendone('Proof.')
         if options['reset']:
             repl.sendone('Reset Initial.')
             repl.send_initial_options()
diff --git a/dune b/dune
index 890389fe214e..ac0330e80abc 100644
--- a/dune
+++ b/dune
@@ -1,6 +1,7 @@
 ; Default flags for all Rocq libraries.
 (env
- (dev     (flags :standard -w -9-27@60-69@70 \ -short-paths)
+ ; cf explanation for warning settings in configure.ml
+ (dev     (flags :standard -w +a-4-9-27-40..42-44-45-48-58-67-68-70 -warn-error +a \ -short-paths)
           (coq (flags :standard -w +default)))
  (release (flags :standard)
           (ocamlopt_flags :standard -O3 -unbox-closures))
diff --git a/dune-project b/dune-project
index ea6359d08e76..5c7287274841 100644
--- a/dune-project
+++ b/dune-project
@@ -33,7 +33,7 @@
  (conflicts
   (coq (< 8.17))
   (coq-core (< 8.21)))
- (depopts rocq-native memprof-limits memtrace)
+ (depopts rocq-native (memprof-limits (>= 0.3.0)) memtrace)
  (synopsis "The Rocq Prover -- Core Binaries and Tools")
  (description "The Rocq Prover is an interactive theorem prover, or proof assistant. It provides
 a formal language to write mathematical definitions, executable
diff --git a/engine/dune b/engine/dune
index fb7340f3ee23..6165d60eb90b 100644
--- a/engine/dune
+++ b/engine/dune
@@ -6,7 +6,3 @@
  ; until ocaml/dune#4892 fixed
  ; (private_modules univSubst)
  (libraries library))
-
-(deprecated_library_name
- (old_public_name coq-core.engine)
- (new_public_name rocq-runtime.engine))
diff --git a/engine/eConstr.ml b/engine/eConstr.ml
index 533a4c5c4be6..61ac59cbaa6e 100644
--- a/engine/eConstr.ml
+++ b/engine/eConstr.ml
@@ -35,7 +35,6 @@ module ESorts = struct
   let equal sigma s1 s2 =
     Sorts.equal (kind sigma s1) (kind sigma s2)
 
-  let is_small sigma s = Sorts.is_small (kind sigma s)
   let is_prop sigma s = Sorts.is_prop (kind sigma s)
   let is_sprop sigma s = Sorts.is_sprop (kind sigma s)
   let is_set sigma s = Sorts.is_set (kind sigma s)
@@ -172,9 +171,7 @@ type unsafe_judgment = (constr, types) Environ.punsafe_judgment
 type unsafe_type_judgment = (types, ESorts.t) Environ.punsafe_type_judgment
 type named_declaration = (constr, types, ERelevance.t) Context.Named.Declaration.pt
 type rel_declaration = (constr, types, ERelevance.t) Context.Rel.Declaration.pt
-type compacted_declaration = (constr, types, ERelevance.t) Context.Compacted.Declaration.pt
 type named_context = (constr, types, ERelevance.t) Context.Named.pt
-type compacted_context = compacted_declaration list
 type rel_context = (constr, types, ERelevance.t) Context.Rel.pt
 type 'a binder_annot = ('a, ERelevance.t) Context.pbinder_annot
 
@@ -424,6 +421,21 @@ let decompose_lambda_n_decls sigma n =
   in
   lamdec_rec Context.Rel.empty n
 
+let decompose_lambda_n_decls_opt sigma n c =
+  let open Rel.Declaration in
+  if n < 0 then
+    anomaly Pp.(str "decompose_lambda_n_decls_opt: integer parameter must be positive.");
+  let rec lamdec_rec l n c =
+    if Int.equal n 0 then Some (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
+      | _ -> None
+  in
+  lamdec_rec Context.Rel.empty n c
+
 let rec to_lambda sigma n prod =
   if Int.equal n 0 then
     prod
@@ -595,6 +607,12 @@ let iter sigma f c =
     List.iter (fun c -> f c) args
   | _ -> Constr.iter f c
 
+(* Note: these case-related functions are evar-aware wrappers of
+   Inductive.expand_case / contract_case / etc. They live here rather
+   than in a separate EInductive module because iter_with_full_binders
+   (below) calls annotate_case, which would create a circular
+   dependency: EInductive -> EConstr (for EConstr.kind etc.) and
+   EConstr -> EInductive (for annotate_case). *)
 let expand_case env _sigma (ci, u, pms, p, iv, c, bl) =
   let u = EInstance.unsafe_to_instance u in
   let pms = unsafe_to_constr_array pms in
@@ -645,20 +663,42 @@ let expand_branch env _sigma u pms (ind, i) (nas, _br) =
   in
   ans
 
-let contract_case env _sigma (ci, (p,r), iv, c, bl) =
-  let p = unsafe_to_constr p in
-  let r = ERelevance.unsafe_to_relevance r in
-  let iv = unsafe_to_case_invert iv in
-  let c = unsafe_to_constr c in
-  let bl = unsafe_to_constr_array bl in
-  let (ci, u, pms, p, iv, c, bl) = Inductive.contract_case env (ci, (p,r), iv, c, bl) in
-  let u = EInstance.make u in
-  let pms = of_constr_array pms in
-  let p = of_return p in
-  let iv = of_case_invert iv in
-  let c = of_constr c in
-  let bl = of_branches bl in
-  (ci, u, pms, p, iv, c, bl)
+let contract_case env sigma (ci, (p,rp), iv, c, br) =
+  let open Context.Rel.Declaration in
+  let open Declarations in
+  let (mib, mip) = Inductive.lookup_mind_specif env ci.ci_ind in
+  let (arity, p) =
+    match decompose_lambda_n_decls_opt sigma (mip.mind_nrealdecls + 1) p with
+    | Some v -> v
+    | None ->
+      anomaly Pp.(str "contract_case: not enough abstractions in return predicate.")
+  in
+  let (u, pms) = match arity with
+  | LocalAssum (_, ty) :: _ ->
+    let (ind, args) = decompose_app sigma ty in
+    let (ind, u) = destInd sigma ind in
+    let () = assert (Environ.QInd.equal env ind ci.ci_ind) in
+    let pms = Array.sub args 0 mib.mind_nparams in
+    let dummy = List.make mip.mind_nrealdecls Constr.mkProp in
+    let pms = Array.map (fun c -> of_constr (CVars.substl dummy (unsafe_to_constr c))) pms in
+    (u, pms)
+  | _ -> assert false
+  in
+  let p =
+    let nas = Array.of_list (List.rev_map get_annot arity) in
+    ((nas, p), rp)
+  in
+  let map i br =
+    let (ctx, br) =
+      match decompose_lambda_n_decls_opt sigma mip.mind_consnrealdecls.(i) br with
+      | Some v -> v
+      | None ->
+        anomaly Pp.(fmt "contract_case: not enough abstractions in branch %d." i)
+    in
+    let nas = Array.of_list (List.rev_map get_annot ctx) in
+    (nas, br)
+  in
+  (ci, u, pms, p, iv, c, Array.mapi map br)
 
 let iter_with_full_binders env sigma g f n c =
   let open Context.Rel.Declaration in
@@ -882,19 +922,14 @@ let eq_constr_universes_proj env sigma m n =
 let add_universes_of_instance sigma (qs,us) u =
   let u = EInstance.kind sigma u in
   let qs', us' = UVars.Instance.levels u in
-  let qs = Sorts.Quality.(Set.fold (fun q qs -> match q with
-      | QVar q -> Sorts.QVar.Set.add q qs
-      | QConstant _ -> qs)
-      qs' qs)
-  in
-  qs, Univ.Level.Set.union us us'
+  Sorts.Quality.Set.union qs qs', Univ.Level.Set.union us us'
 
 let add_relevance sigma (qs,us as v) r =
   let open Sorts in
   (* NB this normalizes above_prop to Relevant which makes it disappear *)
   match ERelevance.kind sigma r with
   | Irrelevant | Relevant -> v
-  | RelevanceVar q -> QVar.Set.add q qs, us
+  | RelevanceVar q -> Quality.Set.add (QVar q) qs, us
 
 let univs_and_qvars_visitor sigma =
   let open Univ in
@@ -902,8 +937,10 @@ let univs_and_qvars_visitor sigma =
     match ESorts.kind sigma s with
     | Sorts.Type u ->
       qs, Universe.levels ~init:us u
-    | Sorts.QSort (q,u) ->
-      Sorts.QVar.Set.add q qs, Universe.levels ~init:us u
+    | Sorts.GSort (q,u) ->
+      Sorts.Quality.Set.add (QGlobal q) qs, Universe.levels ~init:us u
+    | Sorts.VSort (q,u) ->
+      Sorts.Quality.Set.add (QVar q) qs, Universe.levels ~init:us u
     | Sorts.(SProp | Prop | Set) -> acc
   in
   let visit_instance acc u = add_universes_of_instance sigma acc u in
@@ -914,7 +951,7 @@ let univs_and_qvars_visitor sigma =
     visit_relevance = visit_relevance;
   }
 
-let universes_of_constr ?(init=Sorts.QVar.Set.empty,Univ.Level.Set.empty) sigma c =
+let universes_of_constr ?(init=Sorts.Quality.Set.empty,Univ.Level.Set.empty) sigma c =
   let visit = univs_and_qvars_visitor sigma in
   let rec aux s c =
     let kc = kind sigma c in
@@ -1181,16 +1218,25 @@ let destArity sigma =
 let push_rel d e = push_rel (cast_rel_decl unsafe_eq unsafe_relevance_eq d) e
 let push_rel_context d e = push_rel_context (cast_rel_context unsafe_eq unsafe_relevance_eq d) e
 let push_rec_types d e = push_rec_types (cast_rec_decl unsafe_eq unsafe_relevance_eq d) e
-let push_named d e = push_named (cast_named_decl unsafe_eq unsafe_relevance_eq d) e
-let push_named_context d e = push_named_context (cast_named_context unsafe_eq unsafe_relevance_eq d) e
-let push_named_context_val d e = push_named_context_val (cast_named_decl unsafe_eq unsafe_relevance_eq d) e
+let push_named status d e = push_named status (cast_named_decl unsafe_eq unsafe_relevance_eq d) e
+let push_named_context d e =
+  List.fold_right (fun (status, d) env -> push_named status d env) d e
+let push_named_context_val status d e = push_named_context_val status (cast_named_decl unsafe_eq unsafe_relevance_eq d) e
 
 let rel_context e = cast_rel_context (sym unsafe_eq) (sym unsafe_relevance_eq) (rel_context e)
 let named_context e = cast_named_context (sym unsafe_eq) (sym unsafe_relevance_eq) (named_context e)
 
-let val_of_named_context e = val_of_named_context (cast_named_context unsafe_eq unsafe_relevance_eq e)
+let val_of_named_context ctxt =
+  List.fold_right (fun (status,d) ctxt -> push_named_context_val status d ctxt)
+    ctxt Environ.empty_named_context_val
+
 let named_context_of_val e = cast_named_context (sym unsafe_eq) (sym unsafe_relevance_eq) (named_context_of_val e)
 
+let named_context_of_val_with_status
+  : named_context_val -> (var_status * named_declaration) list =
+  let Refl, Refl = unsafe_eq, unsafe_relevance_eq in
+  named_context_of_val_with_status
+
 let of_existential : Constr.existential -> existential =
   let gen : type a b. (a,b) eq -> 'c * b SList.t -> 'c * a SList.t = fun Refl x -> x in
   gen unsafe_eq
@@ -1209,12 +1255,30 @@ let map_rel_context_in_env f env sign =
   aux env [] (List.rev sign)
 
 let match_named_context_val :
-  named_context_val -> (named_declaration * named_context_val) option =
+  named_context_val -> (var_status * named_declaration * named_context_val) option =
   match unsafe_eq, unsafe_relevance_eq with
   | Refl, Refl -> match_named_context_val
 
+let fold_named_context_val :
+  (named_context_val -> var_status -> named_declaration -> 'a -> 'a) ->
+  named_context_val -> init:'a -> 'a =
+  let Refl, Refl = unsafe_eq, unsafe_relevance_eq in
+  Environ.fold_named_context_val
+
+let fold_named_context :
+  (env -> var_status -> named_declaration -> 'a -> 'a) ->
+  env -> init:'a -> 'a =
+  let Refl, Refl = unsafe_eq, unsafe_relevance_eq in
+  Environ.fold_named_context
+
+let map_named_val :
+  (var_status -> named_declaration -> var_status * named_declaration) ->
+  named_context_val -> named_context_val =
+  match unsafe_eq, unsafe_relevance_eq with
+  | Refl, Refl -> map_named_val
+
 let identity_subst_val : named_context_val -> t SList.t = fun ctx ->
-  SList.defaultn (List.length ctx.Environ.env_named_ctx) SList.empty
+  SList.defaultn (Environ.nb_named ctx) SList.empty
 
 let fresh_global ?loc ?rigid ?names env sigma reference =
   let (evd,t) = Evd.fresh_global ?loc ?rigid ?names env sigma reference in
@@ -1235,6 +1299,18 @@ let constant_value_in env sigma (kn, u) =
     let r = Environ.lookup_rewrite_rules kn env in
     raise (NotEvaluableConst (HasRules (u, b, r)))
 
+(* Checks if a context of variables can be instantiated by the
+   variables of the current env. *)
+let check_hyps_inclusion env c sign =
+  sign |> List.iter @@ fun d ->
+  let id = NamedDecl.get_id d in
+  let ok =
+    match var_status ~check:false id env with
+    | SecVar -> true
+    | ProofVar -> false
+  in
+  if not ok then Type_errors.error_reference_variables env id c
+
 (** Kind of type *)
 
 type kind_of_type =
diff --git a/engine/eConstr.mli b/engine/eConstr.mli
index 3a485da1e3fd..e48c5efaea3d 100644
--- a/engine/eConstr.mli
+++ b/engine/eConstr.mli
@@ -51,7 +51,6 @@ sig
 
   val equal : Evd.evar_map -> t -> t -> bool
 
-  val is_small : Evd.evar_map -> t -> bool
   val is_prop : Evd.evar_map -> t -> bool
   val is_sprop : Evd.evar_map -> t -> bool
   val is_set : Evd.evar_map -> t -> bool
@@ -94,9 +93,7 @@ type unsafe_judgment = (constr, types) Environ.punsafe_judgment
 type unsafe_type_judgment = (types, Evd.esorts) Environ.punsafe_type_judgment
 type named_declaration = (constr, types, ERelevance.t) Context.Named.Declaration.pt
 type rel_declaration = (constr, types, ERelevance.t) Context.Rel.Declaration.pt
-type compacted_declaration = (constr, types, ERelevance.t) Context.Compacted.Declaration.pt
 type named_context = (constr, types, ERelevance.t) Context.Named.pt
-type compacted_context = compacted_declaration list
 type rel_context = (constr, types, ERelevance.t) Context.Rel.pt
 type 'a binder_annot = ('a,ERelevance.t) Context.pbinder_annot
 
@@ -314,6 +311,11 @@ val decompose_lambda_n_assum : Evd.evar_map -> int -> t -> rel_context * t
      @raise UserError if the term doesn't have enough lambdas/letins. *)
 val decompose_lambda_n_decls : Evd.evar_map -> int -> t -> rel_context * t
 
+(** Like [decompose_lambda_n_decls] but returns [None] instead of raising
+    an anomaly when there are not enough abstractions. *)
+val decompose_lambda_n_decls_opt : Evd.evar_map -> int -> t ->
+  (rel_context * t) option
+
 val prod_decls : Evd.evar_map -> t -> rel_context
 
 val to_lambda : Evd.evar_map -> int -> t -> t
@@ -356,7 +358,8 @@ val fold_with_binders : Evd.evar_map -> ('a -> 'a) -> ('a -> 'b -> t -> 'b) -> '
 
 (** Gather the universes transitively used in the term, including in the
    type of evars appearing in it. *)
-val universes_of_constr : ?init:Sorts.QVar.Set.t * Univ.Level.Set.t -> Evd.evar_map -> t -> Sorts.QVar.Set.t * Univ.Level.Set.t
+val universes_of_constr : ?init:Sorts.Quality.Set.t * Univ.Level.Set.t -> Evd.evar_map -> t ->
+  Sorts.Quality.Set.t * Univ.Level.Set.t
 
 (** {6 Substitutions} *)
 
@@ -419,20 +422,33 @@ val push_rel : rel_declaration -> env -> env
 val push_rel_context : rel_context -> env -> env
 val push_rec_types : rec_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 push_named : var_status -> named_declaration -> env -> env
+val push_named_context : (var_status * named_declaration) list -> env -> env
+val push_named_context_val  : var_status -> 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 val_of_named_context : (var_status * named_declaration) list -> named_context_val
 val named_context_of_val : named_context_val -> named_context
+val named_context_of_val_with_status : named_context_val -> (var_status * named_declaration) list
+
+val fold_named_context_val :
+  (named_context_val -> var_status -> named_declaration -> 'a -> 'a) ->
+  named_context_val -> init:'a -> 'a
+
+val fold_named_context :
+  (env -> var_status -> named_declaration -> 'a -> 'a) ->
+  env -> init:'a -> 'a
 
 val lookup_rel : int -> env -> rel_declaration
 val lookup_named : variable -> env -> named_declaration
 val lookup_named_val : variable -> named_context_val -> named_declaration
 
+(** [check_hyps_inclusion env gr hyps] Check that [hyps] are included in [env]
+    and fails with error otherwise. *)
+val check_hyps_inclusion : env -> Names.GlobRef.t -> Constr.named_context -> unit
+
 val lookup_constant : env -> Evd.evar_map -> Constant.t -> Declarations.constant_body
 val constant_value_in : env -> Evd.evar_map -> Constant.t * EInstance.t -> constr
 
@@ -440,7 +456,14 @@ val map_rel_context_in_env :
   (env -> constr -> constr) -> env -> rel_context -> rel_context
 
 val match_named_context_val :
-  named_context_val -> (named_declaration * named_context_val) option
+  named_context_val -> (var_status * named_declaration * named_context_val) option
+
+(** [map_named_val f ctxt] apply [f] to the body and the type of
+   each declarations.
+   *** /!\ ***   [f t] must preserve the name *)
+val map_named_val :
+  (var_status -> named_declaration -> var_status * named_declaration) ->
+  named_context_val -> named_context_val
 
 val identity_subst_val : named_context_val -> t SList.t
 
diff --git a/engine/evarnames.ml b/engine/evarnames.ml
index 2ebaa2e3535d..05a32ec9fa86 100644
--- a/engine/evarnames.ml
+++ b/engine/evarnames.ml
@@ -233,6 +233,12 @@ let shortest_name ev evn =
   | Some name -> Some (NameResolution.shortest_name name ev evn.name_resolution)
   | None -> None
 
+(* Returns the set of focusable evars that have the given qualid as name.  *)
+let get_matching_evars qualid evn =
+  let evs = NameResolution.find qualid evn.name_resolution in
+  (* Do not consider removed evars as conflicts for name resolution purposes *)
+  Evar.Set.diff evs evn.removed_evars
+
 let register_parent ev parent evn =
   let add_child = function
     | Some children -> Some (EvSet.add ev children)
@@ -261,8 +267,8 @@ let add_fresh basename ev ?parent evn =
     | None -> evn
   in
   let qualid = EvarQualid.{ basename; path = path ev evn } in
-  let ans = NameResolution.find qualid evn.name_resolution in
-  if Evar.Set.is_empty ans then
+  let conflicts = get_matching_evars qualid evn in
+  if Evar.Set.is_empty conflicts then
     (* No need to give the parent since it's already registered *)
     add basename ev evn
   else
@@ -361,7 +367,7 @@ let name_of ev evn =
   match shortest_name ev evn with
   | None -> None
   | Some name ->
-    let conflicts = NameResolution.find name evn.name_resolution in
+    let conflicts = get_matching_evars name evn in
     (* TODO: we should the caller handle the conflict themselves instead of
        generating nonsensical names in linear time. *)
     match classify_set conflicts with
@@ -384,20 +390,17 @@ let has_unambiguous_name ev evn =
   match shortest_name ev evn with
   | None -> false
   | Some name ->
-    let ans = NameResolution.find name evn.name_resolution in
-    match classify_set ans with
+    let matches = get_matching_evars name evn in
+    match classify_set matches with
     | SetEmpty | SetOther -> false
-    | SetSingleton e ->
-      Evar.equal e ev && not (EvSet.mem ev evn.removed_evars)
+    | SetSingleton e -> Evar.equal e ev
 
 let resolve fp evn =
   let qualid = EvarQualid.make fp in
-  let evs = NameResolution.find qualid evn.name_resolution in
+  let evs = get_matching_evars qualid evn in
   let open Pp in
   match classify_set evs with
   | SetEmpty -> raise Not_found
-  | SetSingleton ev ->
-    if EvSet.mem ev evn.removed_evars then raise Not_found
-    else ev
+  | SetSingleton ev -> ev
   | SetOther ->
     CErrors.user_err ?loc:fp.loc (str "Ambiguous evar name " ++ Libnames.pr_qualid fp ++ str ".")
diff --git a/engine/evarutil.ml b/engine/evarutil.ml
index 93e784c71cd4..2ece061ff1cf 100644
--- a/engine/evarutil.ml
+++ b/engine/evarutil.ml
@@ -10,7 +10,6 @@
 
 open Util
 open Names
-open Context
 open Constr
 open Environ
 open Evd
@@ -32,8 +31,8 @@ let create_clos_infos env sigma flags =
 (* Expanding/testing/exposing existential variables *)
 (****************************************************)
 
-let finalize ?abort_on_undefined_evars sigma f =
-  let sigma = minimize_universes sigma in
+let finalize ?abort_on_undefined_evars ?poly sigma f =
+  let sigma = minimize_universes ?poly sigma in
   let uvars = ref Univ.Level.Set.empty in
   let nf_constr c =
     let _, varsc = EConstr.universes_of_constr sigma c in
@@ -42,7 +41,7 @@ let finalize ?abort_on_undefined_evars sigma f =
     c
   in
   let v = f nf_constr in
-  let sigma = restrict_universe_context sigma !uvars in
+  let sigma = restrict_ustate sigma !uvars in
   sigma, v
 
 (** Term exploration up to instantiation. *)
@@ -64,17 +63,17 @@ let tj_nf_evar sigma {utj_val=v;utj_type=t} =
 let nf_relevance sigma r =
   UState.nf_relevance (Evd.ustate sigma) r
 
-let nf_named_context_evar sigma ctx =
-  Context.Named.map_with_relevance (nf_relevance sigma) (nf_evars_universes sigma) ctx
+let nf_named_decl_evar sigma status ctx =
+  status, Context.Named.Declaration.map_constr_with_relevance (nf_relevance sigma) (nf_evars_universes sigma) ctx
 
 let nf_rel_context_evar sigma ctx =
   let nf_relevance r = ERelevance.make (ERelevance.kind sigma r) in
   Context.Rel.map_with_relevance nf_relevance (nf_evar sigma) ctx
 
 let nf_env_evar sigma env =
-  let nc' = nf_named_context_evar sigma (Environ.named_context env) in
+  let nc' = Environ.map_named_val (nf_named_decl_evar sigma) (Environ.named_context_val env) in
   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)
+    EConstr.push_rel_context rel' (reset_with_named_context nc' env)
 
 let nf_evar_info evc info = map_evar_info (nf_evar evc) info
 
@@ -115,6 +114,7 @@ let is_ground_env evd env =
     | RelDecl.LocalDef (_,b,_) -> is_ground_term evd (EConstr.of_constr b)
     | _ -> true in
   let is_ground_named_decl = function
+    (* skip if SecVar? *)
     | NamedDecl.LocalDef (_,b,_) -> is_ground_term evd (EConstr.of_constr b)
     | _ -> true in
   List.for_all is_ground_rel_decl (rel_context env) &&
@@ -284,18 +284,7 @@ let update_var src tgt subst =
       let csubst_var = Id.Map.add id (Constr.mkVar tgt) subst.csubst_var in
       { subst with csubst_var; csubst_rev }
 
-module VarSet =
-struct
-  type t = Id.t -> bool
-  let empty _ = false
-  let full _ = true
-  let variables env id = is_section_variable env id
-end
-
-type naming_mode = VarSet.t
-
 let push_rel_decl_to_named_context
-  ~hypnaming
   sigma decl (ext : ext_named_context) =
   let open EConstr in
   let open Vars in
@@ -304,18 +293,19 @@ let push_rel_decl_to_named_context
   in
   let rec replace_var_named_declaration id0 id nc = match match_named_context_val nc with
   | None -> empty_named_context_val
-  | Some (decl, nc) ->
+  | Some (status, decl, nc) ->
     if Id.equal id0 (NamedDecl.get_id decl) then
-      (* Stop here, the variable cannot occur before its definition *)
-      push_named_context_val (NamedDecl.set_id id decl) nc
+      (* Stop here, the variable cannot occur before its definition
+         NB: we lose section variable status *)
+      push_named_context_val ProofVar (NamedDecl.set_id id decl) nc
     else
       let nc = replace_var_named_declaration id0 id nc in
       let vsubst = [id0 , mkVar id] in
-      push_named_context_val (map_decl (fun c -> replace_vars sigma vsubst c) decl) nc
+      push_named_context_val status (map_decl (fun c -> replace_vars sigma vsubst c) decl) nc
   in
   let extract_if_neq id = function
     | Anonymous -> None
-    | Name id' when Id.compare id id' = 0 -> None
+    | Name id' when Id.equal id id' -> None
     | Name id' -> Some id'
   in
   let na = RelDecl.get_name decl in
@@ -326,7 +316,7 @@ let push_rel_decl_to_named_context
   in
   match extract_if_neq id na with
   | Some id0 ->
-    if hypnaming id0 then
+    if Environ.mem_named_ctxt id0 ext.ext_ctx && is_section_variable_sign ext.ext_ctx id0 then
       (* 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
@@ -334,7 +324,7 @@ let push_rel_decl_to_named_context
       let d = decl |> NamedDecl.of_rel_decl (fun _ -> id) |> map_decl (csubst_subst sigma ext.ext_subst) in
       { ext_subst = push_var id ext.ext_subst;
         ext_avoid = Id.Set.add id ext.ext_avoid;
-        ext_ctx = push_named_context_val d ext.ext_ctx }
+        ext_ctx = push_named_context_val ProofVar d ext.ext_ctx }
     else
       (* spiwack: if [id<>id0], rather than introducing a new
           binding named [id], we will keep [id0] (the name given
@@ -346,12 +336,12 @@ let push_rel_decl_to_named_context
       let avoid = Id.Set.add id (Id.Set.add id0 ext.ext_avoid) in
       { ext_subst = push_var id0 subst;
         ext_avoid = avoid;
-        ext_ctx = push_named_context_val d nc }
+        ext_ctx = push_named_context_val ProofVar d nc }
   | None ->
     let d = decl |> NamedDecl.of_rel_decl (fun _ -> id) |> map_decl (csubst_subst sigma ext.ext_subst) in
     { ext_subst = push_var id ext.ext_subst;
       ext_avoid = Id.Set.add id ext.ext_avoid;
-      ext_ctx = push_named_context_val d ext.ext_ctx }
+      ext_ctx = push_named_context_val ProofVar d ext.ext_ctx }
 
 let csubst_instance subst ctx =
   let fold decl accu = match Id.Map.find (NamedDecl.get_id decl) subst.csubst_rev with
@@ -369,7 +359,7 @@ let ext_rev_subst { ext_subst = subst } id0 =
 let default_ext_instance { ext_subst = subst; ext_ctx = ctx } =
   csubst_instance subst (named_context_of_val ctx)
 
-let push_rel_context_to_named_context ~hypnaming env sigma typ =
+let push_rel_context_to_named_context env sigma typ =
   (* compute the instances relative to the named context and rel_context *)
   let open EConstr in
   let ctx = named_context_val env in
@@ -383,15 +373,15 @@ let push_rel_context_to_named_context ~hypnaming env sigma typ =
     (* We do keep the instances corresponding to local definition (see above) *)
     let init = { ext_subst = empty_csubst; ext_avoid = avoid; ext_ctx = ctx } in
     let ext =
-      Context.Rel.fold_outside (fun d acc -> push_rel_decl_to_named_context ~hypnaming sigma d acc)
+      Context.Rel.fold_outside (fun d acc -> push_rel_decl_to_named_context sigma d acc)
         (rel_context env) ~init in
     let inst = default_ext_instance ext in
     (ext.ext_ctx, csubst_subst sigma ext.ext_subst typ, inst, ext.ext_subst)
 
-let ext_named_context_of_env ~hypnaming env sigma =
+let ext_named_context_of_env env sigma =
   let avoid = Environ.ids_of_named_context_val (Environ.named_context_val env) in
   let init = { ext_subst = empty_csubst; ext_avoid = avoid; ext_ctx = named_context_val env } in
-  Context.Rel.fold_outside (fun d acc -> push_rel_decl_to_named_context ~hypnaming sigma d acc)
+  Context.Rel.fold_outside (fun d acc -> push_rel_decl_to_named_context sigma d acc)
     (EConstr.rel_context env) ~init
 
 (*------------------------------------*
@@ -408,13 +398,9 @@ let next_evar_name naming = match naming with
 (* [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 ?src ?filter ?relevance ?abstract_arguments ?candidates ?(naming = IntroAnonymous) ?parent ?typeclass_candidate
-    ?rrpat ?hypnaming env evd typ =
+    ?rrpat env evd typ =
   let name = next_evar_name naming in
-  let hypnaming = match hypnaming with
-  | Some n -> n
-  | None -> VarSet.variables (Global.env ())
-  in
-  let sign,typ',instance,subst = push_rel_context_to_named_context ~hypnaming env evd typ in
+  let sign,typ',instance,subst = push_rel_context_to_named_context env evd typ in
   let map c = csubst_subst evd subst c in
   let candidates = Option.map (fun l -> List.map map l) candidates in
   let instance =
@@ -429,10 +415,10 @@ let new_evar ?src ?filter ?relevance ?abstract_arguments ?candidates ?(naming =
     ?typeclass_candidate in
   (evd, EConstr.mkEvar (evk, instance))
 
-let new_type_evar ?src ?filter ?naming ?hypnaming env evd rigid =
+let new_type_evar ?src ?filter ?naming env evd rigid =
   let (evd', s) = new_sort_variable rigid evd in
   let relevance = EConstr.ESorts.relevance_of_sort s in
-  let (evd', e) = new_evar env evd' ?src ?filter ~relevance ?naming ~typeclass_candidate:false ?hypnaming (EConstr.mkSort s) in
+  let (evd', e) = new_evar env evd' ?src ?filter ~relevance ?naming ~typeclass_candidate:false (EConstr.mkSort s) in
   evd', (e, s)
 
 let new_Type ?(rigid=Evd.univ_flexible) evd =
@@ -517,7 +503,7 @@ let check_vars env sigma ids c =
   in
   check_rec c
 
-let rec check_and_clear_in_constr ~is_section_variable env evdref err ids ~global c =
+let rec check_and_clear_in_constr env evdref err ids ~global c =
   (* returns a new constr where all the evars have been 'cleaned'
      (ie the hypotheses ids have been removed from the contexts of
      evars). [global] should be true iff there is some variable of [ids] which
@@ -584,9 +570,10 @@ let rec check_and_clear_in_constr ~is_section_variable env evdref err ids ~globa
               let _nconcl : EConstr.t =
                 try
                   let nids = Id.Map.domain rids in
-                  let global = Id.Set.exists is_section_variable nids in
+                  let env = evar_filtered_env env evi in
+                  let global = Id.Set.exists (is_section_variable_env env) nids in
                   let concl = evar_concl evi in
-                  check_and_clear_in_constr ~is_section_variable env evdref (EvarTypingBreak ev) nids ~global concl
+                  check_and_clear_in_constr env evdref (EvarTypingBreak ev) nids ~global concl
                 with ClearDependencyError (rid,err,where) ->
                   raise (ClearDependencyError (Id.Map.find rid rids,err,where))
               in
@@ -598,22 +585,21 @@ let rec check_and_clear_in_constr ~is_section_variable env evdref err ids ~globa
               evdref := evd;
               Evd.existential_value !evdref ev
 
-      | _ -> EConstr.map !evdref (check_and_clear_in_constr ~is_section_variable env evdref err ids ~global) c
+      | _ -> EConstr.map !evdref (check_and_clear_in_constr env evdref err ids ~global) c
 
 let clear_hyps_in_evi_main env sigma 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 evdref = ref sigma in
-  let is_section_variable id = is_section_variable (Global.env ()) id in
-  let global = Id.Set.exists is_section_variable ids in
+  let global = Id.Set.exists (is_section_variable_env env) ids in
   let terms =
-    List.map (check_and_clear_in_constr ~is_section_variable env evdref (OccurHypInSimpleClause None) ids ~global) terms in
+    List.map (check_and_clear_in_constr env evdref (OccurHypInSimpleClause None) ids ~global) terms in
   let nhyps =
-    let check_context decl =
+    let check_context status decl =
       let decl = EConstr.of_named_decl decl in
       let err = OccurHypInSimpleClause (Some (NamedDecl.get_id decl)) in
-      EConstr.Unsafe.to_named_decl @@ NamedDecl.map_constr (check_and_clear_in_constr ~is_section_variable env evdref err ids ~global) decl
+      status, EConstr.Unsafe.to_named_decl @@ NamedDecl.map_constr (check_and_clear_in_constr env evdref err ids ~global) decl
     in
     remove_hyps ids check_context hyps
   in
@@ -621,8 +607,9 @@ let clear_hyps_in_evi_main env sigma hyps terms ids =
 
 let check_and_clear_in_constr env evd err ids c =
   let evdref = ref evd in
+  let global = Id.Set.exists (is_section_variable_env env) ids in
   let _ : EConstr.constr = check_and_clear_in_constr
-      ~is_section_variable:(fun _ -> true) ~global:true
+      ~global
       env evdref err ids c
   in
   !evdref
@@ -688,6 +675,7 @@ let undefined_evars_of_named_context evd nc =
     nc
     ~init:Evar.Set.empty
 
+(* not sure how useful it is to have 2 layers of mutability (mutable field + refs in the map) *)
 type undefined_evars_cache = {
   mutable cache : (EConstr.named_declaration * Evar.Set.t) ref Id.Map.t;
 }
@@ -702,25 +690,19 @@ let cached_evar_of_hyp cache sigma decl accu = match cache with
   in
   NamedDecl.fold_constr fold decl accu
 | Some cache ->
-  let id = NamedDecl.get_annot decl in
-  let r =
-    try Id.Map.find id.binder_name 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.binder_name r cache.cache in
-      r
-  in
-  let (decl', evs) = !r in
-  let evs =
-    if NamedDecl.equal (==) (==) decl decl' then snd !r
-    else
+  let id = NamedDecl.get_id decl in
+  let evs = match Id.Map.find_opt id cache.cache with
+    | Some {contents = decl',evs } when NamedDecl.equal (==) (==) decl decl' -> evs
+    | None | Some _ as r ->
       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
+      let () = match r with
+        | None -> cache.cache <- Id.Map.add id (ref (decl,evs)) cache.cache
+        | Some r -> r := (decl,evs)
+      in
       evs
   in
   Evar.Set.fold Evar.Set.add evs accu
diff --git a/engine/evarutil.mli b/engine/evarutil.mli
index 2c52ee5fb925..b942316b5294 100644
--- a/engine/evarutil.mli
+++ b/engine/evarutil.mli
@@ -26,16 +26,6 @@ val new_meta : unit -> metavariable
 
 val next_evar_name : intro_pattern_naming_expr -> (Id.t * bool) option
 
-module VarSet :
-sig
-  type t
-  val empty : t
-  val full : t
-  val variables : Environ.env -> t
-end
-
-type naming_mode = VarSet.t
-
 val new_evar :
   ?src:Evar_kinds.t Loc.located -> ?filter:Filter.t ->
   ?relevance:ERelevance.t ->
@@ -44,7 +34,6 @@ val new_evar :
   ?parent:Evar.t ->
   ?typeclass_candidate:bool ->
   ?rrpat:bool ->
-  ?hypnaming:naming_mode ->
   env -> evar_map -> types -> evar_map * EConstr.t
 
 (** Alias of {!Evd.new_pure_evar} *)
@@ -63,7 +52,6 @@ val new_pure_evar :
 val new_type_evar :
   ?src:Evar_kinds.t Loc.located -> ?filter:Filter.t ->
   ?naming:intro_pattern_naming_expr ->
-  ?hypnaming:naming_mode ->
   env -> evar_map -> rigid ->
   evar_map * (constr * ESorts.t)
 
@@ -128,7 +116,6 @@ val jv_nf_evar :
 val tj_nf_evar :
    evar_map -> unsafe_type_judgment -> unsafe_type_judgment
 
-val nf_named_context_evar : evar_map -> Constr.named_context -> Constr.named_context
 val nf_rel_context_evar : evar_map -> rel_context -> rel_context
 val nf_env_evar : evar_map -> env -> env
 
@@ -150,7 +137,7 @@ val nf_evars_universes : evar_map -> Constr.constr -> Constr.constr
 
     Note that the normalizer passed to [f] holds some imperative state
    in its closure. *)
-val finalize : ?abort_on_undefined_evars:bool -> evar_map ->
+val finalize : ?abort_on_undefined_evars:bool -> ?poly:PolyFlags.t -> evar_map ->
   ((EConstr.t -> Constr.t) -> 'a) ->
   evar_map * 'a
 
@@ -199,6 +186,8 @@ type unification_pb = conv_pb * env * constr * constr
     Put it at the end of the list if [tail] is true, by default it is false. *)
 val add_unification_pb : ?tail:bool -> unification_pb -> evar_map -> evar_map
 
+val vars_of_global : env -> evar_map -> GlobRef.t -> Id.Set.t
+
 (** {6 Removing hyps in evars'context}
 raise OccurHypInSimpleClause if the removal breaks dependencies *)
 
@@ -238,7 +227,7 @@ val csubst_subst : Evd.evar_map -> csubst -> constr -> constr
 
 type ext_named_context
 
-val ext_named_context_of_env : hypnaming:naming_mode -> env -> evar_map -> ext_named_context
+val ext_named_context_of_env : env -> evar_map -> ext_named_context
 
 val ext_named_context_val : ext_named_context -> named_context_val
 val ext_csubst : ext_named_context -> csubst
@@ -247,10 +236,10 @@ val default_ext_instance : ext_named_context -> constr SList.t
 
 val ext_rev_subst : ext_named_context -> Id.t -> constr
 
-val push_rel_decl_to_named_context : hypnaming:naming_mode ->
+val push_rel_decl_to_named_context :
   evar_map -> rel_declaration -> ext_named_context -> ext_named_context
 
-val push_rel_context_to_named_context : hypnaming:naming_mode ->
+val push_rel_context_to_named_context :
   Environ.env -> evar_map -> types ->
   named_context_val * types * constr SList.t * csubst
 
diff --git a/engine/evd.ml b/engine/evd.ml
index f10d71c84e27..85d325801689 100644
--- a/engine/evd.ml
+++ b/engine/evd.ml
@@ -257,15 +257,15 @@ let evar_hyps evi = evi.evar_hyps
 let evar_filtered_hyps evi = match Filter.repr (evar_filter evi) with
 | None -> evar_hyps evi
 | Some filter ->
-  let rec make_hyps filter ctxt = match filter, ctxt with
-  | [], [] -> empty_named_context_val
-  | false :: filter, _ :: ctxt -> make_hyps filter ctxt
-  | true :: filter, decl :: ctxt ->
+  let rec make_hyps filter ctxt = match filter, match_named_context_val ctxt with
+  | [], None -> empty_named_context_val
+  | false :: filter, Some (_, _,  ctxt) -> make_hyps filter ctxt
+  | true :: filter, Some (status, decl, ctxt) ->
     let hyps = make_hyps filter ctxt in
-    push_named_context_val decl hyps
+    push_named_context_val status decl hyps
   | _ -> instance_mismatch ()
   in
-  make_hyps filter (evar_context evi)
+  make_hyps filter (evar_hyps evi)
 
 let evar_env env evi =
   Environ.reset_with_named_context evi.evar_hyps env
@@ -290,7 +290,7 @@ let map_when_undefined (type a b) f : (a, b) when_undefined -> (a, b) when_undef
 let map_evar_info f evi =
   {evi with
     evar_body = map_evar_body f evi.evar_body;
-    evar_hyps = map_named_val (fun d -> NamedDecl.map_constr f d) evi.evar_hyps;
+    evar_hyps = map_named_val (fun status d -> status, NamedDecl.map_constr f d) evi.evar_hyps;
     evar_concl = map_when_undefined f evi.evar_concl;
     evar_candidates = map_when_undefined (fun c -> Option.map (List.map f) c) evi.evar_candidates }
 
@@ -308,7 +308,7 @@ let evar_instance_array empty push info args =
     else match args with
     | SList.Nil -> assert false
     | SList.Cons (c, args) ->
-      let d = Range.get info.evar_hyps.env_named_idx pos in
+      let d = Environ.lookup_named_ctxt_pos pos info.evar_hyps in
       let id = NamedDecl.get_id d in
       push id c (instpush (pos + 1) (n - 1) filter args)
     | SList.Default (m, args) ->
@@ -320,7 +320,7 @@ let evar_instance_array empty push info args =
     let rec instance pos args = match args with
     | SList.Nil -> empty
     | SList.Cons (c, args) ->
-      let d = Range.get info.evar_hyps.env_named_idx pos in
+      let d = Environ.lookup_named_ctxt_pos pos info.evar_hyps in
       let id = NamedDecl.get_id d in
       push id c (instance (pos + 1) args)
     | SList.Default (n, args) -> instance (pos + n) args
@@ -651,8 +651,6 @@ let is_obligation_evar evd evk =
 
 let get_impossible_case_evars evd = evd.evar_flags.impossible_case_evars
 
-let get_rewrite_rule_evars evd = evd.evar_flags.rewrite_rule_evars
-
 let is_rewrite_rule_evar evd evk =
   let flags = evd.evar_flags in
   Evar.Set.mem evk flags.rewrite_rule_evars
@@ -814,11 +812,10 @@ let evar_handler sigma =
     | Def _ | Undef _ | Primitive _ | Symbol _ as body -> body
     in
     let drop_code = function
-    | None -> Vmemitcodes.BCconstant
-    | Some (Vmemitcodes.BCdefined (mask, idx, patch)) ->
+    | Vmemitcodes.BCdefined (mask, idx, patch) ->
       let code () = Environ.lookup_vm_code idx env in
       Vmemitcodes.BCdefined (mask, code, patch)
-    | Some (BCalias _ | BCconstant as code) -> code
+    | BCalias _ | BCconstant | BCuncompiled as code -> code
     in
     { cb with const_body = drop_opaque cb.const_body; const_body_code = drop_code cb.const_body_code }
   in
@@ -894,9 +891,13 @@ let empty = {
   extras = Store.empty;
 }
 
-let from_env ?binders e = { empty with universes = UState.from_env ?binders e }
+let from_env e = { empty with universes = UState.from_env e }
+
+let from_ustate uctx = { empty with universes = uctx }
 
-let from_ctx uctx = { empty with universes = uctx }
+let from_ctx = from_ustate
+
+let from_auctx e names = { empty with universes = UState.from_auctx e names }
 
 let has_undefined evd = not (EvMap.is_empty evd.undf_evars)
 
@@ -904,12 +905,16 @@ let has_given_up evd = not (Evar.Set.is_empty evd.given_up)
 
 let has_shelved evd = not (List.for_all List.is_empty evd.shelf)
 
-let merge_universe_context evd uctx' =
+let merge_ustate evd uctx' =
   { evd with universes = UState.union evd.universes uctx' }
 
-let set_universe_context evd uctx' =
+let merge_universe_context = merge_ustate
+
+let set_ustate evd uctx' =
   { evd with universes = uctx' }
 
+let set_universe_context = set_ustate
+
 (* TODO: make unique *)
 let add_conv_pb ?(tail=false) pb d =
   if tail then {d with conv_pbs = d.conv_pbs @ [pb]}
@@ -934,6 +939,8 @@ let is_aliased_evar evd evk =
   with Not_found -> None
 
 let downcast evk ccl evd =
+  if is_rewrite_rule_evar evd evk then
+    CErrors.anomaly Pp.(str "Tried to define or restrict a rewrite rule evar.");
   let evar_info = EvMap.find evk evd.undf_evars in
   let evar_info' = { evar_info with evar_concl = Undefined ccl } in
   { evd with undf_evars = EvMap.add evk evar_info' evd.undf_evars }
@@ -1007,14 +1014,15 @@ let ustate d = d.universes
 
 let elim_graph d = UState.elim_graph d.universes
 
-let evar_universe_context d = ustate d
-
 let universe_context_set d = UState.universe_context_set d.universes
 
 let sort_context_set d = UState.sort_context_set d.universes
 
 let to_universe_context evd = UState.context evd.universes
 
+let quality_printer evd = UState.quality_printer (ustate evd)
+let sort_printer evd = UState.sort_printer (ustate evd)
+
 let univ_entry ~poly evd = UState.univ_entry ~poly evd.universes
 
 let check_univ_decl ~poly evd decl = UState.check_univ_decl ~poly evd.universes decl
@@ -1031,46 +1039,47 @@ let check_univ_decl_early ~poly ~with_obls sigma udecl terms =
   in
   let vars = List.fold_left (fun acc b -> Univ.Level.Set.union acc (Vars.universes_of_constr b)) Univ.Level.Set.empty terms in
   let uctx = ustate sigma in
-  let uctx = UState.collapse_sort_variables uctx in
+  let uctx = UState.collapse_sort_variables ~only_above_prop:(not @@ PolyFlags.collapse_sort_variables poly) uctx in
   let uctx = UState.restrict uctx vars in
   ignore (UState.check_univ_decl ~poly uctx udecl)
 
-let restrict_universe_context evd vars =
+let restrict_ustate evd vars =
   { evd with universes = UState.restrict evd.universes vars }
 
+let restrict_universe_context = restrict_ustate
+
 let universe_subst evd =
   UState.subst evd.universes
 
 let merge_universe_context_set ?loc ?(sideff=false) rigid evd uctx' =
-  {evd with universes = UState.merge_universe_context ?loc ~sideff rigid evd.universes uctx'}
+  {evd with universes = UState.merge_universe_context_set ?loc ~sideff rigid evd.universes uctx'}
 
 let merge_sort_context_set ?loc ?sort_rigid ?(sideff=false) ?src rigid evd ctx' =
-  {evd with universes = UState.merge_sort_context ?loc ?sort_rigid ~sideff rigid ?src evd.universes ctx'}
+  {evd with universes = UState.merge_sort_context_set ?loc ?sort_rigid ~sideff rigid ?src evd.universes ctx'}
 
 let with_sort_context_set ?loc ?sort_rigid ?src rigid d (a, ctx) =
   (merge_sort_context_set ?loc ?sort_rigid ?src rigid d ctx, a)
 
 let new_univ_level_variable ?loc ?name rigid evd =
-  let uctx', u = UState.new_univ_variable ?loc rigid name evd.universes in
+  let uctx', u = UState.new_univ_level_variable ?loc rigid name evd.universes in
     ({evd with universes = uctx'}, u)
 
 let new_univ_variable ?loc ?name rigid evd =
-  let uctx', u = UState.new_univ_variable ?loc rigid name evd.universes in
-    ({evd with universes = uctx'}, Univ.Universe.make u)
+  let evd, u = new_univ_level_variable ?loc ?name rigid evd in
+  evd, Univ.Universe.make u
 
 let new_quality_variable ?loc ?name evd =
-  let uctx, q = UState.new_sort_variable ?loc ?name evd.universes in
+  let uctx, q = UState.new_quality_variable ?loc ?name evd.universes in
   {evd with universes = uctx}, q
 
 let new_sort_info ?loc ?sort_rigid ?name rigid sigma =
   let (sigma, u) = new_univ_variable ?loc rigid sigma in
-  let uctx, q = UState.new_sort_variable ?sort_rigid ?name sigma.universes in
+  let uctx, q = UState.new_quality_variable ?sort_rigid ?name sigma.universes in
   ({ sigma with universes = uctx }, q, u)
 
 let new_sort_variable ?loc ?sort_rigid ?name rigid sigma =
-  let (sigma, u) = new_univ_variable ?loc rigid sigma in
-  let uctx, q = UState.new_sort_variable ?loc ?sort_rigid ?name sigma.universes in
-  ({ sigma with universes = uctx }, Sorts.qsort q u)
+  let sigma, q, u = new_sort_info ?loc ?sort_rigid ?name rigid sigma in
+  sigma, Sorts.vsort q u
 
 let add_forgotten_univ d u =
   { d with universes = UState.add_forgotten_univ d.universes u }
@@ -1148,11 +1157,9 @@ let set_eq_sort evd s1 s2 =
   match is_eq_sort s1 s2 with
   | None -> evd
   | Some (u1, u2) ->
-    if not (UGraph.type_in_type (UState.ugraph evd.universes)) then
-      add_constraints evd
-        (UnivProblem.Set.singleton (UnivProblem.UEq (u1,u2)))
-    else
-      evd
+    if QGraph.ignore_constraints (UState.elim_graph evd.universes) then evd else
+    add_constraints evd
+      (UnivProblem.Set.singleton (UnivProblem.UEq (u1,u2)))
 
 let set_eq_level d u1 u2 =
   add_univ_constraints d (Univ.enforce_eq_level u1 u2 Univ.UnivConstraints.empty)
@@ -1170,10 +1177,8 @@ let set_leq_sort evd s1 s2 =
   match is_eq_sort s1 s2 with
   | None -> evd
   | Some (u1, u2) ->
-     if not (UGraph.type_in_type (UState.ugraph evd.universes)) then
-       add_constraints evd @@
-         UnivProblem.Set.singleton (UnivProblem.ULe (u1,u2))
-     else evd
+    add_constraints evd @@
+      UnivProblem.Set.singleton (UnivProblem.ULe (u1,u2))
 
 let set_eq_qualities evd q1 q2 =
   add_constraints evd @@ UnivProblem.Set.singleton (QEq (q1, q2))
@@ -1216,19 +1221,22 @@ let nf_univ_variables evd =
   let uctx = UState.normalize_variables evd.universes in
   {evd with universes = uctx}
 
-let collapse_sort_variables ?except evd =
-  let universes = UState.collapse_sort_variables ?except evd.universes in
+let collapse_sort_variables ?except ~only_above_prop evd =
+  let universes = UState.collapse_sort_variables ?except ~only_above_prop evd.universes in
   { evd with universes }
 
-let minimize_universes ?(collapse_sort_variables=true) evd =
-  let uctx' = if collapse_sort_variables
-    then UState.collapse_sort_variables evd.universes
-    else evd.universes
-  in
-  let uctx' = UState.normalize_variables uctx' in
+let minimize_universes_no_collapse evd =
+  let uctx' = UState.normalize_variables evd.universes in
   let uctx' = UState.minimize uctx' in
   {evd with universes = uctx'}
 
+let minimize_universes ?(poly=PolyFlags.default) evd =
+  let collapse_sort_variables = PolyFlags.collapse_sort_variables poly in
+  let uctx' =
+    UState.collapse_sort_variables ~only_above_prop:(not collapse_sort_variables) evd.universes
+  in
+  minimize_universes_no_collapse {evd with universes = uctx'}
+
 let universe_of_name evd s = UState.universe_of_name evd.universes s
 
 let quality_of_name evd s = UState.quality_of_name evd.universes s
@@ -1292,6 +1300,11 @@ let push_side_effects ?role ?ts name de ctx effs =
   } in
   kn, effs
 
+let avoid_side_effect_label id sigma =
+  let eff = sigma.effects in
+  let eff = { eff with seff_labels = Id.Set.add id eff.seff_labels } in
+  { sigma with effects = eff }
+
 let seff_mem_label id effs =
   Id.Set.mem id effs.seff_labels
 
@@ -1423,7 +1436,7 @@ let define_with_evar evk body evd =
 let restrict evk filter ?candidates ?src evd =
   let evk' = new_untyped_evar () in
   let evar_info = EvMap.find evk evd.undf_evars in
-  let len = Range.length evar_info.evar_hyps.env_named_idx in
+  let len = Environ.nb_named evar_info.evar_hyps in
   let id_inst = Filter.filter_slist filter (SList.defaultn len SList.empty) in
   let evar_info' =
     { evar_info with evar_filter = filter;
@@ -1476,7 +1489,7 @@ let set_extra_data extras evd = { evd with extras }
 (*******************************************************************)
 (* The state monad with state an evar map. *)
 
-module MonadR =
+module Monad =
   Monad.Make (struct
 
     type +'a t = evar_map -> evar_map * 'a
@@ -1496,26 +1509,6 @@ module MonadR =
 
   end)
 
-module Monad =
-  Monad.Make (struct
-
-    type +'a t = evar_map -> 'a * evar_map
-
-    let return a = fun s -> (a,s)
-
-    let (>>=) x f = fun s ->
-      let (a,s') = x s in
-      f a s'
-
-    let (>>) x y = fun s ->
-      let ((),s') = x s in
-      y s'
-
-    let map f x = fun s ->
-      on_fst f (x s)
-
-  end)
-
 (**********************************************************)
 (* Failure explanation *)
 
diff --git a/engine/evd.mli b/engine/evd.mli
index 30fd89e717d0..d3dea4102c9a 100644
--- a/engine/evd.mli
+++ b/engine/evd.mli
@@ -22,8 +22,7 @@ open Environ
     A unification state (of type [evar_map]) is primarily a finite mapping
     from existential variables to records containing the type of the evar
     ([evar_concl]), the context under which it was introduced ([evar_hyps])
-    and its definition ([evar_body]). [evar_extra] is used to add any other
-    kind of information.
+    and its definition ([evar_body]).
 
     It also contains conversion constraints, debugging information and
     information about meta variables. *)
@@ -164,19 +163,28 @@ type evar_map
 val empty : evar_map
 (** The empty evar map. *)
 
-val from_env : ?binders:lident list -> env -> evar_map
-(** The empty evar map with given universe context, taking its initial
-    universes from env, possibly with initial universe binders. This
-    is the main entry point at the beginning of the process of
+val from_env : env -> evar_map
+(** The empty evar map with given universe context,
+    taking its initial universes from env.
+    This is the main entry point at the beginning of the process of
     interpreting a declaration (e.g. before entering the
     interpretation of a Theorem statement). *)
 
-val from_ctx : UState.t -> evar_map
-(** The empty evar map with given universe context. This is the main
-    entry point when resuming from a already interpreted declaration
-    (e.g.  after having interpreted a Theorem statement and preparing
+val from_ustate : UState.t -> evar_map
+(** The empty evar map with given universe unification state. This is
+    the main entry point when resuming from an already interpreted declaration
+    (e.g. after having interpreted a Theorem statement and preparing
     to open a goal). *)
 
+val from_auctx : Environ.env -> UVars.AbstractContext.t -> evar_map
+(** The empty evar map with given universe context, taking its initial universes
+    from both the env and the variables in the universe context.
+    This is the entry point when restarting from an already finalized declaration
+    (e.g. for printing). *)
+
+val from_ctx : UState.t -> evar_map
+[@@deprecated "(9.3) Use [Evd.from_ustate]"]
+
 val is_empty : evar_map -> bool
 (** Whether an evarmap is empty. *)
 
@@ -363,9 +371,6 @@ val is_obligation_evar : evar_map -> Evar.t -> bool
 val get_impossible_case_evars : evar_map -> Evar.Set.t
 (** Set of undefined evars with ImpossibleCase evar source. *)
 
-val get_rewrite_rule_evars : evar_map -> Evar.Set.t
-(** Set of evars declared as an ununifiable rewrite rule evar *)
-
 val is_rewrite_rule_evar : evar_map -> Evar.t -> bool
 (** Is the evar declared as an ununifiable rewrite rule evar *)
 
@@ -414,6 +419,8 @@ val push_side_effects :
   Id.t -> Safe_typing.side_effect_declaration -> Univ.ContextSet.t ->
   side_effects -> Constant.t * side_effects
 
+val avoid_side_effect_label : Id.t -> evar_map -> evar_map
+
 (** {6 Accessors} *)
 
 val seff_mem_label : Id.t -> side_effects -> bool
@@ -490,10 +497,7 @@ val add_constraints : evar_map -> UnivProblem.Set.t -> evar_map
 
   Evar maps can contain arbitrary data, allowing to use an extensible state.
   As evar maps are theoretically used in a strict state-passing style, such
-  additional data should be passed along transparently. Some old and bug-prone
-  code tends to drop them nonetheless, so you should keep cautious.
-
-*)
+  additional data should be passed along transparently. *)
 
 module Store : Store.S
 (** Datatype used to store additional information in evar maps. *)
@@ -503,8 +507,7 @@ val set_extra_data : Store.t -> evar_map -> evar_map
 
 (** {5 The state monad with state an evar map} *)
 
-module MonadR : Monad.S with type +'a t = evar_map -> evar_map * 'a
-module Monad  : Monad.S with type +'a t = evar_map -> 'a * evar_map
+module Monad : Monad.S with type +'a t = evar_map -> evar_map * 'a
 
 (** Unification constraints *)
 type conv_pb = Conversion.conv_pb
@@ -562,8 +565,6 @@ val univ_flexible_alg : rigid
 
 type 'a in_ustate = 'a * UState.t
 
-val restrict_universe_context : evar_map -> Univ.Level.Set.t -> evar_map
-
 (** Raises Not_found if not a name for a universe in this map. *)
 val universe_of_name : evar_map -> Id.t -> Univ.Level.t
 val quality_of_name : evar_map -> Id.t -> Sorts.QVar.t
@@ -611,7 +612,9 @@ val check_quality_constraints : evar_map -> UVars.QPairSet.t -> bool
 
 val ustate : evar_map -> UState.t
 val elim_graph : evar_map -> QGraph.t
-val evar_universe_context : evar_map -> UState.t [@@deprecated "(9.0) Use [Evd.ustate]"]
+
+val quality_printer : evar_map -> Sorts.Quality.printer
+val sort_printer : evar_map -> Sorts.printer
 
 val universe_context_set : evar_map -> Univ.ContextSet.t
 val sort_context_set : evar_map -> UnivGen.sort_context_set
@@ -630,8 +633,18 @@ val check_univ_decl : poly:PolyFlags.t -> evar_map -> UState.universe_decl -> US
     starting to build a declaration interactively *)
 val check_univ_decl_early : poly:PolyFlags.t -> with_obls:bool -> evar_map -> UState.universe_decl -> Constr.t list -> unit
 
+val restrict_ustate : evar_map -> Univ.Level.Set.t -> evar_map
+val merge_ustate : evar_map -> UState.t -> evar_map
+val set_ustate : evar_map -> UState.t -> evar_map
+
+val restrict_universe_context : evar_map -> Univ.Level.Set.t -> evar_map
+[@@deprecated "(9.3) Use [Evd.restrict_ustate]"]
+
 val merge_universe_context : evar_map -> UState.t -> evar_map
+[@@deprecated "(9.3) Use [Evd.merge_ustate]"]
+
 val set_universe_context : evar_map -> UState.t -> evar_map
+[@@deprecated "(9.3) Use [Evd.set_ustate]"]
 
 val merge_universe_context_set : ?loc:Loc.t -> ?sideff:bool -> rigid -> evar_map -> Univ.ContextSet.t -> evar_map
 
@@ -643,12 +656,14 @@ val with_sort_context_set : ?loc:Loc.t -> ?sort_rigid:bool -> ?src:UState.constr
 
 val nf_univ_variables : evar_map -> evar_map
 
-val collapse_sort_variables : ?except:Sorts.QVar.Set.t -> evar_map -> evar_map
+val collapse_sort_variables : ?except:Sorts.QVar.Set.t -> only_above_prop:bool -> evar_map -> evar_map
 
 val fix_undefined_variables : evar_map -> evar_map
 
-(** Universe minimization (collapse_sort_variables is true by default) *)
-val minimize_universes : ?collapse_sort_variables:bool -> evar_map -> evar_map
+val minimize_universes_no_collapse : evar_map -> evar_map
+
+(** Universe minimization *)
+val minimize_universes : ?poly:PolyFlags.t -> evar_map -> evar_map
 
 (** Lift [UState.update_sigma_univs] *)
 val update_sigma_univs : UGraph.t -> evar_map -> evar_map
diff --git a/engine/logic_monad.ml b/engine/logic_monad.ml
index 9e1e2017ce6a..c82439c937f4 100644
--- a/engine/logic_monad.ml
+++ b/engine/logic_monad.ml
@@ -101,6 +101,9 @@ struct
   let timeout = fun n t -> (); fun () ->
     Control.timeout n t ()
 
+  let alloc_limit = fun n t -> (); fun () ->
+    Control.alloc_limit n t ()
+
   let make f = (); fun () ->
     try f ()
     with e when CErrors.noncritical e ->
@@ -181,9 +184,23 @@ struct
       [split] is pattern-matching. *)
 
   type ('a, 'i, 'o, 'e) t =
-      { iolist : 'r. 'i -> ('e -> 'r NonLogical.t) ->
-                     ('a -> 'o -> ('e -> 'r NonLogical.t) -> 'r NonLogical.t) ->
-                     'r NonLogical.t }
+    { iolist : 'r. 'i -> ('e -> 'r) -> ('a -> 'o -> ('e -> 'r) -> 'r) -> 'r }
+  (* IMPORTANT: to play well with side-effects, all functions involved in the
+     above type must have AT LEAST the same arity as the one implied by their
+     type. This is to ensure that applying them to the expected arguments only
+     triggers side-effects once fully applied. If OCaml had a type for pure
+     functions a ~> b ⊆ a -> b, we could write this type instead as
+
+     type ('a, 'i, 'o, 'e) t =
+      { iolist : 'r. 'i ~> ('e -> 'r) ~> ('a ~> 'o ~> ('e -> 'r) -> 'r) -> 'r }
+
+     Alternatively we could use records but then it would incur a runtime
+     overhead.
+
+     An easy way to ensure that is to eta-expand the functions on sight.
+
+     Since the type is abstract in the API, this means we must locally enforce
+     this property only in this module. *)
 
   let return x =
     { iolist = fun s nil cons -> cons x s nil }
@@ -209,7 +226,7 @@ struct
     { iolist = fun s nil cons -> m.iolist s nil (fun _ s next -> cons () s next) }
 
   let lift m =
-    { iolist = fun s nil cons -> NonLogical.(m >>= fun x -> cons x s nil) }
+    { iolist = fun s nil cons -> cons (m ()) s nil }
 
   (** State related *)
 
@@ -242,39 +259,37 @@ struct
 
   (** For [reflect] and [split] see the "Backtracking, Interleaving,
       and Terminating Monad Transformers" paper.  *)
-  type ('a, 'e) reified = ('a, ('a, 'e) reified_, 'e) list_view_ NonLogical.t
-  and ('a, 'e) reified_ = {r : 'e -> ('a, 'e) reified} [@@unboxed]
+  type ('a, 'e) reified = { r : ('a, ('a, 'e) reified, 'e) list_view } [@@unboxed]
 
-  let rec reflect (m : ('a * 'o, 'e) reified) =
-    { iolist = fun s0 nil cons ->
-      let next = function
+  let rec reflect0 : type r. _ -> (_ -> r) -> (_ -> _ -> (_ -> r) -> r) -> r =
+    fun m nil cons ->
+      match m.r with
       | Nil e -> nil e
-      | Cons ((x, s), {r=l}) -> cons x s (fun e -> (reflect (l e)).iolist s0 nil cons)
-      in
-      NonLogical.(m >>= next)
-    }
+      | Cons ((x, s), l) -> cons x s (fun e -> reflect0 (l e) nil cons)
+
+  let reflect (m : ('a * 'o, 'e) reified) =
+    { iolist = fun s0 nil cons -> reflect0 m nil cons }
 
   let split m : (_ list_view, _, _, _) t =
-    let rnil e = NonLogical.return (Nil e) in
-    let rcons p s l = NonLogical.return (Cons ((p, s), {r=l})) in
+    let rnil e = Nil e in
+    let rcons p s l = Cons ((p, s), (fun e -> {r=l e})) in
     { iolist = fun s nil cons ->
-      let open NonLogical in
-      m.iolist s rnil rcons >>= begin function
+      begin match m.iolist s rnil rcons with
       | Nil e -> cons (Nil e) s nil
-      | Cons ((x, s), {r=l}) ->
+      | Cons ((x, s), l) ->
         let l e = reflect (l e) in
         cons (Cons (x, l)) s nil
       end }
 
   let run m s =
-    let rnil e = NonLogical.return (Nil e) in
+    let rnil e = {r=Nil e} in
     let rcons x s l =
       let p = (x, s) in
-      NonLogical.return (Cons (p, {r=l}))
+      {r=Cons (p, l)}
     in
     m.iolist s rnil rcons
 
-  let repr x = x
+  let repr x = x.r
 end
 
 module type Param = sig
@@ -326,7 +341,6 @@ struct
   type iexn = Exninfo.iexn
 
   type 'a reified = ('a, iexn) BackState.reified
-  type 'a reified_ = ('a, iexn) BackState.reified_
 
   (** Inherited from Backstate *)
 
@@ -379,10 +393,10 @@ struct
 
   let run m r s =
     let s = { wstate = P.wunit; ustate = P.uunit; rstate = r; sstate = s } in
-    let rnil e = NonLogical.return (Nil e) in
+    let rnil e = {r=Nil e} in
     let rcons x s l =
       let p = (x, s.sstate, s.wstate, s.ustate) in
-      NonLogical.return (Cons (p, {r=l}))
+      {r=Cons (p, l)}
     in
     m.iolist s rnil rcons
 
diff --git a/engine/logic_monad.mli b/engine/logic_monad.mli
index c262a99b1b6e..46ea83d40bb5 100644
--- a/engine/logic_monad.mli
+++ b/engine/logic_monad.mli
@@ -75,6 +75,8 @@ module NonLogical : sig
   val catch : 'a t -> (Exninfo.iexn -> 'a t) -> 'a t
   val timeout : float -> 'a t -> ('a, Exninfo.info) result t
 
+  val alloc_limit : Control.kilowords -> 'a t -> ('a * Control.kilowords, Exninfo.info) result t
+
   (** Construct a monadified side-effect. Exceptions raised by the argument are
       wrapped with {!Exception}. *)
   val make : (unit -> 'a) -> 'a t
@@ -145,9 +147,8 @@ module BackState : sig
   val lift : 'a NonLogical.t -> ('a, 's, 's, 'e) t
 
   type ('a, 'e) reified
-  type ('a, 'e) reified_
 
-  val repr : ('a, 'e) reified -> ('a, ('a, 'e) reified_, 'e) list_view_ NonLogical.t
+  val repr : ('a, 'e) reified -> ('a, ('a, 'e) reified, 'e) list_view
 
   val run : ('a, 'i, 'o, 'e) t -> 'i -> ('a * 'o, 'e) reified
 
@@ -201,9 +202,8 @@ module Logical (P:Param) : sig
   val lift : 'a NonLogical.t -> 'a t
 
   type 'a reified = ('a, Exninfo.iexn) BackState.reified
-  type 'a reified_ = ('a, Exninfo.iexn) BackState.reified_
 
-  val repr : 'a reified -> ('a, 'a reified_, Exninfo.iexn) list_view_ NonLogical.t
+  val repr : 'a reified -> ('a, 'a reified, Exninfo.iexn) list_view
 
   val run : 'a t -> P.e -> P.s -> ('a * P.s * P.w * P.u) reified
 
diff --git a/engine/namegen.ml b/engine/namegen.ml
index 108ac00b9013..524adcc47d1c 100644
--- a/engine/namegen.ml
+++ b/engine/namegen.ml
@@ -99,10 +99,6 @@ let is_constructor id =
   with Not_found ->
     false
 
-let is_section_variable env id =
-  try let _ = Environ.lookup_named id env in true
-  with Not_found -> false
-
 (**********************************************************************)
 (* Generating "intuitive" names from its type *)
 
@@ -145,7 +141,7 @@ let sort_hdchar = function
   | SProp -> "P"
   | Prop -> "P"
   | Set -> "S"
-  | Type _ | QSort _ -> "T"
+  | Type _ | GSort _ | VSort _ -> "T"
 
 let hdchar env sigma c =
   let rec hdrec k c =
@@ -401,7 +397,7 @@ let next_name_away_in_cases_pattern gen sigma env_t na avoid =
 
 let next_ident_away_in_goal env id avoid =
   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 env id)) in
+  let bad id = Id.Set.mem id avoid || (is_global id && not (Environ.mem_named id env)) in
   next_ident_away_from id bad
 
 let next_name_away_in_goal (type a) (gen : a Generator.t) env na (avoid : a) =
@@ -409,7 +405,7 @@ let next_name_away_in_goal (type a) (gen : a Generator.t) env na (avoid : a) =
     | Name id -> id
     | Anonymous -> default_non_dependent_ident in
   let id = if Generator.is_fresh gen id avoid then id else restart_subscript id in
-  let bad id = is_global id && not (is_section_variable env id) in
+  let bad id = is_global id && not (Environ.mem_named id env) in
   Generator.gen_ident ~filter:bad gen id avoid
 
 (* 3- Looks for next fresh name outside a list that is moreover valid
diff --git a/engine/proofview.ml b/engine/proofview.ml
index 5623c8a4a023..60e00a223312 100644
--- a/engine/proofview.ml
+++ b/engine/proofview.ml
@@ -41,7 +41,7 @@ let proofview p =
 let compact el ({ solution } as pv) =
   let nf c = Evarutil.nf_evar solution c in
   let nf0 c = EConstr.(to_constr ~abort_on_undefined_evars:false solution (of_constr c)) in
-  let nf_hyps hyps = Environ.map_named_val (fun d -> map_constr nf0 d) hyps in
+  let nf_hyps hyps = Environ.map_named_val (fun status d -> status, map_constr nf0 d) hyps in
   let size = Evd.fold (fun _ _ i -> i+1) solution 0 in
   let new_el = List.map (fun (hyps,t,ty) -> nf_hyps hyps, nf t, nf ty) el in
   let pruned_solution = Evd.drop_all_defined solution in
@@ -245,15 +245,15 @@ type +'a tactic = 'a Proof.t
 (** Applies a tactic to the current proofview. *)
 let apply ~name ~poly env t sp =
   let open Logic_monad in
-  NewProfile.profile "Proofview.apply" (fun () ->
-  let ans = Proof.repr (Proof.run t P.{trace=false; name; poly} (sp,env)) in
-  let ans = Logic_monad.NonLogical.run ans in
-  match ans with
+  NewProfile.profile "Proofview.apply" begin fun () ->
+  match Proof.repr (Proof.run t P.{trace=false; name; poly} (sp,env)) with
   | Nil (e, info) -> Exninfo.iraise (TacticFailure e, info)
   | Cons ((r, (state, env), status, info), _) ->
-    r, state, env, status, Trace.to_tree info)
-    ()
-
+    r, state, env, status, Trace.to_tree info
+  | exception (Exception e as src) ->
+    let (src, info) = Exninfo.capture src in
+    Exninfo.iraise (e, info)
+  end ()
 
 (** {7 Monadic primitives} *)
 
@@ -916,15 +916,19 @@ module Progress = struct
   let eq_named_context_val sigma1 sigma2 ctx1 ctx2 =
     let r_eq _ _ = true (* ignore relevances *) in
     let c1 = EConstr.named_context_of_val ctx1 and c2 = EConstr.named_context_of_val ctx2 in
+    (* should we check variable status? if x is secvar,
+       [rename x into x'; rename x' into x] loses the secvar status
+       so maybe should progress?
+       NB Don't forget to also change the fast path if we change this *)
     let eq_named_declaration d1 d2 =
       match d1, d2 with
       | LocalAssum (i1,t1), LocalAssum (i2,t2) ->
-         Context.eq_annot Names.Id.equal r_eq i1 i2 && eq_constr sigma1 sigma2 t1 t2
+        Context.eq_annot Names.Id.equal r_eq i1 i2 && eq_constr sigma1 sigma2 t1 t2
       | LocalDef (i1,c1,t1), LocalDef (i2,c2,t2) ->
-         Context.eq_annot Names.Id.equal r_eq i1 i2 && eq_constr sigma1 sigma2 c1 c2
-         && eq_constr sigma1 sigma2 t1 t2
+        Context.eq_annot Names.Id.equal r_eq i1 i2 && eq_constr sigma1 sigma2 c1 c2 &&
+        eq_constr sigma1 sigma2 t1 t2
       | _ ->
-         false
+        false
     in
     (* NB: can't use List.equal because it shortcuts on physical equality *)
     List.for_all2eq eq_named_declaration c1 c2
@@ -960,9 +964,11 @@ module Progress = struct
     let c1 = EConstr.named_context_of_val ctx1 in
     let c2 = EConstr.named_context_of_val ctx2 in
     let eq_named_declaration d1 d2 = match d1, d2 with
-    | LocalAssum (i1, _), LocalAssum (i2, _) -> Context.eq_annot Names.Id.equal r_eq i1 i2
-    | LocalDef (i1, _, _), LocalDef (i2, _, _) -> Context.eq_annot Names.Id.equal r_eq i1 i2
-    | _ -> false
+      | LocalAssum (i1, _), LocalAssum (i2, _) ->
+        Context.eq_annot Names.Id.equal r_eq i1 i2
+      | LocalDef (i1, _, _), LocalDef (i2, _, _) ->
+        Context.eq_annot Names.Id.equal r_eq i1 i2
+      | _ -> false
     in
     List.for_all2eq eq_named_declaration c1 c2
 
@@ -988,7 +994,7 @@ let tclPROGRESS t =
   (* [*_test] test absence of progress. [quick_test] is approximate
      whereas [exhaustive_test] is complete. *)
   let quick_test =
-    initial.solution == final.solution && initial.comb == final.comb
+    Evd.defined_map initial.solution == Evd.defined_map final.solution && initial.comb == final.comb
   in
   let test =
     quick_test ||
@@ -1004,9 +1010,9 @@ let tclPROGRESS t =
     let info = Exninfo.reify () in
     tclZERO ~info (CErrors.UserError Pp.(str "Failed to progress."))
 
-let _ = CErrors.register_handler begin function
+let () = CErrors.register_handler begin function
   | Logic_monad.Tac_Timeout ->
-    Some (Pp.str "[Proofview.tclTIMEOUT] Tactic timeout!")
+    Some (Pp.str "Tactic timeout!")
   | _ -> None
 end
 
@@ -1022,7 +1028,7 @@ let tclTIMEOUTF n t =
   Proof.current >>= fun envvar ->
   Proof.lift begin
     let open Logic_monad.NonLogical in
-    timeout n (Proof.repr (Proof.run t envvar initial)) >>= fun r ->
+    timeout n (make (fun () -> Proof.repr (Proof.run t envvar initial))) >>= fun r ->
     match r with
     | Error info -> return (Util.Inr (Logic_monad.Tac_Timeout, info))
     | Ok (Logic_monad.Nil e) -> return (Util.Inr e)
@@ -1037,6 +1043,37 @@ let tclTIMEOUTF n t =
 
 let tclTIMEOUT n t = tclTIMEOUTF (float_of_int n) t
 
+exception TacAllocLimit
+
+let () = CErrors.register_handler begin function
+  | TacAllocLimit -> Some (Pp.str "Alloc limit")
+  | _ -> None
+  end
+
+let tclALLOCLIMIT n t =
+  let open Proof in
+  let t = Proof.lift (Logic_monad.NonLogical.return ()) >> t in
+  Proof.get >>= fun initial ->
+  Proof.current >>= fun envvar ->
+  let r = Control.alloc_limit n (fun () -> Proof.repr (Proof.run t envvar initial)) () in
+  let () = match r with
+    | Error _ -> ()
+    | Ok (_, {kilowords=n}) ->
+      Feedback.msg_info Pp.(str "Allocated " ++ str Int64.(to_string (div n 1000L)) ++ str "Mw.")
+  in
+  let r = match r with
+    | Error info -> Inr (TacAllocLimit, info)
+    | Ok (Logic_monad.Nil e, _) -> Inr e
+    | Ok (Logic_monad.Cons (r, _), _) -> Inl r
+  in
+  match r with
+  | Inl (res,s,m,i) ->
+    Proof.set s >>
+    Proof.put m >>
+    Proof.update (fun _ -> i) >>
+    return res
+  | Inr (e, info) -> tclZERO ~info e
+
 let tclTIME s t =
   let pr_time t1 t2 n msg =
     let msg =
@@ -1103,7 +1140,7 @@ module Unsafe = struct
     Pv.modify (fun ps -> { solution = evd; comb = undefined evd ps.comb })
 
   let tclEVARUNIVCONTEXT ctx =
-    Pv.modify (fun ps -> { ps with solution = Evd.set_universe_context ps.solution ctx })
+    Pv.modify (fun ps -> { ps with solution = Evd.set_ustate ps.solution ctx })
 
   let push_future_goals p =
     { p with solution = Evd.push_future_goals p.solution }
diff --git a/engine/proofview.mli b/engine/proofview.mli
index 15b504a76aed..a5c76672e894 100644
--- a/engine/proofview.mli
+++ b/engine/proofview.mli
@@ -444,6 +444,8 @@ val tclCHECKINTERRUPT : unit tactic
 val tclTIMEOUTF : float -> 'a tactic -> 'a tactic
 val tclTIMEOUT  : int   -> 'a tactic -> 'a tactic
 
+val tclALLOCLIMIT : Control.kilowords -> 'a tactic -> 'a tactic
+
 (** [tclTIME s t] displays time for each atomic call to t, using s as an
     identifying annotation if present *)
 val tclTIME : string option -> 'a tactic -> 'a tactic
diff --git a/engine/termops.ml b/engine/termops.ml
index 213782a0d50c..70659d9389da 100644
--- a/engine/termops.ml
+++ b/engine/termops.ml
@@ -22,7 +22,6 @@ open Environ
 
 module RelDecl = Context.Rel.Declaration
 module NamedDecl = Context.Named.Declaration
-module CompactedDecl = Context.Compacted.Declaration
 
 module Internal = struct
 
@@ -62,7 +61,7 @@ module Internal = struct
 
   let print_named_context env sigma =
     hv 0 (fold_named_context
-            (fun env d pps ->
+            (fun env _status d pps ->
                pps ++ ws 2 ++ pr_var_decl env sigma d)
             env ~init:(mt ()))
 
@@ -74,7 +73,7 @@ module Internal = struct
   let print_env env sigma =
     let sign_env =
       fold_named_context
-        (fun env d pps ->
+        (fun env _status d pps ->
            let pidt =  pr_var_decl env sigma d in
            (pps ++ fnl () ++ pidt))
         env ~init:(mt ())
@@ -132,6 +131,11 @@ let evar_suggested_name env sigma evk =
   let (_, n) = Evar.Map.fold fold names (false, 0) in
   if n = 0 then id else Nameops.add_suffix id (string_of_int (pred n))
 
+let evar_string env sigma evk =
+  match Evd.evar_ident evk sigma with
+  | Some id -> Libnames.string_of_path id
+  | None -> Id.to_string (evar_suggested_name env sigma evk)
+
 let pr_existential_key env sigma evk =
 let open Evd in
 match evar_ident evk sigma with
@@ -144,9 +148,11 @@ let pr_decl env sigma (decl,ok) =
   let open NamedDecl in
   let print_constr = Internal.print_kconstr in
   match decl with
-  | LocalAssum ({binder_name=id},_) -> if ok then Id.print id else (str "{" ++ Id.print id ++ str "}")
-  | LocalDef ({binder_name=id},c,_) -> str (if ok then "(" else "{") ++ Id.print id ++ str ":=" ++
-                           print_constr env sigma c ++ str (if ok then ")" else "}")
+  | LocalAssum ({binder_name=id},_) ->
+    if ok then Id.print id else (str "{" ++ Id.print id ++ str "}")
+  | LocalDef ({binder_name=id},c,_) ->
+    str (if ok then "(" else "{") ++ Id.print id ++ str ":=" ++
+    print_constr env sigma c ++ str (if ok then ")" else "}")
 
 let pr_evar_source env sigma = function
   | Evar_kinds.NamedHole id -> Id.print id
@@ -267,8 +273,12 @@ let has_no_evar sigma =
 
 let pr_evd_level sigma = UState.pr_uctx_level (Evd.ustate sigma)
 
+let pr_evd_qglobal sigma = UState.pr_uctx_qglobal (Evd.ustate sigma)
+
 let pr_evd_qvar sigma = UState.pr_uctx_qvar (Evd.ustate sigma)
 
+let pr_evd_quality sigma q = Quality.pr (Evd.quality_printer sigma) q
+
 let reference_of_level sigma l = UState.qualid_of_level (Evd.ustate sigma) l
 
 let pr_evar_universe_context = UState.pr
@@ -430,19 +440,6 @@ let push_rels_assum assums =
   let open RelDecl in
   push_rel_context (List.map (fun (x,t) -> LocalAssum (x,t)) assums)
 
-let push_named_rec_types (lna,typarray,_) env =
-  let open NamedDecl in
-  let ctxt =
-    Array.map2_i
-      (fun i na t ->
-         let id = map_annot (function
-             | Name id -> id
-             | Anonymous -> anomaly (Pp.str "Fix declarations must be named.")) na
-         in  LocalAssum (id, lift i t))
-      lna typarray in
-  Array.fold_left
-    (fun e assum -> push_named assum e) env ctxt
-
 let lookup_rel_id id sign =
   let open RelDecl in
   let rec lookrec n = function
@@ -835,34 +832,6 @@ let free_rels sigma m =
   in
   frec 1 Int.Set.empty m
 
-let free_rels_and_unqualified_refs sigma t =
-  let rec aux k (gseen, vseen, ids as accu) t =
-    match EConstr.kind sigma t with
-    | Const _ | Ind _ | Construct _ | Var _ ->
-      let g, _ = EConstr.destRef sigma t in
-      if not (GlobRef.Set_env.mem g gseen) then begin
-        try
-          let gseen = GlobRef.Set_env.add g gseen in
-          let short = Nametab.shortest_qualid_of_global ~force_short:true Id.Set.empty g in
-          let dir, id = Libnames.repr_qualid short in
-          let ids = if DirPath.is_empty dir then Id.Set.add id ids else ids in
-          (gseen, vseen, ids)
-        with Not_found when !Flags.in_debugger || !Flags.in_ml_toplevel ->
-          accu
-      end else
-        accu
-    | Rel p ->
-      if p > k && not (Int.Set.mem (p - k) vseen) then
-        let vseen = Int.Set.add (p - k) vseen in
-        (gseen, vseen, ids)
-      else
-        accu
-    | _ ->
-      EConstr.fold_with_binders sigma succ aux k accu t in
-  let accu = (GlobRef.Set_env.empty, Int.Set.empty, Id.Set.empty) in
-  let (_, rels, ids) = aux 0 accu t in
-  rels, ids
-
 (* collects all metavar occurrences, in left-to-right order, preserving
  * repetitions and all. *)
 
@@ -909,10 +878,7 @@ 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 sigma a decl =
-  let open NamedDecl in
-  match decl with
-    | LocalAssum (_,t) -> dependent sigma a t
-    | LocalDef (_, body, t) -> dependent sigma a body || dependent sigma a t
+  NamedDecl.exists (dependent sigma a) decl
 
 let count_occurrences sigma m t =
   let open EConstr in
@@ -1040,9 +1006,13 @@ let ids_of_context env =
 let names_of_rel_context env =
   List.map RelDecl.get_name (rel_context env)
 
-let is_section_variable env id =
-  try let _ = Environ.lookup_named id env in true
-  with Not_found -> false
+let is_section_variable_sign ?check sign id =
+  match Environ.var_status_ctxt ?check id sign with
+  | SecVar -> true
+  | ProofVar -> false
+
+let is_section_variable_env ?check env id =
+  is_section_variable_sign ?check (Environ.named_context_val env) id
 
 let is_template_polymorphic_ref env sigma f =
   match EConstr.kind sigma f with
@@ -1061,8 +1031,10 @@ let is_template_polymorphic_ind env sigma f =
 let base_sort_cmp pb s0 s1 =
   match (s0,s1) with
   | SProp, SProp | Prop, Prop | Set, Set | Type _, Type _ -> true
-  | QSort (q1, _), QSort (q2, _) -> Sorts.QVar.equal q1 q2
-  | QSort _, _ | _, QSort _ -> false
+  | VSort (q1, _), VSort (q2, _) -> Sorts.QVar.equal q1 q2
+  | VSort _, _ | _, VSort _ -> false
+  | GSort (q1, _), GSort (q2, _) -> Sorts.QGlobal.equal q1 q2
+  | GSort _, _ | _, GSort _ -> false
   | SProp, _ | _, SProp -> false
   | Prop, Set | Prop, Type _ | Set, Type _ -> pb == Conversion.CUMUL
   | Set, Prop | Type _, Prop | Type _, Set -> false
@@ -1209,33 +1181,11 @@ 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_ctxt id ctxt); true with Not_found -> false
 
-let compact_named_context sigma 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 EConstr.eq_constr sigma 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 EConstr.eq_constr sigma c1 c2 && EConstr.eq_constr sigma 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
-  let aux _ = function
-  | LocalDef (id',c,t) when Id.equal id id'.binder_name -> push_named (LocalAssum (id',t))
-  | d -> push_named d in
+  let aux _ status = function
+  | LocalDef (id',c,t) when Id.equal id id'.binder_name -> push_named status (LocalAssum (id',t))
+  | d -> push_named status d in
   fold_named_context aux env ~init:(reset_context env)
 
 let global_vars_set env sigma constr =
@@ -1304,3 +1254,158 @@ let env_rel_context_chop k env =
   let ctx1,ctx2 = List.chop k rels in
   push_rel_context ctx2 (reset_with_named_context (named_context_val env) env),
   ctx1
+
+(** Terms as a datatype *)
+
+module ConstrData =
+struct
+
+open Constr
+
+type t = Constr.t
+
+let compare_invert f iv1 iv2 =
+  match iv1, iv2 with
+  | NoInvert, NoInvert -> 0
+  | NoInvert, CaseInvert _ -> -1
+  | CaseInvert _, NoInvert -> 1
+  | CaseInvert iv1, CaseInvert iv2 ->
+    Array.compare f iv1.indices iv2.indices
+
+let constr_ord_int f t1 t2 =
+  let open! Compare in
+  let fix_cmp (a1, i1) (a2, i2) =
+    compare [(Array.compare Int.compare,a1,a2); (Int.compare,i1,i2)]
+  in
+  let ctx_cmp f (_n1, p1) (_n2, p2) = f p1 p2 in
+  match kind t1, kind t2 with
+    | Cast (c1,_,_), _ -> f c1 t2
+    | _, Cast (c2,_,_) -> f t1 c2
+    (* Why this special case? *)
+    | App (c1,l1), _ when isCast c1 -> let c1 = pi1 (destCast c1) in f (mkApp (c1,l1)) t2
+    | _, App (c2,l2) when isCast c2 -> let c2 = pi1 (destCast c2) in f t1 (mkApp (c2,l2))
+    | Rel n1, Rel n2 -> Int.compare n1 n2
+    | 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) ->
+      compare [(Evar.compare, e1, e2); (SList.compare f, l1, l2)]
+    | Evar _, _ -> -1 | _, Evar _ -> 1
+    | Sort s1, Sort s2 -> Sorts.compare s1 s2
+    | Sort _, _ -> -1 | _, Sort _ -> 1
+    | Prod (_,t1,c1), Prod (_,t2,c2)
+    | Lambda (_,t1,c1), Lambda (_,t2,c2) -> compare [(f,t1,t2); (f,c1,c2)]
+    | Prod _, _ -> -1 | _, Prod _ -> 1
+    | Lambda _, _ -> -1 | _, Lambda _ -> 1
+    | LetIn (_,b1,t1,c1), LetIn (_,b2,t2,c2) -> compare [(f,b1,b2); (f,t1,t2); (f,c1,c2)]
+    | LetIn _, _ -> -1 | _, LetIn _ -> 1
+    | App (c1,l1), App (c2,l2) -> compare [(f,c1,c2); (Array.compare f, l1, l2)]
+    | App _, _ -> -1 | _, App _ -> 1
+    | Const (c1,_u1), Const (c2,_u2) -> Constant.UserOrd.compare c1 c2
+    | Const _, _ -> -1 | _, Const _ -> 1
+    | Ind (ind1, _u1), Ind (ind2, _u2) -> Ind.UserOrd.compare ind1 ind2
+    | Ind _, _ -> -1 | _, Ind _ -> 1
+    | Construct (ct1,_u1), Construct (ct2,_u2) -> Construct.UserOrd.compare ct1 ct2
+    | Construct _, _ -> -1 | _, Construct _ -> 1
+    | Case (_,_u1,pms1,(p1,_r1),iv1,c1,bl1), Case (_,_u2,pms2,(p2,_r2),iv2,c2,bl2) ->
+      compare [
+        (Array.compare f, pms1, pms2);
+        (ctx_cmp f, p1, p2);
+        (compare_invert f, iv1, iv2);
+        (f, c1, c2);
+        (Array.compare (ctx_cmp f), bl1, bl2);
+      ]
+    | Case _, _ -> -1 | _, Case _ -> 1
+    | Fix (ln1,(_,tl1,bl1)), Fix (ln2,(_,tl2,bl2)) ->
+      compare [(fix_cmp, ln1, ln2); (Array.compare f, tl1, tl2); (Array.compare f, bl1, bl2)]
+    | Fix _, _ -> -1 | _, Fix _ -> 1
+    | CoFix(ln1,(_,tl1,bl1)), CoFix(ln2,(_,tl2,bl2)) ->
+      compare [(Int.compare, ln1, ln2); (Array.compare f, tl1, tl2); (Array.compare f, bl1, bl2)]
+    | CoFix _, _ -> -1 | _, CoFix _ -> 1
+    | Proj (p1,_r1,c1), Proj (p2,_r2,c2) -> compare [(Projection.UserOrd.compare, p1, p2); (f, c1, c2)]
+    | Proj _, _ -> -1 | _, Proj _ -> 1
+    | Int i1, Int i2 -> Uint63.compare i1 i2
+    | Int _, _ -> -1 | _, Int _ -> 1
+    | Float f1, Float f2 -> Float64.total_compare f1 f2
+    | Float _, _ -> -1 | _, Float _ -> 1
+    | String s1, String s2 -> Pstring.compare s1 s2
+    | String _, _ -> -1 | _, String _ -> 1
+    | Array(_u1,t1,def1,ty1), Array(_u2,t2,def2,ty2) ->
+      compare [(Array.compare f, t1, t2); (f, def1, def2); (f, ty1, ty2)]
+    (*| Array _, _ -> -1 | _, Array _ -> 1*)
+
+let rec compare m n =
+  constr_ord_int compare m n
+
+let equal m n = Int.equal (compare m n) 0
+
+(* Exported hashing fonction on constr, used mainly in plugins. *)
+
+open UVars
+open Hashset.Combine
+
+let rec hash t =
+  match kind t with
+    | Var i -> combinesmall 1 (Id.hash i)
+    | Sort s -> combinesmall 2 (Sorts.hash s)
+    | Cast (c, k, t) ->
+      let hc = hash c in
+      let ht = hash t in
+      combinesmall 3 (combine3 hc (hash_cast_kind k) ht)
+    | Prod (_, t, c) -> combinesmall 4 (combine (hash t) (hash c))
+    | Lambda (_, t, c) -> combinesmall 5 (combine (hash t) (hash c))
+    | LetIn (_, b, t, c) ->
+      combinesmall 6 (combine3 (hash b) (hash t) (hash c))
+    | App (c,l) -> begin match kind c with
+        | Cast (c, _, _) -> hash (mkApp (c,l)) (* WTF *)
+        | _ -> combinesmall 7 (combine (hash_term_array l) (hash c))
+      end
+    | Evar (e,l) ->
+      combinesmall 8 (combine (Evar.hash e) (hash_term_list l))
+    | Const (c,u) ->
+      combinesmall 9 (combine (Constant.UserOrd.hash c) (Instance.hash u))
+    | Ind (ind,u) ->
+      combinesmall 10 (combine (Ind.UserOrd.hash ind) (Instance.hash u))
+    | Construct (c,u) ->
+      combinesmall 11 (combine (Construct.UserOrd.hash c) (Instance.hash u))
+    | Case (_ , u, pms, (p,r), iv, c, bl) ->
+      combinesmall 12 (combine5 (hash c) (hash_invert iv) (hash_term_array pms) (Instance.hash u)
+                         (combine3 (hash_under_context p) (Sorts.relevance_hash r) (hash_branches bl)))
+    | Fix (_ln ,(_, tl, bl)) ->
+      combinesmall 13 (combine (hash_term_array bl) (hash_term_array tl))
+    | CoFix(_ln, (_, tl, bl)) ->
+       combinesmall 14 (combine (hash_term_array bl) (hash_term_array tl))
+    | Meta n -> combinesmall 15 n
+    | Rel n -> combinesmall 16 n
+    | Proj (p,r, c) ->
+      combinesmall 17 (combine3 (Projection.UserOrd.hash p) (Sorts.relevance_hash r) (hash c))
+    | Int i -> combinesmall 18 (Uint63.hash i)
+    | Float f -> combinesmall 19 (Float64.hash f)
+    | String s -> combinesmall 20 (Pstring.hash s)
+    | Array(u,t,def,ty) ->
+      combinesmall 21 (combine4 (Instance.hash u) (hash_term_array t) (hash def) (hash ty))
+
+and hash_invert = function
+  | NoInvert -> 0
+  | CaseInvert {indices;} ->
+    combinesmall 1 (hash_term_array indices)
+
+and hash_term_array t =
+  Array.fold_left (fun acc t -> combine acc (hash t)) 0 t
+
+and hash_term_list t =
+  SList.Skip.fold (fun acc t -> combine (hash t) acc) 0 t
+
+and hash_under_context (_, t) = hash t
+
+and hash_branches bl =
+  Array.fold_left (fun acc t -> combine acc (hash_under_context t)) 0 bl
+
+end
+
+(* deprecated *)
+let is_section_variable env id =
+  try let _ = Environ.lookup_named id env in true
+  with Not_found -> false
diff --git a/engine/termops.mli b/engine/termops.mli
index 46fc0d85c44f..167713da5211 100644
--- a/engine/termops.mli
+++ b/engine/termops.mli
@@ -19,7 +19,6 @@ open EConstr
 (** about contexts *)
 val push_rel_assum : Name.t EConstr.binder_annot * types -> env -> env
 val push_rels_assum : (Name.t Constr.binder_annot * Constr.types) list -> env -> env
-val push_named_rec_types : Name.t Constr.binder_annot array * Constr.types array * 'a -> env -> env
 
 val lookup_rel_id : Id.t -> ('c, 't, 'r) Context.Rel.pt -> int * 'c option * 't
 (** Associates the contents of an identifier in a [rel_context]. Raise
@@ -81,10 +80,6 @@ val local_occur_var_in_decl : Evd.evar_map -> Id.t -> named_declaration -> bool
 
 val free_rels : Evd.evar_map -> constr -> Int.Set.t
 
-(* Return the list of unbound rels and unqualified reference (same
-   strategy as in Namegen) *)
-val free_rels_and_unqualified_refs : Evd.evar_map -> constr -> Int.Set.t * Id.Set.t
-
 (** [dependent m t] tests whether [m] is a subterm of [t] *)
 val dependent : Evd.evar_map -> constr -> constr -> bool
 val dependent_no_evar : Evd.evar_map -> constr -> constr -> bool
@@ -199,7 +194,6 @@ val fold_named_context_both_sides :
   ('a -> Constr.named_declaration -> Constr.named_declaration list -> 'a) ->
     Constr.named_context -> init:'a -> 'a
 val mem_named_context_val : Id.t -> named_context_val -> bool
-val compact_named_context : Evd.evar_map -> EConstr.named_context -> EConstr.compacted_context
 
 val clear_named_body : Id.t -> env -> env
 
@@ -211,8 +205,15 @@ val global_app_of_constr : Evd.evar_map -> constr -> (GlobRef.t * EInstance.t) *
    containing a given set *)
 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 *)
+(** This tests if the ident is known in the given env, intended to be used with the global env. *)
 val is_section_variable : env -> Id.t -> bool
+[@@deprecated "Use is_section_variable_env on the local env instead of is_section_variable on the global env."]
+
+(** Check if the ident has [SecVar] status in this enviroment.
+    By default [check=true] and produce anomaly if it is not bound.
+    If [check=false] returns [false] if it is not bound. *)
+val is_section_variable_sign : ?check:bool -> Environ.named_context_val -> Id.t -> bool
+val is_section_variable_env : ?check:bool -> env -> Id.t -> bool
 
 val is_template_polymorphic_ref : env -> Evd.evar_map -> constr -> bool
 val is_template_polymorphic_ind : env -> Evd.evar_map -> constr -> bool
@@ -230,6 +231,7 @@ open Evd
 val pr_global_env : env -> GlobRef.t -> Pp.t
 
 val pr_existential_key : env -> evar_map -> Evar.t -> Pp.t
+val evar_string : env -> evar_map -> Evar.t -> string
 
 val evar_suggested_name : env -> evar_map -> Evar.t -> Id.t
 
@@ -239,7 +241,19 @@ val pr_evar_map : ?with_univs:bool -> int option -> env -> evar_map -> Pp.t
 val pr_evar_map_filter : ?with_univs:bool -> (Evar.t -> any_evar_info -> bool) ->
   env -> evar_map -> Pp.t
 val pr_evd_level : evar_map -> Univ.Level.t -> Pp.t
+val pr_evd_qglobal : evar_map -> Sorts.QGlobal.t -> Pp.t
 val pr_evd_qvar : evar_map -> Sorts.QVar.t -> Pp.t
+val pr_evd_quality : evar_map -> Sorts.Quality.t -> Pp.t
+
+(* Treat terms as a concrete data type with an otherwise unspecified
+   representation. You should be wary about the lack of invariants of this API. *)
+module ConstrData :
+sig
+type t = Constr.t
+val compare : t -> t -> int
+val equal : t -> t -> bool
+val hash : t -> int
+end
 
 module Internal : sig
 
diff --git a/engine/uState.ml b/engine/uState.ml
index 2538da7e67b2..bb9a46ea7d37 100644
--- a/engine/uState.ml
+++ b/engine/uState.ml
@@ -29,8 +29,8 @@ module PContextSet = struct
   let add_level u (univs, cst) =
     Level.Set.add u univs, cst
 
-  let pr prv prl (univs, cst) =
-    UnivGen.pr_sort_context prv prl ((Sorts.QVar.Set.empty, univs), cst)
+  let pr printer (univs, cst) =
+    UnivGen.pr_sort_context printer ((Sorts.QVar.Set.empty, univs), cst)
 
   let univ_context_set (uvars, (_, uctx)) = (uvars, uctx)
   let univ_constraints (_, (_,csts)) = csts
@@ -76,7 +76,13 @@ type uinfo = {
 
 open Quality
 
+exception SortInconsistency of UGraph.univ_inconsistency
+
 let sort_inconsistency ?explain cst l r =
+  let explain = Option.map (fun p -> UGraph.Other p) explain in
+  raise (SortInconsistency (None, (cst, l, r, explain)))
+
+let univ_inconsistency ?explain cst l r =
   let explain = Option.map (fun p -> UGraph.Other p) explain in
   raise (UGraph.UniverseInconsistency (None, (cst, l, r, explain)))
 
@@ -95,8 +101,8 @@ module QState : sig
   val unify_quality : fail:(unit -> t) -> Conversion.conv_pb -> Quality.t -> Quality.t -> t -> t
   val undefined : t -> QVar.Set.t
   val collapse_above_prop : to_prop:bool -> t -> t
-  val collapse : ?except:QVar.Set.t -> t -> t
-  val pr : (QVar.t -> Libnames.qualid option) -> t -> Pp.t
+  val collapse : ?except:QVar.Set.t -> only_above_prop:bool -> t -> t
+  val pr : Sorts.Quality.printer -> (QVar.t -> Id.t option) -> t -> Pp.t
   val of_elims : QGraph.t -> t
   val elims : t -> QGraph.t
   val set_elims : QGraph.t -> t -> t
@@ -106,10 +112,13 @@ module QState : sig
 end =
 struct
 
+type node =
+| Equiv of Quality.t
+| Canonical of { rigid : bool }
+(** Rigid variables may not be set to another *)
+
 type t = {
-  rigid : QSet.t;
-  (** Rigid variables, may not be set to another *)
-  qmap : Quality.t option QMap.t;
+  qmap : node QMap.t;
   (* TODO: use a persistent union-find structure *)
   above_prop : QSet.t;
   (** Set for quality variables known to be either in Prop or Type.
@@ -122,57 +131,91 @@ type t = {
 
 type elt = QVar.t
 
-let empty = { rigid = QSet.empty; qmap = QMap.empty; above_prop = QSet.empty;
+let empty = { qmap = QMap.empty; above_prop = QSet.empty;
               elims = QGraph.initial_graph; initial_elims = QGraph.initial_graph }
 
 let rec repr q m = match QMap.find q m.qmap with
-| None -> QVar q
-| Some (QVar q) -> repr q m
-| Some (QConstant _ as q) -> q
+| Canonical _ -> QVar q
+| Equiv (QVar q) -> repr q m
+| Equiv (QConstant _ | QGlobal _ as q) -> q
 | exception Not_found -> QVar q
 
+type repr =
+| ReprConstant of Quality.constant
+| ReprGlobal of QGlobal.t
+| ReprVar of QVar.t * bool
+
+let rec repr_node_qvar q m = match QMap.find q m.qmap with
+| Canonical { rigid } -> ReprVar (q, rigid)
+| Equiv q -> repr_node q m
+| exception Not_found -> ReprVar (q, true) (* a bit dubious but missing variables are considered rigid *)
+
+and repr_node q m = match q with
+| QVar q -> repr_node_qvar q m
+| (QConstant qc) -> ReprConstant qc
+| (QGlobal q) -> ReprGlobal q
+
 let is_above_prop m q = QSet.mem q m.above_prop
 
 let eliminates_to_prop m q =
   QGraph.eliminates_to_prop m.elims (QVar q)
 
-let is_rigid m q = QSet.mem q m.rigid || not (QMap.mem q m.qmap)
+let is_rigid m q = match repr_node_qvar q m with
+| ReprVar (_, rigid) -> rigid
+| ReprConstant _ | ReprGlobal _ -> true
 
 let set q qv m =
-  let q = repr q m in
-  let q = match q with QVar q -> q | QConstant _ -> assert false in
-  let qv = match qv with QVar qv -> repr qv m | (QConstant _ as qv) -> qv in
-  let enforce_eq q1 q2 g = QGraph.enforce_eliminates_to q1 q2 (QGraph.enforce_eliminates_to q2 q1 g) in
-  match q, qv with
-  | q, QVar qv ->
+  let q = repr_node_qvar q m in
+  let q, rigid = match q with
+    | ReprVar (q, rigid) -> q, rigid
+    | ReprConstant _ | ReprGlobal _ -> assert false
+  in
+  let qv = repr_node qv m in
+  let enforce_eq q1 q2 g =
+    let ans = QGraph.enforce_eliminates_to q1 q2 (QGraph.enforce_eliminates_to q2 q1 g) in
+    let () = QGraph.check_rigid_paths ans in
+    ans
+  in
+  match qv with
+  | ReprVar (qv, _qvrigd) ->
     if QVar.equal q qv then Some m
-    else
-    if QSet.mem q m.rigid then None
+    else if rigid then None
     else
       let above_prop =
         if is_above_prop m q
         then QSet.add qv (QSet.remove q m.above_prop)
         else m.above_prop in
-      Some { rigid = m.rigid; qmap = QMap.add q (Some (QVar qv)) m.qmap; above_prop;
-             elims = enforce_eq (QVar qv) (QVar q) m.elims; initial_elims = m.initial_elims }
-  | q, (QConstant qc as qv) ->
+      Some { m with
+             qmap = QMap.add q (Equiv (QVar qv)) m.qmap; above_prop;
+             elims = enforce_eq (QVar qv) (QVar q) m.elims; }
+  | ReprConstant qc ->
     if qc == QSProp && (is_above_prop m q || eliminates_to_prop m q) then None
-    else if QSet.mem q m.rigid then None
+    else if rigid then None
     else
-      Some { m with rigid = m.rigid; qmap = QMap.add q (Some qv) m.qmap;
+      let qv = QConstant qc in
+      Some { m with qmap = QMap.add q (Equiv qv) m.qmap;
+                    above_prop = QSet.remove q m.above_prop;
+                    elims = enforce_eq qv (QVar q) m.elims }
+  | ReprGlobal qg ->
+    if is_above_prop m q then None
+    else if rigid then None
+    else
+      let qv = QGlobal qg in
+      Some { m with qmap = QMap.add q (Equiv qv) m.qmap;
                     above_prop = QSet.remove q m.above_prop;
                     elims = enforce_eq qv (QVar q) m.elims }
 
 let set_above_prop q m =
-  let q = repr q m in
-  let q = match q with QVar q -> q | QConstant _ -> assert false in
-  if QSet.mem q m.rigid then None
+  let q = repr_node_qvar q m in
+  let q, rigid = match q with ReprVar (q, rigid) -> q, rigid | ReprConstant _ | ReprGlobal _ -> assert false in
+  if rigid then None
   else Some { m with above_prop = QSet.add q m.above_prop }
 
 let unify_quality ~fail c q1 q2 local = match q1, q2 with
 | QConstant QType, QConstant QType
 | QConstant QProp, QConstant QProp
 | QConstant QSProp, QConstant QSProp -> local
+| QGlobal q1, QGlobal q2 -> if QGlobal.equal q1 q2 then local else fail ()
 | QConstant QProp, QVar q when c == Conversion.CUMUL ->
   begin match set_above_prop q local with
   | Some local -> local
@@ -184,12 +227,13 @@ let unify_quality ~fail c q1 q2 local = match q1, q2 with
       | Some local -> local
       | None -> fail ()
   end
-| QVar q, (QConstant (QType | QProp | QSProp) as qv)
-| (QConstant (QType | QProp | QSProp) as qv), QVar q ->
+| QVar q, (QConstant (QType | QProp | QSProp) | QGlobal _ as qv)
+| (QConstant (QType | QProp | QSProp) | QGlobal _ as qv), QVar q ->
   begin match set q qv local with
   | Some local -> local
   | None -> fail ()
   end
+| QGlobal _, QConstant _| QConstant _, QGlobal _ -> fail ()
 | (QConstant QType, QConstant (QProp | QSProp)) -> fail ()
 | (QConstant QProp, QConstant QType) ->
   begin match c with
@@ -200,14 +244,15 @@ let unify_quality ~fail c q1 q2 local = match q1, q2 with
 | (QConstant QProp, QConstant QSProp) -> fail ()
 
 let nf_quality m = function
-  | QConstant _ as q -> q
+  | QConstant _ | QGlobal _ as q -> q
   | QVar q -> repr q m
 
 let add_qvars m qmap qs =
   let g = m.initial_elims in
-  let filter v = match QMap.find v qmap with
-    | None | exception Not_found -> true
-    | _ -> false in
+  let filter v = match QMap.find_opt v qmap with
+  | None | Some (Canonical _) -> true
+  | Some (Equiv _) -> false
+  in
   (* Here, we filter instead of enforcing equality due to the collapse:
      simply enforcing equality may lead to inconsistencies after it *)
   let qs = QVar.Set.filter filter qs in
@@ -218,21 +263,26 @@ let union ~fail s1 s2 =
   let extra = ref [] in
   let qmap = QMap.union (fun qk q1 q2 ->
       match q1, q2 with
-      | Some q, None | None, Some q -> Some (Some q)
-      | None, None -> Some None
-      | Some q1, Some q2 ->
+      | Equiv q, (Canonical {rigid}) | (Canonical {rigid}), Equiv q ->
+        assert (not rigid);
+        Some (Equiv q)
+      | Canonical { rigid = r1 }, Canonical { rigid = r2 } ->
+        assert (Bool.equal r1 r2);
+        Some (Canonical { rigid = r1 })
+      | Equiv q1, Equiv q2 ->
         let () = if not (Quality.equal q1 q2) then extra := (q1,q2) :: !extra in
-        Some (Some q1))
+        Some (Equiv q1))
       s1.qmap s2.qmap
   in
   let extra = !extra in
   let qs = QVar.Set.union (QGraph.qvar_domain s1.elims) (QGraph.qvar_domain s2.elims) in
-  let filter v = match QMap.find v qmap with
-    | None | exception Not_found -> true
-    | _ -> false in
+  let filter v = match QMap.find_opt v qmap with
+  | None | Some (Canonical _) -> true
+  | Some (Equiv _) -> false
+  in
   let above_prop = QSet.filter filter @@ QSet.union s1.above_prop s2.above_prop in
   let elims = add_qvars s2 qmap qs in
-  let s = { rigid = QSet.union s1.rigid s2.rigid; qmap; above_prop;
+  let s = { qmap; above_prop;
             elims; initial_elims = elims } in
   List.fold_left (fun s (q1,q2) ->
       let q1 = nf_quality s q1 and q2 = nf_quality s q2 in
@@ -246,70 +296,90 @@ let add ~check_fresh ~rigid q m =
     try QGraph.add_quality (QVar q) g
     with QGraph.AlreadyDeclared as e -> if check_fresh then raise e else g
   in
-  { rigid = if rigid then QSet.add q m.rigid else m.rigid;
-    qmap = QMap.add q None m.qmap;
+  { qmap = QMap.add q (Canonical { rigid }) m.qmap;
     above_prop = m.above_prop;
     elims = add_quality m.elims;
     initial_elims = add_quality m.initial_elims }
 
 let of_elims elims =
-  let qs = QGraph.qvar_domain elims in
-  let initial_elims =
-    QSet.fold (fun v -> QGraph.add_quality (QVar v)) qs (QGraph.initial_graph) in
-  let initial_elims = QGraph.update_rigids elims initial_elims in
-  { empty with rigid = qs; elims; initial_elims }
+  { empty with elims; initial_elims = elims }
 
 (* XXX what about qvars in the elimination graph? *)
 let undefined m =
-  let mq = QMap.filter (fun _ v -> Option.is_empty v) m.qmap in
+  let filter _ v = match v with
+  | Canonical _ -> true
+  | Equiv _ -> false
+  in
+  let mq = QMap.filter filter m.qmap in
   QMap.domain mq
 
 let collapse_above_prop ~to_prop m =
   QMap.fold (fun q v m ->
            match v with
-           | Some _ -> m
-           | None ->
+           | Equiv _ -> m
+           | Canonical _ ->
               if not @@ is_above_prop m q then m else
                 if to_prop then Option.get (set q qprop m)
                 else Option.get (set q qtype m)
          )
          m.qmap m
 
-let collapse ?(except=QSet.empty) m =
+let collapse ?(except=QSet.empty) ~only_above_prop m =
+  let free_qualities = QMap.fold (fun q v fqs ->
+      match v with
+      | Equiv _ -> fqs
+      | Canonical _ -> QSet.add q fqs)
+      m.qmap QSet.empty
+  in
+  let dominates_above_prop q q' =
+    not (QVar.equal q q') && QGraph.eliminates_to m.elims (QVar q) (QVar q') && not (QSet.mem q m.above_prop)
+  in
   QMap.fold (fun q v m ->
-           match v with
-           | Some _ -> m
-           | None -> if QSet.mem q m.rigid || QSet.mem q except then m
-                    else Option.get (set q qtype m))
-         m.qmap m
-
-let pr prqvar_opt ({ qmap; elims; rigid } as m) =
+      match v with
+      | Equiv _ -> m
+      | Canonical { rigid } ->
+        if rigid || QSet.mem q except then m
+        (* This check is necessary because there is a particular scenario where we could end up
+           with an unsatisfied elimination constraint or an unnecessary elaborated elimination constraint to Type
+           (or some inexistent sort variable); if we simply defaulted sort variables to Type, as before.
+           This comes from a weird interaction with "above Prop". The scenario is:
+           - An unbound sort variable β might be set to be above Prop during unification, which in practice
+             should be equal to Prop.
+           - A rigid sort s eliminates to Prop explicitly (and β, since they are supposed to be equal)
+           - Collapsing β to Type means that now sort s eliminates to Type, but this is an undeclared constraint,
+             and therefore the declaration fails.
+
+           This check is therefore simply finding if the sort variable above Prop is dominated by another one.
+           If so, the sort variable collapses to Prop, otherwise to Type (if collapsing is enabled), or we keep it.
+        *)
+        else if QSet.mem q m.above_prop then
+          if QSet.exists (fun q' -> dominates_above_prop q' q) free_qualities then
+            Option.get (set q qprop m)
+          else Option.get (set q qtype m)
+        else if not only_above_prop then Option.get (set q qtype m) else m)
+    m.qmap m
+
+let pr prqvar local_name ({ qmap; elims } as m) =
   let open Pp in
-  (* Print the QVar using its name if any, e.g. "α1" or "s" *)
-  let prqvar q = match prqvar_opt q with
-    | None -> QVar.raw_pr q
-    | Some qid -> Libnames.pr_qualid qid
-  in
   (* Print the "body" of the QVar, e.g. "α1 := Type", "α2 >= Prop" *)
   let prbody u = function
-  | None ->
+  | Canonical { rigid } ->
     if is_above_prop m u then str " >= Prop"
-    else if QSet.mem u rigid then
+    else if rigid then
       str " (rigid)"
     else mt ()
-  | Some q ->
+  | Equiv q ->
     let q = Quality.pr prqvar q in
     str " := " ++ q
   in
   (* Print the "name" (given by the user) of the Qvar, e.g. "(named s)" *)
-  let prqvar_name q =
-    match prqvar_opt q with
-    | None -> mt ()
-    | Some qid -> str " (named " ++ Libnames.pr_qualid qid ++ str ")"
+  let prqvar_name q = match local_name q with
+  | None -> mt ()
+  | Some qid -> str " (named " ++ Id.print qid ++ str ")"
   in
   let prqvar_full (q1, q2) = QVar.raw_pr q1 ++ prbody q1 q2 ++ prqvar_name q1 in
   hov 0 (prlist_with_sep fnl prqvar_full (QMap.bindings qmap) ++
-    str " |=" ++ brk (1, 2) ++ hov 0 (QGraph.pr_qualities (Quality.pr prqvar) elims))
+    str " |=" ++ brk (1, 2) ++ hov 0 (QGraph.pr_qualities prqvar elims))
 
 let elims m = m.elims
 
@@ -322,14 +392,15 @@ let merge_constraints f m =
 
 let normalize_elim_constraints m cstrs =
   let subst q = match q with
-    | QConstant _ -> q
+    | QConstant _ | QGlobal _ -> q
     | QVar qv -> repr qv m
   in
   let is_instantiated q = is_qconst q || is_qglobal q in
   let can_drop (q1,_,q2) = not (is_instantiated q1 && is_instantiated q2) in
   let subst_cst (q1,c,q2) = (subst q1,c,subst q2) in
   let cstrs = ElimConstraints.map subst_cst cstrs in
-  ElimConstraints.filter can_drop cstrs
+  let cstrs = ElimConstraints.filter can_drop cstrs in
+  ElimConstraints.filter (fun (q1, _, q2) -> not @@ Quality.equal q1 q2) cstrs
 end
 
 module UPairSet = UnivMinim.UPairSet
@@ -359,13 +430,6 @@ let empty =
     initial_universes = UGraph.initial_universes;
     minim_extra = UnivMinim.empty_extra; }
 
-let make ~qualities univs =
-  { empty with
-    universes = univs;
-    initial_universes = univs ;
-    sort_variables = QState.of_elims qualities
-  }
-
 let is_empty uctx =
   PContextSet.is_empty uctx.local &&
   UnivFlex.is_empty uctx.univ_variables
@@ -387,7 +451,7 @@ let get_uname info = match info.uname with
 let qualid_of_qvar_names (bind, (qrev,_)) l =
   try Some (Libnames.qualid_of_ident (get_uname (QVar.Map.find l qrev)))
   with Not_found ->
-    UnivNames.qualid_of_quality bind l
+    UnivNames.qualid_of_quality bind (QVar l)
 
 let qualid_of_level_names (bind, (_,urev)) l =
   try Some (Libnames.qualid_of_ident (get_uname (Level.Map.find l urev)))
@@ -401,20 +465,36 @@ let pr_uctx_qvar_names names l =
   | Some qid -> Libnames.pr_qualid qid
   | None -> QVar.raw_pr l
 
+let quality_printer_names names = {
+  Sorts.Quality.prvar = pr_uctx_qvar_names names;
+  prglobal = (UnivNames.quality_printer (fst names)).prglobal;
+}
+
+let quality_printer uctx = quality_printer_names uctx.names
+
 let pr_uctx_level_names names l =
   match qualid_of_level_names names l with
   | Some qid -> Libnames.pr_qualid qid
   | None -> Level.raw_pr l
 
+let sort_printer_names names = {
+  Sorts.prq = quality_printer_names names;
+  pru = pr_uctx_level_names names;
+}
+
+let sort_printer uctx = sort_printer_names uctx.names
+
 let pr_uctx_level uctx l = pr_uctx_level_names uctx.names l
 
+let pr_uctx_qglobal uctx q =
+  UnivNames.pr_quality_with_global_universes ~binders:(fst uctx.names) (QGlobal q)
+
 let pr_uctx_qvar uctx l = pr_uctx_qvar_names uctx.names l
 
 let merge_univ_constraints uctx cstrs g =
   try UGraph.merge_constraints cstrs g
   with UGraph.UniverseInconsistency (_, i) ->
-    let printers = (pr_uctx_qvar uctx, pr_uctx_level uctx) in
-    raise (UGraph.UniverseInconsistency (Some printers, i))
+    raise (UGraph.UniverseInconsistency (Some (sort_printer uctx), i))
 
 type constraint_source =
 | Internal
@@ -433,8 +513,7 @@ let merge_elim_constraints ?(src = Internal) uctx cstrs g =
       let fold (q1, _, q2) accu = QGraph.add_rigid_path q1 q2 accu in
       Sorts.ElimConstraints.fold fold cstrs g
   with QGraph.(EliminationError (QualityInconsistency (_, i))) ->
-    let printer = pr_uctx_qvar uctx in
-    raise (QGraph.(EliminationError (QualityInconsistency (Some printer, i))))
+    raise (QGraph.(EliminationError (QualityInconsistency (Some (quality_printer uctx), i))))
 
 let uname_union s t =
   if s == t then s
@@ -465,10 +544,10 @@ let union uctx uctx' =
       Level.Set.fold (fun u g -> UGraph.add_universe u ~strict:false g) newus g
     in
     let fail_union s q1 q2 =
-      if UGraph.type_in_type uctx.universes then s
-      else CErrors.user_err
-          Pp.(str "Could not merge universe contexts: could not unify" ++ spc() ++
-             Quality.raw_pr q1 ++ strbrk " and " ++ Quality.raw_pr q2 ++ str ".")
+      if QGraph.ignore_constraints (QState.elims uctx.sort_variables) then s else
+      CErrors.user_err
+        Pp.(str "Could not merge universe contexts: could not unify" ++ spc() ++
+           Quality.raw_pr q1 ++ strbrk " and " ++ Quality.raw_pr q2 ++ str ".")
     in
       { names;
         local = local;
@@ -504,7 +583,7 @@ let compute_instance_binders uctx inst =
       begin try Name (get_uname (QVar.Map.find q qrev))
       with Not_found -> Anonymous
       end
-    | QConstant _ -> assert false
+    | QConstant _ | QGlobal _ -> assert false
   in
   let umap lvl =
     try Name (get_uname (Level.Map.find lvl urev))
@@ -547,6 +626,7 @@ let is_above_prop uctx qv = QState.is_above_prop uctx.sort_variables qv
 
 let is_algebraic l uctx = UnivFlex.is_algebraic l uctx.univ_variables
 
+(** Deprecated *)
 let of_names (ubind,(revqbind,revubind)) =
   let revqbind = QVar.Map.map (fun id -> { uname = Some id; uloc = None }) revqbind in
   let revubind = Level.Map.map (fun id -> { uname = Some id; uloc = None }) revubind in
@@ -608,7 +688,7 @@ let nf_relevance uctx r = match r with
 | RelevanceVar q ->
   match nf_qvar uctx q with
   | QConstant QSProp -> Sorts.Irrelevant
-  | QConstant QProp | QConstant QType -> Sorts.Relevant
+  | QConstant QProp | QConstant QType | QGlobal _ -> Sorts.Relevant
   | QVar q' ->
     (* XXX currently not used in nf_evars_and_universes_opt_subst
        does it matter? *)
@@ -641,7 +721,7 @@ let classify s = match s with
 | Prop -> USmall UProp
 | SProp -> USmall USProp
 | Set -> USmall USet
-| Type u | QSort (_, u) ->
+| Type u | GSort (_, u) | VSort (_, u) ->
   if Universe.is_levels u then match Universe.level u with
   | None -> UMax (u, Universe.levels u)
   | Some u -> ULevel u
@@ -688,9 +768,10 @@ let warn_template uctx csts =
   if not @@ UnivConstraints.is_empty csts then
     do_warn_template (uctx,csts)
 
-let unify_quality univs c s1 s2 l =
-  let fail () = if UGraph.type_in_type univs then l.local_sorts
-    else sort_inconsistency (get_constraint c) s1 s2
+let unify_quality c s1 s2 l =
+  let fail () =
+    if QGraph.ignore_constraints (QState.elims l.local_sorts) then l.local_sorts else
+    sort_inconsistency (get_constraint c) s1 s2
   in
   { l with
     local_sorts = QState.unify_quality ~fail
@@ -725,20 +806,20 @@ let process_constraints uctx cstrs =
     in
     if UGraph.check_eq_sort Sorts.Quality.equal univs ls s then local
     else if is_uset l then match classify s with
-    | USmall _ -> sort_inconsistency Eq set s
+    | USmall _ -> univ_inconsistency Eq set s
     | ULevel r ->
       if is_local r then
         let () = instantiate_variable r Universe.type0 vars in
         add_univ_local (Level.set, Eq, r) local
       else
-        sort_inconsistency Eq set s
+        univ_inconsistency Eq set s
     | UMax (u, _)| UAlgebraic u ->
       if univ_level_mem Level.set u then
         let inst = univ_level_rem Level.set u u in
         enforce_leq_up inst Level.set local
       else
-        sort_inconsistency Eq ls s
-    else sort_inconsistency Eq ls s
+        univ_inconsistency Eq ls s
+    else univ_inconsistency Eq ls s
   in
   let equalize_variables fo l' r' local =
     if Level.equal l' r' then local
@@ -767,7 +848,7 @@ let process_constraints uctx cstrs =
     else
       if univ_level_mem l ru then
         enforce_leq_up inst l local
-      else sort_inconsistency Eq (sort_of_univ (Universe.make l)) (sort_of_univ ru)
+      else univ_inconsistency Eq (sort_of_univ (Universe.make l)) (sort_of_univ ru)
   in
   let equalize_universes l r local = match classify l, classify r with
   | USmall l', (USmall _ | ULevel _ | UMax _ | UAlgebraic _) ->
@@ -781,7 +862,7 @@ let process_constraints uctx cstrs =
   | (UAlgebraic _ | UMax _), (UAlgebraic _ | UMax _) ->
     (* both are algebraic *)
     if UGraph.check_eq_sort Sorts.Quality.equal univs l r then local
-    else sort_inconsistency Eq l r
+    else univ_inconsistency Eq l r
   in
   let unify_universes cst local =
     let cst = nf_constraint local.local_sorts cst in
@@ -791,18 +872,18 @@ let process_constraints uctx cstrs =
          qualities instead of having to make a dummy sort *)
       let mk q = Sorts.make q Universe.type0 in
       match cst with
-    | QEq (a, b) -> unify_quality univs CONV (mk a) (mk b) local
-    | QLeq (a, b) -> unify_quality univs CUMUL (mk a) (mk b) local
+    | QEq (a, b) -> unify_quality CONV (mk a) (mk b) local
+    | QLeq (a, b) -> unify_quality CUMUL (mk a) (mk b) local
     | QElimTo (a, b) -> { local with local_cst = PConstraints.add_quality (a, ElimTo, b) local.local_cst }
     | ULe (l, r) ->
-      let local = unify_quality univs CUMUL l r local in
+      let local = unify_quality CUMUL l r local in
       let l = normalize_sort local.local_sorts l in
       let r = normalize_sort local.local_sorts r in
       begin match classify r with
       | UAlgebraic _ | UMax _ ->
         if UGraph.check_leq_sort Sorts.Quality.equal univs l r then local
         else
-          sort_inconsistency Le l r
+          univ_inconsistency Le l r
             ~explain:(Pp.str "(cannot handle algebraic on the right)")
       | USmall r' ->
         (* Invariant: there are no universes u <= Set in the graph. Except for
@@ -812,28 +893,28 @@ let process_constraints uctx cstrs =
         else begin match classify l with
         | UAlgebraic _ ->
           (* l contains a +1 and r=r' small so l <= r impossible *)
-          sort_inconsistency Le l r
+          univ_inconsistency Le l r
         | USmall l' ->
           if UGraph.check_leq_sort Sorts.Quality.equal univs l r then local
-          else sort_inconsistency Le l r
+          else univ_inconsistency Le l r
         | ULevel l' ->
           if is_uset r' && is_local l' then
             (* Unbounded universe constrained from above, we equalize it *)
             let () = instantiate_variable l' Universe.type0 vars in
             add_univ_local (l', Eq, Level.set) local
           else
-            sort_inconsistency Le l r
+            univ_inconsistency Le l r
         | UMax (_, levels) ->
           if is_uset r' then
             let fold l' local =
               let l = sort_of_univ @@ Universe.make l' in
               if Level.is_set l' || is_local l' then
                 equalize_variables false l' Level.set local
-              else sort_inconsistency Le l r
+              else univ_inconsistency Le l r
             in
             Level.Set.fold fold levels local
           else
-            sort_inconsistency Le l r
+            univ_inconsistency Le l r
         end
       | ULevel r' ->
         (* We insert the constraint in the graph even if the graph
@@ -849,7 +930,7 @@ let process_constraints uctx cstrs =
           { local with local_above_prop = Level.Set.add r' local.local_above_prop }
         | USmall USProp ->
           if UGraph.type_in_type univs then local
-          else sort_inconsistency Le l r
+          else univ_inconsistency Le l r
         | USmall USet ->
           add_univ_local (Level.set, Le, r') local
         | ULevel l' ->
@@ -866,14 +947,20 @@ let process_constraints uctx cstrs =
       then { local with local_weak = UPairSet.add (l, r) local.local_weak }
       else local
     | UEq (l, r) ->
-      let local = unify_quality univs CONV l r local in
+      let local = unify_quality CONV l r local in
       let l = normalize_sort local.local_sorts l in
       let r = normalize_sort local.local_sorts r in
       equalize_universes l r local
   in
   let unify_universes cst local =
-    if not (UGraph.type_in_type univs) then unify_universes cst local
-    else try unify_universes cst local with UGraph.UniverseInconsistency _ -> local
+    try unify_universes cst local
+    with
+      | SortInconsistency e
+        when QGraph.ignore_constraints (QState.elims local.local_sorts) -> local
+      | SortInconsistency e as exn ->
+        let info = Exninfo.info exn in
+        Exninfo.iraise (UGraph.UniverseInconsistency e, info)
+      | UGraph.UniverseInconsistency _ when UGraph.type_in_type univs -> local
   in
   let local = {
     local_cst = PConstraints.empty;
@@ -953,7 +1040,7 @@ let check_constraint uctx (c:UnivProblem.t) =
         match a, b with
         | QConstant QProp, QConstant QType -> true
         | QConstant QProp, QVar q -> QState.is_above_prop uctx.sort_variables q
-        | (QConstant _ | QVar _), _ -> false
+        | (QConstant _ | QVar _ | QGlobal _), _ -> false
       end
   | QElimTo (a, b) ->
     let a = nf_quality uctx a in
@@ -1108,7 +1195,7 @@ let check_elim_implication uctx cstrs cstrs' =
   if ElimConstraints.is_empty cstrs' then ()
   else CErrors.user_err
       Pp.(str "Elimination constraints are not implied by the ones declared: " ++
-          ElimConstraints.pr (pr_uctx_qvar uctx) cstrs')
+          ElimConstraints.pr (quality_printer uctx) cstrs')
 
 let check_implication uctx (elim_csts,univ_csts) (elim_csts',univ_csts') =
   check_univ_implication uctx univ_csts univ_csts';
@@ -1246,7 +1333,7 @@ let univ_flexible_alg = UnivFlexible true
 (** ~sideff indicates that it is ok to redeclare a universe.
     Also merges the universe context in the local constraint structures
     and not only in the graph. *)
-let merge_universe_context ?loc ~sideff rigid uctx (levels, ucst) =
+let merge_universe_context_set ?loc ~sideff rigid uctx (levels, ucst) =
   let declare g =
     Level.Set.fold (fun u g ->
         try UGraph.add_universe ~strict:false u g
@@ -1305,9 +1392,9 @@ let merge_sort_variables ?loc ?(sort_rigid=false) ?src ~sideff uctx (qvars, csts
   let local = (us, (Sorts.ElimConstraints.union qcst csts, ucst)) in
   { uctx with local; sort_variables; names }
 
-let merge_sort_context ?loc ?sort_rigid ?src ~sideff rigid uctx ((qvars, levels), (qcst, ucst)) =
+let merge_sort_context_set ?loc ?sort_rigid ?src ~sideff rigid uctx ((qvars, levels), (qcst, ucst)) =
   let uctx = merge_sort_variables ?loc ?sort_rigid ?src ~sideff uctx (qvars, qcst) in
-  merge_universe_context ?loc ~sideff rigid uctx (levels, ucst)
+  merge_universe_context_set ?loc ~sideff rigid uctx (levels, ucst)
 
 let demote_global_univs (lvl_set, univ_csts) uctx =
   let (local_univs, local_constraints) = uctx.local in
@@ -1382,6 +1469,14 @@ let add_loc l loc (names, (qnames_rev,unames_rev) as orig) =
   | None -> orig
   | Some _ -> (names, (qnames_rev, Level.Map.add l { uname = None; uloc = loc } unames_rev))
 
+let add_quality_variable ?loc ?(check_fresh=true) ~name ~rigid uctx q =
+  let sort_variables = QState.add ~check_fresh ~rigid q uctx.sort_variables in
+  let names = match name with
+    | Some n -> add_qnames ?loc n q uctx.names
+    | None -> add_qloc q loc uctx.names
+  in
+  { uctx with sort_variables; names }
+
 let add_universe ?loc name strict uctx u =
   let initial_universes = UGraph.add_universe ~strict u uctx.initial_universes in
   let universes = UGraph.add_universe ~strict u uctx.universes in
@@ -1393,19 +1488,12 @@ let add_universe ?loc name strict uctx u =
   in
   { uctx with names; local; initial_universes; universes }
 
-let new_sort_variable ?loc ?(sort_rigid = false) ?name uctx =
+let new_quality_variable ?loc ?(sort_rigid = false) ?name uctx =
   let q = UnivGen.fresh_sort_quality () in
   (* don't need to check_fresh as it's guaranteed new *)
-  let sort_variables = QState.add ~check_fresh:false ~rigid:(sort_rigid || Option.has_some name)
-      q uctx.sort_variables
-  in
-  let names = match name with
-    | Some n -> add_qnames ?loc n q uctx.names
-    | None -> add_qloc q loc uctx.names
-  in
-  { uctx with sort_variables; names }, q
+  add_quality_variable ?loc ~name ~rigid:(sort_rigid || Option.has_some name) uctx q, q
 
-let new_univ_variable ?loc rigid name uctx =
+let new_univ_level_variable ?loc rigid name uctx =
   let u = UnivGen.fresh_level () in
   let uctx =
     match rigid with
@@ -1419,18 +1507,22 @@ let new_univ_variable ?loc rigid name uctx =
 
 let add_forgotten_univ uctx u = add_universe None true uctx u
 
-let make_with_initial_binders ~qualities univs binders =
-  let uctx = make ~qualities univs in
-  List.fold_left
-    (fun uctx { CAst.loc; v = id } ->
-       fst (new_univ_variable ?loc univ_rigid (Some id) uctx))
-    uctx binders
+let from_env env =
+  { empty with
+    universes = Environ.universes env;
+    initial_universes = Environ.universes env;
+    sort_variables = QState.of_elims (Environ.qualities env);
+  }
 
-let from_env ?(binders=[]) env =
-  make_with_initial_binders
-    ~qualities:(Environ.qualities env)
-    (Environ.universes env)
-    binders
+let from_auctx env auctx =
+  let ustate = from_env env in
+  let names = AbstractContext.names auctx in
+  let name_to_option = function Name id -> Some id | Anonymous -> None in
+  (* Inlined call to [AbstractContext.repr] to know what qvars, levels and constraints to add *)
+  let ustate = Array.fold_left_i (fun i ustate name -> add_quality_variable ~rigid:true ~name:(name_to_option name) ustate (QVar.make_var i)) ustate names.quals in
+  let ustate = Array.fold_left_i (fun i ustate name -> add_universe (name_to_option name) false ustate (Level.var i)) ustate names.univs in
+  let ustate = add_poly_constraints ustate (AbstractContext.constraints auctx) in
+  ustate
 
 let make_nonalgebraic_variable uctx u =
   { uctx with univ_variables = UnivFlex.make_nonalgebraic_variable uctx.univ_variables u }
@@ -1469,8 +1561,8 @@ let collapse_above_prop_sort_variables ~to_prop uctx =
   let sorts = QState.collapse_above_prop ~to_prop uctx.sort_variables in
   normalize_quality_variables { uctx with sort_variables = sorts }
 
-let collapse_sort_variables ?except uctx =
-  let sorts = QState.collapse ?except uctx.sort_variables in
+let collapse_sort_variables ?except ~only_above_prop uctx =
+  let sorts = QState.collapse ?except ~only_above_prop uctx.sort_variables in
   normalize_quality_variables { uctx with sort_variables = sorts }
 
 let minimize uctx =
@@ -1549,7 +1641,7 @@ let check_uctx_impl ~fail uctx uctx' =
     let grext = elim_graph uctx in
     let cstrs' = ElimConstraints.filter (fun c -> not (QGraph.check_constraint grext c)) elim_csts in
     if ElimConstraints.is_empty cstrs' then ()
-    else fail (ElimConstraints.pr (pr_uctx_qvar uctx) cstrs')
+    else fail (ElimConstraints.pr (quality_printer uctx) cstrs')
   in
   ()
 
@@ -1562,17 +1654,22 @@ let pr_weak prl {minim_extra={UnivMinim.weak_constraints=weak; above_prop}} =
     ++ if UPairSet.is_empty weak || Level.Set.is_empty above_prop then mt() else cut () ++
     prlist_with_sep cut (fun u -> h (str "Prop <= " ++ prl u)) (Level.Set.elements above_prop))
 
-let pr_sort_opt_subst uctx = QState.pr (qualid_of_qvar_names uctx.names) uctx.sort_variables
+let pr_sort_opt_subst uctx =
+  let local_name q = try Some (get_uname (QVar.Map.find q (fst @@ snd uctx.names)))
+    with Not_found -> None
+  in
+  QState.pr (quality_printer uctx)
+    local_name
+    uctx.sort_variables
 
 let pr ctx =
   let open Pp in
   let prl = pr_uctx_level ctx in
-  let prq = pr_uctx_qvar ctx in
   if is_empty ctx then mt ()
   else
     v 0
       (str"UNIVERSES:"++brk(0,1)++
-       h (PContextSet.pr prq prl (context_set ctx)) ++ fnl () ++
+       h (PContextSet.pr (sort_printer ctx) (context_set ctx)) ++ fnl () ++
        UnivFlex.pr prl (subst ctx) ++ fnl() ++
        str"SORTS:"++brk(0,1)++
        h (pr_sort_opt_subst ctx) ++ fnl() ++
diff --git a/engine/uState.mli b/engine/uState.mli
index 260f000adcaa..a025f47be8ad 100644
--- a/engine/uState.mli
+++ b/engine/uState.mli
@@ -32,20 +32,17 @@ type t
 
 val empty : t
 
-val make : qualities:QGraph.t -> UGraph.t -> t
-[@@ocaml.deprecated "(8.13) Use from_env"]
+val from_env : Environ.env -> t
+(** Main entry point at the beginning of a declaration. *)
 
-val make_with_initial_binders : qualities:QGraph.t -> UGraph.t -> lident list -> t
-[@@ocaml.deprecated "(8.13) Use from_env"]
-
-val from_env : ?binders:lident list -> Environ.env -> t
-(** Main entry point at the beginning of a declaration declaring the
-    binding names as rigid universes. *)
+val from_auctx : Environ.env -> UVars.AbstractContext.t -> t
+(** Main entry point when the universe declaration has already been computed,
+    e.g. for printing. *)
 
 val of_names : (UnivNames.universe_binders * UnivNames.rev_binders) -> t
+[@@deprecated "(9.3) Use [UState.from_uctx]"]
 (** Main entry point when only names matter, e.g. for printing. *)
 
-
 (** Misc *)
 
 val is_empty : t -> bool
@@ -187,9 +184,9 @@ val univ_rigid : rigid
 val univ_flexible : rigid
 val univ_flexible_alg : rigid
 
-val merge_sort_context : ?loc:Loc.t -> ?sort_rigid:bool -> ?src:constraint_source ->
+val merge_sort_context_set : ?loc:Loc.t -> ?sort_rigid:bool -> ?src:constraint_source ->
     sideff:bool -> rigid -> t -> UnivGen.sort_context_set -> t
-val merge_universe_context : ?loc:Loc.t -> sideff:bool -> rigid -> t -> Univ.ContextSet.t -> t
+val merge_universe_context_set : ?loc:Loc.t -> sideff:bool -> rigid -> t -> Univ.ContextSet.t -> t
 
 val demote_global_univs : Univ.ContextSet.t -> t -> t
 (** After declaring global universes, call this if you want to keep using the UState.
@@ -213,10 +210,10 @@ val demote_global_univ_entry : universes_entry -> t -> t
 val emit_side_effects : Safe_typing.private_constants -> t -> t
 (** Calls [demote_global_univs] for the private constant universes. *)
 
-val new_sort_variable : ?loc:Loc.t -> ?sort_rigid:bool -> ?name:Id.t -> t -> t * QVar.t
+val new_quality_variable : ?loc:Loc.t -> ?sort_rigid:bool -> ?name:Id.t -> t -> t * QVar.t
 (** Declare a new local sort. *)
 
-val new_univ_variable : ?loc:Loc.t -> rigid -> Id.t option -> t -> t * Univ.Level.t
+val new_univ_level_variable : ?loc:Loc.t -> rigid -> Id.t option -> t -> t * Univ.Level.t
 (** Declare a new local universe; use rigid if a global or bound
     universe; use flexible for a universe existential variable; use
     univ_flexible_alg for a universe existential variable allowed to
@@ -243,7 +240,7 @@ val minimize : t -> t
 
 val collapse_above_prop_sort_variables : to_prop:bool -> t -> t
 
-val collapse_sort_variables : ?except:QVar.Set.t -> t -> t
+val collapse_sort_variables : ?except:QVar.Set.t -> only_above_prop:bool -> t -> t
 
 type ('a, 'b, 'c, 'd) gen_universe_decl = {
   univdecl_qualities : 'a;
@@ -287,9 +284,13 @@ val update_sigma_univs : t -> UGraph.t -> t
 (** {5 Pretty-printing} *)
 
 val pr_uctx_level : t -> Univ.Level.t -> Pp.t
+val pr_uctx_qglobal : t -> Sorts.QGlobal.t -> Pp.t
 val pr_uctx_qvar : t -> Sorts.QVar.t -> Pp.t
 val qualid_of_level : t -> Univ.Level.t -> Libnames.qualid option
 
+val quality_printer : t -> Sorts.Quality.printer
+val sort_printer : t -> Sorts.printer
+
 (** Only looks in the local names, not in the nametab. *)
 val id_of_level : t -> Univ.Level.t -> Id.t option
 
diff --git a/engine/univGen.ml b/engine/univGen.ml
index 81d226ddbd7c..611d08df7b98 100644
--- a/engine/univGen.ml
+++ b/engine/univGen.ml
@@ -29,10 +29,13 @@ module QualityOrSet = struct
     | Set, Qual _ -> -1
 
   let eliminates_to a b =
-    let to_qual = function
-      | Set -> Quality.qtype
-      | Qual q -> q
-    in Inductive.raw_eliminates_to (to_qual a) (to_qual b)
+    match a, b with
+    | Set, Qual (QConstant QType) -> false
+    | _ ->
+      let to_qual = function
+        | Set -> Quality.qtype
+        | Qual q -> q
+      in Inductive.raw_eliminates_to (to_qual a) (to_qual b)
 
   let of_quality q = Qual q
   let of_sort s = match s with
@@ -68,10 +71,9 @@ module QualityOrSet = struct
     | Set -> Pp.str"Set"
     | Qual q -> Quality.pr prv q
 
-  let raw_pr = pr Sorts.QVar.raw_pr
+  let raw_pr = pr Sorts.Quality.raw_printer
 
   let all_constants = Set :: List.map (fun q -> Qual q) Quality.all_constants
-  let all = Set :: List.map (fun q -> Qual q) Quality.all
 end
 
 type sort_context_set = (QVar.Set.t * Univ.Level.Set.t) * PConstraints.t
@@ -89,15 +91,15 @@ let sort_context_union ((qs,us),csts) ((qs',us'),csts') =
 let diff_sort_context ((qs,us),csts) ((qs',us'),csts') =
   (QVar.Set.diff qs qs', Level.Set.diff us us'), PConstraints.diff csts csts'
 
-let pr_sort_context prv prl ((vs, us), cst as ctx) =
+let pr_sort_context printer ((vs, us), cst as ctx) =
   let open Pp in
   if is_empty_sort_context ctx then mt ()
   else
     let vs =
       if Sorts.QVar.Set.is_empty vs then mt ()
-      else Sorts.QVar.Set.pr prv vs ++ pr_semicolon ()
+      else Sorts.QVar.Set.pr printer.Sorts.prq.prvar vs ++ pr_semicolon ()
     in
-    hov 0 (h (vs ++ Level.Set.pr prl us ++ str " |=") ++ brk(1,2) ++ h (PConstraints.pr prv prl cst))
+    hov 0 (h (vs ++ Level.Set.pr printer.pru us ++ str " |=") ++ brk(1,2) ++ h (PConstraints.pr printer cst))
 
 type univ_length_mismatch = {
   gref : GlobRef.t;
@@ -132,16 +134,13 @@ let new_univ_global () =
 let fresh_level () =
   Univ.Level.make (new_univ_global ())
 
-let new_sort_id =
+let new_unif_sort_id =
   let cnt = ref 0 in
   fun () -> incr cnt; !cnt
 
-let new_sort_global id =
-  Sorts.QGlobal.make (Global.current_dirpath ()) id
-
 let fresh_sort_quality () =
   let s = if Flags.async_proofs_is_worker() then !Flags.async_proofs_worker_id else "" in
-  Sorts.QVar.make_unif s (new_sort_id ())
+  Sorts.QVar.make_unif s (new_unif_sort_id ())
 
 let fresh_instance auctx : _ in_sort_context_set =
   let qlen, ulen = AbstractContext.size auctx in
@@ -213,6 +212,9 @@ let fresh_sort_in_quality =
   | Qual (QConstant QSProp) -> Sorts.sprop, empty_sort_context
   | Qual (QConstant QProp) -> Sorts.prop, empty_sort_context
   | Set -> Sorts.set, empty_sort_context
+  | Qual (QGlobal _ as q) ->
+    let u = fresh_level () in
+    Sorts.make q (Univ.Universe.make u), ((QVar.Set.empty,Level.Set.singleton u), PConstraints.empty)
   | Qual (QConstant QType | QVar _ (* Treat as Type *)) ->
      let u = fresh_level () in
      sort_of_univ (Univ.Universe.make u), ((QVar.Set.empty,Level.Set.singleton u), PConstraints.empty)
diff --git a/engine/univGen.mli b/engine/univGen.mli
index 2add1595c5ee..111cbefea5bf 100644
--- a/engine/univGen.mli
+++ b/engine/univGen.mli
@@ -24,6 +24,7 @@ module QualityOrSet : sig
   val quality : t -> Sorts.Quality.t
 
   val eliminates_to : t -> t -> bool
+  (** Set is not considered to eliminate to Type by this function *)
 
   val set : t
 
@@ -36,11 +37,10 @@ module QualityOrSet : sig
   val is_prop : t -> bool
   val is_sprop : t -> bool
 
-  val pr : (Sorts.QVar.t -> Pp.t) -> t -> Pp.t
+  val pr : Sorts.Quality.printer -> t -> Pp.t
   val raw_pr : t -> Pp.t
 
   val all_constants : t list
-  val all : t list
 end
 
 type univ_length_mismatch = {
@@ -55,7 +55,6 @@ exception UniverseLengthMismatch of univ_length_mismatch
 (** Side-effecting functions creating new universe levels. *)
 
 val new_univ_global : unit -> UGlobal.t
-val new_sort_global : Id.t -> Sorts.QGlobal.t
 val fresh_level : unit -> Level.t
 val fresh_sort_quality : unit -> Sorts.QVar.t
 
@@ -76,8 +75,7 @@ val is_empty_sort_context : sort_context_set -> bool
 
 val diff_sort_context : sort_context_set -> sort_context_set -> sort_context_set
 
-val pr_sort_context : (Sorts.QVar.t -> Pp.t) -> (Univ.Level.Set.elt -> Pp.t) ->
-  sort_context_set -> Pp.t
+val pr_sort_context : Sorts.printer -> sort_context_set -> Pp.t
 
 val fresh_instance : AbstractContext.t -> Instance.t in_sort_context_set
 
diff --git a/engine/univNames.ml b/engine/univNames.ml
index 71e97ae8bc1e..bb8d51620a64 100644
--- a/engine/univNames.ml
+++ b/engine/univNames.ml
@@ -20,9 +20,7 @@ let empty_binders = Id.Map.empty, Id.Map.empty
 
 let empty_rev_binders = QVar.Map.empty, Level.Map.empty
 
-type univ_name_list = Names.lname list
-
-type full_name_list = lname list * lname list
+type univ_name_list = lname list * lname list
 
 let qualid_of_level (_,ctx) l =
   match Level.name l with
@@ -37,13 +35,20 @@ let pr_level_with_global_universes ?(binders=empty_binders) l =
   | None -> Level.raw_pr l
 
 let qualid_of_quality (ctx,_) q =
-  match Sorts.QVar.repr q with
-  | Global qid ->
-    (try Some (Nametab.Quality.shortest_qualid_gen (fun id -> Id.Map.mem id ctx) qid)
-     with Not_found -> None)
-  | _ -> None
+  try Some (Nametab.Quality.shortest_qualid_gen (fun id -> Id.Map.mem id ctx) q)
+  with Not_found -> None
 
 let pr_quality_with_global_universes ?(binders=empty_binders) q =
   match qualid_of_quality binders q with
   | Some qid  -> Libnames.pr_qualid qid
-  | None -> Sorts.QVar.raw_pr q
+  | None -> Sorts.Quality.raw_pr q
+
+let quality_printer binders = {
+  Sorts.Quality.prvar = (fun q -> pr_quality_with_global_universes ~binders (QVar q));
+  prglobal = (fun q -> pr_quality_with_global_universes ~binders (QGlobal q));
+}
+
+let sort_printer binders = {
+  Sorts.prq = quality_printer binders;
+  pru = (fun u -> pr_level_with_global_universes ~binders u);
+}
diff --git a/engine/univNames.mli b/engine/univNames.mli
index 9149a0d67c4d..2daa40a957ba 100644
--- a/engine/univNames.mli
+++ b/engine/univNames.mli
@@ -22,12 +22,13 @@ val empty_binders : universe_binders
 
 val empty_rev_binders : rev_binders
 
-type univ_name_list = Names.lname list
-
-type full_name_list = lname list * lname list
+type univ_name_list = lname list * lname list
 
 val pr_level_with_global_universes : ?binders:universe_binders -> Level.t -> Pp.t
 val qualid_of_level : universe_binders -> Level.t -> Libnames.qualid option
 
-val pr_quality_with_global_universes : ?binders:universe_binders -> Sorts.QVar.t -> Pp.t
-val qualid_of_quality : universe_binders -> Sorts.QVar.t -> Libnames.qualid option
+val pr_quality_with_global_universes : ?binders:universe_binders -> Sorts.Quality.t -> Pp.t
+val qualid_of_quality : universe_binders -> Sorts.Quality.t -> Libnames.qualid option
+
+val quality_printer : universe_binders -> Sorts.Quality.printer
+val sort_printer : universe_binders -> Sorts.printer
diff --git a/engine/univProblem.ml b/engine/univProblem.ml
index 4bfccc5ac207..448d32427c1d 100644
--- a/engine/univProblem.ml
+++ b/engine/univProblem.ml
@@ -21,9 +21,9 @@ type t =
   | UWeak of Level.t * Level.t
 
 let is_trivial = function
-  | QLeq (a,b) -> Inductive.raw_eliminates_to a b
+  | QLeq (QConstant QProp, QConstant QType) -> true
+  | QLeq (a, b) | QEq (a, b) -> Quality.equal a b
   | QElimTo (a, b) -> Inductive.raw_eliminates_to a b
-  | QEq (a, b) -> Quality.equal a b
   | ULe (u, v) | UEq (u, v) -> Sorts.equal u v
   | ULub (u, v) | UWeak (u, v) -> Level.equal u v
 
diff --git a/gramlib/dune b/gramlib/dune
index de64e44fed3d..3eec1128cf48 100644
--- a/gramlib/dune
+++ b/gramlib/dune
@@ -3,7 +3,3 @@
  (public_name rocq-runtime.gramlib)
  (modules_without_implementation plexing)
  (libraries rocq-runtime.lib))
-
-(deprecated_library_name
- (old_public_name coq-core.gramlib)
- (new_public_name rocq-runtime.gramlib))
diff --git a/gramlib/grammar.ml b/gramlib/grammar.ml
index 8dfc766ccfbd..a1616afa6fc0 100644
--- a/gramlib/grammar.ml
+++ b/gramlib/grammar.ml
@@ -12,8 +12,8 @@ exception ParseError of string
 
 (* Functorial interface *)
 
-type norec
-type mayrec
+type norec = private [ `norec ]
+type mayrec = private [ `mayrec ]
 
 module type S = sig
   type keyword_state
@@ -50,6 +50,8 @@ module type S = sig
 
     val comments : t -> ((int * int) * string) list
 
+    val drop_comments : t -> unit
+
     val loc : t -> Loc.t
     (** [loc pa] Return parsing position for [pa] *)
 
@@ -67,7 +69,7 @@ module type S = sig
     type 'a parser_fun = { parser_fun : keyword_state -> (keyword_state,te) LStream.t -> 'a parser_v }
     val of_parser : string -> 'a parser_fun -> 'a t mod_estate
     val parse_token_stream : 'a t -> (keyword_state,te) LStream.t -> 'a parser_v with_gstate
-    val print : Format.formatter -> 'a t -> unit with_kwstate with_estate
+    val print : flatten:bool -> Format.formatter -> 'a t -> unit with_kwstate with_estate
     val is_empty : 'a t -> bool with_estate
     type any_t = Any : 'a t -> any_t
     val accumulate_in : any_t list -> any_t list CString.Map.t with_estate
@@ -128,7 +130,7 @@ module type S = sig
   val generalize_symbol : ('a, 'tr, 'c) Symbol.t -> ('b, norec, 'c) Symbol.t option
 
   (* Used in custom entries, should tweak? *)
-  val level_of_nonterm : ('a, norec, 'c) Symbol.t -> string option
+  val level_of_nonterm : _ Symbol.t -> string option
 
 end
 
@@ -156,9 +158,11 @@ module type ExtS = sig
      and type 'a with_estate := EState.t -> 'a
      and type 'a mod_estate := EState.t -> EState.t * 'a
 
+  val safe_extend : EState.t -> 'a Entry.t -> 'a extend_statement -> EState.t
+
   type 's add_kw = { add_kw : 'c. 's -> 'c pattern -> 's }
 
-  val safe_extend : 's add_kw -> EState.t -> 's -> 'a Entry.t -> 'a extend_statement -> EState.t * 's
+  val add_extend_kws : 's add_kw -> 's -> _ extend_statement -> 's
 
   module Unsafe : sig
     val existing_entry : EState.t -> 'a Entry.t -> EState.t
@@ -210,7 +214,7 @@ type 'a ty_entry = {
   etag : 'a DMap.onetag;
 }
 
-and ('self, 'trec, 'a) ty_symbol =
+type ('self, 'trec, 'a) ty_symbol =
 | Stoken : 'c pattern -> ('self, norec, 'c) ty_symbol
 | Stokens : ty_pattern list -> ('self, norec, unit) ty_symbol
 | Slist1 : ('self, 'trec, 'a) ty_symbol -> ('self, 'trec, 'a list) ty_symbol
@@ -225,10 +229,6 @@ and ('self, 'trec, 'a) ty_symbol =
 | Snterml : 'a ty_entry * string -> ('self, norec, 'a) ty_symbol
 | Stree : ('self, 'trec, Loc.t -> 'a) ty_tree -> ('self, 'trec, 'a) ty_symbol
 
-and ('self, _, _, 'r) ty_rule =
-| TStop : ('self, norec, 'r, 'r) ty_rule
-| TNext : ('trr, 'trs, 'tr) ty_and_rec * ('self, 'trr, 'a, 'r) ty_rule * ('self, 'trs, 'b) ty_symbol -> ('self, 'tr, 'b -> 'a, 'r) ty_rule
-
 and ('self, 'trec, 'a) ty_tree =
 | Node : ('trn, 'trs, 'trb, 'tr) ty_and_rec3 * ('self, 'trn, 'trs, 'trb, 'b, 'a) ty_node -> ('self, 'tr, 'a) ty_tree
 | LocAct : 'k -> ('self, norec, 'k) ty_tree
@@ -240,6 +240,10 @@ and ('self, 'trec, 'trecs, 'trecb, 'a, 'r) ty_node = {
   brother : ('self, 'trecb, 'r) ty_tree;
 }
 
+type ('self, _, _, 'r) ty_rule =
+| TStop : ('self, norec, 'r, 'r) ty_rule
+| TNext : ('trr, 'trs, 'tr) ty_and_rec * ('self, 'trr, 'a, 'r) ty_rule * ('self, 'trs, 'b) ty_symbol -> ('self, 'tr, 'b -> 'a, 'r) ty_rule
+
 type ('trecs, 'trecp, 'a) ty_rec_level = {
   assoc : g_assoc;
   lname : string option;
@@ -686,40 +690,6 @@ let rec change_to_self : type s trec a r. s ty_entry -> (s, trec, a, r) ty_rule
   let MayRecSymbol t = change_to_self0 e t in
   MayRecRule (TNext (MayRec2, r, t))
 
-type 's add_kw = { add_kw : 'c. 's -> 'c pattern -> 's }
-
-let insert_tokens {add_kw} lstate symbols =
-  let rec insert : type s trec a. _ -> (s, trec, a) ty_symbol -> _ =
-    fun lstate -> function
-    | Slist0 s -> insert lstate s
-    | Slist1 s -> insert lstate s
-    | Slist0sep (s, t) -> let lstate = insert lstate s in insert lstate t
-    | Slist1sep (s, t) -> let lstate = insert lstate s in insert lstate t
-    | Sopt s -> insert lstate s
-    | Stree t -> tinsert lstate t
-    | Stoken tok -> add_kw lstate tok
-    | Stokens (TPattern tok::_) ->
-      (* Only the first token is liable to trigger a keyword effect *)
-      add_kw lstate tok
-    | Stokens [] -> assert false
-    | Snterm _
-    | Snterml _
-    | Snext
-    | Sself -> lstate
-  and tinsert : type s tr a. _ -> (s, tr, a) ty_tree -> _ =
-    fun lstate -> function
-      Node (_, {node = s; brother = bro; son = son}) ->
-      let lstate = insert lstate s in
-      let lstate = tinsert lstate bro in
-      tinsert lstate son
-    | LocAct _ | DeadEnd -> lstate
-  and linsert : type s tr p. _ -> (s, tr, p) ty_symbols -> _ =
-    fun lstate -> function
-      | TNil -> lstate
-      | TCns (_, s, r) -> let lstate = insert lstate s in linsert lstate r
-  in
-  linsert lstate symbols
-
 type 'a single_extend_statement =
   string option * Gramext.g_assoc option * 'a ty_production list
 
@@ -727,13 +697,57 @@ type 'a extend_statement =
 | Reuse of string option * 'a ty_production list
 | Fresh of Gramext.position * 'a single_extend_statement list
 
-let add_prod add_kw entry (lstate, lev) (TProd (symbols, action)) =
+type 's add_kw = { add_kw : 'c. 's -> 'c pattern -> 's }
+
+let rec add_symbol_kws : type s trec a. _ -> _ -> (s, trec, a) ty_symbol -> _ =
+  fun add_kw lstate -> function
+  | Slist0 s -> add_symbol_kws add_kw lstate s
+  | Slist1 s -> add_symbol_kws add_kw lstate s
+  | Slist0sep (s, t) -> let lstate = add_symbol_kws add_kw lstate s in add_symbol_kws add_kw lstate t
+  | Slist1sep (s, t) -> let lstate = add_symbol_kws add_kw lstate s in add_symbol_kws add_kw lstate t
+  | Sopt s -> add_symbol_kws add_kw lstate s
+  | Stree t -> add_tree_kws add_kw lstate t
+  | Stoken tok -> add_kw.add_kw lstate tok
+  | Stokens (TPattern tok::_) ->
+    (* Only the first token is liable to trigger a keyword effect *)
+    add_kw.add_kw lstate tok
+  | Stokens [] -> assert false
+  | Snterm _
+  | Snterml _
+  | Snext
+  | Sself -> lstate
+
+and add_tree_kws : type s tr a. _ -> _ -> (s, tr, a) ty_tree -> _ =
+  fun add_kw lstate -> function
+  | Node (_, {node = s; brother = bro; son = son}) ->
+    let lstate = add_symbol_kws add_kw lstate s in
+    let lstate = add_tree_kws add_kw lstate bro in
+    add_tree_kws add_kw lstate son
+  | LocAct _ | DeadEnd -> lstate
+
+let rec add_rule_kws : type s trr k r. _ -> _ -> (s, trr, k, r) ty_rule -> _ =
+  fun add_kw lstate -> function
+  | TStop -> lstate
+  | TNext (_, r, s) ->
+    let lstate = add_symbol_kws add_kw lstate s in
+    add_rule_kws add_kw lstate r
+
+let add_production_kws add_kw lstate (TProd (r, _)) = add_rule_kws add_kw lstate r
+
+let add_extend_kws add_kw lstate ext =
+  let add_ps lstate ps =
+    List.fold_left (fun lstate p -> add_production_kws add_kw lstate p) lstate ps
+  in
+  match ext with
+  | Reuse (_, ps) -> add_ps lstate ps
+  | Fresh (_, ps) -> List.fold_left (fun lstate (_, _, ps) -> add_ps lstate ps) lstate ps
+
+let add_prod entry lev (TProd (symbols, action)) =
   let MayRecRule symbols = change_to_self entry symbols in
   let AnyS (symbols, pf) = get_symbols symbols in
-  let lstate = insert_tokens add_kw lstate symbols in
-  lstate, insert_level entry.ename symbols pf action lev
+  insert_level entry.ename symbols pf action lev
 
-let levels_of_rules add_kw lstate entry edata st =
+let levels_of_rules entry edata st =
   let elev =
     match edata.edesc with
       Dlevels elev -> elev
@@ -742,30 +756,38 @@ let levels_of_rules add_kw lstate entry edata st =
         failwith msg
   in
   match st with
-  | Reuse (name, []) -> lstate, elev
+  | Reuse (name, []) -> elev
   | Reuse (name, prods) ->
     let (levs1, lev, levs2) = get_level entry name elev in
-    let lstate, lev = List.fold_left (fun lev prod -> add_prod add_kw entry lev prod) (lstate, lev) prods in
-    lstate, levs1 @ [lev] @ levs2
+    let lev = List.fold_left (fun lev prod -> add_prod entry lev prod) lev prods in
+    levs1 @ [lev] @ levs2
   | Fresh (position, rules) ->
     let (levs1, levs2) = get_position entry position elev in
-    let fold (lstate, levs) (lname, assoc, prods) =
+    let fold levs (lname, assoc, prods) =
       let lev = empty_lev lname assoc in
-      let lstate, lev = List.fold_left (fun lev prod -> add_prod add_kw entry lev prod) (lstate, lev) prods in
-      lstate, lev :: levs
+      let lev = List.fold_left (fun lev prod -> add_prod entry lev prod) lev prods in
+      lev :: levs
     in
-    let lstate, levs = List.fold_left fold (lstate, []) rules in
-    lstate, levs1 @ List.rev levs @ levs2
+    let levs = List.fold_left fold [] rules in
+    levs1 @ List.rev levs @ levs2
 
-type 's ex_symbols =
-| ExS : ('s, 'tr, 'p) ty_symbols -> 's ex_symbols
+(* used for printing and iteration *)
+type ex_symbols =
+  | ExNil
+  | ExCns : _ ty_symbol * ex_symbols list -> ex_symbols
 
-let rec flatten_tree : type s tr a. (s, tr, a) ty_tree -> s ex_symbols list =
-  function
+let exCns ~flatten n s =
+  if flatten then
+    List.map (fun s -> ExCns (n, [s])) s
+  else [ExCns (n, s)]
+
+let rec ex_tree : type s tr a. flatten:bool -> (s, tr, a) ty_tree -> ex_symbols list =
+  fun ~flatten -> function
     DeadEnd -> []
-  | LocAct _ -> [ExS TNil]
+  | LocAct _ -> [ExNil]
   | Node (_, {node = n; brother = b; son = s}) ->
-      List.map (fun (ExS l) -> ExS (TCns (MayRec2, n, l))) (flatten_tree s) @ flatten_tree b
+    let s = ex_tree ~flatten s in
+    exCns ~flatten n s @ ex_tree ~flatten b
 
 let utf8_string_escaped s =
   let b = Buffer.create (String.length s) in
@@ -805,65 +827,72 @@ let print_tokens kwstate ppf = function
     (fun ppf -> List.iter (function TPattern p -> fprintf ppf ";@ "; print_token kwstate true ppf p))
     pl
 
-let rec print_symbol : type s tr r. _ -> formatter -> (s, tr, r) ty_symbol -> unit =
-  fun kwstate ppf ->
-  function
-  | Slist0 s -> fprintf ppf "LIST0 %a" (print_symbol1 kwstate) s
-  | Slist0sep (s, t) ->
+let print_level ~flatten =
+  let rec print_symbol : type s tr r. _ -> formatter -> (s, tr, r) ty_symbol -> unit =
+    fun kwstate ppf ->
+    function
+    | Slist0 s -> fprintf ppf "LIST0 %a" (print_symbol1 kwstate) s
+    | Slist0sep (s, t) ->
       fprintf ppf "LIST0 %a SEP %a" (print_symbol1 kwstate) s (print_symbol1 kwstate) t
-  | Slist1 s -> fprintf ppf "LIST1 %a" (print_symbol1 kwstate) s
-  | Slist1sep (s, t) ->
+    | Slist1 s -> fprintf ppf "LIST1 %a" (print_symbol1 kwstate) s
+    | Slist1sep (s, t) ->
       fprintf ppf "LIST1 %a SEP %a" (print_symbol1 kwstate) s (print_symbol1 kwstate) t
-  | Sopt s -> fprintf ppf "OPT %a" (print_symbol1 kwstate) s
-  | Stoken p -> print_token kwstate true ppf p
-  | Stokens [TPattern p] -> print_token kwstate true ppf p
-  | Stokens pl -> print_tokens kwstate ppf pl
-  | Snterml (e, l) ->
-      fprintf ppf "%s%s@ LEVEL@ %a" e.ename ""
-        print_str l
-  | s -> (print_symbol1 kwstate) ppf s
-and print_symbol1 : type s tr r. _ -> formatter -> (s, tr, r) ty_symbol -> unit =
-  fun kwstate ppf ->
-  function
-  | Snterm e -> fprintf ppf "%s%s" e.ename ""
-  | Sself -> pp_print_string ppf "SELF"
-  | Snext -> pp_print_string ppf "NEXT"
-  | Stoken p -> print_token kwstate false ppf p
-  | Stokens [TPattern p] -> print_token kwstate false ppf p
-  | Stokens pl -> print_tokens kwstate ppf pl
-  | Stree t -> print_level kwstate ppf pp_print_space (flatten_tree t)
-  | s ->
+    | Sopt s -> fprintf ppf "OPT %a" (print_symbol1 kwstate) s
+    | Stoken p -> print_token kwstate true ppf p
+    | Stokens [TPattern p] -> print_token kwstate true ppf p
+    | Stokens pl -> print_tokens kwstate ppf pl
+    | Snterml (e, l) ->
+      fprintf ppf "%s LEVEL %a" e.ename print_str l
+    | s -> (print_symbol1 kwstate) ppf s
+  and print_symbol1 : type s tr r. _ -> formatter -> (s, tr, r) ty_symbol -> unit =
+    fun kwstate ppf ->
+    function
+    | Snterm e -> fprintf ppf "%s%s" e.ename ""
+    | Sself -> pp_print_string ppf "SELF"
+    | Snext -> pp_print_string ppf "NEXT"
+    | Stoken p -> print_token kwstate false ppf p
+    | Stokens [TPattern p] -> print_token kwstate false ppf p
+    | Stokens pl -> print_tokens kwstate ppf pl
+    | Stree t -> print_level kwstate ppf pp_print_space (ex_tree ~flatten t)
+    | s ->
       fprintf ppf "(%a)" (print_symbol kwstate) s
-and print_rule : type s tr p. _ -> formatter -> (s, tr, p) ty_symbols -> unit =
-  fun kwstate ppf symbols ->
-  fprintf ppf "@[";
-  let rec fold : type s tr p. _ -> (s, tr, p) ty_symbols -> unit =
-    fun sep symbols ->
-    match symbols with
-    | TNil -> ()
-    | TCns (_, symbol, symbols) ->
-      fprintf ppf "%t%a" sep (print_symbol kwstate) symbol;
-      fold (fun ppf -> fprintf ppf ";@ ") symbols
-  in
-  let () = fold (fun ppf -> ()) symbols in
-  fprintf ppf "@]"
-and print_level : type s. _ -> _ -> _ -> s ex_symbols list -> _ =
-  fun kwstate ppf pp_print_space rules ->
-  fprintf ppf "@[[ ";
-  let () =
-    Format.pp_print_list ~pp_sep:(fun ppf () -> fprintf ppf "%a| " pp_print_space ())
-      (fun ppf (ExS rule) -> print_rule kwstate ppf rule)
-      ppf rules
+  and print_rule : _ -> formatter -> ex_symbols -> unit =
+    fun kwstate ppf symbols ->
+    fprintf ppf "@[";
+    let rec fold : _ -> ex_symbols -> unit =
+      fun sep symbols ->
+      match symbols with
+      | ExNil -> ()
+      | ExCns (symbol, symbols) ->
+        fprintf ppf "%t%a" sep (print_symbol kwstate) symbol;
+        match symbols with
+        | [symbols] ->
+          fold (fun ppf -> fprintf ppf ";@ ") symbols
+        | _ -> fprintf ppf ";@ "; print_level kwstate ppf pp_force_newline symbols
+    in
+    let () = fold (fun ppf -> ()) symbols in
+    fprintf ppf "@]"
+  and print_level : _ -> _ -> _ -> ex_symbols list -> _ =
+    fun kwstate ppf pp_print_space rules ->
+    fprintf ppf "@[[ ";
+    let () =
+      Format.pp_print_list ~pp_sep:(fun ppf () -> fprintf ppf "%a| " pp_print_space ())
+        (fun ppf rule -> print_rule kwstate ppf rule)
+        ppf rules
+    in
+    fprintf ppf " ]@]"
   in
-  fprintf ppf " ]@]"
+  print_level
 
-let print_levels kwstate ppf elev =
+let ex_level ~flatten lev =
+  let suff = ex_tree ~flatten lev.lsuffix in
+  let lrec = if List.is_empty suff then [] else exCns ~flatten Sself suff in
+  lrec @ ex_tree ~flatten lev.lprefix
+
+let print_levels ~flatten kwstate ppf elev =
   Format.pp_print_list ~pp_sep:(fun ppf () -> fprintf ppf "@,| ")
     (fun ppf (Level lev) ->
-       let rules =
-         List.map (fun (ExS t) -> ExS (TCns (MayRec2, Sself, t))) (flatten_tree lev.lsuffix) @
-         flatten_tree lev.lprefix
-       in
+       let rules = ex_level ~flatten lev in
        fprintf ppf "@[";
        begin match lev.lname with
            Some n -> fprintf ppf "%a@;<1 2>" print_str n
@@ -876,13 +905,13 @@ let print_levels kwstate ppf elev =
          | NonA -> fprintf ppf "NONA"
        end;
        fprintf ppf "@]@;<1 2>";
-       print_level kwstate ppf pp_force_newline rules)
+       print_level ~flatten kwstate ppf pp_force_newline rules)
     ppf elev
 
-let print_entry estate kwstate ppf e =
+let print_entry ~flatten estate kwstate ppf e =
   fprintf ppf "@[[ ";
   begin match (get_entry estate e).edesc with
-    Dlevels elev -> print_levels kwstate ppf elev
+    Dlevels elev -> print_levels ~flatten kwstate ppf elev
   | Dparser _ -> fprintf ppf ""
   end;
   fprintf ppf " ]@]"
@@ -1483,18 +1512,29 @@ let rec continue_parser_of_levels entry clevn =
               let () = Option.iter (warn_recover_continuation entry.ename bp ep strm__) tolerance in
               c
 
+(* Don't use Lazy because if it gets interrupted it is unrecoverable *)
+let lazy_fun f =
+  let r = ref None in
+  fun () ->
+    match !r with
+    | Some f -> f
+    | None ->
+      let f = f () in
+      r := Some f;
+      f
+
 let make_continue_parser_of_entry entry = function
   | [] -> (fun _ _ _ _ _ (_ : _ LStream.t) -> Error ())
   | elev ->
-    let p = lazy (continue_parser_of_levels entry 0 elev) in
+    let p = lazy_fun (fun () -> continue_parser_of_levels entry 0 elev) in
     (fun gstate levfrom levn bp a (strm__ : _ LStream.t) ->
-       Lazy.force p gstate levfrom levn bp a strm__ <+> fun () -> Ok a)
+       p () gstate levfrom levn bp a strm__ <+> fun () -> Ok a)
 
 let make_start_parser_of_entry entry = function
   | [] -> empty_entry entry.ename
   | elev ->
-    let p = lazy (start_parser_of_levels entry 0 elev) in
-    (fun gstate levn (strm:_ LStream.t) -> Lazy.force p gstate levn strm)
+    let p = lazy_fun (fun () -> start_parser_of_levels entry 0 elev) in
+    (fun gstate levn (strm:_ LStream.t) -> p () gstate levn strm)
 
 let make_entry_data entry elev = {
   eentry = entry;
@@ -1512,14 +1552,12 @@ let add_entry otag estate e v =
   assert (not (EState.mem (DMap.tag_of_onetag e.etag) estate));
   EState.add otag v estate
 
-let extend_entry add_kw estate kwstate entry statement =
-  let kwstate = ref kwstate in
+let extend_entry estate entry statement =
   let estate = modify_entry estate entry (fun edata ->
-      let kwstate', elev = levels_of_rules add_kw !kwstate entry edata statement in
-      kwstate := kwstate';
+      let elev = levels_of_rules entry edata statement in
       make_entry_data entry elev)
   in
-  estate, !kwstate
+  estate
 
 (* Normal interface *)
 
@@ -1583,6 +1621,8 @@ module Parsable = struct
 
   let comments p = L.State.get_comments !(p.lexer_state)
 
+  let drop_comments p = p.lexer_state := L.State.drop_comments !(p.lexer_state)
+
   let loc t = LStream.current_loc t.pa_tok_strm
   let consume { pa_tok_strm } len kwstate = LStream.njunk kwstate len pa_tok_strm
 end
@@ -1617,7 +1657,7 @@ module Entry = struct
   let of_parser_val e { parser_fun = p } = {
     eentry = e;
     estart = (fun gstate _ (strm:_ LStream.t) -> p gstate.kwstate strm);
-    econtinue = (fun _ _ _ _ _ (strm__ : _ LStream.t) -> assert false);
+    econtinue = (fun _ _ _ _ _ (strm__ : _ LStream.t) -> Error ());
     edesc = Dparser p;
   }
   let of_parser n p estate =
@@ -1625,7 +1665,7 @@ module Entry = struct
     let estate = add_entry otag estate e (of_parser_val e p) in
     estate, e
 
-  let print ppf e estate kwstate = fprintf ppf "%a@." (print_entry estate kwstate) e
+  let print ~flatten ppf e estate kwstate = fprintf ppf "%a@." (print_entry ~flatten estate kwstate) e
 
   let is_empty e estate = match (get_entry estate e).edesc with
   | Dparser _ -> failwith "Arbitrary parser entry"
@@ -1633,12 +1673,12 @@ module Entry = struct
 
   type any_t = Any : 'a t -> any_t
 
-  let rec iter_in_symbols : type s tr p. _ -> (s, tr, p) ty_symbols -> unit = fun f symbols ->
+  let rec iter_in_symbols : _ -> ex_symbols -> unit = fun f symbols ->
     match symbols with
-    | TNil -> ()
-    | TCns (_, symbol, symbols) ->
+    | ExNil -> ()
+    | ExCns (symbol, symbols) ->
       iter_in_symbol f symbol;
-      iter_in_symbols f symbols
+      List.iter (iter_in_symbols f) symbols
 
   and iter_in_symbol : type s tr r. _ -> (s, tr, r) ty_symbol -> unit = fun f ->
     function
@@ -1650,17 +1690,14 @@ module Entry = struct
     | Sopt s -> iter_in_symbol f s
     | Stoken _ | Stokens _ -> ()
     | Sself | Snext -> ()
-    | Stree t -> List.iter (fun (ExS rule) -> iter_in_symbols f rule) (flatten_tree t)
+    | Stree t -> List.iter (fun rule -> iter_in_symbols f rule) (ex_tree ~flatten:false t)
 
   let iter_in estate f e = match (get_entry estate e).edesc with
     | Dparser _ -> ()
     | Dlevels elev ->
       List.iter (fun (Level lev) ->
-          let rules =
-            List.map (fun (ExS t) -> ExS (TCns (MayRec2, Sself, t))) (flatten_tree lev.lsuffix) @
-            flatten_tree lev.lprefix
-          in
-          List.iter (fun (ExS rule) -> iter_in_symbols f rule) rules)
+          let rules = ex_level ~flatten:false lev in
+          List.iter (fun rule -> iter_in_symbols f rule) rules)
         elev
 
   let same_entry (Any e) (Any e') = Option.has_some (eq_entry e e')
@@ -1784,7 +1821,7 @@ end
 
 let safe_extend = extend_entry
 
-let level_of_nonterm sym = match sym with
+let level_of_nonterm (type rec_) (sym:(_,rec_,_) Symbol.t) = match sym with
   | Snterml (_,l) -> Some l
   | _ -> None
 
diff --git a/gramlib/grammar.mli b/gramlib/grammar.mli
index 16c8011b0ae0..24c2f1decd30 100644
--- a/gramlib/grammar.mli
+++ b/gramlib/grammar.mli
@@ -60,6 +60,7 @@ module type S = sig
     type t
     val make : ?loc:Loc.t -> (unit,char) Stream.t -> t
     val comments : t -> ((int * int) * string) list
+    val drop_comments : t -> unit
     val loc : t -> Loc.t
     val consume : t -> int -> unit with_kwstate
   end
@@ -72,7 +73,7 @@ module type S = sig
     type 'a parser_fun = { parser_fun : keyword_state -> (keyword_state,te) LStream.t -> 'a parser_v }
     val of_parser : string -> 'a parser_fun -> 'a t mod_estate
     val parse_token_stream : 'a t -> (keyword_state,te) LStream.t -> 'a parser_v with_gstate
-    val print : Format.formatter -> 'a t -> unit with_kwstate with_estate
+    val print : flatten:bool -> Format.formatter -> 'a t -> unit with_kwstate with_estate
     val is_empty : 'a t -> bool with_estate
 
     type any_t = Any : 'a t -> any_t
@@ -136,7 +137,8 @@ module type S = sig
   val generalize_symbol : ('a, 'tr, 'c) Symbol.t -> ('b, norec, 'c) Symbol.t option
 
   (* Used in custom entries, should tweak? *)
-  val level_of_nonterm : ('a, norec, 'c) Symbol.t -> string option
+  (** If the symbol is [nterml] returns the level, otherwise [None] *)
+  val level_of_nonterm : _ Symbol.t -> string option
 
 end
 
@@ -165,9 +167,11 @@ module type ExtS = sig
      and type 'a with_estate := EState.t -> 'a
      and type 'a mod_estate := EState.t -> EState.t * 'a
 
+  val safe_extend : EState.t -> 'a Entry.t -> 'a extend_statement -> EState.t
+
   type 's add_kw = { add_kw : 'c. 's -> 'c pattern -> 's }
 
-  val safe_extend : 's add_kw -> EState.t -> 's -> 'a Entry.t -> 'a extend_statement -> EState.t * 's
+  val add_extend_kws : 's add_kw -> 's -> _ extend_statement -> 's
 
   module Unsafe : sig
     val existing_entry : EState.t -> 'a Entry.t -> EState.t
diff --git a/gramlib/plexing.mli b/gramlib/plexing.mli
index 0501a472fb25..6d89a34b7bac 100644
--- a/gramlib/plexing.mli
+++ b/gramlib/plexing.mli
@@ -32,6 +32,7 @@ module type S = sig
     val get : unit -> t
     val drop : unit -> unit
     val get_comments : t -> ((int * int) * string) list
+    val drop_comments : t -> t
   end
 
 end
diff --git a/hint_attr_plugin/_CoqProject b/hint_attr_plugin/_CoqProject
new file mode 100644
index 000000000000..712ba991b588
--- /dev/null
+++ b/hint_attr_plugin/_CoqProject
@@ -0,0 +1,7 @@
+-Q theories HintAttr
+-I src
+
+src/hintAttr.ml
+src/hint_attr_plugin.mlpack
+theories/HintAttr.v
+theories/test.v
diff --git a/hint_attr_plugin/src/META.rocq-hint-attr b/hint_attr_plugin/src/META.rocq-hint-attr
new file mode 100644
index 000000000000..417c070924ee
--- /dev/null
+++ b/hint_attr_plugin/src/META.rocq-hint-attr
@@ -0,0 +1,11 @@
+package "hint" (
+    directory = "."
+    version = "dev"
+    description = "A #[hint(db=...,cost=...,visibility=...)] programmable attribute"
+    requires = ""
+    archive(byte) = "hint_attr_plugin.cma"
+    archive(native) = "hint_attr_plugin.cmxa"
+    plugin(byte) = "hint_attr_plugin.cma"
+    plugin(native) = "hint_attr_plugin.cmxs"
+)
+directory = "."
diff --git a/hint_attr_plugin/src/hintAttr.ml b/hint_attr_plugin/src/hintAttr.ml
new file mode 100644
index 000000000000..5a3c88fd0cc9
--- /dev/null
+++ b/hint_attr_plugin/src/hintAttr.ml
@@ -0,0 +1,123 @@
+(************************************************************************)
+(* Standalone plugin: a programmable [#[hint(...)]] attribute.          *)
+(*                                                                      *)
+(* Attaching                                                            *)
+(*                                                                      *)
+(*   #[hint(db=mydb, cost="2", visibility=export)]                      *)
+(*                                                                      *)
+(* to a [Definition], [Lemma], [Theorem], [Fixpoint], ... registers the *)
+(* resulting constant in the hint database [mydb] as a [Resolve] hint   *)
+(* with priority [2] and the given visibility, as soon as the           *)
+(* declaration is completed (at [Qed]/[Defined] for proofs).  It is     *)
+(* equivalent to running, immediately after the definition:             *)
+(*                                                                      *)
+(*   #[export] Hint Resolve name | 2 : mydb.                            *)
+(*                                                                      *)
+(* The keys are:                                                        *)
+(*   - db          (required) the target hint database;                 *)
+(*   - cost        (optional) the hint priority/cost, an integer given  *)
+(*                 as a string literal (attribute values cannot be bare *)
+(*                 numbers); omitted means the default priority;        *)
+(*   - visibility  (optional) one of [local], [export] or [global];     *)
+(*                 omitted behaves like a plain [Hint Resolve] (i.e.    *)
+(*                 [local] inside a section, [export] otherwise).        *)
+(************************************************************************)
+
+open Attributes
+open Attributes.Notations
+
+(* The hint database name: [db=mydb] or [db="mydb"]. *)
+let db_attr : string option attribute =
+  let parser ?loc prev v =
+    let () = match prev with
+      | Some _ -> CErrors.user_err ?loc Pp.(str "Key \"db\" was already set.")
+      | None -> ()
+    in
+    match v with
+    | VernacFlagLeaf (FlagString s) -> s
+    | VernacFlagLeaf (FlagQualid q) -> Libnames.string_of_qualid q
+    | _ ->
+      CErrors.user_err ?loc Pp.(str "Key \"db\" expects a value, e.g. db=mydb.")
+  in
+  attribute_of_list ["db", parser]
+
+(* The hint cost / priority: [cost="2"].  Attribute values can only be string
+   literals or qualified names, never bare numbers, so the integer is given as
+   a string. *)
+let cost_attr : int option attribute =
+  let parser ?loc prev v =
+    let () = match prev with
+      | Some _ -> CErrors.user_err ?loc Pp.(str "Key \"cost\" was already set.")
+      | None -> ()
+    in
+    let s = match v with
+      | VernacFlagLeaf (FlagString s) -> s
+      | VernacFlagLeaf (FlagQualid q) -> Libnames.string_of_qualid q
+      | _ ->
+        CErrors.user_err ?loc
+          Pp.(str "Key \"cost\" expects a number, e.g. cost=\"2\".")
+    in
+    match int_of_string_opt s with
+    | Some n -> n
+    | None ->
+      CErrors.user_err ?loc
+        Pp.(str "Key \"cost\" expects an integer, got \"" ++ str s ++ str "\".")
+  in
+  attribute_of_list ["cost", parser]
+
+(* The visibility: [visibility=local|export|global]. *)
+let visibility_attr : Hints.hint_locality option attribute =
+  key_value_attribute ~key:"visibility" ?empty:None
+    ~values:[ "local",  Hints.Local
+            ; "export", Hints.Export
+            ; "global", Hints.SuperGlobal ]
+
+type cfg = { db : string; cost : int option; vis : Hints.hint_locality option }
+
+(* Parse the arguments of [hint(...)] into a [cfg]. *)
+let parse_hint_args ?loc v =
+  let inner = match v with
+    | VernacFlagList l -> l
+    | _ ->
+      CErrors.user_err ?loc
+        Pp.(str "The \"hint\" attribute expects arguments, e.g. \
+                 #[hint(db=mydb, cost=\"1\", visibility=export)].")
+  in
+  let ((db, cost), vis) =
+    Attributes.parse (db_attr ++ cost_attr ++ visibility_attr) inner
+  in
+  match db with
+  | None ->
+    CErrors.user_err ?loc
+      Pp.(str "The \"hint\" attribute requires a \"db\" key, e.g. \
+               #[hint(db=mydb)].")
+  | Some db -> { db; cost; vis }
+
+(* The completion hook: equivalent to [#[visibility] Hint Resolve name | cost : db]. *)
+let resolve_hook { db; cost; vis } =
+  Declare.Hook.make (fun { Declare.Hook.S.dref; _ } ->
+      let locality = match vis with
+        | Some l -> l
+        | None ->
+          if Lib.sections_are_opened () then Hints.Local else Hints.Export
+      in
+      let info = { Hints.empty_hint_info with Typeclasses.hint_priority = cost } in
+      (* [true] is the [hnf] flag, matching the [Hint Resolve] vernacular. *)
+      let entry = Hints.HintsResolveEntry [ (info, true, dref) ] in
+      Hints.add_hints ~locality [db] entry)
+
+let hint_attribute : Declare.Hook.t list Attributes.attribute =
+  let parser ?loc _prev v = parse_hint_args ?loc v in
+  map (function None -> [] | Some cfg -> [resolve_hook cfg])
+    (attribute_of_list ["hint", parser])
+
+(* Register and activate the observer when the plugin is loaded (i.e. on
+   [Declare ML Module "rocq-hint-attr.hint"], directly or transitively via
+   [Require Import HintAttr.HintAttr]).  Loading happens once per process, so a
+   plain activation keeps the [#[hint(...)]] attribute available for the rest
+   of the session. *)
+let hint_token =
+  Vernacentries.DefAttributes.Observer.register
+    ~name:"hint-resolve-attribute" hint_attribute
+
+let () = Vernacentries.DefAttributes.Observer.activate hint_token
diff --git a/hint_attr_plugin/src/hint_attr_plugin.mlpack b/hint_attr_plugin/src/hint_attr_plugin.mlpack
new file mode 100644
index 000000000000..e5814df0a0c4
--- /dev/null
+++ b/hint_attr_plugin/src/hint_attr_plugin.mlpack
@@ -0,0 +1 @@
+HintAttr
diff --git a/hint_attr_plugin/theories/HintAttr.v b/hint_attr_plugin/theories/HintAttr.v
new file mode 100644
index 000000000000..ed7f1f5d8c7a
--- /dev/null
+++ b/hint_attr_plugin/theories/HintAttr.v
@@ -0,0 +1,3 @@
+(** Load this module to enable the [#[hint(db=...,cost=...,visibility=...)]]
+    attribute. *)
+Declare ML Module "rocq-hint-attr.hint".
diff --git a/hint_attr_plugin/theories/test.v b/hint_attr_plugin/theories/test.v
new file mode 100644
index 000000000000..721e60c5c1b2
--- /dev/null
+++ b/hint_attr_plugin/theories/test.v
@@ -0,0 +1,44 @@
+Require Import HintAttr.HintAttr.
+
+Create HintDb mydb.
+
+(* On a Lemma: registers [foo] in [mydb] with cost 3, exported. *)
+#[hint(db=mydb, cost="3", visibility=export)]
+Lemma foo : True.
+Proof. exact I. Qed.
+
+(* The hint must now be usable from [mydb]. *)
+Goal True.
+Proof. solve [ auto with mydb ]. Qed.
+
+(* On a Definition, with a different visibility and no explicit cost. *)
+#[hint(db=mydb, visibility=global)]
+Definition bar : True := I.
+
+Goal True.
+Proof. solve [ auto with mydb ]. Qed.
+
+(* Default cost and default visibility (omitted keys). *)
+Definition P := True.
+#[hint(db=mydb)]
+Lemma p_proof : P.
+Proof. exact I. Qed.
+
+Goal P.
+Proof. solve [ auto with mydb ]. Qed.
+
+(* Error handling: missing [db]. *)
+Fail #[hint(cost="1")]
+Definition baz : True := I.
+
+(* Error handling: non-integer cost. *)
+Fail #[hint(db=mydb, cost="oops")]
+Definition qux : True := I.
+
+(* Error handling: bad visibility. *)
+Fail #[hint(db=mydb, visibility=sometimes)]
+Definition quux : True := I.
+
+(* Error handling: unknown sub-key. *)
+Fail #[hint(db=mydb, color="blue")]
+Definition corge : True := I.
diff --git a/ide/rocqide/FAQ b/ide/rocqide/FAQ
index 64ae690675d8..1f8bd0ab170e 100644
--- a/ide/rocqide/FAQ
+++ b/ide/rocqide/FAQ
@@ -19,8 +19,8 @@ Q4) How to use those Forall and Exists pretty symbols?
 R4) Thanks to the Notation features in Coq, you just need to insert these
 	lines in your Coq Buffer :
 ======================================================================
-Notation "∀ x : t, P" := (forall x:t, P) (at level 200, x ident).
-Notation "∃ x : t, P" := (exists x:t, P) (at level 200, x ident).
+Notation "∀ x : t, P" := (forall x:t, P) (at level 10, x ident, P at level 200).
+Notation "∃ x : t, P" := (exists x:t, P) (at level 10, x ident, P at level 200).
 ======================================================================
 Copy/Paste of these lines from this file will not work outside of RocqIDE.
 You need to load a file containing these lines or to enter the "∀" 
diff --git a/ide/rocqide/idetop.ml b/ide/rocqide/idetop.ml
index 05fd2e95058c..7afdb18ea3d9 100644
--- a/ide/rocqide/idetop.ml
+++ b/ide/rocqide/idetop.ml
@@ -16,7 +16,6 @@ open Pp
 open Printer
 
 module NamedDecl = Context.Named.Declaration
-module CompactedDecl = Context.Compacted.Declaration
 
 (** Idetop : an implementation of [Interface], i.e. mainly an interp
     function and a rewind function. *)
@@ -40,7 +39,12 @@ let valid_interrupt () =
 let init_signal_handler () =
   let f _ = if valid_interrupt () then
               if !catch_break then raise Sys.Break else Control.interrupt := true in
-  Sys.set_signal Sys.sigint (Sys.Signal_handle f)
+  Sys.set_signal Sys.sigint (Sys.Signal_handle f);
+  (* Ignore SIGUSR1 by default: it is used by the IDE's Break button to enter
+     the Ltac debugger, and its Unix default action would terminate the process.
+     The Ltac debugger installs its own handler in db_initialize. *)
+  if Sys.os_type = "Unix" then
+    Sys.set_signal Sys.sigusr1 Sys.Signal_ignore
 
 let pr_with_pid s = Printf.eprintf "[pid %d] %s\n%!" (Unix.getpid ()) s
 
@@ -67,7 +71,6 @@ let rocqide_known_option table = List.mem table [
   ["Printing";"Universes"];
   ["Printing";"Unfocused"];
   ["Printing";"Goal";"Names"];
-  ["Generate";"Goal";"Names"];
   ["Diffs"]]
 
 let is_known_option cmd = match cmd with
@@ -195,28 +198,24 @@ let concl_next_tac =
 let process_goal short sigma g =
   let evi = Evd.find_undefined sigma g in
   let env = Evd.evar_filtered_env (Global.env ()) evi in
-  let min_env = Environ.reset_context env in
-  let name = if Printer.print_goal_name sigma g then Some (Names.Id.to_string (Termops.evar_suggested_name env sigma g)) else None in
+  let name = if Printer.print_goal_name sigma g then Some (Termops.evar_string env sigma g) else None in
   let ccl =
     pr_letype_env ~goal_concl_style:true env sigma (Evd.evar_concl evi)
   in
-  let process_hyp d (env,l) =
-    let d' = CompactedDecl.to_named_context d in
-      (List.fold_right EConstr.push_named d' env,
-       (pr_ecompacted_decl env sigma d) :: l) in
+  let process_hyp d = pr_ecompacted_decl env sigma d in
   let hyps =
     if short then [] else
-      let (_env, hyps) =
-        Context.Compacted.fold process_hyp
-        (Termops.compact_named_context sigma (EConstr.named_context env)) ~init:(min_env,[])
+      let hyps =
+        List.rev_map process_hyp
+          (Ppconstr.compact_named_context sigma (Environ.named_context_val env))
       in
       hyps
   in
-  { Interface.goal_hyp = List.rev hyps; Interface.goal_ccl = ccl; Interface.goal_id = Proof.goal_uid g; Interface.goal_name = name }
+  { Interface.goal_hyp = hyps; Interface.goal_ccl = ccl; Interface.goal_id = Proof.goal_uid g; Interface.goal_name = name }
 
 let process_goal_diffs ~short diff_goal_map oldp nsigma ng =
   let env = Global.env () in
-  let name = if Printer.print_goal_name nsigma ng then Some (Names.Id.to_string (Termops.evar_suggested_name env nsigma ng)) else None in
+  let name = if Printer.print_goal_name nsigma ng then Some (Termops.evar_string env nsigma ng) else None in
   let og_s = match oldp, diff_goal_map with
   | Some oldp, Some diff_goal_map -> Proof_diffs.map_goal ng diff_goal_map
   | None, _ | _, None -> None
@@ -302,7 +301,7 @@ let hints () =
     | [] -> None
     | g :: _ ->
       let env = Evd.evar_filtered_env (Global.env ()) (Evd.find_undefined sigma g) in
-      let get_hint_hyp env d accu = hyp_next_tac sigma env d :: accu in
+      let get_hint_hyp env _ d accu = hyp_next_tac sigma env d :: accu in
       let hint_hyps = List.rev (Environ.fold_named_context get_hint_hyp env ~init: []) in
       Some (hint_hyps, concl_next_tac)
   with Vernacstate.Declare.NoCurrentProof -> None
@@ -712,11 +711,6 @@ let islave_parse opts extra_args =
 
 let islave_init ( { Coqtop.run_mode; color_mode }, stm_opts) injections ~opts =
   if run_mode = Coqtop.Batch then Flags.quiet := true;
-  (* -xml-debug implies -debug. *)
-  let injections = if !xml_debug
-    then Coqargs.OptionInjection (["Debug"], OptionSet (Some "all")) :: injections
-    else injections
-  in
   Coqtop.init_toploop opts stm_opts injections
 
 let islave_default_opts = Coqargs.default
diff --git a/ide/rocqide/preferences.ml b/ide/rocqide/preferences.ml
index d73849bae915..5a8a8863ca50 100644
--- a/ide/rocqide/preferences.ml
+++ b/ide/rocqide/preferences.ml
@@ -303,7 +303,7 @@ let read_project =
   new preference ~name:["read_project"] ~init:Append_args ~repr
 
 let project_file_name =
-  new preference ~name:["project_file_name"] ~init:"_CoqProject" ~repr:Repr.(string)
+  new preference ~name:["project_file_name"] ~init:"_RocqProject" ~repr:Repr.(string)
 
 let project_path =
   new preference ~name:["project_path"] ~init:None ~repr:Repr.(option string)
diff --git a/ide/rocqide/protocol/xml_parser.ml b/ide/rocqide/protocol/xml_parser.ml
index a750ea8562b5..756d58098c88 100644
--- a/ide/rocqide/protocol/xml_parser.ml
+++ b/ide/rocqide/protocol/xml_parser.ml
@@ -51,7 +51,6 @@ exception File_not_found of string
 
 type t = {
   mutable check_eof : bool;
-  mutable concat_pcdata : bool;
   source : Lexing.lexbuf;
   stack : Xml_lexer.token Stack.t;
 }
@@ -92,7 +91,6 @@ let make source =
   let () = Xml_lexer.init source in
   {
     check_eof = false;
-    concat_pcdata = true;
     source = source;
     stack = Stack.create ();
   }
diff --git a/ide/rocqide/rocqDriver.ml b/ide/rocqide/rocqDriver.ml
index d1714f7cf1e8..19200a524680 100644
--- a/ide/rocqide/rocqDriver.ml
+++ b/ide/rocqide/rocqDriver.ml
@@ -30,11 +30,11 @@ let get_version () =
   with _ -> Coq_config.version
 
 let short_version () =
-  Printf.sprintf "The Coq Proof Assistant, version %s\n" (get_version ())
+  Printf.sprintf "The Rocq Prover, version %s\n" (get_version ())
 
 let version () =
     Printf.sprintf
-      "The Coq Proof Assistant, version %s\
+      "The Rocq Prover, version %s\
        \nArchitecture %s running %s operating system\
        \nGtk version is %s\
        \nThis is %s \n"
@@ -221,9 +221,9 @@ type rocqtop = {
   mutable status : status;
   mutable stopped_in_debugger : bool;
   (* i.e., RocqIDE has received a prompt message *)
-  mutable do_when_ready : (unit -> unit) Queue.t;
+  do_when_ready : (unit -> unit) Queue.t;
   (* for debug msgs only; functions are called when rocqtop is Ready *)
-  mutable basename : string;
+  basename : string;
   mutable set_script_editable : bool -> unit;
   mutable restore_bpts : unit -> unit
 }
diff --git a/ide/rocqide/rocqOps.ml b/ide/rocqide/rocqOps.ml
index 32771117bf39..41a45ef0f69e 100644
--- a/ide/rocqide/rocqOps.ml
+++ b/ide/rocqide/rocqOps.ml
@@ -489,13 +489,14 @@ object(self)
         let bg = flatten (List.rev bg) in
         return (Wg_ProofView.FocusGoals { fg; bg; })
       | Some { fg_goals = []; bg_goals = bg } ->
-        let flags = { gf_mode = "short"; gf_fg = false; gf_bg = false; gf_shelved = true; gf_given_up = true } in
+        (* gf_bg: get background goals if we didn't already do so *)
+        let flags = { gf_mode = "short"; gf_fg = false; gf_bg = not gf_bg; gf_shelved = true; gf_given_up = true } in
         RocqDriver.subgoals flags >>= fun rem ->
-        let bg = flatten (List.rev bg) in
-        let shelved, given_up = match rem with
-        | None -> [], []
-        | Some goals -> goals.shelved_goals, goals.given_up_goals
+        let shelved, given_up, bg = match rem with
+        | None -> [], [], bg
+        | Some goals -> goals.shelved_goals, goals.given_up_goals, if gf_bg then bg else goals.bg_goals
         in
+        let bg = flatten (List.rev bg) in
         return (Wg_ProofView.NoFocusGoals { bg; shelved; given_up })
       end
     in
diff --git a/ide/rocqide/rocqide.ml b/ide/rocqide/rocqide.ml
index 3a45f846c6bc..d78c32e9c20d 100644
--- a/ide/rocqide/rocqide.ml
+++ b/ide/rocqide/rocqide.ml
@@ -1627,7 +1627,7 @@ let build_ui () =
         browse notebook#current_term.messages#default_route#add_string Coq_config.wwwrefman);
     item "Browse Coq Library" ~label:"Browse Coq _Library" ~accel:"F1" ~stock:`HELP
       ~callback:(fun _ ->
-        browse notebook#current_term.messages#default_route#add_string Coq_config.wwwstdlib);
+        browse notebook#current_term.messages#default_route#add_string Coq_config.wwwcorelib);
     item "Help for keyword" ~label:"Help for _keyword" ~accel:"F1"
       ~callback:(fun _ -> on_current_term (fun sn ->
         browse_keyword sn.messages#default_route#add_string (get_current_word sn)));
@@ -1799,7 +1799,7 @@ let rocqide_specific_usage = Boot.Usage.{
   extra_args = "";
   extra_options = "\n\
 RocqIDE specific options:\
-\n  -f _CoqProjectFile         set _CoqProject file to _CoqProjectFile\
+\n  -f PROJECT_FILE            set Rocq project file to PROJECT_FILE\
 \n  -unicode-bindings f1 .. f2 load files f1..f2 with extra unicode bindings\
 \n  -coqtop dir                look for rocqidetop in dir\
 \n  -coqtop-flags              extra flags for the rocqtop subprocess\
@@ -1836,7 +1836,6 @@ let read_rocqide_args argv =
       set_debug ();
       filter_rocqtop rocqtop project_files bindings_files out args
     |"-xml-debug"::args ->
-      set_debug ();
       (* xml_debug ref only exists in coqidetop *)
       filter_rocqtop rocqtop project_files bindings_files ("-xml-debug"::out) args
     |"-coqtop-flags" :: flags :: args->
diff --git a/ide/rocqide/wg_ProofView.ml b/ide/rocqide/wg_ProofView.ml
index bd5ad7b283fc..be9ea4db97c4 100644
--- a/ide/rocqide/wg_ProofView.ml
+++ b/ide/rocqide/wg_ProofView.ml
@@ -33,12 +33,10 @@ class type proof_view =
     method set_debug_goal : Pp.t -> unit
   end
 
-(* tag is the tag to be hooked, item is the item covered by this tag, make_menu
- *  * is the template for building menu if needed, sel_cb is the callback if
- *  there
- *   * is a selection o said menu, hover_cb is the callback when there is only
- *    * hovering *)
-let hook_tag_cb tag menu_content sel_cb hover_cb =
+(* tag is the tag to be hooked, item is the item covered by this tag,
+   make_menu is the template for building menu if needed, hover_cb is
+   the callback when there is only hovering *)
+let hook_tag_cb tag menu_content hover_cb =
   ignore (tag#connect#event ~callback:
             (fun ~origin evt it ->
                let iter = new GText.iter it in
@@ -51,7 +49,7 @@ let hook_tag_cb tag menu_content sel_cb hover_cb =
                        let ctxt_menu = GMenu.menu () in
                        let factory = new GMenu.factory ctxt_menu in
                        List.iter
-                         (fun (text,cmd) -> ignore (factory#add_item text ~callback:(sel_cb cmd)))
+                         (fun (text,cmd) -> ignore (factory#add_item text))
                          menu_content;
                        ctxt_menu#popup ~button:3 ~time:(GdkEvent.Button.time ev);
                        true
@@ -60,7 +58,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 ~unfoc_goals hints = match goals with
+let mode_tactic (proof : #GText.view_skel) goals ~unfoc_goals hints = match goals with
   | [] -> assert false
   | { Interface.goal_hyp = hyps; Interface.goal_ccl = cur_goal; Interface.goal_name = cur_name } :: rem_goals ->
       let on_hover sel_start sel_stop =
@@ -98,7 +96,7 @@ let mode_tactic sel_cb (proof : #GText.view_skel) goals ~unfoc_goals hints = mat
         | [] -> [], []
         | hint :: hints ->
           let tag = proof#buffer#create_tag [] in
-          let () = hook_tag_cb tag hint sel_cb on_hover in
+          let () = hook_tag_cb tag hint on_hover in
           [tag], hints
         in
         let () = insert_xml ~tags proof#buffer (Richpp.richpp_of_pp ~width hyp) in
@@ -110,7 +108,7 @@ let mode_tactic sel_cb (proof : #GText.view_skel) goals ~unfoc_goals hints = mat
       let () =
         let _ = if goal_hints <> [] then
           let tag = proof#buffer#create_tag [] in
-          let () = hook_tag_cb tag goal_hints sel_cb on_hover in
+          let () = hook_tag_cb tag goal_hints on_hover in
           [tag]
           else []
         in
@@ -141,14 +139,14 @@ let mode_tactic sel_cb (proof : #GText.view_skel) goals ~unfoc_goals hints = mat
                          (Some Tags.Proof.goal)));
       ignore(proof#scroll_to_mark `INSERT)
 
-let display mode (view : #GText.view_skel) goals hints =
+let display (view : #GText.view_skel) goals hints =
   let () = view#buffer#set_text "" in
   let width = Ideutils.textview_width view in
   match goals with
   | NoGoals -> ()
     (* No proof in progress *)
   | FocusGoals { fg; bg } ->
-    mode view fg ~unfoc_goals:bg hints
+    mode_tactic view fg ~unfoc_goals:bg hints
   | NoFocusGoals { bg; shelved; given_up } ->
     begin match (bg, shelved, given_up) with
     | [], [], [] ->
@@ -250,9 +248,7 @@ let proof_view () =
       if needed then begin
         last_width <- width;
         match debug_goal with
-        | None ->
-          let dummy _ () = () in
-          display (mode_tactic dummy) view goals None
+        | None -> display view goals None
         | Some msg -> self#set_debug_goal msg
       end
   end
diff --git a/interp/constrexpr.mli b/interp/constrexpr.mli
index d76de673dcd5..7a0b447abeec 100644
--- a/interp/constrexpr.mli
+++ b/interp/constrexpr.mli
@@ -21,22 +21,19 @@ type sort_name_expr =
 
 type univ_level_expr  = sort_name_expr Glob_term.glob_sort_gen
 
-type qvar_expr =
+type quality_expr =
   | CQVar of qualid
   | CQAnon of Loc.t option
-  | CRawQVar of Sorts.QVar.t
-
-type quality_expr =
   | CQConstant of Sorts.Quality.constant
-  | CQualVar of qvar_expr
+  | CRawQuality of Sorts.Quality.t
 
 type relevance_expr =
   | CRelevant | CIrrelevant
-  | CRelevanceVar of qvar_expr
+  | CRelevanceVar of quality_expr
 
 type relevance_info_expr = relevance_expr option
 
-type sort_expr = (qvar_expr option * (sort_name_expr * int) list Glob_term.glob_sort_gen)
+type sort_expr = (quality_expr option * (sort_name_expr * int) list Glob_term.glob_sort_gen)
 
 type instance_expr = quality_expr list * univ_level_expr list
 
@@ -164,10 +161,10 @@ and constr_expr_r =
   | CIf of constr_expr * (lname option * constr_expr option)
          * constr_expr * constr_expr
   | CHole   of Evar_kinds.glob_evar_kind option
-  | CGenarg of Genarg.raw_generic_argument
+  | CGenarg of GenConstr.raw
 
   (* because print for genargs wants to print directly the glob without an extern phase (??) *)
-  | CGenargGlob of Genarg.glob_generic_argument
+  | CGenargGlob of GenConstr.glb
 
   | CPatVar of Pattern.patvar
   | CEvar   of Glob_term.existential_name CAst.t * (lident * constr_expr) list
diff --git a/interp/constrexpr_ops.ml b/interp/constrexpr_ops.ml
index dd72cd77643f..71bc25444743 100644
--- a/interp/constrexpr_ops.ml
+++ b/interp/constrexpr_ops.ml
@@ -33,20 +33,16 @@ let sort_name_expr_eq c1 c2 = match c1, c2 with
   | CRawType u1, CRawType u2 -> Univ.Level.equal u1 u2
   | (CSProp|CProp|CSet|CType _|CRawType _), _ -> false
 
-let qvar_expr_eq c1 c2 = match c1, c2 with
+let quality_expr_eq c1 c2 = match c1, c2 with
   | CQVar q1, CQVar q2 -> Libnames.qualid_eq q1 q2
   | CQAnon _, CQAnon _ -> true
-  | CRawQVar q1, CRawQVar q2 -> Sorts.QVar.equal q1 q2
-  | (CQVar _ | CQAnon _ | CRawQVar _), _ -> false
-
-let quality_expr_eq q1 q2 = match q1, q2 with
+  | CRawQuality q1, CRawQuality q2 -> Sorts.Quality.equal q1 q2
   | CQConstant q1, CQConstant q2 -> Sorts.Quality.Constants.equal q1 q2
-  | CQualVar q1, CQualVar q2 -> qvar_expr_eq q1 q2
-  | (CQConstant _ | CQualVar _), _ -> false
+  | (CQConstant _ | CQVar _ | CQAnon _ | CRawQuality _), _ -> false
 
 let relevance_expr_eq a b = match a, b with
   | CRelevant, CRelevant | CIrrelevant, CIrrelevant -> true
-  | CRelevanceVar q1, CRelevanceVar q2 -> qvar_expr_eq q1 q2
+  | CRelevanceVar q1, CRelevanceVar q2 -> quality_expr_eq q1 q2
   | (CRelevant | CIrrelevant | CRelevanceVar _), _ -> false
 
 let relevance_info_expr_eq = Option.equal relevance_expr_eq
@@ -55,7 +51,7 @@ let univ_level_expr_eq u1 u2 =
   Glob_ops.glob_sort_gen_eq sort_name_expr_eq u1 u2
 
 let sort_expr_eq (q1, l1) (q2, l2) =
-  Option.equal qvar_expr_eq q1 q2 &&
+  Option.equal quality_expr_eq q1 q2 &&
   Glob_ops.glob_sort_gen_eq
     (List.equal (fun (x,m) (y,n) ->
       sort_name_expr_eq x y
diff --git a/interp/constrextern.ml b/interp/constrextern.ml
index 70519ad2b6fe..397eb9bbe440 100644
--- a/interp/constrextern.ml
+++ b/interp/constrextern.ml
@@ -84,25 +84,14 @@ let extern_evar n l = CEvar (n,l)
     For instance, in the debugger the tables of global references
     may be inaccurate *)
 
-let rec dirpath_of_modpath = function
-  | MPfile dp -> dp
-  | MPbound mbid -> let (_,id,_) = MBId.repr mbid in DirPath.make [id]
-  | MPdot (t, l) -> Libnames.add_dirpath_suffix (dirpath_of_modpath t) l
-
-let qualid_of_global = function
-  | GlobRef.VarRef id -> Libnames.qualid_of_ident id
-  (* We rely on the tacite invariant that the label of a constant is used to build its internal name *)
-  | GlobRef.ConstRef cst -> Libnames.make_qualid (dirpath_of_modpath (Constant.modpath cst)) (Constant.label cst)
-  (* We rely on the tacite invariant that an inductive block inherits the name of its first type *)
-  | GlobRef.IndRef (ind,0) -> Libnames.make_qualid (dirpath_of_modpath (MutInd.modpath ind)) (MutInd.label ind)
-  (* These are hacks *)
-  | GlobRef.IndRef (ind,n) -> Libnames.make_qualid (dirpath_of_modpath (MutInd.modpath ind)) (Id.of_string_soft (""))
-  | GlobRef.ConstructRef ((ind,0),p) -> Libnames.make_qualid (dirpath_of_modpath (MutInd.modpath ind)) (Id.of_string_soft (""))
-  | GlobRef.ConstructRef ((ind,n),p) -> Libnames.make_qualid (dirpath_of_modpath (MutInd.modpath ind)) (Id.of_string_soft (""))
-
 let default_extern_reference ?loc vars r =
   try Nametab.shortest_qualid_of_global ?loc vars r
-  with Not_found -> qualid_of_global r
+  with Not_found ->
+  match r with
+  | ConstRef c when ModPath.equal (Lib.current_mp()) (Constant.modpath c) ->
+    (* assume this is a side effect not yet in the nametab *)
+    Libnames.qualid_of_ident ?loc (Constant.label c)
+  | _ -> raise Not_found
 
 let my_extern_reference = ref default_extern_reference
 
@@ -318,18 +307,23 @@ let rec extern_cases_pattern_in_scope ~flags ((custom,(lev_after:int option)),sc
             | Some l -> CPatRecord l
             | None ->
                   let c = extern_reference vars (GlobRef.ConstructRef cstrsp) in
-                  if Constrintern.get_asymmetric_patterns () then
-                    if pattern_printable_in_both_syntax ~flags cstrsp
-                    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
+                  let full_args = add_patt_for_params (fst cstrsp) args in
+                  let drop n =
                     let tags = try Inductiveops.constructor_alltags (Global.env()) cstrsp
                       with _ when !Flags.in_debugger -> []
                     in
-                    match drop_implicits_in_patt ~flags (GlobRef.ConstructRef cstrsp) 0 ~tags full_args with
+                    let tags = List.skipn_at_best n tags in
+                    let args = List.skipn_at_best n full_args in
+                    match drop_implicits_in_patt ~flags (GlobRef.ConstructRef cstrsp) n ~tags args with
                       | Some true_args -> CPatCstr (c, None, true_args)
-                      | None           -> CPatCstr (c, Some full_args, [])
+                      | None           -> CPatCstr (c, Some full_args, []) in
+                  if Constrintern.get_asymmetric_patterns () then
+                    if pattern_printable_in_both_syntax ~flags cstrsp
+                    then CPatCstr (c, None, args)
+                    else if Constrintern.get_asymmetric_patterns_no_implicits ()
+                    then CPatCstr (c, Some full_args, [])
+                    else drop (Inductiveops.inductive_nparamdecls (Global.env()) (fst cstrsp))
+                  else drop 0
           in
           insert_pat_alias ?loc (CAst.make ?loc p) na
       in
@@ -501,7 +495,7 @@ let adjust_implicit_arguments ~flags inctx n args impl =
           (flags.ExternFlags.implicits && flags.ExternFlags.implicits_explicit_args) ||
           (is_needed_for_correct_partial_application tail imp) ||
           (flags.ExternFlags.implicits_defensive &&
-           (not (is_inferable_implicit inctx n imp) || !Flags.beautify) &&
+           (not (is_inferable_implicit inctx n imp)) &&
            is_significant_implicit (Lazy.force a))
         in
         if visible then
@@ -793,28 +787,24 @@ let extern_glob_sort_name uvars = function
       | None -> CRawType u
     end
 
-let extern_glob_qvar uvars = function
+let extern_glob_quality uvars = function
   | GLocalQVar {v=Anonymous;loc} -> CQAnon loc
   | GLocalQVar {v=Name id; loc} -> CQVar (qualid_of_ident ?loc id)
-  | GRawQVar q -> CRawQVar q
-  | GQVar q -> begin match UnivNames.qualid_of_quality uvars q with
+  | GRawQVar q -> CRawQuality (QVar q)
+  | GQuality q -> begin match UnivNames.qualid_of_quality uvars q with
     | Some qid -> CQVar qid
-    | None -> CRawQVar q
+    | None -> CRawQuality q
     end
 
 let extern_relevance uvars = function
   | GRelevant -> CRelevant
   | GIrrelevant -> CIrrelevant
-  | GRelevanceVar q -> CRelevanceVar (extern_glob_qvar uvars q)
+  | GRelevanceVar q -> CRelevanceVar (extern_glob_quality uvars q)
 
 let extern_relevance_info uvars = Option.map (extern_relevance uvars)
 
-let extern_glob_quality uvars = function
-  | GQConstant q -> CQConstant q
-  | GQualVar q -> CQualVar (extern_glob_qvar uvars q)
-
 let extern_glob_sort uvars (q, l) =
-  Option.map (extern_glob_qvar uvars) q,
+  Option.map (extern_glob_quality uvars) q,
   map_glob_sort_gen (List.map (on_fst (extern_glob_sort_name uvars))) l
 
 let extern_instance uvars = function
@@ -857,7 +847,7 @@ let max_depth = ref None
 
 let set_max_depth d = max_depth := d
 
-let init_depth () = match !max_depth with
+let init_depth flags = match flags.ExternFlags.depth with
   | None -> Unlimited
   | Some max -> Until { current = 0; max }
 
@@ -1318,14 +1308,14 @@ and extern_applied_proj depth inctx scopes eenv (cst,us) params c extraargs =
   let us = extern_instance eenv.uvars us in
   extern_projection ~flags:eenv.flags inctx (f,us) nparams args imps
 
-let extern inctx scopes eenv c : constr_expr = extern (init_depth()) inctx scopes eenv c
+let extern inctx scopes eenv c : constr_expr = extern (init_depth eenv.flags) inctx scopes eenv c
 
 let extern_glob_constr eenv c =
   extern false ((constr_some_level,None),([],[])) eenv c
 
 let extern_glob_type ?impargs eenv c =
   let c = Option.fold_right insert_impargs impargs c in
-  extern_typ (init_depth()) ((constr_some_level,None),([],[])) eenv c
+  extern_typ (init_depth eenv.flags) ((constr_some_level,None),([],[])) eenv c
 
 (******************************************************************)
 (* Main translation function from constr -> constr_expr *)
@@ -1486,7 +1476,7 @@ let rec glob_of_pat
           ((List.hd nas, Some (CAst.make (ind, List.tl nas))), Some p)
         | _ -> anomaly (Pp.str "PCase with non-trivial predicate but unknown inductive.")
       in
-      GCases (Constr.RegularStyle,rtn,[glob_of_pat of_extra avoid env sigma tm,indnames],mat)
+      GCases (Constr.MatchStyle,rtn,[glob_of_pat of_extra avoid env sigma tm,indnames],mat)
   | PFix ((ln,i),(lna,tl,bl)) ->
      let def_avoid, def_env, lfi =
        Array.fold_left
@@ -1520,6 +1510,7 @@ let rec glob_of_pat
   | PSort (Qual (QConstant QSProp)) -> GSort Glob_ops.glob_SProp_sort
   | PSort (Qual (QConstant QProp)) -> GSort Glob_ops.glob_Prop_sort
   | PSort (Qual (QConstant QType | QVar _)) -> GSort Glob_ops.glob_Type_sort
+  | PSort (Qual (QGlobal _ as q)) -> GSort (Some (GQuality q), Glob_ops.glob_rigid_univ)
   | PSort Set -> GSort Glob_ops.glob_Set_sort
   | PInt i -> GInt i
   | PFloat f -> GFloat f
@@ -1546,4 +1537,4 @@ let extern_rel_context ~(flags:PrintingFlags.t) env sigma sign =
   let a = detype_rel_context Detyping.Later ~flags:flags.detype ([],env) sigma sign in
   let eenv = extern_env env sigma ~flags:flags.extern in
   let a = List.map (extended_glob_local_binder_of_decl) a in
-  pi3 (extern_local_binder (init_depth()) ((constr_some_level,None),([],[])) eenv a)
+  pi3 (extern_local_binder (init_depth eenv.flags) ((constr_some_level,None),([],[])) eenv a)
diff --git a/interp/constrintern.ml b/interp/constrintern.ml
index 9d194813b607..904896617203 100644
--- a/interp/constrintern.ml
+++ b/interp/constrintern.ml
@@ -1240,31 +1240,28 @@ let intern_sort_name ~local_univs = function
         else
           CErrors.user_err ?loc:qid.loc Pp.(str "Undeclared universe " ++ pr_qualid qid ++ str".")
 
-let intern_qvar ~local_univs = function
+let intern_quality ~local_univs = function
   | CQAnon loc -> GLocalQVar (CAst.make ?loc Anonymous)
-  | CRawQVar q -> GRawQVar q
+  | CRawQuality (QVar q) -> GRawQVar q
+  | CRawQuality _ -> assert false (* intern on raw quality only used for funind hacks *)
+  | CQConstant q -> GQuality (QConstant q)
   | CQVar qid ->
     let is_id = qualid_is_ident qid in
     let local = if not is_id then None
       else Id.Map.find_opt (qualid_basename qid) (fst local_univs.bound)
     in
     match local with
-    | Some u -> GQVar u
+    | Some u -> GQuality (QVar u)
     | None ->
-      try GQVar (Sorts.QVar.make_global (Nametab.Quality.locate qid))
+      try GQuality (Nametab.Quality.locate qid)
       with Not_found ->
         if is_id && local_univs.unb_univs
         then GLocalQVar (CAst.make ?loc:qid.loc (Name (qualid_basename qid)))
         else
           CErrors.user_err ?loc:qid.loc Pp.(str "Undeclared quality " ++ pr_qualid qid ++ str".")
 
-let intern_quality ~local_univs q =
-  match q with
-  | CQConstant q -> GQConstant q
-  | CQualVar q -> GQualVar (intern_qvar ~local_univs q)
-
 let intern_sort ~local_univs (q,l) =
-  Option.map (intern_qvar ~local_univs) q,
+  Option.map (intern_quality ~local_univs) q,
   map_glob_sort_gen (List.map (on_fst (intern_sort_name ~local_univs))) l
 
 let intern_instance ~local_univs = function
@@ -1779,6 +1776,13 @@ let { Goptions.get = get_asymmetric_patterns } =
     ~value:false
     ()
 
+let { Goptions.get = get_asymmetric_patterns_no_implicits } =
+  Goptions.declare_bool_option_and_ref
+    ~depr:(Deprecation.make ~since:"9.3" ())
+    ~key:["Asymmetric";"Patterns";"No";"Implicits"]
+    ~value:false
+    ()
+
 type global_reference_test = {
   for_ind : bool;
   test_kind : ?loc:Loc.t -> GlobRef.t -> unit
@@ -1856,7 +1860,7 @@ let drop_notations_pattern (test_kind_top,test_kind_inner) genv env pat =
     let loc = pt.loc in
     (* The two policies implied by asymmetric pattern mode *)
     let add_par_if_no_ntn_with_par = get_asymmetric_patterns () && not for_ind in
-    let no_impl = get_asymmetric_patterns () && not for_ind in
+    let no_impl = get_asymmetric_patterns_no_implicits () && get_asymmetric_patterns () && not for_ind in
     match pt.v with
     | CPatAlias (p, id) -> DAst.make ?loc @@ RCPatAlias (in_pat test_kind scopes p, id)
     | CPatRecord l ->
@@ -1883,7 +1887,7 @@ let drop_notations_pattern (test_kind_top,test_kind_inner) genv env pat =
       end
     | CPatNotation (_,(InConstrEntry,"- _"),([a],[],[]),[]) when is_non_zero_pat a ->
       let p = match a.CAst.v with CPatPrim (Number (_, p)) -> p | _ -> assert false in
-      let pat, _df = Notation.interp_prim_token_cases_pattern_expr ?loc
+      let pat = Notation.interp_prim_token_cases_pattern_expr ?loc
           (check_allowed_ref_in_pat test_kind) (Number (SMinus,p)) scopes in
       rcp_of_glob scopes pat
     | CPatNotation (_,(InConstrEntry,"( _ )"),([a],[],[]),[]) ->
@@ -1901,7 +1905,7 @@ let drop_notations_pattern (test_kind_top,test_kind_inner) genv env pat =
         | DelimUnboundedScope -> [], sc::snd scopes in
       in_pat test_kind scopes e
     | CPatPrim p ->
-      let pat, _df = Notation.interp_prim_token_cases_pattern_expr ?loc
+      let pat = Notation.interp_prim_token_cases_pattern_expr ?loc
           (check_allowed_ref_in_pat test_kind) p scopes in
       rcp_of_glob scopes pat
     | CPatAtom (Some id) ->
@@ -2176,8 +2180,8 @@ module Interner = struct
   ; lettuple : t -> (lname list * (lname option * constr_expr option) * constr_expr * constr_expr) fn
   ; if_ : t -> (constr_expr * (lname option * constr_expr option) * constr_expr * constr_expr) fn
   ; hole : t -> Evar_kinds.glob_evar_kind option fn
-  ; genarg : t -> Genarg.raw_generic_argument fn
-  ; genargglob : t -> Genarg.glob_generic_argument fn
+  ; genarg : t -> GenConstr.raw fn
+  ; genargglob : t -> GenConstr.glb fn
   ; patvar : t -> (Pattern.patvar) fn
   ; evar : t -> (Glob_term.existential_name CAst.t * (lident * constr_expr) list) fn
   ; sort : t -> sort_expr fn
@@ -2676,7 +2680,7 @@ let cases self genv env lvar ?loc (sty, rtnpo, tms, eqns) =
         if List.for_all (irrefutable genv) thepats then [] else
           [CAst.make @@ ([],List.make (List.length thepats) (DAst.make @@ PatVar Anonymous), (* "|_,..,_" *)
                          DAst.make @@ GHole(GImpossibleCase))]   (* "=> _" *) in
-      Some (DAst.make @@ GCases(RegularStyle,sub_rtn,sub_tms,main_sub_eqn::catch_all_sub_eqn))
+      Some (DAst.make @@ GCases(MatchStyle,sub_rtn,sub_tms,main_sub_eqn::catch_all_sub_eqn))
   in
   let eqns' = List.map (intern_eqn self genv env lvar (List.length tms)) eqns in
   DAst.make ?loc @@
@@ -2731,6 +2735,7 @@ let genarg self genv env lvar ?loc gen =
   (* Propagating enough information for mutual interning with tac-in-term *)
   let intern_sign = {
     Genintern.intern_ids = env.ids;
+    Genintern.intern_univs = env.local_univs.bound;
     Genintern.notation_variable_status = ntnvars
   } in
   let ist = {
@@ -2741,10 +2746,10 @@ let genarg self genv env lvar ?loc gen =
     strict_check = match env.strict_check with None -> false | Some b -> b;
   } in
   let intern = if env.pattern_mode
-    then Genintern.generic_intern_pat ?loc
-    else Genintern.generic_intern
+    then Genintern.generic_intern_pat
+    else Genintern.generic_intern_constr
   in
-  let (_, glb) = intern ist gen in
+  let glb = intern ?loc ist gen in
   DAst.make ?loc @@
   GGenarg glb
 
@@ -2799,7 +2804,7 @@ let generalization self genv env lvar ?loc (b, c) =
   intern_generalization intern env (snd lvar) loc b c
 
 let prim self genv env lvar ?loc p =
-  let c = fst (Notation.interp_prim_token ?loc p (env.tmp_scope,env.scopes)) in
+  let c = Notation.interp_prim_token ?loc p (env.tmp_scope,env.scopes) in
   apply_impargs self genv env lvar loc c []
 
 let delimiters self genv env lvar ?loc (depth, key, e) =
@@ -2963,14 +2968,28 @@ let interp_constr_pattern env sigma ?as_type ?strict_check c =
   let ids, pat = intern_constr_pattern env sigma ?as_type ?strict_check c in
   ids, Patternops.interp_pattern env sigma Glob_ops.empty_lvar pat
 
-let intern_core kind env sigma ?strict_check ?(pattern_mode=false) ?(ltacvars=empty_ltac_sign)
-      { Genintern.intern_ids = ids; Genintern.notation_variable_status = vl } c =
-  let tmp_scope = scope_of_type_kind env sigma kind in
+let intern_core kind ?(pattern_mode=false) ist c =
+  let env = ist.Genintern.genv in
+  let Genintern.{
+      intern_ids = ids;
+      notation_variable_status = vl;
+      intern_univs = local_univs;
+    } = ist.intern_sign
+  in
+  let ltacvars = {
+    ltac_vars = ist.ltacvars;
+    ltac_bound = Id.Set.empty;
+    ltac_extra = ist.extra;
+  }
+  in
+  (* Evd.from_env: in practice kind is never OfType so evar map doesn't matter
+     maybe should change intern_core API to take is_arity:bool instead of typing constraint? *)
+  let tmp_scope = scope_of_type_kind env (Evd.from_env env) kind in
   let impls = empty_internalization_env in
   let k = allowed_binder_kind_of_type_kind kind in
   internalize env
-    {ids; strict_check; pattern_mode;
-     local_univs = { bound = bound_univs sigma; unb_univs = true };
+    {ids; strict_check = Some ist.strict_check; pattern_mode;
+     local_univs = { bound = local_univs; unb_univs = not ist.strict_check };
      tmp_scope; scopes = []; impls;
      binder_block_names = Some (Some k); ntn_binding_ids = Id.Set.empty}
     (ltacvars, vl) c
@@ -3098,7 +3117,7 @@ let interp_context_evars_gen ?(program_mode=false) ?(unconstrained_sorts = false
 let interp_named_context_evars ?program_mode ?unconstrained_sorts ?poly ?impl_env ?autoimp_enable env sigma bl =
   let extract_name ?loc = function Name id -> id | Anonymous -> user_err ?loc Pp.(str "Unexpected anonymous variable.") in
   let make_decl ?loc = Context.Named.Declaration.of_rel_decl (extract_name ?loc) in
-  interp_context_evars_gen ?program_mode ?unconstrained_sorts ?poly ?impl_env ?autoimp_enable ~dump:false env sigma make_decl EConstr.push_named bl
+  interp_context_evars_gen ?program_mode ?unconstrained_sorts ?poly ?impl_env ?autoimp_enable ~dump:false env sigma make_decl (EConstr.push_named ProofVar) bl
 
 let interp_context_evars ?program_mode ?unconstrained_sorts ?poly ?impl_env env sigma bl =
   interp_context_evars_gen ?program_mode ?unconstrained_sorts ?poly ?impl_env ~autoimp_enable:false ~dump:true env sigma (fun ?loc d -> d) EConstr.push_rel bl
@@ -3141,15 +3160,15 @@ let interp_univ_constraints env evd cstrs =
     with UGraph.UniverseInconsistency e as exn ->
       let _, info = Exninfo.capture exn in
       CErrors.user_err ~info
-        (UGraph.explain_universe_inconsistency (Termops.pr_evd_qvar evd) (Termops.pr_evd_level evd) e)
+        (UGraph.explain_universe_inconsistency (Evd.sort_printer evd) e)
   in
   List.fold_left interp (evd,Univ.UnivConstraints.empty) cstrs
 
 let known_glob_quality evd q =
   match q with
-  | GQConstant q -> Sorts.Quality.QConstant q
-  | GQualVar (GLocalQVar _) -> assert false
-  | GQualVar (GQVar q | GRawQVar q) -> Sorts.Quality.QVar q
+  | GQuality q -> q
+  | GLocalQVar _ -> assert false
+  | GRawQVar q -> QVar q
 
 let interp_known_quality evd q =
   let q = intern_quality ~local_univs:{bound = bound_univs evd; unb_univs=false} q in
@@ -3163,13 +3182,13 @@ let interp_elim_constraint evd (q1,k,q2) =
 let interp_elim_constraints env evd cstrs =
   let interp (evd,cstrs) cstr =
     let cstr = interp_elim_constraint evd cstr in
-    try let evd = Evd.add_poly_constraints ~src:UState.Rigid evd @@
+    try let evd = Evd.add_poly_constraints ~src:UState.Internal evd @@
                     PConstraints.of_qualities (Sorts.ElimConstraints.singleton cstr) in
         evd, Sorts.ElimConstraints.add cstr cstrs
     with QGraph.EliminationError e as exn ->
       let _, info = Exninfo.capture exn in
       CErrors.user_err ~info @@
-        QGraph.explain_elimination_error (Termops.pr_evd_qvar evd) e
+        QGraph.explain_elimination_error (Evd.quality_printer evd) e
   in
   List.fold_left interp (evd, Sorts.ElimConstraints.empty) cstrs
 
diff --git a/interp/constrintern.mli b/interp/constrintern.mli
index bc168287ee65..3cbf381ca920 100644
--- a/interp/constrintern.mli
+++ b/interp/constrintern.mli
@@ -118,8 +118,8 @@ module Interner : sig
   ; lettuple : t -> (lname list * (lname option * constr_expr option) * constr_expr * constr_expr) fn
   ; if_ : t -> (constr_expr * (lname option * constr_expr option) * constr_expr * constr_expr) fn
   ; hole : t -> Evar_kinds.glob_evar_kind option fn
-  ; genarg : t -> Genarg.raw_generic_argument fn
-  ; genargglob : t -> Genarg.glob_generic_argument fn
+  ; genarg : t -> GenConstr.raw fn
+  ; genargglob : t -> GenConstr.glb fn
   ; patvar : t -> (Pattern.patvar) fn
   ; evar : t -> (Glob_term.existential_name CAst.t * (lident * constr_expr) list) fn
   ; sort : t -> sort_expr fn
@@ -240,11 +240,9 @@ val interp_notation_constr : env -> ?impls:internalization_env ->
   notation_interp_env -> constr_expr ->
   (bool * subscopes * Id.Set.t) Id.Map.t * notation_constr * reversibility_status
 
-(** Idem but to glob_constr (weaker check of binders) *)
-
-val intern_core : typing_constraint ->
-  env -> evar_map -> ?strict_check:bool -> ?pattern_mode:bool -> ?ltacvars:ltac_sign ->
-  Genintern.intern_variable_status -> constr_expr ->
+(** Typically used to internalize a term inside a tactic. *)
+val intern_core : typing_constraint -> ?pattern_mode:bool ->
+  Genintern.glob_sign -> constr_expr ->
   glob_constr
 
 (** Globalization options *)
@@ -253,6 +251,8 @@ val parsing_explicit : bool ref
 (** Placeholder for global option, should be moved to a parameter *)
 val get_asymmetric_patterns : unit -> bool
 
+val get_asymmetric_patterns_no_implicits : unit -> bool
+
 val check_duplicate : ?loc:Loc.t -> (qualid * constr_expr) list -> unit
 (** Check that a list of record field definitions doesn't contain
     duplicates. *)
diff --git a/interp/dumpglob.ml b/interp/dumpglob.ml
index 38f83b6642d4..b0b0a9d1a912 100644
--- a/interp/dumpglob.ml
+++ b/interp/dumpglob.ml
@@ -132,9 +132,9 @@ let type_of_logical_kind = function
 
 (** Data associated to global parameters and constants *)
 
-let csttab = Summary.ref (Names.Cmap.empty : logical_kind Names.Cmap.t) ~name:"CONSTANT"
-let add_constant_kind kn k = csttab := Names.Cmap.add kn k !csttab
-let constant_kind kn = Names.Cmap.find kn !csttab
+let csttab = Summary.ref (Environ.QConstant.Map.empty : logical_kind Environ.QConstant.Map.t) ~name:"CONSTANT"
+let add_constant_kind env kn k = csttab := Environ.QConstant.Map.add env kn k !csttab
+let constant_kind env kn = Environ.QConstant.Map.find env kn !csttab
 
 let type_of_global_ref gr =
   if Typeclasses.is_class (Global.env ()) gr then
@@ -143,7 +143,7 @@ let type_of_global_ref gr =
     let open Names.GlobRef in
     match gr with
     | ConstRef cst ->
-      let knd = try constant_kind cst with Not_found -> IsDefinition Definition in
+      let knd = try constant_kind (Global.env ()) cst with Not_found -> IsDefinition Definition in
       type_of_logical_kind knd
     | VarRef v ->
       let knd = try Decls.variable_kind v with Not_found -> IsDefinition Definition in
diff --git a/interp/dumpglob.mli b/interp/dumpglob.mli
index cbc18ce00af5..86ec0a1c2eb2 100644
--- a/interp/dumpglob.mli
+++ b/interp/dumpglob.mli
@@ -152,5 +152,5 @@ val dump_string : string -> unit
 val type_of_global_ref : Names.GlobRef.t -> string
 
 (** Registration of constant information *)
-val add_constant_kind : Names.Constant.t -> Decls.logical_kind -> unit
-val constant_kind : Names.Constant.t -> Decls.logical_kind
+val add_constant_kind : Environ.env -> Names.Constant.t -> Decls.logical_kind -> unit
+val constant_kind : Environ.env -> Names.Constant.t -> Decls.logical_kind
diff --git a/interp/dune b/interp/dune
index 4e11d42c7e06..169600eead0e 100644
--- a/interp/dune
+++ b/interp/dune
@@ -5,7 +5,3 @@
  (wrapped false)
  (modules_without_implementation constrexpr notation_term)
  (libraries zarith pretyping gramlib))
-
-(deprecated_library_name
- (old_public_name coq-core.interp)
- (new_public_name rocq-runtime.interp))
diff --git a/interp/genintern.ml b/interp/genintern.ml
index 13993cc5944d..3fbd948b0f3f 100644
--- a/interp/genintern.ml
+++ b/interp/genintern.ml
@@ -23,6 +23,7 @@ type ntnvar_status = {
 
 type intern_variable_status = {
   intern_ids : Id.Set.t;
+  intern_univs : UnivNames.universe_binders;
   notation_variable_status : ntnvar_status Id.Map.t;
 }
 
@@ -34,16 +35,17 @@ type glob_sign = {
   strict_check : bool;
 }
 
-let empty_intern_sign = {
+let empty_intern_sign univs = {
   intern_ids = Id.Set.empty;
+  intern_univs = univs;
   notation_variable_status = Id.Map.empty;
 }
 
-let empty_glob_sign ~strict env = {
+let empty_glob_sign ~strict env univs = {
   ltacvars = Id.Set.empty;
   genv = env;
   extra = Store.empty;
-  intern_sign = empty_intern_sign;
+  intern_sign = empty_intern_sign univs;
   strict_check = strict;
 }
 
@@ -63,52 +65,58 @@ struct
   let default _ = None
 end
 
+type ('raw, 'glb) constr_intern_fun = ?loc:Loc.t -> glob_sign -> 'raw -> 'glb
+
+module CInternObj = struct
+  type ('r, 'g) t = ('r, 'g) constr_intern_fun
+end
+
 module NtnSubstObj =
 struct
-  type ('raw, 'glb, 'top) obj = 'glb ntn_subst_fun
-  let name = "notation_subst"
-  let default _ = None
+  type (_, 'glb) t = 'glb ntn_subst_fun
 end
 
 module Intern = Register (InternObj)
-module NtnSubst = Register (NtnSubstObj)
+module CIntern = GenConstr.Register (CInternObj)
+module NtnSubst = GenConstr.Register (NtnSubstObj)
 
 let intern = Intern.obj
 let register_intern0 = Intern.register0
+let register_intern_constr = CIntern.register
 
 let generic_intern ist (GenArg (Rawwit wit, v)) =
   let (ist, v) = intern wit ist v in
   (ist, in_gen (glbwit wit) v)
 
-type ('raw,'glb) intern_pat_fun = ?loc:Loc.t -> ('raw,'glb) intern_fun
+let generic_intern_constr ?loc ist (GenConstr.Raw (tag, v)) =
+  let internf = CIntern.get tag in
+  GenConstr.Glb (tag, internf ?loc ist v)
 
 module InternPatObj = struct
-  type ('raw, 'glb, 'top) obj = ('raw, 'glb) intern_pat_fun
-  let name = "intern_pat"
-  let default tag =
-    Some (fun ?loc ->
-        let name = Genarg.(ArgT.repr tag) in
-        CErrors.user_err ?loc Pp.(str "This quotation is not supported in tactic patterns (" ++ str name ++ str ")"))
+  type ('raw, 'glb) t = ('raw, 'glb) constr_intern_fun
 end
 
-module InternPat = Register (InternPatObj)
+module InternPat = GenConstr.Register (InternPatObj)
 
-let intern_pat = InternPat.obj
+let register_intern_pat = InternPat.register
 
-let register_intern_pat = InternPat.register0
-
-let generic_intern_pat ?loc ist (GenArg (Rawwit wit, v)) =
-  let (ist, v) = intern_pat wit ?loc ist v in
-  (ist, in_gen (glbwit wit) v)
+let generic_intern_pat ?loc ist (GenConstr.Raw (tag, v)) =
+  match InternPat.find_opt tag with
+  | None ->
+    let name = GenConstr.repr tag in
+    CErrors.user_err ?loc Pp.(str "This quotation is not supported in tactic patterns (" ++ str name ++ str ").")
+  | Some internf ->
+    let v = internf ?loc ist v in
+    GenConstr.Glb (tag, v)
 
 (** Notation substitution *)
 
-let substitute_notation = NtnSubst.obj
-let register_ntn_subst0 = NtnSubst.register0
+let substitute_notation = NtnSubst.get
+let register_ntn_subst0 = NtnSubst.register
 
-let generic_substitute_notation avoid env (GenArg (Glbwit wit, v) as orig) =
-  let v' = substitute_notation wit avoid env v in
-  if v' == v then orig else in_gen (glbwit wit) v'
+let generic_substitute_notation avoid env (GenConstr.Glb (tag, v) as orig) =
+  let v' = substitute_notation tag avoid env v in
+  if v' == v then orig else Glb (tag, v')
 
 let with_used_ntnvars ntnvars f =
   let () = Id.Map.iter (fun _ status ->
@@ -135,3 +143,9 @@ let with_used_ntnvars ntnvars f =
     let e = Exninfo.capture e in
     let () = Id.Map.iter (fun _ status -> status.ntnvar_used <- List.tl status.ntnvar_used) ntnvars in
     Exninfo.iraise e
+
+let create_uniform_genconstr name =
+  let tag = GenConstr.create name in
+  let () = register_intern_constr tag (fun ?loc _ v -> v) in
+  let () = Gensubst.register_constr_subst tag (fun _ v -> v) in
+  tag
diff --git a/interp/genintern.mli b/interp/genintern.mli
index 36d10e1a0232..8f0f4d0f4a5a 100644
--- a/interp/genintern.mli
+++ b/interp/genintern.mli
@@ -24,6 +24,7 @@ type ntnvar_status = {
 
 type intern_variable_status = {
   intern_ids : Id.Set.t;
+  intern_univs : UnivNames.universe_binders;
   notation_variable_status : ntnvar_status Id.Map.t;
 }
 
@@ -35,7 +36,7 @@ type glob_sign = {
   strict_check : bool;
 }
 
-val empty_glob_sign : strict:bool -> Environ.env -> glob_sign
+val empty_glob_sign : strict:bool -> Environ.env -> UnivNames.universe_binders -> glob_sign
 
 (** In globalize tactics, we need to keep the initial [constr_expr] to recompute
    in the environment by the effective calls to Intro, Inversion, etc
@@ -48,17 +49,17 @@ type glob_constr_pattern_and_expr = Id.Set.t * glob_constr_and_expr * Pattern.un
 type ('raw, 'glb) intern_fun = glob_sign -> 'raw -> glob_sign * 'glb
 (** The type of functions used for internalizing generic arguments. *)
 
+type ('raw, 'glb) constr_intern_fun = ?loc:Loc.t -> glob_sign -> 'raw -> 'glb
+
 val intern : ('raw, 'glb, 'top) genarg_type -> ('raw, 'glb) intern_fun
 
 val generic_intern : (raw_generic_argument, glob_generic_argument) intern_fun
 
-(** {5 Internalization in tactic patterns} *)
-
-type ('raw,'glb) intern_pat_fun = ?loc:Loc.t -> ('raw,'glb) intern_fun
+val generic_intern_constr : (GenConstr.raw, GenConstr.glb) constr_intern_fun
 
-val intern_pat : ('raw, 'glb, 'top) genarg_type -> ('raw, 'glb) intern_pat_fun
+(** {5 Internalization in tactic patterns} *)
 
-val generic_intern_pat : (raw_generic_argument, glob_generic_argument) intern_pat_fun
+val generic_intern_pat : (GenConstr.raw, GenConstr.glb) constr_intern_fun
 
 (** {5 Notation functions} *)
 
@@ -67,20 +68,26 @@ val generic_intern_pat : (raw_generic_argument, glob_generic_argument) intern_pa
    may raise an exception if it fails, None for recursive part variables *)
 type 'glb ntn_subst_fun = ntnvar_status Id.Map.t -> (Id.t -> Glob_term.glob_constr option) -> 'glb -> 'glb
 
-val substitute_notation : ('raw, 'glb, 'top) genarg_type -> 'glb ntn_subst_fun
+val substitute_notation : (_, 'glb) GenConstr.tag -> 'glb ntn_subst_fun
 
-val generic_substitute_notation : glob_generic_argument ntn_subst_fun
+val generic_substitute_notation : GenConstr.glb ntn_subst_fun
 
 (** Registering functions *)
 
 val register_intern0 : ('raw, 'glb, 'top) genarg_type ->
   ('raw, 'glb) intern_fun -> unit
 
-val register_intern_pat : ('raw, 'glb, 'top) genarg_type ->
-  ('raw, 'glb) intern_pat_fun -> unit
+val register_intern_constr : ('raw, 'glb) GenConstr.tag ->
+  ('raw, 'glb) constr_intern_fun -> unit
+
+val register_intern_pat : ('raw, 'glb) GenConstr.tag ->
+  ('raw, 'glb) constr_intern_fun -> unit
 
-val register_ntn_subst0 : ('raw, 'glb, 'top) genarg_type ->
-  'glb ntn_subst_fun -> unit
+val register_ntn_subst0 : (_, 'glb) GenConstr.tag -> 'glb ntn_subst_fun -> unit
 
 (** Used to compute the set of used notation variables during internalization.*)
 val with_used_ntnvars : ntnvar_status Id.Map.t -> (unit -> 'a) -> Id.Set.t * 'a
+
+(** Registers trivial intern and subst functions. Other registers
+    should be done by the caller. *)
+val create_uniform_genconstr : string -> ('a, 'a) GenConstr.tag
diff --git a/interp/impargs.ml b/interp/impargs.ml
index 9d1add09ef8b..e0df324054a9 100644
--- a/interp/impargs.ml
+++ b/interp/impargs.ml
@@ -254,18 +254,18 @@ let compute_implicits_names env sigma t =
   let open Context.Rel.Declaration in
   let rec aux env names t = match whd_prod env sigma t with
   | Some (na, a, b) ->
-    let rels,ids = Termops.free_rels_and_unqualified_refs sigma a in
-    aux (push_rel (LocalAssum (na,a)) env) ((na.Context.binder_name,rels,ids)::names) b
+    let rels = Termops.free_rels sigma a in
+    aux (push_rel (LocalAssum (na,a)) env) ((na.Context.binder_name,rels)::names) b
   | None ->
-    let rels,ids = Termops.free_rels_and_unqualified_refs sigma t in
-    let rec set_names (allrels,ids) = function
+    let rels = Termops.free_rels sigma t in
+    let rec set_names allrels = function
     | [] -> (1,1,[])
-    | (na,rels',ids')::names ->
-      let (absolute_pos,nnondep,names) = set_names (rels'::allrels,Id.Set.union ids ids') names in
+    | (na,rels')::names ->
+      let (absolute_pos,nnondep,names) = set_names (rels'::allrels) names in
       let isdep = List.exists_i (fun i rels -> Int.Set.mem i rels) 1 allrels in
       let nnondep',dep_pos = if isdep then nnondep, None else nnondep + 1, Some nnondep in
       (absolute_pos+1,nnondep',(na,absolute_pos,dep_pos)::names) in
-    let _,_,names = set_names ([rels],ids) names in
+    let _,_,names = set_names [rels] names in
     List.rev names
   in
   NewProfile.profile "compute_implicits_names" (fun () -> aux env [] t) ()
diff --git a/interp/notation.ml b/interp/notation.ml
index a99bfe4fb71a..b1fdb1a02314 100644
--- a/interp/notation.ml
+++ b/interp/notation.ml
@@ -535,7 +535,7 @@ let interp_prim_token_gen ?loc g p local_scopes =
   let p_as_ntn = try notation_of_prim_token p with Not_found -> InConstrEntry,"" in
   try
     let pat, sc = find_interpretation p_as_ntn (find_prim_token ?loc g p) scopes in
-    pat, sc
+    pat
   with Not_found as exn ->
     let _, info = Exninfo.capture exn in
     user_err ?loc ~info
@@ -642,7 +642,9 @@ let is_printing_inactive_rule rule pat =
   | NotationRule (scope,ntn) ->
     not (is_printing_active_in_scope (scope,ntn) pat)
   | AbbrevRule kn ->
-    try let _ = Nametab.path_of_abbreviation kn in false with Not_found -> true
+    match Abbreviation.find_opt kn with
+    | None -> true
+    | Some d -> not @@ Abbreviation.enabled d
 
 let availability_of_notation (ntn_scope,ntn) scopes =
   find_without_delimiters (has_active_parsing_rule_in_scope ntn) (ntn_scope,Some ntn) (make_current_scopes scopes)
diff --git a/interp/notation.mli b/interp/notation.mli
index af6309b13082..1c83f61e3fe6 100644
--- a/interp/notation.mli
+++ b/interp/notation.mli
@@ -108,10 +108,10 @@ val enable_prim_token_interpretation : prim_token_infos -> unit
    given scope context*)
 
 val interp_prim_token : ?loc:Loc.t -> prim_token -> subscopes ->
-  glob_constr * scope_name option
+  glob_constr
 (* This function returns a glob_const representing a pattern *)
 val interp_prim_token_cases_pattern_expr : ?loc:Loc.t -> (Glob_term.glob_constr -> unit) -> prim_token ->
-  subscopes -> glob_constr * scope_name option
+  subscopes -> glob_constr
 
 (** Return the primitive token associated to a [term]/[cases_pattern];
    raise [No_match] if no such token *)
diff --git a/interp/notation_ops.ml b/interp/notation_ops.ml
index c5a282a68325..9040196fe1b3 100644
--- a/interp/notation_ops.ml
+++ b/interp/notation_ops.ml
@@ -88,7 +88,7 @@ let compare_glob_universe_instances lt strictly_lt us1 us2 =
   | None, Some _ -> false
   | Some (ql1,ul1), Some (ql2,ul2) ->
     let is_anon = function
-      | GQualVar (GLocalQVar {v=Anonymous}) -> true
+      | GLocalQVar {v=Anonymous} -> true
       | _ -> false
     in
     CList.for_all2eq (fun q1 q2 ->
@@ -923,7 +923,7 @@ let rec subst_notation_constr subst bound raw =
     else NHole nknd
 
   | NGenarg arg ->
-    let arg' = Gensubst.generic_substitute subst arg in
+    let arg' = Gensubst.constr_subst subst arg in
     if arg' == arg then raw
     else NGenarg arg'
 
diff --git a/interp/notation_term.mli b/interp/notation_term.mli
index abb6c5a66b17..c7af11993011 100644
--- a/interp/notation_term.mli
+++ b/interp/notation_term.mli
@@ -16,8 +16,7 @@ open Glob_term
 (** [notation_constr] is the subtype of [glob_constr] allowed in syntactic
     extensions (i.e. notations).
     No location since intended to be substituted at any place of a text.
-    Complex expressions such as fixpoints and cofixpoints are excluded,
-    as well as non global expressions such as existential variables. *)
+    Non global expressions such as existential variables are not allowed. *)
 
 type notation_constr =
   (* Part common to [glob_constr] and [cases_pattern] *)
@@ -26,7 +25,7 @@ type notation_constr =
   | NApp of notation_constr * notation_constr list
   | NProj of (Constant.t * glob_instance option) * notation_constr list * notation_constr
   | NHole of glob_evar_kind
-  | NGenarg of Genarg.glob_generic_argument
+  | NGenarg of GenConstr.glb
   | NList of Id.t * Id.t * notation_constr * notation_constr * (* associativity: *) bool
   (* Part only in [glob_constr] *)
   | NLambda of Name.t * notation_constr option * notation_constr
diff --git a/interp/numTok.ml b/interp/numTok.ml
index 72fa7cfc97f2..a13740789632 100644
--- a/interp/numTok.ml
+++ b/interp/numTok.ml
@@ -113,6 +113,13 @@ struct
   let equal n1 n2 =
     String.(equal n1.int n2.int && equal n1.frac n2.frac && equal n1.exp n2.exp)
 
+  let compare n1 n2 =
+    let c = String.compare n1.int n2.int in
+    if c <> 0 then c
+    else let c = String.compare n1.frac n2.frac in
+      if c <> 0 then c
+      else String.compare n1.exp n2.exp
+
   let parse =
     let buff = ref (Bytes.create 80) in
     let store len x =
diff --git a/interp/numTok.mli b/interp/numTok.mli
index e46db6efd351..b5c95ae2cc3f 100644
--- a/interp/numTok.mli
+++ b/interp/numTok.mli
@@ -75,6 +75,7 @@ module Unsigned :
 sig
   type t
   val equal : t -> t -> bool
+  val compare : t -> t -> int
   val is_nat : t -> bool
   val to_nat : t -> string option
 
diff --git a/interp/primNotations.ml b/interp/primNotations.ml
index 4fc27fad0f95..8fca253d0cee 100644
--- a/interp/primNotations.ml
+++ b/interp/primNotations.ml
@@ -436,7 +436,10 @@ let rec glob_of_token token_kind ?loc env sigma c = match TokenValue.kind c with
   | TSort Sorts.SProp -> DAst.make ?loc (Glob_term.GSort Glob_ops.glob_SProp_sort)
   | TSort Sorts.Prop -> DAst.make ?loc (Glob_term.GSort Glob_ops.glob_Prop_sort)
   | TSort Sorts.Set -> DAst.make ?loc (Glob_term.GSort Glob_ops.glob_Set_sort)
-  | TSort (Sorts.Type _ | Sorts.QSort _) -> DAst.make ?loc (Glob_term.GSort Glob_ops.glob_Type_sort)
+  | TSort (Sorts.Type _ | Sorts.VSort _) -> DAst.make ?loc (Glob_term.GSort Glob_ops.glob_Type_sort)
+  | TSort (Sorts.GSort (q, _)) ->
+    let q = GQuality (QGlobal q) in
+    DAst.make ?loc (Glob_term.GSort (Some q, Glob_ops.glob_rigid_univ))
   | TOther ->
     let c = TokenValue.repr c in
     Loc.raise ?loc (PrimTokenNotationError(token_kind,env,sigma,UnexpectedTerm c))
diff --git a/kernel/byterun/dune b/kernel/byterun/dune
index a152f1fe5a05..df58ea63074b 100644
--- a/kernel/byterun/dune
+++ b/kernel/byterun/dune
@@ -7,10 +7,6 @@
   (names rocq_fix_code rocq_float64 rocq_memory rocq_values rocq_interp)
   (flags :standard (:include %{project_root}/config/dune.c_flags))))
 
-(deprecated_library_name
- (old_public_name coq-core.vm)
- (new_public_name rocq-runtime.vm))
-
 (rule
  (targets rocq_instruct.h)
  (action (with-stdout-to %{targets} (run ../genOpcodeFiles.exe enum))))
diff --git a/kernel/byterun/rocq_values.c b/kernel/byterun/rocq_values.c
index 01972d974c47..ccc9d1920b50 100644
--- a/kernel/byterun/rocq_values.c
+++ b/kernel/byterun/rocq_values.c
@@ -10,6 +10,7 @@
 
 #include 
 #include 
+#include 
 #include 
 #include "rocq_fix_code.h"
 #include "rocq_instruct.h"
@@ -107,13 +108,60 @@ value rocq_tcode_array(value tcodes) {
   CAMLreturn(res);
 }
 
-CAMLprim value rocq_obj_set_tag (value arg, value new_tag)
-{
-#if OCAML_VERSION >= 50000
-// Placeholder used by native_compute
+/* The rocq_curry2_1 function returns a pointer to some code that
+   immediately branches to caml_curry2_1. It can be used as field 0 of
+   an OCaml closure, as long as field 3 contains a closure whose code
+   pointer accepts exactly two arguments (the first argument is stored
+   in field 2).
+
+   Since the word before the branch indicates to the garbage collector
+   that this block should be ignored, the code pointer can be used
+   inside blocks that do not have tag 247. This 2043 value is the
+   result of Caml_out_of_heap_header(2, Abstract_tag).
+
+   Keep the compile-time checks in sync with rocq_configure.c */
+
+#ifdef NO_NATIVE_COMPUTE
+
+value rocq_curry2_1_addr(value v) {
+  return Val_unit;
+}
+
+#elif defined(NO_NAKED_POINTERS)
+
+__attribute__((weak))
+void caml_curry2_1() {
   abort();
+}
+
+#if defined(__GNUC__) && defined(__amd64__)
+
+asm(".align 8\n\t"
+    ".quad 2043\n"
+    "rocq_curry2_1:\n\t"
+    "jmp caml_curry2_1\n");
+
+#elif defined(__GNUC__) && defined(__i386__)
+
+asm(".align 4\n\t"
+    ".long 2043\n"
+    "rocq_curry2_1:\n\t"
+    "jmp caml_curry2_1\n");
+
 #else
-  Tag_val (arg) = Int_val (new_tag);
+#error "Unsupported architecture for native_compute."
 #endif
-  return Val_unit;
+
+value rocq_curry2_1_addr(value v) {
+  extern void rocq_curry2_1();
+  return (value)&rocq_curry2_1;
 }
+
+#else // not NO_NAKED_POINTERS
+
+value rocq_curry2_1_addr(value v) {
+  extern void caml_curry2_1() __attribute__((weak));
+  return (value)&caml_curry2_1;
+}
+
+#endif
diff --git a/kernel/cClosure.ml b/kernel/cClosure.ml
index 5efb27ac6dd4..8d7296b2e8c1 100644
--- a/kernel/cClosure.ml
+++ b/kernel/cClosure.ml
@@ -137,7 +137,7 @@ let default_evar_handler env = {
   evar_repack = (fun _ -> assert false);
   evar_irrelevant = (fun _ -> assert false);
   qvar_irrelevant = (fun q ->
-      assert (Sorts.QVar.Set.mem q (Environ.qvars env));
+      assert (QGraph.mem (QVar q) (Environ.qualities env));
       false);
   qual_equal = Sorts.Quality.equal;
   abstr_const = fun _ -> assert false;
@@ -148,11 +148,10 @@ let drop_opaque = function
 | Def _ | Undef _ | Primitive _ | Symbol _ as body -> body
 
 let drop_code env = function
-| None -> Vmemitcodes.BCconstant
-| Some (Vmemitcodes.BCdefined (mask, idx, patch)) ->
+| Vmemitcodes.BCdefined (mask, idx, patch) ->
   let code () = Environ.lookup_vm_code idx env in
   Vmemitcodes.BCdefined (mask, code, patch)
-| Some (BCalias _ | BCconstant as code) -> code
+| (BCalias _ | BCconstant | BCuncompiled as code) -> code
 
 let lookup_constant_handler env sigma cst = match lookup_constant_opt cst env with
 | None -> sigma.abstr_const cst
@@ -399,11 +398,7 @@ end = struct
       let env = info.i_cache.i_env in
       match ref with
       | RelKey n ->
-        let i = n - 1 in
-        let d =
-          try Range.get (Environ.rel_context_val env).env_rel_map i
-          with Invalid_argument _ -> raise Not_found
-        in
+        let d = Environ.lookup_rel n env in
         shortcut_irrelevant info (RelDecl.get_relevance d);
         let body =
           match d with
@@ -430,7 +425,7 @@ end = struct
         if TransparentState.is_transparent_constant ts cst then match cb.const_body with
         | Undef _ | Def _ | OpaqueDef _ | Primitive _ ->
           let mask = match cb.const_body_code with
-          | (Vmemitcodes.BCalias _ | Vmemitcodes.BCconstant) -> [||]
+          | (Vmemitcodes.BCalias _ | Vmemitcodes.BCconstant | BCuncompiled) -> [||]
           | (Vmemitcodes.BCdefined (mask, _, _)) -> mask
           in
           Def (constant_value_in u cb.const_body, mask)
@@ -577,7 +572,7 @@ let rec to_constr lfts v =
         Term.compose_lam (List.rev tys) f
     | FProd (n, t, c, e) ->
       if is_subs_id (fst e) && is_lift_id lfts then
-        mkProd (n, to_constr lfts t, subst_instance_constr (snd e) c)
+        mkProd (usubst_binder e n, to_constr lfts t, subst_instance_constr (snd e) c)
       else
         let subs' = comp_subs lfts e in
         mkProd (usubst_binder subs' n,
@@ -874,16 +869,14 @@ let check_native_args op stk =
   nargs <= rargs
 
 
-let try_drop_parameters n m = match[@warning "-4"] m.term with
-  | FConstruct (_, args) ->
-    let q = Array.length args in
-    if n > q then raise Not_found
-    else if q = 0 then [||]
-    else Array.sub args n (q - n)
-  | _ -> assert false
+let try_drop_parameters n args =
+  let q = Array.length args in
+  if n > q then raise Not_found
+  else if q = 0 then [||]
+  else Array.sub args n (q - n)
 
-let drop_parameters n m =
-  try try_drop_parameters n m
+let drop_parameters n args =
+  try try_drop_parameters n args
   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.")
@@ -900,14 +893,24 @@ let inductive_subst mib u pms =
   in
   mk_pms (Array.length pms - 1) mib.mind_params_ctxt, u
 
-(* Iota-reduction: feed the arguments of the constructor to the branch *)
-let get_branch infos ci pms cterm br e =
-  let ((ind, c), u) = match[@warning "-4"] cterm.term with
-    | FConstruct (c, _) -> c
-    | _ -> assert false
+let args_subst ind_subst ctx args e =
+  let rec aux args_subst ind_subst i = function
+    | [] ->
+      assert (Int.equal (Array.length args) i);
+      args_subst
+    | RelDecl.LocalAssum _ :: ctx ->
+      let c = args.(i) in
+      aux (usubs_cons c args_subst) (usubs_cons c ind_subst) (succ i) ctx
+    | RelDecl.LocalDef (_, b, _) :: ctx ->
+      let c = mk_clos ind_subst b in
+      aux (usubs_cons c args_subst) (usubs_cons c ind_subst) i ctx
   in
+  aux e ind_subst 0 (List.rev ctx)
+
+(* Iota-reduction: feed the arguments of the constructor to the branch *)
+let get_branch infos ci pms ((ind, c), u) args br e =
   let i = c - 1 in
-  let args = drop_parameters ci.ci_npar cterm in
+  let args = drop_parameters ci.ci_npar args in
   let (_nas, br) = br.(i) in
   if Int.equal ci.ci_cstr_ndecls.(i) ci.ci_cstr_nargs.(i) then
     (* No let-bindings in the constructor, we don't have to fetch the
@@ -923,49 +926,34 @@ let get_branch infos ci pms cterm br e =
     let (ctx, _) = mip.mind_nf_lc.(i) in
     let ctx, _ = List.chop mip.mind_consnrealdecls.(i) ctx in
     let ind_subst = inductive_subst mib u (Array.map (mk_clos e) pms) in
-    let rec push i e = function
-    | [] -> []
-    | RelDecl.LocalAssum _ :: ctx ->
-      let ans = push (pred i) e ctx in
-      args.(i) :: ans
-    | RelDecl.LocalDef (_, b, _) :: ctx ->
-      let ans = push i e ctx in
-      let b = subst_instance_constr u b in
-      let s = Array.rev_of_list ans in
-      let e = usubs_consv s ind_subst in
-      let v = mk_clos e b in
-      v :: ans
-    in
-    let ext = push (Array.length args - 1) [] ctx in
-    (br, usubs_consv (Array.rev_of_list ext) e)
+    let e = args_subst ind_subst ctx args e in
+    (br, e)
 
-(** [eta_expand_ind_stack env ind c s t] computes stacks corresponding
+(** [eta_expand_ind_stack env ind args t] computes stacks corresponding
     to the conversion of the eta expansion of t, considered as an inhabitant
-    of ind, and the Constructor c of this inductive type applied to arguments
-    s.
-    @assumes [t] is an irreducible term, and not a constructor. [ind] is the inductive
-    of the constructor term [c]
+    of ind, and the constructor of this inductive type applied to arguments args.
+    @assumes [t] is a rigid term, and not a constructor;
+    that [args] are valid arguments for the constructor of inductive [ind].
     @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,u) m (f, s') =
+let eta_expand_ind_stack env (ind,u) args m' =
   let open Declarations in
   let mib = lookup_mind (fst ind) env in
-  (* disallow eta-exp for non-primitive records *)
-  if not (mib.mind_finite == BiFinite) then raise Not_found;
+  let specif = mib, mib.mind_packets.(snd ind) in
+  (* disallow eta-exp for non-primitive records, also check postponed eta *)
+  let () = if not (Declareops.is_record_with_eta specif u) then
+    raise Not_found
+  in
   match Declareops.inductive_make_projections ind mib with
-  | Some (projs, has_eta) ->
-    let () =
-      match has_eta with
-      | NoEta -> raise Not_found
-      | AlwaysEta -> ()
-    in
-    (* (Construct, pars1 .. parsm :: arg1...argn :: []) ~= (f, s') ->
-           arg1..argn ~= (proj1 t...projn t) where t = zip (f,s') *)
+  | None -> assert false
+  | Some projs ->
+    (* (Construct, pars1 .. parsm :: arg1...argn :: []) ~= m' ->
+           arg1..argn ~= (proj1 t...projn t) where t = zip m' *)
     let pars = mib.Declarations.mind_nparams in
-    let right = fapp_stack (f, s') in
+    let right = fapp_stack m' in
     (** Try to drop the params, might fail on partially applied constructors. *)
-    let argss = try_drop_parameters pars m in
+    let argss = try_drop_parameters pars args in
     let () = if not @@ Int.equal (Array.length projs) (Array.length argss)
       then raise Not_found (* partially applied constructor (missing non-param arguments) *)
     in
@@ -975,7 +963,6 @@ let eta_expand_ind_stack env (ind,u) m (f, s') =
         projs
     in
     [Zapp argss], [Zapp hstack]
-  | None -> raise Not_found (* disallow eta-exp for non-primitive records *)
 
 (* Iota reduction: expansion of a fixpoint.
  * Given a fixpoint and a substitution, returns the corresponding
@@ -1450,6 +1437,7 @@ and knht info e t stk =
           { mark = Ntrl; term = FEvar (evk, args, e, repack) }, stk
       end
     | Array(u,t,def,ty) ->
+      let u = usubst_instance e u in
       let len = Array.length t in
       let ty = mk_clos e ty in
       let t = Parray.init (Uint63.of_int len) (fun i -> mk_clos e t.(i)) (mk_clos e def) in
@@ -1475,29 +1463,27 @@ type (_, _) escape =
 module RedPattern :
 sig
 
-type ('constr, 'stack, 'context) resume_state
+type resume_state
 
-type ('constr, 'stack, 'context, _) depth =
-  | Nil: ('constr * 'stack, 'ret) escape -> ('constr, 'stack, 'context, 'ret) depth
-  | Cons: ('constr, 'stack, 'context) resume_state * ('constr, 'stack, 'context, 'ret) depth -> ('constr, 'stack, 'context, 'ret) depth
+type _ depth =
+  | Nil: (fconstr * stack, 'ret) escape -> 'ret depth
+  | Cons: resume_state * 'ret depth -> 'ret depth
 
-type 'a patstate = (fconstr, stack, rel_context, 'a) depth
+val match_symbol : ('a, 'a depth) reduction -> clos_infos -> Table.t ->
+  pat_state:'a depth -> table_key -> UVars.Instance.t * bool * machine_rewrite_rule list -> stack -> 'a
 
-val match_symbol : ('a, 'a patstate) reduction -> clos_infos -> Table.t ->
-  pat_state:(fconstr, stack, rel_context, 'a) depth -> table_key -> UVars.Instance.t * bool * machine_rewrite_rule list -> stack -> 'a
-
-val match_head : ('a, 'a patstate) reduction -> clos_infos -> Table.t ->
-  pat_state:(fconstr, stack, rel_context, 'a) depth -> (fconstr, stack, rel_context) resume_state -> fconstr -> stack -> 'a
+val match_head : ('a, 'a depth) reduction -> clos_infos -> Table.t ->
+  pat_state:'a depth -> resume_state -> fconstr -> stack -> 'a
 
 end =
 struct
 
-type 'constr partial_subst = {
-  subst: ('constr, Sorts.Quality.t, Univ.Level.t) Partial_subst.t;
+type partial_subst = {
+  subst: (fconstr, Sorts.Quality.t, Univ.Level.t) Partial_subst.t;
   rhs: constr;
 }
 
-type 'constr subst_status = Dead | Live of 'constr partial_subst
+type subst_status = Dead | Live of partial_subst
 
 type 'a status =
   | Check of 'a
@@ -1516,20 +1502,33 @@ type ('a, 'b) next =
   | Continue of 'a
   | Return of 'b
 
-type ('constr, 'stack, 'context) state =
-  | LocStart of { elims: pattern_elimination list status array; context: 'context; head: 'constr; stack: 'stack; next: ('constr, 'stack, 'context) state_next }
-  | LocArg of { patterns: pattern_argument status array; context: 'context; arg: 'constr; next: ('constr, 'stack, 'context) state }
-
-and ('constr, 'stack, 'context) state_next = (('constr, 'stack, 'context) state, bool * 'constr * 'stack) next
-
-type ('constr, 'stack, 'context) resume_state =
-  { states: 'constr subst_status array; context: 'context; patterns: head_elimination status array; next: ('constr, 'stack, 'context) state }
-
-type ('constr, 'stack, 'context, _) depth =
-  | Nil: ('constr * 'stack, 'ret) escape -> ('constr, 'stack, 'context, 'ret) depth
-  | Cons: ('constr, 'stack, 'context) resume_state * ('constr, 'stack, 'context, 'ret) depth -> ('constr, 'stack, 'context, 'ret) depth
+type state =
+  | LocStart of {
+      elims: pattern_elimination list status array;
+      context: rel_context;
+      head: fconstr;
+      stack: stack;
+      next: state_next;
+    }
+  | LocArg of {
+      patterns: pattern_argument status array;
+      context: rel_context;
+      arg: fconstr;
+      next: state;
+    }
+
+and state_next = (state, bool * fconstr * stack) next
+
+type resume_state = {
+  states: subst_status array;
+  context: rel_context;
+  patterns: head_elimination status array;
+  next: state;
+}
 
-type 'a patstate = (fconstr, stack, rel_context, 'a) depth
+type _ depth =
+  | Nil: (fconstr * stack, 'ret) escape -> 'ret depth
+  | Cons: resume_state * 'ret depth -> 'ret depth
 
 let extract_or_kill filter a status =
   let step elim status =
@@ -1575,7 +1574,7 @@ let extract_or_kill4 filter a status =
   in
   Array.split4 @@ Array.map2 step a status
 
-let rec match_main : type a. (a, a patstate) reduction -> _ -> _ -> pat_state:(fconstr, stack, _, a) depth -> _ -> _ -> a =
+let rec match_main : type a. (a, a depth) reduction -> _ -> _ -> pat_state:a depth -> _ -> _ -> a =
   fun red info tab ~pat_state states loc ->
   if Array.for_all (function Dead -> true | Live _ -> false) states then match_kill red info tab ~pat_state loc else
   match [@ocaml.warning "-4"] loc with
@@ -1597,7 +1596,7 @@ let rec match_main : type a. (a, a patstate) reduction -> _ -> _ -> pat_state:(f
   | LocStart { elims; context; head; stack; next } ->
       match_elim red info tab ~pat_state next context states elims head stack
 
-and match_kill : 'a. ('a, 'a patstate) reduction -> _ -> _ -> pat_state:(fconstr, stack, _, 'a) depth -> _ -> 'a =
+and match_kill : 'a. ('a, 'a depth) reduction -> _ -> _ -> pat_state:'a depth -> _ -> 'a =
   fun red info tab ~pat_state -> function
   | LocArg { next; _ } -> match_kill red info tab ~pat_state next
   | LocStart { head; stack; next; _ } ->
@@ -1606,16 +1605,14 @@ and match_kill : 'a. ('a, 'a patstate) reduction -> _ -> _ -> pat_state:(fconstr
       | Continue next -> match_kill red info tab ~pat_state next
       | Return k -> try_unfoldfix red info tab ~pat_state k
 
-and match_endstack : 'a. ('a, 'a patstate) reduction -> _ -> _ -> pat_state:(_, _, _, 'a) depth -> _ -> _ -> 'a =
-  fun red info tab ~pat_state states next ->
+and match_endstack red info tab ~pat_state states next =
   match next with
   | Continue next -> match_main red info tab ~pat_state states next
   | Return k ->
       assert (Array.for_all (function Dead -> true | Live _ -> false) states);
       try_unfoldfix red info tab ~pat_state k
 
-and try_unfoldfix : 'a. ('a, 'a patstate) reduction -> _ -> _ -> pat_state:(_, _, _, 'a) depth -> _ -> 'a =
-  fun red info tab ~pat_state (b, m, stk) ->
+and try_unfoldfix red info tab ~pat_state (b, m, stk) =
   if not b then red.red_ret info tab ~pat_state ~failed:true (m, stk) else
   let rarg, stack = strip_update_shift_absorb_app m stk in
   match [@ocaml.warning "-4"] stack with
@@ -1625,7 +1622,7 @@ and try_unfoldfix : 'a. ('a, 'a patstate) reduction -> _ -> _ -> pat_state:(_, _
     red.red_knit info tab ~pat_state fxe fxbd stk'
   | _ -> red.red_ret info tab ~pat_state ~failed:true (m, stk)
 
-and match_elim : 'a. ('a, 'a patstate) reduction -> _ -> _ -> pat_state:(fconstr, stack, _, 'a) depth -> _ -> _ -> _ -> _ -> _ -> _ -> 'a =
+and match_elim : 'a. ('a, 'a depth) reduction -> _ -> _ -> pat_state:'a depth -> _ -> _ -> _ -> _ -> _ -> _ -> 'a =
   fun red info tab ~pat_state next context states elims head stk ->
   match stk with
   | Zapp args :: s ->
@@ -1660,7 +1657,7 @@ and match_elim : 'a. ('a, 'a patstate) reduction -> _ -> _ -> pat_state:(fconstr
       let ntys_brs = Environ.expand_branch_contexts specif u pms brs in
       let prets, pbrss, elims, states = extract_or_kill4 (function [@ocaml.warning "-4"]
       | PECase (pind, pret, pbrs) :: es, subst ->
-        if not @@ Ind.CanOrd.equal pind ci.ci_ind then None else
+        if not @@ QInd.equal (info_env info) pind ci.ci_ind then None else
           Some (pret, pbrs, es, subst)
       | _ -> None)
           elims states
@@ -1677,7 +1674,7 @@ and match_elim : 'a. ('a, 'a patstate) reduction -> _ -> _ -> pat_state:(fconstr
       let head = {mark; term=FProj(Projection.make proj' true, r, head)} in
       let elims, states = extract_or_kill2 (function [@ocaml.warning "-4"]
       | PEProj proj :: es, subst ->
-        if not @@ Projection.Repr.CanOrd.equal proj proj' then None else
+        if not @@ QProjection.Repr.equal (info_env info) proj proj' then None else
         Some (es, subst)
       | _ -> None) elims states
       in
@@ -1691,7 +1688,7 @@ and match_elim : 'a. ('a, 'a patstate) reduction -> _ -> _ -> pat_state:(fconstr
       let states = extract_or_kill (function [], subst -> Some subst | _ -> None) elims states in
       match_endstack red info tab ~pat_state states next
 
-and match_arg : 'a. ('a, 'a patstate) reduction -> _ -> _ -> pat_state:(fconstr, stack, _, 'a) depth -> _ -> _ -> _ -> _ -> _ -> 'a =
+and match_arg : 'a. ('a, 'a depth) reduction -> _ -> _ -> pat_state:'a depth -> _ -> _ -> _ -> _ -> _ -> 'a =
   fun red info tab ~pat_state next context states patterns t ->
   let match_deeper = ref false in
   let t' = it_mkLambda_or_LetIn info context t in
@@ -1708,13 +1705,12 @@ and match_arg : 'a. ('a, 'a patstate) reduction -> _ -> _ -> pat_state:(fconstr,
   else
     match_main red info tab ~pat_state states next
 
-and match_head : 'a. ('a, 'a patstate) reduction -> _ -> _ -> pat_state:(fconstr, stack, _, 'a) depth -> _ -> _ -> _ -> _ -> _ -> _ -> 'a =
-  fun red info tab ~pat_state next context states patterns t stk ->
+and match_head red info tab ~pat_state next context states patterns t stk =
   match [@ocaml.warning "-4"] t.term with
   | FInd (ind', u) ->
     let elims, states = extract_or_kill2 (function [@ocaml.warning "-4"]
     | (PHInd (ind, pu), elims), psubst ->
-      if not @@ Ind.CanOrd.equal ind ind' then None else
+      if not @@ QInd.equal (info_env info) ind ind' then None else
       let subst = UVars.Instance.pattern_match pu u psubst.subst in
       Option.map (fun subst -> elims, { psubst with subst }) subst
     | _ -> None) patterns states
@@ -1724,7 +1720,7 @@ and match_head : 'a. ('a, 'a patstate) reduction -> _ -> _ -> pat_state:(fconstr
   | FConstruct ((constr', u), args) ->
     let elims, states = extract_or_kill2 (function [@ocaml.warning "-4"]
     | (PHConstr (constr, pu), elims), psubst ->
-      if not @@ Construct.CanOrd.equal constr constr' then None else
+      if not @@ QConstruct.equal (info_env info) constr constr' then None else
       let subst = UVars.Instance.pattern_match pu u psubst.subst in
       Option.map (fun subst -> elims, { psubst with subst }) subst
     | _ -> None) patterns states
@@ -1750,7 +1746,7 @@ and match_head : 'a. ('a, 'a patstate) reduction -> _ -> _ -> pat_state:(fconstr
   | FFlex (ConstKey (c', u)) ->
     let elims, states = extract_or_kill2 (function [@ocaml.warning "-4"]
     | (PHSymbol (c, pu), elims), psubst ->
-      if not @@ Constant.CanOrd.equal c c' then None else
+      if not @@ QConstant.equal (info_env info) c c' then None else
       let subst = UVars.Instance.pattern_match pu u psubst.subst in
       Option.map (fun subst -> elims, { psubst with subst }) subst
     | _ -> None) patterns states
@@ -1864,11 +1860,10 @@ let match_head red info tab ~pat_state { states; context; patterns; next } m stk
 
 end
 
-type 'a depth = 'a RedPattern.patstate
+type 'a depth = 'a RedPattern.depth
 
 (* Computes a weak head normal form from the result of knh. *)
-let rec knr : 'a. _ -> _ -> pat_state: 'a depth -> _ -> _ -> 'a =
-  fun info tab ~pat_state m stk ->
+let rec knr info tab ~pat_state 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
@@ -1886,41 +1881,31 @@ let rec knr : 'a. _ -> _ -> pat_state: 'a depth -> _ -> _ -> 'a =
             (* Similarly to fix, partially applied primitives are not Ntrl! *)
             knr_ret info tab ~pat_state (m, stk)
         | Symbol (u, b, r) ->
-          let red = {
-            red_kni = kni;
-            red_knit = knit;
-            red_ret = knr_ret;
-          } in
-          RedPattern.match_symbol red info tab ~pat_state fl (u, b, r) stk
+          RedPattern.match_symbol knred info tab ~pat_state fl (u, b, r) stk
         | Undef _ | OpaqueDef _ -> (set_ntrl m; knr_ret info tab ~pat_state (m,stk)))
-  | FConstruct (c,_) ->
-     let use_match = red_set info.i_flags fMATCH in
-     let use_fix = red_set info.i_flags fFIX in
-     if use_match || use_fix then
-      (match [@ocaml.warning "-4"] m,  stk with
-        | (_, Zapp _ :: _) -> assert false (* knh *)
-        | (c, ZcaseT(ci,_,pms,_,br,e)::s) when use_match ->
-            assert (ci.ci_npar>=0);
-            (* instance on the case and instance on the constructor are compatible by typing *)
-            let (br, e) = get_branch info ci pms c br e in
-            knit info tab ~pat_state e br s
-        | (rarg, Zfix(fx,par)::s) when use_fix ->
-            let stk' = par @ append_stack [|rarg|] s in
-            let (fxe,fxbd) = contract_fix_vect fx.term in
-            knit info tab ~pat_state fxe fxbd stk'
-        | (m, Zproj (p,_)::s) when use_match ->
-            let rargs = drop_parameters (Projection.Repr.npars p) m in
-            let rarg = rargs.(Projection.Repr.arg p) in
-            kni info tab ~pat_state rarg s
-        | (m, s) ->
-          if is_irrelevant_constructor info c then
-            knr_ret info tab ~pat_state (mk_irrelevant, skip_irrelevant_stack info stk)
-          else
-            knr_ret info tab ~pat_state (m,s))
-     else if is_irrelevant_constructor info c then
-      knr_ret info tab ~pat_state (mk_irrelevant, skip_irrelevant_stack info stk)
-     else
-      knr_ret info tab ~pat_state (m, stk)
+  | FConstruct (c, args) ->
+    let use_match = red_set info.i_flags fMATCH in
+    let use_fix = red_set info.i_flags fFIX in
+    begin match [@ocaml.warning "-4"] stk with
+    | Zapp _ :: _ -> assert false (* knh *)
+    | ZcaseT (ci, _, pms, _, br, e) :: s when use_match ->
+      (* instance on the case and instance on the constructor are compatible by typing *)
+      let (br, e) = get_branch info ci pms c args br e in
+      knit info tab ~pat_state e br s
+    | Zfix (fx, par) :: s when use_fix ->
+      let stk' = par @ append_stack [|m|] s in
+      let (fxe, fxbd) = contract_fix_vect fx.term in
+      knit info tab ~pat_state fxe fxbd stk'
+    | Zproj (p, _) :: s when use_match ->
+      let rargs = drop_parameters (Projection.Repr.npars p) args in
+      let rarg = rargs.(Projection.Repr.arg p) in
+      kni info tab ~pat_state rarg s
+    | _ ->
+      if is_irrelevant_constructor info c then
+        knr_ret info tab ~pat_state (mk_irrelevant, skip_irrelevant_stack info stk)
+      else
+        knr_ret info tab ~pat_state (m, stk)
+    end
   | FCoFix ((i, (lna, _, _)), e) ->
     if is_irrelevant info (usubst_relevance e (lna.(i)).binder_relevance) then
       knr_ret info tab ~pat_state (mk_irrelevant, skip_irrelevant_stack info stk)
@@ -1981,22 +1966,15 @@ and knr_ret : type a. _ -> _ -> pat_state: a depth -> ?failed: _ -> _ -> a =
   match pat_state with
   | RedPattern.Cons (patt, pat_state) ->
       let m, stk = i in
-      let red = {
-        red_kni = kni;
-        red_knit = knit;
-        red_ret = knr_ret;
-      } in
-      RedPattern.match_head red info tab ~pat_state patt m stk
+      RedPattern.match_head knred info tab ~pat_state patt m stk
   | RedPattern.Nil b ->
       match b with No -> i | Yes -> if failed then None else Some i
 
 (* Computes the weak head normal form of a term *)
-and kni : 'a. _ -> _ -> pat_state: 'a depth -> _ -> _ -> 'a =
-  fun info tab ~pat_state m stk ->
+and kni info tab ~pat_state m stk =
   let (hm,s) = knh info m stk in
   knr info tab ~pat_state hm s
-and knit : 'a. _ -> _ -> pat_state: 'a depth -> _ -> _ -> _ -> 'a =
-  fun info tab ~pat_state e t stk ->
+and knit info tab ~pat_state e t stk =
   let (ht,s) = knht info e t stk in
   knr info tab ~pat_state ht s
 
@@ -2026,7 +2004,7 @@ and case_inversion info tab ci u params indices v = match v with
     then Some v else None
 | _ -> assert false
 
-let knred = {
+and knred : 'a. ('a, 'a RedPattern.depth) reduction = {
   red_kni = kni;
   red_knit = knit;
   red_ret = knr_ret;
@@ -2066,21 +2044,29 @@ and klt info tab e t = match kind t with
   | Inr (k, Some p) -> kl info tab @@ lift_fconstr (k-p) {mark=Red;term=FFlex(RelKey p)}
   end
 | App (hd, args) ->
-  begin match kind hd with
-  | Ind _ | Construct _ ->
+  let is_stuck = match kind hd with
+  | Ind _ | Construct _ -> true
+  | CoFix _ | Lambda _ | Fix _ | Prod _ | Evar _ | Case _
+  | Cast _ | LetIn _ | Proj _ | Array _ | Rel _ | Meta _ | Sort _ | Int _
+  | Float _ | String _ -> false
+  | Const (cst, _) ->
+    let ts = RedFlags.red_transparent info.i_flags in
+    not @@ TransparentState.is_transparent_constant ts cst
+  | Var id ->
+    let ts = RedFlags.red_transparent info.i_flags in
+    not @@ TransparentState.is_transparent_variable ts id
+  | App _ -> assert false
+  in
+  if is_stuck then
     let args' = Array.Smart.map (fun c -> klt info tab e c) args in
     let hd' = subst_instance_constr (snd e) hd in
     if hd' == hd && args' == args then t
     else mkApp (hd', args')
-  | Var _ | Const _ | CoFix _ | Lambda _ | Fix _ | Prod _ | Evar _ | Case _
-  | Cast _ | LetIn _ | Proj _ | Array _ | Rel _ | Meta _ | Sort _ | Int _
-  | Float _ | String _ ->
+  else
     let share = info.i_cache.i_share in
     let (nm,s) = knit info tab e t [] in
     let () = if share then ignore (fapp_stack (nm, s)) in (* to unlock Zupdates! *)
     zip_term info tab (norm_head info tab nm) s
-  | App _ -> assert false
-  end
 | Lambda (na, u, c) ->
   let na' = usubst_binder e na in
   let u' = klt info tab e u in
diff --git a/kernel/cClosure.mli b/kernel/cClosure.mli
index cc31068e6948..8f7c9f90ff3a 100644
--- a/kernel/cClosure.mli
+++ b/kernel/cClosure.mli
@@ -181,15 +181,15 @@ val skip_irrelevant_stack : clos_infos -> stack -> stack
 
 val eta_expand_stack : clos_infos -> Name.t binder_annot -> stack -> stack
 
-(** [eta_expand_ind_stack env ind c t] computes stacks corresponding
-    to the conversion of the eta expansion of [t], considered as an inhabitant
-    of [ind], and the Constructor [c] of this inductive type containing its arguments.
-    Assumes [t] is a rigid term, and not a constructor. [ind] is the inductive
-    of the constructor term [c].
+(** [eta_expand_ind_stack env ind args t] computes stacks corresponding
+    to the conversion of the eta expansion of t, considered as an inhabitant
+    of ind, and the constructor of this inductive type applied to arguments args.
+    @assumes [t] is a rigid term, and not a constructor;
+    that [args] are valid arguments for the constructor of inductive [ind].
     @raise Not_found if the inductive is not a primitive record, or if the
     constructor is partially applied.
  *)
-val eta_expand_ind_stack : env -> pinductive -> fconstr ->
+val eta_expand_ind_stack : env -> pinductive -> fconstr array ->
    (fconstr * stack) -> stack * stack
 
 (** Conversion auxiliary functions to do step by step normalisation *)
diff --git a/kernel/constr.ml b/kernel/constr.ml
index 12b09455a688..e7051c6e4af6 100644
--- a/kernel/constr.ml
+++ b/kernel/constr.ml
@@ -37,7 +37,7 @@ type metavariable = int
 type cast_kind = VMcast | NATIVEcast | DEFAULTcast
 
 (* This defines Cases annotations *)
-type case_style = LetStyle | IfStyle | LetPatternStyle | MatchStyle | RegularStyle
+type case_style = LetStyle | IfStyle | LetPatternStyle | MatchStyle
 type case_printing =
   { style     : case_style }
 
@@ -186,7 +186,6 @@ let rec is_Type c = match kind c with
   | Cast (c,_,_) -> is_Type c
   | _ -> false
 
-let is_small = Sorts.is_small
 let iskind c = isprop c || is_Type c
 
 (* Tests if an evar *)
@@ -1013,81 +1012,6 @@ let leq_constr_univs univs m n =
 let rec eq_constr_nounivs m n =
   (m == n) || compare_head_gen (fun _ _ _ -> true) (fun _ _ -> true) (eq_existential eq_constr_nounivs) (fun _ -> eq_constr_nounivs) 0 m n
 
-let compare_invert f iv1 iv2 =
-  match iv1, iv2 with
-  | NoInvert, NoInvert -> 0
-  | NoInvert, CaseInvert _ -> -1
-  | CaseInvert _, NoInvert -> 1
-  | CaseInvert iv1, CaseInvert iv2 ->
-    Array.compare f iv1.indices iv2.indices
-
-let constr_ord_int f t1 t2 =
-  let open! Compare in
-  let fix_cmp (a1, i1) (a2, i2) =
-    compare [(Array.compare Int.compare,a1,a2); (Int.compare,i1,i2)]
-  in
-  let ctx_cmp f (_n1, p1) (_n2, p2) = f p1 p2 in
-  match kind t1, kind t2 with
-    | Cast (c1,_,_), _ -> f c1 t2
-    | _, Cast (c2,_,_) -> f t1 c2
-    (* Why this special case? *)
-    | App (c1,l1), _ when isCast c1 -> let c1 = pi1 (destCast c1) in f (mkApp (c1,l1)) t2
-    | _, App (c2,l2) when isCast c2 -> let c2 = pi1 (destCast c2) in f t1 (mkApp (c2,l2))
-    | Rel n1, Rel n2 -> Int.compare n1 n2
-    | 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) ->
-      compare [(Evar.compare, e1, e2); (SList.compare f, l1, l2)]
-    | Evar _, _ -> -1 | _, Evar _ -> 1
-    | Sort s1, Sort s2 -> Sorts.compare s1 s2
-    | Sort _, _ -> -1 | _, Sort _ -> 1
-    | Prod (_,t1,c1), Prod (_,t2,c2)
-    | Lambda (_,t1,c1), Lambda (_,t2,c2) -> compare [(f,t1,t2); (f,c1,c2)]
-    | Prod _, _ -> -1 | _, Prod _ -> 1
-    | Lambda _, _ -> -1 | _, Lambda _ -> 1
-    | LetIn (_,b1,t1,c1), LetIn (_,b2,t2,c2) -> compare [(f,b1,b2); (f,t1,t2); (f,c1,c2)]
-    | LetIn _, _ -> -1 | _, LetIn _ -> 1
-    | App (c1,l1), App (c2,l2) -> compare [(f,c1,c2); (Array.compare f, l1, l2)]
-    | 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.CanOrd.compare ind1 ind2
-    | Ind _, _ -> -1 | _, Ind _ -> 1
-    | Construct (ct1,_u1), Construct (ct2,_u2) -> Construct.CanOrd.compare ct1 ct2
-    | Construct _, _ -> -1 | _, Construct _ -> 1
-    | Case (_,_u1,pms1,(p1,_r1),iv1,c1,bl1), Case (_,_u2,pms2,(p2,_r2),iv2,c2,bl2) ->
-      compare [
-        (Array.compare f, pms1, pms2);
-        (ctx_cmp f, p1, p2);
-        (compare_invert f, iv1, iv2);
-        (f, c1, c2);
-        (Array.compare (ctx_cmp f), bl1, bl2);
-      ]
-    | Case _, _ -> -1 | _, Case _ -> 1
-    | Fix (ln1,(_,tl1,bl1)), Fix (ln2,(_,tl2,bl2)) ->
-      compare [(fix_cmp, ln1, ln2); (Array.compare f, tl1, tl2); (Array.compare f, bl1, bl2)]
-    | Fix _, _ -> -1 | _, Fix _ -> 1
-    | CoFix(ln1,(_,tl1,bl1)), CoFix(ln2,(_,tl2,bl2)) ->
-      compare [(Int.compare, ln1, ln2); (Array.compare f, tl1, tl2); (Array.compare f, bl1, bl2)]
-    | CoFix _, _ -> -1 | _, CoFix _ -> 1
-    | Proj (p1,_r1,c1), Proj (p2,_r2,c2) -> compare [(Projection.CanOrd.compare, p1, p2); (f, c1, c2)]
-    | Proj _, _ -> -1 | _, Proj _ -> 1
-    | Int i1, Int i2 -> Uint63.compare i1 i2
-    | Int _, _ -> -1 | _, Int _ -> 1
-    | Float f1, Float f2 -> Float64.total_compare f1 f2
-    | Float _, _ -> -1 | _, Float _ -> 1
-    | String s1, String s2 -> Pstring.compare s1 s2
-    | String _, _ -> -1 | _, String _ -> 1
-    | Array(_u1,t1,def1,ty1), Array(_u2,t2,def2,ty2) ->
-      compare [(Array.compare f, t1, t2); (f, def1, def2); (f, ty1, ty2)]
-    (*| Array _, _ -> -1 | _, Array _ -> 1*)
-
-let rec compare m n=
-  constr_ord_int compare m n
-
 (*******************)
 (*  hash-consing   *)
 (*******************)
@@ -1213,66 +1137,6 @@ let hash_cast_kind = function
 | NATIVEcast -> 1
 | DEFAULTcast -> 2
 
-(* Exported hashing fonction on constr, used mainly in plugins.
-   Slight differences from [snd (hash_term t)] above: it ignores binders. *)
-
-let rec hash t =
-  match kind t with
-    | Var i -> combinesmall 1 (Id.hash i)
-    | Sort s -> combinesmall 2 (Sorts.hash s)
-    | Cast (c, k, t) ->
-      let hc = hash c in
-      let ht = hash t in
-      combinesmall 3 (combine3 hc (hash_cast_kind k) ht)
-    | Prod (_, t, c) -> combinesmall 4 (combine (hash t) (hash c))
-    | Lambda (_, t, c) -> combinesmall 5 (combine (hash t) (hash c))
-    | LetIn (_, b, t, c) ->
-      combinesmall 6 (combine3 (hash b) (hash t) (hash c))
-    | App (c,l) -> begin match kind c with
-        | Cast (c, _, _) -> hash (mkApp (c,l)) (* WTF *)
-        | _ -> combinesmall 7 (combine (hash_term_array l) (hash c))
-      end
-    | Evar (e,l) ->
-      combinesmall 8 (combine (Evar.hash e) (hash_term_list l))
-    | Const (c,u) ->
-      combinesmall 9 (combine (Constant.CanOrd.hash c) (Instance.hash u))
-    | Ind (ind,u) ->
-      combinesmall 10 (combine (Ind.CanOrd.hash ind) (Instance.hash u))
-    | Construct (c,u) ->
-      combinesmall 11 (combine (Construct.CanOrd.hash c) (Instance.hash u))
-    | Case (_ , u, pms, (p,r), iv, c, bl) ->
-      combinesmall 12 (combine5 (hash c) (hash_invert iv) (hash_term_array pms) (Instance.hash u)
-                         (combine3 (hash_under_context p) (Sorts.relevance_hash r) (hash_branches bl)))
-    | Fix (_ln ,(_, tl, bl)) ->
-      combinesmall 13 (combine (hash_term_array bl) (hash_term_array tl))
-    | CoFix(_ln, (_, tl, bl)) ->
-       combinesmall 14 (combine (hash_term_array bl) (hash_term_array tl))
-    | Meta n -> combinesmall 15 n
-    | Rel n -> combinesmall 16 n
-    | Proj (p,r, c) ->
-      combinesmall 17 (combine3 (Projection.CanOrd.hash p) (Sorts.relevance_hash r) (hash c))
-    | Int i -> combinesmall 18 (Uint63.hash i)
-    | Float f -> combinesmall 19 (Float64.hash f)
-    | String s -> combinesmall 20 (Pstring.hash s)
-    | Array(u,t,def,ty) ->
-      combinesmall 21 (combine4 (Instance.hash u) (hash_term_array t) (hash def) (hash ty))
-
-and hash_invert = function
-  | NoInvert -> 0
-  | CaseInvert {indices;} ->
-    combinesmall 1 (hash_term_array indices)
-
-and hash_term_array t =
-  Array.fold_left (fun acc t -> combine acc (hash t)) 0 t
-
-and hash_term_list t =
-  SList.Skip.fold (fun acc t -> combine (hash t) acc) 0 t
-
-and hash_under_context (_, t) = hash t
-
-and hash_branches bl =
-  Array.fold_left (fun acc t -> combine acc (hash_under_context t)) 0 bl
-
 module CaseinfoHash =
 struct
   type t = case_info
@@ -1283,7 +1147,7 @@ struct
     | IfStyle -> 1
     | LetPatternStyle -> 2
     | MatchStyle -> 3
-    | RegularStyle -> 4 in
+    in
     h1
   let hash ~hind ci =
     let h1 = hind in
@@ -1519,10 +1383,8 @@ let hcons = HCons.hcons
 
 type rel_declaration = (constr, types, Sorts.relevance) Context.Rel.Declaration.pt
 type named_declaration = (constr, types, Sorts.relevance) Context.Named.Declaration.pt
-type compacted_declaration = (constr, types, Sorts.relevance) Context.Compacted.Declaration.pt
 type rel_context = rel_declaration list
 type named_context = named_declaration list
-type compacted_context = compacted_declaration list
 
 (** Minimalistic constr printer, typically for debugging *)
 
@@ -1538,7 +1400,7 @@ let debug_print_fix pr_constr ((t,i),(lna,tl,bl)) =
 
 let pr_puniverses p u =
   if UVars.Instance.is_empty u then p
-  else Pp.(p ++ str"(*" ++ UVars.Instance.pr Sorts.QVar.raw_pr Univ.Level.raw_pr u ++ str"*)")
+  else Pp.(p ++ str"(*" ++ UVars.Instance.pr Sorts.raw_printer u ++ str"*)")
 
 let rec debug_print c =
   let open Pp in
@@ -1601,7 +1463,7 @@ let rec debug_print c =
   | String s -> str"String("++str (Printf.sprintf "%S" (Pstring.to_string s)) ++ str")"
   | Array(u,t,def,ty) -> str"Array(" ++ prlist_with_sep pr_comma debug_print (Array.to_list t) ++ str" | "
       ++ debug_print def ++ str " : " ++ debug_print ty
-      ++ str")@{" ++ UVars.Instance.pr Sorts.QVar.raw_pr Univ.Level.raw_pr u ++ str"}"
+      ++ str")@{" ++ UVars.Instance.pr Sorts.raw_printer u ++ str"}"
 
 and debug_invert = let open Pp in function
   | NoInvert -> mt()
diff --git a/kernel/constr.mli b/kernel/constr.mli
index 60594d54a290..edb0d9fe3cc8 100644
--- a/kernel/constr.mli
+++ b/kernel/constr.mli
@@ -23,7 +23,7 @@ type metavariable = int
 
 (** {6 Case annotation } *)
 type case_style = LetStyle | IfStyle | LetPatternStyle | MatchStyle
-  | RegularStyle (** infer printing form from number of constructor *)
+
 type case_printing =
   { style     : case_style }
 
@@ -332,7 +332,6 @@ 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
@@ -427,17 +426,12 @@ val leq_constr_univs : UGraph.t -> constr -> constr -> bool
    application grouping and ignoring universe instances. *)
 val eq_constr_nounivs : constr -> constr -> bool
 
-(** Total ordering compatible with [equal] *)
-val compare : constr -> constr -> int
-
 (** {6 Extension of Context with declarations on constr} *)
 
 type rel_declaration = (constr, types, Sorts.relevance) Context.Rel.Declaration.pt
 type named_declaration = (constr, types, Sorts.relevance) Context.Named.Declaration.pt
-type compacted_declaration = (constr, types, Sorts.relevance) Context.Compacted.Declaration.pt
 type rel_context = rel_declaration list
 type named_context = named_declaration list
-type compacted_context = compacted_declaration list
 
 (** {6 Relocation and substitution } *)
 
@@ -622,8 +616,6 @@ val eq_invert : ('a -> 'a -> bool)
 
 (** {6 Hashconsing} *)
 
-val hash : constr -> int
-
 (*********************************************************************)
 
 module GenHCons(C:sig
diff --git a/kernel/context.ml b/kernel/context.ml
index 7046ca3f66f8..a0d9f84432eb 100644
--- a/kernel/context.ml
+++ b/kernel/context.ml
@@ -569,38 +569,3 @@ struct
   let instance mk l =
     Array.of_list (instance_list mk l)
 end
-
-module Compacted =
-  struct
-    module Declaration =
-      struct
-        type ('constr, 'types, 'r) pt =
-          | LocalAssum of (Id.t,'r) pbinder_annot list * 'types
-          | LocalDef of (Id.t,'r) pbinder_annot list * 'constr * 'types
-
-        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, 'r) pt = ('constr, 'types, 'r) Declaration.pt list
-
-    let fold f l ~init = List.fold_right f l init
-  end
diff --git a/kernel/context.mli b/kernel/context.mli
index 751b08d54b59..7d67681980ce 100644
--- a/kernel/context.mli
+++ b/kernel/context.mli
@@ -370,21 +370,3 @@ sig
   (** [instance_list] is like [instance] but returning a list. *)
   val instance_list : (Id.t -> 'v) -> ('c, 't, 'r) pt -> 'v list
 end
-
-module Compacted :
-sig
-  module Declaration :
-  sig
-    type ('constr, 'types, 'r) pt =
-      | LocalAssum of (Id.t,'r) pbinder_annot list * 'types
-      | LocalDef of (Id.t,'r) pbinder_annot list * 'constr * 'types
-
-    val map_constr : ('c -> 'c) -> ('c, 'c, 'r) pt -> ('c, 'c, 'r) pt
-    val of_named_decl : ('c, 't, 'r) Named.Declaration.pt -> ('c, 't, 'r) pt
-    val to_named_context : ('c, 't, 'r) pt -> ('c, 't, 'r) Named.pt
-  end
-
-  type ('constr, 'types, 'r) pt = ('constr, 'types, 'r) Declaration.pt list
-
-  val fold : (('c, 't, 'r) Declaration.pt -> 'a -> 'a) -> ('c, 't, 'r) pt -> init:'a -> 'a
-end
diff --git a/kernel/conv_oracle.ml b/kernel/conv_oracle.ml
index e092b0478c1a..10bb34cb3840 100644
--- a/kernel/conv_oracle.ml
+++ b/kernel/conv_oracle.ml
@@ -34,6 +34,10 @@ let is_transparent = function
 | Level 0 -> true
 | _ -> false
 
+module Cmap = HMap.Make(Constant.CanOrd)
+module PRmap = HMap.Make(Projection.Repr.CanOrd)
+(* TODO: should we hand-canonize without the env, or just change the semantics? *)
+
 type oracle = {
   var_opacity : level Id.Map.t;
   cst_opacity : level Cmap.t;
@@ -113,34 +117,45 @@ let get_transp_state { var_trstate; cst_trstate; prj_trstate; _ } =
   let open TransparentState in
   { tr_var = var_trstate; tr_cst = cst_trstate ; tr_prj = prj_trstate }
 
-let dep_order l2r k1 k2 =
+type order = Left | Right | Same
+
+let dep_order k1 k2 =
   match k1, k2 with
-  | None, None -> l2r
-  | None, _    -> true
-  | Some _, None -> false
+  | None, None -> Same
+  | None, _    -> Left
+  | Some _, None -> Right
   | Some k1, Some k2 ->
   match k1, k2 with
-  | EvalVarRef _, EvalVarRef _ -> l2r
-  | EvalVarRef _, (EvalConstRef _ | EvalProjectionRef _) -> true
-  | EvalConstRef _, EvalVarRef _ -> false
-  | EvalConstRef _, EvalProjectionRef _ -> l2r
-  | EvalConstRef _, EvalConstRef _ -> l2r
-  | EvalProjectionRef _, EvalVarRef _ -> false
-  | EvalProjectionRef _, EvalConstRef _ -> l2r
-  | EvalProjectionRef _, EvalProjectionRef _ -> l2r
+  | EvalVarRef _, EvalVarRef _ -> Same
+  | EvalVarRef _, (EvalConstRef _ | EvalProjectionRef _) -> Left
+  | EvalConstRef _, EvalVarRef _ -> Right
+  | EvalConstRef _, EvalProjectionRef _ -> Same
+  | EvalConstRef _, EvalConstRef _ -> Same
+  | EvalProjectionRef _, EvalVarRef _ -> Right
+  | EvalProjectionRef _, EvalConstRef _ -> Same
+  | EvalProjectionRef _, EvalProjectionRef _ -> Same
 
-(* Unfold the first constant only if it is "more transparent" than the
-   second one. In case of tie, use the recommended default. *)
-let oracle_order o l2r k1 k2 =
+(* Compare two constants based on their oracle levels.
+   Returns Same when both have equal levels and same key type. *)
+let oracle_compare o k1 k2 =
   let s1 = match k1 with None -> Expand | Some k1 -> get_strategy o k1 in
   let s2 = match k2 with None -> Expand | Some k2 -> get_strategy o k2 in
   match s1, s2 with
-  | Expand, Expand -> dep_order l2r k1 k2
-  | Expand, (Opaque | Level _) -> true
-  | (Opaque | Level _), Expand -> false
-  | Opaque, Opaque -> dep_order l2r k1 k2
-  | Level _, Opaque -> true
-  | Opaque, Level _ -> false
+  | Expand, Expand -> dep_order k1 k2
+  | Expand, (Opaque | Level _) -> Left
+  | (Opaque | Level _), Expand -> Right
+  | Opaque, Opaque -> dep_order k1 k2
+  | Level _, Opaque -> Left
+  | Opaque, Level _ -> Right
   | Level n1, Level n2 ->
-     if Int.equal n1 n2 then dep_order l2r k1 k2
-     else n1 < n2
+     if Int.equal n1 n2 then dep_order k1 k2
+     else if n1 < n2 then Left
+     else Right
+
+(* Unfold the first constant only if it is "more transparent" than the
+   second one. In case of tie, use the recommended default. *)
+let oracle_order o l2r k1 k2 =
+  match oracle_compare o k1 k2 with
+  | Left -> true
+  | Right -> false
+  | Same -> l2r
diff --git a/kernel/conv_oracle.mli b/kernel/conv_oracle.mli
index f695fd388bf3..5ba6af566f99 100644
--- a/kernel/conv_oracle.mli
+++ b/kernel/conv_oracle.mli
@@ -20,6 +20,9 @@ type oracle
 
 val empty : oracle
 
+(** Result of oracle comparison *)
+type order = Left | Right | Same
+
 (** Order on section paths for unfolding.
    If [oracle_order kn1 kn2] is true, then unfold kn1 first.
    Note: the oracle does not introduce incompleteness, it only
@@ -27,6 +30,12 @@ val empty : oracle
 val oracle_order :
   oracle -> bool -> evaluable option -> evaluable option -> bool
 
+(** Like [oracle_order] but returns [Same] when neither constant is preferred
+    based on the oracle alone. This allows the caller to apply additional
+    heuristics. *)
+val oracle_compare :
+  oracle -> evaluable option -> evaluable option -> order
+
 (** Priority for the expansion of constant in the conversion test.
  * Higher levels means that the expansion is less prioritary.
  * (And Expand stands for -oo, and Opaque +oo.)
diff --git a/kernel/conversion.ml b/kernel/conversion.ml
index cddc2cb5d73a..b1389d690b6e 100644
--- a/kernel/conversion.ml
+++ b/kernel/conversion.ml
@@ -266,11 +266,17 @@ let push_relevances infos nas =
 let identity_of_ctx (ctx:Constr.rel_context) =
   Context.Rel.instance mkRel 0 ctx
 
+let get_template_instance mib u = match mib.mind_template with
+| None -> u
+| Some templ ->
+  let () = assert (UVars.Instance.is_empty u) in
+  templ.template_defaults
+
 (* ind -> fun args => ind args *)
 let eta_expand_ind env (ind,u as pind) =
   let mib = Environ.lookup_mind (fst ind) env in
   let mip = mib.mind_packets.(snd ind) in
-  let ctx = Vars.subst_instance_context u mip.mind_arity_ctxt in
+  let ctx = Vars.subst_instance_context (get_template_instance mib u) mip.mind_arity_ctxt in
   let args = identity_of_ctx ctx in
   let c = mkApp (mkIndU pind, args) in
   let c = Term.it_mkLambda_or_LetIn c ctx in
@@ -279,18 +285,17 @@ let eta_expand_ind env (ind,u as pind) =
 let eta_expand_constructor env ((ind,ctor),u as pctor) =
   let mib = Environ.lookup_mind (fst ind) env in
   let mip = mib.mind_packets.(snd ind) in
-  let ctx = Vars.subst_instance_context u (fst mip.mind_nf_lc.(ctor-1)) in
+  let ctx = Vars.subst_instance_context (get_template_instance mib u) (fst mip.mind_nf_lc.(ctor-1)) in
   let args = identity_of_ctx ctx in
   let c = mkApp (mkConstructU pctor, args) in
   let c = Term.it_mkLambda_or_LetIn c ctx in
   inject c
 
-let esubst_of_context ctx u args e =
+let esubst_of_context ctx args e =
   let rec aux lft e args ctx = match ctx with
   | [] -> lft, e
   | None :: ctx -> aux (lft + 1) (usubs_lift e) (usubs_lift args) ctx
   | Some c :: ctx ->
-    let c = Vars.subst_instance_constr u c in
     let c = mk_clos args c in
     aux lft (usubs_cons c e) (usubs_cons c args) ctx
   in
@@ -344,14 +349,14 @@ let rec compare_under e1 c1 e2 c2 =
     && compare_under e1 c1 e2 c2
     && Array.equal_norefl (fun c1 c2 -> compare_under e1 c1 e2 c2) l1 l2
   | Proj (p1,_,c1), Proj (p2,_,c2) ->
-    Projection.CanOrd.equal p1 p2 && compare_under e1 c1 e2 c2
+    Projection.UserOrd.equal p1 p2 && compare_under e1 c1 e2 c2
   | Evar _, Evar _ -> false
   | Const (c1,u1), Const (c2,u2) ->
     (* The args length currently isn't used but may as well pass it. *)
-    Constant.CanOrd.equal c1 c2 && eq_universes e1 e2 u1 u2
-  | Ind (c1,u1), Ind (c2,u2) -> Ind.CanOrd.equal c1 c2 && eq_universes e1 e2 u1 u2
+    Constant.UserOrd.equal c1 c2 && eq_universes e1 e2 u1 u2
+  | Ind (c1,u1), Ind (c2,u2) -> Ind.UserOrd.equal c1 c2 && eq_universes e1 e2 u1 u2
   | Construct (c1,u1), Construct (c2,u2) ->
-    Construct.CanOrd.equal c1 c2 && eq_universes e1 e2 u1 u2
+    Construct.UserOrd.equal c1 c2 && eq_universes e1 e2 u1 u2
   | Case _, Case _ | Fix _, Fix _ | CoFix _, CoFix _ -> false (* todo some other time *)
   | Array(_,t1,def1,ty1), Array(_,t2,def2,ty2) ->
     Array.equal_norefl (fun c1 c2 -> compare_under e1 c1 e2 c2) t1 t2
@@ -429,7 +434,7 @@ and eqwhnf cv_pb l2r infos (lft1, (hd1, v1) as appr1) (lft2, (hd2, v2) as appr2)
         let rn = Range.get (info_relevances infos.cnv_inf) (n - 1) in
         let rm = Range.get (info_relevances infos.cnv_inf) (m - 1) in
         if is_irrelevant infos.cnv_inf rn && is_irrelevant infos.cnv_inf rm then
-          let v1 = CClosure.skip_irrelevant_stack infos.cnv_inf v2 in
+          let v1 = CClosure.skip_irrelevant_stack infos.cnv_inf v1 in
           let v2 = CClosure.skip_irrelevant_stack infos.cnv_inf v2 in
           convert_stacks l2r infos lft1 lft2 v1 v2 cuniv
         else if Int.equal n m then
@@ -465,7 +470,25 @@ and eqwhnf cv_pb l2r infos (lft1, (hd1, v1) as appr1) (lft2, (hd2, v2) as appr2)
           in
           let ninfos = infos_with_reds infos.cnv_inf RedFlags.betaiotazeta in
           let () = Control.check_for_interrupt () in
-          if Conv_oracle.oracle_order oracle l2r (to_er fl1) (to_er fl2) then
+          (* Determine which constant to unfold first *)
+          let unfold_left =
+            let order = Conv_oracle.oracle_compare oracle (to_er fl1) (to_er fl2) in
+            match order with
+            | Conv_oracle.Left -> true
+            | Conv_oracle.Right -> false
+            | Conv_oracle.Same ->
+              (* When oracle doesn't prefer either, optionally use dependency heuristic *)
+              let env = CClosure.info_env infos.cnv_inf in
+              if (Environ.typing_flags env).unfold_dep_heuristic then
+                match fl1, fl2 with
+                | ConstKey (cst1, _), ConstKey (cst2, _) ->
+                  if Environ.constant_depends_on env cst1 cst2 then true
+                  else if Environ.constant_depends_on env cst2 cst1 then false
+                  else l2r
+                | _ -> l2r
+              else l2r
+          in
+          if unfold_left then
             let appr1 = whd_stack ninfos infos.lft_tab t1 v1 in
             eqwhnf cv_pb l2r infos (lft1, appr1) appr2 cuniv
           else
@@ -593,11 +616,11 @@ and eqwhnf cv_pb l2r infos (lft1, (hd1, v1) as appr1) (lft2, (hd2, v2) as appr2)
             eqwhnf cv_pb l2r infos (lft1, r1) appr2 cuniv
         | None ->
           (match c2 with
-           | FConstruct (((ind2,1),u2),_) ->
+           | FConstruct (((ind2, 1), u2), args2) ->
              let () = assert_reduced_constructor v2 in
              (try
                 let v2, v1 =
-                  eta_expand_ind_stack (info_env infos.cnv_inf) (ind2,u2) hd2 (snd appr1)
+                  eta_expand_ind_stack (info_env infos.cnv_inf) (ind2,u2) args2 (snd appr1)
                 in convert_stacks l2r infos lft1 lft2 v1 v2 cuniv
               with Not_found -> raise NotConvertible)
            | _ -> raise NotConvertible)
@@ -612,10 +635,10 @@ and eqwhnf cv_pb l2r infos (lft1, (hd1, v1) as appr1) (lft2, (hd2, v2) as appr2)
           eqwhnf cv_pb l2r infos appr1 (lft2, r2) cuniv
         | None ->
           match c1 with
-          | FConstruct (((ind1,1),u1),_) ->
+          | FConstruct (((ind1, 1), u1), args1) ->
             let () = assert_reduced_constructor v1 in
             (try let v1, v2 =
-                   eta_expand_ind_stack (info_env infos.cnv_inf) (ind1,u1) hd1 (snd appr2)
+                   eta_expand_ind_stack (info_env infos.cnv_inf) (ind1,u1) args1 (snd appr2)
                in convert_stacks l2r infos lft1 lft2 v1 v2 cuniv
              with Not_found -> raise NotConvertible)
           | _ -> raise NotConvertible
@@ -662,23 +685,23 @@ and eqwhnf cv_pb l2r infos (lft1, (hd1, v1) as appr1) (lft2, (hd2, v2) as appr2)
       else raise NotConvertible
 
     (* Eta expansion of records *)
-    | (FConstruct (((ind1,j1),u1), _),_) ->
+    | (FConstruct (((ind1, j1), u1), args1), _) ->
       let () = assert_reduced_constructor v1 in
       (* records only have 1 constructor *)
       let () = if not @@ Int.equal j1 1 then raise NotConvertible in
       (try
          let v1, v2 =
-            eta_expand_ind_stack (info_env infos.cnv_inf) (ind1,u1) hd1 (snd appr2)
+            eta_expand_ind_stack (info_env infos.cnv_inf) (ind1,u1) args1 (snd appr2)
          in convert_stacks l2r infos lft1 lft2 v1 v2 cuniv
        with Not_found -> raise NotConvertible)
 
-    | (_, FConstruct (((ind2,j2),u2),_)) ->
+    | (_, FConstruct (((ind2, j2), u2), args2)) ->
       let () = assert_reduced_constructor v2 in
       (* records only have 1 constructor *)
       let () = if not @@ Int.equal j2 1 then raise NotConvertible in
       (try
          let v2, v1 =
-            eta_expand_ind_stack (info_env infos.cnv_inf) (ind2,u2) hd2 (snd appr1)
+            eta_expand_ind_stack (info_env infos.cnv_inf) (ind2,u2) args2 (snd appr1)
          in convert_stacks l2r infos lft1 lft2 v1 v2 cuniv
        with Not_found -> raise NotConvertible)
 
@@ -753,7 +776,12 @@ and eqwhnf cv_pb l2r infos (lft1, (hd1, v1) as appr1) (lft2, (hd2, v2) as appr2)
       let cuniv = Array.fold_right2 fold pms1 pms2 cuniv in
       let cuniv = Array.fold_right2 fold (get_invert iv1) (get_invert iv2) cuniv in
       let cuniv = convert_return_clause mind mip l2r infos e1 e2 el1 el2 u1 u2 pms1 pms2 p1 p2 cuniv in
-      convert_branches mind mip l2r infos e1 e2 el1 el2 u1 u2 pms1 pms2 br1 br2 cuniv
+      (* not clear if we need to pass both u1 and u2 as
+         convert_inductives should have enforced that they are
+         equivalent when used to instantiate this inductive's
+         components, but we may as well *)
+      let cuniv = convert_branches mind mip l2r infos e1 e2 el1 el2 u1 u2 pms1 pms2 br1 br2 cuniv in
+      convert_stacks l2r infos lft1 lft2 v1 v2 cuniv
 
     | FArray (u1,t1,ty1), FArray (u2,t2,ty2) ->
       let len = Parray.length_int t1 in
@@ -882,9 +910,9 @@ and convert_under_context l2r infos e1 e2 lft1 lft2 ctx (nas1, c1) (nas2, c2) cu
     let e1 = usubs_liftn n e1 in
     let e2 = usubs_liftn n e2 in
     (n, e1, e2)
-  | Some (ctx, u1, u2, args1, args2) ->
-    let n1, e1 = esubst_of_context ctx u1 args1 e1 in
-    let n2, e2 = esubst_of_context ctx u2 args2 e2 in
+  | Some (ctx, args1, args2) ->
+    let n1, e1 = esubst_of_context ctx args1 e1 in
+    let n2, e2 = esubst_of_context ctx args2 e2 in
     let () = assert (Int.equal n1 n2) in
     n1, e1, e2
   in
@@ -899,11 +927,11 @@ and convert_return_clause mib mip l2r infos e1 e2 l1 l2 u1 u2 pms1 pms2 p1 p2 cu
     else
       let ctx, _ = List.chop mip.mind_nrealdecls mip.mind_arity_ctxt in
       let pms1 = inductive_subst mib u1 pms1 in
-      let pms2 = inductive_subst mib u1 pms2 in
+      let pms2 = inductive_subst mib u2 pms2 in
       let open Context.Rel.Declaration in
       (* Add the inductive binder *)
       let ctx = None :: List.map get_value ctx in
-      Some (ctx, u1, u2, pms1, pms2)
+      Some (ctx, pms1, pms2)
   in
   convert_under_context l2r infos e1 e2 l1 l2 ctx (fst p1) (fst p2) cu
 
@@ -916,7 +944,7 @@ and convert_branches mib mip l2r infos e1 e2 lft1 lft2 u1 u2 pms1 pms2 br1 br2 c
         let ctx = List.map Context.Rel.Declaration.get_value ctx in
         let pms1 = inductive_subst mib u1 pms1 in
         let pms2 = inductive_subst mib u2 pms2 in
-        Some (ctx, u1, u2, pms1, pms2)
+        Some (ctx, pms1, pms2)
     in
     let c1 = br1.(i) in
     let c2 = br2.(i) in
@@ -991,7 +1019,7 @@ let () =
       let box = Empty.abort in
       let state = info_univs infos in
       let qual_equal q1 q2 = CClosure.eq_quality infos q1 q2 in
-      let infos = { cnv_inf = infos; cnv_typ = true; lft_tab = tab; rgt_tab = tab; err_ret = box } in
+      let infos = { cnv_inf = infos; cnv_typ = true; lft_tab = tab; rgt_tab = tab; err_ret = box; } in
       let state', _ = ccnv CONV false infos el_id el_id a b (state, checked_universes_gen qual_equal) in
       assert (state==state');
       true
diff --git a/kernel/conversion.mli b/kernel/conversion.mli
index d42217f8e0f5..4c21de1b54a2 100644
--- a/kernel/conversion.mli
+++ b/kernel/conversion.mli
@@ -45,7 +45,11 @@ val sort_cmp_universes : conv_pb -> Sorts.t -> Sorts.t ->
 (* [flex] should be true for constants, false for inductive types and
 constructors. *)
 val convert_instances : flex:bool -> UVars.Instance.t -> UVars.Instance.t ->
-  'a * ('a, 'err) universe_compare -> ('a, 'err option) result * ('a, 'err) universe_compare
+  ('a, 'err) universe_state -> ('a, 'err option) result * ('a, 'err) universe_compare
+
+val convert_instances_cumul : conv_pb -> UVars.Variance.t array ->
+  UVars.Instance.t -> UVars.Instance.t ->
+  ('a, 'err) universe_state -> ('a, 'err option) result * ('a, 'err) universe_compare
 
 (** This function never returns an non-empty error. *)
 val checked_universes : (UGraph.t, 'err) universe_compare
diff --git a/kernel/cooking.ml b/kernel/cooking.ml
index df45739d951d..1af0baf1430b 100644
--- a/kernel/cooking.ml
+++ b/kernel/cooking.ml
@@ -391,5 +391,8 @@ let lift_private_poly_univs info (inst, cstrs) =
   let cstrs = UVars.subst_univs_constraints (snd @@ make_instance_subst info.abstr_info.abstr_ausubst) cstrs in
   (inst, cstrs)
 
+let lift_quality info q =
+  UVars.subst_sort_level_quality (make_instance_subst info.abstr_info.abstr_ausubst) q
+
 let lift_relevance info relevance =
   UVars.subst_sort_level_relevance (make_instance_subst info.abstr_info.abstr_ausubst) relevance
diff --git a/kernel/cooking.mli b/kernel/cooking.mli
index 93ff4b9b3946..18ee0d10b265 100644
--- a/kernel/cooking.mli
+++ b/kernel/cooking.mli
@@ -74,6 +74,8 @@ val lift_private_mono_univs : cooking_info -> 'a -> 'a
 
 val lift_private_poly_univs : cooking_info -> Univ.ContextSet.t -> Univ.ContextSet.t
 
+val lift_quality : cooking_info -> Sorts.Quality.t -> Sorts.Quality.t
+
 val lift_relevance : cooking_info -> Sorts.relevance -> Sorts.relevance
 
 val discharge_proj_repr : cooking_info -> Names.Projection.Repr.t -> Names.Projection.Repr.t
diff --git a/kernel/declarations.mli b/kernel/declarations.mli
index 3d58466e46c0..74f058237583 100644
--- a/kernel/declarations.mli
+++ b/kernel/declarations.mli
@@ -77,12 +77,18 @@ type typing_flags = {
   check_universes : bool;
   (** If [false] universe constraints are not checked *)
 
+  check_eliminations : bool;
+  (** If [false] sort elimination constraints are not checked. Breaks the system *)
+
   conv_oracle : Conv_oracle.oracle;
   (** Unfolding strategies for conversion *)
 
   share_reduction : bool;
   (** Use by-need reduction algorithm *)
 
+  unfold_dep_heuristic : bool;
+  (** If [true], use dependency heuristic when unfolding constants during conversion *)
+
   enable_VM : bool;
   (** If [false], all VM conversions fall back to interpreted ones *)
 
@@ -122,7 +128,7 @@ type ('opaque, 'bytecode) pconstant_body = {
                                            type-checking. *)
 }
 
-type constant_body = (Opaqueproof.opaque, Vmlibrary.indirect_code option) pconstant_body
+type constant_body = (Opaqueproof.opaque, Vmlibrary.indirect_code) pconstant_body
 
 (** {6 Representation of mutual inductive types in the kernel } *)
 
@@ -157,7 +163,7 @@ v}
     [FakeRecord]. It is mostly used by extraction, and should be extruded from
     the kernel at some point.
 *)
-type has_eta = AlwaysEta | NoEta
+type has_eta = AlwaysEta | MaybeEta | NoEta
 
 type record_info =
 | NotRecord
@@ -242,11 +248,15 @@ type one_inductive_body = {
     mind_consnrealdecls : int array;
  (** Length of the signature of the constructors (with let, w/o params) *)
 
-    mind_recargs : wf_paths; (** Signature of recursive arguments in the constructors *)
+    mind_automaton : recarg Rtree.Automaton.t; (** Minimal automaton generated from the inductive tree *)
 
     mind_relevance : Sorts.relevance;
     (* XXX this is redundant with mind_sort, is it actually worth keeping? *)
 
+    mind_relies_on_indices_not_mattering : bool;
+    (** true if this inductive relies on indices not mattering,
+        i.e. its behavior would change under -indices-matter. *)
+
 (** {8 Datas for bytecode compilation } *)
 
     mind_nb_constant : int; (** number of constant constructor *)
@@ -300,12 +310,12 @@ type mind_specif = mutual_inductive_body * one_inductive_body
 (** {6 Rewrite rules } *)
 
 type 'q quality_pattern = 'q Sorts.Quality.pattern =
-  | PQVar of 'q | PQConstant of Sorts.Quality.constant
+  | PQVar of 'q | PQConstant of Sorts.Quality.constant | PQGlobal of Sorts.QGlobal.t
 
 type ('q, 'u) instance_mask = ('q, 'u) UVars.Instance.mask
 
 type ('q, 'u) sort_pattern = ('q, 'u) Sorts.pattern =
-  | PSProp | PSSProp | PSSet | PSType of 'u | PSQSort of 'q * 'u
+  | PSProp | PSSProp | PSSet | PSType of 'u | PSGlobal of Sorts.QGlobal.t * 'u | PSQSort of 'q * 'u
 
 (** Patterns are internally represented as pairs of a head-pattern and a list of eliminations
     Eliminations correspond to elements of the stack in a reduction machine,
diff --git a/kernel/declareops.ml b/kernel/declareops.ml
index ecd9844cd050..553d33c1649a 100644
--- a/kernel/declareops.ml
+++ b/kernel/declareops.ml
@@ -19,14 +19,20 @@ let noh hcons x = snd (hcons x)
 (** Operations concernings types in [Declarations] :
     [constant_body], [mutual_inductive_body], [module_body] ... *)
 
+let configure_enabled_native = match Coq_config.native_compiler with
+  | NativeOff -> false
+  | NativeOn _ -> true
+
 let safe_flags oracle = {
   check_guarded = true;
   check_positive = true;
+  check_eliminations = true;
   check_universes = true;
   conv_oracle = oracle;
   share_reduction = true;
-  enable_VM = true;
-  enable_native_compiler = true;
+  unfold_dep_heuristic = false;
+  enable_VM = Coq_config.bytecode_compiler;
+  enable_native_compiler = configure_enabled_native;
   indices_matter = true;
   impredicative_set = false;
   sprop_allowed = true;
@@ -105,8 +111,7 @@ let subst_const_body subst cb =
         const_univ_hyps = UVars.Instance.empty;
         const_body = body';
         const_type = type';
-        const_body_code =
-          Option.map (Vmemitcodes.subst_body_code subst) cb.const_body_code;
+        const_body_code = Vmemitcodes.subst_body_code subst cb.const_body_code;
         const_universes = cb.const_universes;
         const_relevance = cb.const_relevance;
         const_inline_code = cb.const_inline_code;
@@ -146,16 +151,19 @@ let hcons_const_body ?hbody cb =
 
 (** {6 Inductive types } *)
 
-let eq_recarg_type t1 t2 = match t1, t2 with
-| RecArgInd ind1, RecArgInd ind2 -> Names.Ind.CanOrd.equal ind1 ind2
-| RecArgPrim c1, RecArgPrim c2 -> Names.Constant.CanOrd.equal c1 c2
-| (RecArgInd _ | RecArgPrim _), _ -> false
+let compare_recarg_type t1 t2 = match t1, t2 with
+| RecArgInd ind1, RecArgInd ind2 -> Names.Ind.CanOrd.compare ind1 ind2
+| RecArgInd _, RecArgPrim _ -> -1
+| RecArgPrim c1, RecArgPrim c2 -> Names.Constant.CanOrd.compare c1 c2
+| RecArgPrim _, RecArgInd _ -> 1
+
+let compare_recarg r1 r2 = match r1, r2 with
+| Norec, Norec -> 0
+| Norec, Mrec _ -> -1
+| Mrec t1, Mrec t2 -> compare_recarg_type t1 t2
+| Mrec _, Norec -> 1
 
-let eq_recarg r1 r2 = match r1, r2 with
-| Norec, Norec -> true
-| Norec, _ -> false
-| Mrec t1, Mrec t2 -> eq_recarg_type t1 t2
-| Mrec _, _ -> false
+let eq_recarg r1 r2 = Int.equal (compare_recarg r1 r2) 0
 
 let pr_recarg_type = let open Pp in function
   | RecArgInd (mind,i) ->
@@ -201,11 +209,8 @@ let dest_subterms p =
   assert (match ra with Norec -> false | _ -> true);
   Array.map Array.to_list cstrs
 
-let recarg_length p j =
-  let (_,cstrs) = Rtree.dest_node p in
-  Array.length cstrs.(j-1)
-
-let subst_wf_paths subst p = Rtree.Smart.map (subst_recarg subst) p
+let subst_automaton subst a =
+  Rtree.Automaton.map (fun r -> subst_recarg subst r) a
 
 (** {7 Substitution of inductive declarations } *)
 
@@ -231,8 +236,9 @@ let subst_mind_packet subst mbp =
     mind_nrealargs = mbp.mind_nrealargs;
     mind_nrealdecls = mbp.mind_nrealdecls;
     mind_squashed = mbp.mind_squashed;
-    mind_recargs = subst_wf_paths subst mbp.mind_recargs (*wf_paths*);
+    mind_automaton = subst_automaton subst mbp.mind_automaton;
     mind_relevance = mbp.mind_relevance;
+    mind_relies_on_indices_not_mattering = mbp.mind_relies_on_indices_not_mattering;
     mind_nb_constant = mbp.mind_nb_constant;
     mind_nb_args = mbp.mind_nb_args;
     mind_reloc_tbl = mbp.mind_reloc_tbl }
@@ -286,12 +292,34 @@ let inductive_make_projection ind mib ~proj_arg =
 let inductive_make_projections ind mib =
   match mib.mind_packets.(snd ind).mind_record with
   | NotRecord | FakeRecord -> None
-  | PrimRecord { projections; relevances; has_eta; _ } ->
+  | PrimRecord { projections; relevances; _ } ->
     let projs = Array.map2_i (fun proj_arg lab r ->
         Names.Projection.Repr.make ind ~proj_npars:mib.mind_nparams ~proj_arg lab, r)
         projections relevances
     in
-    Some (projs, has_eta)
+    Some projs
+
+let has_valid_relevance u ind_relevance flds =
+  let ind_relevance = UVars.subst_instance_relevance u ind_relevance in
+  let flds = Array.map (UVars.subst_instance_relevance u) flds in
+  match ind_relevance with
+  | Sorts.Irrelevant -> true
+  | Sorts.Relevant -> Array.exists Sorts.is_relevant flds
+  | Sorts.RelevanceVar qv ->
+    Array.for_all (fun r -> match r with
+        | Sorts.Relevant -> true
+        | Sorts.Irrelevant -> false
+        | Sorts.RelevanceVar qv' -> Sorts.QVar.equal qv qv') flds
+
+let is_record_with_eta (_,mip) u =
+  match mip.mind_record with
+  | NotRecord | FakeRecord -> false
+  | PrimRecord r ->
+    match r.has_eta with
+    | NoEta -> false
+    | MaybeEta ->
+      has_valid_relevance u mip.mind_relevance r.relevances
+    | AlwaysEta -> true
 
 (** {6 Hash-consing of inductive declarations } *)
 
diff --git a/kernel/declareops.mli b/kernel/declareops.mli
index 9cb522a7152b..acc2c23b9f87 100644
--- a/kernel/declareops.mli
+++ b/kernel/declareops.mli
@@ -40,6 +40,7 @@ val is_opaque : ('a, 'b) pconstant_body -> bool
 (** {6 Inductive types} *)
 
 val eq_recarg : recarg -> recarg -> bool
+val compare_recarg : recarg -> recarg -> int
 
 val pr_recarg : recarg -> Pp.t
 val pr_wf_paths : wf_paths -> Pp.t
@@ -50,9 +51,6 @@ val mk_norec : wf_paths
 val mk_paths : recarg -> wf_paths list array -> wf_paths
 val dest_recarg : wf_paths -> recarg
 val dest_subterms : wf_paths -> wf_paths list array
-val recarg_length : wf_paths -> int -> int
-
-val subst_wf_paths : substitution -> wf_paths -> wf_paths
 
 val subst_mind_body : substitution -> mutual_inductive_body -> mutual_inductive_body
 
@@ -72,7 +70,9 @@ val inductive_make_projection : Names.inductive -> mutual_inductive_body -> proj
   Names.Projection.Repr.t * Sorts.relevance
 
 val inductive_make_projections : Names.inductive -> mutual_inductive_body ->
-  ((Names.Projection.Repr.t * Sorts.relevance) array * has_eta) option
+  ((Names.Projection.Repr.t * Sorts.relevance) array) option
+
+val is_record_with_eta : mind_specif -> Instance.t -> bool
 
 (** {6 Kernel flags} *)
 
diff --git a/kernel/discharge.ml b/kernel/discharge.ml
index cf37ea0d5637..1d96131582eb 100644
--- a/kernel/discharge.ml
+++ b/kernel/discharge.ml
@@ -111,6 +111,16 @@ let cook_projection cache ~params t =
   let _, t = decompose_prod_n_decls (Context.Rel.length params + 1 + nrels) t in
   t
 
+let lift_squashed info = let open Declarations in function
+  | AlwaysSquashed -> AlwaysSquashed
+  | SometimesSquashed s ->
+    let s = Sorts.Quality.Set.fold (fun x acc ->
+        let x = lift_quality info x in
+        Sorts.Quality.Set.add x acc)
+        s Sorts.Quality.Set.empty
+    in
+    SometimesSquashed s
+
 let cook_one_ind info cache ~params ~ntypes mip =
   let mind_user_arity = abstract_as_type cache mip.mind_user_arity in
   let mind_sort = abstract_as_sort cache mip.mind_sort in
@@ -130,6 +140,7 @@ let cook_one_ind info cache ~params ~ntypes mip =
         let relevances = Array.map (lift_relevance info) relevances in
         PrimRecord { pinfo with relevances ; tys }
   in
+  let squashed = Option.map (lift_squashed info) mip.mind_squashed in
 
   { mind_typename = mip.mind_typename;
     mind_record;
@@ -140,12 +151,13 @@ let cook_one_ind info cache ~params ~ntypes mip =
     mind_user_lc;
     mind_nrealargs = mip.mind_nrealargs;
     mind_nrealdecls = mip.mind_nrealdecls;
-    mind_squashed = mip.mind_squashed;
+    mind_squashed = squashed;
     mind_nf_lc;
     mind_consnrealargs = mip.mind_consnrealargs;
     mind_consnrealdecls = mip.mind_consnrealdecls;
-    mind_recargs = mip.mind_recargs;
+    mind_automaton = mip.mind_automaton;
     mind_relevance = lift_relevance info mip.mind_relevance;
+    mind_relies_on_indices_not_mattering = mip.mind_relies_on_indices_not_mattering;
     mind_nb_constant = mip.mind_nb_constant;
     mind_nb_args = mip.mind_nb_args;
     mind_reloc_tbl = mip.mind_reloc_tbl;
diff --git a/kernel/dune b/kernel/dune
index 03c5e801acea..6e7e9b94712e 100644
--- a/kernel/dune
+++ b/kernel/dune
@@ -7,6 +7,7 @@
  (modules (:standard \ genOpcodeFiles uint63_31 uint63_63 float64_31 float64_63))
  (libraries boot lib coqrun dynlink))
 
+; used by dune coq mode
 (deprecated_library_name
  (old_public_name coq-core.kernel)
  (new_public_name rocq-runtime.kernel))
diff --git a/kernel/environ.ml b/kernel/environ.ml
index db732432b62d..08284ffa1450 100644
--- a/kernel/environ.ml
+++ b/kernel/environ.ml
@@ -48,12 +48,39 @@ type link_info =
 
 type constant_key = constant_body * (link_info ref * key) * KerName.t
 
+module DepCache :
+sig
+  type t
+  val empty : t
+  val get : Constant.t -> t -> (Cset_env.t, Cset_env.t -> unit) union
+  val fresh : t -> t
+end =
+struct
+
+type t = Cset_env.t Cmap_env.t ref option
+
+let empty = None
+
+let get kn cache = match cache with
+| None -> Inr ignore
+| Some cache ->
+  match Cmap_env.find_opt kn !cache with
+  | None -> Inr (fun s -> cache := Cmap_env.add kn s !cache)
+  | Some s -> Inl s
+
+let fresh = function
+| None -> Some (ref Cmap_env.empty)
+| Some cache -> Some (ref !cache)
+
+end
+
 type mind_key = mutual_inductive_body * link_info ref * KerName.t
 
 type named_context_val = {
   env_named_ctx : Constr.named_context;
   env_named_map : Constr.named_declaration Id.Map.t;
   env_named_idx : Constr.named_declaration Range.t;
+  env_named_secvars : Id.Set.t;
 }
 
 type rel_context_val = {
@@ -82,6 +109,7 @@ type env = {
   irr_inds : Sorts.relevance Indmap_env.t;
   constant_hyps : Id.Set.t Cmap_env.t;
   inductive_hyps : Id.Set.t Mindmap_env.t;
+  constant_deps : DepCache.t CEphemeron.key;
 }
 
 type rewrule_not_allowed = Symb | Rule
@@ -91,6 +119,7 @@ let empty_named_context_val = {
   env_named_ctx = [];
   env_named_map = Id.Map.empty;
   env_named_idx = Range.empty;
+  env_named_secvars = Id.Set.empty;
 }
 
 let empty_rel_context_val = {
@@ -117,6 +146,7 @@ let empty_env = {
   vm_library = Vmlibrary.empty;
   retroknowledge = Retroknowledge.empty;
   rewrite_rules_allowed = false;
+  constant_deps = CEphemeron.create DepCache.empty;
 }
 
 
@@ -142,6 +172,10 @@ let lookup_rel n env =
   try Range.get env.env_rel_context.env_rel_map (n - 1)
   with Invalid_argument _ -> raise Not_found
 
+let lookup_rel_ctxt n ctx =
+  try Range.get ctx.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;
@@ -159,43 +193,85 @@ let set_rel_context_val v env =
     env_nb_rel = Range.length v.env_rel_map; }
 
 (* Named context *)
-
-let push_named_context_val d ctxt =
-(*   assert (not (Id.Map.mem (NamedDecl.get_id d) ctxt.env_named_map)); *)
+type var_status = SecVar | ProofVar
+
+let var_status_eq a b = match a, b with
+  | SecVar, SecVar -> true
+  | ProofVar, ProofVar -> true
+  | (SecVar | ProofVar), _ -> false
+
+let push_named_context_val status d ctxt =
+  let id = NamedDecl.get_id d in
+  (* we would like the stronger assert but it breaks in bug_4095 *)
+  (* assert (not (Id.Map.mem id ctxt.env_named_map)); *)
+  assert (not (Id.Set.mem id ctxt.env_named_secvars));
+  let secvars = match status with
+    | ProofVar -> ctxt.env_named_secvars
+    | SecVar -> Id.Set.add id ctxt.env_named_secvars
+  in
   {
     env_named_ctx = Context.Named.add d ctxt.env_named_ctx;
-    env_named_map = Id.Map.add (NamedDecl.get_id d) d ctxt.env_named_map;
+    env_named_map = Id.Map.add id d ctxt.env_named_map;
     env_named_idx = Range.cons d ctxt.env_named_idx;
+    env_named_secvars = secvars;
   }
 
+let var_status_ctxt ?(check=true) id ctxt =
+  if Id.Set.mem id ctxt.env_named_secvars then SecVar
+  else
+    let () = assert (not check || Id.Map.mem id ctxt.env_named_map) in
+    ProofVar
+
+let var_status ?check id env = var_status_ctxt ?check id env.env_named_context
+
 let match_named_context_val c = match c.env_named_ctx with
 | [] -> None
 | decl :: ctx ->
-  let map = Id.Map.remove (NamedDecl.get_id decl) c.env_named_map in
-  let cval = { env_named_ctx = ctx; env_named_map = map; env_named_idx = Range.tl c.env_named_idx } in
-  Some (decl, cval)
+  let id = NamedDecl.get_id decl in
+  let map = Id.Map.remove id c.env_named_map in
+  let secvars = Id.Set.remove id c.env_named_secvars in
+  let status = if secvars == c.env_named_secvars then ProofVar else SecVar in
+  let cval = {
+    env_named_ctx = ctx;
+    env_named_map = map;
+    env_named_idx = Range.tl c.env_named_idx;
+    env_named_secvars = secvars;
+  }
+  in
+  Some (status, decl, cval)
 
 let map_named_val f ctxt =
   let open Context.Named.Declaration in
-  let fold accu d =
-    let d' = f d in
-    let accu =
-      if d == d' then accu
-      else Id.Map.set (get_id d) d' accu
+  let fold (map,secvars) d =
+    let id = get_id d in
+    let status = var_status_ctxt ~check:false id ctxt in
+    let status', d' = f status d in
+    let () = assert (Id.equal id (get_id d')) in
+    let map =
+      if d == d' then map
+      else Id.Map.set id d' map
+    in
+    let secvars =
+      if status == status' then secvars else
+        match status' with
+        | SecVar -> Id.Set.add id secvars
+        | ProofVar -> Id.Set.remove id secvars
     in
-    (accu, d')
+    ((map,secvars), d')
   in
-  let map, ctx = List.Smart.fold_left_map fold ctxt.env_named_map ctxt.env_named_ctx in
-  if map == ctxt.env_named_map then ctxt
+  let (map,secvars), ctx = List.Smart.fold_left_map fold (ctxt.env_named_map,ctxt.env_named_secvars) ctxt.env_named_ctx in
+  if map == ctxt.env_named_map && secvars == ctxt.env_named_secvars then ctxt
   else
     let idx = List.fold_right Range.cons ctx Range.empty in
-    { env_named_ctx = ctx; env_named_map = map; env_named_idx = idx }
+    { env_named_ctx = ctx; env_named_map = map; env_named_idx = idx; env_named_secvars = secvars }
 
-let push_named d env =
-  {env with env_named_context = push_named_context_val d env.env_named_context}
+let push_named status d env =
+  {env with env_named_context = push_named_context_val status d env.env_named_context}
 
-let mem_named id env =
-  Id.Map.mem id env.env_named_context.env_named_map
+let mem_named_ctxt id ctxt =
+  Id.Map.mem id ctxt.env_named_map
+
+let mem_named id env = mem_named_ctxt id  env.env_named_context
 
 let lookup_named id env =
   Id.Map.find id env.env_named_context.env_named_map
@@ -203,6 +279,11 @@ let lookup_named id env =
 let lookup_named_ctxt id ctxt =
   Id.Map.find id ctxt.env_named_map
 
+let lookup_named_ctxt_pos n ctxt =
+  try Range.get ctxt.env_named_idx n with Invalid_argument _ -> raise Not_found
+
+let nb_named ctx = Range.length ctx.env_named_idx
+
 let record_global_hyps add kn hyps acc =
   if CList.is_empty hyps then acc
   else add kn (Context.Named.to_vars hyps) acc
@@ -220,14 +301,20 @@ let lookup_constant_opt kn env =
   | None -> None
   | Some (cb, _, _) -> Some cb
 
-let lookup_constant_key kn env =
-  match Cmap_env.find_opt kn env.env_constants with
-  | Some v -> v
-  | None ->
-    anomaly Pp.(str "Constant " ++ Constant.print kn ++ str" does not appear in the environment.")
+let missing_constant kn =
+  anomaly Pp.(str "Constant " ++ Constant.print kn ++ str" does not appear in the environment.")
+
+let lookup_constant_key kn env = match Cmap_env.find_opt kn env.env_constants with
+| None -> missing_constant kn
+| Some (_, key, _) -> key
+
+let lookup_constant kn env = match Cmap_env.find_opt kn env.env_constants with
+| None -> missing_constant kn
+| Some (cb, _, _) -> cb
 
-let lookup_constant kn env =
-  pi1 (lookup_constant_key kn env)
+let lookup_constant_canonical kn env = match Cmap_env.find_opt kn env.env_constants with
+| None -> missing_constant kn
+| Some (_, _, can) -> can
 
 let mem_constant kn env = Cmap_env.mem kn env.env_constants
 
@@ -245,14 +332,21 @@ let lookup_rewrite_rules cst env =
   Cmap_env.find cst env.symb_pats
 
 (* Mutual Inductives *)
-let lookup_mind_key kn env =
-  match Mindmap_env.find_opt kn env.env_inductives with
-  | Some v -> v
-  | None ->
-    anomaly Pp.(str "Inductive " ++ MutInd.print kn ++ str" does not appear in the environment.")
 
-let lookup_mind kn env =
-  pi1 (lookup_mind_key kn env)
+let missing_ind kn =
+  anomaly Pp.(str "Inductive " ++ MutInd.print kn ++ str" does not appear in the environment.")
+
+let lookup_mind kn env = match Mindmap_env.find_opt kn env.env_inductives with
+| None -> missing_ind kn
+| Some (mib, _, _) -> mib
+
+let lookup_mind_key kn env = match Mindmap_env.find_opt kn env.env_inductives with
+| None -> missing_ind kn
+| Some (_, key, _) -> key
+
+let lookup_mind_canonical kn env = match Mindmap_env.find_opt kn env.env_inductives with
+| None -> missing_ind kn
+| Some (_, _, can) -> can
 
 let ind_relevance kn env = match Indmap_env.find_opt kn env.irr_inds with
 | None -> Sorts.Relevant
@@ -267,6 +361,13 @@ let ind_relevance kn env = match Indmap_env.find_opt kn env.irr_inds with
     [instantiate_context u subst nas ctx] applies both [u] and [subst] to [ctx]
     while replacing names using [nas] (order reversed)
 *)
+
+let get_template_instance mib u = match mib.mind_template with
+| None -> u
+| Some templ ->
+  let () = assert (UVars.Instance.is_empty u) in
+  templ.template_defaults
+
 let instantiate_context u subst nas ctx =
   let open Context.Rel.Declaration in
   let get_binder i na =
@@ -292,11 +393,15 @@ let instantiate_context u subst nas ctx =
 
 let expand_arity (mib, mip) (ind, u) params nas =
   let open Context.Rel.Declaration in
+  let u = get_template_instance mib u in
   let paramdecl = Vars.subst_instance_context u mib.mind_params_ctxt in
   let params = Vars.subst_of_rel_context_instance paramdecl params in
   let realdecls, _ = List.chop mip.mind_nrealdecls mip.mind_arity_ctxt in
   let self =
-    let u = UVars.Instance.abstract_instance (UVars.Instance.length u) in
+    let u =
+      if Option.has_some mib.mind_template then UVars.Instance.empty
+      else UVars.Instance.abstract_instance (UVars.Instance.length u)
+    in
     let args = Context.Rel.instance mkRel 0 mip.mind_arity_ctxt in
     mkApp (mkIndU (ind, u), args)
   in
@@ -305,6 +410,7 @@ let expand_arity (mib, mip) (ind, u) params nas =
   instantiate_context u params nas realdecls
 
 let expand_branch_contexts (mib, mip) u params br =
+  let u = get_template_instance mib u in
   let paramdecl = Vars.subst_instance_context u mib.mind_params_ctxt in
   let paramsubst = Vars.subst_of_rel_context_instance paramdecl params in
   let build_one_branch i (nas, _) (ctx, _) =
@@ -333,9 +439,10 @@ let is_impredicative_set env = env.env_typing_flags.impredicative_set
 let is_impredicative_sort env = function
   | Sorts.SProp | Sorts.Prop -> true
   | Sorts.Set -> is_impredicative_set env
-  | Sorts.Type _ | Sorts.QSort _ -> false
+  | Sorts.Type _ | Sorts.VSort _ | Sorts.GSort _-> false
 
 let type_in_type env = not (typing_flags env).check_universes
+let ignore_elim_constraints env = not (typing_flags env).check_eliminations
 let deactivated_guard env = not (typing_flags env).check_guarded
 
 let indices_matter env = env.env_typing_flags.indices_matter
@@ -346,7 +453,6 @@ let set_universes g env =
   {env with env_universes=g}
 
 let qualities env = env.env_qualities
-let qvars env = QGraph.qvar_domain @@ qualities env
 
 let set_qualities g env =
   {env with env_qualities=g}
@@ -389,14 +495,18 @@ let fold_rel_context f env ~init =
 
 let named_context_of_val c = c.env_named_ctx
 
+let named_context_of_val_with_status c =
+  List.map (fun d -> var_status_ctxt ~check:false (NamedDecl.get_id d) c, d) c.env_named_ctx
+
 let ids_of_named_context_val c = Id.Map.domain c.env_named_map
 
 let empty_named_context = Context.Named.empty
 
-let push_named_context = List.fold_right push_named
+let push_named_context = List.fold_right (fun (status,d) env -> push_named status d env)
 
 let val_of_named_context ctxt =
-  List.fold_right push_named_context_val ctxt empty_named_context_val
+  List.fold_right (fun (status,d) ctxt -> push_named_context_val status d ctxt)
+    ctxt empty_named_context_val
 
 
 let eq_named_context_val c1 c2 =
@@ -437,15 +547,18 @@ let pop_rel_context n env =
     env_rel_context = skip n ctxt;
     env_nb_rel = env.env_nb_rel - n }
 
-let fold_named_context f env ~init =
-  let rec fold_right env =
-    match match_named_context_val env.env_named_context with
+let fold_named_context_val f sign ~init =
+  let rec fold_right sign =
+    match match_named_context_val sign with
     | None -> init
-    | Some (d, rem) ->
-        let env =
-          reset_with_named_context rem env in
-        f env d (fold_right env)
-  in fold_right env
+    | Some (status, d, rem) ->
+      f rem status d (fold_right rem)
+  in fold_right sign
+
+let fold_named_context f env ~init =
+  fold_named_context_val (fun sign status d acc ->
+      f (reset_with_named_context sign env) status d acc)
+    (named_context_val env) ~init
 
 let fold_named_context_reverse f ~init env =
   Context.Named.fold_inside f ~init:init (named_context env)
@@ -500,10 +613,12 @@ let add_universes_set ~strict (lvl, cstr) g =
 let push_context_set ?(strict=false) ctx env =
   map_universes (add_universes_set ~strict ctx) env
 
-let push_qualities ~rigid (qs, qcsts) env =
-  let () = assert Sorts.QVar.Set.(is_empty @@ inter qs (QGraph.qvar_domain env.env_qualities)) in
-  let fold v = QGraph.add_quality (Sorts.Quality.QVar v) in
-  let g = Sorts.QVar.Set.fold fold qs env.env_qualities in
+let push_qualities qs env =
+  let () = assert Sorts.Quality.Set.(is_empty @@ inter qs (QGraph.domain env.env_qualities)) in
+  let g = Sorts.Quality.Set.fold QGraph.add_quality qs env.env_qualities in
+  set_qualities g env
+
+let merge_elim_constraints ~rigid qcsts env =
   let merge g =
     let g = QGraph.merge_constraints qcsts g in
     if rigid then
@@ -511,28 +626,71 @@ let push_qualities ~rigid (qs, qcsts) env =
       Sorts.ElimConstraints.fold fold qcsts g
     else g
   in
-  map_qualities merge @@ set_qualities g env
+  map_qualities merge env
+
+(** [restrict_subgraph l c] produces [c'] such that [c + (Set <= l)] imply [c'],
+    [c'] does not mention any of the levels in [l],
+    and any constraint between levels not in [l] which is implied by [c + (Set <= l)]
+    is also implied by [c'].
+
+    We then rely on the fact that for any constraint set [d] which does not mention levels in [l],
+    any constraint between levels not in [l] which is implied by [d + c + (Set <= l)]
+    is also implied by [d + c'].
+    Therefore if [d] implies [c'] then [c] adds no new constraints between non-[l] levels.
+
+    (Given a path in [d + c + (Set <= l)], we can separate it in
+    segments in [d] and segments in [c + (Set <= l)] where the
+    endpoints of each segment are not in [l]. Then the non-[d]
+    segments can be replaced by paths in [c'].)
+*)
+let restrict_subgraph levels univ_csts =
+  let g = UGraph.initial_universes in
+  let mentioned_univs =
+    Univ.UnivConstraints.fold (fun (u,_,v) acc ->
+        Univ.Level.Set.(add u (add v acc)))
+      univ_csts
+      (* do not forget Set: if we have preexisting univ u and new univ v with v < u,
+         this implies Set < u.
+         (in other words we have implicit Set <= v constraints for every new v) *)
+      (Univ.Level.Set.singleton Univ.Level.set)
+  in
+  let g = Univ.Level.Set.fold (fun v g ->
+      if Univ.Level.is_set v then g else UGraph.add_universe ~strict:false v g)
+      mentioned_univs g
+  in
+  (* having to merge_constraints twice (here and in add_subgraph) is
+     not great but better than having to crawl the full env's graph to
+     check the subgraph property *)
+  let g = UGraph.merge_constraints univ_csts g in
+  let kept = Univ.Level.Set.diff mentioned_univs levels in
+  UGraph.constraints_for ~kept g
 
 let push_subgraph (levels, univ_csts) env =
   let add_subgraph g =
     let newg = Univ.Level.Set.fold (fun v g -> UGraph.add_universe ~strict:false v g) levels g in
     let newg = UGraph.merge_constraints univ_csts newg in
-    (if not (Univ.UnivConstraints.is_empty univ_csts) then
-       let restricted = UGraph.constraints_for ~kept:(UGraph.domain g) newg in
-       (if not (UGraph.check_constraints restricted g) then
-          CErrors.anomaly Pp.(str "Local constraints imply new transitive constraints.")));
+    let () =
+      if not (Univ.UnivConstraints.is_empty univ_csts) then
+        let restricted = restrict_subgraph levels univ_csts in
+        (if not (UGraph.check_constraints restricted g) then
+           CErrors.anomaly Pp.(str "Local constraints imply new transitive constraints."))
+    in
     newg
   in
   map_universes add_subgraph env
 
+let push_subgraph us env = NewProfile.profile "push_subgraph" (fun () -> push_subgraph us env) ()
+
 (* It's convenient to use [{flags with foo = bar}] so we're smart wrt to it. *)
 let same_flags {
      check_guarded;
      check_positive;
      check_universes;
+     check_eliminations;
      conv_oracle;
      indices_matter;
      share_reduction;
+     unfold_dep_heuristic;
      enable_VM;
      enable_native_compiler;
      impredicative_set;
@@ -542,9 +700,11 @@ let same_flags {
   check_guarded == alt.check_guarded &&
   check_positive == alt.check_positive &&
   check_universes == alt.check_universes &&
+  check_eliminations == alt.check_eliminations &&
   conv_oracle == alt.conv_oracle &&
   indices_matter == alt.indices_matter &&
   share_reduction == alt.share_reduction &&
+  unfold_dep_heuristic == alt.unfold_dep_heuristic &&
   enable_VM == alt.enable_VM &&
   enable_native_compiler == alt.enable_native_compiler &&
   impredicative_set == alt.impredicative_set &&
@@ -552,13 +712,21 @@ let same_flags {
   allow_uip == alt.allow_uip
 [@warning "+9"]
 
+let check_flags c =
+  assert (Coq_config.bytecode_compiler || not c.enable_VM);
+  assert (match Coq_config.native_compiler with
+      | NativeOff -> not c.enable_native_compiler
+      | NativeOn _ -> true)
+
 let set_type_in_type b = map_universes (UGraph.set_type_in_type b)
 
 let set_typing_flags c env =
   if same_flags env.env_typing_flags c then env
   else
+    let () = check_flags c in
     let env = { env with env_typing_flags = c } in
     let env = set_type_in_type (not c.check_universes) env in
+    let env = { env with env_qualities = QGraph.set_ignore_constraints (not c.check_eliminations) env.env_qualities } in
     env
 
 let update_typing_flags ?typing_flags env =
@@ -607,7 +775,15 @@ let add_constant_key kn cb linkinfo env =
       Cmap_env.add kn [] env.symb_pats
     | _ -> env.symb_pats
   in
-  { env with constant_hyps; irr_constants; symb_pats; env_constants = new_constants }
+  let constant_deps =
+    (* when replacing a previous constant, invalidate the cache *)
+    if Cmap_env.mem kn env.env_constants then DepCache.empty
+    else match CEphemeron.get env.constant_deps with
+    | cache -> cache
+    | exception CEphemeron.InvalidKey -> DepCache.empty
+  in
+  let constant_deps = CEphemeron.create @@ DepCache.fresh constant_deps in
+  { env with constant_hyps; irr_constants; symb_pats; env_constants = new_constants; constant_deps }
 
 let add_constant kn cb env =
   add_constant_key kn cb no_link_info env
@@ -753,7 +929,7 @@ let get_projection env ind ~proj_arg =
 
 let get_projections env ind =
   let mib = lookup_mind (fst ind) env in
-  Option.map fst @@ Declareops.inductive_make_projections ind mib
+  Declareops.inductive_make_projections ind mib
 
 (* Mutual Inductives *)
 let polymorphic_ind (mind,_i) env =
@@ -913,12 +1089,13 @@ let apply_to_hyp ctxt id f =
   let open Context.Named.Declaration in
   let rec aux rtail ctxt =
     match match_named_context_val ctxt with
-    | Some (d, ctxt) ->
-        if Id.equal (get_id d) id then
-          push_named_context_val (f ctxt.env_named_ctx d rtail) ctxt
-        else
-          let ctxt' = aux (d::rtail) ctxt in
-          push_named_context_val d ctxt'
+    | Some (status, d, ctxt) ->
+      if Id.equal (get_id d) id then
+        let status, d' = f ctxt.env_named_ctx status d rtail in
+        push_named_context_val status d' ctxt
+      else
+        let ctxt' = aux (d::rtail) ctxt in
+        push_named_context_val status d ctxt'
     | None -> raise Hyp_not_found
   in aux [] ctxt
 
@@ -928,7 +1105,7 @@ let remove_hyps ids check_context ctxt =
     if Id.Set.is_empty ids then ctxt, false
     else match match_named_context_val ctxt with
     | None -> empty_named_context_val, false
-    | Some (d, rctxt) ->
+    | Some (status, d, rctxt) ->
       let id0 = Context.Named.Declaration.get_id d in
       let removed = Id.Set.mem id0 ids in
       let ids = if removed then Id.Set.remove id0 ids else ids in
@@ -937,10 +1114,10 @@ let remove_hyps ids check_context ctxt =
       else if not seen then ctxt, false
       else
         let rctxt' = ans in
-        let d' = check_context d in
-        if d == d' && rctxt == rctxt' then
+        let status', d' = check_context status d in
+        if status == status' && d == d' && rctxt == rctxt' then
           ctxt, true
-        else push_named_context_val d' rctxt', true
+        else push_named_context_val status' d' rctxt', true
   in
   fst (remove_hyps ids ctxt)
 
@@ -970,6 +1147,9 @@ let is_type_in_type env r =
   | IndRef ind -> type_in_type_ind ind env
   | ConstructRef cstr -> type_in_type_ind (inductive_of_constructor cstr) env
 
+let ind_ignores_elim_constraints env (mind, _) =
+  not (lookup_mind mind env).mind_typing_flags.check_eliminations
+
 let vm_library env = env.vm_library
 
 let set_vm_library lib env =
@@ -1071,6 +1251,36 @@ end
 
 module QGlobRef = HackQ(GlobRef)(GlobRef.Map_env)
 
+let rec constant_dependencies_with_cache env cache kn =
+  match DepCache.get kn cache with
+  | Inl deps -> deps
+  | Inr set ->
+    match Cmap_env.find_opt kn env.env_constants with
+    | None -> Cset_env.empty
+    | Some (body, _, _) ->
+      let deps = match body.const_body with
+      | Def c ->
+        let rec compute_dependencies accu c = match kind c with
+        | Const (kn, _) ->
+          Cset_env.fold Cset_env.add (constant_dependencies_with_cache env cache kn) (Cset_env.add kn accu)
+        | _ -> Constr.fold compute_dependencies accu c
+        in
+        compute_dependencies Cset_env.empty c
+      | Undef _ | OpaqueDef _ | Primitive _ | Symbol _ -> Cset_env.empty
+      in
+      let () = set deps in
+      deps
+
+let constant_dependencies env kn =
+  let cache =
+    try CEphemeron.get env.constant_deps
+    with CEphemeron.InvalidKey -> DepCache.empty
+  in
+  constant_dependencies_with_cache env cache kn
+
+let constant_depends_on env cst1 cst2 =
+  Cset_env.mem cst2 (constant_dependencies env cst1)
+
 module Internal = struct
   let push_template_context uctx env =
     let () = check_ucontext uctx env in
@@ -1084,30 +1294,32 @@ module Internal = struct
   module View =
   struct
     type t = {
-      env_constants : constant_key Cmap_env.t;
-      env_inductives : mind_key Mindmap_env.t;
+      env_constants : constant_body Cmap_env.t;
+      env_inductives : mutual_inductive_body Mindmap_env.t;
       env_modules : module_body ModPath.Map.t;
       env_modtypes : module_type_body ModPath.Map.t;
-      env_named_context : named_context_val;
-      env_rel_context   : rel_context_val;
+      env_named_context : named_context;
+      env_rel_context   : rel_context;
       env_universes : UGraph.t;
-      env_qualities : Sorts.QVar.Set.t;
+      env_qualities : Sorts.Quality.Set.t;
       env_symb_pats : machine_rewrite_rule list Cmap_env.t;
       env_typing_flags  : typing_flags;
     }
 
     let view (env : env) = {
-      env_constants = env.env_constants;
-      env_inductives = env.env_inductives;
+      env_constants = Cmap_env.map (fun (cb, _, _) -> cb) env.env_constants;
+      env_inductives = Mindmap_env.map (fun (mib, _, _) -> mib) env.env_inductives;
       env_modtypes = env.env_modtypes;
       env_modules = env.env_modules;
-      env_named_context = env.env_named_context;
-      env_rel_context = env.env_rel_context;
+      env_named_context = env.env_named_context.env_named_ctx;
+      env_rel_context = env.env_rel_context.env_rel_ctx;
       env_universes = env.env_universes;
-      env_qualities = QGraph.qvar_domain env.env_qualities;
+      env_qualities = QGraph.domain env.env_qualities;
       env_symb_pats = env.symb_pats;
       env_typing_flags = env.env_typing_flags;
     } [@@ocaml.warning "-42"]
+    (* It does not matter that this is linear in the size of the environment
+       since we only use for serialization purposes, which is already linear. *)
 
   end
 
diff --git a/kernel/environ.mli b/kernel/environ.mli
index 06c8f5e11c94..b712e764aa07 100644
--- a/kernel/environ.mli
+++ b/kernel/environ.mli
@@ -37,22 +37,9 @@ type link_info =
 
 type key = int CEphemeron.key option ref
 
-type constant_key = constant_body * (link_info ref * key) * KerName.t
+type named_context_val
 
-type mind_key = mutual_inductive_body * link_info ref * KerName.t
-
-type named_context_val = private {
-  env_named_ctx : Constr.named_context;
-  env_named_map : Constr.named_declaration Id.Map.t;
-  (** Identifier-indexed version of [env_named_ctx] *)
-  env_named_idx : Constr.named_declaration Range.t;
-  (** Same as env_named_ctx but with a fast-access list. *)
-}
-
-type rel_context_val = private {
-  env_rel_ctx : Constr.rel_context;
-  env_rel_map : Constr.rel_declaration Range.t;
-}
+type rel_context_val
 
 type env
 (** Type of global environments. *)
@@ -77,11 +64,11 @@ val set_universes : UGraph.t -> env -> env
 val set_qualities : QGraph.t -> env -> env
 
 val qualities : env -> QGraph.t
-val qvars : env -> Sorts.QVar.Set.t
 
 val typing_flags    : env -> typing_flags
 val is_impredicative_set : env -> bool
 val type_in_type : env -> bool
+val ignore_elim_constraints : env -> bool
 val deactivated_guard : env -> bool
 val indices_matter : env -> bool
 
@@ -104,6 +91,7 @@ val empty_rel_context_val : rel_context_val
 (** Looks up in the context of local vars referred by indice ([rel_context])
    raises [Not_found] if the index points out of the context *)
 val lookup_rel    : int -> env -> Constr.rel_declaration
+val lookup_rel_ctxt : int -> rel_context_val -> Constr.rel_declaration
 val evaluable_rel : int -> env -> bool
 val env_of_rel     : int -> env -> env
 
@@ -114,24 +102,34 @@ val fold_rel_context :
 
 (** {5 Context of variables (section variables and goal assumptions) } *)
 
+type var_status = SecVar | ProofVar
+
+val var_status_eq : var_status -> var_status -> bool
+
+val var_status_ctxt : ?check:bool -> Id.t -> named_context_val -> var_status
+val var_status : ?check:bool -> Id.t -> env -> var_status
+
 val named_context_of_val : named_context_val -> Constr.named_context
-val val_of_named_context : Constr.named_context -> named_context_val
+val val_of_named_context : (var_status * Constr.named_declaration) list -> named_context_val
 val empty_named_context_val : named_context_val
 val ids_of_named_context_val : named_context_val -> Id.Set.t
+val named_context_of_val_with_status : named_context_val -> (var_status * named_declaration) list
 
 
 (** [map_named_val f ctxt] apply [f] to the body and the type of
    each declarations.
-   *** /!\ ***   [f t] should be convertible with t, and preserve the name *)
+   *** /!\ ***   [f t] must preserve the name *)
 val map_named_val :
-   (named_declaration -> named_declaration) -> named_context_val -> named_context_val
+  (var_status -> named_declaration -> var_status * named_declaration) ->
+  named_context_val -> named_context_val
 
-val push_named : Constr.named_declaration -> env -> env
-val push_named_context : Constr.named_context -> env -> env
+val push_named : var_status -> Constr.named_declaration -> env -> env
+val push_named_context : (var_status * Constr.named_declaration) list -> env -> env
 val push_named_context_val  :
-    Constr.named_declaration -> named_context_val -> named_context_val
+  var_status -> Constr.named_declaration -> named_context_val -> named_context_val
 
 
+val mem_named_ctxt : variable -> named_context_val -> bool
 val mem_named : variable -> env -> bool
 
 (** Looks up in the context of local vars referred by names ([named_context])
@@ -139,16 +137,23 @@ val mem_named : variable -> env -> bool
 
 val lookup_named     : variable -> env -> Constr.named_declaration
 val lookup_named_ctxt : variable -> named_context_val -> Constr.named_declaration
+val lookup_named_ctxt_pos : int -> named_context_val -> Constr.named_declaration
+val nb_named : named_context_val -> int
 val evaluable_named  : variable -> env -> bool
 val named_type : variable -> env -> types
 val named_body : variable -> env -> constr option
 
 (** {6 Recurrence on [named_context]: older declarations processed first } *)
 
+val fold_named_context_val :
+  (named_context_val -> var_status -> Constr.named_declaration -> 'a -> 'a) ->
+  named_context_val -> init:'a -> 'a
+
 val fold_named_context :
-  (env -> Constr.named_declaration -> 'a -> 'a) -> env -> init:'a -> 'a
+  (env -> var_status -> Constr.named_declaration -> 'a -> 'a) ->
+  env -> init:'a -> 'a
 
-val match_named_context_val : named_context_val -> (named_declaration * named_context_val) option
+val match_named_context_val : named_context_val -> (var_status * named_declaration * named_context_val) option
 
 (** Recurrence on [named_context] starting from younger decl *)
 val fold_named_context_reverse :
@@ -173,12 +178,13 @@ val fold_inductives : (MutInd.t -> Declarations.mutual_inductive_body -> 'a -> '
 val add_constant : Constant.t -> constant_body -> env -> env
 val add_constant_key : Constant.t -> constant_body -> link_info ->
   env -> env
-val lookup_constant_key :  Constant.t -> env -> constant_key
 
 (** Looks up in the context of global constant names
    raises an anomaly if the required path is not found *)
 val lookup_constant    : Constant.t -> env -> constant_body
 val lookup_constant_opt : Constant.t -> env -> constant_body option
+val lookup_constant_key :  Constant.t -> env -> link_info ref * key
+val lookup_constant_canonical :  Constant.t -> env -> KerName.t
 val evaluable_constant : Constant.t -> env -> bool
 val constant_relevance : Constant.t -> env -> Sorts.relevance
 
@@ -243,7 +249,7 @@ val get_projection : env -> inductive -> proj_arg:int -> Names.Projection.Repr.t
 val get_projections : env -> inductive -> (Names.Projection.Repr.t * Sorts.relevance) array option
 
 (** {5 Inductive types } *)
-val lookup_mind_key : MutInd.t -> env -> mind_key
+val lookup_mind_key : MutInd.t -> env -> link_info ref
 val add_mind_key : MutInd.t -> mutual_inductive_body -> link_info -> env -> env
 val add_mind : MutInd.t -> mutual_inductive_body -> env -> env
 
@@ -251,6 +257,9 @@ val add_mind : MutInd.t -> mutual_inductive_body -> env -> env
    raises an anomaly if the required path is not found *)
 val lookup_mind : MutInd.t -> env -> mutual_inductive_body
 
+(** Returns the canonical name of the inductive *)
+val lookup_mind_canonical : MutInd.t -> env -> KerName.t
+
 val mem_mind : MutInd.t -> env -> bool
 
 val ind_relevance : inductive -> env -> Sorts.relevance
@@ -271,11 +280,13 @@ val template_polymorphic_pind : pinductive -> env -> bool
 (** {6 Changes of representation of Case nodes} *)
 
 (** Given an inductive type and its parameters, builds the context of the return
-    clause, including the inductive being eliminated. The additional binder
-    array is only used to set the names of the context variables, we use the
-    less general type to make it easy to use this function on Case nodes. *)
+    clause, including the inductive being eliminated.
+
+    The additional binder array is only used to set the names of the
+    context variables, we use the less general type to make it easy to
+    use this function on Case nodes. *)
 val expand_arity : Declarations.mind_specif -> pinductive -> constr array ->
-  Name.t binder_annot array -> rel_context
+  (Name.t, _) Context.pbinder_annot array -> rel_context
 
 (** Given an inductive type and its parameters, builds the context of the return
     clause, including the inductive being eliminated. The additional binder
@@ -392,11 +403,15 @@ val push_context_set : ?strict:bool -> Univ.ContextSet.t -> env -> env
     context set to the environment. It does not fail even if one of the
     universes is already declared. *)
 
-val push_qualities : rigid:bool -> Sorts.QContextSet.t -> env -> env
+val push_qualities : Sorts.Quality.Set.t -> env -> env
 (** [push_qualities qs env] pushes the set of quality variables and constraints
     in the environment. It fails if a quality variable is already
     declared. *)
 
+val merge_elim_constraints : rigid:bool -> Sorts.ElimConstraints.t -> env -> env
+(** [merge_elim_constraints ~rigid qcsts env] adds the elimination
+    constraints to the graph, rigidly if [rigid]. *)
+
 val push_subgraph : Univ.ContextSet.t -> env -> env
 (** [push_subgraph univs env] adds the universes and constraints in
    [univs] to [env] as [push_context_set ~strict:false univs env], and
@@ -464,15 +479,17 @@ exception Hyp_not_found
    return [tail::(f head (id,_,_) (rev tail))::head].
    the value associated to id should not change *)
 val apply_to_hyp : named_context_val -> variable ->
-  (Constr.named_context -> Constr.named_declaration -> Constr.named_context -> Constr.named_declaration) ->
+  (Constr.named_context -> var_status -> Constr.named_declaration -> Constr.named_context -> var_status * Constr.named_declaration) ->
     named_context_val
 
-val remove_hyps : Id.Set.t -> (Constr.named_declaration -> Constr.named_declaration) -> named_context_val -> named_context_val
+val remove_hyps : Id.Set.t -> (var_status -> Constr.named_declaration -> var_status * Constr.named_declaration) -> named_context_val -> named_context_val
 
 val is_polymorphic : env -> Names.GlobRef.t -> bool
 val is_template_polymorphic : env -> GlobRef.t -> bool
 val is_type_in_type : env -> GlobRef.t -> bool
 
+val ind_ignores_elim_constraints : env -> inductive -> bool
+
 (** {5 VM and native} *)
 
 val vm_library : env -> Vmlibrary.t
@@ -487,6 +504,15 @@ val no_link_info : link_info
 val set_retroknowledge : env -> Retroknowledge.retroknowledge -> env
 val retroknowledge : env -> Retroknowledge.retroknowledge
 
+(** {5 Dependency analysis} *)
+
+(** [constant_depends_on c1 c2] is true when [c2] appears in the transitive set of
+    constants reachable from the body of [c1]. Axioms, opaque definitions,
+    and primitives have no body and thus no dependencies. *)
+val constant_depends_on : env -> Constant.t -> Constant.t -> bool
+
+(** {5 Internals} *)
+
 module Internal : sig
   (** Makes the qvars treated as above prop.
       Do not use outside kernel inductive typechecking. *)
@@ -497,14 +523,14 @@ module Internal : sig
   module View :
   sig
     type t = {
-      env_constants : constant_key Cmap_env.t;
-      env_inductives : mind_key Mindmap_env.t;
+      env_constants : constant_body Cmap_env.t;
+      env_inductives : mutual_inductive_body Mindmap_env.t;
       env_modules : module_body ModPath.Map.t;
       env_modtypes : module_type_body ModPath.Map.t;
-      env_named_context : named_context_val;
-      env_rel_context   : rel_context_val;
+      env_named_context : named_context;
+      env_rel_context   : rel_context;
       env_universes : UGraph.t;
-      env_qualities : Sorts.QVar.Set.t;
+      env_qualities : Sorts.Quality.Set.t;
       env_symb_pats : machine_rewrite_rule list Cmap_env.t;
       env_typing_flags  : typing_flags;
     }
diff --git a/kernel/genlambda.ml b/kernel/genlambda.ml
index 0c6fa358fc2c..5164c897f44c 100644
--- a/kernel/genlambda.ml
+++ b/kernel/genlambda.ml
@@ -70,13 +70,6 @@ let pp_names ids =
 let pp_rel name n =
   Name.print name ++  str "##" ++ int n
 
-let pp_sort s =
-  match s with
-  | Sorts.Set -> str "Set"
-  | Sorts.Prop -> str "Prop"
-  | Sorts.SProp -> str "SProp"
-  | Sorts.Type _ | Sorts.QSort _ -> str "Type"
-
 let pr_con sp = str(Names.Id.to_string (Constant.label sp))
 
 let rec pp_lam lam =
@@ -166,7 +159,7 @@ let rec pp_lam lam =
   | Lfloat f -> str (Float64.to_string f)
   | Lstring s -> str (Printf.sprintf "%S" (Pstring.to_string s))
   | Lval _ -> str "values"
-  | Lsort s -> pp_sort s
+  | Lsort s -> Sorts.raw_pr s
   | Lind ((mind,i), _) -> MutInd.print mind ++ str"#" ++ int i
   | Lprim ((kn,_u),_op,args) ->
      hov 1
@@ -525,7 +518,7 @@ let rec remove_let subst lam =
   | 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 && is_value body then remove_let (cons def' subst) body
+    if is_value body && 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 mknode @@ Llet(id,def',body')
@@ -543,7 +536,7 @@ let rec get_alias env sigma kn =
   let tps = cb.const_body_code in
   match tps with
   | Vmemitcodes.BCalias kn' -> get_alias env sigma kn'
-  | Vmemitcodes.BCconstant -> kn, [||]
+  | Vmemitcodes.BCconstant | BCuncompiled -> kn, [||]
   | Vmemitcodes.BCdefined (mask, _, _) -> kn, mask
 
 (* Translation of constructors *)
@@ -782,7 +775,9 @@ and lambda_of_app cache env sigma f args =
       begin match cb.const_body with
       | Primitive op -> lambda_of_prim env c op (lambda_of_args cache env sigma 0 args)
       | Def csubst -> (* TODO optimize if f is a proj and argument is known *)
-        if cb.const_inline_code then lambda_of_app cache env sigma csubst args
+        if cb.const_inline_code then
+          let csubst = Vars.subst_instance_constr u csubst in
+          lambda_of_app cache env sigma csubst args
         else
           (* Erase unused arguments *)
           let mapi i arg =
diff --git a/kernel/indTyping.ml b/kernel/indTyping.ml
index 8e46f75bf2cb..2956272c72c0 100644
--- a/kernel/indTyping.ml
+++ b/kernel/indTyping.ml
@@ -69,6 +69,8 @@ let mind_check_names env mie =
 
 type record_arg_info =
   | NoRelevantArg
+  | MaybeRelevantArg
+  (** At least one arg with variable relevance. *)
   | HasRelevantArg
   (** HasRelevantArg means when the record is relevant at least one arg is relevant.
       When the record is in a polymorphic sort this can mean one arg is in the same sort. *)
@@ -82,61 +84,47 @@ type univ_info =
   }
 
 let add_squash q info =
-  match info.ind_squashed with
-  | None -> { info with ind_squashed = Some (SometimesSquashed (Sorts.Quality.Set.singleton q)) }
-  | Some AlwaysSquashed -> info
-  | Some (SometimesSquashed qs) ->
-    (* XXX dedup insertion *)
-    { info with ind_squashed = Some (SometimesSquashed (Sorts.Quality.Set.add q qs)) }
+  match q, Sorts.quality info.ind_univ with
+  | Sorts.Quality.QVar _, _ | _, QVar _ ->
+    begin match info.ind_squashed with
+    | None -> { info with ind_squashed = Some (SometimesSquashed (Sorts.Quality.Set.singleton q)) }
+    | Some AlwaysSquashed -> info
+    | Some (SometimesSquashed qs) ->
+      (* XXX dedup insertion *)
+      { info with ind_squashed = Some (SometimesSquashed (Sorts.Quality.Set.add q qs)) }
+    end
+  | _ ->
+    (* no qvar involved: no instantiation can resolve this constraint *)
+    { info with ind_squashed = Some AlwaysSquashed }
 
 let compute_elim_squash ?(is_real_arg=false) env u info =
   let open Sorts.Quality in
   let info = if not is_real_arg then info
     else match info.record_arg_info with
       | HasRelevantArg -> info
-      | NoRelevantArg -> match u with
-        | Sorts.SProp -> info
-        | QSort (q,_) ->
-           if Environ.Internal.is_above_prop env q
-              || equal (QVar q) (Sorts.quality info.ind_univ)
+      | NoRelevantArg | MaybeRelevantArg ->
+        match Sorts.relevance_of_sort u with
+        | Irrelevant -> info
+        | Relevant -> { info with record_arg_info = HasRelevantArg }
+        | RelevanceVar q ->
+          if Environ.Internal.is_above_prop env q
+          || equal (QVar q) (Sorts.quality info.ind_univ)
           then { info with record_arg_info = HasRelevantArg }
-          else info
-        | Prop | Set | Type _ -> { info with record_arg_info = HasRelevantArg }
-  in
-  if (Environ.type_in_type env) then info
-  else
-    let indu = info.ind_univ
-    and check_univ_consistency f induu uu =
-      if UGraph.check_leq (universes env) uu induu
-      then f info
-      else { info with missing = u :: info.missing } in
-    if Inductive.eliminates_to (Environ.qualities env) (Sorts.quality indu) (Sorts.quality u) then
-          if Sorts.Quality.is_impredicative (Sorts.quality indu)
-          then
-            match u with
-            | Type _ | Set -> { info with ind_squashed = Some AlwaysSquashed }
-            | QSort (q, _) -> add_squash (Sorts.Quality.QVar q) info
-            | SProp | Prop -> info
-          else check_univ_consistency (fun x -> x)
-                 (Sorts.univ_of_sort indu)
-                 (Sorts.univ_of_sort u)
-    else
-      let check_univ_consistency_squash quality =
-        check_univ_consistency (add_squash quality) in
-      match indu, u with
-      | QSort (_, indu), Type uu ->
-         check_univ_consistency_squash qtype indu uu
-      | QSort (_, indu), QSort (cq, uu) ->
-         check_univ_consistency_squash (QVar cq) indu uu
-      | QSort (q, indu), Set ->
-         if Environ.Internal.is_above_prop env q then info
-         else check_univ_consistency_squash qtype indu Universe.type0
-      | (SProp | Prop), QSort (q, _) ->
-         add_squash (QVar q) info
-      | QSort (q, _), (SProp | Prop) ->
-         if Environ.Internal.is_above_prop env q then info
-         else add_squash (Sorts.quality u) info
-      | _, _ -> { info with ind_squashed = Some AlwaysSquashed }
+          else { info with record_arg_info = MaybeRelevantArg }
+  in
+  if Environ.ignore_elim_constraints env then info else
+  let indu = info.ind_univ in
+
+  if not @@ UGraph.check_leq (universes env) (Sorts.univ_of_sort u) (Sorts.univ_of_sort indu) then
+    if Environ.is_impredicative_sort env indu then add_squash (Sorts.quality u) info
+    else { info with missing = u :: info.missing }
+  else if Inductive.eliminates_to (Environ.qualities env) (Sorts.quality indu) (Sorts.quality u) then
+    info
+  else match indu, u with
+    (* XXX add a constraint q -> Prop in push_template_context,
+       then we don't need this above_prop test *)
+    | VSort (q, _), (SProp | Prop) when Environ.Internal.is_above_prop env q -> info
+    | _ -> add_squash (Sorts.quality u) info
 
 let check_context_univs ~ctor env info ctx =
   let check_one d (info,env) =
@@ -151,13 +139,28 @@ let check_context_univs ~ctor env info ctx =
   in
   fst (Context.Rel.fold_outside ~init:(info,env) check_one ctx)
 
+let eq_squashed a b =
+  match a, b with
+  | SometimesSquashed a, SometimesSquashed b -> Sorts.Quality.Set.equal a b
+  | AlwaysSquashed, AlwaysSquashed -> true
+  | (SometimesSquashed _ | AlwaysSquashed), _ -> false
+
 let check_indices_matter env_params info indices =
-  if not (indices_matter env_params) then info
-  else check_context_univs ~ctor:false env_params info indices
+  let with_indices = check_context_univs ~ctor:false env_params info indices in
+  let relies_on_indices_not_mattering =
+    not (Option.equal eq_squashed info.ind_squashed with_indices.ind_squashed)
+    || not (List.equal Sorts.equal info.missing with_indices.missing)
+  in
+  if indices_matter env_params then
+    (* indices constraints are enforced, so this inductive does not
+       rely on indices not mattering *)
+    (with_indices, false)
+  else
+    (info, relies_on_indices_not_mattering)
 
 (* env_ar contains the inductives before the current ones in the block, and no parameters *)
-let check_arity ~template env_params env_ar ind =
-  let {utj_val=arity;utj_type=_} = Typeops.infer_type env_params ind.mind_entry_arity in
+let check_arity ~template env_params env_ar (na, arity) =
+  let {utj_val=arity;utj_type=_} = Typeops.infer_type env_params arity in
   let indices, ind_sort = Reduction.dest_arity env_params arity in
   let univ_info = {
     ind_squashed=None;
@@ -167,13 +170,12 @@ let check_arity ~template env_params env_ar ind =
     missing=[];
   }
   in
-  let univ_info = check_indices_matter env_params univ_info indices in
   (* We do not need to generate the universe of the arity with params;
      if later, after the validation of the inductive definition,
      full_arity is used as argument or subject to cast, an upper
      universe will be generated *)
   let arity = it_mkProd_or_LetIn arity (Environ.rel_context env_params) in
-  let x = Context.make_annot (Name ind.mind_entry_typename) (Sorts.relevance_of_sort ind_sort) in
+  let x = Context.make_annot (Name na) (Sorts.relevance_of_sort ind_sort) in
   push_rel (LocalAssum (x, arity)) env_ar,
   (arity, indices, univ_info)
 
@@ -181,7 +183,7 @@ let check_constructor_univs env_ar_par info (args,_) =
   (* We ignore the output, positivity will check that it's the expected inductive type *)
   check_context_univs ~ctor:true env_ar_par info args
 
-let check_constructors env_ar_par isrecord params lc (arity,indices,univ_info) =
+let check_constructors ~env_params ~env_ar_par isrecord params lc (arity,indices,univ_info) =
   let lc = Array.map_of_list (fun c -> (Typeops.infer_type env_ar_par c).utj_val) lc in
   let splayed_lc = Array.map (Reduction.whd_decompose_prod_decls env_ar_par) lc in
   let univ_info =
@@ -215,7 +217,8 @@ let check_constructors env_ar_par isrecord params lc (arity,indices,univ_info) =
   in
   (* generalize the constructors over the parameters *)
   let lc = Array.map (fun c -> Term.it_mkProd_or_LetIn c params) lc in
-  (arity, lc), (indices, splayed_lc), univ_info
+  let univ_info, relies_on_indices_not_mattering = check_indices_matter env_params univ_info indices in
+  (arity, lc), (indices, splayed_lc), univ_info, relies_on_indices_not_mattering
 
 module NotPrimRecordReason = struct
 
@@ -228,9 +231,9 @@ module NotPrimRecordReason = struct
 end
 
 (* Checks whether the record can have primitive projections, and if so, whether it has eta *)
-let check_record data =
+let check_record ~ignore_elim data =
   let open NotPrimRecordReason in
-  List.fold_left (fun res (_, (_, splayed_lc), info) ->
+  List.fold_left (fun res (_, (_, splayed_lc), info, _) ->
       if Result.is_error res then res
       else if Option.has_some info.ind_squashed
       (* records must have all projections definable -> equivalent to not being squashed *)
@@ -254,14 +257,20 @@ let check_record data =
         match res with
         | Some reason -> Result.Error reason
         | None -> (* Otherwise, we allow primitive projections but check if it has eta *)
+            if ignore_elim then Result.Ok AlwaysEta else
             match info.record_arg_info with
             | HasRelevantArg -> Result.Ok AlwaysEta
+            | MaybeRelevantArg ->
+              begin match info.ind_univ with
+              | SProp -> Result.Ok AlwaysEta
+              | _ -> Result.Ok MaybeEta
+              end
             | NoRelevantArg ->
               (* If there is no relevant projection, then we consider the sort of the record to decide if it has eta *)
               match info.ind_univ with
               | SProp -> Result.Ok AlwaysEta
-              | Set | Type _ | Prop -> Result.Ok NoEta (* Set, Type and Prop don't have eta *)
-              | QSort _ ->  Result.Ok NoEta (* For sort variables it now defaults to not having eta *)
+              | GSort _ | Set | Type _ | Prop -> Result.Ok NoEta (* relevant sorts don't have eta *)
+              | VSort _ ->  Result.Ok MaybeEta (* For sort variables it depends on the instantiation *)
     )
     (Result.Ok NoEta)
     data
@@ -308,7 +317,7 @@ let get_template_binding_arity ~template_univs c =
   match kind c with
   | Sort (Type u as s) ->
     Some (decls, None, check_level u, s)
-  | Sort (QSort (q, u) as s) ->
+  | Sort (VSort (q, u) as s) ->
     (* XXX check if q is a template qvar in anticipation of global qvars existing *)
     Some (decls, Some q, check_level u, s)
   | _ -> None
@@ -327,14 +336,10 @@ let check_no_increment ~template_univs u =
     CErrors.user_err
       Pp.(str "Template polymorphism with conclusion strictly larger than a bound universe not supported.")
 
-let make_template_univ_names (u:UVars.Instance.t) : UVars.bound_names =
-  let qlen, ulen = UVars.Instance.length u in
-  {quals = Array.make qlen Anonymous; univs = Array.make ulen Anonymous}
-
 let get_template (mie:mutual_inductive_entry) = match mie.mind_entry_universes with
-| Monomorphic_ind_entry | Polymorphic_ind_entry _ -> mie, None, None
+| Monomorphic_ind_entry | Polymorphic_ind_entry _ -> None
 | Template_ind_entry {uctx; default_univs} ->
-  let ((template_qvars, _), (template_univs, _ as template_uctx) as template_context) =
+  let ((template_qvars, _), (template_univs, _ as template_uctx)) =
     UVars.UContext.to_context_set uctx
   in
   let params = mie.mind_entry_params in
@@ -345,11 +350,8 @@ let get_template (mie:mutual_inductive_entry) = match mie.mind_entry_universes w
   in
   let () = check_unbounded_from_below template_uctx in
 
-  let template_context =
-    UVars.UContext.of_context_set make_template_univ_names template_context
-  in
   let template_abstract, template_context =
-    let inst, ctx = UVars.abstract_universes template_context in
+    let inst, ctx = UVars.abstract_universes uctx in
     UVars.make_instance_subst inst, ctx
   in
 
@@ -359,7 +361,10 @@ let get_template (mie:mutual_inductive_entry) = match mie.mind_entry_universes w
      The inductive and binding parameter types must be syntactically arities. *)
   let check_not_appearing c =
     let qs, us = Vars.sort_and_universes_of_constr c in
-    let qappearing = Sorts.QVar.Set.inter qs template_qvars in
+    let qappearing =
+      Sorts.QVar.Set.filter (fun qv -> Sorts.Quality.Set.mem (QVar qv) qs)
+        template_qvars
+    in
     if not (Sorts.QVar.Set.is_empty qappearing) then
       CErrors.user_err
         Pp.(str "Template " ++
@@ -437,11 +442,11 @@ let get_template (mie:mutual_inductive_entry) = match mie.mind_entry_universes w
     let s = destSort s in
     let () = match s with
     | SProp | Prop | Set -> ()
-    | QSort (_, u) ->
+    | VSort (_, u) ->
       (* typechecking will fail with "unbound qvar" if the quality isn't in template_qvars *)
       check_no_increment ~template_univs u;
       ()
-    | Type u ->
+    | GSort (_, u) | Type u ->
       check_no_increment ~template_univs u;
       ()
     in
@@ -459,72 +464,26 @@ let get_template (mie:mutual_inductive_entry) = match mie.mind_entry_universes w
       assums
   in
 
-  (* Substitution from the template binders to the default univs (and qtype for the qvars)
-     XXX can this be simplified by composing template_abstract and default_univs?
-     don't forget to check the default_univs qualities are all QType if so *)
-  let template_usubst : UVars.sort_level_subst =
+  (* don't forget to check the default_univs qualities are all QType *)
+  let () =
     let bind_instance = UVars.UContext.instance uctx in
     let () = if not UVars.(eq_sizes (Instance.length bind_instance) (Instance.length default_univs))
-      then CErrors.anomaly Pp.(str "Inorrect default template universes declaration.")
+      then CErrors.anomaly Pp.(str "Incorrect default template universes declaration.")
     in
     let bind_qs, bind_us = UVars.Instance.to_array bind_instance in
-    let default_qs, default_us = UVars.Instance.to_array default_univs in
-    let qsubst = Array.fold_left2 (fun qsubst bind_q default_q ->
-        let open Sorts.Quality in
-        match bind_q, default_q with
-        | QConstant _, _ -> assert false
-        | QVar bind_q, QConstant QType ->
-          Sorts.QVar.Map.add bind_q default_q qsubst
-        | QVar _, _ -> CErrors.anomaly Pp.(str "Default template quality must be QType."))
-        Sorts.QVar.Map.empty
-        bind_qs default_qs
-    in
-    let usubst = Array.fold_left2 (fun usubst bind_u default_u ->
-        assert (not @@ Level.is_set bind_u);
-        Level.Map.add bind_u default_u usubst)
-        Level.Map.empty
-        bind_us default_us
-    in
-    qsubst, usubst
+    let default_qs, _ = UVars.Instance.to_array default_univs in
+    let () = assert (Array.for_all Sorts.Quality.is_qvar bind_qs) in
+    let () = assert (Array.for_all Sorts.Quality.is_qtype default_qs) in
+    assert (Array.for_all (fun bind_u -> not @@ Level.is_set bind_u) bind_us)
   in
 
-  mie, Some template_usubst, Some {
+  Some {
     template_param_arguments;
     template_context;
     template_concl;
     template_defaults = default_univs;
   }
 
-let abstract_packets env usubst ((arity,lc),(indices,splayed_lc),univ_info) =
-  if not (List.is_empty univ_info.missing)
-  then raise (InductiveError (env, MissingUnivConstraints (univ_info.missing,univ_info.ind_univ)));
-  let arity = Vars.subst_univs_level_constr usubst arity in
-  let lc = Array.map (Vars.subst_univs_level_constr usubst) lc in
-  let indices = Vars.subst_univs_level_context usubst indices in
-  let splayed_lc = Array.map (fun (args,out) ->
-      let args = Vars.subst_univs_level_context usubst args in
-      let out = Vars.subst_univs_level_constr usubst out in
-      args,out)
-      splayed_lc
-  in
-  let ind_univ = UVars.subst_sort_level_sort usubst univ_info.ind_univ in
-
-  let arity = {user_arity = arity; sort = ind_univ} in
-
-  let squashed = Option.map (function
-      | AlwaysSquashed -> AlwaysSquashed
-      | SometimesSquashed qs ->
-        let qs = Sorts.Quality.Set.fold (fun q qs ->
-            Sorts.Quality.Set.add (UVars.subst_sort_level_quality usubst q) qs)
-            qs
-            Sorts.Quality.Set.empty
-        in
-        SometimesSquashed qs)
-      univ_info.ind_squashed
-  in
-
-  (arity,lc), (indices,splayed_lc), squashed
-
 let typecheck_inductive env ~sec_univs (mie:mutual_inductive_entry) =
   let () = match mie.mind_entry_inds with
   | [] -> CErrors.anomaly Pp.(str "empty inductive types declaration.")
@@ -535,17 +494,24 @@ let typecheck_inductive env ~sec_univs (mie:mutual_inductive_entry) =
   assert (List.is_empty (Environ.rel_context env));
 
   (* universes *)
-  let mie, template_usubst, template = get_template mie in
+  let template = get_template mie in
 
-  let env_univs =
-    match mie.mind_entry_universes with
-    | Template_ind_entry {uctx; default_univs=_} ->
-      Environ.Internal.push_template_context uctx env
-    | Monomorphic_ind_entry -> env
-    | Polymorphic_ind_entry ctx ->
-      let () = check_ucontext ctx env in
-      let env = push_context ctx env in
-      env
+  (* Abstract universes *)
+  let env_univs, usubst, univs = match mie.mind_entry_universes with
+  | Monomorphic_ind_entry ->
+    env, UVars.empty_sort_subst, Monomorphic
+  | Template_ind_entry { uctx; _ } ->
+    let (inst, _) = UVars.abstract_universes uctx in
+    let usubst = UVars.make_instance_subst inst in
+    let template = Option.get template in
+    let env = Environ.Internal.push_template_context (AbstractContext.repr template.template_context) env in
+    env, usubst, Monomorphic
+  | Polymorphic_ind_entry uctx ->
+    let (inst, auctx) = UVars.abstract_universes uctx in
+    let usubst = UVars.make_instance_subst inst in
+    let () = check_ucontext (AbstractContext.repr auctx) env in
+    let env = Environ.push_context (AbstractContext.repr auctx) env in
+    env, usubst, Polymorphic auctx
   in
 
   let has_template_poly = match mie.mind_entry_universes with
@@ -554,10 +520,15 @@ let typecheck_inductive env ~sec_univs (mie:mutual_inductive_entry) =
   in
 
   (* Params *)
-  let env_params, params = Typeops.check_context env_univs mie.mind_entry_params in
+  let params = Vars.subst_univs_level_context usubst mie.mind_entry_params in
+  let env_params, params = Typeops.check_context env_univs params in
 
   (* Arities *)
-  let env_ar, data = List.fold_left_map (check_arity ~template:has_template_poly env_params) env_univs mie.mind_entry_inds in
+  let check_arity env_univs mib =
+    let arity = Vars.subst_univs_level_constr usubst mib.mind_entry_arity in
+    check_arity ~template:has_template_poly env_params env_univs (mib.mind_entry_typename, arity)
+  in
+  let env_ar, data = List.fold_left_map check_arity env_univs mie.mind_entry_inds in
   let env_ar_par = push_rel_context params env_ar in
 
   (* Constructors *)
@@ -565,25 +536,32 @@ let typecheck_inductive env ~sec_univs (mie:mutual_inductive_entry) =
     | Some (Some _) -> true
     | Some None | None -> false
   in
-  let data = List.map2 (fun ind data ->
-      check_constructors env_ar_par isrecord params ind.mind_entry_lc data)
-      mie.mind_entry_inds data
+  let map ind data =
+    let ctyp = List.map (fun t -> Vars.subst_univs_level_constr usubst t) ind.mind_entry_lc in
+    check_constructors ~env_params ~env_ar_par isrecord params ctyp data
   in
+  let data = List.map2 map mie.mind_entry_inds data in
 
   let record = mie.mind_entry_record in
   let data, record, not_prim_reason_or_has_eta = match record with
     | None | Some None -> data, record, None (* NotRecord or FakeRecord *)
     | Some (Some _) -> (* PrimRecord *)
       (* We check if it can actually have primitive projections & eta *)
-      match check_record data with
-      | Result.Ok has_eta -> data, record, Some (Result.Ok has_eta)
+      match check_record ~ignore_elim:(Environ.ignore_elim_constraints env_ar_par) data with
+      | Result.Ok has_eta ->
+        let has_eta = match mie.mind_entry_finite with
+          | BiFinite -> has_eta
+          | Finite | CoFinite -> NoEta
+        in
+        data, record, Some (Result.Ok has_eta)
       | Result.Error _ as reason ->
         (* if someone tried to declare a record as SProp but it can't
            be primitive we must squash. *)
-        let data = List.map (fun (a, b, univs) ->
-            a, b, compute_elim_squash env_ar_par Sorts.prop univs)
-            data
+        let map (a, b, univs, im) =
+          let univs = compute_elim_squash env_ar_par Sorts.prop univs in
+          (a, b, univs, im)
         in
+        let data = List.map map data in
         data, Some None, Some reason (* back to FakeRecord with a reason why *)
   in
 
@@ -595,7 +573,7 @@ let typecheck_inductive env ~sec_univs (mie:mutual_inductive_entry) =
         CErrors.user_err Pp.(str "Inductive cannot be both monomorphic and universe cumulative.")
       | Polymorphic_ind_entry uctx ->
         (* no variance for qualities *)
-        let _qualities, univs = Instance.to_array @@ UContext.instance uctx in
+        let _qualities, univs = Instance.to_array @@ subst_sort_level_instance usubst @@ UContext.instance uctx in
         let univs = Array.map2 (fun a b -> a,b) univs variances in
         let univs = match sec_univs with
           | None -> univs
@@ -606,33 +584,22 @@ let typecheck_inductive env ~sec_univs (mie:mutual_inductive_entry) =
             Array.append sec_univs univs
         in
         let variances = InferCumulativity.infer_inductive ~env_params ~env_ar_par
-            ~arities:(List.map (fun e -> e.mind_entry_arity) mie.mind_entry_inds)
-            ~ctors:(List.map (fun e -> e.mind_entry_lc) mie.mind_entry_inds)
+            ~arities:(List.map (fun e -> Vars.subst_univs_level_constr usubst e.mind_entry_arity) mie.mind_entry_inds)
+            ~ctors:(List.map (fun e -> List.map (fun c -> Vars.subst_univs_level_constr usubst c) e.mind_entry_lc) mie.mind_entry_inds)
             univs
         in
         Some variances
   in
 
-  (* Abstract universes *)
-  let usubst, univs = match mie.mind_entry_universes with
-  | Monomorphic_ind_entry ->
-    UVars.empty_sort_subst, Monomorphic
-  | Template_ind_entry _ ->
-    let usubst = Option.get template_usubst in
-    usubst, Monomorphic
-  | Polymorphic_ind_entry uctx ->
-    let (inst, auctx) = UVars.abstract_universes uctx in
-    let inst = UVars.make_instance_subst inst in
-    (inst, Polymorphic auctx)
+  let check_packet env (_, _, univ_info, _) =
+    if not (List.is_empty univ_info.missing)
+    then raise (InductiveError (env, MissingUnivConstraints (univ_info.missing,univ_info.ind_univ)));
   in
-  let params = Vars.subst_univs_level_context usubst params in
-  let data = List.map (abstract_packets env usubst) data in
-
-  let env_ar_par =
-    let ctx = Environ.rel_context env_ar_par in
-    let ctx = Vars.subst_univs_level_context usubst ctx in
-    let env = Environ.pop_rel_context (Environ.nb_rel env_ar_par) env_ar_par in
-    Environ.push_rel_context ctx env
+  let () = List.iter (fun pkt -> check_packet env pkt) data in
+  let map ((arity, lc), b, univs, relies_on_indices_not_mattering) =
+    let arity = { user_arity = arity; sort = univs.ind_univ } in
+    ((arity, lc), b, univs.ind_squashed, relies_on_indices_not_mattering)
   in
+  let data = List.map map data in
 
   env_ar_par, univs, template, variance, record, not_prim_reason_or_has_eta, params, Array.of_list data
diff --git a/kernel/indTyping.mli b/kernel/indTyping.mli
index 1b2a149ab314..b22ebaf3f340 100644
--- a/kernel/indTyping.mli
+++ b/kernel/indTyping.mli
@@ -50,5 +50,6 @@ val typecheck_inductive : env -> sec_univs:UVars.Instance.t option
   * Constr.rel_context
   * ((inductive_arity * Constr.types array) *
      (Constr.rel_context * (Constr.rel_context * Constr.types) array) *
-     squash_info option)
+     squash_info option *
+     bool (** true if the inductive relies on indices not mattering *))
     array
diff --git a/kernel/indtypes.ml b/kernel/indtypes.ml
index 44a13d462084..58c79b4bfc0a 100644
--- a/kernel/indtypes.ml
+++ b/kernel/indtypes.ml
@@ -63,6 +63,20 @@ type ill_formed_ind =
 
 exception IllFormedInd of ill_formed_ind
 
+type rdecl =
+| Toplevel of wf_paths (* The inductive being checked *)
+| Nesting of wf_paths (* A nested inductive node *)
+| FlatNesting (* Nesting over a non-recursive type *)
+| Other (* No recursion *)
+
+(* In the above type, all wf_paths are guaranteed to be free variables *)
+
+let lift_rdecl = function
+| Toplevel path -> Toplevel (Rtree.lift 1 path)
+| Nesting path -> Nesting (Rtree.lift 1 path)
+| FlatNesting -> FlatNesting
+| Other -> Other
+
 (* [mind_extract_params mie] extracts the params from an inductive types
    declaration, and checks that they are all present (and all the same)
    for all the given types. *)
@@ -152,10 +166,17 @@ if Int.equal nmr 0 then 0 else
      (i.e. range of inductives is [n; n+ntypes-1])
    [lra] is the list of recursive tree of each variable
  *)
-let ienv_push_var (env, n, ntypes, lra) (x,a,ra) =
-  (push_rel (LocalAssum (x,a)) env, n+1, ntypes, (Norec,ra)::lra)
+let ienv_push_var (env, n, ntypes, lra) (x, a) =
+  (push_rel (LocalAssum (x, a)) env, n+1, ntypes, Other :: lra)
 
-let ienv_push_inductive (env, n, ntypes, ra_env) ((mi,u),lrecparams) =
+let is_recursive = function
+| BiFinite -> false
+| Finite | CoFinite -> true
+
+let ienv_push_inductive (env, n, ntypes, ra_env) ((mi, u), lrecparams, finite) =
+  let isrec = is_recursive finite in
+  (* Only non-mutual inductive types are allowed for nesting *)
+  let () = assert (Int.equal (snd mi) 0) in
   let auxntyp = 1 in
   let specif = (lookup_mind_specif env mi, u) in
   let ty = type_of_inductive specif in
@@ -165,8 +186,9 @@ let ienv_push_inductive (env, n, ntypes, ra_env) ((mi,u),lrecparams) =
     let decl = LocalAssum (anon, hnf_prod_applist env ty lrecparams) in
     push_rel decl env in
   let ra_env' =
-    (Mrec (RecArgInd mi),(Rtree.mk_rec_calls 1).(0)) ::
-    List.map (fun (r,t) -> (r,Rtree.lift 1 t)) ra_env in
+    if isrec then Nesting (Rtree.mk_rec_calls 1).(0) :: List.map lift_rdecl ra_env
+    else FlatNesting :: ra_env
+  in
   (* New index of the inductive types *)
   let newidx = n + auxntyp in
   (env', newidx, ntypes, ra_env')
@@ -176,7 +198,7 @@ let rec ienv_decompose_prod (env,_,_,_ as ienv) n c =
     let c' = whd_all env c in
     match kind c' with
         Prod(na,a,b) ->
-          let ienv' = ienv_push_var ienv (na,a,mk_norec) in
+          let ienv' = ienv_push_var ienv (na, a) in
           ienv_decompose_prod ienv' (n-1) b
       | _ -> assert false
 
@@ -195,7 +217,7 @@ let array_min nmr a = if Int.equal nmr 0 then 0 else
     If [chkpos] is [false] then positivity is assumed, and
     [check_positivity_one] computes the subterms occurrences in a
     best-effort fashion. *)
-let check_positivity_one ~chkpos recursive (env,_,ntypes,_ as ienv) paramsctxt (mind,i as ind) nnonrecargs lcnames indlc =
+let check_positivity_one ~chkpos recursive (env,_,ntypes,_ as ienv) paramsctxt (_, i as ind) nnonrecargs lcnames indlc =
   let nparamsctxt = Context.Rel.length paramsctxt in
   let nmr = Context.Rel.nhyps paramsctxt in
   (** Positivity of one argument [c] of a constructor (i.e. the
@@ -215,30 +237,32 @@ let check_positivity_one ~chkpos recursive (env,_,ntypes,_ as ienv) paramsctxt (
               | None when chkpos ->
                   failwith_non_pos_list n ntypes [b]
               | None ->
-                  check_strict_positivity (ienv_push_var ienv (na, b, mk_norec)) nmr d
+                  check_strict_positivity (ienv_push_var ienv (na, b)) nmr d
               | Some b ->
-                  check_strict_positivity (ienv_push_var ienv (na, b, mk_norec)) nmr d)
+                  check_strict_positivity (ienv_push_var ienv (na, b)) nmr d)
         | Rel k ->
             (match List.nth_opt ra_env (k-1) with
-            | Some (ra,rarg) ->
-            let largs = List.map (whd_all env) largs in
-            let nmr1 =
-              (match ra with
-                (* Are we referring to the original block of mutual inductive types? *)
-                | Mrec (RecArgInd (mind',_)) ->
-                  if Names.MutInd.CanOrd.equal mind mind'
-                  then compute_rec_par ienv paramsctxt nmr largs
-                  else nmr
-                | Norec | Mrec (RecArgPrim _) -> nmr)
-            in
+            | Some rdecl ->
+              let largs = List.map (whd_all env) largs in
               (** The case where one of the inductives of the mutually
                   inductive block occurs as an argument of another is not
                   known to be safe. So Rocq rejects it. *)
               if chkpos &&
                  not (List.for_all (noccur_between n ntypes) largs)
               then failwith_non_pos_list n ntypes largs
-              else (nmr1,rarg)
-            | None -> (nmr,mk_norec))
+              (* Are we referring to the original block of mutual inductive types? *)
+              else begin match rdecl with
+              | Toplevel rarg ->
+                let nmr1 = compute_rec_par ienv paramsctxt nmr largs in
+                (nmr1, rarg)
+              | Nesting rarg -> nmr, rarg
+              | FlatNesting ->
+                (* Nesting on an inductive that is not recursive, the corresponding
+                   variable cannot appear in the body of that type *)
+                assert false
+              | Other -> nmr, mk_norec
+              end
+            | None -> assert false)
         | Ind ind_kn ->
             (** If one of the inductives of the mutually inductive
                 block being defined appears in a parameter, then we
@@ -286,7 +310,7 @@ let check_positivity_one ~chkpos recursive (env,_,ntypes,_ as ienv) paramsctxt (
         let auxlcvect = abstract_mind_lc auxntyp auxnrecpar mind mip.mind_nf_lc in
           (* Extends the environment with a variable corresponding to
              the inductive def *)
-        let (env',_,_,_ as ienv') = ienv_push_inductive ienv ((ind,u),auxrecparams) in
+        let (env',_,_,_ as ienv') = ienv_push_inductive ienv ((ind, u), auxrecparams, mib.mind_finite) in
           (* Parameters expressed in env' *)
         let auxrecparams' = List.map (lift auxntyp) auxrecparams in
         let irecargs_nmr =
@@ -306,16 +330,21 @@ let check_positivity_one ~chkpos recursive (env,_,ntypes,_ as ienv) paramsctxt (
         let irecargs = Array.map snd irecargs_nmr
         and nmr' = array_min nmr irecargs_nmr
         in
-          (nmr',(Rtree.mk_rec [|mk_paths (Mrec (RecArgInd ind)) irecargs|]).(0))
+        let rtree =
+          if is_recursive mib.mind_finite then
+            (Rtree.mk_rec [|mk_paths (Mrec (RecArgInd ind)) irecargs|]).(0)
+          else mk_paths (Mrec (RecArgInd ind)) irecargs
+        in
+        (nmr', rtree)
 
   and check_positivity_nested_primitive (env,n,ntypes,ra_env) nmr (c, largs) =
     (* We model the primitive type c X1 ... Xn as if it had one constructor
        C : X1 -> ... -> Xn -> c X1 ... Xn
        The subterm relation is defined for each primitive in `inductive.ml`. *)
-    let ra_env = List.map (fun (r,t) -> (r,Rtree.lift 1 t)) ra_env in
     let ienv = (env,n,ntypes,ra_env) in
     let nmr',recargs = List.fold_left_map (check_strict_positivity ienv) nmr largs in
-    (nmr', (Rtree.mk_rec [| mk_paths (Mrec (RecArgPrim c)) [| recargs |] |]).(0))
+    (* Arrays are not recursive types, [mk_node] suffices *)
+    (nmr', mk_paths (Mrec (RecArgPrim c)) [| recargs |])
 
   (** [check_constructors ienv check_head nmr c] checks the positivity
       condition in the type [c] of a constructor (i.e. that recursive
@@ -335,7 +364,7 @@ let check_positivity_one ~chkpos recursive (env,_,ntypes,_ as ienv) paramsctxt (
               if not recursive && not (noccur_between n ntypes b) then
                 raise (InductiveError (env,Type_errors.BadEntry));
               let nmr',recarg = check_strict_positivity ienv nmr b in
-              let ienv' = ienv_push_var ienv (na,b,mk_norec) in
+              let ienv' = ienv_push_var ienv (na, b) in
                 check_constr_rec ienv' nmr' (recarg::lrec) d
           | hd ->
             let () =
@@ -375,15 +404,14 @@ let check_positivity_one ~chkpos recursive (env,_,ntypes,_ as ienv) paramsctxt (
     best-effort fashion. *)
 let check_positivity ~chkpos kn names env_ar_par paramsctxt finite inds =
   let ntypes = Array.length inds in
-  let recursive = finite != BiFinite in
+  let recursive = is_recursive finite in
   if not recursive && Array.length inds <> 1 then raise (InductiveError (env_ar_par,Type_errors.BadEntry));
-  let rc = Array.mapi (fun j t -> (Mrec (RecArgInd (kn,j)),t)) (Rtree.mk_rec_calls ntypes) in
+  let rc = Array.map (fun t -> Toplevel t) (Rtree.mk_rec_calls ntypes) in
   let ra_env_ar = Array.rev_to_list rc in
   let nparamsctxt = Context.Rel.length paramsctxt in
   let nmr = Context.Rel.nhyps paramsctxt in
   let check_one i (_,lcnames) (nindices,lc) =
-    let ra_env_ar_par =
-      List.init nparamsctxt (fun _ -> (Norec,mk_norec)) @ ra_env_ar in
+    let ra_env_ar_par = List.init nparamsctxt (fun _ -> Other) @ ra_env_ar in
     let ienv = (env_ar_par, 1+nparamsctxt, ntypes, ra_env_ar_par) in
     check_positivity_one ~chkpos recursive ienv paramsctxt (kn,i) nindices lcnames lc
   in
@@ -398,7 +426,7 @@ let check_positivity ~chkpos kn names env_ar_par paramsctxt finite inds =
 (* Build the inductive packet *)
 
 let fold_inductive_blocks f acc inds =
-  Array.fold_left (fun acc ((arity,lc),_,_) ->
+  Array.fold_left (fun acc ((arity,lc),_,_,_) ->
       f (Array.fold_left f acc lc) arity.IndTyping.user_arity)
     acc inds
 
@@ -475,7 +503,7 @@ let build_inductive env ~sec_univs names prv univs template variance
   let u = UVars.make_abstract_instance (universes_context univs) in
   let subst = List.init ntypes (fun i -> mkIndU ((kn, ntypes - i - 1), u)) in
   (* Check one inductive *)
-  let build_one_packet i (id,cnames) ((arity,lc),(indices,splayed_lc),squashed) recarg =
+  let build_one_packet i (id,cnames) ((arity,lc),(indices,splayed_lc),squashed,relies_on_indices_not_mattering) recarg =
     let lc = Array.map (substl subst) lc in
     (* Type of constructors in normal form *)
     let nf_lc =
@@ -488,7 +516,18 @@ let build_inductive env ~sec_univs names prv univs template variance
     let consnrealargs =
       Array.map (fun (d,_) -> Context.Rel.nhyps d)
         splayed_lc in
-    let mind_relevance = Sorts.relevance_of_sort arity.IndTyping.sort in
+    let mind_relevance = match template with
+    | None -> Sorts.relevance_of_sort arity.IndTyping.sort
+    | Some templ ->
+      match templ.template_concl with
+      | Sorts.Prop | Sorts.Set | Sorts.Type _ -> Sorts.Relevant
+      | Sorts.SProp -> Sorts.Irrelevant
+      | Sorts.VSort _ ->
+        (* Template inductive types are currently either constant or always
+          relevant, otherwise we'd need the template parameters to compute the relevance *)
+        Sorts.Relevant
+      | Sorts.GSort _ -> assert false
+    in
     let mind_record = match isrecord with
       | Some (Some rid) ->
         (** The elimination criterion ensures that all projections can be defined. *)
@@ -515,6 +554,10 @@ let build_inductive env ~sec_univs names prv univs template variance
            les tag des constructeur non constant a 1 (0 => accumulator) *)
     in
     let rtbl = Array.map transf consnrealargs in
+    let automaton =
+      let automaton = Rtree.Automaton.make recarg in
+      Rtree.Automaton.compact compare_recarg automaton
+    in
       (* Build the inductive packet *)
       { mind_typename = id;
         mind_record;
@@ -529,8 +572,9 @@ let build_inductive env ~sec_univs names prv univs template variance
         mind_consnrealargs = consnrealargs;
         mind_user_lc = lc;
         mind_nf_lc = nf_lc;
-        mind_recargs = recarg;
+        mind_automaton = automaton;
         mind_relevance;
+        mind_relies_on_indices_not_mattering = relies_on_indices_not_mattering;
         mind_nb_constant = !nconst;
         mind_nb_args = !nblock;
         mind_reloc_tbl = rtbl;
@@ -581,7 +625,7 @@ let check_inductive env ~sec_univs kn mie =
   in
   let (nmr,recargs) = check_positivity ~chkpos kn names
       env_ar_par paramsctxt mie.mind_entry_finite
-      (Array.map (fun ((_,lc),(indices,_),_) -> Context.Rel.nhyps indices,lc) inds)
+      (Array.map (fun ((_,lc),(indices,_),_,_) -> Context.Rel.nhyps indices,lc) inds)
   in
   (* Build the inductive packets *)
   let mib =
diff --git a/kernel/inductive.ml b/kernel/inductive.ml
index 1ce2cc6509c2..bc6f0e7cf0e6 100644
--- a/kernel/inductive.ml
+++ b/kernel/inductive.ml
@@ -52,7 +52,14 @@ let find_coinductive ?evars env c =
 
 let inductive_params (mib,_) = mib.mind_nparams
 
+let get_template_instance mib u = match mib.mind_template with
+| None -> u
+| Some templ ->
+  let () = assert (UVars.Instance.is_empty u) in
+  templ.template_defaults
+
 let inductive_paramdecls (mib,u) =
+  let u = get_template_instance mib u in
   Vars.subst_instance_context u mib.mind_params_ctxt
 
 let inductive_nnonrecparams mib = mib.mind_nparams - mib.mind_nparams_rec
@@ -85,8 +92,9 @@ let instantiate_params t u args sign =
   substl subs ty
 
 let full_constructor_instantiate (_,u,(mib,_),params) t =
+  let u = get_template_instance mib u in
   let inst_ind = subst_instance_constr u t in
-   instantiate_params inst_ind u params mib.mind_params_ctxt
+  instantiate_params inst_ind u params mib.mind_params_ctxt
 
 (************************************************************************)
 (************************************************************************)
@@ -132,7 +140,9 @@ let template_univ_quality = function
 let max_template_quality a b =
   let open Sorts.Quality in
   match a, b with
-  | QConstant QSProp, _ | _, QConstant QSProp -> assert false
+  | QConstant QSProp, _ | _, QConstant QSProp
+  | QGlobal _, _ | _, QGlobal _ ->
+    assert false
   | QConstant QProp, q | q, QConstant QProp -> q
   | (QConstant QType as q), _ | _, (QConstant QType as q) -> q
   | QVar a', QVar b' ->
@@ -150,11 +160,11 @@ let univ_bind_kind u =
 
 let bind_kind = let open Sorts in function
   | SProp | Prop | Set -> assert false
-  | Type u ->
+  | Type u | GSort (_, u) ->
     let u = univ_bind_kind u in
     assert (Option.has_some u);
     None, u
-  | QSort (q,u) ->
+  | VSort (q,u) ->
     let q = Sorts.QVar.var_index q in
     let u = univ_bind_kind u in
     assert (Option.has_some q || Option.has_some u);
@@ -243,9 +253,9 @@ let template_subst_universe (_,usubst) u =
 
 let template_subst_sort (subst : template_subst) = function
 | Sorts.Prop | Sorts.Set | Sorts.SProp as s -> s
-| Sorts.Type u ->
-  Sorts.sort_of_univ (template_subst_universe subst u)
-| Sorts.QSort (q,u) ->
+| Sorts.Type u | Sorts.GSort (_, u) as s ->
+  Sorts.make (Sorts.quality s) (template_subst_universe subst u)
+| Sorts.VSort (q,u) ->
   let q = match Sorts.QVar.var_index q with
     | None -> Sorts.Quality.QVar q
     | Some q -> Int.Map.get q (fst subst)
@@ -273,7 +283,7 @@ let instantiate_template_constraints subst templ =
   let cstrs = UVars.UContext.constraints (UVars.AbstractContext.repr templ.template_context) in
   let foldq (q, cst, q') accq =
     let substq q = match q with
-      | Quality.QConstant _ -> q
+      | Quality.QConstant _ | Quality.QGlobal _ -> q
       | Quality.QVar q' ->
          begin
            match QVar.var_index q' with
@@ -374,14 +384,16 @@ let constrained_type_of_constructor cstru ind =
 let type_of_constructor_knowing_parameters cstr specif args =
   type_of_constructor_gen cstr specif args
 
-let arities_of_constructors (_,u) (_,mip) =
+let arities_of_constructors (_, u) (mib, mip) =
+  let u = get_template_instance mib u in
   let map (ctx, c) =
     let cty = Term.it_mkProd_or_LetIn c ctx in
     subst_instance_constr u cty
   in
   Array.map map mip.mind_nf_lc
 
-let type_of_constructors (_,u) (_,mip) =
+let type_of_constructors (_, u) (mib, mip) =
+  let u = get_template_instance mib u in
   Array.map (subst_instance_constr u) mip.mind_user_lc
 
 let abstract_constructor_type_relatively_to_inductive_types_context ntyps mind t =
@@ -439,7 +451,7 @@ let allowed_elimination_gen g nf_quality actions specifu s =
   | Some SquashToSet ->
     begin match s with
       | SProp|Prop|Set -> actions.squashed_to_set_below
-      | QSort _ | Type _ -> actions.squashed_to_set_above
+      | GSort _ | VSort _ | Type _ -> actions.squashed_to_set_above
     end
   | Some (SquashToQuality indq) -> actions.squashed_to_quality indq
 
@@ -523,7 +535,10 @@ let expand_case env (ci, _, _, _, _, _, _ as case) =
 
 let contract_case env (ci, (p,rp), iv, c, br) =
   let (mib, mip) = lookup_mind_specif env ci.ci_ind in
-  let (arity, p) = Term.decompose_lambda_n_decls (mip.mind_nrealdecls + 1) p in
+  let (arity, p) = match Term.decompose_lambda_n_decls_opt (mip.mind_nrealdecls + 1) p with
+    | Some v -> v
+    | None -> CErrors.anomaly Pp.(str "contract_case: not enough abstractions in return predicate.")
+  in
   let (u, pms) = match arity with
   | LocalAssum (_, ty) :: _ ->
     (** Last binder is the self binder for the term being eliminated *)
@@ -542,7 +557,11 @@ let contract_case env (ci, (p,rp), iv, c, br) =
     ((nas, p),rp)
   in
   let map i br =
-    let (ctx, br) = Term.decompose_lambda_n_decls mip.mind_consnrealdecls.(i) br in
+    let (ctx, br) = match Term.decompose_lambda_n_decls_opt mip.mind_consnrealdecls.(i) br with
+      | Some v -> v
+      | None ->
+        CErrors.anomaly Pp.(fmt "contract_case: not enough abstractions in branch %d." i)
+    in
     let nas = Array.of_list (List.rev_map get_annot ctx) in
     (nas, br)
   in
@@ -633,218 +652,282 @@ let contract_cofix (bodynum,(_,_,bodies as typedbodies)) =
    first argument.
 *)
 
-(*************************************************************)
-(* Environment annotated with marks on recursive arguments *)
 
-(* tells whether it is a strict or loose subterm *)
-type size = Large | Strict
+(************************************************************************)
+(* Subterm information *)
 
-(* merging information *)
-let size_glb s1 s2 =
-  match s1,s2 with
-      Strict, Strict -> Strict
-    | _ -> Large
-
-(* possible specifications for a term:
-   - Not_subterm: when the size of a term is not related to the
-     recursive argument of the fixpoint
-   - Internally_bound_subterm: when the recursive call is in a subterm
-     of a redex and the recursive argument is bound to a variable
-     which will be instantiated by reducing the redex; the integers
-     refer to the number of redexes stacked, with 1 counting for the
-     variables bound at head in the body of the fix (as e.g. [x] in
-     [fix f n := fun x => f x]); there may be several such indices
-     because [match] subterms may have combine several results;
-   - Subterm: when the term is a subterm of the recursive argument
-       the wf_paths argument specifies which subterms are recursive;
-     the [int list] is used in the [match] case where one branch of
-     the [match] might be a subterm but (an arbitrary number of)
-     others are calls to bound variables
-   - Dead_code: when the term has been built by elimination over an
-       empty type
- *)
-
-type subterm_spec =
-    Subterm of (Int.Set.t * size * wf_paths)
-  | Dead_code
-  | Not_subterm
-  | Internally_bound_subterm of Int.Set.t
-
-let is_norec_path t = match Rtree.dest_head t with
+module WfPaths :
+sig
+type t
+val lookup_subterms : env -> inductive -> t
+val lookup_mutual_subterms : env -> MutInd.t -> t array
+val inter : t -> t -> t
+val restrict : t -> wf_paths -> t
+val dest_subterm : t -> int -> int -> t
+val dest_subterms : t -> t array array
+val is_norec : t -> bool
+val is_inductive : env -> inductive -> t -> bool
+val is_primitive_positive_container : env -> Constant.t -> t -> bool
+val incl : t -> t -> bool
+
+end =
+struct
+
+module Atm = Rtree.Automaton
+
+type t = recarg Atm.t
+
+let lookup_subterms env ind =
+  let _, mip = lookup_mind_specif env ind in
+  mip.mind_automaton
+
+let lookup_mutual_subterms env mind =
+  let mib = Environ.lookup_mind mind env in
+  Array.map (fun mip -> mip.mind_automaton) mib.mind_packets
+
+let meet_recarg r1 r2 = match r1, r2 with
+| Mrec _, Mrec _ ->
+  let () = assert (eq_recarg r1 r2) in
+  r1
+| Norec, Norec -> Norec
+| (Norec, Mrec _) | (Mrec _, Norec) -> Norec
+
+let inter t1 t2 =
+  let automaton = Atm.inter meet_recarg t1 t2 in
+  if automaton == t1 then t1 else Atm.compact compare_recarg automaton
+
+let restrict t p =
+  let p = Atm.make p in
+  let p = Atm.compact compare_recarg p in
+  let automaton = Atm.inter meet_recarg t p in
+  Atm.compact compare_recarg automaton
+
+let dest_subterm t i j =
+  let trans = Atm.transitions t (Atm.initial t) in
+  Atm.move t trans.(i).(j)
+
+let dest_subterms t =
+  let trans = Atm.transitions t (Atm.initial t) in
+  let map v = Array.map (fun tgt -> Atm.move t tgt) v in
+  Array.map map trans
+
+let dest_recarg t =
+  Atm.data t (Atm.initial t)
+
+let is_norec t = match dest_recarg t with
 | Norec -> true
 | Mrec _ -> false
-| exception (Failure _) -> false
+| exception Failure _ ->
+  anomaly ~label:"rtree" Pp.(str "Non-closed recursive tree during guard checking.")
 
-let inter_recarg r1 r2 = if eq_recarg r1 r2 then Some r1 else None
+let is_inductive env ind t = match dest_recarg t with
+| Mrec (RecArgInd i) -> QInd.equal env ind i
+| Norec | Mrec (RecArgPrim _) -> false
 
-let inter_wf_paths = Rtree.inter Declareops.eq_recarg inter_recarg Norec
+let is_primitive_positive_container env cst t = match dest_recarg t with
+| Mrec (RecArgPrim c) -> QConstant.equal env cst c
+| Norec | Mrec _ -> false
 
-let incl_wf_paths = Rtree.incl Declareops.eq_recarg inter_recarg Norec
+let equal t1 t2 =
+  Atm.equal eq_recarg t1 t2
 
-let spec_of_tree internal t =
-  if is_norec_path t
-  then Not_subterm
-  else Subterm (internal, Strict, t)
+let incl t1 t2 =
+  equal t1 t2 ||
+  let t12 = inter t1 t2 in
+  equal t1 t12
 
-let merge_internal_subterms l1 l2 =
-  Int.Set.union l1 l2
+end
 
-let inter_spec s1 s2 =
-  match s1, s2 with
-  | _, Dead_code -> s1
-  | Dead_code, _ -> s2
-  | Not_subterm, _ -> s1
-  | _, Not_subterm -> s2
-  | Internally_bound_subterm l1, Internally_bound_subterm l2 -> Internally_bound_subterm (merge_internal_subterms l1 l2)
-  | Subterm (l1,a1,t1), Internally_bound_subterm l2 -> Subterm (merge_internal_subterms l1 l2,a1,t1)
-  | Internally_bound_subterm l1, Subterm (l2,a2,t2) -> Subterm (merge_internal_subterms l1 l2,a2,t2)
-  | Subterm (l1,a1,t1), Subterm (l2,a2,t2) ->
-     Subterm (merge_internal_subterms l1 l2, size_glb a1 a2, inter_wf_paths t1 t2)
-
-let subterm_spec_glb =
-  Array.fold_left inter_spec Dead_code
+(*************************************)
+(* Exported utilities for positivity *)
 
-type guard_env =
-  { env     : env;
-    (* dB of last fixpoint *)
-    rel_min : int;
-    (* dB of variables denoting subterms *)
-    genv    : subterm_spec Lazy.t list;
-  }
+let is_primitive_positive_container env c =
+  match (Environ.retroknowledge env).Retroknowledge.retro_array with
+  | Some c' when QConstant.equal env c c' -> true
+  | _ -> false
 
-let make_renv env recarg tree =
-  { env = env;
-    rel_min = recarg+2; (* recarg = 0 ==> Rel 1 -> recarg; Rel 2 -> fix *)
-    genv = [Lazy.from_val(Subterm(Int.Set.empty, Large,tree))] }
+(* This removes global parameters of the inductive types in lc (for
+   nested inductive types only ) *)
+let dummy_univ = Level.(make (UGlobal.make (DirPath.make [Id.of_string "implicit"]) "" 0))
+let dummy_implicit_sort = mkType (Universe.make dummy_univ)
+let lambda_implicit n a =
+  let anon = Context.make_annot Anonymous Sorts.Relevant in
+  let lambda_implicit a = mkLambda (anon, dummy_implicit_sort, a) in
+  iterate lambda_implicit n a
 
-let push_var renv (x,ty,spec) =
-  { env = push_rel (LocalAssum (x,ty)) renv.env;
-    rel_min = renv.rel_min+1;
-    genv = spec:: renv.genv }
+let abstract_mind_lc ntyps npars mind lc =
+  let lc = Array.map (fun (ctx, c) -> Term.it_mkProd_or_LetIn c ctx) lc in
+  let rec replace_ind k c =
+    let hd, args = decompose_app_list c in
+    match kind hd with
+    | Ind ((mind',i),_) when MutInd.CanOrd.equal mind mind' ->
+      let rec drop_params n = function
+        | _ :: args when n > 0 -> drop_params (n-1) args
+        | args -> lambda_implicit n (Term.applist (mkRel (ntyps+n+k-i), List.Smart.map (replace_ind (n+k)) args))
+      in
+      drop_params npars args
+    | _ -> map_with_binders succ replace_ind k c
+  in
+  Array.map (replace_ind 0) lc
 
-let push_let renv (x,c,ty,spec) =
-  { env = push_rel (LocalDef (x,c,ty)) renv.env;
-    rel_min = renv.rel_min+1;
-    genv = spec:: renv.genv }
 
-let assign_var_spec renv (i,spec) =
-  { renv with genv = List.assign renv.genv (i-1) spec }
+(*****************************************************************************)
+(* Subterm specification *)
+module Subterm : sig
 
-let push_var_renv renv n (x,ty) =
-  let spec = Lazy.from_val (if n >= 1 then Internally_bound_subterm (Int.Set.singleton n) else Not_subterm) in
-  push_var renv (x,ty,spec)
+type size = Large | Strict
 
-(* Fetch recursive information about a variable p *)
-let subterm_var p renv =
-  try Lazy.force (List.nth renv.genv (p-1))
-  with Failure _ | Invalid_argument _ -> (* outside context of the fixpoint *) Not_subterm
+(**
+  Possible specifications for a term, from most to least acceptable:
+  - DeadCode: the term has been built by elimination over an empty type;
+  - Vars l: the term is as much of a subterm as the worst of these variables;
+    variables are levels pointing to the redex stack;
+  - Subterm: the term is a [strict|large] subterm of the structural argument;
+    the argument itself is a large subterm, becomes strict after a [match];
+    the wf_paths argument specifies which constructor arguments are recursive,
+    it can never be empty or this downgrades the specification to [NotSubterm];
+    the [int set] is the same as in [Vars l];
+  - NotSubterm: the term is not a subterm in any kind **)
+type t = private
+  | DeadCode
+  | Vars of Int.Set.t
+  | Subterm of size * WfPaths.t * Int.Set.t
+  | NotSubterm
+
+val structural : WfPaths.t -> t
+val strict_subterm : WfPaths.t -> t
+
+val dead_code : t
+val not_subterm : t
+
+val internal : int -> t
+val make_internal : int -> t lazy_t -> t lazy_t
+
+type check_result =
+  | InvalidSubterm
+  | NeedReduce of Int.Set.t
 
-let push_ctxt_renv renv ctxt =
-  let n = Context.Rel.length ctxt in
-  { env = push_rel_context ctxt renv.env;
-    rel_min = renv.rel_min+n;
-    genv = iterate (fun ge -> lazy Not_subterm::ge) n renv.genv }
+val check : t -> WfPaths.t -> check_result
 
-let push_fix_renv renv (_,v,_ as recdef) =
-  let n = Array.length v in
-  { env = push_rec_types recdef renv.env;
-    rel_min = renv.rel_min+n;
-    genv = iterate (fun ge -> lazy Not_subterm::ge) n renv.genv }
+val inter_spec : t array -> t
 
-type fix_check_result =
-  | NeedReduce of env * fix_guard_error
-  | NoNeedReduce
+val on_branches : env -> inductive -> t lazy_t -> int -> t lazy_t list
 
-(* Definition and manipulation of the stack *)
-type stack_element =
-  (* arguments in the evaluation stack *)
-  (* [constr] is typed in [guard_env] and [int] is the number of
-     binders added in the current env on top of [guard_env.env] *)
-  | SClosure of fix_check_result * guard_env * int * constr
-  (* arguments applied to a "match": only their spec traverse the match *)
-  | SArg of subterm_spec Lazy.t
+val on_projection : t -> int -> t
+val on_array : t -> t
 
-let (|||) x y = match x with
-  | NeedReduce _ -> x
-  | NoNeedReduce -> y
+val prune_path : ?evars:CClosure.evar_handler ->
+  env -> t -> pinductive -> types list -> t
 
-let rec needreduce_of_stack = function
-  | [] -> NoNeedReduce
-  | SArg _ :: l -> needreduce_of_stack l
-  | SClosure (needreduce,_,_,_) :: l -> needreduce ||| needreduce_of_stack l
+end = struct
 
-let redex_level rs = List.length rs
+type size = Large | Strict
 
-let push_stack_closure renv needreduce c stack =
-  (SClosure (needreduce, renv, 0, c)) :: stack
+(* merging information *)
+let inter_size s1 s2 =
+  match s1 with
+  | Strict -> s2
+  | Large -> Large
+
+
+(**
+  Possible specifications for a term, from most to least acceptable:
+  - DeadCode: the term has been built by elimination over an empty type;
+  - Vars l: the term is as much of a subterm as the worst of these variables;
+    variables are levels pointing to the redex stack;
+  - Subterm: the term is a [strict|large] subterm of the structural argument;
+    the argument itself is a large subterm, becomes strict after a [match];
+    the wf_paths argument specifies which constructor arguments are recursive,
+    it can never be empty or this downgrades the specification to [NotSubterm];
+    the [int set] is the same as in [Vars l];
+  - NotSubterm: the term is not a subterm in any kind **)
+
+type t =
+  | DeadCode
+  | Vars of Int.Set.t
+  | Subterm of size * WfPaths.t * Int.Set.t
+  | NotSubterm
+
+(** Constructor for Subterm, which possibly downgrades to NotSubterm *)
+let spec_of_tree size vars tree =
+  if WfPaths.is_norec tree then
+    NotSubterm
+  else
+    Subterm (size, tree, vars)
 
-let push_stack_closures renv l stack =
-  List.fold_right (push_stack_closure renv NoNeedReduce) l stack
+let structural tree =
+  spec_of_tree Large Int.Set.empty tree
 
-let push_stack_args l stack =
-  List.fold_right (fun spec stack -> SArg spec :: stack) l stack
+let strict_subterm tree =
+  spec_of_tree Strict Int.Set.empty tree
 
-let lift_stack k =
-   List.map (function
-       | SClosure (needreduce,s,n,c) -> SClosure (needreduce,s,n+k,c)
-       | x -> x)
+let internal n =
+  assert (n >= 1);
+  Vars (Int.Set.singleton n)
+
+let dead_code = DeadCode
+let not_subterm = NotSubterm
+
+let make_internal n spec =
+  lazy begin match Lazy.force spec with
+  | NotSubterm -> internal n
+  | spec -> spec
+  end
+
+type check_result =
+  | InvalidSubterm
+  | NeedReduce of Int.Set.t (* empty = NoNeedReduce *)
+
+let check t tree =
+  match t with
+  | DeadCode -> NeedReduce Int.Set.empty
+  | Vars l ->   NeedReduce l
+  | Subterm (Strict, tree', l) ->
+    if WfPaths.incl tree tree' then
+      NeedReduce l
+    else
+      InvalidSubterm
+  | NotSubterm | Subterm (Large, _, _) -> InvalidSubterm
+
+let inter_spec s1 s2 =
+  match s1, s2 with
+  | s, DeadCode | DeadCode, s -> s
+  | NotSubterm, _ | _, NotSubterm -> NotSubterm
+  | Vars l1, Vars l2 ->
+    Vars (Int.Set.union l1 l2)
+  | Subterm (s, tree, l1), Vars l2
+  | Vars l1, Subterm (s, tree, l2) ->
+    Subterm (s, tree, Int.Set.union l1 l2)
+  | Subterm (s1, tree1, l1), Subterm (s2, tree2, l2) ->
+    spec_of_tree (inter_size s1 s2) (Int.Set.union l1 l2) (WfPaths.inter tree1 tree2)
+
+let inter_spec =
+  Array.fold_left inter_spec DeadCode
+
+
+let on_constructors discr i j =
+  lazy begin match Lazy.force discr with
+  | DeadCode | Vars _ | NotSubterm as spec -> spec
+  | Subterm (_, tree, vars) ->
+    let subtree = WfPaths.dest_subterm tree i j in
+    spec_of_tree Strict vars subtree
+  end
+
+let on_branches env ind discr =
+  let _, mip = lookup_mind_specif env ind in
+  let sizes = mip.mind_consnrealargs in
+  let subterms = on_constructors discr in
+  fun i -> List.init sizes.(i) (subterms i)
+
+let on_projection discr n =
+  Lazy.force (on_constructors (lazy discr) 0 n)
+
+let on_array discr =
+  Lazy.force (on_constructors (lazy discr) 0 0)
 
-let lift1_stack = lift_stack 1
 
-(******************************)
-(* {6 Computing the recursive subterms of a term (propagation of size
-   information through Cases).} *)
 
-let lookup_subterms env ind =
-  let (_,mip) = lookup_mind_specif env ind in
-  mip.mind_recargs
-
-let match_inductive ind ra =
-  match ra with
-    | Mrec (RecArgInd i) -> Ind.CanOrd.equal ind i
-    | Norec | Mrec (RecArgPrim _) -> false
-
-(* In {match c as z in ci y_s return P with | C_i x_s => t end}
-   [branches_specif renv c_spec ci] returns an array of x_s specs knowing
-   c_spec. *)
-let branches_specif renv c_spec ci =
-  let car =
-    (* We fetch the regular tree associated to the inductive of the match.
-       This is just to get the number of constructors (and constructor
-       arities) that fit the match branches without forcing c_spec.
-       Note that c_spec might be more precise than [v] below, because of
-       nested inductive types. *)
-    let (_,mip) = lookup_mind_specif renv.env ci.ci_ind in
-    let tree = Rtree.Kind.make mip.mind_recargs in
-    match Rtree.Kind.kind tree with
-    | Rtree.Kind.Node (_, v) -> Array.map Array.length v
-    | Rtree.Kind.Var _ -> assert false
-  in
-  let subterms = lazy begin match Lazy.force c_spec with
-  | Subterm (_, _, t) -> dest_subterms t
-  | Dead_code | Internally_bound_subterm _ | Not_subterm -> assert false
-  end in
-  Array.mapi
-      (fun i nca -> (* i+1-th cstructor has arity nca *)
-         let lvra = lazy
-           (match Lazy.force c_spec with
-                Subterm (internal,_,t) when match_inductive ci.ci_ind (dest_recarg t) ->
-                  let vra = Array.of_list (Lazy.force subterms).(i) in
-                  assert (Int.equal nca (Array.length vra));
-                  Array.map (spec_of_tree internal) vra
-              | Dead_code -> Array.make nca Dead_code
-              | Internally_bound_subterm _ as x -> Array.make nca x
-              | Subterm _ | Not_subterm -> Array.make nca Not_subterm) in
-         List.init nca (fun j -> lazy (Lazy.force lvra).(j)))
-      car
 
-let check_inductive_codomain ?evars env p =
-  let absctx, ar = whd_decompose_lambda_decls ?evars env p in
-  let env = push_rel_context absctx env in
-  let arctx, s = whd_decompose_prod_decls ?evars env ar in
-  let env = push_rel_context arctx env in
-  let i,_l' = decompose_app (whd_all ?evars env s) in
-  isInd i
 
 (* The following functions are almost duplicated from indtypes.ml, except
 that they carry here a poorer environment (containing less information). *)
@@ -875,59 +958,12 @@ let rec ienv_decompose_prod ?evars (env,_ as ienv) n c =
      ienv_decompose_prod ?evars ienv' (n-1) b
      | _ -> assert false
 
-(* This removes global parameters of the inductive types in lc (for
-   nested inductive types only ) *)
-let dummy_univ = Level.(make (UGlobal.make (DirPath.make [Id.of_string "implicit"]) "" 0))
-let dummy_implicit_sort = mkType (Universe.make dummy_univ)
-let lambda_implicit n a =
-  let anon = Context.make_annot Anonymous Sorts.Relevant in
-  let lambda_implicit a = mkLambda (anon, dummy_implicit_sort, a) in
-  iterate lambda_implicit n a
-
-let abstract_mind_lc ntyps npars mind lc =
-  let lc = Array.map (fun (ctx, c) -> Term.it_mkProd_or_LetIn c ctx) lc in
-  let rec replace_ind k c =
-    let hd, args = decompose_app_list c in
-    match kind hd with
-    | Ind ((mind',i),_) when MutInd.CanOrd.equal mind mind' ->
-      let rec drop_params n = function
-        | _ :: args when n > 0 -> drop_params (n-1) args
-        | args -> lambda_implicit n (Term.applist (mkRel (ntyps+n+k-i), List.Smart.map (replace_ind (n+k)) args))
-      in
-      drop_params npars args
-    | _ -> map_with_binders succ replace_ind k c
-  in
-  Array.map (replace_ind 0) lc
-
-let is_primitive_positive_container env c =
-  match (Environ.retroknowledge env).Retroknowledge.retro_array with
-  | Some c' when QConstant.equal env c c' -> true
-  | _ -> false
-
-module Cache :
-sig
-  type t
-  val create : unit -> t
-  val get_inductive_subterms : MutInd.t -> mutual_inductive_body -> t -> wf_paths list array array
-end =
-struct
-  type ans = wf_paths list array array
-  type t = ans Mindmap_env.t ref
-  let create () = ref Mindmap_env.empty
-  let get_inductive_subterms mind mib cache = match Mindmap_env.find_opt mind !cache with
-  | None ->
-    let ans = Array.map (fun mip -> dest_subterms mip.mind_recargs) mib.mind_packets in
-    let () = cache := Mindmap_env.add mind ans !cache in
-    ans
-  | Some ans -> ans
-end
-
 (* [get_recargs_approx env tree ind args] builds an approximation of the recargs
 tree for ind, knowing args. The argument tree is used to know when candidate
 nested types should be traversed, pruning the tree otherwise. This code is very
 close to check_positive in indtypes.ml, but does no positivity check and does not
 compute the number of recursive arguments. *)
-let get_recargs_approx cache ?evars env tree ind args =
+let get_recargs_approx ?evars env tree ind args =
   let rec build_recargs (env, ra_env as ienv) tree c =
     let x,largs = decompose_app_list (whd_all ?evars env c) in
     match kind x with
@@ -941,28 +977,23 @@ let get_recargs_approx cache ?evars env tree ind args =
     | Ind ind_kn ->
        (* When the inferred tree allows it, we consider that we have a potential
        nested inductive type *)
-       begin match dest_recarg tree with
-             | Mrec (RecArgInd ind') when QInd.equal env (fst ind_kn) ind' ->
-               build_recargs_nested ienv tree (ind_kn, largs)
-             | Norec | Mrec _ -> mk_norec
-       end
-    | Const (c,_) when is_primitive_positive_container env c ->
-       begin match dest_recarg tree with
-             | Mrec (RecArgPrim c') when QConstant.equal env c c' ->
-               build_recargs_nested_primitive ienv tree (c, largs)
-             | Norec | Mrec _ -> mk_norec
-       end
+      if WfPaths.is_inductive env (fst ind_kn) tree then
+        build_recargs_nested ienv tree (ind_kn, largs)
+      else mk_norec
+    | Const (c, _) ->
+      if WfPaths.is_primitive_positive_container env c tree then
+        build_recargs_nested_primitive ienv tree (c, largs)
+      else mk_norec
     | _err ->
        mk_norec
 
   and build_recargs_nested (env,_ra_env as ienv) tree (((mind,i),u), largs) =
     (* If the inferred tree already disallows recursion, no need to go further *)
-    if is_norec_path tree then tree
+    if WfPaths.is_norec tree then mk_norec
     else
     let mib = Environ.lookup_mind mind env in
-    let auxnpar = mib.mind_nparams_rec in
-    let nonrecpar = mib.mind_nparams - auxnpar in
-    let (lpar,_) = List.chop auxnpar largs in
+    let nonrecpar = mib.mind_nparams - mib.mind_nparams_rec in
+    let (lpar,_) = List.chop mib.mind_nparams_rec largs in
     let auxntyp = Declareops.mind_ntypes mib in
     (* Extends the environment with a variable corresponding to
              the inductive def *)
@@ -973,18 +1004,18 @@ let get_recargs_approx cache ?evars env tree ind args =
     computed statically. This is fine because nested inductive types with
     mutually recursive containers are not supported. *)
     let trees =
-      if Int.equal auxntyp 1 then [|dest_subterms tree|]
-      else Cache.get_inductive_subterms mind mib cache
+      if Int.equal auxntyp 1 then [|tree|]
+      else WfPaths.lookup_mutual_subterms env mind
     in
     let mk_irecargs j mip =
       (* The nested inductive type with parameters removed *)
-      let auxlcvect = abstract_mind_lc auxntyp auxnpar mind mip.mind_nf_lc in
+      let auxlcvect = abstract_mind_lc auxntyp mib.mind_nparams_rec mind mip.mind_nf_lc in
       let paths = Array.mapi
         (fun k c ->
          let c' = hnf_prod_applist ?evars env' c lpar' in
          (* skip non-recursive parameters *)
          let (ienv',c') = ienv_decompose_prod ?evars ienv' nonrecpar c' in
-         build_recargs_constructors ienv' trees.(j).(k) c')
+         build_recargs_constructors ienv' trees.(j) k c')
         auxlcvect
       in
       mk_paths (Mrec (RecArgInd (mind,j))) paths
@@ -993,98 +1024,220 @@ let get_recargs_approx cache ?evars env tree ind args =
     (Rtree.mk_rec irecargs).(i)
 
   and build_recargs_nested_primitive (env, ra_env) tree (c, largs) =
-    if is_norec_path tree then tree
+    if WfPaths.is_norec tree then mk_norec
     else
     let ntypes = 1 in (* Primitive types are modelled by non-mutual inductive types *)
     let ra_env = List.map (fun (r,t) -> (r,Rtree.lift ntypes t)) ra_env in
     let ienv = (env, ra_env) in
-    let paths = List.map2 (build_recargs ienv) (dest_subterms tree).(0) largs in
+    let paths = List.map2 (build_recargs ienv) (Array.to_list (WfPaths.dest_subterms tree).(0)) largs in
     let recargs = [| mk_paths (Mrec (RecArgPrim c)) [| paths |] |] in
     (Rtree.mk_rec recargs).(0)
 
-  and build_recargs_constructors ienv trees c =
-    let rec recargs_constr_rec (env,_ra_env as ienv) trees lrec c =
+  and build_recargs_constructors ienv trees k c =
+    let rec recargs_constr_rec (env,_ra_env as ienv) i lrec c =
       let x,largs = decompose_app_list (whd_all ?evars env c) in
         match kind x with
 
           | Prod (na,b,d) ->
              let () = assert (List.is_empty largs) in
-             let recarg = build_recargs ienv (List.hd trees) b in
+             let recarg = build_recargs ienv (WfPaths.dest_subterm trees k i) b in
              let ienv' = ienv_push_var ienv (na,b,mk_norec) in
-             recargs_constr_rec ienv' (List.tl trees) (recarg::lrec) d
+             recargs_constr_rec ienv' (i+1) (recarg::lrec) d
           | _hd ->
              List.rev lrec
     in
-    recargs_constr_rec ienv trees [] c
+    recargs_constr_rec ienv 0 [] c
   in
   (* starting with ra_env = [] seems safe because any unbounded Rel will be
   assigned Norec *)
   build_recargs_nested (env,[]) tree (ind, args)
 
+
+let prune_path ?evars env spec ind args =
+  match spec with
+  | DeadCode | Vars _ | NotSubterm as spec -> spec
+  | Subterm (size, tree, vars) ->
+    let recargs = get_recargs_approx ?evars env tree ind args in
+    let tree = WfPaths.restrict tree recargs in
+    spec_of_tree size vars tree
+
+end
+
+(*************************************************************)
+(* Environment annotated with marks on recursive arguments *)
+
+type guard_env =
+  { env     : env;
+    (* dB of last fixpoint *)
+    rel_min : int;
+    (* dB of variables denoting subterms *)
+    genv    : Subterm.t Lazy.t list;
+  }
+
+let make_renv env recarg tree =
+  { env = env;
+    rel_min = recarg+2; (* recarg = 0 ==> Rel 1 -> recarg; Rel 2 -> fix *)
+    genv = [Lazy.from_val (Subterm.structural tree)] }
+
+let push_var renv (x,ty,spec) =
+  { env = push_rel (LocalAssum (x,ty)) renv.env;
+    rel_min = renv.rel_min+1;
+    genv = spec:: renv.genv }
+
+let push_let renv (x,c,ty,spec) =
+  { env = push_rel (LocalDef (x,c,ty)) renv.env;
+    rel_min = renv.rel_min+1;
+    genv = spec:: renv.genv }
+
+let assign_var_spec renv (i,spec) =
+  { renv with genv = List.assign renv.genv (i-1) spec }
+
+let push_var_renv renv n (x,ty) =
+  let spec = Lazy.from_val (Subterm.internal n) in
+  push_var renv (x,ty,spec)
+
+(* Fetch recursive information about a variable p *)
+let subterm_var p renv =
+  try Lazy.force (List.nth renv.genv (p-1))
+  with Failure _ | Invalid_argument _ ->
+    (* Check still that the variable is well scoped *)
+    if 1 <= p && p <= Environ.nb_rel renv.env then
+      Subterm.not_subterm
+    else
+      anomaly ~label:"fixpoint" Pp.(str "Index not found in current environment.")
+
+let push_ctxt_renv renv ctxt =
+  let n = Context.Rel.length ctxt in
+  { env = push_rel_context ctxt renv.env;
+    rel_min = renv.rel_min+n;
+    genv = iterate (fun ge -> lazy Subterm.not_subterm::ge) n renv.genv }
+
+let push_fix_renv renv (_,v,_ as recdef) =
+  let n = Array.length v in
+  { env = push_rec_types recdef renv.env;
+    rel_min = renv.rel_min+n;
+    genv = iterate (fun ge -> lazy Subterm.not_subterm::ge) n renv.genv }
+
+type fix_check_result =
+  | NeedReduce of env * fix_guard_error
+  | NoNeedReduce
+
+(* Definition and manipulation of the stack *)
+type stack_element =
+  (* arguments in the evaluation stack *)
+  (* [constr] is typed in [guard_env] and [int] is the number of
+     binders added in the current env on top of [guard_env.env] *)
+  | SClosure of fix_check_result * guard_env * int * constr
+  (* arguments applied to a "match": only their spec traverse the match *)
+  | SArg of Subterm.t Lazy.t
+
+let (|||) x y = match x with
+  | NeedReduce _ -> x
+  | NoNeedReduce -> y
+
+let rec needreduce_of_stack = function
+  | [] -> NoNeedReduce
+  | SArg _ :: l -> needreduce_of_stack l
+  | SClosure (needreduce,_,_,_) :: l -> needreduce ||| needreduce_of_stack l
+
+let redex_level rs = List.length rs
+
+let push_stack_closure renv needreduce c stack =
+  (SClosure (needreduce, renv, 0, c)) :: stack
+
+let push_stack_closures renv l stack =
+  List.fold_right (push_stack_closure renv NoNeedReduce) l stack
+
+let push_stack_args l stack =
+  List.fold_right (fun spec stack -> SArg spec :: stack) l stack
+
+let lift_stack k =
+   List.map (function
+       | SClosure (needreduce,s,n,c) -> SClosure (needreduce,s,n+k,c)
+       | x -> x)
+
+let lift1_stack = lift_stack 1
+
+(******************************)
+(* {6 Computing the recursive subterms of a term (propagation of size
+   information through Cases).} *)
+
+let check_inductive_codomain ?evars env p =
+  let absctx, ar = whd_decompose_lambda_decls ?evars env p in
+  let env = push_rel_context absctx env in
+  let arctx, s = whd_decompose_prod_decls ?evars env ar in
+  let env = push_rel_context arctx env in
+  let i,_l' = decompose_app (whd_all ?evars env s) in
+  isInd i
+
+(* Check that the parameter arguments of an inductive type do not mention some
+   variable range. This is used as a fast-path when casting recursive trees
+   against a commutative cut: indices are irrelevant for the tree
+   computation in {!get_recargs_approx}. *)
+let has_constant_parameters env nvars k ((mind, _), _) args =
+  let mib = Environ.lookup_mind mind env in
+  let auxnpar = mib.mind_nparams_rec in
+  let (lpar, _) = List.chop auxnpar args in
+  List.for_all (fun c -> noccur_with_meta (1 + k) nvars c) lpar
+
 (* [restrict_spec env spec p] restricts the size information in spec to what is
    allowed to flow out of a match with predicate p in environment env. *)
-let restrict_spec cache ?evars env spec p =
+let restrict_spec ?evars env spec p =
   match spec with
-  | Not_subterm | Internally_bound_subterm _ -> spec
+  | Subterm.NotSubterm | Subterm.Vars _ -> spec
   | _ ->
   let absctx, ar = whd_decompose_lambda_decls ?evars env p in
+  let absctxlen = Context.Rel.length absctx in
   (* Optimization: if the predicate is not dependent, no restriction is needed
      and we avoid building the recargs tree. *)
-  if noccur_with_meta 1 (Context.Rel.length absctx) ar then spec
+  if noccur_with_meta 1 absctxlen ar then spec
   else
   let env = push_rel_context absctx env in
-  let arctx, s = whd_decompose_prod_decls ?evars env ar in
+  let arctx, s = whd_decompose_prod ?evars env ar in
   let env = push_rel_context arctx env in
   let i,args = decompose_app_list (whd_all ?evars env s) in
   match kind i with
   | Ind i ->
-     begin match spec with
-           | Dead_code -> spec
-           | Subterm(l,st,tree) ->
-              let recargs = get_recargs_approx cache ?evars env tree i args in
-              let recargs = inter_wf_paths tree recargs in
-              Subterm(l,st,recargs)
-           | _ -> assert false
-     end
-  | _ -> Not_subterm
+    if has_constant_parameters env absctxlen (List.length arctx) i args then spec
+    else
+      Subterm.prune_path ?evars env spec i args
+  | _ -> Subterm.not_subterm
 
 (* [filter_stack_domain env spec p] restricts the size information in stack to
    what is allowed to enter under a match with predicate p in environment env. *)
-let filter_stack_domain cache stack_element_specif set_iota_specif ?evars env p stack =
+let filter_stack_domain stack_element_specif not_subterm ?evars env p stack =
   let absctx, ar = Term.decompose_lambda_decls p in
+  let absctxlen = Context.Rel.length absctx in
   (* Optimization: if the predicate is not dependent, no restriction is needed
      and we avoid building the recargs tree. *)
-  if noccur_with_meta 1 (Context.Rel.length absctx) ar then stack
-  else let env = push_rel_context absctx env in
-  let rec filter_stack env ar stack =
-    match stack with
+  if noccur_with_meta 1 absctxlen ar then
+    stack
+  else
+    let env = push_rel_context absctx env in
+    let rec filter_stack env k ar stack = match stack with
     | [] -> []
     | elt :: stack' ->
-    let t = whd_all ?evars env ar in
-    match kind t with
-    | Prod (n,a,c0) ->
-      let d = LocalAssum (n,a) in
-      let ctx, a = whd_decompose_prod_decls ?evars env a in
-      let env = push_rel_context ctx env in
-      let ty, args = decompose_app_list (whd_all ?evars env a) in
-      let elt = match kind ty with
-      | Ind ind ->
-        let spec = stack_element_specif cache ?evars elt in
-        let sarg =
-        lazy (match Lazy.force spec with
-        | Not_subterm | Dead_code | Internally_bound_subterm _ as spec -> spec
-        | Subterm(l,s,path) ->
-            let recargs = get_recargs_approx cache ?evars env path ind args in
-            let path = inter_wf_paths path recargs in
-            Subterm(l,s,path))
+      let t = whd_all ?evars env ar in
+      match kind t with
+      | Prod (n, a, c0) ->
+        let d = LocalAssum (n, a) in
+        let ctx, a = whd_decompose_prod ?evars env a in
+        let env = push_rel_context ctx env in
+        let ty, args = decompose_app_list (whd_all ?evars env a) in
+        let elt = match kind ty with
+        | Ind ind ->
+          let spec = stack_element_specif ?evars elt in
+          if has_constant_parameters env absctxlen (k + List.length ctx) ind args then
+            spec
+          else
+            lazy (Subterm.prune_path ?evars env (Lazy.force spec) ind args)
+        | _ -> not_subterm
         in
-        SArg sarg
-      | _ -> SArg (set_iota_specif (lazy Not_subterm))
-      in
-      elt :: filter_stack (push_rel d env) c0 stack'
-    | _ -> List.fold_right (fun _ l -> SArg (set_iota_specif (lazy Not_subterm)) :: l) stack []
+        SArg elt :: filter_stack (push_rel d env) (k + 1) c0 stack'
+      | _ ->
+        List.map (fun _ -> SArg not_subterm) stack
   in
-  filter_stack env ar stack
+  filter_stack env 0 ar stack
 
 (* [subterm_specif renv t] computes the recursive structure of [t] and
    compare its size with the size of the initial recursive argument of
@@ -1092,7 +1245,7 @@ let filter_stack_domain cache stack_element_specif set_iota_specif ?evars env p
    about variables.
 *)
 
-let rec subterm_specif cache ?evars renv stack t =
+let rec subterm_specif ?evars renv stack t =
   (* maybe reduction is not always necessary! *)
   let f,l = decompose_app_list (whd_all ?evars renv.env t) in
     match kind f with
@@ -1100,17 +1253,15 @@ let rec subterm_specif cache ?evars renv stack t =
     | Case (ci, u, pms, p, iv, c, lbr) -> (* iv ignored: it's just a cache *)
       let (ci, (p,_), _iv, c, lbr) = expand_case renv.env (ci, u, pms, p, iv, c, lbr) in
       let stack' = push_stack_closures renv l stack in
-      let stack' = filter_stack_domain cache stack_element_specif Fun.id ?evars renv.env p stack' in
-      let cases_spec =
-        branches_specif renv (lazy_subterm_specif cache ?evars renv [] c) ci
-      in
+      let stack' = filter_stack_domain stack_element_specif (lazy Subterm.not_subterm) ?evars renv.env p stack' in
+      let cases_spec = Subterm.on_branches renv.env ci.ci_ind (lazy_subterm_specif ?evars renv [] c) in
       let stl =
         Array.mapi (fun i br' ->
-                    let stack_br = push_stack_args (cases_spec.(i)) stack' in
-                    subterm_specif cache ?evars renv stack_br br')
+                    let stack_br = push_stack_args (cases_spec i) stack' in
+                    subterm_specif ?evars renv stack_br br')
                   lbr in
-      let spec = subterm_spec_glb stl in
-      restrict_spec cache ?evars renv.env spec p
+      let spec = Subterm.inter_spec stl in
+      restrict_spec ?evars renv.env spec p
 
     | Fix ((recindxs,i),(_,typarray,bodies as recdef)) ->
       (* when proving that the fixpoint f(x)=e is less than n, it is enough
@@ -1118,7 +1269,7 @@ let rec subterm_specif cache ?evars renv stack t =
          furthermore when f is applied to a term which is strictly less than
          n, one may assume that x itself is strictly less than n
       *)
-    if not (check_inductive_codomain ?evars renv.env typarray.(i)) then Not_subterm
+    if not (check_inductive_codomain ?evars renv.env typarray.(i)) then Subterm.not_subterm
     else
       let (ctxt,clfix) = whd_decompose_prod ?evars renv.env typarray.(i) in
       let oind =
@@ -1126,102 +1277,84 @@ let rec subterm_specif cache ?evars renv stack t =
           try Some(fst (find_inductive ?evars env' clfix))
           with Not_found -> None in
         (match oind with
-      None -> Not_subterm (* happens if fix is polymorphic *)
+        | None -> Subterm.not_subterm (* happens if fix is polymorphic *)
         | Some (ind, _) ->
+        let stack = push_stack_closures renv l stack in
         let nbfix = Array.length typarray in
-        let recargs = lookup_subterms renv.env ind in
+        let recargs = WfPaths.lookup_subterms renv.env ind in
                    (* pushing the fixpoints *)
-        let renv' = push_fix_renv renv recdef in
-        let renv' =
+        let renv = push_fix_renv renv recdef in
+        let renv =
                      (* Why Strict here ? To be general, it could also be
                         Large... *)
-          assign_var_spec renv'
-          (nbfix-i, lazy (Subterm(Int.Set.empty,Strict,recargs))) in
+          assign_var_spec renv
+          (nbfix-i, lazy (Subterm.strict_subterm recargs)) in
         let decrArg = recindxs.(i) in
         let theBody = bodies.(i)   in
         let nbOfAbst = decrArg+1 in
         let sign,strippedBody = whd_decompose_lambda_n_assum ?evars renv.env nbOfAbst theBody in
                    (* pushing the fix parameters *)
-        let stack' = push_stack_closures renv l stack in
-        let renv'' = push_ctxt_renv renv' sign in
-        let renv'' =
-          if List.length stack' < nbOfAbst then renv''
+        let renv = push_ctxt_renv renv sign in
+        let renv =
+          if List.length stack < nbOfAbst then renv
           else
-            let decrArg = List.nth stack' decrArg in
-            let arg_spec = stack_element_specif cache ?evars decrArg in
-              assign_var_spec renv'' (1, arg_spec) in
-          subterm_specif cache ?evars renv'' [] strippedBody)
+            let decrArg = List.nth stack decrArg in
+            let arg_spec = stack_element_specif ?evars decrArg in
+            assign_var_spec renv (1, arg_spec)
+        in
+        subterm_specif ?evars renv [] strippedBody)
 
     | Lambda (x,a,b) ->
       let () = assert (List.is_empty l) in
-      let spec,stack' = extract_stack cache ?evars stack in
-        subterm_specif cache ?evars (push_var renv (x,a,spec)) stack' b
+      let spec,stack' = extract_stack ?evars stack in
+        subterm_specif ?evars (push_var renv (x,a,spec)) stack' b
 
-      (* Metas and evars are considered OK *)
-    | (Meta _|Evar _) -> Dead_code
+      (* Evars are considered OK *)
+    | Evar _ -> Subterm.dead_code
 
     | Proj (p, _, c) ->
-      let subt = subterm_specif cache ?evars renv stack c in
-      (match subt with
-       | Subterm (internal, _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 n = Projection.arg p in
-         spec_of_tree internal (List.nth wf_args n)
-       | Dead_code -> Dead_code
-       | Not_subterm -> Not_subterm
-       | Internally_bound_subterm n -> Internally_bound_subterm n)
+      let subt = subterm_specif ?evars renv [] c in
+      Subterm.on_projection subt (Projection.arg p)
 
     | Const c ->
       begin try
-        let _ = Environ.constant_value_in renv.env c in Not_subterm
+        let _ = Environ.constant_value_in renv.env c in Subterm.not_subterm
       with
         | NotEvaluableConst (IsPrimitive (_u,op)) when List.length l >= CPrimitives.arity op ->
-          primitive_specif cache ?evars renv op l
-        | NotEvaluableConst _ -> Not_subterm
+          primitive_specif ?evars renv op l
+        | NotEvaluableConst _ -> Subterm.not_subterm
       end
 
+    | Meta _ -> assert false
+
     | Var _ | Sort _ | Cast _ | Prod _ | LetIn _ | App _ | Ind _
       | Construct _ | CoFix _ | Int _ | Float _ | String _
-      | Array _ -> Not_subterm
+      | Array _ -> Subterm.not_subterm
 
 
       (* Other terms are not subterms *)
 
-and lazy_subterm_specif cache ?evars renv stack t =
-  lazy (subterm_specif cache ?evars renv stack t)
+and lazy_subterm_specif ?evars renv stack t =
+  lazy (subterm_specif ?evars renv stack t)
 
-and stack_element_specif cache ?evars = function
-  | SClosure (_, h_renv, _, h) -> lazy_subterm_specif cache ?evars h_renv [] h
+and stack_element_specif ?evars = function
+  | SClosure (_, h_renv, _, h) -> lazy_subterm_specif ?evars h_renv [] h
   | SArg x -> x
 
-and extract_stack cache ?evars = function
-   | [] -> Lazy.from_val Not_subterm, []
-   | elt :: l -> stack_element_specif cache ?evars elt, l
+and extract_stack ?evars = function
+   | [] -> lazy Subterm.not_subterm, []
+   | elt :: l -> stack_element_specif ?evars elt, l
 
-and primitive_specif cache ?evars renv op args =
+and primitive_specif ?evars renv op args =
   let open CPrimitives in
   match op with
   | Arrayget | Arraydefault ->
     (* t.[i] and default t can be seen as strict subterms of t, with a
        potentially nested rectree. *)
     let arg = List.nth args 1 in (* the result is a strict subterm of the second argument *)
-    let subt = subterm_specif cache ?evars renv [] arg in
-    begin match subt with
-    | Subterm (internal, _s, wf) ->
-      let wf_args = (dest_subterms wf).(0) in
-      spec_of_tree internal (List.nth wf_args 0) (* first and only parameter of `array` *)
-    | Dead_code -> Dead_code
-    | Not_subterm -> Not_subterm
-    | Internally_bound_subterm n -> Internally_bound_subterm n
-    end
-  | _ -> Not_subterm
-
-let set_iota_specif nr spec =
-  lazy (match Lazy.force spec with
-        | Not_subterm -> if nr >= 1 then Internally_bound_subterm (Int.Set.singleton nr) else Not_subterm
-        | spec -> spec)
+    let subt = subterm_specif ?evars renv [] arg in
+    Subterm.on_array subt
+  | _ -> Subterm.not_subterm
 
 (************************************************************************)
 
@@ -1234,8 +1367,8 @@ let illegal_rec_call renv fx = function
       List.fold_left
         (fun (i,le,lt) sbt ->
           match Lazy.force sbt with
-              (Subterm(_,Strict,_) | Dead_code) -> (i+1, le, i::lt)
-            | (Subterm(_,Large,_)) -> (i+1, i::le, lt)
+              (Subterm.Subterm (Strict, _, _) | DeadCode) -> (i+1, le, i::lt)
+            | (Subterm.Subterm (Large, _, _)) -> (i+1, i::le, lt)
             | _ -> (i+1, le ,lt))
         (1,[],[]) renv.genv in
           (le_vars,lt_vars)) in
@@ -1257,43 +1390,39 @@ let set_need_reduce env l err rs =
 let set_need_reduce_top env err rs =
   set_need_reduce_one env (List.length rs) err rs
 
-type check_subterm_result =
+type check_subterm_result = Subterm.check_result =
   | InvalidSubterm
-  | NeedReduceSubterm of Int.Set.t (* empty = NoNeedReduce *)
-
-(* Check term c can be applied to one of the mutual fixpoints. *)
-let check_is_subterm x tree =
-  match Lazy.force x with
-  | Subterm (need_reduce,Strict,tree') ->
-    if incl_wf_paths tree tree' then NeedReduceSubterm need_reduce
-    else InvalidSubterm
-  | Dead_code -> NeedReduceSubterm Int.Set.empty
-  | Not_subterm | Subterm (_,Large,_) -> InvalidSubterm
-  | Internally_bound_subterm l -> NeedReduceSubterm l
+  | NeedReduce of Int.Set.t (* empty = NoNeedReduce *)
+
 
 let find_uniform_parameters recindx nargs bodies =
   let nbodies = Array.length bodies in
+  (* Ensure that the structural argument is not uniform,
+     so that it stays in [non_absorbed_stack] *)
   let min_indx = Array.fold_left min nargs recindx in
-  (* We work only on the i-th body but are in the context of n bodies *)
-  let rec aux i k nuniformparams c =
+  let rec aux k nuniformparams c =
     let f, l = decompose_app_list c in
     match kind f with
     | Rel n ->
-      (* A recursive reference to the i-th body *)
-      if Int.equal n (nbodies + k - i) then
-        List.fold_left_i (fun j nuniformparams a ->
-            match kind a with
-            | Rel m when Int.equal m (k - j) ->
-              (* a reference to the j-th parameter *)
-              nuniformparams
-            | _ ->
-              (* not a parameter: this puts a bound on the size of an extrudable prefix of uniform arguments *)
-              min j nuniformparams) 0 nuniformparams l
+      let fold accu c = fold_constr_with_binders succ aux k accu c in
+      let nuniformparams = List.fold_left fold nuniformparams l in
+      (* A recursive reference to any one of the mutual fixpoints *)
+      if n > k && n <= k + nbodies then
+        List.fold_left_until (fun j arg ->
+          if j >= nuniformparams then Stop nuniformparams else
+          match kind arg with
+          | Rel m when Int.equal m (k - j) ->
+            (* a reference to the j-th parameter *)
+            Cont (j+1)
+          | _ ->
+            (* not a parameter: this puts a bound on the size of an extrudable prefix of uniform arguments *)
+            Stop j
+          ) 0 l
       else
         nuniformparams
-    | _ -> fold_constr_with_binders succ (aux i) k nuniformparams c
+    | _ -> fold_constr_with_binders succ aux k nuniformparams c
   in
-  Array.fold_left_i (fun i -> aux i 0) min_indx bodies
+  Array.fold_left (aux 0) min_indx bodies
 
 (** Given a fixpoint [fix f x y z n {struct n} := phi(f x y u t, ..., f x y u' t')]
     with [z] not uniform we build in context [x:A, y:B(x), z:C(x,y)] a term
@@ -1303,41 +1432,44 @@ let find_uniform_parameters recindx nargs bodies =
 
 let drop_uniform_parameters nuniformparams bodies =
   let nbodies = Array.length bodies in
-  let rec aux i k c =
+  let rec aux k c =
     let f, l = decompose_app_list c in
     match kind f with
     | Rel n ->
-      (* A recursive reference to the i-th body *)
-      if Int.equal n (nbodies + k - i) then
-        let new_args = List.skipn_at_best nuniformparams l in
+      let l = List.map (fun c -> aux k c) l in
+      (* A recursive reference to any one of the mutual fixpoints *)
+      if n > k && n <= k + nbodies then
+        let new_args = List.skipn nuniformparams l in
         Term.applist (f, new_args)
-      else
-        c
-    | _ -> map_with_binders succ (aux i) k c
+      else Term.applist (f, l)
+    | _ -> map_with_binders succ aux k c
   in
-  Array.mapi (fun i -> aux i 0) bodies
+  Array.map (aux 0) bodies
 
-let filter_fix_stack_domain cache ?evars nr decrarg stack nuniformparams =
+let filter_fix_stack_domain ?evars nr decrarg stack nuniformparams =
   let rec aux i nuniformparams stack =
     match stack with
     | [] -> []
     | a :: stack ->
       let uniform, nuniformparams = if nuniformparams = 0 then false, 0 else true, nuniformparams -1 in
       let a =
-        if uniform || Int.equal i decrarg then SArg (stack_element_specif cache ?evars a)
+        if uniform then a
+        else if Int.equal i decrarg then SArg (stack_element_specif ?evars a)
+        (* We forget the needreduce status of the structural argument here,
+           since it's checked in [non_absorbed_stack]. *)
         else
           (* deactivate the status of non-uniform parameters since we
              cannot guarantee that they are preserve in the recursive
              calls *)
-          SArg (set_iota_specif nr (lazy Not_subterm)) in
+          SArg (Lazy.from_val (Subterm.internal nr)) in
       a :: aux (i+1) nuniformparams stack
   in aux 0 nuniformparams stack
 
-let pop_argument cache ?evars needreduce renv elt stack x a b =
+let pop_argument ?evars needreduce renv elt stack x a b =
   match needreduce, elt with
   | NoNeedReduce, SClosure (NoNeedReduce, _, n, c) ->
     (* Neither function nor args have rec calls on internally bound variables *)
-    let spec = stack_element_specif cache ?evars elt in
+    let spec = stack_element_specif ?evars elt in
     (* Thus, args do not a priori require to be rechecked, so we push a let *)
     (* maybe the body of the let will have to be locally expanded though, see Rel case *)
     push_let renv (x,lift n c,a,spec), lift1_stack stack, b
@@ -1351,10 +1483,18 @@ let pop_argument cache ?evars needreduce renv elt stack x a b =
 let judgment_of_fixpoint (_, types, bodies) =
   Array.map2 (fun typ body -> { uj_val = body ; uj_type = typ }) types bodies
 
+let rec reduce_and_contract_cofix ?evars env c =
+  let c = whd_all ?evars env c in
+  let hd, args = decompose_app c in
+  match kind hd with
+  | CoFix cofix ->
+    reduce_and_contract_cofix ?evars env (mkApp (contract_cofix cofix, args))
+  | _ -> hd, args
+
 (* Check if [def] is a guarded fixpoint body with decreasing arg.
    given [recpos], the decreasing arguments of each mutually defined
    fixpoint. *)
-let check_one_fix cache ?evars renv recpos trees def =
+let check_one_fix ?evars renv recpos trees def =
   let nfi = Array.length recpos in
 
   (* Checks if [t] only make valid recursive calls
@@ -1389,8 +1529,8 @@ let check_one_fix cache ?evars renv recpos trees def =
                   (* Retrieve the expected tree for the argument *)
                   (* Check the decreasing arg is smaller *)
                   let z = List.nth stack np in
-                  match check_is_subterm (stack_element_specif cache ?evars z) trees.(glob) with
-                  | NeedReduceSubterm l -> set_need_reduce renv.env l (illegal_rec_call renv glob z) rs
+                  match Subterm.check (Lazy.force (stack_element_specif ?evars z)) trees.(glob) with
+                  | NeedReduce l -> set_need_reduce renv.env l (illegal_rec_call renv glob z) rs
                   | InvalidSubterm -> raise (FixGuardError (renv.env, illegal_rec_call renv glob z))
               else rs
             in
@@ -1406,25 +1546,20 @@ let check_one_fix cache ?evars renv recpos trees def =
             (* compute the recarg info for the arguments of each branch *)
             let rs' = NoNeedReduce::rs in
             let nr = redex_level rs' in
-            let case_spec =
-              branches_specif renv (set_iota_specif nr (lazy_subterm_specif cache ?evars renv [] c_0)) ci in
-            let stack' = filter_stack_domain cache stack_element_specif (set_iota_specif nr) ?evars renv.env p stack in
+            let c_spec = Subterm.make_internal nr (lazy_subterm_specif ?evars renv [] c_0) in
+            let case_spec = Subterm.on_branches renv.env ci.ci_ind c_spec in
+            let stack' = filter_stack_domain stack_element_specif (Lazy.from_val (Subterm.internal nr)) ?evars renv.env p stack in
             let rs' =
               Array.fold_left_i (fun k rs' br' ->
-                  let stack_br = push_stack_args case_spec.(k) stack' in
+                  let stack_br = push_stack_args (case_spec k) stack' in
                   check_rec_call_stack renv stack_br rs' br') rs' brs in
             let needreduce_br, rs = List.sep_first rs' in
             check_rec_call_state renv (needreduce_br ||| needreduce_c_0) stack rs (fun () ->
               (* we try hard to reduce the match away by looking for a
                  constructor in c_0 (we unfold definitions too) *)
-              let c_0 = whd_all ?evars renv.env c_0 in
-              let hd, args = decompose_app_list c_0 in
-              let hd, args = match kind hd with
-              | CoFix cofix ->
-                  decompose_app_list (whd_all ?evars renv.env (Term.applist (contract_cofix cofix, args)))
-              | _ -> hd, args in
+              let hd, args = reduce_and_contract_cofix ?evars renv.env c_0 in
               match kind hd with
-              | Construct cstr -> Some (apply_branch cstr args ci brs, [])
+              | Construct cstr -> Some (apply_branch cstr (Array.to_list args) ci brs, [])
               | CoFix _ | Ind _ | Lambda _ | Prod _ | LetIn _
               | Sort _ | Int _ | Float _ | String _ | Array _ -> assert false
               | Rel _ | Var _ | Const _ | App _ | Case _ | Fix _
@@ -1449,7 +1584,7 @@ let check_one_fix cache ?evars renv recpos trees def =
             let renv' = push_fix_renv renv recdef in
             let nuniformparams = find_uniform_parameters recindxs (List.length stack) bodies in
             let bodies = drop_uniform_parameters nuniformparams bodies in
-            let fix_stack = filter_fix_stack_domain cache ?evars (redex_level rs) decrArg stack nuniformparams in
+            let fix_stack = filter_fix_stack_domain ?evars (redex_level rs) decrArg stack nuniformparams in
             let fix_stack = if List.length stack > decrArg then List.firstn (decrArg+1) fix_stack else fix_stack in
             let stack_this = lift_stack nbodies fix_stack in
             let stack_others = lift_stack nbodies (List.firstn nuniformparams fix_stack) in
@@ -1490,7 +1625,7 @@ let check_one_fix cache ?evars renv recpos trees def =
               let needreduce, rs = check_rec_call renv rs a in
               match stack with
               | elt :: stack ->
-                let renv, stack, b = pop_argument cache ?evars needreduce renv elt stack x a b in
+                let renv, stack, b = pop_argument ?evars needreduce renv elt stack x a b in
                 check_rec_call_stack renv stack rs b
               | [] ->
                 check_rec_call_stack (push_var_renv renv (redex_level rs) (x,a)) [] rs b
@@ -1521,12 +1656,7 @@ let check_one_fix cache ?evars renv recpos trees def =
               check_rec_call_state renv needreduce' stack rs (fun () ->
               (* we try hard to reduce the proj away by looking for a
                  constructor in c (we unfold definitions too) *)
-              let c = whd_all ?evars renv.env c in
-              let hd, args = decompose_app c in
-              let hd, args = match kind hd with
-              | CoFix cofix ->
-                  decompose_app (whd_all ?evars renv.env (mkApp (contract_cofix cofix, args)))
-              | _ -> hd, args in
+              let hd, args = reduce_and_contract_cofix ?evars renv.env c in
               match kind hd with
               | Construct _ -> Some (args.(Projection.npars p + Projection.arg p), [])
               | CoFix _ | Ind _ | Lambda _ | Prod _ | LetIn _
@@ -1549,7 +1679,7 @@ let check_one_fix cache ?evars renv recpos trees def =
               match needreduce_of_stack stack ||| needreduce_c ||| needreduce_t with
               | NoNeedReduce ->
                   (* Stack do not require to beta-reduce; let's look if the body of the let needs *)
-                  let spec = lazy_subterm_specif cache ?evars renv [] c in
+                  let spec = lazy_subterm_specif ?evars renv [] c in
                   let stack = lift1_stack stack in
                   check_rec_call_stack (push_let renv (x,c,t,spec)) stack rs b
               | NeedReduce _ -> check_rec_call_stack renv stack rs (subst1 c b)
@@ -1571,9 +1701,10 @@ let check_one_fix cache ?evars renv recpos trees def =
             let rs = check_inert_subterm_rec_call renv rs ty in
             rs
 
-        (* l is not checked because it is considered as the meta's context *)
-        | (Evar _ | Meta _) ->
-            rs
+        (* stack is not checked because it will depend on evar definition *)
+        | Evar _ -> rs (* TODO: check if evar has a definition in ?evars *)
+
+        | Meta _ -> assert false
 
   and check_nested_fix_body illformed renv decr stack rs body =
     if Int.equal decr 0 then
@@ -1582,10 +1713,10 @@ let check_one_fix cache ?evars renv recpos trees def =
       match kind (whd_all ?evars renv.env body) with
         | Lambda (x,a,body) ->
           begin
+            let rs = check_inert_subterm_rec_call renv rs a in
             match stack with
             | elt :: stack ->
-              let rs = check_inert_subterm_rec_call renv rs a in
-              let renv', stack', body' = pop_argument cache NoNeedReduce renv elt stack x a body in
+              let renv', stack', body' = pop_argument NoNeedReduce renv elt stack x a body in
               check_nested_fix_body illformed renv' (decr-1) stack' rs body'
             | [] ->
               let renv' = push_var_renv renv (redex_level rs) (x,a) in
@@ -1626,7 +1757,14 @@ let check_one_fix cache ?evars renv recpos trees def =
   | NeedReduce (env,err) -> raise (FixGuardError (env,err))
   | NoNeedReduce -> ()
 
-let inductive_of_mutfix ?evars ?elim_to env ((nvect,bodynum),(names,types,bodies as recdef)) =
+let raise_fix_guard_err_fn env recdef names =
+  let fixenv = push_rec_types recdef env in
+  let vdefj = judgment_of_fixpoint recdef in
+  let raise_err env i err =
+    error_ill_formed_rec_body env (Type_errors.FixGuardError err) names i fixenv vdefj in
+  raise_err
+
+let inductive_of_mutfix ?evars env ((nvect, bodynum), (names, types, bodies as recdef)) =
   let nbfix = Array.length bodies in
   if Int.equal nbfix 0
     || not (Int.equal (Array.length nvect) nbfix)
@@ -1636,90 +1774,102 @@ let inductive_of_mutfix ?evars ?elim_to env ((nvect,bodynum),(names,types,bodies
     || bodynum >= nbfix
   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 =
-    error_ill_formed_rec_body env (Type_errors.FixGuardError err) names i fixenv vdefj in
-  (* Check the i-th definition with recarg k *)
-  let find_ind i k def =
-    (* 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 (whd_all ?evars env def) with
-        | Lambda (x,a,b) ->
-            if noccur_with_meta n nbfix a then
-              let env' = push_rel (LocalAssum (x,a)) env in
-              if Int.equal n (k + 1) then
-                (* get the inductive type of the fixpoint *)
-                let (mind, _) =
-                  try find_inductive ?evars 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.")
-        | _ -> raise_err env i (NotEnoughAbstractionInFixBody k)
-    in
-    let ((ind, inst), _) as res = check_occur fixenv 1 def in
-    let _, mip = lookup_mind_specif env ind in
-    (* recursive sprop means non record with projections -> squashed *)
-    let () =
-      if Environ.is_type_in_type env (GlobRef.IndRef ind) then ()
+  let raise_err = raise_fix_guard_err_fn env recdef names in
+  (* Check the i-th definition with recarg, under k binders *)
+  let rec find_ind env i recarg k def =
+    match kind (whd_all ?evars env def) with
+    | Lambda (na, ty, body) ->
+      (* check no recursive call appear in the recarg+1 first abstractions,
+         gives the type of the recarg+1-th abstraction (must be an inductive) *)
+      let () = if not (noccur_with_meta k nbfix ty) then
+        anomaly ~label:"check_one_fix" (Pp.str "Bad occurrence of recursive call.")
+      in
+      let env = push_rel (LocalAssum (na, ty)) env in
+      if Int.equal k (recarg + 1) then
+        (* get the inductive type of the fixpoint *)
+        let (mind, _) =
+          try find_inductive ?evars env ty
+          with Not_found ->
+            raise_err env i (RecursionNotOnInductiveType ty)
+        in
+        let mib, _ = lookup_mind_specif env (out_punivs mind)in
+        let () = if mib.mind_finite != Finite then
+          raise_err env i (RecursionNotOnInductiveType ty)
+        in
+        (mind, (env, body))
       else
-        let sind = UVars.subst_instance_sort inst mip.mind_sort in
-        let u = Sorts.univ_of_sort sind in
+        find_ind env i recarg (k+1) body
+    | _ -> raise_err env i (NotEnoughAbstractionInFixBody recarg)
+  in
+  (* Do it on every fixpoint *)
+  let rv = Array.map2_i (fun i recarg def -> find_ind fixenv i recarg 1 def) nvect bodies in
+  (Array.map fst rv, Array.map snd rv)
+
+(* Returns the pairs of (inductive sort * output sort) or
+ * None if any elimination constraint was ignored. *)
+let sorts_of_mutfix env minds names =
+  let ind_ignores_elim_constraints (ind, _) = Environ.ind_ignores_elim_constraints env ind in
+  (* recursive sprop means non record with projections -> squashed *)
+  if Array.exists ind_ignores_elim_constraints minds then None
+  else
+    Some (Array.fold_left_i (fun i sorts (ind, inst) ->
+        let mib, mip = lookup_mind_specif env ind in
+        let ind_sort = match mib.mind_template with
+        | None -> UVars.subst_instance_sort inst mip.mind_sort
+        | Some templ ->
+          let () = assert (UVars.Instance.is_empty inst) in
+          (* suspect, this is always Type currently *)
+          UVars.subst_instance_sort templ.template_defaults mip.mind_sort
+        in
+        let u = Sorts.univ_of_sort ind_sort in
         (* This is an approximation: a [Relevant] variable might be of sort [Prop]
            or [Type]. As we only care about the quality, we have to be conservative
            here, i.e., every relevant sort (so, [Prop] or above) can be eliminated
            into any other relevant sort. *)
-        let bsort = match names.(i).Context.binder_relevance with
+        let out_sort = match names.(i).Context.binder_relevance with
           | Irrelevant -> Sorts.sprop
           | Relevant -> Sorts.prop
-          | RelevanceVar q -> Sorts.qsort q u in
-        let elim_to = match elim_to with
-          | Some f -> f
-          | None -> eliminates_to (Environ.qualities env) in
-        if not (is_allowed_fixpoint elim_to sind bsort) then
-          raise_err env i @@ FixpointOnNonEliminable (sind, bsort)
-    in
-    res
+          | RelevanceVar q -> Sorts.vsort q u in
+        (ind_sort, out_sort) :: sorts
+      ) [] minds)
+
+
+let check_fix_pre_sorts ?evars env ((nvect, _), (names, _, bodies as recdef) as fix) =
+(* For elaboration of elimination constraints, we need to update the evar_map with
+   the possibly new constraints (see e.g. [esearch_guard] (Pretyping)). We expose this
+   function to be used for this purpose, while check_fix performs the normal check,
+   failing when elimination constraints are not satisfied. *)
+  let minds, rdef = inductive_of_mutfix ?evars env fix in
+  let sorts_opt = sorts_of_mutfix env minds names in
+  let inds = Array.map fst minds in
+  let flags = Environ.typing_flags env in
+  let raise_err = raise_fix_guard_err_fn env recdef names in
+  let () =
+    if flags.check_guarded then
+      let trees = Array.map (fun ind -> WfPaths.lookup_subterms env ind) inds in
+      for i = 0 to Array.length bodies - 1 do
+        let (fenv, body) = rdef.(i) in
+        let renv = make_renv fenv nvect.(i) trees.(i) in
+        try check_one_fix ?evars renv nvect trees body
+        with FixGuardError (err_env, err) -> raise_err err_env i err
+      done
   in
-  (* Do it on every fixpoint *)
-  let rv = Array.map2_i find_ind nvect bodies in
-  (Array.map fst rv, Array.map snd rv)
-
+  sorts_opt
 
-let check_fix ?evars ?elim_to env ((nvect,_),(names,_,bodies as recdef) as fix) =
-  let cache = Cache.create () in
-  let (minds, rdef) = inductive_of_mutfix ?evars ?elim_to env fix in
-  let flags = Environ.typing_flags env in
-  if flags.check_guarded then
-    let get_tree (kn,i) =
-      let mib = Environ.lookup_mind kn env in
-      mib.mind_packets.(i).mind_recargs
-    in
-    let trees = Array.map (fun (mind,_) -> get_tree mind) minds in
-    for i = 0 to Array.length bodies - 1 do
-      let (fenv,body) = rdef.(i) in
-      let renv = make_renv fenv nvect.(i) trees.(i) in
-      try check_one_fix cache ?evars renv nvect trees body
-      with FixGuardError (fixenv,err) ->
-        error_ill_formed_rec_body fixenv (Type_errors.FixGuardError err) names i
-          (push_rec_types recdef env) (judgment_of_fixpoint recdef)
-    done
-  else
-    ()
+let check_fix ?evars env (_, (names, _, _ as recdef) as fix) =
+  let sorts_opts = check_fix_pre_sorts ?evars env fix in
+  let raise_err = raise_fix_guard_err_fn env recdef names in
+  let elim_to = eliminates_to (Environ.qualities env) in
+  Option.iter (List.iteri (fun i (ind_sort, out_sort) ->
+      if not (is_allowed_fixpoint elim_to ind_sort out_sort) then
+        raise_err env i @@ FixpointOnNonEliminable (ind_sort, out_sort)
+    )) sorts_opts
 
 (************************************************************************)
 (* Co-fixpoints. *)
 
 exception CoFixGuardError of env * cofix_guard_error
 
-let anomaly_ill_typed () =
-  anomaly ~label:"check_one_cofix" (Pp.str "too many arguments applied to constructor.")
-
 let rec codomain_is_coind ?evars env c =
   let b = whd_all ?evars env c in
   match kind b with
@@ -1730,8 +1880,8 @@ let rec codomain_is_coind ?evars env c =
         with Not_found ->
           raise (CoFixGuardError (env, CodomainNotInductiveType b)))
 
-let check_one_cofix cache ?evars env nbfix def deftype =
-  let rec check_rec_call env alreadygrd n tree vlra t =
+let check_one_cofix ?evars env nbfix def deftype =
+  let rec check_rec_call env alreadygrd n tree t =
     if not (noccur_with_meta n nbfix t) then
       let c,args = decompose_app_list (whd_all ?evars env t) in
       match kind c with
@@ -1743,30 +1893,30 @@ let check_one_cofix cache ?evars env nbfix def deftype =
             else if not(List.for_all (noccur_with_meta n nbfix) args) then
               raise (CoFixGuardError (env,NestedRecursiveOccurrences))
         | Construct ((_,i as cstr_kn),_u)  ->
-            let lra = vlra.(i-1) in
             let mI = inductive_of_constructor cstr_kn in
             let (mib,_mip) = lookup_mind_specif env mI in
             let realargs = List.skipn mib.mind_nparams args in
-            let rec process_args_of_constr = function
-              | (t::lr), (rar::lrar) ->
-                  if is_norec_path rar then
-                    if noccur_with_meta n nbfix t
-                    then process_args_of_constr (lr, lrar)
-                    else raise (CoFixGuardError
-                                 (env,RecCallInNonRecArgOfConstructor t))
-                  else begin
-                      check_rec_call env true n rar (dest_subterms rar) t;
-                      process_args_of_constr (lr, lrar)
-                    end
-              | [],_ -> ()
-              | _ -> anomaly_ill_typed ()
-            in process_args_of_constr (realargs, lra)
+            let rec process_args_of_constr j = function
+            | [] -> ()
+            | t :: lr ->
+              let rar = WfPaths.dest_subterm tree (i - 1) j in
+              let () =
+                if WfPaths.is_norec rar then
+                  if noccur_with_meta n nbfix t then ()
+                  else
+                    raise (CoFixGuardError (env, RecCallInNonRecArgOfConstructor t))
+                else
+                  check_rec_call env true n rar t
+              in
+              process_args_of_constr (j + 1) lr
+            in
+            process_args_of_constr 0 realargs
 
         | Lambda (x,a,b) ->
             let () = assert (List.is_empty args) in
             if noccur_with_meta n nbfix a then
               let env' = push_rel (LocalAssum (x,a)) env in
-              check_rec_call env' alreadygrd (n+1) tree vlra b
+              check_rec_call env' alreadygrd (n+1) tree b
             else
               raise (CoFixGuardError (env,RecCallInTypeOfAbstraction a))
 
@@ -1776,8 +1926,8 @@ let check_one_cofix cache ?evars env nbfix def deftype =
               if Array.for_all (noccur_with_meta n nbfix) varit then
                 let nbfix = Array.length vdefs in
                 let env' = push_rec_types recdef env in
-                (Array.iter (check_rec_call env' alreadygrd (n+nbfix) tree vlra) vdefs;
-                 List.iter (check_rec_call env alreadygrd n tree vlra) args)
+                (Array.iter (check_rec_call env' alreadygrd (n+nbfix) tree) vdefs;
+                 List.iter (check_rec_call env alreadygrd n tree) args)
               else
                 raise (CoFixGuardError (env,RecCallInTypeOfDef c))
             else
@@ -1786,16 +1936,15 @@ let check_one_cofix cache ?evars env nbfix def deftype =
         | Case (ci, u, pms, p, iv, tm, br) -> (* iv ignored: just a cache *)
           begin
             let (_, (p,_), _iv, tm, vrest) = expand_case env (ci, u, pms, p, iv, tm, br) in
-            let tree = match restrict_spec cache ?evars env (Subterm (Int.Set.empty, Strict, tree)) p with
-            | Dead_code -> assert false
-            | Subterm (_, _, tree') -> tree'
+            let tree = match restrict_spec ?evars env (Subterm.strict_subterm tree) p with
+            | Vars _ | DeadCode -> assert false
+            | Subterm (_, tree', _) -> tree'
             | _ -> raise (CoFixGuardError (env, ReturnPredicateNotCoInductive c))
             in
                if (noccur_with_meta n nbfix p) then
                  if (noccur_with_meta n nbfix tm) then
                    if (List.for_all (noccur_with_meta n nbfix) args) then
-                     let vlra = dest_subterms tree in
-                     Array.iter (check_rec_call env alreadygrd n tree vlra) vrest
+                     Array.iter (check_rec_call env alreadygrd n tree) vrest
                    else
                      raise (CoFixGuardError (env,RecCallInCaseFun c))
                  else
@@ -1804,29 +1953,28 @@ let check_one_cofix cache ?evars env nbfix def deftype =
                  raise (CoFixGuardError (env,RecCallInCasePred c))
            end
 
-        | Meta _ -> ()
+        | Meta _ -> assert false
         | Evar _ ->
-            List.iter (check_rec_call env alreadygrd n tree vlra) args
+            List.iter (check_rec_call env alreadygrd n tree) args
         | Rel _ | Var _ | Sort _ | Cast _ | Prod _ | LetIn _ | App _ | Const _
           | Ind _ | Fix _ | Proj _ | Int _ | Float _ | String _
           | Array _ ->
            raise (CoFixGuardError (env,NotGuardedForm t)) in
 
   let ((mind, _),_) = codomain_is_coind ?evars env deftype in
-  let vlra = lookup_subterms env mind in
-  check_rec_call env false 1 vlra (dest_subterms vlra) def
+  let vlra = WfPaths.lookup_subterms env mind in
+  check_rec_call env false 1 vlra def
 
 (* The  function which checks that the whole block of definitions
    satisfies the guarded condition *)
 
 let check_cofix ?evars env (_bodynum,(names,types,bodies as recdef)) =
-  let cache = Cache.create () in
   let flags = Environ.typing_flags env in
   if flags.check_guarded then
     let nbfix = Array.length bodies in
     for i = 0 to nbfix-1 do
       let fixenv = push_rec_types recdef env in
-      try check_one_cofix cache ?evars fixenv nbfix bodies.(i) types.(i)
+      try check_one_cofix ?evars fixenv nbfix bodies.(i) types.(i)
       with CoFixGuardError (errenv,err) ->
         error_ill_formed_rec_body errenv (Type_errors.CoFixGuardError err) names i
           fixenv (judgment_of_fixpoint recdef)
diff --git a/kernel/inductive.mli b/kernel/inductive.mli
index 27c86340ebfb..0bd8b7b096ea 100644
--- a/kernel/inductive.mli
+++ b/kernel/inductive.mli
@@ -193,13 +193,20 @@ val check_case_info : env -> pinductive -> case_info -> unit
     in these containers. *)
 val is_primitive_positive_container : env -> Constant.t -> bool
 
-(** When [chk] is false, the guard condition is not actually
-    checked. *)
-val check_fix : ?evars:evar_handler -> ?elim_to:(Sorts.Quality.t -> Sorts.Quality.t -> bool) -> env -> fixpoint -> unit
+val check_fix_pre_sorts : ?evars:evar_handler -> env -> fixpoint -> (Sorts.t * Sorts.t) list option
+(** Checks fixpoint without checking sort elimination constraints.
+    Returns the list of each fixpoint's structural argument's sort and
+    output sort or None if any elimination constraint was ignored. *)
+
+val check_fix : ?evars:evar_handler -> env -> fixpoint -> unit
+(** Checks fixpoint, along with sort elimination constraints. *)
+
 val check_cofix : ?evars:evar_handler -> env -> cofixpoint -> unit
 
 val abstract_mind_lc : int -> int -> MutInd.t -> (rel_context * constr) array -> constr array
 
+val get_template_instance : mutual_inductive_body -> Instance.t -> Instance.t
+
 module Template : sig
   val bind_kind : Sorts.t -> int option * int option
   val template_subst_sort : template_subst -> Sorts.t -> Sorts.t
diff --git a/kernel/mod_declarations.ml b/kernel/mod_declarations.ml
index 9d6a46221777..227f047e4096 100644
--- a/kernel/mod_declarations.ml
+++ b/kernel/mod_declarations.ml
@@ -39,8 +39,7 @@ and 'a generic_module_body =
     mod_type : module_signature; (** expanded type *)
     mod_type_alg : module_expression option; (** algebraic type *)
     mod_delta : Mod_subst.delta_resolver; (**
-      quotiented set of equivalent constants and inductive names *)
-    mod_retroknowledge : ('a, Retroknowledge.action list) when_mod_body }
+      quotiented set of equivalent constants and inductive names *) }
 
 (** For a module, there are five possible situations:
     - [Declare Module M : T] then [mod_expr = Abstract; mod_type_alg = Some T]
@@ -59,8 +58,6 @@ and module_body = mod_body generic_module_body
 
 and module_type_body = mod_type generic_module_body
 
-type 'a module_retroknowledge = ('a, Retroknowledge.action list) when_mod_body
-
 (** Extra invariants :
 
     - No [MEwith] inside a [mod_expr] implementation : the 'with' syntax
@@ -73,12 +70,11 @@ type 'a module_retroknowledge = ('a, Retroknowledge.action list) when_mod_body
 
 (** Builders *)
 
-let make_module_body typ delta retro = {
+let make_module_body typ delta = {
   mod_expr = ModBodyVal FullStruct;
   mod_type = typ;
   mod_type_alg = None;
   mod_delta = delta;
-  mod_retroknowledge = ModBodyVal retro;
 }
 
 let make_module_type typ delta = {
@@ -86,7 +82,6 @@ let make_module_type typ delta = {
   mod_type = typ;
   mod_type_alg = None;
   mod_delta = delta;
-  mod_retroknowledge = ModTypeNul;
 }
 
 let strengthen_module_body ~src typ delta mb =
@@ -110,12 +105,10 @@ let replace_module_body struc delta mb =
     mod_delta = delta }
 
 let module_type_of_module mb =
-  { mb with mod_expr = ModTypeNul; mod_type_alg = None;
-    mod_retroknowledge = ModTypeNul; }
+  { mb with mod_expr = ModTypeNul; mod_type_alg = None; }
 
 let module_body_of_type mtb =
-  { mtb with mod_expr = ModBodyVal Abstract;
-      mod_retroknowledge = ModBodyVal []; }
+  { mtb with mod_expr = ModBodyVal Abstract; }
 
 (** Setters *)
 
@@ -125,16 +118,12 @@ let set_implementation e mb =
 let set_algebraic_type mb alg =
   { mb with mod_type_alg = Some alg }
 
-let set_retroknowledge mb rk =
-  { mb with mod_retroknowledge = ModBodyVal rk }
-
 (** Accessors *)
 
 let mod_expr { mod_expr = ModBodyVal v; _ } = v
 let mod_type m = m.mod_type
 let mod_type_alg m = m.mod_type_alg
 let mod_delta m = m.mod_delta
-let mod_retroknowledge { mod_retroknowledge = ModBodyVal rk; _ } = rk
 
 let mod_global_delta m = match m.mod_type with
 | MoreFunctor _ -> None
@@ -214,21 +203,18 @@ and hcons_generic_module_body :
   let type' = hcons_module_signature mb.mod_type in
   let type_alg' = mb.mod_type_alg in
   let delta' = mb.mod_delta in
-  let retroknowledge' = mb.mod_retroknowledge in
 
   if
     mb.mod_expr == expr' &&
     mb.mod_type == type' &&
     mb.mod_type_alg == type_alg' &&
-    mb.mod_delta == delta' &&
-    mb.mod_retroknowledge == retroknowledge'
+    mb.mod_delta == delta'
   then mb
   else {
     mod_expr = expr';
     mod_type = type';
     mod_type_alg = type_alg';
     mod_delta = delta';
-    mod_retroknowledge = retroknowledge';
   }
 
 let hcons_module_body =
@@ -273,19 +259,15 @@ let functorize_module params mb =
 
 (** Substitutions of modular structures *)
 
-type subst_kind = Dom | Codom | Both | Neither | Shallow of Mod_subst.substitution
+type subst_kind = Codom | Both | Neither
 
-let subst_dom = Dom
 let subst_codom = Codom
 let subst_dom_codom = Both
-let subst_shallow_dom_codom s = Shallow s
 
 let apply_subst skind subst delta = match skind with
-| Dom -> subst_dom_delta_resolver subst delta
 | Codom -> subst_codom_delta_resolver subst delta
 | Both -> subst_dom_codom_delta_resolver subst delta
 | Neither -> delta
-| Shallow subst' -> subst_dom_codom_delta_resolver subst' delta (* ignore subst *)
 
 let is_functor = function
   | NoFunctor _ -> false
@@ -299,14 +281,6 @@ let subst_with_body subst = function
     let c' = subst_mps subst c in
     if c==c' then orig else WithDef(id,(c',ctx))
 
-let subst_retro : type a. Mod_subst.substitution -> a module_retroknowledge -> a module_retroknowledge =
-  fun subst retro ->
-    match retro with
-    | ModTypeNul as r -> r
-    | ModBodyVal l as r ->
-      let l' = List.Smart.map (subst_retro_action subst) l in
-      if l == l' then r else ModBodyVal l
-
 let rec subst_structure skind subst mp sign =
   let subst_field ((l,body) as orig) = match body with
     | SFBconst cb ->
@@ -329,8 +303,7 @@ let rec subst_structure skind subst mp sign =
 
 and subst_module_body : type a. _ -> _ -> _ -> _ -> a generic_module_body -> a generic_module_body =
   fun is_mod skind subst mp mb ->
-    let { mod_expr=me; mod_type=ty; mod_type_alg=aty;
-          mod_retroknowledge=retro; _ } = mb in
+  let { mod_expr=me; mod_type=ty; mod_type_alg=aty; _ } = mb in
   let mp' = subst_mp subst mp in
   let subst =
     if ModPath.equal mp mp' then subst
@@ -340,16 +313,14 @@ and subst_module_body : type a. _ -> _ -> _ -> _ -> a generic_module_body -> a g
   let ty' = subst_signature skind subst mp ty in
   let me' = subst_impl skind subst mp me in
   let aty' = Option.Smart.map (subst_expression subst) aty in
-  let retro' = subst_retro subst retro in
   let delta' = apply_subst skind subst mb.mod_delta in
   if mp==mp' && me==me' && ty==ty' && aty==aty'
-     && retro==retro' && delta'==mb.mod_delta
+     && delta'==mb.mod_delta
   then mb
   else
     { mod_expr = me';
       mod_type = ty';
       mod_type_alg = aty';
-      mod_retroknowledge = retro';
       mod_delta = delta';
     }
 
diff --git a/kernel/mod_declarations.mli b/kernel/mod_declarations.mli
index 0daff971fee8..2d534d4ca46a 100644
--- a/kernel/mod_declarations.mli
+++ b/kernel/mod_declarations.mli
@@ -25,10 +25,9 @@ type module_body = mod_body generic_module_body
 
 type module_type_body = mod_type 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. *)
+(** A [module_type_body] is just a [module_body] with no implementation. Its
+    [mod_type_alg] contains the algebraic definition of this module type, or
+    [None] if it has been built interactively. *)
 
 type structure_field_body =
   (module_body, module_type_body) Declarations.structure_field_body
@@ -62,14 +61,13 @@ val mod_expr : module_body -> module_implementation
 val mod_type : 'a generic_module_body -> module_signature
 val mod_type_alg : 'a generic_module_body -> module_expression option
 val mod_delta : 'a generic_module_body -> delta_resolver
-val mod_retroknowledge : module_body -> Retroknowledge.action list
 
 val mod_global_delta : 'a generic_module_body -> delta_resolver option
 (** [None] if the argument is a functor, [mod_delta] otherwise *)
 
 (** {6 Builders} *)
 
-val make_module_body : module_signature -> Mod_subst.delta_resolver -> Retroknowledge.action list -> module_body
+val make_module_body : module_signature -> Mod_subst.delta_resolver -> module_body
 val make_module_type : module_signature -> Mod_subst.delta_resolver -> module_type_body
 
 val strengthen_module_body : src:ModPath.t ->
@@ -91,15 +89,12 @@ val functorize_module : (Names.MBId.t * module_type_body) list -> module_body ->
 
 val set_implementation : module_implementation -> module_body -> module_body
 val set_algebraic_type : module_type_body -> module_expression -> module_type_body
-val set_retroknowledge : module_body -> Retroknowledge.action list -> module_body
 
 (** {6 Substitution} *)
 
 type subst_kind
-val subst_dom : subst_kind
 val subst_codom : subst_kind
 val subst_dom_codom : subst_kind
-val subst_shallow_dom_codom : Mod_subst.substitution -> subst_kind
 
 val subst_signature : subst_kind -> substitution ->
   ModPath.t -> module_signature -> module_signature
diff --git a/kernel/mod_subst.ml b/kernel/mod_subst.ml
index 88088010629c..29cc29c3657b 100644
--- a/kernel/mod_subst.ml
+++ b/kernel/mod_subst.ml
@@ -160,20 +160,23 @@ let is_empty_subst = Umap.is_empty
 
 (*  *)
 
-let string_of_hint = function
-  | Inline (_,Some _) -> "inline(Some _)"
-  | Inline _ -> "inline()"
-  | Equiv kn -> KerName.to_string kn
+let string_of_hint pr = function
+  | Inline (_, Some c) -> str "inline(" ++ pr c ++ str ")"
+  | Inline (lvl, None) -> str "inline[" ++ int lvl ++ str "]"
+  | Equiv kn -> str "equiv(" ++ KerName.print kn ++ str ")"
 
-let debug_string_of_delta resolve =
+let debug_pr_delta pr resolve =
   let kn_to_string kn hint l =
-    (KerName.to_string kn ^ "=>" ^ string_of_hint hint) :: l
+    hov 2 (KerName.print kn ++ str " =>" ++ spc() ++ string_of_hint pr hint) :: l
   in
   let mp_to_string mp mp' l =
-    (ModPath.to_string mp ^ "=>" ^ ModPath.to_string mp') :: l
+    hov 2 (ModPath.print mp ++ str " =>" ++ spc() ++ ModPath.print mp') :: l
   in
   let l = Deltamap.fold mp_to_string kn_to_string resolve [] in
-  String.concat ", " (List.rev l)
+  v 0 @@ prlist_with_sep pr_comma (fun p -> p) (List.rev l)
+
+let debug_string_of_delta resolve =
+  string_of_ppcmds @@ debug_pr_delta (fun _ -> str "_") resolve
 
 let list_contents subst =
   let one_pair reso = (ModPath.to_string (Deltamap.root reso), debug_string_of_delta reso) in
@@ -186,9 +189,6 @@ let debug_string_of_subst subst =
   in
   "{" ^ String.concat "; " l ^ "}"
 
-let debug_pr_delta resolve =
-  strbrk (debug_string_of_delta resolve)
-
 let debug_pr_subst subst =
   let l = list_contents subst in
   let f (s1,(s2,s3)) = hov 2 (str s1 ++ spc () ++ str "|-> " ++ str s2 ++
@@ -553,7 +553,9 @@ let subset_prefixed_by mp resolver =
   in
   Deltamap.fold mp_prefix kn_prefix resolver (empty_delta_resolver mp)
 
-let subst_dom_delta_resolver subst resolver =
+let subst_dom_delta_resolver mp_from mp_to resolver =
+  let () = assert (ModPath.equal mp_from resolver.Deltamap.root) in
+  let subst = map_mp mp_from mp_to (empty_delta_resolver mp_to) in
   let mp_apply_subst mkey mequ rslv =
     Deltamap.add_mp (subst_mp subst mkey) mequ rslv
   in
@@ -570,8 +572,7 @@ let subst_mp_delta subst mp mkey =
     (* root(resolve) ⊆ mp' *)
       let mp1 = find_prefix resolve mp' in
       let resolve1 = subset_prefixed_by mp1 resolve in
-      (subst_dom_delta_resolver
-         (map_mp mp1 mkey (empty_delta_resolver mkey)) resolve1), mp1
+      subst_dom_delta_resolver mp1 mkey resolve1, mp1
 
 let gen_subst_delta_resolver dom subst resolver =
   let mp_apply_subst mkey mequ rslv =
diff --git a/kernel/mod_subst.mli b/kernel/mod_subst.mli
index 6ec4ff53c82e..6d5b6e7cff07 100644
--- a/kernel/mod_subst.mli
+++ b/kernel/mod_subst.mli
@@ -94,8 +94,9 @@ val map_mp :
 val join : substitution -> substitution -> substitution
 
 
-(** Apply the substitution on the domain of the resolver  *)
-val subst_dom_delta_resolver : substitution -> delta_resolver -> delta_resolver
+(** [subst_dom_delta_resolver mpfrom mpto delta] substitutes the root of the
+    resolver [delta] from [mpfrom] to [mpto], i.e. performs α-equivalence. *)
+val subst_dom_delta_resolver : ModPath.t -> ModPath.t -> delta_resolver -> delta_resolver
 
 (** Apply the substitution on the codomain of the resolver  *)
 val subst_codom_delta_resolver :
@@ -110,7 +111,7 @@ val subst_dom_codom_delta_resolver :
 val debug_string_of_subst : substitution -> string
 val debug_pr_subst : substitution -> Pp.t
 val debug_string_of_delta : delta_resolver -> string
-val debug_pr_delta : delta_resolver -> Pp.t
+val debug_pr_delta : (Constr.constr UVars.univ_abstracted -> Pp.t) -> delta_resolver -> Pp.t
 (**/**)
 
 (** [subst_mp sub mp] guarantees that whenever the result of the
diff --git a/kernel/mod_typing.ml b/kernel/mod_typing.ml
index 858eb91029b1..b6745cb0ad92 100644
--- a/kernel/mod_typing.ml
+++ b/kernel/mod_typing.ml
@@ -61,7 +61,7 @@ let infer_gen_conv_leq state env c1 c2 =
 type with_body = {
   w_def : Constr.t;
   w_univs : universes;
-  w_bytecode : Vmlibrary.indirect_code option;
+  w_bytecode : Vmlibrary.indirect_code;
 }
 
 let rec check_with_def (cst, ustate) env struc (idl, wth) mp reso =
@@ -83,25 +83,25 @@ let rec check_with_def (cst, ustate) env struc (idl, wth) mp reso =
       (* In the spirit of subtyping.check_constant, we accept
          any implementations of parameters and opaque terms,
          as long as they have the right type *)
-      let ctx' =
+      let (univs, typ), ctx' =
         match cb.const_universes, wth.w_univs with
         | Monomorphic, Monomorphic ->
           let error_univ_mismatch env t1 t2 = function
             | Conversion.Univ err -> error (WithSignatureMismatch (IncompatibleUniverses { err; env; t1; t2 }))
             | Conversion.Qual err -> error (WithSignatureMismatch (IncompatibleQualities { err; env; t1; t2 }))
           in
+          let j = Typeops.infer env' wth.w_def in
           begin match cb.const_body with
           | Undef _ | OpaqueDef _ ->
-            let j = Typeops.infer env' wth.w_def in
             let typ = cb.const_type in
             begin match infer_gen_conv_leq (cst, ustate) env' j.uj_type typ with
-            | Result.Ok cst -> cst
+            | Result.Ok cst -> (cb.const_universes, cb.const_type), cst
             | Result.Error None -> error (WithSignatureMismatch (NotConvertibleTypeField (env', j.uj_type, typ)))
             | Result.Error (Some e) -> error_univ_mismatch env' j.uj_type typ e
             end
           | Def c' ->
             begin match infer_gen_conv (cst, ustate) env' wth.w_def c' with
-            | Result.Ok cst -> cst
+            | Result.Ok cst -> (cb.const_universes, cb.const_type), cst
             | Result.Error None -> error (WithSignatureMismatch (NotConvertibleBodyField (Some (env', wth.w_def, c'))))
             | Result.Error (Some e) -> error_univ_mismatch env' wth.w_def c' e
             end
@@ -110,15 +110,19 @@ let rec check_with_def (cst, ustate) env struc (idl, wth) mp reso =
           end
         | Polymorphic uctx, Polymorphic ctx ->
           let () =
-            if not (UGraph.check_subtype (Environ.universes env) uctx ctx) then
-              error (WithSignatureMismatch (IncompatibleUnivConstraints { got = ctx; expect = uctx }))
+            if not (Subtyping.check_polymorphic_universes env uctx ctx) then
+              error (WithSignatureMismatch (IncompatibleUnivConstraints { env; got = ctx; expect = uctx }))
           in
           (** Terms are compared in a context with De Bruijn universe indices *)
           let () = check_ucontext (UVars.AbstractContext.repr uctx) env in
-          let env' = Environ.push_context ~strict:false (UVars.AbstractContext.repr uctx) env in
+          let j =
+            (* Use 1. the external environment with 2. the with Definition constraints *)
+            let jenv = Environ.push_context ~strict:false (UVars.AbstractContext.repr ctx) env in
+            Typeops.infer jenv wth.w_def
+          in
+          let env' = Environ.push_context ~strict:false (UVars.AbstractContext.repr uctx) env' in
           let () = match cb.const_body with
             | Undef _ | OpaqueDef _ ->
-              let j = Typeops.infer env' wth.w_def in
               let typ = cb.const_type in
               begin match Conversion.conv_leq env' j.uj_type typ with
               | Result.Ok () -> ()
@@ -132,14 +136,23 @@ let rec check_with_def (cst, ustate) env struc (idl, wth) mp reso =
             | Primitive _ -> error WithCannotConstrainPrimitive
             | Symbol _ -> error WithCannotConstrainSymbol
           in
-          cst
+          (cb.const_universes, cb.const_type), cst
         | Monomorphic, Polymorphic _ -> error (WithSignatureMismatch (PolymorphicStatusExpected true))
         | Polymorphic _, Monomorphic -> error (WithSignatureMismatch (PolymorphicStatusExpected false))
       in
+      (* Here we have two choices for the type of the constant: either pick the
+         type T from module constant or the type U from the with Definition
+         constant, including their universe constraints. In general, we only
+         have U ≤ T, so the corresponding module types will only satisfy
+         MU ≤ MT. In some sense MU is minimal and MT maximal, so both are
+         canonical. Depending on the context, one may be preferred to the
+         other but there is no "best" choice a priori. Some code out there
+         depends on picking MT, so we enshrine this decision here. *)
       let cb' =
         { cb with
           const_body = Def wth.w_def;
-          const_universes = wth.w_univs;
+          const_type = typ;
+          const_universes = univs;
           const_body_code = wth.w_bytecode; }
       in
       before@(lab,SFBconst(cb'))::after, ctx'
@@ -218,15 +231,14 @@ let rec check_with_mod (cst, ustate) env struc (idl,new_mp) mp reso =
         let new_after = subst_structure id_subst mp after in
         before @ (lab, SFBmodule new_mb) :: new_after, subreso, cst
       | Algebraic (MENoFunctor (MEident mp0)) ->
-        let mpnew = rebuild_mp mp0 idl in
-        check_modpath_equiv env' mpnew mp;
+        let () = check_modpath_equiv env' new_mp (rebuild_mp mp0 idl) in
         before@(lab,spec)::after, reso, cst
       | _ -> error_generative_module_expected lab
       end
   with
   | Not_found -> error_no_such_label lab mp
 
-type 'a vm_handler = { vm_handler : env -> universes -> Constr.t -> 'a -> 'a * Vmlibrary.indirect_code option }
+type 'a vm_handler = { vm_handler : env -> universes -> Constr.t -> 'a -> 'a * Vmlibrary.indirect_code }
 type 'a vm_state = 'a * 'a vm_handler
 
 let check_with ustate vmstate env mp (sign,reso,cst,vm) = function
@@ -326,12 +338,12 @@ and translate_modtype state vmstate env mp inl (params,mte) =
 let finalize_module_alg (cst, ustate) (vm, vmstate) env mp (sign,alg,reso) restype = match restype with
   | None ->
     let impl = match alg with Some e -> Algebraic e | None -> FullStruct in
-    let mb = make_module_body sign reso [] in
+    let mb = make_module_body sign reso in
     let mb = set_implementation impl mb in
     mb, cst, vm
   | Some (params_mte,inl) ->
     let res_mtb, cst, vm = translate_modtype (cst, ustate) (vm, vmstate) env mp inl params_mte in
-    let auto_mtb = Mod_declarations.make_module_body sign reso [] in
+    let auto_mtb = Mod_declarations.make_module_body sign reso in
     (* This function is supposed to be called in a state where the current module
        is about to be closed, so all subcomponents of the module are already
        part of the environment. We only need to add the toplevel module entry. *)
@@ -375,9 +387,11 @@ let translate_module (cst, ustate) (vm, vmstate) env mp inl = function
     (see #3746). Note that restricted non-functorized modules are ok,
     thanks to strengthening. *)
 
-let rec unfunct = function
-  | MENoFunctor me -> me
-  | MEMoreFunctor me -> unfunct me
+let rec unfunct env = function
+| NoFunctor me -> env, me
+| MoreFunctor (mbid, mtb, me) ->
+  let env = Modops.add_module_parameter mbid mtb env in
+  unfunct env me
 
 let rec forbid_incl_signed_functor env = function
   | MEapply(fe,_) -> forbid_incl_signed_functor env fe
@@ -388,9 +402,11 @@ let rec forbid_incl_signed_functor env = function
     | MoreFunctor _, Some _, _ ->
       (* functor + restricted signature = error *)
       error_include_restricted_functor mp1
-    | MoreFunctor _, None, Algebraic me ->
+    | MoreFunctor _ as sign, None, Algebraic me ->
       (* functor, no signature yet, a definition which may be restricted *)
-      forbid_incl_signed_functor env (unfunct me)
+      let me = annotate_module_expression me sign in
+      let env, me = unfunct env me in
+      forbid_incl_signed_functor env me
     | _ -> ()
 
 let rec translate_mse_include_module (cst, ustate) (vm, vmstate) env mp inl = function
diff --git a/kernel/mod_typing.mli b/kernel/mod_typing.mli
index 6218fe2d4137..95f8863b10a0 100644
--- a/kernel/mod_typing.mli
+++ b/kernel/mod_typing.mli
@@ -17,7 +17,7 @@ open Names
 
 (** Main functions for translating module entries *)
 
-type 'a vm_handler = { vm_handler : env -> universes -> Constr.t -> 'a -> 'a * Vmlibrary.indirect_code option }
+type 'a vm_handler = { vm_handler : env -> universes -> Constr.t -> 'a -> 'a * Vmlibrary.indirect_code }
 type 'a vm_state = 'a * 'a vm_handler
 
 (** [translate_module] produces a [module_body] out of a [module_entry].
diff --git a/kernel/modops.ml b/kernel/modops.ml
index cb696805b2fd..6a025b9a0237 100644
--- a/kernel/modops.ml
+++ b/kernel/modops.ml
@@ -50,7 +50,7 @@ type signature_mismatch_error =
   | IncompatibleUniverses of { err : UGraph.univ_inconsistency; env : env; t1 : types; t2 : types }
   | IncompatibleQualities of { err : QGraph.elimination_error; env : env; t1 : types; t2 : types }
   | IncompatiblePolymorphism of env * types * types
-  | IncompatibleUnivConstraints of { got : UVars.AbstractContext.t; expect : UVars.AbstractContext.t }
+  | IncompatibleUnivConstraints of { env : env; got : UVars.AbstractContext.t; expect : UVars.AbstractContext.t }
   | IncompatibleVariance
   | NoRewriteRulesSubtyping
 
@@ -193,8 +193,7 @@ and add_module mp mb linkinfo env =
   match mod_type mb with
   | NoFunctor struc ->
     let delta = get_global_delta mb in
-    add_retroknowledge (mod_retroknowledge mb)
-      (add_structure mp struc delta linkinfo env)
+    add_structure mp struc delta linkinfo env
   | MoreFunctor _ -> env
 
 let add_linked_module mp mb linkinfo env =
@@ -220,7 +219,7 @@ let strengthen_const mp_from l cb resolver =
     let u = UVars.make_abstract_instance (Declareops.constant_polymorphic_context cb) in
       { cb with
         const_body = Def (mkConstU (con,u));
-        const_body_code = Some (Vmbytegen.compile_alias con) }
+        const_body_code = Vmbytegen.compile_alias con }
 
 let rec strengthen_module mp mb = match mod_type mb with
 | NoFunctor struc ->
@@ -270,14 +269,15 @@ let rec strengthen_and_subst_module mb subst mp_from mp_to =
   | NoFunctor struc ->
     let delta_mb = get_global_delta mb in
     let mb_is_an_alias = mp_in_delta mp_from delta_mb in
-    if mb_is_an_alias then subst_module subst_dom subst mp_from mb
+    if mb_is_an_alias then
+      subst_module subst_dom_codom subst mp_from mb
     else
       let reso',struc' =
         strengthen_and_subst_struct struc subst
           mp_from mp_to false false delta_mb
       in
       (* Don't forget to add the original resolver up to substitution *)
-      let reso' = add_delta_resolver (subst_dom_delta_resolver subst delta_mb) (add_mp_delta_resolver mp_to mp_from reso') in
+      let reso' = add_delta_resolver (subst_dom_delta_resolver mp_from mp_to delta_mb) (add_mp_delta_resolver mp_to mp_from reso') in
       strengthen_module_body ~src:mp_from (NoFunctor struc') reso' mb
   | MoreFunctor _ ->
     let subst = add_mp mp_from mp_to (empty_delta_resolver mp_to) subst in
@@ -331,7 +331,7 @@ and strengthen_and_subst_struct struc subst mp_from mp_to alias incl reso =
         let mp_from' = MPdot (mp_from,l) in
         let mp_to' = MPdot (mp_to,l) in
         let mb' = if alias then
-          subst_module subst_dom subst mp_from' mb
+          subst_module subst_dom_codom subst mp_from' mb
         else
           strengthen_and_subst_module mb subst mp_from' mp_to'
         in
@@ -350,7 +350,7 @@ and strengthen_and_subst_struct struc subst mp_from mp_to alias incl reso =
         let mp_from' = MPdot (mp_from,l) in
         let mp_to' = MPdot(mp_to,l) in
         let subst' = add_mp mp_from' mp_to' (empty_delta_resolver mp_to') subst in
-        let mty' = subst_modtype (subst_shallow_dom_codom subst') subst' mp_from' mty in
+        let mty' = subst_modtype subst_dom_codom subst' mp_from' mty in
         let item' = if mty' == mty then item else (l, SFBmodtype mty') in
         add_mp_delta_resolver mp_to' mp_to' reso', item'
   in
@@ -379,10 +379,9 @@ let strengthen_and_subst_module_body mp_from mb mp include_b = match mod_type mb
     (* if mb.mod_mp is an alias then the strengthening is useless
        (i.e. it is already done)*)
     let mp_alias = mp_of_delta delta_mb mp_from in
-    let subst_resolver = map_mp mp_from mp (empty_delta_resolver mp) in
     let new_resolver =
       add_mp_delta_resolver mp mp_alias
-        (subst_dom_delta_resolver subst_resolver delta_mb)
+        (subst_dom_delta_resolver mp_from mp delta_mb)
     in
     let subst = map_mp mp_from mp new_resolver in
     let reso',struc' =
diff --git a/kernel/modops.mli b/kernel/modops.mli
index c46a9c6ee743..70f0b8c3bae1 100644
--- a/kernel/modops.mli
+++ b/kernel/modops.mli
@@ -104,7 +104,7 @@ type signature_mismatch_error =
   | IncompatibleUniverses of { err : UGraph.univ_inconsistency; env : env; t1 : types; t2 : types }
   | IncompatibleQualities of { err : QGraph.elimination_error; env : env; t1 : types; t2 : types }
   | IncompatiblePolymorphism of env * types * types
-  | IncompatibleUnivConstraints of { got : UVars.AbstractContext.t; expect : UVars.AbstractContext.t }
+  | IncompatibleUnivConstraints of { env : env; got : UVars.AbstractContext.t; expect : UVars.AbstractContext.t }
   | IncompatibleVariance
   | NoRewriteRulesSubtyping
 
diff --git a/kernel/names.ml b/kernel/names.ml
index e05d4354e3d9..b3ed56254d24 100644
--- a/kernel/names.ml
+++ b/kernel/names.ml
@@ -961,6 +961,9 @@ module PRmap = HMap.Make(Projection.Repr.CanOrd)
 module PRset = PRmap.Set
 module PRpred = Predicate.Make(Projection.Repr.CanOrd)
 
+module PRmap_env = HMap.Make(Projection.Repr.UserOrd)
+module PRset_env = PRmap_env.Set
+
 module GlobRefInternal = struct
 
   type t =
diff --git a/kernel/names.mli b/kernel/names.mli
index f8ee314b58d0..8d2cf53adb96 100644
--- a/kernel/names.mli
+++ b/kernel/names.mli
@@ -162,8 +162,8 @@ sig
   module Map : Map.ExtS with type key = t and module Set := Set
 end
 
-module DPset = DirPath.Set [@@deprecated "Use DirPath.Set"]
-module DPmap = DirPath.Map [@@deprecated "Use DirPath.Map"]
+module DPset = DirPath.Set [@@deprecated "(9.2) Use DirPath.Set"]
+module DPmap = DirPath.Map [@@deprecated "(9.2) Use DirPath.Map"]
 
 (** {6 Unique names for bound modules} *)
 
@@ -203,8 +203,8 @@ sig
 
 end
 
-module MBIset = MBId.Set [@@deprecated "Use MBId.Set"]
-module MBImap = MBId.Map [@@deprecated "Use MBId.Map"]
+module MBIset = MBId.Set [@@deprecated "(9.2) Use MBId.Set"]
+module MBImap = MBId.Map [@@deprecated "(9.2) Use MBId.Map"]
 
 (** {6 The module part of the kernel name } *)
 
@@ -243,8 +243,8 @@ sig
 
 end
 
-module MPset = ModPath.Set [@@deprecated "Use ModPath.Set"]
-module MPmap = ModPath.Map [@@deprecated "Use ModPath.Map"]
+module MPset = ModPath.Set [@@deprecated "(9.2) Use ModPath.Set"]
+module MPmap = ModPath.Map [@@deprecated "(9.2) Use ModPath.Map"]
 
 (** {6 The absolute names of objects seen by kernel } *)
 
@@ -283,9 +283,9 @@ sig
 
 end
 
-module KNset = KerName.Set [@@deprecated "Use KerName.Set"]
-module KNpred = KerName.Pred [@@deprecated "Use KerName.Pred"]
-module KNmap = KerName.Map [@@deprecated "Use KerName.Map"]
+module KNset = KerName.Set [@@deprecated "(9.2) Use KerName.Set"]
+module KNpred = KerName.Pred [@@deprecated "(9.2) Use KerName.Pred"]
+module KNmap = KerName.Map [@@deprecated "(9.2) Use KerName.Map"]
 
 (** {6 Signature for quotiented names} *)
 
@@ -396,11 +396,15 @@ end
    the others consider an order on canonical part of names*)
 module Cpred : Predicate.S with type elt = Constant.t
 module Cset : CSig.USetS with type elt = Constant.t
+[@@ocaml.deprecated "(9.3) This will switch to user ordering at some point in \
+the future. In the meantime either use the _env variant or the Q-variant from \
+Environ, depending on the desired semantics."]
 module Cset_env  : CSig.USetS with type elt = Constant.t
 
-module Cmap : Map.UExtS with type key = Constant.t and module Set := Cset
-(** A map whose keys are constants (values of the {!Constant.t} type).
-    Keys are ordered wrt. "canonical form" of the constant. *)
+module Cmap : Map.UExtS with type key = Constant.t and module Set := Cset [@@ocaml.warning "-3"]
+[@@ocaml.deprecated "(9.3) This will switch to user ordering at some point in \
+the future. In the meantime either use the _env variant or the Q-variant from \
+Environ, depending on the desired semantics."]
 
 module Cmap_env : Map.UExtS with type key = Constant.t and module Set := Cset_env
 (** A map whose keys are constants (values of the {!Constant.t} type).
@@ -618,7 +622,16 @@ module Projection : sig
 end
 
 module PRset : CSig.USetS with type elt = Projection.Repr.t
-module PRmap : Map.UExtS with type key = Projection.Repr.t and module Set := PRset
+[@@ocaml.deprecated "(9.3) This will switch to user ordering at some point in \
+the future. In the meantime either use the _env variant or the Q-variant from \
+Environ, depending on the desired semantics."]
+module PRmap : Map.UExtS with type key = Projection.Repr.t and module Set := PRset [@@ocaml.warning "-3"]
+[@@ocaml.deprecated "(9.3) This will switch to user ordering at some point in \
+the future. In the meantime either use the _env variant or the Q-variant from \
+Environ, depending on the desired semantics."]
+
+module PRset_env : CSig.USetS with type elt = Projection.Repr.t
+module PRmap_env : Map.UExtS with type key = Projection.Repr.t and module Set := PRset_env
 
 (** Predicate on projection representation (ignoring unfolding state) *)
 module PRpred : Predicate.S with type elt = Projection.Repr.t
@@ -648,6 +661,9 @@ module GlobRef : sig
 
   module Map : Map.UExtS
     with type key = t and module Set := Set [@@ocaml.warning "-3"]
+  [@@ocaml.deprecated "(9.3) This will switch to user ordering at some point in \
+  the future. In the meantime either use the _env variant or the Q-variant from \
+  Environ, depending on the desired semantics."]
 
   val print : t -> Pp.t
   (** Print internal representation (not to be used for user-facing messages). *)
diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index a1439a6685d8..a869bebd8cc9 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -73,13 +73,13 @@ type prefix = string
 
 (* Linked code location utilities *)
 let get_mind_prefix env mind =
-   let _,name,_ = lookup_mind_key mind env in
+   let name = lookup_mind_key mind env in
    match !name with
    | NotLinked -> ""
    | Linked s -> s
 
 let get_const_prefix env c =
-   let _,(nameref,_),_ = lookup_constant_key c env in
+   let nameref, _ = lookup_constant_key c env in
    match !nameref with
    | NotLinked -> ""
    | Linked s -> s
@@ -2283,7 +2283,8 @@ let empty_updates = Mindmap_env.empty, Cmap_env.empty
 
 let compile_mind_deps cenv env prefix
     (comp_stack, (mind_updates, const_updates) as init) mind =
-  let mib,nameref,_ = lookup_mind_key mind env in
+  let mib = lookup_mind mind env in
+  let nameref = lookup_mind_key mind env in
   if is_code_loaded nameref
     || Mindmap_env.mem mind mind_updates
   then init
@@ -2306,7 +2307,8 @@ let compile_deps cenv env sigma prefix init t =
   | Ind ((mind,_),_u) -> compile_mind_deps cenv env prefix init mind
   | Const (c, _u) ->
     let c, _ = get_alias env sigma c in
-    let cb,(nameref,_),_ = lookup_constant_key c env in
+    let cb = lookup_constant c env in
+    let (nameref, _) = lookup_constant_key c env in
     let (_, (_, const_updates)) = init in
     if is_code_loaded nameref
     || (Cmap_env.mem c const_updates)
diff --git a/kernel/nativeconv.ml b/kernel/nativeconv.ml
index 3ff5907a6257..0b40d61b78e9 100644
--- a/kernel/nativeconv.ml
+++ b/kernel/nativeconv.ml
@@ -31,6 +31,13 @@ let convert_instances ~flex u1 u2 (state, check, box) =
   let state, check = Conversion.convert_instances ~flex u1 u2 (state, check) in
   fail_check state check box
 
+let convert_inductives env pb ind u1 u2 ((state, check, box) as cuniv) =
+  match (Environ.lookup_mind ind env).mind_variance with
+  | None -> convert_instances ~flex:false u1 u2 cuniv
+  | Some variances ->
+    let state, check = Conversion.convert_instances_cumul pb variances u1 u2 (state, check) in
+    fail_check state check box
+
 let sort_cmp_universes pb s1 s2 (state, check, box) =
   let state, check = Conversion.sort_cmp_universes pb s1 s2 (state, check) in
   fail_check state check box
@@ -103,17 +110,24 @@ and conv_atom env pb lvl a1 a2 cu =
     | Arel i1, Arel i2 ->
         if Int.equal i1 i2 then cu else raise NotConvertible
     | Aind (ind1,u1), Aind (ind2,u2) ->
-       if Ind.CanOrd.equal ind1 ind2 then convert_instances ~flex:false u1 u2 cu
+      if QInd.equal env ind1 ind2 then
+        (* Aind is an accumulator but not a neutral, so we always
+           convert at a common type (after applying arguments).
+
+           Therefore if the inductive is not fully applied then the
+           missing parameters have identical types,
+           and we don't need to eta expand to use cumulativity. *)
+        convert_inductives env pb (fst ind1) u1 u2 cu
        else raise NotConvertible
     | Aconstant (c1,u1), Aconstant (c2,u2) ->
-       if Constant.CanOrd.equal c1 c2 then convert_instances ~flex:true u1 u2 cu
+       if QConstant.equal env c1 c2 then convert_instances ~flex:true u1 u2 cu
        else raise NotConvertible
     | Asort s1, Asort s2 ->
       sort_cmp_universes pb s1 s2 cu
     | Avar id1, Avar id2 ->
         if Id.equal id1 id2 then cu else raise NotConvertible
     | Acase(a1,ac1,p1,bs1), Acase(a2,ac2,p2,bs2) ->
-        if not (Ind.CanOrd.equal a1.asw_ind a2.asw_ind) then raise NotConvertible;
+        if not (QInd.equal env a1.asw_ind a2.asw_ind) then raise NotConvertible;
         let cu = conv_accu env CONV lvl ac1 ac2 cu in
         let tbl = a1.asw_reloc in
         let len = Array.length tbl in
@@ -143,7 +157,7 @@ and conv_atom env pb lvl a1 a2 cu =
         else
           Array.fold_left2 (fun cu v1 v2 -> conv_val env CONV lvl v1 v2 cu) (conv_fix env lvl t1 f1 t2 f2 cu) args1 args2
     | Aproj((ind1, i1), ac1), Aproj((ind2, i2), ac2) ->
-       if not (Ind.CanOrd.equal ind1 ind2 && Int.equal i1 i2) then raise NotConvertible
+       if not (QInd.equal env ind1 ind2 && Int.equal i1 i2) then raise NotConvertible
        else conv_accu env CONV lvl ac1 ac2 cu
     | Arel _, _ | Aind _, _ | Aconstant _, _ | Asort _, _ | Avar _, _
     | Acase _, _ | Afix _, _ | Acofix _, _
diff --git a/kernel/nativelib.ml b/kernel/nativelib.ml
index 7819b8f9642a..4a2c2c731b18 100644
--- a/kernel/nativelib.ml
+++ b/kernel/nativelib.ml
@@ -34,12 +34,24 @@ let ( / ) = Filename.concat
 
 (* Directory for temporary files for the conversion and normalisation
    (as opposed to compiling the library itself, which uses [output_dir]). *)
-let my_temp_dir = lazy (CUnix.mktemp_dir "Coq_native" "")
+let temp_dir = ref None
+
+let force_temp_dir () =
+  match !temp_dir with
+  | None ->
+    let tmp = CUnix.mktemp_dir "Coq_native" "" in
+    temp_dir := Some tmp;
+    tmp
+  | Some tmp -> tmp
+
+let temp_dir () = !temp_dir
 
 let () = at_exit (fun () ->
-    if not (keep_debug_files ()) && Lazy.is_val my_temp_dir then
+    let tmp = if not (keep_debug_files ()) then None else temp_dir() in
+    match tmp with
+    | None -> ()
+    | Some d ->
       try
-        let d = Lazy.force my_temp_dir in
         Array.iter (fun f -> Sys.remove (Filename.concat d f)) (Sys.readdir d);
         Unix.rmdir d
       with (Unix.Unix_error _ | Sys_error _) as e ->
@@ -67,9 +79,9 @@ let get_include_dirs () =
         Pp.(str "Native compute with -boot: you must also give -nI pointing to the kernel.")
   | _::_ as l -> l
   in
-  if Lazy.is_val my_temp_dir
-  then (Lazy.force my_temp_dir) :: base
-  else base
+  match temp_dir() with
+  | Some tmp -> tmp :: base
+  | None -> base
 
 (* Pointer to the function linking an ML object into Rocq's toplevel *)
 let load_obj = ref (fun _x -> () : string -> unit)
@@ -81,7 +93,7 @@ let rt2 = ref None
 let get_symbols () = !rsymbols
 
 let get_ml_filename () =
-  let temp_dir = Lazy.force my_temp_dir in
+  let temp_dir = force_temp_dir() in
   let filename = Filename.temp_file ~temp_dir "Coq_native" source_ext in
   let prefix = Filename.chop_extension (Filename.basename filename) ^ "." in
   filename, prefix
diff --git a/kernel/nativevalues.ml b/kernel/nativevalues.ml
index 2459a09edd3d..fd3a06d759f6 100644
--- a/kernel/nativevalues.ml
+++ b/kernel/nativevalues.ml
@@ -109,23 +109,23 @@ let ret_accu = Obj.repr (ref ())
 
 type accu_val = { acc_atm : atom; acc_arg : t list }
 
-external set_tag : Obj.t -> int -> unit = "rocq_obj_set_tag"
+(** Return a pointer to [caml_curry2_1] that is also recognized as an unscannable block *)
+external get_curry2_1 : unit -> Obj.t = "rocq_curry2_1_addr"
 
-let mk_accu (a : atom) : t =
+type _ curry2_1_clos = Curry2_1 : Obj.t * int * 'a * ('a -> 'b -> 'c) -> ('b -> 'c) curry2_1_clos
+
+let mk_accu =
+  let curry2_1 = get_curry2_1 () in
   let rec accumulate data x =
     if Obj.repr 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 () = 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 () = set_tag ans accumulate_tag in
-  (Obj.obj ans : t)
+      let ans = Curry2_1 (curry2_1, 2, data, accumulate) in
+      Obj.repr ans in
+  fun (a : atom) ->
+  let data = { acc_atm = a; acc_arg = [] } in
+  let ans = Curry2_1 (curry2_1, 2, data, accumulate) in
+  (Obj.magic ans : t)
 
 let get_accu (k : accumulator) =
   (Obj.magic k : Obj.t -> accu_val) ret_accu
diff --git a/kernel/pConstraints.ml b/kernel/pConstraints.ml
index 26fddd996968..b863db67dae7 100644
--- a/kernel/pConstraints.ml
+++ b/kernel/pConstraints.ml
@@ -59,12 +59,12 @@ let filter_qualities f (qc, lc) =
 let filter_univs f (qc, lc) =
   make qc @@ UnivConstraints.filter f lc
 
-let pr prv prl (qc, lc) =
+let pr (printer:Sorts.printer) (qc, lc) =
   let open Pp in
   let sep = if ElimConstraints.is_empty qc || UnivConstraints.is_empty lc
             then mt ()
             else pr_comma () in
-  v 0 (ElimConstraints.pr prv qc ++ sep ++ UnivConstraints.pr prl lc)
+  v 0 (ElimConstraints.pr printer.prq qc ++ sep ++ UnivConstraints.pr printer.pru lc)
 
 module HPConstraints =
   Hashcons.Make(
diff --git a/kernel/pConstraints.mli b/kernel/pConstraints.mli
index 91410d3c74ee..7dbaeeb8edbe 100644
--- a/kernel/pConstraints.mli
+++ b/kernel/pConstraints.mli
@@ -48,7 +48,7 @@ val elements : t -> ElimConstraint.t list * UnivConstraint.t list
 val filter_qualities : (ElimConstraints.elt -> bool) -> t -> t
 val filter_univs : (UnivConstraints.elt -> bool) -> t -> t
 
-val pr : (QVar.t -> Pp.t) -> (Level.t -> Pp.t) -> t -> Pp.t
+val pr : Sorts.printer -> t -> Pp.t
 
 val hcons : t Hashcons.f
 
diff --git a/kernel/qGraph.ml b/kernel/qGraph.ml
index fe26f61d1047..609f46a287b0 100644
--- a/kernel/qGraph.ml
+++ b/kernel/qGraph.ml
@@ -23,8 +23,9 @@ module ElimTable = struct
     match q, q' with
     | QConstant QType, _ -> true
     | QConstant q, QConstant q' -> const_eliminates_to q q'
+    | QGlobal q, QGlobal q' -> QGlobal.equal q q'
     | QVar q, QVar q' -> QVar.equal q q'
-    | (QConstant _ | QVar _), _ -> false
+    | (QConstant _ | QGlobal _ | QVar _), _ -> false
 end
 
 module G = AcyclicGraph.Make(struct
@@ -34,6 +35,7 @@ module G = AcyclicGraph.Make(struct
 
     let equal = Quality.equal
     let compare = Quality.compare
+    let root = None
 
     let raw_pr = Quality.raw_pr
 
@@ -94,6 +96,7 @@ type t =
     ground_and_global_sorts: Quality.Set.t;
     dominant: Quality.t QMap.t;
     delayed_check: QSet.t QMap.t;
+    ignore_constraints: bool;
   }
 
 type path_explanation = G.explanation Lazy.t
@@ -103,7 +106,7 @@ type explanation =
   | Other of Pp.t
 
 type quality_inconsistency =
-  ((QVar.t -> Pp.t) option) *
+  (Quality.printer option) *
     (ElimConstraint.kind * Quality.t * Quality.t * explanation option)
 
 (* If s can eliminate to s', we want an edge between s and s'.
@@ -123,6 +126,9 @@ type elimination_error =
 
 exception EliminationError of elimination_error
 
+let set_ignore_constraints b g = {g with ignore_constraints=b}
+let ignore_constraints g = g.ignore_constraints
+
 let non_refl_pairs l =
   let fold x =
     List.fold_right (fun y acc -> if x <> y then (x,y) :: acc else acc) l in
@@ -162,40 +168,36 @@ let rec update_dominance g q qv =
      | None -> None
 
 let update_dominance_if_valid g (q1,k,q2) =
+  let open Quality in
   match k with
   | ElimConstraint.ElimTo ->
-     (* if the constraint is s ~> g, dominants are not modified. *)
-     if Quality.is_qconst q2 then Some g
-     else
-       match q1, q2 with
-       | (Quality.QConstant _ | Quality.QVar _), Quality.QConstant _ -> assert false
-       | Quality.QVar qv1, Quality.QVar qv2 ->
-          (* 3 cases:
-             - if [qv1] is a global, treat as constants.
-             - if [qv1] is not dominated, delay the check to when [qv1] gets dominated.
-             - if [qv1] is dominated, try to update the dominance of [qv2]. *)
-          if Quality.is_qglobal q1 then update_dominance g q1 qv2
-          else
-            (match QMap.find_opt qv1 g.dominant with
-            | None ->
-               let add_delayed qs =
-                 Some { g with delayed_check = QMap.set qv1 (QSet.add qv2 qs) g.delayed_check }
-               in
-               (match QMap.find_opt qv1 g.delayed_check with
-               | None -> add_delayed QSet.empty
-               | Some qs -> add_delayed qs)
-            | Some q' -> update_dominance g q' qv2)
-       | Quality.QConstant _, Quality.QVar qv -> update_dominance g q1 qv
+    match q1, q2 with
+    | _, (QConstant _ | QGlobal _) ->
+      (* if the constraint is s ~> g, dominants are not modified. *)
+      Some g
+    | (QConstant _ | QGlobal _), QVar qv -> update_dominance g q1 qv
+    | QVar qv1, QVar qv2 ->
+      (* 2 cases:
+         - if [qv1] is not dominated, delay the check to when [qv1] gets dominated.
+         - if [qv1] is dominated, try to update the dominance of [qv2]. *)
+      (match QMap.find_opt qv1 g.dominant with
+       | None ->
+         let add_delayed qs =
+           Some { g with delayed_check = QMap.set qv1 (QSet.add qv2 qs) g.delayed_check }
+         in
+         (match QMap.find_opt qv1 g.delayed_check with
+          | None -> add_delayed QSet.empty
+          | Some qs -> add_delayed qs)
+       | Some q' -> update_dominance g q' qv2)
 
 let dominance_check g (q1,_,q2 as cstr) =
+  let open Quality in
   let dom_q1 () = match q1 with
-    | Quality.QConstant _ -> q1
-    | Quality.QVar qv ->
-       if Quality.is_qglobal q1 then q1
-       else QMap.find qv g.dominant in
+    | QConstant _ | QGlobal _ -> q1
+    | QVar qv -> QMap.find qv g.dominant in
   let dom_q2 () = match q2 with
-    | Quality.QConstant _ -> assert false
-    | Quality.QVar qv -> QMap.find qv g.dominant in
+    | QConstant _ | QGlobal _ -> assert false
+    | QVar qv -> QMap.find qv g.dominant in
   match update_dominance_if_valid g cstr with
   | None -> raise (EliminationError (MultipleDominance (dom_q2() , q2, dom_q1())))
   | Some g -> g
@@ -225,6 +227,7 @@ let enforce_func k q1 q2 g = match k with
 let enforce_constraint (q1, k, q2) g =
   match enforce_func k q1 q2 g with
   | None ->
+     if ignore_constraints g then g else
      let e = lazy (G.get_explanation (q1,to_graph_cstr k,q2) g.graph) in
      raise @@ EliminationError (QualityInconsistency (None, (k, q1, q2, Some (Path e))))
   | Some g ->
@@ -232,8 +235,10 @@ let enforce_constraint (q1, k, q2) g =
 
 let merge_constraints csts g = ElimConstraints.fold enforce_constraint csts g
 
-let check_constraint g (q1, k, q2) = match k with
-| ElimConstraint.ElimTo -> G.check_leq g.graph q1 q2
+let check_constraint g (q1, k, q2) =
+  ignore_constraints g ||
+  match k with
+  | ElimConstraint.ElimTo -> G.check_leq g.graph q1 q2
 
 let check_constraints csts g = ElimConstraints.for_all (check_constraint g) csts
 
@@ -243,13 +248,18 @@ let add_quality q g =
   let graph = G.add q g.graph in
   let g = enforce_constraint (Quality.qtype, ElimConstraint.ElimTo, q) { g with graph } in
   let (paths,ground_and_global_sorts) =
-    if Quality.is_qglobal q
+    let is_global = match q with
+      | QGlobal _ -> true
+      | QVar q -> QVar.is_secvar q
+      | QConstant _ -> assert false
+    in
+    if is_global
     then (RigidPaths.add_elim_to Quality.qtype q g.rigid_paths, Quality.Set.add q g.ground_and_global_sorts)
     else (g.rigid_paths,g.ground_and_global_sorts) in
   (* As Type ~> s, set Type to be the dominant sort of q if q is a variable. *)
   let dominant = match q with
-    | Quality.QVar qv -> QMap.add qv Quality.qtype g.dominant
-    | Quality.QConstant _ -> g.dominant in
+    | QVar qv -> QMap.add qv Quality.qtype g.dominant
+    | QConstant _ | QGlobal _ -> g.dominant in
   { g with rigid_paths = paths; ground_and_global_sorts; dominant }
 
 let enforce_eliminates_to s1 s2 g =
@@ -271,9 +281,11 @@ let initial_graph =
     rigid_paths = p;
     ground_and_global_sorts = Quality.Set.of_list Quality.all_constants;
     dominant = QMap.empty;
-    delayed_check = QMap.empty; }
+    delayed_check = QMap.empty;
+    ignore_constraints = false }
 
 let eliminates_to g q q' =
+  ignore_constraints g ||
   G.check_leq g.graph q q'
 
 let update_rigids g g' =
@@ -284,6 +296,8 @@ let sort_eliminates_to g s1 s2 =
 
 let eliminates_to_prop g q = eliminates_to g q Quality.qprop
 
+let mem q g = Quality.Set.mem q (G.domain g.graph)
+
 let domain g = G.domain g.graph
 
 let qvar_domain g =
@@ -316,14 +330,14 @@ let pr_arc prq =
   | q1, G.Node ltle ->
     if Quality.Map.is_empty ltle then mt ()
     else
-      prq q1 ++ spc () ++
+      Quality.pr prq q1 ++ spc () ++
       v 0
         (pr_pmap spc (fun (q2, _) ->
-              str "-> " ++ prq q2)
+              str "-> " ++ Quality.pr prq q2)
             ltle) ++
       fnl ()
   | q1, G.Alias q2 ->
-    prq q1  ++ str " <-> " ++ prq q2 ++ fnl ()
+    Quality.pr prq q1  ++ str " <-> " ++ Quality.pr prq q2 ++ fnl ()
 
 let repr g = G.repr g.graph
 
@@ -331,6 +345,14 @@ let is_declared q g = match G.check_declared g.graph (Quality.Set.singleton q) w
 | Result.Ok _ -> true
 | Result.Error _ -> false
 
+let constraints_for ~kept g =
+  let add (q1,k,q2) accu = match k with
+    | AcyclicGraph.Eq ->
+      ElimConstraints.add (q1,ElimTo,q2) (ElimConstraints.add (q2,ElimTo,q1) accu)
+    | Le | Lt -> ElimConstraints.add (q1,ElimTo,q2) accu
+  in
+  G.constraints_for ~kept g.graph add ElimConstraints.empty
+
 let pr_qualities prq g = pr_pmap Pp.mt (pr_arc prq) (repr g)
 
 let explain_quality_inconsistency prv r =
diff --git a/kernel/qGraph.mli b/kernel/qGraph.mli
index 89409ef42560..3db2b7e83c95 100644
--- a/kernel/qGraph.mli
+++ b/kernel/qGraph.mli
@@ -24,6 +24,15 @@ end
 
 type t
 
+val set_ignore_constraints : bool -> t -> t
+
+(** When [ignore_constraints], functions adding sort constraints do not fail and
+   may instead ignore inconsistent constraints. Breaks the system.
+
+    Checking functions such as [elim_to] always return [true].
+*)
+val ignore_constraints : t -> bool
+
 type path_explanation
 
 type explanation =
@@ -31,7 +40,7 @@ type explanation =
   | Other of Pp.t
 
 type quality_inconsistency =
-  ((QVar.t -> Pp.t) option) *
+  (Quality.printer option) *
     (ElimConstraint.kind * Quality.t * Quality.t * explanation option)
 
 type elimination_error =
@@ -87,13 +96,17 @@ val eliminates_to_prop : t -> Quality.t -> bool
 
 val sort_eliminates_to : t -> Sorts.t -> Sorts.t -> bool
 
+val mem : Quality.t -> t -> bool
+
 val domain : t -> Quality.Set.t
 val qvar_domain : t -> QVar.Set.t
 
 val is_empty : t -> bool
 
-val pr_qualities : (Quality.t -> Pp.t) -> t -> Pp.t
+val constraints_for : kept:Quality.Set.t -> t -> ElimConstraints.t
+
+val pr_qualities : Quality.printer -> t -> Pp.t
 
-val explain_quality_inconsistency : (QVar.t -> Pp.t) -> explanation option -> Pp.t
+val explain_quality_inconsistency : Quality.printer -> explanation option -> Pp.t
 
-val explain_elimination_error : (QVar.t -> Pp.t) -> elimination_error -> Pp.t
+val explain_elimination_error : Quality.printer -> elimination_error -> Pp.t
diff --git a/kernel/rtree.ml b/kernel/rtree.ml
index 1e2145f0aad9..093b4e0ec8b6 100644
--- a/kernel/rtree.ml
+++ b/kernel/rtree.ml
@@ -244,9 +244,9 @@ let is_infinite cmp t =
   is_inf [] t
 
 (* Pretty-print a tree (not so pretty) *)
-open Pp
 
 let rec pr_tree prl t =
+  let open Pp in
   match t with
     | Var (i,j) -> str"#"++int i++str":"++int j
     | Node(lab,[||]) -> prl lab
@@ -265,3 +265,197 @@ let rec pr_tree prl t =
         else
           hv 2 (str"Rec{"++int i++str","++brk(1,0)++
                  prvect_with_sep pr_comma (pr_tree prl) v++str"}")
+
+module Automaton =
+struct
+
+type 'a rtree = 'a t
+
+type label = { constructor : int; argpos : int }
+
+module Label =
+struct
+  type t = label
+  let compare p q =
+    let c = Int.compare p.constructor q.constructor in
+    if Int.equal c 0 then Int.compare p.argpos q.argpos else c
+end
+
+module H = Hopcroft.Make(Label)
+
+type state = int
+
+type 'a data = {
+  uid : int;
+  elt : 'a Int.Map.t;
+  trs : state array array Int.Map.t;
+}
+
+type 'a t = {
+  init : int;
+  states : ('a * state array array) array;
+}
+
+let initial a = a.init
+let data a i = fst a.states.(i)
+let transitions a i = snd a.states.(i)
+let move a i = { init = i; states = a.states }
+
+let make r =
+  let rec aux env state = function
+  | Var (i, j) ->
+    let vec = Range.get env i in
+    state, vec.(j)
+  | Node (lbl, args) ->
+    let node = state.uid in
+    let state = { state with elt = Int.Map.add node lbl state.elt; uid = state.uid + 1 } in
+    let fold accu v = Array.fold_left_map (fun accu r -> aux env accu r) accu v in
+    let (state, tr) = Array.fold_left_map fold state args in
+    let state = { state with trs = Int.Map.add node tr state.trs } in
+    state, node
+  | Rec (j, v) ->
+    let map = function
+    | Var _ | Rec _ ->
+      assert false (* does not happen for rtrees generated from an inductive *)
+    | Node (lbl, args) -> (lbl, args)
+    in
+    let uid = state.uid in
+    let v = Array.map map v in
+    let self = Array.mapi (fun i _ -> state.uid + i) v in
+    let nelt = Array.fold_left_i (fun i accu (lbl, _) -> Int.Map.add (state.uid + i) lbl accu) state.elt v in
+    let state = { state with elt = nelt; uid = state.uid + Array.length v } in
+    let env = Range.cons self env in
+    let fold pos accu (_lbl, args) =
+      let fold accu v = Array.fold_left_map (fun accu r -> aux env accu r) accu v in
+      let (accu, tr) = Array.fold_left_map fold accu args in
+      { accu with trs = Int.Map.add (uid + pos) tr accu.trs }
+    in
+    let state = Array.fold_left_i fold state v in
+    state, self.(j)
+  in
+  let state, init = aux Range.empty { uid = 0; trs = Int.Map.empty; elt = Int.Map.empty } r in
+  let states = Array.init state.uid (fun i -> Int.Map.find i state.elt, Int.Map.find i state.trs) in
+  { init; states }
+
+let compact (type data) (cmp : data -> data -> int) { init; states } =
+  let module Data = struct type t = data let compare = cmp end in
+  let module LMap = Map.Make(Data) in
+  let fold i accu (label, _) = match LMap.find_opt label accu with
+  | None -> LMap.add label [i] accu
+  | Some l -> LMap.add label (i :: l) accu
+  in
+  let partitions = Array.fold_left_i fold LMap.empty states in
+  let partitions = List.map snd @@ LMap.bindings partitions in
+  let fold src accu (_, trs) =
+    let fold i accu v =
+      let fold j accu dst = { H.src = src; H.lbl = { constructor = i; argpos = j }; H.dst = dst } :: accu in
+      Array.fold_left_i fold accu v
+    in
+    Array.fold_left_i fold accu trs
+  in
+  let transitions = Array.fold_left_i fold [] states in
+  let classes =
+    if List.is_empty transitions then
+      Array.of_list partitions
+    else
+      let automaton = {
+        H.states = Array.length states;
+        H.partitions = partitions;
+        H.transitions = transitions;
+      } in
+      H.reduce automaton
+  in
+  (* Canonicalize transitions *)
+  let fold i accu l = List.fold_left (fun accu orig -> Int.Map.add orig i accu) accu l in
+  let map = Array.fold_left_i fold Int.Map.empty classes in
+  let canon st =
+    let can = match st with
+    | [] -> assert false
+    | can :: _ -> can
+    in
+    let v, tr = states.(can) in
+    let ntr = Array.map (fun v -> Array.map (fun dst -> Int.Map.get dst map) v) tr in
+    v, ntr
+  in
+  let nstates = Array.map canon classes in
+  let ninit = Int.Map.find init map in
+  { init = ninit; states = nstates }
+
+module IntPair = OrderedType.Pair(Int)(Int)
+module IntPairMap = Map.Make(IntPair)
+
+let merge_array f v1 v2 =
+  let len1 = Array.length v1 in
+  let len2 = Array.length v2 in
+  let len = if len1 < len2 then len1 else len2 in
+  Array.init len (fun i -> f v1.(i) v2.(i))
+
+let inter f a1 a2=
+  let { init = i1; states = st1 } = a1 in
+  let { init = i2; states = st2 } = a2 in
+  if Int.equal i1 i2 && st1 == st2 then a1
+  else
+    let rec search seen i1 i2 =
+      if IntPairMap.mem (i1, i2) seen then seen
+      else
+        let (v1, tr1) = st1.(i1) in
+        let (v2, tr2) = st2.(i2) in
+        let v = f v1 v2 in
+        let merge v1 v2 = merge_array (fun t1 t2 -> t1, t2) v1 v2 in
+        let tr = merge_array merge tr1 tr2 in
+        let seen = IntPairMap.add (i1, i2) (v, tr) seen in
+        let fold seen v =
+          let fold seen (tgt1, tgt2) = search seen tgt1 tgt2 in
+          Array.fold_left fold seen v
+        in
+        Array.fold_left fold seen tr
+    in
+    let seen = search IntPairMap.empty i1 i2 in
+    let fold p _ (i, dir, rev) = (i + 1, IntPairMap.add p i dir, Int.Map.add i p rev) in
+    let (_, dir, rev) = IntPairMap.fold fold seen (0, IntPairMap.empty, Int.Map.empty) in
+    let len = IntPairMap.cardinal dir in
+    let mk i =
+      let p = Int.Map.find i rev in
+      let (v, tr) = IntPairMap.find p seen in
+      let ntr = Array.map (fun v -> Array.map (fun p -> IntPairMap.find p dir) v) tr in
+      (v, ntr)
+    in
+    let nstates = Array.init len mk in
+    let ninit = IntPairMap.get (i1, i2) dir in
+    { init = ninit; states = nstates }
+
+exception Different
+
+let check_len v1 v2 =
+  if not (Int.equal (Array.length v1) (Array.length v2)) then raise Different
+
+(* The function below expects the automata to be minimal *)
+let equal eqf { init = i1; states = st1 } { init = i2; states = st2 } =
+  let rec search seen1 seen2 equiv i1 i2 =
+    if IntPairMap.mem (i1, i2) equiv then (seen1, seen2, equiv)
+    else if Int.Set.mem i1 seen1 || Int.Set.mem i2 seen2 then raise Different
+    else
+      let (v1, tr1) = st1.(i1) in
+      let (v2, tr2) = st2.(i2) in
+      let () = if not (eqf v1 v2) then raise Different in
+      let seen1 = Int.Set.add i1 seen1 in
+      let seen2 = Int.Set.add i2 seen2 in
+      let equiv = IntPairMap.add (i1, i2) () equiv in
+      let () = check_len tr1 tr2 in
+      let fold accu v1 v2 =
+        let () = check_len v1 v2 in
+        Array.fold_left2 (fun (seen1, seen2, equiv) tgt1 tgt2 -> search seen1 seen2 equiv tgt1 tgt2) accu v1 v2
+      in
+      Array.fold_left2 fold (seen1, seen2, equiv) tr1 tr2
+  in
+  (Int.equal i1 i2 && st1 == st2) ||
+  match search Int.Set.empty Int.Set.empty IntPairMap.empty i1 i2 with
+  | _ -> true
+  | exception Different -> false
+
+let map f { init; states } =
+  let map (v, tr) = f v, tr in
+  let states = Array.map map states in
+  { init; states }
+
+end
diff --git a/kernel/rtree.mli b/kernel/rtree.mli
index 24a479c5e3f6..0579c6fae0ce 100644
--- a/kernel/rtree.mli
+++ b/kernel/rtree.mli
@@ -109,3 +109,42 @@ val kind : 'a t -> 'a kind
 val repr : 'a t -> 'a rtree
 
 end
+
+module Automaton :
+sig
+
+type 'a rtree = 'a t
+
+type state
+
+type 'a t
+
+(** Compile a regular tree into an automaton, not necessarily minimal *)
+val make : 'a rtree -> 'a t
+
+(** Get the initial state of the automaton *)
+val initial : 'a t -> state
+
+(** Get the data associated to a given state in the automaton *)
+val data : 'a t -> state -> 'a
+
+(** Get the transitions of the automaton from a given state *)
+val transitions : 'a t -> state -> state array array
+
+(** Move the automaton into the given state *)
+val move : 'a t -> state -> 'a t
+
+(** Given a comparison function on the data, produce a minimal automaton *)
+val compact  : ('a -> 'a -> int) -> 'a t -> 'a t
+
+(** Intersection of two automata given an intersection on data. Does not
+    produce a minimal automaton on general. *)
+val inter : ('a -> 'a -> 'a) -> 'a t -> 'a t -> 'a t
+
+(** Equality of minimal automata, i.e. only valid after compaction *)
+val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
+
+(** Map the data of each node *)
+val map : ('a -> 'b) -> 'a t -> 'b t
+
+end
diff --git a/kernel/safe_typing.ml b/kernel/safe_typing.ml
index 696ece152ac2..dbcbecf77cf5 100644
--- a/kernel/safe_typing.ml
+++ b/kernel/safe_typing.ml
@@ -176,9 +176,10 @@ type compiled_library = {
   comp_name : DirPath.t;
   comp_mod : module_body;
   comp_univs : Univ.ContextSet.t;
-  comp_sorts : Sorts.QContextSet.t;
+  comp_sorts : Sorts.QGlobal.Set.t * Sorts.ElimConstraints.t;
   comp_deps : library_info array;
   comp_flags : permanent_flags;
+  comp_retro : Retroknowledge.action list;
 }
 
 type reimport = compiled_library * Vmlibrary.on_disk * vodigest
@@ -192,7 +193,7 @@ type required_lib = {
 type section_data = {
   rev_env : Environ.env;
   rev_univ : Univ.ContextSet.t;
-  rev_qualities : Sorts.QVar.Set.t * Sorts.ElimConstraints.t;
+  rev_qualities : Sorts.QGlobal.Set.t * Sorts.ElimConstraints.t;
   rev_objlabels : Id.Set.t;
   rev_reimport : reimport list;
   rev_revstruct : structure_body;
@@ -228,8 +229,8 @@ type safe_environment =
     modlabels : Id.Set.t;
     objlabels : Id.Set.t;
     univ : Univ.ContextSet.t;
-    (* maybe should be a qglobal set? *)
-    qualities : Sorts.QVar.Set.t * Sorts.ElimConstraints.t;
+    qualities : Sorts.QGlobal.Set.t;
+    elims : Sorts.ElimConstraints.t;
     future_cst : (Constant_typing.typing_context * safe_environment * Nonce.t) HandleMap.t;
     required : required_lib DirPath.Map.t;
     loads : (ModPath.t * module_body) list;
@@ -261,7 +262,8 @@ let empty_environment =
     sections = None;
     future_cst = HandleMap.empty;
     univ = Univ.ContextSet.empty;
-    qualities = Sorts.QVar.Set.empty, Sorts.ElimConstraints.empty;
+    qualities = Sorts.QGlobal.Set.empty;
+    elims = Sorts.ElimConstraints.empty;
     required = DirPath.Map.empty;
     loads = [];
     local_retroknowledge = [];
@@ -335,6 +337,10 @@ let set_share_reduction b senv =
   let flags = Environ.typing_flags senv.env in
   set_typing_flags { flags with share_reduction = b } senv
 
+let set_unfold_dep_heuristic b senv =
+  let flags = Environ.typing_flags senv.env in
+  set_typing_flags { flags with unfold_dep_heuristic = b } senv
+
 let set_VM b senv =
   let flags = Environ.typing_flags senv.env in
   set_typing_flags { flags with enable_VM = b } senv
@@ -358,6 +364,53 @@ let with_typing_flags ?typing_flags senv ~f =
     let res, senv = f (set_typing_flags typing_flags senv) in
     res, set_typing_flags orig_typing_flags senv
 
+(* f1 is stricter than f2 if terms typed with f1 also type with f2 *)
+let stricter_flags f1 f2 =
+  let impl b1 b2 = if b1 then b2 else true in
+  let {
+    check_guarded = check_guarded1;
+    check_positive = check_positive1;
+    check_universes = check_universes1;
+    check_eliminations = check_eliminations1;
+    indices_matter = indices_matter1;
+    impredicative_set = impredicative_set1;
+    sprop_allowed = sprop_allowed1;
+    allow_uip = allow_uip1;
+    (* The flags below do not change the theory *)
+    conv_oracle = _;
+    share_reduction = _;
+    unfold_dep_heuristic = _;
+    enable_VM = _;
+    enable_native_compiler = _;
+  } = f1
+  in
+  let {
+    check_guarded = check_guarded2;
+    check_positive = check_positive2;
+    check_universes = check_universes2;
+    check_eliminations = check_eliminations2;
+    indices_matter = indices_matter2;
+    impredicative_set = impredicative_set2;
+    sprop_allowed = sprop_allowed2;
+    allow_uip = allow_uip2;
+    (* The flags below do not change the theory *)
+    conv_oracle = _;
+    share_reduction = _;
+    unfold_dep_heuristic = _;
+    enable_VM = _;
+    enable_native_compiler = _;
+  } = f2
+  in
+  impl check_guarded2 check_guarded1 &&
+  impl check_positive2 check_positive1 &&
+  impl check_universes2 check_universes1 &&
+  impl check_eliminations2 check_eliminations1 &&
+  impl indices_matter2 indices_matter1 &&
+  (* Beware: the order is reversed below because a "true" flag is laxer *)
+  impl impredicative_set1 impredicative_set2 &&
+  impl sprop_allowed1 sprop_allowed2 &&
+  impl allow_uip1 allow_uip2
+
 (** {6 Stm machinery } *)
 
 module Certificate :
@@ -373,8 +426,8 @@ sig
   val safe_extend : src:t -> dst:t -> t option
 
   (** [compatible src dst] checks whether [dst] adds exactly 1 declaration
-      to an ancestor of [src].
-      If it does, the declaration is also valid in [src] (up to universes). *)
+      to an ancestor of [src] and the typing flags are compatible.
+      If so, the declaration is also valid in [src] (up to universes). *)
   val compatible : safe_environment -> t -> bool
 end =
 struct
@@ -382,11 +435,13 @@ struct
 type t = {
   certif_struc : Mod_declarations.structure_body;
   certif_univs : Univ.ContextSet.t;
+  certif_flags : Declarations.typing_flags;
 }
 
 let make senv = {
   certif_struc = senv.revstruct;
   certif_univs = senv.univ;
+  certif_flags = Environ.typing_flags senv.env;
 }
 
 let is_suffix l suf = match l with
@@ -394,12 +449,14 @@ let is_suffix l suf = match l with
 | _ :: l -> l == suf
 
 let safe_extend ~src ~dst =
-  if is_suffix dst.certif_struc src.certif_struc then
+  if is_suffix dst.certif_struc src.certif_struc && stricter_flags dst.certif_flags src.certif_flags then
     Some { certif_struc = dst.certif_struc;
-           certif_univs = Univ.ContextSet.union src.certif_univs dst.certif_univs }
+           certif_univs = Univ.ContextSet.union src.certif_univs dst.certif_univs;
+           certif_flags = dst.certif_flags }
   else None
 
 let compatible src dst =
+  stricter_flags dst.certif_flags (Environ.typing_flags src.env) &&
   let dst = dst.certif_struc in
   let src = src.revstruct in
   match dst with
@@ -419,7 +476,7 @@ end
 type side_effect = {
   seff_certif : Certificate.t CEphemeron.key;
   seff_constant : Constant.t;
-  seff_body : HConstr.t option * (Constr.t, Vmemitcodes.body_code option) Declarations.pconstant_body;
+  seff_body : HConstr.t option * (Constr.t, Vmemitcodes.body_code) Declarations.pconstant_body;
   seff_univs : Univ.ContextSet.t;
 }
 (* Invariant: For any senv, if [Certificate.safe_extend senv seff_certif] returns [Some certif'] then
@@ -493,12 +550,10 @@ let lift_constant c =
 let push_bytecode vmtab code =
   let open Vmemitcodes in
   let vmtab, code = match code with
-  | None -> vmtab, None
-  | Some (BCdefined (mask, code, patches)) ->
+  | BCdefined (mask, code, patches) ->
     let vmtab, index = Vmlibrary.add code vmtab in
-    vmtab, Some (BCdefined (mask, index, patches))
-  | Some BCconstant -> vmtab, Some BCconstant
-  | Some (BCalias kn) -> vmtab, Some (BCalias kn)
+    vmtab, BCdefined (mask, index, patches)
+  | BCconstant | BCuncompiled | BCalias _ as code -> vmtab, code
   in
   vmtab, code
 
@@ -554,25 +609,37 @@ let push_context_set ~strict cst senv =
       univ = Univ.ContextSet.union cst senv.univ;
       sections }
 
-let push_qualities ~rigid qs senv =
-  if Sorts.QVar.Set.is_empty (fst qs) && Sorts.ElimConstraints.is_empty (snd qs) then
+let current_modpath senv = senv.modpath
+let current_dirpath senv = Names.ModPath.dp (current_modpath senv)
+
+let new_global_sort senv =
+  if is_modtype senv then
+    CErrors.user_err (Pp.str "Cannot declare global sort qualities inside module types.")
+  else if Option.has_some senv.sections then
+    CErrors.user_err (Pp.str "Cannot declare global sort qualities inside sections.")
+  else
+  let module QG = Sorts.QGlobal in
+  let uid = QG.Set.cardinal senv.qualities in
+  let s = QG.make (current_dirpath senv) uid in
+  let qualities = QG.Set.add s senv.qualities in
+  let env = Environ.push_qualities (Sorts.Quality.Set.singleton (QGlobal s)) senv.env in
+  s, { senv with
+       env;
+       qualities;
+     }
+
+let merge_elim_constraints qcsts senv =
+  if Sorts.ElimConstraints.is_empty qcsts then
     senv
   else if is_modtype senv then
     CErrors.user_err (Pp.str "Cannot declare global sort qualities inside module types.")
   else if Option.has_some senv.sections then
-    CErrors.user_err (Pp.str "Cannot declare global sort qualities inside sections")
+    CErrors.user_err (Pp.str "Cannot declare global sort qualities inside sections.")
   else
-    let check_local qv = match Sorts.QVar.repr qv with
-    | Sorts.QVar.Global gv ->
-      let (dp, _) = Sorts.QGlobal.repr gv in
-      let () = assert (DirPath.equal dp (ModPath.dp senv.modpath)) in
-      assert (not @@ QGraph.is_declared (Sorts.Quality.QVar qv) (Environ.qualities senv.env))
-    | Sorts.QVar.Unif _ | Sorts.QVar.Var _ -> assert false
-    in
-    let () = Sorts.QVar.Set.iter check_local (fst qs) in
+    let env = Environ.merge_elim_constraints ~rigid:true qcsts senv.env in
     { senv with
-      env = Environ.push_qualities ~rigid qs senv.env ;
-      qualities = Sorts.QContextSet.union qs senv.qualities ;
+      env;
+      elims = Sorts.ElimConstraints.union qcsts senv.elims;
     }
 
 let is_curmod_library senv =
@@ -668,7 +735,7 @@ let safe_push_named d env =
       let _ = Environ.lookup_named id env in
       CErrors.user_err Pp.(pr_sequence str ["Identifier"; Id.to_string id; "already defined."])
     with Not_found -> () in
-  Environ.push_named d env
+  Environ.push_named SecVar d env
 
 let push_named_def (id,de) senv =
   let sections = get_section senv.sections in
@@ -692,10 +759,11 @@ let push_section_context uctx senv =
   let senv = { senv with sections=Some sections } in
   let qctx, ctx = UVars.UContext.to_context_set uctx in
   let check_quality q =
-    Sorts.QVar.is_global q &&
+    Sorts.QVar.is_secvar q &&
     not (QGraph.is_declared (Sorts.Quality.QVar q) (Environ.qualities senv.env))
   in
-  let () = assert (Sorts.QVar.Set.for_all check_quality (fst qctx)) in
+  if not @@ Sorts.QVar.Set.for_all check_quality (fst qctx) then
+    CErrors.user_err Pp.(str "Implicit section-wide sort variables are not allowed.");
   let check_fresh u = match UGraph.check_declared_universes (Environ.universes senv.env) (Univ.Level.Set.singleton u) with
   | Result.Ok _ -> assert false
   | Result.Error _ -> ()
@@ -704,11 +772,12 @@ let push_section_context uctx senv =
   let env = Environ.push_context_set ~strict:false ctx senv.env in
   (* FIXME: check validity of the sort context *)
   (* FIXME: marking the section-local sorts as rigid makes little sense *)
-  let env = Environ.push_qualities ~rigid:true qctx env in
+  let env = Environ.push_qualities (Sorts.Quality.Set.of_qvars @@ fst qctx) env in
+  let env = Environ.merge_elim_constraints ~rigid:true (snd qctx) env in
   { senv with
     env;
-    univ = Univ.ContextSet.union ctx senv.univ ;
-    qualities = Sorts.QContextSet.union qctx senv.qualities }
+    univ = Univ.ContextSet.union ctx senv.univ;
+  }
 
 (** {6 Insertion of new declarations to current environment } *)
 
@@ -726,6 +795,16 @@ let labels_of_mib mib =
   get ()
 
 let add_retroknowledge pttc senv =
+  (* Retroknowledge is only allowed in nested modules *)
+  let rec is_nested = function
+  | LIBRARY -> true
+  | STRUCT ([], senv) -> is_nested senv.modvariant
+  | SIG _ | NONE | STRUCT (_ :: _, _) -> false
+  in
+  let () = if sections_are_opened senv || not (is_nested senv.modvariant) then
+    CErrors.user_err Pp.(str "Registering a kernel type is only allowed at toplevel.")
+  in
+  let () = assert (is_nested senv.modvariant) in
   { senv with
     env = Primred.add_retroknowledge senv.env pttc;
     local_retroknowledge = pttc::senv.local_retroknowledge }
@@ -1102,7 +1181,6 @@ let add_constant l decl senv =
       | Entries.PrimitiveEntry entry ->
         let senv = match entry with
         | { Entries.prim_entry_content = CPrimitives.OT_type t; _ } ->
-          if sections_are_opened senv then CErrors.anomaly (Pp.str "Primitive type not allowed in sections");
           add_retroknowledge (Retroknowledge.Register_type(t,kn)) senv
         | _ -> senv in
         senv, (None, Constant_typing.infer_primitive senv.env entry)
@@ -1289,13 +1367,6 @@ let add_modtype l params_mte inl senv =
   let senv = add_field (l,SFBmodtype mtb) (MT mp) senv in
   mp, senv
 
-(** full_add_module adds module with universes and constraints *)
-
-let full_add_module mp mb senv =
-  let dp = ModPath.dp mp in
-  let linkinfo = Nativecode.link_info_of_dirpath dp in
-  { senv with env = Modops.add_linked_module mp mb linkinfo senv.env }
-
 (** Insertion of modules *)
 
 let add_module l me inl senv =
@@ -1331,6 +1402,7 @@ let start_mod_modtype ~istype l senv =
     paramresolver = ParamResolver.add_delta_resolver senv.modpath senv.modresolver senv.paramresolver;
     univ = senv.univ;
     qualities = senv.qualities;
+    elims = senv.elims;
     required = senv.required;
     opaquetab = senv.opaquetab;
     sections = None; (* checked in check_empty_context *)
@@ -1387,11 +1459,17 @@ let rec module_is_modtype senv =
 let functorize params init =
   List.fold_left (fun e (mbid,mt) -> MoreFunctor(mbid,mt,e)) init params
 
-let propagate_loads senv =
-  List.fold_left
-    (fun env (mp, mb) -> full_add_module mp mb env)
-    senv
-    (List.rev senv.loads)
+let propagate_load senv (mp, mb as load) =
+  let dp = ModPath.dp mp in
+  let linkinfo = Nativecode.link_info_of_dirpath dp in
+  { senv with
+    paramresolver = ParamResolver.add_delta_resolver mp (mod_delta mb) senv.paramresolver;
+    loads = load :: senv.loads;
+    env = Modops.add_linked_module mp mb linkinfo senv.env;
+  }
+
+let propagate_loads loads senv =
+  List.fold_left propagate_load senv (List.rev loads)
 
 (** Build the module body of the current module, taking in account
     a possible return type (_:T) *)
@@ -1401,13 +1479,13 @@ let build_module_body params restype senv =
   let restype' = Option.map (fun (ty,inl) -> (([],ty),inl)) restype in
   let state = check_state senv in
   let vmstate = vm_state senv in
-  let mb, _, vmtab =
+  (* XXX why are we dropping vmtab here? *)
+  let mb, _, _vmtab =
     Mod_typing.finalize_module state vmstate senv.env senv.modpath
       (struc, senv.modresolver) restype'
   in
-  let senv = set_vm_library vmtab senv in
   let mb' = functorize_module params mb in
-  set_retroknowledge mb' senv.local_retroknowledge
+  mb'
 
 (** Returning back to the old pre-interactive-module environment,
     with one extra component and some updated fields
@@ -1415,22 +1493,23 @@ let build_module_body params restype senv =
 
 let allow_delayed_constants = ref false
 
-let propagate_senv newdef newenv newresolver senv oldsenv =
+let propagate_senv newdef senv oldsenv =
   (* This asserts that after Paral-ITP, standard vo compilation is behaving
    * exctly as before: the same universe constraints are added to modules *)
   if not !allow_delayed_constants && not (HandleMap.is_empty senv.future_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;
+  propagate_loads senv.loads {
+    oldsenv with
+    env = senv.env;
+    modresolver = senv.modresolver;
     revstruct = newdef::oldsenv.revstruct;
     modlabels = Id.Set.add (fst newdef) oldsenv.modlabels;
     univ = senv.univ;
     qualities = senv.qualities ;
     future_cst = senv.future_cst;
     required = senv.required;
-    loads = senv.loads@oldsenv.loads;
+    loads = oldsenv.loads;
     local_retroknowledge =
       senv.local_retroknowledge@oldsenv.local_retroknowledge;
     opaquetab = senv.opaquetab;
@@ -1447,14 +1526,15 @@ let end_module l restype senv =
   let newenv = Environ.set_qualities (Environ.qualities senv.env) newenv in
   let newenv = if Environ.rewrite_rules_allowed senv.env then Environ.allow_rewrite_rules newenv else newenv in
   let newenv = Environ.set_vm_library (Environ.vm_library senv.env) newenv in
-  let senv' = propagate_loads { senv with env = newenv } in
-  let newenv = Modops.add_module mp mb senv'.env in
+  let newenv = Modops.add_retroknowledge senv.local_retroknowledge newenv in
+  let newenv = Modops.add_module mp mb newenv in
   let newresolver = match mod_global_delta mb with
   | None -> oldsenv.modresolver
   | Some delta -> Mod_subst.add_delta_resolver delta oldsenv.modresolver
   in
+  let () = assert (List.is_empty params || List.is_empty senv.local_retroknowledge) in
   (mp, mbids, mod_delta mb),
-  propagate_senv (l,SFBmodule mb) newenv newresolver senv' oldsenv
+  propagate_senv (l,SFBmodule mb) { senv with env = newenv; modresolver = newresolver } oldsenv
 
 let build_mtb = Mod_declarations.make_module_type
 
@@ -1467,13 +1547,13 @@ let end_modtype l senv =
   let newenv = Environ.set_universes (Environ.universes senv.env) oldsenv.env in
   let newenv = if Environ.rewrite_rules_allowed senv.env then Environ.allow_rewrite_rules newenv else newenv in
   let newenv = Environ.set_vm_library (Environ.vm_library senv.env) newenv in
-  let senv' = propagate_loads {senv with env=newenv} in
   let auto_tb = functorize params (NoFunctor (List.rev senv.revstruct)) in
   let mtb = build_mtb auto_tb senv.modresolver in
-  let newenv = Environ.add_modtype mp mtb senv'.env in
+  let newenv = Environ.add_modtype mp mtb newenv in
   let newresolver = oldsenv.modresolver in
+  let () = assert (List.is_empty senv.local_retroknowledge) in
   (mp,mbids),
-  propagate_senv (l,SFBmodtype mtb) newenv newresolver senv' oldsenv
+  propagate_senv (l,SFBmodtype mtb) { senv with env = newenv; modresolver = newresolver } oldsenv
 
 (** {6 Inclusion of module or module type } *)
 
@@ -1488,7 +1568,7 @@ let add_include me is_module inl senv =
   let senv = set_vm_library vmtab senv in
   (* Include Self support  *)
   let struc = NoFunctor (List.rev senv.revstruct) in
-  let mb = Mod_declarations.make_module_body struc senv.modresolver [] in
+  let mb = Mod_declarations.make_module_body struc senv.modresolver in
   let rec compute_sign sign resolver =
     match sign with
     | MoreFunctor(mbid,mtb,str) ->
@@ -1528,9 +1608,7 @@ let module_of_library lib = lib.comp_mod
 
 let univs_of_library lib = lib.comp_sorts, lib.comp_univs
 
-(** FIXME: MS: remove?*)
-let current_modpath senv = senv.modpath
-let current_dirpath senv = Names.ModPath.dp (current_modpath senv)
+let retroknowledge_of_library lib = lib.comp_retro
 
 let start_library dir senv =
   (* When starting a library, the current environment should be initial
@@ -1556,7 +1634,8 @@ let start_library dir senv =
     sections = None;
     future_cst = HandleMap.empty;
     univ = Univ.ContextSet.empty;
-    qualities = Sorts.QContextSet.empty;
+    qualities = Sorts.QGlobal.Set.empty;
+    elims = Sorts.ElimConstraints.empty;
     loads = [];
     local_retroknowledge = [];
     opaquetab = Opaqueproof.empty_opaquetab;
@@ -1566,7 +1645,7 @@ let export ~output_native_objects senv dir =
   let () = check_current_library dir senv in
   let mp = senv.modpath in
   let str = NoFunctor (List.rev senv.revstruct) in
-  let mb = Mod_declarations.make_module_body str senv.modresolver senv.local_retroknowledge in
+  let mb = Mod_declarations.make_module_body str senv.modresolver in
   let ast, symbols =
     if output_native_objects then
       Nativelibrary.dump_library mp senv.env str
@@ -1583,9 +1662,10 @@ let export ~output_native_objects senv dir =
     comp_name = dir;
     comp_mod = mb;
     comp_univs = senv.univ;
-    comp_sorts = senv.qualities;
+    comp_sorts = senv.qualities, senv.elims;
     comp_deps = Array.of_list comp_deps;
-    comp_flags = permanent_flags
+    comp_flags = permanent_flags;
+    comp_retro = senv.local_retroknowledge;
   } in
   let vmlib = Vmlibrary.export @@ Environ.vm_library senv.env in
   mp, lib, vmlib, (ast, symbols)
@@ -1601,13 +1681,15 @@ let import lib vmtab vodigest senv =
   let mb = lib.comp_mod in
   let univs = lib.comp_univs in
   let qualities = lib.comp_sorts in
+  let retro = lib.comp_retro in
   let check_quality q =
-    Sorts.QVar.is_global q &&
-    not (QGraph.is_declared (Sorts.Quality.QVar q) (Environ.qualities senv.env))
+    not (QGraph.is_declared (Sorts.Quality.QGlobal q) (Environ.qualities senv.env))
   in
-  let () = assert (Sorts.QVar.Set.for_all check_quality (fst qualities)) in
-  let env = Environ.push_qualities ~rigid:true qualities senv.env in
+  let () = assert (Sorts.QGlobal.Set.for_all check_quality (fst qualities)) in
+  let env = Environ.push_qualities (Sorts.Quality.Set.of_qglobals @@ fst qualities) senv.env in
+  let env = Environ.merge_elim_constraints ~rigid:true (snd qualities) env in
   let env = Environ.push_context_set ~strict:true univs env in
+  let env = Modops.add_retroknowledge retro env in
   let env = Environ.link_vm_library vmtab env in
   let env =
     let linkinfo = Nativecode.link_info_of_dirpath lib.comp_name in
@@ -1641,7 +1723,7 @@ let open_section senv =
   let custom = {
     rev_env = senv.env;
     rev_univ = senv.univ;
-    rev_qualities = senv.qualities;
+    rev_qualities = senv.qualities, senv.elims;
     rev_objlabels = senv.objlabels;
     rev_reimport = [];
     rev_revstruct = senv.revstruct;
@@ -1660,10 +1742,10 @@ let close_section senv =
      were forced inside the section, they have been turned into global monomorphic
      that are going to be replayed. Those that are not forced are not readded
      by {!add_constant_aux}. *)
-  let { rev_env = env; rev_univ = univ; rev_qualities = qualities; rev_objlabels = objlabels;
+  let { rev_env = env; rev_univ = univ; rev_qualities = (qualities, elims); rev_objlabels = objlabels;
         rev_reimport; rev_revstruct = revstruct; rev_paramresolver = paramresolver } = revert in
   let env = if Environ.rewrite_rules_allowed env0 then Environ.allow_rewrite_rules env else env in
-  let senv = { senv with env; revstruct; sections; univ; qualities; objlabels; paramresolver } in
+  let senv = { senv with env; revstruct; sections; univ; qualities; elims; objlabels; paramresolver } in
   (* Second phase: replay Requires *)
   let senv = List.fold_left (fun senv (lib,vmtab,vodigest) -> snd (import lib vmtab vodigest senv))
       senv (List.rev rev_reimport)
@@ -1723,8 +1805,7 @@ let register_inline kn senv =
   let cb = {cb with const_inline_code = true} in
   let env = add_constant kn cb env in { senv with env}
 
-let check_register_ind (type t) ind (r : t CPrimitives.prim_ind) env =
-  let (mb,ob as spec) = Inductive.lookup_mind_specif env ind in
+let check_register_ind (type t) ind (r : t CPrimitives.prim_ind) (mb, ob as spec) =
   let ind = match mb.mind_universes with
     | Polymorphic _ -> CErrors.user_err Pp.(str "A universe monomorphic inductive type is expected.")
     | Monomorphic -> Constr.UnsafeMonomorphic.mkInd ind
@@ -1781,7 +1862,10 @@ let check_register_ind (type t) ind (r : t CPrimitives.prim_ind) env =
     check_nparams 2;
     check_nconstr 1;
     check_name 0 "pair";
-    let c = ob.mind_user_lc.(0) in
+    let c = match mb.mind_template with
+    | None -> ob.mind_user_lc.(0)
+    | Some templ -> Vars.subst_instance_constr templ.template_defaults ob.mind_user_lc.(0)
+    in
     let s =  Pp.str "the constructor does not have the expected type" in
     begin match Term.decompose_prod c with
       | ([_,b;_,a;_,_B;_,_A], codom) ->
@@ -1833,7 +1917,8 @@ let check_register_ind (type t) ind (r : t CPrimitives.prim_ind) env =
     check_type_cte 8
 
 let register_inductive ind prim senv =
-  check_register_ind ind prim senv.env;
+  let spec = Inductive.lookup_mind_specif senv.env ind in
+  let () = check_register_ind ind prim spec in
   let action = Retroknowledge.Register_ind(prim,ind) in
   add_retroknowledge action senv
 
diff --git a/kernel/safe_typing.mli b/kernel/safe_typing.mli
index 35b2fc364509..b3d2f7a5e4dd 100644
--- a/kernel/safe_typing.mli
+++ b/kernel/safe_typing.mli
@@ -157,7 +157,9 @@ val push_context_set :
 
 (** Adding global sort qualities *)
 
-val push_qualities : rigid:bool -> Sorts.QContextSet.t -> safe_transformer0
+val new_global_sort : Sorts.QGlobal.t safe_transformer
+
+val merge_elim_constraints : Sorts.ElimConstraints.t -> safe_transformer0
 
 (* (\** Generator of universes *\) *)
 (* val next_universe : int safe_transformer *)
@@ -168,6 +170,7 @@ val set_impredicative_set : bool -> safe_transformer0
 val set_indices_matter : bool -> safe_transformer0
 val set_typing_flags : Declarations.typing_flags -> safe_transformer0
 val set_share_reduction : bool -> safe_transformer0
+val set_unfold_dep_heuristic : bool -> safe_transformer0
 val set_check_guarded : bool -> safe_transformer0
 val set_check_positive : bool -> safe_transformer0
 val set_check_universes : bool -> safe_transformer0
@@ -238,7 +241,8 @@ type compiled_library
 
 val dirpath_of_library : compiled_library -> DirPath.t
 val module_of_library : compiled_library -> Mod_declarations.module_body
-val univs_of_library : compiled_library -> Sorts.QContextSet.t * Univ.ContextSet.t
+val univs_of_library : compiled_library -> (Sorts.QGlobal.Set.t * Sorts.ElimConstraints.t) * Univ.ContextSet.t
+val retroknowledge_of_library : compiled_library -> Retroknowledge.action list
 val check_flags_for_library : compiled_library -> safe_transformer0
 
 val start_library : DirPath.t -> ModPath.t safe_transformer
@@ -275,6 +279,7 @@ val mind_of_delta_kn_senv : safe_environment -> KerName.t -> MutInd.t
 
 val register_inline : Constant.t -> safe_transformer0
 val register_inductive : inductive -> 'a CPrimitives.prim_ind -> safe_transformer0
+val check_register_ind : inductive -> 'a CPrimitives.prim_ind -> Declarations.mind_specif -> unit
 
 val set_oracle : Conv_oracle.oracle -> safe_transformer0
 val set_strategy : Conv_oracle.evaluable -> Conv_oracle.level -> safe_transformer0
diff --git a/kernel/section.ml b/kernel/section.ml
index 265a345ba236..1e6c1d16b7c9 100644
--- a/kernel/section.ml
+++ b/kernel/section.ml
@@ -49,6 +49,9 @@ let has_poly_univs sec = sec.has_poly_univs
 
 let all_poly_univs sec = sec.all_poly_univs
 
+let section_qvar_count sec =
+  fst @@ UVars.Instance.length @@ all_poly_univs sec
+
 let map_custom f sec = {sec with custom = f sec.custom}
 
 let add_emap e v (cmap, imap) = match e with
diff --git a/kernel/section.mli b/kernel/section.mli
index 4680e454842b..d102df5ebbd3 100644
--- a/kernel/section.mli
+++ b/kernel/section.mli
@@ -58,6 +58,8 @@ val push_global : Environ.env -> poly:bool -> section_entry -> 'a t -> 'a t
 
 (** {6 Retrieving section data} *)
 
+val section_qvar_count : _ t -> int
+
 val all_poly_univs : 'a t -> Instance.t
 (** Returns all polymorphic universes, including those from previous
    sections. Earlier sections are earlier in the array.
diff --git a/kernel/sorts.ml b/kernel/sorts.ml
index 59c94ddb637a..9ae186f6296c 100644
--- a/kernel/sorts.ml
+++ b/kernel/sorts.ml
@@ -15,52 +15,79 @@ module QGlobal = struct
 
   type t = {
     library : DirPath.t;
-    id : Id.t
+    (* uid is unique for the library *)
+    uid : int;
   }
 
-  let make library id = { library ; id }
+  let make library uid = { library; uid }
 
-  let repr x = (x.library, x.id)
+  let repr x = (x.library, x.uid)
 
   let equal u1 u2 =
-    Id.equal u1.id u2.id &&
+    Int.equal u1.uid u2.uid &&
     DirPath.equal u1.library u2.library
 
-  let hash u = Hashset.Combine.combine (Id.hash u.id) (DirPath.hash u.library)
+  let hash u = Hashset.Combine.combine (Int.hash u.uid) (DirPath.hash u.library)
 
   let compare u1 u2 =
-    let c = Id.compare u1.id u2.id in
+    let c = Int.compare u1.uid u2.uid in
     if c <> 0 then c
     else
       DirPath.compare u1.library u2.library
 
-  let to_string { library = d ; id } =
-    DirPath.to_string d ^ "." ^ Id.to_string id
+  let to_string { library = d; uid } =
+    Printf.sprintf "%s.%d" (DirPath.to_string d) uid
+
+  let raw_pr id = Pp.str @@ Printf.sprintf "γ%s" (to_string id)
+
+  module Hstruct = struct
+    type nonrec t = t
+
+    let hashcons ({ library; uid } as v) =
+      let hl, l' = DirPath.hcons library in
+      let v = if l' == library then v else { library = l'; uid } in
+      Hashset.Combine.combine hl uid, v
+
+    let eq a b = a.library == b.library && a.uid == b.uid
+  end
+
+  module Hasher = Hashcons.Make(Hstruct)
+
+  let hcons = Hashcons.simple_hcons Hasher.generate Hasher.hcons ()
+
+  module Self = struct type nonrec t = t let compare = compare end
+  module Set =
+  struct
+    include CSet.Make(Self)
+    let pr prl s =
+      let open Pp in
+      hov 1 (str"{" ++ prlist_with_sep spc prl (elements s) ++ str"}")
+  end
+
 end
 
 module QVar =
 struct
   type repr =
     | Var of int
+    | Secvar of int
     | Unif of string * int
-    | Global of QGlobal.t
   type t = repr
 
   let make_var n = Var n
 
-  let make_unif s n = Unif (s,n)
+  let make_secvar n = Secvar n
 
-  let make_global id = Global id
+  let make_unif s n = Unif (s,n)
 
   let var_index = function
     | Var q -> Some q
-    | Unif _ -> None
-    | Global _ -> None
+    | Secvar _ | Unif _ -> None
 
   let hash = function
     | Var q -> Hashset.Combine.combinesmall 1 q
-    | Unif (s,q) -> Hashset.Combine.(combinesmall 2 (combine (CString.hash s) q))
-    | Global id -> Hashset.Combine.combinesmall 3 (QGlobal.hash id)
+    | Secvar q -> Hashset.Combine.combinesmall 2 q
+    | Unif (s,q) -> Hashset.Combine.(combinesmall 3 (combine (CString.hash s) q))
 
   module Hstruct = struct
     type nonrec t = t
@@ -69,17 +96,17 @@ struct
 
     let hashcons = function
       | Var qv as q -> combinesmall 1 qv, q
+      | Secvar qv as q -> combinesmall 2 qv, q
       | Unif (s,i) as q ->
         let hs, s' = CString.hcons s in
-        combinesmall 2 (combine hs i), if s == s' then q else Unif (s',i)
-      | Global id as q -> combinesmall 3 (QGlobal.hash id), q
+        combinesmall 3 (combine hs i), if s == s' then q else Unif (s',i)
 
     let eq a b =
       match a, b with
       | Var a, Var b -> Int.equal a b
+      | Secvar a, Secvar b -> Int.equal a b
       | Unif (sa, ia), Unif (sb, ib) -> sa == sb && Int.equal ia ib
-      | Global ida, Global idb -> QGlobal.equal ida idb
-      | (Var _ | Unif _| Global _), _ -> false
+      | (Var _ | Secvar _ | Unif _), _ -> false
   end
 
   module Hasher = Hashcons.Make(Hstruct)
@@ -88,42 +115,42 @@ struct
 
   let compare a b = match a, b with
     | Var a, Var b -> Int.compare a b
+    | Var _, _ -> -1
+    | _, Var _ -> 1
+    | Secvar a, Secvar b -> Int.compare a b
+    | Secvar _, _ -> -1
+    | _, Secvar _ -> 1
     | Unif (s1,i1), Unif (s2,i2) ->
       let c = Int.compare i1 i2 in
       if c <> 0 then c
       else CString.compare s1 s2
-    | Global ida, Global idb -> QGlobal.compare ida idb
-    | Var _, _ -> -1
-    | _, Var _ -> 1
-    | Unif _, _ -> -1
-    | _, Unif _ -> 1
 
   let equal a b = match a, b with
     | Var a, Var b ->  Int.equal a b
+    | Secvar a, Secvar b -> Int.equal a b
     | Unif (s1,i1), Unif (s2,i2) ->
       Int.equal i1 i2 && CString.equal s1 s2
-    | Global ida, Global idb -> QGlobal.equal ida idb
-    | (Var _| Unif _ | Global _), _ -> false
+    | (Var _| Secvar _ | Unif _), _ -> false
 
   let to_string = function
     | Var q -> Printf.sprintf "β%d" q
+    | Secvar q -> Printf.sprintf "βsec%d" q
     | Unif (s,q) ->
       let s = if CString.is_empty s then "" else s^"." in
       Printf.sprintf "%sα%d" s q
-    | Global id -> Printf.sprintf "γ%s" (QGlobal.to_string id)
 
   let raw_pr q = Pp.str (to_string q)
 
   let repr x = x
   let of_repr x = x
 
+  let is_secvar = function
+    | Secvar _ -> true
+    | Unif _ | Var _ -> false
+
   let is_unif = function
     | Unif _ -> true
-    | (Var _ | Global _) -> false
-
-  let is_global = function
-  | Global _ -> true
-  | (Unif _ | Var _) -> false
+    | Secvar _ | Var _ -> false
 
   module Self = struct type nonrec t = t let compare = compare end
   module Set =
@@ -138,19 +165,14 @@ end
 
 module Quality = struct
   type constant = QProp | QSProp | QType
-  type t = QVar of QVar.t | QConstant of constant
+  type t = QVar of QVar.t | QConstant of constant | QGlobal of QGlobal.t
 
   let var i = QVar (QVar.make_var i)
-  let global sg = QVar (QVar.make_global sg)
-
-  let is_var x =
-    match x with
-    | QVar _ -> true
-    | QConstant _ -> false
+  let global sg = QGlobal sg
 
   let var_index = function
     | QVar q -> QVar.var_index q
-    | QConstant _ -> None
+    | QConstant _ | QGlobal _ -> None
 
   module Constants = struct
     let equal a b = match a, b with
@@ -182,32 +204,48 @@ module Quality = struct
   let equal a b = match a, b with
     | QVar a, QVar b -> QVar.equal a b
     | QConstant a, QConstant b -> Constants.equal a b
-    | (QVar _ | QConstant _), _ -> false
+    | QGlobal ida, QGlobal idb -> QGlobal.equal ida idb
+    | (QVar _ | QConstant _ | QGlobal _), _ -> false
 
   let compare a b = match a, b with
     | QVar a, QVar b -> QVar.compare a b
     | QVar _, _ -> -1
     | _, QVar _ -> 1
     | QConstant a, QConstant b -> Constants.compare a b
+    | QConstant _, _ -> -1
+    | _, QConstant _ -> 1
+    | QGlobal a, QGlobal b -> QGlobal.compare a b
+
+  type printer = {
+    prvar : QVar.t -> Pp.t;
+    prglobal : QGlobal.t -> Pp.t;
+  }
 
   let pr prv = function
-    | QVar v -> prv v
+    | QVar v -> prv.prvar v
     | QConstant q -> Constants.pr q
+    | QGlobal id -> prv.prglobal id
+
+  let raw_printer = {
+    prvar = QVar.raw_pr;
+    prglobal = QGlobal.raw_pr;
+  }
 
-  let raw_pr q = pr QVar.raw_pr q
+  let raw_pr q = pr raw_printer q
 
   let all_constants = List.map (fun q -> QConstant q) Constants.all
-  let all = var (-1) :: all_constants
 
   let hash = let open Hashset.Combine in function
     | QConstant q -> Constants.hash q
+    (* combinesmall 3 because constants.hash in [0;2] *)
     | QVar q -> combinesmall 3 (QVar.hash q)
+    | QGlobal q -> combinesmall 4 (QGlobal.hash q)
 
   let subst f = function
-    | QConstant _ as q -> q
+    | QConstant _ | QGlobal _ as q -> q
     | QVar qv as q ->
       match f qv with
-      | QConstant _ as q -> q
+      | QConstant _ | QGlobal _ as q -> q
       | QVar qv' as q' ->
         if qv == qv' then q else q'
 
@@ -224,12 +262,15 @@ module Quality = struct
       | QVar qv as q ->
         let hqv, qv' = QVar.hcons qv in
         Hashset.Combine.combinesmall 3 hqv, if qv == qv' then q else QVar qv'
+      | QGlobal qv as q ->
+        (* XXX hashcons qglobals *)
+        Hashset.Combine.combinesmall 4 (QGlobal.hash qv), q
 
     let eq a b =
       match a, b with
       | QVar a, QVar b -> a == b
       | QVar _, _ -> false
-      | (QConstant _), _ -> equal a b
+      | (QConstant _ | QGlobal _), _ -> equal a b
   end
 
   module Hasher = Hashcons.Make(Hstruct)
@@ -245,21 +286,28 @@ module Quality = struct
   let is_qtype = equal qtype
   let is_qvar q = match q with QVar _ -> true | _ -> false
   let is_qconst q = match q with QConstant _ -> true | _ -> false
-  let is_qglobal q = match q with QVar (QVar.Global _) -> true | _ -> false
+  let is_qglobal q = match q with QGlobal _ -> true | _ -> false
   let is_impredicative q = is_qsprop q || is_qprop q
 
   module Self = struct type nonrec t = t let compare = compare end
-  module Set = CSet.Make(Self)
+  module Set = struct
+    include CSet.Make(Self)
+    let of_qvars qs =
+      QVar.Set.fold (fun qv acc -> add (QVar qv) acc) qs empty
+    let of_qglobals qs =
+      QGlobal.Set.fold (fun qv acc -> add (QGlobal qv) acc) qs empty
+  end
   module Map = CMap.Make(Self)
 
   type 'q pattern =
-    | PQVar of 'q | PQConstant of constant
+    | PQVar of 'q | PQConstant of constant | PQGlobal of QGlobal.t
 
   let pattern_match ps s qusubst =
     match ps, s with
     | PQConstant qc, QConstant qc' -> if Constants.equal qc qc' then Some qusubst else None
+    | PQGlobal qg, QGlobal qg' -> if QGlobal.equal qg qg' then Some qusubst else None
     | PQVar qio, q -> Some (Partial_subst.maybe_add_quality qio q qusubst)
-    | PQConstant _, QVar _ -> None
+    | (PQConstant _ | PQGlobal _), _ -> None
 end
 
 module ElimConstraint = struct
@@ -291,7 +339,7 @@ module ElimConstraint = struct
     let open Pp in
     hov 1 (Quality.pr prq a ++ spc() ++ pr_kind k ++ spc() ++ Quality.pr prq b)
 
-  let raw_pr x = pr QVar.raw_pr x
+  let raw_pr x = pr Quality.raw_printer x
 
   module Hstruct = struct
     type nonrec t = t
@@ -310,7 +358,7 @@ module ElimConstraint = struct
   let hcons = Hashcons.simple_hcons Hasher.generate Hasher.hcons ()
 end
 
-module ElimConstraints = struct include Stdlib.Set.Make(ElimConstraint)
+module ElimConstraints = struct include CSet.Make(ElimConstraint)
   let pr prq c =
     let open Pp in
     v 0 (prlist_with_sep spc (fun (u1,op,u2) ->
@@ -329,24 +377,26 @@ module QContextSet =
 struct
   type t = QVar.Set.t * ElimConstraints.t
   let empty = (QVar.Set.empty, ElimConstraints.empty)
+  let is_empty (q,c) = QVar.Set.is_empty q && ElimConstraints.is_empty c
   let union (q1, c1) (q2, c2) = (QVar.Set.union q1 q2, ElimConstraints.union c1 c2)
-  let filter_constant_qualities (q, c) =
-    let filter (q1, _, q2) = not (Quality.is_qconst q1 && Quality.is_qconst q2) in
-    (q, ElimConstraints.filter filter c)
 end
 
+(* XXX simplify this type to quality * universe
+   with invariant that if quality is impredicative then universe=0? *)
 type t =
   | SProp
   | Prop
   | Set
   | Type of Universe.t
-  | QSort of QVar.t * Universe.t
+  | GSort of QGlobal.t * Universe.t
+  | VSort of QVar.t * Universe.t
 
 let sprop = SProp
 let prop = Prop
 let set = Set
 let type1 = Type Universe.type1
-let qsort q u = QSort (q, u)
+let gsort q u = GSort (q, u)
+let vsort q u = VSort (q, u)
 
 let sort_of_univ u =
   if Universe.is_type0 u then set else Type u
@@ -354,12 +404,13 @@ let sort_of_univ u =
 let univ_of_sort s =
   match s with
   | SProp | Prop | Set -> Universe.type0
-  | Type u | QSort (_, u) -> u
+  | Type u | GSort (_, u) | VSort (_, u) -> u
 
 let make q u =
   let open Quality in
   match q with
-  | QVar q -> qsort q u
+  | QVar q -> vsort q u
+  | QGlobal q -> gsort q u
   | QConstant QSProp -> sprop
   | QConstant QProp -> prop
   | QConstant QType -> sort_of_univ u
@@ -368,69 +419,74 @@ let compare s1 s2 =
   if s1 == s2 then 0 else
     match s1, s2 with
     | SProp, SProp -> 0
-    | SProp, (Prop | Set | Type _ | QSort _) -> -1
-    | (Prop | Set | Type _ | QSort _), SProp -> 1
+    | SProp, _ -> -1
+    | _, SProp -> 1
     | Prop, Prop -> 0
-    | Prop, (Set | Type _ | QSort _) -> -1
-    | Set, Prop -> 1
+    | Prop, _ -> -1
+    | _, Prop -> 1
     | Set, Set -> 0
-    | Set, (Type _ | QSort _) -> -1
-    | Type _, QSort _ -> -1
+    | Set, _ -> -1
+    | _, Set -> 1
     | Type u1, Type u2 -> Universe.compare u1 u2
-    | Type _, (Prop | Set) -> 1
-    | QSort (q1, u1), QSort (q2, u2) ->
+    | Type _, _ -> -1
+    | _, Type _ -> 1
+    | GSort (q1, u1), GSort (q2, u2) ->
+      let c = QGlobal.compare q1 q2 in
+      if Int.equal c 0 then Universe.compare u1 u2 else c
+    | GSort _, _ -> -1
+    | _, GSort _ -> 1
+    | VSort (q1, u1), VSort (q2, u2) ->
       let c = QVar.compare q1 q2 in
       if Int.equal c 0 then Universe.compare u1 u2 else c
-    | QSort _, (Prop | Set | Type _) -> 1
 
 let equal s1 s2 = Int.equal (compare s1 s2) 0
 
 let super = function
   | SProp | Prop | Set -> Type (Universe.type1)
-  | Type u | QSort (_, u) -> Type (Universe.super u)
+  | Type u | GSort (_, u) | VSort (_, u) -> Type (Universe.super u)
 
 let is_sprop = function
   | SProp -> true
-  | Prop | Set | Type _ | QSort _ -> false
+  | _ -> false
 
 let is_prop = function
   | Prop -> true
-  | SProp | Set | Type _ | QSort _-> false
+  |  _-> false
 
 let is_set = function
   | Set -> true
-  | SProp | Prop | Type _ | QSort _ -> false
-
-let is_small = function
-  | SProp | Prop | Set -> true
-  | Type _ | QSort _ -> false
+  | _ -> false
 
 let levels s = match s with
 | SProp | Prop -> Level.Set.empty
 | Set -> Level.Set.singleton Level.set
-| Type u | QSort (_, u) -> Universe.levels u
+| Type u | GSort (_, u) | VSort (_, u) -> Universe.levels u
 
 let subst_fn (fq,fu) = function
   | SProp | Prop | Set as s -> s
   | Type v as s ->
     let v' = fu v in
     if v' == v then s else sort_of_univ v'
-  | QSort (q, v) as s ->
+  | GSort (q, v) as s ->
+    let v' = fu v in
+    if v' == v then s else gsort q v'
+  | VSort (q, v) as s ->
     let open Quality in
     match fq q with
     | QVar q' ->
       let v' = fu v in
       if q' == q && v' == v then s
-      else qsort q' v'
+      else vsort q' v'
     | QConstant QSProp -> sprop
     | QConstant QProp -> prop
-    | QConstant QType -> sort_of_univ (fu v)
+    | q' -> make q' (fu v)
 
 let quality = let open Quality in function
 | Set | Type _ -> qtype
 | Prop -> qprop
 | SProp -> qsprop
-| QSort (q, _) -> QVar q
+| GSort (q, _) -> QGlobal q
+| VSort (q, _) -> QVar q
 
 open Hashset.Combine
 
@@ -441,10 +497,14 @@ let hash = function
   | Type u ->
     let h = Univ.Universe.hash u in
     combinesmall 2 h
-  | QSort (q, u) ->
+  | GSort (q, u) ->
     let h = Univ.Universe.hash u in
-    let h' = QVar.hash q in
+    let h' = QGlobal.hash q in
     combinesmall 3 (combine h h')
+  | VSort (q, u) ->
+    let h = Univ.Universe.hash u in
+    let h' = QVar.hash q in
+    combinesmall 4 (combine h h')
 
 module HSorts =
   Hashcons.Make(
@@ -455,16 +515,22 @@ module HSorts =
         | Type u as c ->
           let hu, u' = Universe.hcons u in
           combinesmall 2 hu, if u' == u then c else Type u'
-        | QSort (q, u) as c ->
+        | GSort (q, u) as c ->
+          let hq, q' = QGlobal.hcons q in
+          let hu, u' = Universe.hcons u in
+          combinesmall 3 (combine hu hq), if u' == u && q' == q then c else GSort (q', u')
+        | VSort (q, u) as c ->
           let hq, q' = QVar.hcons q in
           let hu, u' = Universe.hcons u in
-          combinesmall 3 (combine hu hq), if u' == u && q' == q then c else QSort (q', u')
+          combinesmall 4 (combine hu hq), if u' == u && q' == q then c else VSort (q', u')
         | SProp | Prop | Set as s -> hash s, s
+
       let eq s1 s2 = match (s1,s2) with
         | SProp, SProp | Prop, Prop | Set, Set -> true
         | (Type u1, Type u2) -> u1 == u2
-        | QSort (q1, u1), QSort (q2, u2) -> q1 == q2 && u1 == u2
-        | (SProp | Prop | Set | Type _ | QSort _), _ -> false
+        | GSort (q1, u1), GSort (q2, u2) -> q1 == q2 && u1 == u2
+        | VSort (q1, u1), VSort (q2, u2) -> q1 == q2 && u1 == u2
+        | (SProp | Prop | Set | Type _ | GSort _ | VSort _), _ -> false
     end)
 
 let hcons = Hashcons.simple_hcons HSorts.generate HSorts.hcons ()
@@ -488,35 +554,55 @@ let relevance_subst_fn f = function
     let open Quality in
     match f qv with
     | QConstant QSProp -> Irrelevant
-    | QConstant (QProp | QType) -> Relevant
+    | QConstant (QProp | QType) | QGlobal _ -> Relevant
     | QVar qv' ->
       if qv' == qv then r else RelevanceVar qv'
 
 let relevance_of_sort = function
   | SProp -> Irrelevant
-  | Prop | Set | Type _ -> Relevant
-  | QSort (q, _) -> RelevanceVar q
+  | Prop | Set | Type _ | GSort _ -> Relevant
+  | VSort (q, _) -> RelevanceVar q
+
+let is_relevant = function
+  | Relevant -> true
+  | Irrelevant | RelevanceVar _ -> false
 
 let debug_print = function
   | SProp -> Pp.(str "SProp")
   | Prop -> Pp.(str "Prop")
   | Set -> Pp.(str "Set")
   | Type u -> Pp.(str "Type(" ++ Univ.Universe.raw_pr u ++ str ")")
-  | QSort (q, u) -> Pp.(str "QSort(" ++ QVar.raw_pr q ++ str ","
+  | GSort (q, u) -> Pp.(str "QSort(" ++ QGlobal.raw_pr q ++ str ","
                         ++ spc() ++ Univ.Universe.raw_pr u ++ str ")")
+  | VSort (q, u) -> Pp.(str "VSort(" ++ QVar.raw_pr q ++ str ","
+                        ++ spc() ++ Univ.Universe.raw_pr u ++ str ")")
+
+type printer = {
+  prq : Quality.printer;
+  pru : Level.t -> Pp.t;
+}
 
-let pr prv pru = function
+let pr printer = function
   | SProp -> Pp.(str "SProp")
   | Prop -> Pp.(str "Prop")
   | Set -> Pp.(str "Set")
-  | Type u -> Pp.(str "Type@{" ++ pru u ++ str "}")
-  | QSort (q, u) -> Pp.(str "Type@{" ++ prv q ++ str "|"
-                        ++ spc() ++ pru u ++ str "}")
+  | Type u -> Pp.(str "Type@{" ++ Universe.pr printer.pru u ++ str "}")
+  | GSort (q, u) ->
+    Pp.(hov 0 (str "Type@{" ++ printer.prq.prglobal q ++ str ";"
+               ++ spc() ++ Universe.pr printer.pru u ++ str "}"))
+  | VSort (q, u) ->
+    Pp.(hov 0 (str "Type@{" ++ printer.prq.prvar q ++ str ";"
+               ++ spc() ++ Universe.pr printer.pru u ++ str "}"))
+
+let raw_printer = {
+  prq = Quality.raw_printer;
+  pru = Level.raw_pr;
+}
 
-let raw_pr = pr QVar.raw_pr Univ.Universe.raw_pr
+let raw_pr = pr raw_printer
 
 type ('q, 'u) pattern =
-  | PSProp | PSSProp | PSSet | PSType of 'u | PSQSort of 'q * 'u
+  | PSProp | PSSProp | PSSet | PSType of 'u | PSGlobal of QGlobal.t * 'u | PSQSort of 'q * 'u
 
 let extract_level u =
   match Universe.level u with
@@ -524,8 +610,7 @@ let extract_level u =
   | None -> CErrors.anomaly Pp.(str "Tried to extract level of an algebraic universe")
 
 let extract_sort_level = function
-  | Type u
-  | QSort (_, u) -> extract_level u
+  | Type u | GSort (_, u) | VSort (_, u) -> extract_level u
   | Prop | SProp | Set -> Univ.Level.set
 
 let pattern_match ps s qusubst =
@@ -535,5 +620,6 @@ let pattern_match ps s qusubst =
   | PSSet, Set -> Some qusubst
   | PSType uio, Set -> Some (Partial_subst.maybe_add_univ uio Univ.Level.set qusubst)
   | PSType uio, Type u -> Some (Partial_subst.maybe_add_univ uio (extract_level u) qusubst)
+  | PSGlobal (qg, uio), GSort (qg', u) -> if QGlobal.equal qg qg' then Some (Partial_subst.maybe_add_univ uio (extract_level u) qusubst) else None
   | PSQSort (qio, uio), s -> Some (qusubst |> Partial_subst.maybe_add_quality qio (quality s) |> Partial_subst.maybe_add_univ uio (extract_sort_level s))
-  | (PSProp | PSSProp | PSSet | PSType _), _ -> None
+  | (PSProp | PSSProp | PSSet | PSType _ | PSGlobal _), _ -> None
diff --git a/kernel/sorts.mli b/kernel/sorts.mli
index 93b0a482933e..a40529079b52 100644
--- a/kernel/sorts.mli
+++ b/kernel/sorts.mli
@@ -15,13 +15,19 @@ sig
 
   type t
 
-  val make : Names.DirPath.t -> Names.Id.t -> t
-  val repr : t -> Names.DirPath.t * Names.Id.t
+  val make : Names.DirPath.t -> int -> t
+  val repr : t -> Names.DirPath.t * int
   val equal : t -> t -> bool
   val hash : t -> int
   val compare : t -> t -> int
+
   val to_string : t -> string
 
+  module Set : sig
+    include CSig.SetS with type elt = t
+    val pr : (elt -> Pp.t) -> t -> Pp.t
+  end
+
 end
 
 module QVar :
@@ -31,8 +37,8 @@ sig
   val var_index : t -> int option
 
   val make_var : int -> t
+  val make_secvar : int -> t
   val make_unif : string -> int -> t
-  val make_global : QGlobal.t -> t
 
   val equal : t -> t -> bool
   val compare : t -> t -> int
@@ -47,14 +53,14 @@ sig
 
   type repr =
     | Var of int
+    | Secvar of int
     | Unif of string * int
-    | Global of QGlobal.t
 
   val repr : t -> repr
   val of_repr : repr -> t
 
+  val is_secvar : t -> bool
   val is_unif : t -> bool
-  val is_global : t -> bool
 
   module Set : sig
     include CSig.SetS with type elt = t
@@ -66,7 +72,7 @@ end
 
 module Quality : sig
   type constant = QProp | QSProp | QType
-  type t = QVar of QVar.t | QConstant of constant
+  type t = QVar of QVar.t | QConstant of constant | QGlobal of QGlobal.t
 
   module Constants : sig
     val equal : constant -> constant -> bool
@@ -91,21 +97,24 @@ module Quality : sig
   val global : QGlobal.t -> t
   (** [global i] is [QVar (QVar.make_global i)] *)
 
-  val is_var : t -> bool
-
   val var_index : t -> int option
 
   val equal : t -> t -> bool
 
   val compare : t -> t -> int
 
-  val pr : (QVar.t -> Pp.t) -> t -> Pp.t
+  type printer = {
+    prvar : QVar.t -> Pp.t;
+    prglobal : QGlobal.t -> Pp.t;
+  }
+
+  val pr : printer -> t -> Pp.t
+
+  val raw_printer : printer
 
   val raw_pr : t -> Pp.t
 
   val all_constants : t list
-  val all : t list
-  (* Returns a dummy variable *)
 
   val hash : t -> int
 
@@ -116,12 +125,18 @@ module Quality : sig
 
   val subst_fn : t QVar.Map.t -> QVar.t -> t
 
-  module Set : CSig.SetS with type elt = t
+  module Set : sig
+    include CSig.SetS with type elt = t
+
+    val of_qvars : QVar.Set.t -> t
+
+    val of_qglobals : QGlobal.Set.t -> t
+  end
 
   module Map : CMap.ExtS with type key = t and module Set := Set
 
   type 'q pattern =
-    PQVar of 'q | PQConstant of constant
+    PQVar of 'q | PQConstant of constant | PQGlobal of QGlobal.t
 
   val pattern_match : int option pattern -> t -> ('t, t, 'u) Partial_subst.t -> ('t, t, 'u) Partial_subst.t option
 end
@@ -137,13 +152,13 @@ module ElimConstraint : sig
 
   val compare : t -> t -> int
 
-  val pr : (QVar.t -> Pp.t) -> t -> Pp.t
+  val pr : Quality.printer -> t -> Pp.t
 
   val raw_pr : t -> Pp.t
 end
 
-module ElimConstraints : sig include Stdlib.Set.S with type elt = ElimConstraint.t
-  val pr : (QVar.t -> Pp.t) -> t -> Pp.t
+module ElimConstraints : sig include CSet.ExtS with type elt = ElimConstraint.t
+  val pr : Quality.printer -> t -> Pp.t
 
   val hcons : t Hashcons.f
 end
@@ -152,8 +167,8 @@ module QContextSet :
 sig
   type t = QVar.Set.t * ElimConstraints.t
   val empty : t
+  val is_empty : t -> bool
   val union : t -> t -> t
-  val filter_constant_qualities : t -> t (* XXX: this looks very wrong *)
 end
 
 type t = private
@@ -161,13 +176,15 @@ type t = private
   | Prop
   | Set
   | Type of Univ.Universe.t
-  | QSort of QVar.t * Univ.Universe.t
+  | GSort of QGlobal.t * Univ.Universe.t
+  | VSort of QVar.t * Univ.Universe.t
 
 val sprop : t
 val set  : t
 val prop : t
 val type1  : t
-val qsort : QVar.t -> Univ.Universe.t -> t
+val gsort : QGlobal.t -> Univ.Universe.t -> t
+val vsort : QVar.t -> Univ.Universe.t -> t
 val make : Quality.t -> Univ.Universe.t -> t
 
 val equal : t -> t -> bool
@@ -177,7 +194,6 @@ val hash : t -> int
 val is_sprop : t -> bool
 val is_set : t -> bool
 val is_prop : t -> bool
-val is_small : t -> bool
 val quality : t -> Quality.t
 
 val hcons : t Hashcons.f
@@ -204,11 +220,22 @@ val relevance_subst_fn : (QVar.t -> Quality.t) -> relevance -> relevance
 
 val relevance_of_sort : t -> relevance
 
+val is_relevant : relevance -> bool
+
 val debug_print : t -> Pp.t
-val pr : (QVar.t -> Pp.t) -> (Univ.Universe.t -> Pp.t) -> t -> Pp.t
+
+type printer = {
+  prq : Quality.printer;
+  pru : Univ.Level.t -> Pp.t;
+}
+
+val pr : printer -> t -> Pp.t
+
+val raw_printer : printer
+
 val raw_pr : t -> Pp.t
 
 type ('q, 'u) pattern =
-  | PSProp | PSSProp | PSSet | PSType of 'u | PSQSort of 'q * 'u
+  | PSProp | PSSProp | PSSet | PSType of 'u | PSGlobal of QGlobal.t * 'u | PSQSort of 'q * 'u
 
 val pattern_match : (int option, int option) pattern -> t -> ('t, Quality.t, Univ.Level.t) Partial_subst.t -> ('t, Quality.t, Univ.Level.t) Partial_subst.t option
diff --git a/kernel/subtyping.ml b/kernel/subtyping.ml
index 15e9fb67c71e..0443f7b57682 100644
--- a/kernel/subtyping.ml
+++ b/kernel/subtyping.ml
@@ -95,12 +95,24 @@ let check_conv_error error why state poly pb env a1 a2 =
   | Result.Error (Some (Univ e)) -> error (IncompatibleUniverses { err = e; env; t1 = a1; t2 = a2 })
   | Result.Error (Some (Qual e)) -> error (IncompatibleQualities { err = e; env; t1 = a1; t2 = a2 })
 
+(** Subtyping of polymorphic contexts *)
+
+let check_polymorphic_universes env ctxT ctx =
+  if not @@ eq_sizes (AbstractContext.size ctxT) (AbstractContext.size ctx) then false
+  else
+    let uctxT = AbstractContext.repr ctxT in
+    let () = Environ.check_ucontext uctxT env in
+    let env = Environ.push_context ~strict:false uctxT env in
+    let qcst, ucst = UContext.constraints (AbstractContext.repr ctx) in
+    UGraph.check_constraints ucst (Environ.universes env) &&
+    QGraph.check_constraints qcst (Environ.qualities env)
+
 let check_universes error env u1 u2 =
   match u1, u2 with
   | Monomorphic, Monomorphic -> env
   | Polymorphic auctx1, Polymorphic auctx2 ->
-    if not (UGraph.check_subtype (Environ.universes env) auctx2 auctx1) then
-      error (IncompatibleUnivConstraints { got = auctx1; expect = auctx2; } )
+    if not (check_polymorphic_universes env auctx2 auctx1) then
+      error (IncompatibleUnivConstraints { env; got = auctx1; expect = auctx2; } )
     else
       let () = Environ.check_ucontext (UVars.AbstractContext.repr auctx2) env in
       let env = Environ.push_context ~strict:false (UVars.AbstractContext.repr auctx2) env in
@@ -216,10 +228,11 @@ let check_inductive (cst, ustate) trace env mp1 l info1 mp2 mib2 subst1 subst2 r
     error (InductiveParamsNumberField { got = mib1.mind_nparams; expected = mib2.mind_nparams });
 
   begin
+    let kn1' = kn_of_delta reso1 kn1 in
     let kn2' = kn_of_delta reso2 kn2 in
-    let mind1 = mind_of_delta_kn reso1 kn1 in
+    let mind1 = MutInd.make kn1 kn1' in
     let mind2 = subst_mind subst2 (MutInd.make kn2 kn2') in
-    if KerName.equal kn2 kn2' || MutInd.CanOrd.equal mind1 mind2
+    if KerName.equal kn2 kn2' || KerName.equal kn1' (MutInd.canonical mind2)
     then ()
     else error (NotEqualInductiveAliases (mind1, mind2))
   end;
diff --git a/kernel/subtyping.mli b/kernel/subtyping.mli
index 489c0dbae6df..15d8f1378bc1 100644
--- a/kernel/subtyping.mli
+++ b/kernel/subtyping.mli
@@ -13,3 +13,8 @@ open Mod_declarations
 open Environ
 
 val check_subtypes : ('a, Conversion.graph_inconsistency) Conversion.universe_state -> env -> ModPath.t -> ModPath.t -> module_type_body -> 'a
+
+val check_polymorphic_universes :
+  Environ.env ->
+  UVars.AbstractContext.t -> UVars.AbstractContext.t ->
+  bool
diff --git a/kernel/term.ml b/kernel/term.ml
index 47d2de8c5773..987286d5671f 100644
--- a/kernel/term.ml
+++ b/kernel/term.ml
@@ -314,20 +314,25 @@ let decompose_lambda_n_assum n =
    the inner body [T].
    Lets in between are not expanded but turn into local definitions,
    and n is the number of lambdas and lets to decompose. *)
-let decompose_lambda_n_decls n =
+let decompose_lambda_n_decls_opt n c =
   if n < 0 then
     anomaly (str "decompose_lambda_n_decls: integer parameter must be positive.");
   let rec lamdec_rec l n c =
-    if Int.equal n 0 then l,c
+    if Int.equal n 0 then Some (l,c)
     else
       let open Context.Rel.Declaration in
       match kind 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
-      | _ -> anomaly (str "decompose_lambda_n_decls: not enough declarations.")
+      | _ -> None
   in
-  lamdec_rec Context.Rel.empty n
+  lamdec_rec Context.Rel.empty n c
+
+let decompose_lambda_n_decls n c =
+  match decompose_lambda_n_decls_opt n c with
+  | Some v -> v
+  | None -> anomaly (str "decompose_lambda_n_decls: not enough declarations.")
 
 let prod_decls t = fst (decompose_prod_decls t)
 let prod_n_decls n t = fst (decompose_prod_n_decls n t)
diff --git a/kernel/term.mli b/kernel/term.mli
index 75fc76993f12..2abc3feebb98 100644
--- a/kernel/term.mli
+++ b/kernel/term.mli
@@ -149,6 +149,7 @@ val decompose_lambda_prod_n_decls : int -> constr -> types -> Constr.rel_context
 val decompose_lambda_n_assum : int -> constr -> Constr.rel_context * constr
 
 (** Idem, counting let-ins *)
+val decompose_lambda_n_decls_opt : int -> constr -> (Constr.rel_context * constr) option
 val decompose_lambda_n_decls : int -> constr -> Constr.rel_context * constr
 
 (** Return the premisses/parameters of a type/term (let-in included) *)
diff --git a/kernel/type_errors.ml b/kernel/type_errors.ml
index 769882d5535d..46907921d39b 100644
--- a/kernel/type_errors.ml
+++ b/kernel/type_errors.ml
@@ -73,7 +73,7 @@ type ('constr, 'types, 'r) ptype_error =
       int * (Name.t, 'r) Context.pbinder_annot array * ('constr, 'types) punsafe_judgment array * 'types array
   | UnsatisfiedUnivConstraints of UnivConstraints.t
   | UnsatisfiedPConstraints of PConstraints.t
-  | UndeclaredQualities of Sorts.QVar.Set.t
+  | UndeclaredQualities of Sorts.Quality.Set.t
   | UndeclaredUniverses of Level.Set.t
   | NotAllowedSProp
   | BadBinderRelevance of 'r * ('constr, 'types, 'r) Context.Rel.Declaration.pt
diff --git a/kernel/type_errors.mli b/kernel/type_errors.mli
index c3698be298ab..8686d59a87f2 100644
--- a/kernel/type_errors.mli
+++ b/kernel/type_errors.mli
@@ -75,7 +75,7 @@ type ('constr, 'types, 'r) ptype_error =
       int * (Name.t,'r) Context.pbinder_annot array * ('constr, 'types) punsafe_judgment array * 'types array
   | UnsatisfiedUnivConstraints of UnivConstraints.t
   | UnsatisfiedPConstraints of PConstraints.t
-  | UndeclaredQualities of Sorts.QVar.Set.t
+  | UndeclaredQualities of Sorts.Quality.Set.t
   | UndeclaredUniverses of Level.Set.t
   | NotAllowedSProp
   | BadBinderRelevance of 'r * ('constr, 'types, 'r) Context.Rel.Declaration.pt
@@ -156,7 +156,7 @@ val error_unsatisfied_univ_constraints : env -> Univ.UnivConstraints.t -> 'a
 
 val error_unsatisfied_poly_constraints : env -> PConstraints.t -> 'a
 
-val error_undeclared_qualities : env -> Sorts.QVar.Set.t -> 'a
+val error_undeclared_qualities : env -> Sorts.Quality.Set.t -> 'a
 
 val error_undeclared_universes : env -> Level.Set.t -> 'a
 
diff --git a/kernel/typeops.ml b/kernel/typeops.ml
index babc196a3933..89ef003bf191 100644
--- a/kernel/typeops.ml
+++ b/kernel/typeops.ml
@@ -24,7 +24,6 @@ open Inductive
 open Type_errors
 
 module RelDecl = Context.Rel.Declaration
-module NamedDecl = Context.Named.Declaration
 
 exception NotConvertible
 exception NotConvertibleVect of int
@@ -90,9 +89,10 @@ let check_assumption env x t ty =
   else
     error_bad_binder_relevance env r' (RelDecl.LocalAssum (x, t))
 
-let check_binding_relevance env na1 na2 =
-  (* Since we know statically the relevance here, we are stricter *)
-  assert (check_relevance env (binder_relevance na1) (binder_relevance na2))
+let check_binding_relevance env na1 na2 t =
+  let r1 = binder_relevance na1 in
+  if not (check_relevance env r1 (binder_relevance na2)) then
+    error_bad_binder_relevance env r1 (LocalAssum (na2, t))
 
 let esubst u s c =
   Vars.esubst Vars.lift_substituend s (subst_instance_constr u c)
@@ -111,7 +111,7 @@ let instantiate_context env u subst nas ctx =
     let subst = Esubst.subs_liftn i subst in
     let na = instantiate_relevance na in
     let ty = esubst u subst ty in
-    let () = check_binding_relevance env na nas.(i) in
+    let () = check_binding_relevance env na nas.(i) ty in
     LocalAssum (nas.(i), ty) :: ctx
   | LocalDef (na, ty, bdy) :: ctx ->
     let ctx = instantiate (pred i) ctx in
@@ -119,17 +119,17 @@ let instantiate_context env u subst nas ctx =
     let na = instantiate_relevance na in
     let ty = esubst u subst ty in
     let bdy = esubst u subst bdy in
-    let () = check_binding_relevance env na nas.(i) in
+    let () = check_binding_relevance env na nas.(i) ty in
     LocalDef (nas.(i), ty, bdy) :: ctx
   in
   instantiate (Array.length nas - 1) ctx
 
 let check_constant env cst =
-  let _, _, can = Environ.lookup_constant_key cst env in
+  let can = Environ.lookup_constant_canonical cst env in
   if not (KerName.equal can (Constant.canonical cst)) then error_ill_formed_constant env cst can
 
 let check_mind env mind =
-  let _, _, can = Environ.lookup_mind_key mind env in
+  let can = Environ.lookup_mind_canonical mind env in
   if not (KerName.equal can (MutInd.canonical mind)) then error_ill_formed_inductive env mind can
 
 (************************************************)
@@ -150,8 +150,7 @@ let type_of_type u =
 
 let type_of_sort = function
   | SProp | Prop | Set -> type1
-  | Type u -> type_of_type u
-  | QSort (_, u) -> type_of_type u
+  | Type u | GSort (_, u) | VSort (_, u) -> type_of_type u
 
 (*s Type of a de Bruijn index. *)
 
@@ -167,38 +166,6 @@ let type_of_variable env id =
   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.
-   Order does not have to be checked assuming that all names are distinct *)
-let check_hyps_inclusion env ?evars c sign =
-  let conv env a b = conv env ?evars a b in
-  Context.Named.fold_outside
-    (fun d1 () ->
-      let open Context.Named.Declaration in
-      let id = NamedDecl.get_id d1 in
-      try
-        let d2 = lookup_named id env in
-        let () = match conv env (get_type d2) (get_type d1) with
-        | Result.Ok () -> ()
-        | Result.Error () -> raise NotConvertible
-        in
-        (match d2,d1 with
-        | LocalAssum _, LocalAssum _ -> ()
-        | LocalAssum _, LocalDef _ ->
-            (* This is wrong, because we don't know if the body is
-               needed or not for typechecking: *) ()
-        | LocalDef _, LocalAssum _ -> raise NotConvertible
-        | LocalDef (_,b2,_), LocalDef (_,b1,_) ->
-          match conv env b2 b1 with
-          | Result.Ok () -> ()
-          | Result.Error () -> raise NotConvertible);
-      with Not_found | NotConvertible | Option.Heterogeneous ->
-        error_reference_variables env id c)
-    sign
-    ~init:()
-
 (* Instantiation of terms on real arguments. *)
 
 (* Make a type polymorphic if an arity *)
@@ -207,16 +174,12 @@ let check_hyps_inclusion env ?evars c sign =
 
 let type_of_constant env (kn,_u as cst) =
   let () = check_constant env kn in
-  let cb = lookup_constant kn env in
-  let () = check_hyps_inclusion env (GlobRef.ConstRef kn) cb.const_hyps in
   let ty, cu = constant_type env cst in
   let () = check_poly_constraints cu env in
     ty
 
 let type_of_constant_in env (kn,_u as cst) =
   let () = check_constant env kn in
-  let cb = lookup_constant kn env in
-  let () = check_hyps_inclusion env (GlobRef.ConstRef kn) cb.const_hyps in
   constant_type_in env cst
 
 (* Type of a lambda-abstraction. *)
@@ -340,30 +303,12 @@ let type_of_array env u =
 (* Type of product *)
 
 let sort_of_product env domsort rangsort =
-  match (domsort, rangsort) with
-    | (_, SProp) | (SProp, _) -> rangsort
-    (* Product rule (s,Prop,Prop) *)
-    | (_,       Prop)  -> rangsort
-    (* Product rule (Prop/Set,Set,Set) *)
-    | ((Prop | Set),  Set) -> rangsort
-    (* Product rule (Type,Set,?) *)
-    | ((Type u1 | QSort (_, u1)), Set) ->
-        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 *)
-          Sorts.sort_of_univ (Universe.sup Universe.type0 u1)
-    (* Product rule (Prop,Type_i,Type_i) *)
-    | (Set,  Type u2)  -> Sorts.sort_of_univ (Universe.sup Universe.type0 u2)
-    | (Set,  QSort (q, u2))  ->
-      Sorts.qsort q (Universe.sup Universe.type0 u2)
-    (* Product rule (Prop,Type_i,Type_i) *)
-    | (Prop, (Type _ | QSort _))  -> rangsort
-    (* Product rule (Type_i,Type_i,Type_i) *)
-    | ((Type u1 | QSort (_, u1)), Type u2) -> Sorts.sort_of_univ (Universe.sup u1 u2)
-    | ((Type u1 | QSort (_, u1)), (QSort (q, u2))) ->
-      Sorts.qsort q (Universe.sup u1 u2)
+  if is_impredicative_sort env rangsort then rangsort
+  else match domsort with
+    | SProp | Prop -> rangsort
+    | _ ->
+    let u1 = univ_of_sort domsort and u2 = univ_of_sort rangsort in
+    Sorts.make (quality rangsort) (Universe.sup u1 u2)
 
 (* [judge_of_product env name (typ1,s1) (typ2,s2)] implements the rule
 
@@ -426,7 +371,8 @@ let make_param_univs env indu spec args argtys =
       | Prop -> TemplateProp
       | Set -> TemplateUniv Universe.type0
       | Type u -> TemplateUniv u
-      | QSort (q,u) ->
+      | GSort _ -> assert false
+      | VSort (q,u) ->
         assert (Environ.Internal.is_above_prop env q);
         TemplateAboveProp (q,u))
     argtys
@@ -435,7 +381,6 @@ let type_of_inductive_knowing_parameters env (ind,u as indu) args argst =
   let () = check_mind env (fst ind) in
   let (mib,_mip) as spec = lookup_mind_specif env ind in
   let () = assert (Option.has_some mib.mind_template) in
-  let () = check_hyps_inclusion env (GlobRef.IndRef ind) mib.mind_hyps in
   let param_univs = make_param_univs env indu spec args argst in
   let t, cst = Inductive.type_of_inductive_knowing_parameters (spec,u) param_univs in
   let () = check_poly_constraints cst env in
@@ -444,7 +389,6 @@ let type_of_inductive_knowing_parameters env (ind,u as indu) args argst =
 let type_of_inductive env (ind,u) =
   let () = check_mind env (fst ind) in
   let (mib,mip) = lookup_mind_specif env ind in
-  check_hyps_inclusion env (GlobRef.IndRef ind) mib.mind_hyps;
   let t,cst = Inductive.constrained_type_of_inductive ((mib,mip),u) in
   check_poly_constraints cst env;
   t
@@ -456,7 +400,6 @@ let type_of_constructor_knowing_parameters env (c, u as cu) args argst =
   let () = check_mind env (fst ind) in
   let (mib, _ as spec) = lookup_mind_specif env ind in
   let () = assert (Option.has_some mib.mind_template) in
-  let () = check_hyps_inclusion env (GlobRef.ConstructRef c) mib.mind_hyps in
   let param_univs = make_param_univs env (ind, u) spec args argst in
   let t, cst = Inductive.type_of_constructor_knowing_parameters cu spec param_univs in
   let () = check_poly_constraints cst env in
@@ -465,8 +408,7 @@ let type_of_constructor_knowing_parameters env (c, u as cu) args argst =
 let type_of_constructor env (c,_u as cu) =
   let ind = inductive_of_constructor c in
   let () = check_mind env (fst ind) in
-  let (mib, _ as specif) = lookup_mind_specif env ind in
-  let () = check_hyps_inclusion env (GlobRef.ConstructRef c) mib.mind_hyps in
+  let specif = lookup_mind_specif env ind in
   let t,cst = constrained_type_of_constructor cu specif in
   let () = check_poly_constraints cst env in
   t
@@ -675,7 +617,7 @@ and execute_aux tbl env cstr =
     | Sort s ->
       let () = match s with
       | SProp -> if not (Environ.sprop_allowed env) then error_not_allowed_sprop env
-      | QSort _ | Prop | Set | Type _ -> ()
+      | _ -> ()
       in
       type_of_sort s
 
@@ -886,8 +828,8 @@ let execute env c =
 (* Derived functions *)
 
 let check_declared_qualities env qualities =
-  let module S = Sorts.QVar.Set in
-  let unknown = S.diff qualities (Environ.qvars env) in
+  let module S = Sorts.Quality.Set in
+  let unknown = S.diff qualities (QGraph.domain @@ Environ.qualities env) in
   if S.is_empty unknown then ()
   else error_undeclared_qualities env unknown
 
diff --git a/kernel/typeops.mli b/kernel/typeops.mli
index d9a47916cc16..326185780b75 100644
--- a/kernel/typeops.mli
+++ b/kernel/typeops.mli
@@ -71,10 +71,6 @@ val type_of_global_in_context : env -> GlobRef.t -> types * UVars.AbstractContex
 
 (** {6 Miscellaneous. } *)
 
-(** Check that hyps are included in env and fails with error otherwise *)
-val check_hyps_inclusion : env -> ?evars:CClosure.evar_handler ->
-  GlobRef.t -> Constr.named_context -> unit
-
 (** Types for primitives *)
 
 val type_of_int : env -> types
diff --git a/kernel/uGraph.ml b/kernel/uGraph.ml
index dc5ad7de323a..f40d4d07b03c 100644
--- a/kernel/uGraph.ml
+++ b/kernel/uGraph.ml
@@ -19,6 +19,7 @@ module G = AcyclicGraph.Make(struct
 
     let equal = Level.equal
     let compare = Level.compare
+    let root = Some Level.set
 
     let raw_pr = Level.raw_pr
 
@@ -43,8 +44,7 @@ type explanation =
   | Path of path_explanation
   | Other of Pp.t
 
-type univ_variable_printers = (Sorts.QVar.t -> Pp.t) * (Level.t -> Pp.t)
-type univ_inconsistency = univ_variable_printers option * (UnivConstraint.kind * Sorts.t * Sorts.t * explanation option)
+type univ_inconsistency = Sorts.printer option * (UnivConstraint.kind * Sorts.t * Sorts.t * explanation option)
 
 exception UniverseInconsistency of univ_inconsistency
 
@@ -85,11 +85,7 @@ let empty_universes = {
   above_prop_qvars=Sorts.QVar.Set.empty;
 }
 
-let initial_universes =
-  let big_rank = 1000000 in
-  let g = G.empty in
-  let g = G.add ~rank:big_rank Level.set g in
-  {empty_universes with graph=g}
+let initial_universes = empty_universes
 
 let initial_universes_with g = {g with graph=initial_universes.graph}
 
@@ -129,38 +125,37 @@ let check_constraints csts g = UnivConstraints.for_all (check_constraint g) csts
 let is_above_prop ugraph q =
   Sorts.QVar.Set.mem q ugraph.above_prop_qvars
 
-let check_type_in_type_qualities q1 q2 =
-  let open Sorts.Quality in
-  if Sorts.Quality.equal q1 q2 then true
-  else
-    match q1, q2 with
-    | QConstant (QSProp | QProp), _ | _, QConstant (QSProp | QProp) -> true
-    | (QConstant _ | QVar _), _ -> false
-
 let check_eq_sort qeq univs s1 s2 =
-  if type_in_type univs then
-    check_eq univs (Sorts.univ_of_sort s1) (Sorts.univ_of_sort s2) ||
-      check_type_in_type_qualities (Sorts.quality s1) (Sorts.quality s2)
-  else
-    let u1 = Sorts.univ_of_sort s1 in
-    let u2 = Sorts.univ_of_sort s2 in
-    let q1 = Sorts.quality s1 in
-    let q2 = Sorts.quality s2 in
-    qeq q1 q2 && check_eq univs u1 u2
+  let u1 = Sorts.univ_of_sort s1 in
+  let u2 = Sorts.univ_of_sort s2 in
+  let q1 = Sorts.quality s1 in
+  let q2 = Sorts.quality s2 in
+  qeq q1 q2 && (type_in_type univs || check_eq univs u1 u2)
 
 let check_leq_sort qeq univs s1 s2 =
   if type_in_type univs then
-    check_leq univs (Sorts.univ_of_sort s1) (Sorts.univ_of_sort s2) ||
-      check_type_in_type_qualities (Sorts.quality s1) (Sorts.quality s2)
+    let q1 = Sorts.quality s1 in
+    let q2 = Sorts.quality s2 in
+    let open Sorts.Quality in
+    match q1, q2 with
+    | QConstant QProp, QConstant QType -> true
+    | _ -> qeq q1 q2
   else
     match s1, s2 with
     | (SProp, SProp) | (Prop, Prop) | (Set, Set) -> true
     | (Prop, (Set | Type _)) -> true
-    | (Prop, QSort (q, _)) -> is_above_prop univs q
+    | (Prop, VSort (q, _)) -> is_above_prop univs q
     | (Type _ | Set), (Set | Type _) -> check_leq univs (Sorts.univ_of_sort s1) (Sorts.univ_of_sort s2)
-    | (QSort (s1, u1), QSort (s2, u2)) -> qeq (Sorts.Quality.QVar s1) (Sorts.Quality.QVar s2) && check_leq univs u1 u2
-    | (QSort (q, u1), Type u2) -> is_above_prop univs q && check_leq univs u1 u2
-    | ((SProp | Prop | Set | Type _ | QSort _), _) -> false
+    | (GSort (s1, u1), GSort (s2, u2)) ->
+      qeq (QGlobal s1) (QGlobal s2) && check_leq univs u1 u2
+    | (VSort (s1, u1), VSort (s2, u2)) ->
+      qeq (QVar s1) (QVar s2) && check_leq univs u1 u2
+    | (GSort (s1, u1), VSort (s2, u2)) ->
+      qeq (QGlobal s1) (QVar s2) && check_leq univs u1 u2
+    | (VSort (s1, u1), GSort (s2, u2)) ->
+      qeq (QVar s1) (QGlobal s2) && check_leq univs u1 u2
+    | (VSort (q, u1), Type u2) -> is_above_prop univs q && check_leq univs u1 u2
+    | ((SProp | Prop | Set | Type _ | GSort _ | VSort _), _) -> false
 
 let leq_expr (u,m) (v,n) =
   let d = match m - n with
@@ -216,21 +211,6 @@ let constraints_for ~kept g =
   let add cst accu = UnivConstraints.add cst accu in
   G.constraints_for ~kept g.graph add UnivConstraints.empty
 
-(** Subtyping of polymorphic contexts *)
-
-let check_subtype univs ctxT ctx =
-  (* NB: size check is the only constraint on qualities *)
-  if eq_sizes (AbstractContext.size ctxT) (AbstractContext.size ctx) then
-    let uctx = AbstractContext.repr ctx in
-    let inst = UContext.instance uctx in
-    let cst = UContext.univ_constraints uctx in
-    let cstT = UContext.univ_constraints (AbstractContext.repr ctxT) in
-    let push accu v = add_universe v ~strict:false accu in
-    let univs = Array.fold_left push univs (snd (Instance.to_array inst)) in
-    let univs = merge_constraints cstT univs in
-    check_constraints cst univs
-  else false
-
 (** Instances *)
 
 let check_eq_instances qeq univs t1 t2 =
@@ -240,7 +220,6 @@ let check_eq_instances qeq univs t1 t2 =
   && CArray.equal (check_eq_level univs) ut1 ut2
 
 let domain g = G.domain g.graph
-let choose p g u = G.choose p g.graph u
 
 let check_universes_invariants g = G.check_invariants ~required_canonical:Level.is_set g.graph
 
@@ -274,17 +253,14 @@ let pr_universes prl g = pr_pmap Pp.mt (pr_arc prl) g
 
 open Pp
 
-let explain_universe_inconsistency default_prq default_prl (printers, (o,u,v,p) : univ_inconsistency) =
-  let prq, prl = match printers with
-    | Some (prq, prl) -> prq, prl
-    | None -> default_prq, default_prl
-  in
+let explain_universe_inconsistency default_printer (printer, (o,u,v,p) : univ_inconsistency) =
+  let printer = Option.default default_printer printer in
   let pr_uni u = match u with
   | Sorts.Set -> str "Set"
   | Sorts.Prop -> str "Prop"
   | Sorts.SProp -> str "SProp"
-  | Sorts.Type u -> Universe.pr prl u
-  | Sorts.QSort (q, u) -> str "Type@{" ++ prq q ++ str " | " ++ Universe.pr prl u ++ str"}"
+  | Sorts.Type u -> Universe.pr printer.pru u
+  | Sorts.VSort _ | GSort _ -> Sorts.pr printer u
   in
   let pr_rel = function
     | Eq -> str"=" | Lt -> str"<" | Le -> str"<="
@@ -296,8 +272,8 @@ let explain_universe_inconsistency default_prq default_prl (printers, (o,u,v,p)
       let pstart, p = Lazy.force p in
       if p = [] then mt ()
       else
-        str " because" ++ spc() ++ prl pstart ++
-        prlist (fun (r,v) -> spc() ++ pr_rel r ++ str" " ++ prl v) p
+        str " because" ++ spc() ++ printer.pru pstart ++
+        prlist (fun (r,v) -> spc() ++ pr_rel r ++ str" " ++ printer.pru v) p
   in
     str "Cannot enforce" ++ spc() ++ pr_uni u ++ spc() ++
       pr_rel o ++ spc() ++ pr_uni v ++ reason
diff --git a/kernel/uGraph.mli b/kernel/uGraph.mli
index 7ed22be15eaa..9a872ce9d541 100644
--- a/kernel/uGraph.mli
+++ b/kernel/uGraph.mli
@@ -16,7 +16,7 @@ type t
 
 val set_type_in_type : bool -> t -> t
 
-(** When [type_in_type], functions adding constraints do not fail and
+(** When [type_in_type], functions adding level constraints do not fail and
    may instead ignore inconsistent constraints.
 
     Checking functions such as [check_leq] always return [true].
@@ -50,8 +50,7 @@ type explanation =
   | Path of path_explanation
   | Other of Pp.t
 
-type univ_variable_printers = (Sorts.QVar.t -> Pp.t) * (Level.t -> Pp.t)
-type univ_inconsistency = univ_variable_printers option * (UnivConstraint.kind * Sorts.t * Sorts.t * explanation option)
+type univ_inconsistency = Sorts.printer option * (UnivConstraint.kind * Sorts.t * Sorts.t * explanation option)
 
 exception UniverseInconsistency of univ_inconsistency
 
@@ -64,13 +63,11 @@ val check_constraints : UnivConstraints.t -> t -> bool
 
 val check_eq_sort : (Sorts.Quality.t -> Sorts.Quality.t -> bool) -> t -> Sorts.t -> Sorts.t -> bool
 (** Checks whether (i) the first quality is equal to the second and (ii)
-    that the universe of the first one is equal to the universe of the second one.
-    When [type_in_type], only checks relevance. *)
+    that the universe of the first one is equal to the universe of the second one. *)
 
 val check_leq_sort : (Sorts.Quality.t -> Sorts.Quality.t -> bool) -> t -> Sorts.t -> Sorts.t -> bool
 (** Checks whether (i) the second quality eliminates into the first and (ii)
-    that the universe of the first one is below the universe of the second one.
-    When [type_in_type], only checks relevance. *)
+    that the universe of the first one is below the universe of the second one. *)
 
 val enforce_leq_alg : Univ.Universe.t -> Univ.Universe.t -> t -> Univ.UnivConstraints.t * t
 
@@ -92,10 +89,6 @@ val empty_universes : t
    of the universes into equivalence classes. *)
 val constraints_of_universes : t -> UnivConstraints.t * Level.Set.t list
 
-val choose : (Level.t -> bool) -> t -> Level.t -> Level.t option
-(** [choose p g u] picks a universe verifying [p] and equal
-   to [u] in [g]. *)
-
 (** [constraints_for ~kept g] returns the constraints about the
    universes [kept] in [g] up to transitivity.
 
@@ -105,10 +98,6 @@ val constraints_for : kept:Level.Set.t -> t -> UnivConstraints.t
 val domain : t -> Level.Set.t
 (** Known universes *)
 
-val check_subtype : AbstractContext.t check_function
-(** [check_subtype univ ctx1 ctx2] checks whether [ctx2] is an instance of
-    [ctx1]. *)
-
 (** {6 Dumping} *)
 
 type node =
@@ -121,8 +110,7 @@ val repr : t -> node Level.Map.t
 
 val pr_universes : (Level.t -> Pp.t) -> node Level.Map.t -> Pp.t
 
-val explain_universe_inconsistency : (Sorts.QVar.t -> Pp.t) -> (Level.t -> Pp.t) ->
-  univ_inconsistency -> Pp.t
+val explain_universe_inconsistency : Sorts.printer -> univ_inconsistency -> Pp.t
 
 (** {6 Debugging} *)
 val check_universes_invariants : t -> unit
diff --git a/kernel/uVars.ml b/kernel/uVars.ml
index adba4cf906c2..c2c9b50a2254 100644
--- a/kernel/uVars.ml
+++ b/kernel/uVars.ml
@@ -87,7 +87,7 @@ module Instance : sig
 
     val subst_fn : (Sorts.QVar.t -> Quality.t) * (Level.t -> Level.t) -> t -> t
 
-    val pr : (Sorts.QVar.t -> Pp.t) -> (Level.t -> Pp.t) -> ?variance:Variance.t array -> t -> Pp.t
+    val pr : Sorts.printer -> ?variance:Variance.t array -> t -> Pp.t
     val levels : t -> Quality.Set.t * Level.Set.t
 
     type ('q, 'u) mask = 'q Quality.pattern array * 'u array
@@ -170,12 +170,12 @@ struct
     let u = Array.fold_left (fun acc x -> Level.Set.add x acc) Level.Set.empty xu in
     q, u
 
-  let pr prq prl ?variance (q,u) =
+  let pr (printer:Sorts.printer) ?variance (q,u) =
     let ppu i u =
       let v = Option.map (fun v -> v.(i)) variance in
-      pr_opt_no_spc Variance.pr v ++ prl u
+      pr_opt_no_spc Variance.pr v ++ printer.pru u
     in
-    (if Array.is_empty q then mt() else prvect_with_sep spc (Quality.pr prq) q ++ strbrk " ; ")
+    (if Array.is_empty q then mt() else prvect_with_sep spc (Quality.pr printer.prq) q ++ strbrk " ; ")
     ++ prvecti_with_sep spc ppu u
 
   let equal (xq,xu) (yq,yu) =
@@ -241,7 +241,7 @@ let subst_instance_quality s l =
       | Some n -> (fst (Instance.to_array s)).(n)
       | None -> l
     end
-  | Quality.QConstant _ -> l
+  | Quality.QConstant _ | Quality.QGlobal _ -> l
 
 let subst_instance_instance s i =
   let qs, us = Instance.to_array i in
@@ -313,9 +313,9 @@ struct
   let empty = (empty_bound_names, (Instance.empty, PConstraints.empty))
   let is_empty (_, (univs, csts)) = Instance.is_empty univs && PConstraints.is_empty csts
 
-  let pr prq prl ?variance (_, (univs, csts) as uctx) =
+  let pr printer ?variance (_, (univs, csts) as uctx) =
     if is_empty uctx then mt() else
-      h (Instance.pr prq prl ?variance univs ++ str " |= ") ++ h (v 0 (PConstraints.pr prq prl csts))
+      h (Instance.pr printer ?variance univs ++ str " |= ") ++ h (v 0 (PConstraints.pr printer csts))
 
   let hcons ({quals = qnames; univs = unames}, (univs, csts)) =
     let hqnames, qnames = Hashcons.hashcons_array Names.Name.hcons qnames in
@@ -360,7 +360,7 @@ struct
     let us = Array.fold_left (fun acc x -> Level.Set.add x acc) Level.Set.empty us in
     let qs = Array.fold_left (fun acc -> function
         | Sorts.Quality.QVar x -> Sorts.QVar.Set.add x acc
-        | Sorts.Quality.QConstant _ -> assert false)
+        | Sorts.Quality.(QConstant _ | QGlobal _)  -> assert false)
         Sorts.QVar.Set.empty
         qs
     in
@@ -384,6 +384,8 @@ struct
 
   let names (nas, _) = nas
 
+  let constraints (_, csts) = csts
+
   let hcons ({quals = qnames; univs = unames}, cst) =
     let hqnames, qnames = Hashcons.hashcons_array Names.Name.hcons qnames in
     let hunames, unames = Hashcons.hashcons_array Names.Name.hcons unames in
@@ -407,7 +409,11 @@ struct
     let inst = Instance.abstract_instance (size self) in
     (names, (inst, cst))
 
-  let pr prq pru ?variance ctx = UContext.pr prq pru ?variance (repr ctx)
+  let refine_names names' (names, x) =
+    let merge_names = Array.map2 Names.(fun old refined -> match refined with Anonymous -> old | Name _ -> refined) in
+    ({quals = merge_names names.quals names'.quals; univs = merge_names names.univs names'.univs}, x)
+
+  let pr printer ?variance ctx = UContext.pr printer ?variance (repr ctx)
 
 end
 
@@ -457,7 +463,7 @@ let subst_sort_level_qvar subst qv =
   | Some q -> q
 
 let subst_sort_level_quality subst = function
-  | Quality.QConstant _ as q -> q
+  | Quality.(QConstant _ | QGlobal _) as q -> q
   | Quality.QVar q ->
     subst_sort_level_qvar subst q
 
@@ -482,9 +488,9 @@ let subst_poly_constraints (qsubst, usubst) (qctx, uctx) =
 let pr_universe_level_subst prl =
   Level.Map.pr prl (fun u -> str" := " ++ prl u ++ spc ())
 
-let pr_quality_level_subst prl l =
+let pr_quality_level_subst (printer:Quality.printer) l =
   let open Pp in
-  h (prlist_with_sep fnl (fun (u,v) -> prl u ++ str " := " ++ Sorts.Quality.pr prl v)
+  h (prlist_with_sep fnl (fun (u,v) -> printer.prvar u ++ str " := " ++ Sorts.Quality.pr printer v)
        (Sorts.QVar.Map.bindings l))
 
 type sort_level_subst = Quality.t Sorts.QVar.Map.t * universe_level_subst
@@ -513,7 +519,7 @@ let subst_sort_level_qvar (qsubst,_) qv =
   | Some q -> q
 
 let subst_sort_level_quality subst = function
-  | Sorts.Quality.QConstant _ as q -> q
+  | Sorts.Quality.(QConstant _ | QGlobal _) as q -> q
   | Sorts.Quality.QVar q ->
     subst_sort_level_qvar subst q
 
diff --git a/kernel/uVars.mli b/kernel/uVars.mli
index e327591d4142..2861e60ff83d 100644
--- a/kernel/uVars.mli
+++ b/kernel/uVars.mli
@@ -66,7 +66,7 @@ sig
   val hash : t -> int
   (** Hash value *)
 
-  val pr : (QVar.t -> Pp.t) -> (Level.t -> Pp.t) -> ?variance:Variance.t array -> t -> Pp.t
+  val pr : Sorts.printer -> ?variance:Variance.t array -> t -> Pp.t
   (** Pretty-printing, no comments *)
 
   val levels : t -> Quality.Set.t * Level.Set.t
@@ -151,7 +151,7 @@ sig
   val to_context_set : t -> Sorts.QContextSet.t * Univ.ContextSet.t
   (** Discard the names and order of the universes *)
 
-  val pr : (QVar.t -> Pp.t) -> (Level.t -> Pp.t) -> ?variance:Variance.t array -> t -> Pp.t
+  val pr : Sorts.printer -> ?variance:Variance.t array -> t -> Pp.t
 end
 (** A value in a universe context. *)
 type 'a in_universe_context = 'a * UContext.t
@@ -195,7 +195,13 @@ sig
   val names : t -> bound_names
   (** Return the names of the bound universe variables *)
 
-  val pr : (QVar.t -> Pp.t) -> (Level.t -> Pp.t) -> ?variance:Variance.t array -> t -> Pp.t
+  val constraints : t -> PConstraints.t
+  (** Return the constraints on the universe variables *)
+
+  val refine_names : bound_names -> t -> t
+  (** Use names to name the possibly yet unnamed universes *)
+
+  val pr : Sorts.printer -> ?variance:Variance.t array -> t -> Pp.t
 end
 
 type 'a univ_abstracted = {
@@ -222,7 +228,7 @@ val subst_poly_constraints : sort_level_subst -> PConstraints.t -> PConstraints.
 
 val pr_universe_level_subst : (Level.t -> Pp.t) -> universe_level_subst -> Pp.t
 
-val pr_quality_level_subst : (QVar.t -> Pp.t) -> Quality.t QVar.Map.t -> Pp.t
+val pr_quality_level_subst : Quality.printer -> Quality.t QVar.Map.t -> Pp.t
 
 val empty_sort_subst : sort_level_subst
 
diff --git a/kernel/vars.ml b/kernel/vars.ml
index 969c12551322..e300e3078e27 100644
--- a/kernel/vars.ml
+++ b/kernel/vars.ml
@@ -489,8 +489,10 @@ let univs_and_qvars_visitor =
   let visit_sort (qs,us as acc) = function
     | Sorts.Type u ->
       qs, Universe.levels ~init:us u
-    | Sorts.QSort (q,u) ->
-      Sorts.QVar.Set.add q qs, Universe.levels ~init:us u
+    | Sorts.GSort (q,u) ->
+      Sorts.Quality.Set.add (QGlobal q) qs, Universe.levels ~init:us u
+    | Sorts.VSort (q,u) ->
+      Sorts.Quality.Set.add (QVar q) qs, Universe.levels ~init:us u
     | Sorts.(SProp | Prop | Set) -> acc
   in
   let visit_instance (qs,us) u =
@@ -498,7 +500,7 @@ let univs_and_qvars_visitor =
     let qs = Array.fold_left (fun qs q ->
         let open Sorts.Quality in
         match q with
-        | QVar q -> Sorts.QVar.Set.add q qs
+        | QVar _ | QGlobal _ -> Sorts.Quality.Set.add q qs
         | QConstant _ -> qs)
         qs qs'
     in
@@ -507,7 +509,7 @@ let univs_and_qvars_visitor =
   in
   let visit_relevance (qs,us as acc) = let open Sorts in function
       | Irrelevant | Relevant -> acc
-      | RelevanceVar q -> QVar.Set.add q qs, us
+      | RelevanceVar q -> Quality.Set.add (QVar q) qs, us
   in
   {
     visit_sort = visit_sort;
@@ -528,7 +530,7 @@ let visit_kind_univs visit acc c =
     acc
   | _ -> acc
 
-let sort_and_universes_of_constr ?(init=Sorts.QVar.Set.empty,Univ.Level.Set.empty) c =
+let sort_and_universes_of_constr ?(init=Sorts.Quality.Set.empty,Univ.Level.Set.empty) c =
   let rec aux s c =
     let s = visit_kind_univs univs_and_qvars_visitor s (kind c) in
     Constr.fold aux s c
@@ -541,4 +543,4 @@ let sort_and_universes_of_constr ?init c =
     ()
 
 let universes_of_constr ?(init=Univ.Level.Set.empty) c =
-  snd (sort_and_universes_of_constr ~init:(Sorts.QVar.Set.empty,init) c)
+  snd (sort_and_universes_of_constr ~init:(Sorts.Quality.Set.empty,init) c)
diff --git a/kernel/vars.mli b/kernel/vars.mli
index 3b4d73aee9c5..f8b56718af61 100644
--- a/kernel/vars.mli
+++ b/kernel/vars.mli
@@ -203,7 +203,9 @@ val univ_instantiate_constr : Instance.t -> constr univ_abstracted -> constr
 val map_constr_relevance : (Sorts.relevance -> Sorts.relevance) -> Constr.t -> Constr.t
 (** Modifies the relevances in the head node (not in subterms) *)
 
-val sort_and_universes_of_constr : ?init:Sorts.QVar.Set.t * Univ.Level.Set.t -> constr -> Sorts.QVar.Set.t * Univ.Level.Set.t
+val sort_and_universes_of_constr : ?init:Sorts.Quality.Set.t * Univ.Level.Set.t -> constr ->
+  Sorts.Quality.Set.t * Univ.Level.Set.t
+(** Constant qualities not included in the output. *)
 
 val universes_of_constr : ?init:Univ.Level.Set.t -> constr -> Univ.Level.Set.t
 
diff --git a/kernel/vconv.ml b/kernel/vconv.ml
index d675d352a8f2..c999836ecba5 100644
--- a/kernel/vconv.ml
+++ b/kernel/vconv.ml
@@ -21,6 +21,13 @@ let convert_instances ~flex u1 u2 (state, check, box) =
   let state, check = Conversion.convert_instances ~flex u1 u2 (state, check) in
   fail_check state check box
 
+let convert_inductives pb mib u1 u2 ((state, check, box) as cuniv) =
+  match mib.Declarations.mind_variance with
+  | None -> convert_instances ~flex:false u1 u2 cuniv
+  | Some variances ->
+    let state, check = Conversion.convert_instances_cumul pb variances u1 u2 (state, check) in
+    fail_check state check box
+
 let sort_cmp_universes pb s1 s2 (state, check, box) =
   let state, check = Conversion.sort_cmp_universes pb s1 s2 (state, check) in
   fail_check state check box
@@ -44,6 +51,13 @@ let rec compare_stack stk1 stk2 =
       else false
   | _, _ -> false
 
+let equiv_id_key env (k1 : id_key) (k2 : id_key) = match k1, k2 with
+| ConstKey c1, ConstKey c2 -> QConstant.equal env c1 c2
+| VarKey id1, VarKey id2 -> Names.Id.equal id1 id2
+| RelKey n1, RelKey n2 -> Int.equal n1 n2
+| EvarKey evk1, EvarKey evk2 -> Evar.equal evk1 evk2
+| (ConstKey _ | VarKey _ | RelKey _ | EvarKey _), _ -> false
+
 (* Conversion *)
 let conv_vect fconv vect1 vect2 cu =
   let n = Array.length vect1 in
@@ -113,8 +127,9 @@ 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 Names.Ind.CanOrd.equal ind1 ind2 && compare_stack stk1 stk2 then
-      if UVars.AbstractContext.is_constant (Environ.mind_context env mi) then
+    if QInd.equal env ind1 ind2 && compare_stack stk1 stk2 then
+      let mib = Environ.lookup_mind mi env in
+      if UVars.AbstractContext.is_constant (Declareops.inductive_polymorphic_context mib) then
         conv_stack env k stk1 stk2 cu
       else begin
         match stk1 , stk2 with
@@ -123,14 +138,20 @@ and conv_atom env pb k a1 stk1 a2 stk2 cu =
           assert (0 < nargs args2);
           let u1 = uni_instance (arg args1 0) in
           let u2 = uni_instance (arg args2 0) in
-          let cu = convert_instances ~flex:false u1 u2 cu in
+          (* Aind is an accumulator but not a neutral, so we always
+             convert at a common type (after applying arguments).
+
+             Therefore if the inductive is not fully applied then the
+             missing parameters have identical types,
+             and we don't need to eta expand to use cumulativity. *)
+          let cu = convert_inductives pb mib u1 u2 cu in
           conv_arguments env ~from:1 k args1 args2
             (conv_stack env k stk1' stk2' cu)
         | _, _ -> assert false (* Should not happen if problem is well typed *)
       end
     else raise NotConvertible
   | Aid ik1, Aid ik2 ->
-    if Vmvalues.eq_id_key ik1 ik2 && compare_stack stk1 stk2 then
+    if equiv_id_key env ik1 ik2 && compare_stack stk1 stk2 then
       if UVars.AbstractContext.is_constant (table_key_instance env ik1) then
         conv_stack env k stk1 stk2 cu
       else
diff --git a/kernel/vmbytecodes.ml b/kernel/vmbytecodes.ml
index 0c1e8904ccdd..9ae4dc7794a5 100644
--- a/kernel/vmbytecodes.ml
+++ b/kernel/vmbytecodes.ml
@@ -147,7 +147,7 @@ let rec pp_instr i =
   | Kgetglobal idu -> str "getglobal " ++ Constant.print idu
   | Ksubstinstance u ->
     str "subst_instance " ++
-    UVars.Instance.pr Sorts.QVar.raw_pr Univ.Level.raw_pr u
+    UVars.Instance.pr Sorts.raw_printer u
   | Kconst sc ->
       str "const " ++ pp_struct_const sc
   | Kmakeblock(n, m) ->
diff --git a/kernel/vmbytegen.ml b/kernel/vmbytegen.ml
index cef33cd6a45a..9d24af91f5f2 100644
--- a/kernel/vmbytegen.ml
+++ b/kernel/vmbytegen.ml
@@ -355,9 +355,9 @@ let is_closed_sort env s = match env.uinstance with
   in
   match s with
   | Sorts.Set | Sorts.Prop | Sorts.SProp -> true
-  | Sorts.Type u ->
+  | Sorts.Type u | Sorts.GSort (_, u) ->
     Univ.Universe.for_all (fun (l, _) -> check ulen (Univ.Level.var_index l)) u
-  | Sorts.QSort (q, u) ->
+  | Sorts.VSort (q, u) ->
     check qlen (Sorts.QVar.var_index q)
     && Univ.Universe.for_all (fun (l, _) -> check ulen (Univ.Level.var_index l)) u
 
@@ -539,12 +539,9 @@ let rec compile_fv cenv l sz cont =
 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 tps with
-        | BCalias kn' -> get_alias env kn'
-        | _ -> kn)
+  match tps with
+   | BCalias kn' -> get_alias env kn'
+   | _ -> kn
 
 (* Some primitives are not implemented natively by the VM, but calling OCaml
    code instead *)
@@ -975,6 +972,7 @@ let warn_compile_error =
     Vmerrors.pr_error
 
 let compile ~fail_on_error ~uinstance env sigma c =
+  if not (typing_flags env).enable_VM then None else
   try NewProfile.profile "vm_compile" (fun () -> Some (compile ~uinstance env sigma c)) ()
   with Vmerrors.CompileError msg as exn ->
     let exn = Exninfo.capture exn in
@@ -986,8 +984,8 @@ let compile ~fail_on_error ~uinstance env sigma c =
     end
 
 let compile_constant_body ~fail_on_error env univs = function
-  | Undef _ | OpaqueDef _ -> Some BCconstant
-  | Primitive _ | Symbol _ -> None
+  | Undef _ | OpaqueDef _ | Primitive _ -> BCconstant
+  | Symbol _ -> BCuncompiled
   | Def body ->
       let instance_size = UVars.AbstractContext.size (Declareops.universes_context univs) in
       let alias =
@@ -1003,11 +1001,12 @@ let compile_constant_body ~fail_on_error env univs = function
             end
         | _ -> None in
       match alias with
-      | Some kn -> Some (BCalias kn)
-      | _ ->
+      | Some kn -> BCalias kn
+      | None ->
         let uinstance = Bound instance_size in
-        let res = compile ~fail_on_error ~uinstance env (empty_evars env) body in
-        Option.map (fun (mask, code, patch) -> BCdefined (mask, code, patch)) res
+        match compile ~fail_on_error ~uinstance env (empty_evars env) body with
+        | None -> BCuncompiled
+        | Some (mask, code, patch) -> BCdefined (mask, code, patch)
 
 let compile ~fail_on_error env sigma c =
   compile ~fail_on_error ~uinstance:Global env sigma c
diff --git a/kernel/vmbytegen.mli b/kernel/vmbytegen.mli
index 45c5659f7741..a4e41d28be15 100644
--- a/kernel/vmbytegen.mli
+++ b/kernel/vmbytegen.mli
@@ -20,7 +20,7 @@ val compile :
 
 val compile_constant_body : fail_on_error:bool ->
   env -> universes -> (Constr.t, 'opaque, 'symb) constant_def ->
-  body_code option
+  body_code
 
 (** Shortcut of the previous function used during module strengthening *)
 
diff --git a/kernel/vmemitcodes.ml b/kernel/vmemitcodes.ml
index 79ed7cda3b6d..c709688e68fc 100644
--- a/kernel/vmemitcodes.ml
+++ b/kernel/vmemitcodes.ml
@@ -35,7 +35,7 @@ let eq_reloc_info r1 r2 = match r1, r2 with
 | Reloc_annot _, _ -> false
 | Reloc_const c1, Reloc_const c2 -> eq_structured_constant c1 c2
 | Reloc_const _, _ -> false
-| Reloc_getglobal c1, Reloc_getglobal c2 -> Constant.CanOrd.equal c1 c2
+| Reloc_getglobal c1, Reloc_getglobal c2 -> Constant.UserOrd.equal c1 c2
 | Reloc_getglobal _, _ -> false
 | Reloc_caml_prim p1, Reloc_caml_prim p2 -> CPrimitives.equal (caml_prim_to_prim p1) (caml_prim_to_prim p2)
 | Reloc_caml_prim _, _ -> false
@@ -45,7 +45,7 @@ let hash_reloc_info r =
   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.CanOrd.hash c)
+  | Reloc_getglobal c -> combinesmall 3 (Constant.UserOrd.hash c)
   | Reloc_caml_prim p -> combinesmall 4 (CPrimitives.hash (caml_prim_to_prim p))
 
 module RelocTable = Hashtbl.Make(struct
@@ -632,6 +632,7 @@ type 'a pbody_code =
   | BCdefined of bool array * 'a * patches
   | BCalias of Names.Constant.t
   | BCconstant
+  | BCuncompiled
 
 type body_code = to_patch pbody_code
 
@@ -639,6 +640,7 @@ let subst_body_code s = function
 | BCdefined (m, x, tp) -> BCdefined (m, x, subst_patches s tp)
 | BCalias cu -> BCalias (subst_constant s cu)
 | BCconstant -> BCconstant
+| BCuncompiled -> BCuncompiled
 
 let to_memory fv code =
   let env = {
diff --git a/kernel/vmemitcodes.mli b/kernel/vmemitcodes.mli
index a15b72e80118..a471e327a0bc 100644
--- a/kernel/vmemitcodes.mli
+++ b/kernel/vmemitcodes.mli
@@ -26,6 +26,7 @@ type 'a pbody_code =
   | BCdefined of bool array * 'a * patches
   | BCalias of Constant.t
   | BCconstant
+  | BCuncompiled
 
 type body_code = to_patch pbody_code
 
diff --git a/kernel/vmsymtable.ml b/kernel/vmsymtable.ml
index 5f08956219eb..ea728e7b3a1e 100644
--- a/kernel/vmsymtable.ml
+++ b/kernel/vmsymtable.ml
@@ -265,11 +265,16 @@ let envcache_of_rel i envcache = {
   rel_adjust = envcache.rel_adjust + i
 }
 
+let warn_uncompiled = CWarnings.create ~name:"vm-uncompiled-constant" ~category:CWarnings.CoreCategories.bytecode_compiler ~default:AsError
+    Pp.(fun kn ->
+        str "VM encountered uncompiled constant "++Constant.print kn ++ str "." ++ spc() ++
+        str "Disable this warning to treat it as an opaque constant.")
+
 let rec slot_for_getglobal env sigma kn envcache table =
   let cb = CClosure.lookup_constant_handler env sigma.Genlambda.evars_val kn in
   let rk =
     if Environ.mem_constant kn env then
-      let (_, (_, rk),_) = lookup_constant_key kn env in
+      let (_, rk) = lookup_constant_key kn env in
       rk
     else
       ref None
@@ -284,6 +289,9 @@ let rec slot_for_getglobal env sigma kn envcache table =
       set_global v table
     | BCalias kn' -> slot_for_getglobal env sigma kn' envcache table
     | BCconstant -> set_global (val_of_constant kn) table
+    | BCuncompiled ->
+      warn_uncompiled kn;
+      set_global (val_of_constant kn) table
     in
     rk := Some (CEphemeron.create pos);
     pos
diff --git a/kernel/vmvalues.ml b/kernel/vmvalues.ml
index 71222e8c77d2..45f3b397e154 100644
--- a/kernel/vmvalues.ml
+++ b/kernel/vmvalues.ml
@@ -100,7 +100,7 @@ let hash_structured_values (v : structured_values) =
 let 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 -> Ind.CanOrd.equal i1 i2
+| Const_ind i1, Const_ind i2 -> Ind.UserOrd.equal i1 i2
 | Const_ind _, _ -> false
 | Const_evar e1, Const_evar e2 -> Evar.equal e1 e2
 | Const_evar _, _ -> false
@@ -121,7 +121,7 @@ let 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.CanOrd.hash i)
+  | Const_ind i -> combinesmall 2 (Ind.UserOrd.hash i)
   | Const_evar e -> combinesmall 3 (Evar.hash e)
   | Const_b0 t -> combinesmall 4 (Int.hash t)
   | Const_univ_instance u -> combinesmall 5 (UVars.Instance.hash u)
@@ -142,22 +142,12 @@ let hash_annot_switch asw =
   let h2 = if asw.tailcall then 1 else 0 in
   combine3 h1 h2 asw.max_stack_size
 
-let pp_sort s =
-  let open Sorts in
-  match s with
-  | SProp -> Pp.str "SProp"
-  | Prop -> Pp.str "Prop"
-  | Set -> Pp.str "Set"
-  | Type u -> Pp.(str "Type@{" ++ Univ.Universe.raw_pr u ++ str "}")
-  | QSort (q, u) ->
-    Pp.(str "QSort@{" ++ (Sorts.QVar.raw_pr q) ++ strbrk ", " ++ Univ.Universe.raw_pr u ++ str "}")
-
 let pp_struct_const = function
-  | Const_sort s -> pp_sort s
+  | Const_sort s -> Sorts.raw_pr s
   | Const_ind (mind, i) -> Pp.(MutInd.print mind ++ str"#" ++ int i)
   | Const_evar e -> Pp.( str "Evar(" ++ int (Evar.repr e) ++ str ")")
   | Const_b0 i -> Pp.int i
-  | Const_univ_instance u -> UVars.Instance.pr Sorts.QVar.raw_pr Univ.Level.raw_pr u
+  | Const_univ_instance u -> UVars.Instance.pr Sorts.raw_printer u
   | Const_val _ -> Pp.str "(value)"
   | Const_uint i -> Pp.str (Uint63.to_string i)
   | Const_float f -> Pp.str (Float64.to_string f)
@@ -262,7 +252,7 @@ type id_key =
 | EvarKey of Evar.t
 
 let eq_id_key (k1 : id_key) (k2 : id_key) = match k1, k2 with
-| ConstKey c1, ConstKey c2 -> Constant.CanOrd.equal c1 c2
+| ConstKey c1, ConstKey c2 -> Constant.UserOrd.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
@@ -453,7 +443,7 @@ struct
   let equal = eq_id_key
   open Hashset.Combine
   let hash : t -> tag = function
-  | ConstKey c -> combinesmall 1 (Constant.CanOrd.hash c)
+  | ConstKey c -> combinesmall 1 (Constant.UserOrd.hash c)
   | VarKey id -> combinesmall 2 (Id.hash id)
   | RelKey i -> combinesmall 3 (Int.hash i)
   | EvarKey evk -> combinesmall 4 (Evar.hash evk)
diff --git a/lib/acyclicGraph.ml b/lib/acyclicGraph.ml
index 2c97a1090057..5c28529ba114 100644
--- a/lib/acyclicGraph.ml
+++ b/lib/acyclicGraph.ml
@@ -18,6 +18,7 @@ module type Point = sig
 
   val equal : t -> t -> bool
   val compare : t -> t -> int
+  val root : t option
 
   val raw_pr : t -> Pp.t
 
@@ -114,19 +115,30 @@ module Make (Point:Point) = struct
       klvl: int;
       ilvl: int;
     }
+  (* When the root is set, [gtge] may contain references to indices in the root
+     equivalence class, despite having no associated (k, i)-levels. We filter
+     them in [get_gtge] below. [ltle] never contains root indices though. *)
 
   (* A Point.t is either an alias for another one, or a canonical one,
-     for which we know the points that are above *)
+     for which we know the points that are above, or the root. The root node
+     has no index. *)
 
   type entry =
     | Canonical of canonical_node
     | Equiv of Index.t
+    | Root (* Special case of Equiv to root node *)
+
+  type components = Index.t Int.Map.t Int.Map.t
+  (* Map of elements ordered topologically, i.e. first k-levels and then i-levels *)
 
   type t =
     { entries : entry PMap.t;
       index : int;
       n_nodes : int; n_edges : int;
-      table : Index.table }
+      table : Index.table;
+      components : components;
+      rootlt : PSet.t; (* nodes strictly above the root *)
+    }
 
   module CN = struct
     type t = canonical_node
@@ -146,42 +158,71 @@ module Make (Point:Point) = struct
     let fold = Internal.fold
   end
 
+  let remove_component k i comp =
+    let imap = Int.Map.get k comp in
+    let imap = Int.Map.remove i imap in
+    if Int.Map.is_empty imap then Int.Map.remove k comp
+    else Int.Map.set k imap comp
+
+  let add_component k i index comp =
+    let imap = try Int.Map.find k comp with Not_found -> Int.Map.empty in
+    let imap = Int.Map.add i index imap in
+    Int.Map.add k imap comp
+
+  let update_component ov nv comp =
+    if Int.equal ov.klvl nv.klvl && Int.equal ov.ilvl nv.ilvl then comp
+    else
+      let comp = remove_component ov.klvl ov.ilvl comp in
+      add_component nv.klvl nv.ilvl nv.canon comp
+
   (* Every Point.t has a unique canonical arc representative *)
 
   (* Low-level function : makes u an alias for v.
      Does not removes edges from n_edges, but decrements n_nodes.
      u should be entered as canonical before.  *)
   let enter_equiv g u v =
-    { entries =
-        PMap.modify u (fun _ a ->
-            match a with
-            | Canonical n ->
-              Equiv v
-            | _ -> assert false) g.entries;
+    let ucan = match PMap.find u g.entries with
+    | Canonical n -> n
+    | Equiv _ | Root -> assert false
+    in
+    let node = match v with
+    | None -> Root
+    | Some v -> Equiv v
+    in
+    { entries = PMap.set u node g.entries;
       index = g.index;
       n_nodes = g.n_nodes - 1;
       n_edges = g.n_edges;
-      table = g.table }
+      table = g.table;
+      components = remove_component ucan.klvl ucan.ilvl g.components;
+      rootlt = PSet.remove u g.rootlt;
+    }
 
   (* Low-level function : changes data associated with a canonical node.
      Resets the mutable fields in the old record, in order to avoid breaking
      invariants for other users of this record.
      n.canon should already been inserted as a canonical node. *)
   let change_node g n =
-    { g with entries =
-               PMap.modify n.canon
-                 (fun _ a ->
-                    match a with
-                    | Canonical _ ->
-                      Canonical n
-                    | _ -> assert false)
-                 g.entries }
+    let ucan = match PMap.find n.canon g.entries with
+    | Canonical n -> n
+    | Equiv _ | Root  -> assert false
+    in
+    let entries = PMap.set n.canon (Canonical n) g.entries in
+    let components = update_component ucan n g.components in
+    { g with entries; components }
 
   (* canonical representative : we follow the Equiv links *)
   let rec repr g u =
     match PMap.find u g.entries with
     | Equiv v -> repr g v
     | Canonical arc -> arc
+    | Root -> assert false
+
+  let rec repr_or_root g u =
+    match PMap.find u g.entries with
+    | Equiv v -> repr_or_root g v
+    | Canonical arc -> Some arc
+    | Root -> None
 
   let repr_node g u =
     try repr g (Index.find u g.table)
@@ -224,7 +265,9 @@ module Make (Point:Point) = struct
                         PSet.exists (fun l -> u == repr g l) v.gtge))
             u.ltle;
           PSet.iter (fun v ->
-              let v = repr g v in
+            match repr_or_root g v with
+            | None -> ()
+            | Some v ->
               assert (v.klvl = u.klvl &&
                       (PMap.mem u.canon v.ltle ||
                        PMap.exists (fun l _ -> u == repr g l) v.ltle))
@@ -233,7 +276,8 @@ module Make (Point:Point) = struct
           assert (u.ilvl > g.index);
           assert (not (PMap.mem u.canon u.ltle));
           incr n_nodes
-        | Equiv _ -> assert (not (required_canonical l)))
+        | Equiv _ -> assert (not (required_canonical l))
+        | Root -> ())
       g.entries;
     assert (!n_edges = g.n_edges);
     assert (!n_nodes = g.n_nodes)
@@ -250,7 +294,9 @@ module Make (Point:Point) = struct
 
   let clean_gtge g gtge =
     PSet.fold (fun u acc ->
-        let uu = (repr g u).canon in
+      match repr_or_root g u with
+      | None -> PSet.remove u (fst acc), true (* stale root index *)
+      | Some { canon = uu } ->
         if Index.equal uu u then acc
         else PSet.add uu (PSet.remove u (fst acc)), true)
       gtge (gtge, false)
@@ -395,9 +441,10 @@ module Make (Point:Point) = struct
       List.fold_left (fun acc n -> PSet.union acc n.gtge)
         PSet.empty to_merge
     in
+    let isrootlt = List.exists (fun n -> PSet.mem n.canon g.rootlt) to_merge in
     let gtge, _ = clean_gtge g gtge in
     let gtge = List.fold_left (fun acc n -> PSet.remove n.canon acc) gtge to_merge in
-    (ltle, gtge)
+    (ltle, gtge, isrootlt)
 
 
   let reorder g u v =
@@ -448,7 +495,7 @@ module Make (Point:Point) = struct
               if n.rank >= best.rank then n, best.rank else acc)
             (n0, min_int) q0
         in
-        let ltle, gtge = get_new_edges g to_merge in
+        let ltle, gtge, isrootlt = get_new_edges g to_merge in
         (* Inserting the new root. *)
         let g = change_node g
             { root with ltle; gtge;
@@ -457,10 +504,18 @@ module Make (Point:Point) = struct
 
         (* Inserting shortcuts for old nodes. *)
         let g = List.fold_left (fun g n ->
-            if Index.equal n.canon root.canon then g else enter_equiv g n.canon root.canon)
+            if Index.equal n.canon root.canon then g else enter_equiv g n.canon (Some root.canon))
             g to_merge
         in
 
+        (* Remember the constraint Set < root *)
+        let g =
+          if isrootlt then
+            let rootlt = List.fold_left (fun accu n -> PSet.remove n.canon accu) g.rootlt to_merge in
+            { g with rootlt = PSet.add root.canon rootlt }
+          else g
+        in
+
         (* Updating g.n_edges *)
         let oldsz =
           List.fold_left (fun sz u -> sz+PMap.cardinal u.ltle)
@@ -508,6 +563,93 @@ module Make (Point:Point) = struct
     with
     | CycleDetected as e -> raise_notrace e
 
+  (* Find all nodes <= u. We rely on topological ordering to stop early *)
+  let next_by_topological_order g ucan cur =
+    if Int.Map.is_empty cur then None
+    else
+      let (klvl, imap) = Int.Map.min_binding cur in
+      let (ilvl, v) = Int.Map.min_binding imap in
+      let vcan = repr g v in
+      if topo_compare vcan ucan > 0 then None
+      else
+        let imap = Int.Map.remove ilvl imap in
+        let cur =
+          if Int.Map.is_empty imap then Int.Map.remove klvl cur
+          else Int.Map.set klvl imap cur
+        in
+        Some (cur, vcan)
+
+  let merge_with_root ucan g =
+    let () = if PSet.mem ucan.canon g.rootlt then raise CycleDetected in
+    let status = Status.create g in
+    let rec forward accu strict vcan =
+      if ucan == vcan then
+        if strict then raise CycleDetected (* Set < u *)
+        else true, accu
+      else if topo_compare ucan vcan < 0 then false, accu
+      else if Status.mem status vcan then Status.find status vcan, accu
+      else
+        let fold w nstrict (found, accu) =
+          let wcan = repr g w in
+          let nfound, accu = forward accu (strict || nstrict) wcan in
+          (found || nfound, accu)
+        in
+        let found, accu = PMap.fold fold vcan.ltle (false, accu) in
+        let () = Status.replace status vcan found in
+        let accu = if found then vcan :: accu else accu in
+        found, accu
+    in
+    let rec find_to_merge accu cur = match next_by_topological_order g ucan cur with
+    | None -> accu
+    | Some (cur, vcan) ->
+      let above_set = PSet.mem vcan.canon g.rootlt in
+      let found, accu = forward accu above_set vcan in
+      let () = if found && above_set then raise CycleDetected in
+      find_to_merge accu cur
+    in
+    let to_merge = find_to_merge [ucan] g.components in
+    let fold g n =
+      let g = enter_equiv g n.canon None in
+      (* Record the Set < u constraints *)
+      let foldlt u strict accu = if strict then PSet.add u accu else accu in
+      let rootlt = PMap.fold foldlt n.ltle g.rootlt in
+      { g with rootlt }
+    in
+    List.fold_left fold g to_merge
+
+  (* Basically the same code as above without the accumulator... *)
+  let is_gt_set ucan g =
+    PSet.mem ucan.canon g.rootlt ||
+    let status = Status.create g in
+    let rec forward strict vcan =
+      if ucan == vcan then
+        if strict then raise CycleDetected (* Set < u *)
+        else true
+      else if topo_compare ucan vcan < 0 then false
+      else if Status.mem status vcan then Status.find status vcan
+      else
+        let fold w nstrict found =
+          let wcan = repr g w in
+          let nfound = forward (strict || nstrict) wcan in
+          (found || nfound)
+        in
+        let found = PMap.fold fold vcan.ltle false in
+        let () = Status.replace status vcan found in
+        found
+    in
+    let rec find_to_merge cur = match next_by_topological_order g ucan cur with
+    | None -> ()
+    | Some (cur, vcan) ->
+      let above_set = PSet.mem vcan.canon g.rootlt in
+      let found = forward above_set vcan in
+      let () = if found && above_set then raise CycleDetected in
+      find_to_merge cur
+    in
+    try
+      let () = find_to_merge g.components in
+      false
+    with CycleDetected -> true
+
   let add ?(rank=0) v g =
     if Index.mem v g.table then raise AlreadyDeclared
     else
@@ -523,7 +665,8 @@ module Make (Point:Point) = struct
       }
       in
       let entries = PMap.add v (Canonical node) g.entries in
-      { entries; index = g.index - 1; n_nodes = g.n_nodes + 1; n_edges = g.n_edges; table }
+      let components = add_component 0 g.index v g.components in
+      { entries; index = g.index - 1; n_nodes = g.n_nodes + 1; n_edges = g.n_edges; table; components; rootlt = g.rootlt; }
 
   let check_declared g us =
     let check l = not (Index.mem l g.table) in
@@ -535,8 +678,19 @@ module Make (Point:Point) = struct
 
   type explanation = Point.t * (constraint_type * Point.t) list
 
-  let get_explanation strict pu pv g =
-    let v = repr_node g pv in
+  let repr_or_root_node g u =
+    try repr_or_root g (Index.find u g.table)
+    with Not_found ->
+      CErrors.anomaly (Point.anomaly_err u)
+
+  let get_explanation strict pu pv g = match repr_or_root_node g pu, repr_or_root_node g pv with
+  | (None, None) -> [(Eq, pv)]
+  | (Some _, None) -> assert false
+  | (None, Some vcan) ->
+    (* TODO: actually compute the path *)
+    let islt = strict || is_gt_set vcan g in
+    [(if islt then Lt else Le), pv]
+  | Some u, Some v ->
     let visited_strict = ref PMap.empty in
     let rec traverse strict u =
       if u == v then
@@ -566,7 +720,6 @@ module Make (Point:Point) = struct
           with Found_explanation exp -> Some exp
         end
     in
-    let u = repr_node g pu in
     if u == v then begin assert (not strict); [(Eq, pv)] end
     else match traverse strict u with Some exp -> exp | None -> assert false
 
@@ -618,6 +771,9 @@ module Make (Point:Point) = struct
       try loop (Status.create g) [u, strict] []; false
       with Found -> true
 
+  let search_path strict u v g =
+    search_path strict u v g
+
   (** Uncomment to debug the cycle detection algorithm. *)
   (*let insert_edge strict ucan vcan g =
     let check_invariants = check_invariants ~required_canonical:(fun _ -> false) in
@@ -635,11 +791,16 @@ module Make (Point:Point) = struct
 
   let check_eq g u v =
     u == v ||
-    let arcu = repr_node g u and arcv = repr_node g v in
-    arcu == arcv
+    let arcu = repr_or_root_node g u and arcv = repr_or_root_node g v in
+    Option.equal (==) arcu arcv
 
-  let check_smaller g strict u v =
-    search_path strict (repr_node g u) (repr_node g v) g
+  let check_smaller g strict u v = match repr_or_root_node g u, repr_or_root_node g v with
+  | None, None -> not strict
+  | Some _, None -> false
+  | None, Some ucan ->
+    if strict then is_gt_set ucan g else true
+  | Some ucan, Some vcan ->
+    search_path strict ucan vcan g
 
   let check_leq g u v = check_smaller g false u v
   let check_lt g u v = check_smaller g true u v
@@ -653,7 +814,12 @@ module Make (Point:Point) = struct
 
   (* enforce_eq g u v will force u=v if possible, will fail otherwise *)
 
-  let enforce_eq u v g =
+  let enforce_eq u v g = match repr_or_root_node g u, repr_or_root_node g v with
+  | None, None -> Some g
+  | Some ucan, None | None, Some ucan ->
+    begin try Some (merge_with_root ucan g)
+    with CycleDetected -> None end
+  | Some ucan, Some vcan ->
     let ucan = repr_node g u in
     let vcan = repr_node g v in
     if ucan == vcan then Some g
@@ -668,21 +834,34 @@ module Make (Point:Point) = struct
       with CycleDetected -> None
 
   (* enforce_leq g u v will force u<=v if possible, will fail otherwise *)
-  let enforce_leq u v g =
-    let ucan = repr_node g u in
-    let vcan = repr_node g v in
+  let enforce_leq u v g = match repr_or_root_node g u, repr_or_root_node g v with
+  | None, None -> Some g
+  | Some ucan, None ->
+    begin try Some (merge_with_root ucan g)
+    with CycleDetected -> None end
+  | None, Some _ -> Some g
+  | Some ucan, Some vcan ->
     try Some (insert_edge false ucan vcan g)
     with CycleDetected -> None
 
   (* enforce_lt u v will force u None
+  | Some _, None -> None
+  | None, Some u ->
+    Some { g with rootlt = PSet.add u.canon g.rootlt }
+  | Some ucan, Some vcan ->
     try Some (insert_edge true ucan vcan g)
     with CycleDetected -> None
 
-  let empty =
-    { entries = PMap.empty; index = 0; n_nodes = 0; n_edges = 0; table = Index.empty }
+  let empty = match Point.root with
+  | None ->
+    { entries = PMap.empty; index = 0; n_nodes = 0; n_edges = 0; table = Index.empty; components = Int.Map.empty; rootlt = PSet.empty }
+  | Some root ->
+    let table = Index.empty in
+    let index, table = Index.fresh root table in
+    let entries = PMap.add index Root PMap.empty in
+    { entries; index = 0; n_nodes = 1; n_edges = 0; table; components = Int.Map.empty; rootlt = PSet.empty; }
 
   (* Normalization *)
 
@@ -694,15 +873,27 @@ module Make (Point:Point) = struct
     let constraints_of u v acc =
       match v with
       | Canonical {canon=u; ltle; _} ->
-        PMap.fold (fun v strict acc->
+        let un = Index.repr u g.table in
+        let acc = PMap.fold (fun v strict acc ->
             let typ = if strict then Lt else Le in
-            let u = Index.repr u g.table in
             let v = Index.repr v g.table in
-            fold (u,typ,v) acc) ltle acc
+            fold (un, typ, v) acc) ltle acc
+        in
+        (* Add all Set <= u and Set < u constraints *)
+        begin match Point.root with
+        | None -> acc
+        | Some root ->
+          let typ = if PSet.mem u g.rootlt then Lt else Le in
+          fold (root, typ, un) acc
+        end
       | Equiv v ->
         let u = Index.repr u g.table in
         let v = Index.repr v g.table in
         UF.union u v uf; acc
+      | Root ->
+        let u = Index.repr u g.table in
+        let root = Option.get Point.root in
+        UF.union u root uf; acc
     in
     let csts = PMap.fold constraints_of g.entries accu in
     csts, UF.partition uf
@@ -715,17 +906,22 @@ module Make (Point:Point) = struct
     in
     let kept = Point.Set.fold (fun u accu -> PSet.add (Index.find u g.table) accu) kept PSet.empty in
     let rmap, csts = PSet.fold (fun u (rmap,csts) ->
-        let arcu = repr g u in
-        if PSet.mem arcu.canon kept then
-          let csts = if Index.equal u arcu.canon then csts
-            else add_cst u Eq arcu.canon csts
-          in
-          PMap.add arcu.canon arcu.canon rmap, csts
-        else
-          match PMap.find arcu.canon rmap with
-          | v -> rmap, add_cst u Eq v csts
-          | exception Not_found -> PMap.add arcu.canon u rmap, csts)
-        kept (PMap.empty, accu)
+      let canon = match repr_or_root g u with
+      | None ->
+        let root = Option.get Point.root in
+        Index.find root g.table
+      | Some arcu -> arcu.canon
+      in
+      if PSet.mem canon kept then
+        let csts = if Index.equal u canon then csts
+          else add_cst u Eq canon csts
+        in
+        PMap.add canon canon rmap, csts
+      else
+        match PMap.find canon rmap with
+        | v -> rmap, add_cst u Eq v csts
+        | exception Not_found -> PMap.add canon u rmap, csts
+      ) kept (PMap.empty, accu)
     in
     let rec add_from u csts todo = match todo with
       | [] -> csts
@@ -745,33 +941,26 @@ module Make (Point:Point) = struct
            add_from u csts todo)
     in
     PSet.fold (fun u csts ->
-        let arc = repr g u in
+      match repr_or_root g u with
+      | None ->
+        let fold v r csts = match r with
+        | Root | Equiv _ -> csts
+        | Canonical arcv ->
+          let strict = PSet.mem arcv.canon g.rootlt in
+          add_from u csts [v, strict]
+        in
+        PMap.fold fold g.entries csts
+      | Some arc ->
         PMap.fold (fun v strict csts -> add_from u csts [v,strict])
           arc.ltle csts)
       kept csts
 
+  let mem q g = Index.mem q g.table
+
   let domain g =
     let fold u _ accu = Point.Set.add (Index.repr u g.table) accu in
     PMap.fold fold g.entries Point.Set.empty
 
-  let choose p g u =
-    let exception Found of Point.t in
-    let ru = (repr_node g u).canon in
-    let ruv = Index.repr ru g.table in
-    if p ruv then Some ruv
-    else
-      try PMap.iter (fun v -> function
-          | Canonical _ -> () (* we already tried [p ru] *)
-          | Equiv v' ->
-            let rv = (repr g v').canon in
-            if rv == ru then
-              let v = Index.repr v g.table in
-              if p v then raise_notrace (Found v)
-            (* NB: we could also try [p v'] but it will come up in the
-               rest of the iteration regardless. *)
-        ) g.entries; None
-      with Found v -> Some v
-
   type node = Alias of Point.t | Node of bool Point.Map.t
   type repr = node Point.Map.t
 
@@ -783,6 +972,21 @@ module Make (Point:Point) = struct
         let ltle = PMap.fold fold n.ltle Point.Map.empty in
         Node ltle
       | Equiv u -> Alias (Index.repr u g.table)
+      | Root ->
+        let u0 = Index.repr u g.table in
+        let root = Option.get Point.root in
+        if Point.equal u0 root then
+          (* This is the canonical root *)
+          let fold u n accu = match n with
+          | Canonical _ ->
+            let strict = PSet.mem u g.rootlt in
+            Point.Map.add (Index.repr u g.table) strict accu
+          | Equiv _ | Root -> accu
+          in
+          let ltle = PMap.fold fold g.entries Point.Map.empty in
+          Node ltle
+        else
+          Alias root
       in
       Point.Map.add (Index.repr u g.table) n accu
     in
diff --git a/lib/acyclicGraph.mli b/lib/acyclicGraph.mli
index 0757ed0742e5..d3f256ff9fd2 100644
--- a/lib/acyclicGraph.mli
+++ b/lib/acyclicGraph.mli
@@ -20,6 +20,7 @@ module type Point = sig
 
   val equal : t -> t -> bool
   val compare : t -> t -> int
+  val root : t option
 
   val raw_pr : t -> Pp.t
 
@@ -78,9 +79,9 @@ module Make (Point:Point) : sig
 
   val constraints_for : kept:Point.Set.t -> t -> 'a constraint_fold -> 'a -> 'a
 
-  val domain : t -> Point.Set.t
+  val mem : Point.t -> t -> bool
 
-  val choose : (Point.t -> bool) -> t -> Point.t -> Point.t option
+  val domain : t -> Point.Set.t
 
   (** {5 High-level representation} *)
 
diff --git a/lib/cWarnings.ml b/lib/cWarnings.ml
index c17fbdeadc5b..c1b4a6e4b591 100644
--- a/lib/cWarnings.ml
+++ b/lib/cWarnings.ml
@@ -461,3 +461,6 @@ let warn_ignored_coqlib = create ~name:"boot-ignored-coqlib" ~category:CoreCateg
 
 (* loc doesn't make sense for this warning and gets in the way *)
 let warn_ignored_coqlib () = warn_ignored_coqlib ()
+
+let warn_no_memprof = create ~name:"no-memprof-limits" ~category:CoreCategories.vernacular
+    Pp.(fun () -> str "Allocation limit ignored: memprof-limits was not installed when Rocq was compiled.")
diff --git a/lib/cWarnings.mli b/lib/cWarnings.mli
index cff9cfd93d53..04566046aa91 100644
--- a/lib/cWarnings.mli
+++ b/lib/cWarnings.mli
@@ -135,3 +135,6 @@ module CoreCategories : sig
 end
 
 val warn_ignored_coqlib : unit -> unit
+
+val warn_no_memprof : ?loc:Loc.t -> unit -> unit
+(** Unconditionally print the warning, does not check if memprof is available. *)
diff --git a/lib/control.ml b/lib/control.ml
index 5321357a1c5f..8c7bb7585d21 100644
--- a/lib/control.ml
+++ b/lib/control.ml
@@ -121,3 +121,10 @@ let protect_sigalrm f x =
       Exninfo.iraise e
   with Invalid_argument _ -> (* This happens on Windows, as handling SIGALRM does not seem supported *)
     f x
+
+type kilowords = { kilowords : Int64.t } [@@unboxed]
+
+let alloc_limit n f x =
+  match Memprof_coq.limit_allocations ~limit:n.kilowords (fun () -> f x) with
+  | Ok (v,kilowords) -> Ok (v,{kilowords})
+  | Error e -> Error (snd @@ Exninfo.capture e)
diff --git a/lib/control.mli b/lib/control.mli
index 0883444a6721..134a00ad9c6f 100644
--- a/lib/control.mli
+++ b/lib/control.mli
@@ -29,6 +29,10 @@ val timeout : float -> ('a -> 'b) -> 'a -> ('b, Exninfo.info) result
     so before [n] seconds, returns [Error info] instead (where [info]
     contains the backtrace of the timeout exception). *)
 
+type kilowords = { kilowords : Int64.t } [@@unboxed]
+
+val alloc_limit : kilowords -> ('a -> 'b) -> 'a -> ('b * kilowords, Exninfo.info) result
+
 (** Set a particular timeout function; warning, this is an internal
    API and it is scheduled to go away. *)
 type timeout = { timeout : 'a 'b. float -> ('a -> 'b) -> 'a -> ('b,Exninfo.info) result }
diff --git a/lib/deprecation.ml b/lib/deprecation.ml
index 67c8b345ba47..ad1c81abc2b7 100644
--- a/lib/deprecation.ml
+++ b/lib/deprecation.ml
@@ -99,8 +99,9 @@ module Version = struct
   let v9_0 = get_generic_cat "9.0"
   let v9_1 = get_generic_cat "9.1"
   let v9_2 = get_generic_cat "9.2"
+  let v9_3 = get_generic_cat "9.3"
   (* When adding a new version here, please also add
      #[export] Set Warnings "-deprecated-since-X.Y".
-     in theories/Compat/RocqX{Y-1}.v *)
+     in theories/Corelib/Compat/RocqX{Y-1}.v *)
 
 end
diff --git a/lib/deprecation.mli b/lib/deprecation.mli
index eb55851698fa..698b30c715a1 100644
--- a/lib/deprecation.mli
+++ b/lib/deprecation.mli
@@ -39,4 +39,5 @@ module Version : sig
   val v9_0 : CWarnings.category
   val v9_1 : CWarnings.category
   val v9_2 : CWarnings.category
+  val v9_3 : CWarnings.category
 end
diff --git a/lib/dune b/lib/dune
index e86e9decb13f..bdd1529df401 100644
--- a/lib/dune
+++ b/lib/dune
@@ -9,7 +9,3 @@
   (select instr.ml from
    (!coqperf -> instr.noperf.ml)
    (coqperf -> instr.perf.ml))))
-
-(deprecated_library_name
- (old_public_name coq-core.lib)
- (new_public_name rocq-runtime.lib))
diff --git a/lib/flags.ml b/lib/flags.ml
index 2b1afa11b066..910581decb57 100644
--- a/lib/flags.ml
+++ b/lib/flags.ml
@@ -45,10 +45,6 @@ let in_ml_toplevel = ref false
 
 let in_synterp_phase = ref None
 
-(* Translate *)
-let beautify = ref false
-let beautify_file = ref false
-
 (* Silent / Verbose *)
 let quiet = ref false
 let silently f x = with_option quiet f x
diff --git a/lib/flags.mli b/lib/flags.mli
index 2752e1561746..0141a327cab7 100644
--- a/lib/flags.mli
+++ b/lib/flags.mli
@@ -42,10 +42,6 @@ val in_ml_toplevel : bool ref
 (* Used to check stages are used correctly. *)
 val in_synterp_phase : bool option ref
 
-(* Beautify command line flags, should move to printing? *)
-val beautify : bool ref
-val beautify_file : bool ref
-
 (* Rocq quiet mode. Note that normal mode is called "verbose" here,
    whereas [quiet] suppresses normal output such as goals in rocq repl *)
 val quiet : bool ref
diff --git a/lib/hopcroft.ml b/lib/hopcroft.ml
new file mode 100644
index 000000000000..bae716387df3
--- /dev/null
+++ b/lib/hopcroft.ml
@@ -0,0 +1,365 @@
+(************************************************************************)
+(*         *      The Rocq Prover / The Rocq Development Team           *)
+(*  v      *         Copyright INRIA, CNRS and contributors             *)
+(*  t
+  (** Create a partition structure of the given size *)
+
+  val length : t -> int
+  (** Number of partitions *)
+
+  val size : set -> t -> int
+  (** Number of elements of a partition *)
+
+  val partition : int -> t -> set
+  (** [partition i t] returns the index of the partition which contains [i] *)
+
+  val iter : set -> (int -> unit) -> t -> unit
+  (** Iter on elements of a partition. Don't [mark] and [split] in the loop! *)
+
+  val fold : set -> (int -> 'a -> 'a) -> t -> 'a -> 'a
+  (** Fold left to right on elements of a partition. Don't [mark] and [split] in
+      the loop! *)
+
+  val iter_all : (set -> unit) -> t -> unit
+  (** Iter on partitions. Don't [mark] and [split] in the loop! *)
+
+  val fold_all : (set -> 'a -> 'a) -> t -> 'a -> 'a
+  (** Fold left to right on partitions. Don't [mark] and [split] in the loop! *)
+
+  val mark : int -> t -> unit
+  (** Mark an element for splitting *)
+
+  val split : set -> t -> set
+  (** Performs splitting and return the set of marked elements *)
+
+  val is_marked : set -> t -> bool
+  (** Returns [true] if some element of the set is marked *)
+
+  val is_valid : set -> bool
+  (** Test whether a splitting succeeded *)
+
+  val represent : set -> int
+  (** Associate a unique number to each partition. If the partition is valid, then
+      the returned number is guaranteed to be between [0] and [len - 1] when
+      [len] is the number of partitions of the structure. *)
+end
+
+module Partition =
+struct
+
+type set = int
+
+type t = {
+  mutable partitions : int;
+  (** number of partitions *)
+  mutable first : int array;
+  (** index of the first element of a partition *)
+  mutable last : int array;
+  (** successor index of the last element of a partition *)
+  mutable marked : int array;
+  (** index of the last marked element of a partition *)
+  index : set array;
+  (** associate a partition to an element *)
+  elements : int array;
+  (** contain elements in a contiguous way w.r.t. partitions *)
+  location : int array;
+  (** keep the location of an element in [elements] *)
+}
+
+let initial_size n = max (n / 100) 7
+
+let create n = {
+  partitions = 0;
+  first = Array.make (initial_size n) 0;
+  last = Array.make (initial_size n) n;
+  marked = Array.make (initial_size n) 0;
+  index = Array.make n 0;
+  elements = Array.init n (fun i -> i);
+  location = Array.init n (fun i -> i);
+}
+
+let uget (t : int array) i = Array.get t i
+let uset (t : int array) i x = Array.set t i x
+
+let length t = succ t.partitions
+
+let size s t =
+  uget t.last s - uget t.first s
+
+let partition i t = uget t.index i
+
+let iter s f t =
+  let fst = uget t.first s in
+  let lst = uget t.last s in
+  for i = fst to lst - 1 do
+    f (uget t.elements i);
+  done
+
+let fold s f t accu =
+  let fst = uget t.first s in
+  let lst = uget t.last s in
+  let rec fold accu i =
+    if lst <= i then accu
+    else fold (f (uget t.elements i) accu) (succ i)
+  in
+  fold accu fst
+
+let iter_all f t =
+  for i = 0 to t.partitions do f i; done
+
+let fold_all f t accu =
+  let rec fold accu i =
+    if t.partitions <= i then accu
+    else fold (f i accu) (succ i)
+  in
+  fold accu 0
+
+let resize t =
+  let len = Array.length t.first in
+  if len <= t.partitions then begin
+    let nlen = 2 * len + 1 in
+    let pfirst = t.first in
+    let plast = t.last in
+    let pmarked = t.marked in
+    let nfirst = Array.make nlen 0 in
+    let nlast = Array.make nlen 0 in
+    let nmarked = Array.make nlen 0 in
+    for i = 0 to pred len do
+      uset nfirst i (uget pfirst i);
+      uset nlast i (uget plast i);
+      uset nmarked i (uget pmarked i);
+    done;
+    t.first <- nfirst;
+    t.last <- nlast;
+    t.marked <- nmarked;
+  end
+
+let split s t =
+  if uget t.marked s = uget t.last s then uset t.marked s (uget t.first s);
+  if uget t.marked s = uget t.first s then -1
+  (* Nothing to split *)
+  else begin
+    let len = succ t.partitions in
+    t.partitions <- len;
+    resize t;
+    uset t.first len (uget t.first s);
+    uset t.marked len (uget t.first s);
+    uset t.last len (uget t.marked s);
+    uset t.first s (uget t.marked s);
+    for i = uget t.first len to pred (uget t.last len) do
+      uset t.index (uget t.elements i) len;
+    done;
+    len
+  end
+
+let mark i t =
+  let set = uget t.index i in
+  let loc = uget t.location i in
+  let mark = uget t.marked set in
+  if mark <= loc then begin
+    uset t.elements loc (uget t.elements mark);
+    uset t.location (uget t.elements loc) loc;
+    uset t.elements mark i;
+    uset t.location i mark;
+    uset t.marked set (succ mark);
+  end
+
+let is_marked s t = (uget t.marked s) <> (uget t.first s)
+
+let is_valid s = 0 <= s
+
+let represent s = s
+
+end
+
+(** Hopcroft algorithm *)
+
+module type S =
+sig
+  type label
+  type state
+  type transition = {
+    src : state;
+    lbl : label;
+    dst : state;
+  }
+
+  type automaton = {
+    states : int;
+    partitions : state list list;
+    transitions : transition list;
+  }
+
+  val reduce : automaton -> state list array
+end
+
+module Make (Label : Map.OrderedType) : S
+  with type label = Label.t
+  and type state = int =
+struct
+
+type label = Label.t
+type state = int
+
+type transition = {
+  src : state;
+  lbl : label;
+  dst : state;
+}
+
+module TMap = Map.Make(Label)
+
+type automaton = {
+  states : int;
+  partitions : state list list;
+  transitions : transition list;
+}
+
+(** Partitions of states *)
+module SPartition : PartitionS = Partition
+
+(** Partitions of transitions *)
+module TPartition : PartitionS = Partition
+
+type environment = {
+  state_partition : SPartition.t;
+  splitter_partition : TPartition.t;
+  transition_source : int array;
+}
+
+(** Associate the list of transitions ending in a given state *)
+let reverse automaton =
+  let ans = Array.make automaton.states [] in
+  let add (x : int) l = (* if List.mem x l then l else *) x :: l in
+  let iter i trans =
+    let l = Array.get ans trans.dst in
+    Array.set ans trans.dst (add i l)
+  in
+  let () = List.iteri iter automaton.transitions in
+  ans
+
+let init automaton =
+  let transitions = automaton.transitions in
+  let len = List.length transitions in
+  (* Sort transitions according to their label *)
+  let env = {
+    state_partition = SPartition.create automaton.states;
+    splitter_partition = TPartition.create len;
+    transition_source = Array.make len (-1);
+  } in
+  (* Set the source of the transitions *)
+  let iteri i trans = env.transition_source.(i) <- trans.src in
+  let () = List.iteri iteri transitions in
+  (* Split splitters according to their label *)
+  let fold i accu trans = match TMap.find_opt trans.lbl accu with
+  | None -> TMap.add trans.lbl [i] accu
+  | Some l -> TMap.add trans.lbl (i :: l) accu
+  in
+  let lblmap = CList.fold_left_i fold 0 TMap.empty transitions in
+  let p = env.splitter_partition in
+  let pt = TPartition.partition 0 p in
+  let iter _ trs =
+    let iter idx = TPartition.mark idx p in
+    let () = List.iter iter trs in
+    ignore (TPartition.split pt p : TPartition.set)
+  in
+  let () = TMap.iter iter lblmap in
+  (* Push every splitter in the todo stack *)
+  let fold pt todo = pt :: todo in
+  let splitter_todo = TPartition.fold_all fold env.splitter_partition [] in
+  env, splitter_todo, automaton.partitions
+
+let split_partition s inv env todo =
+  let p = env.state_partition in
+  let r = SPartition.split s p in
+  if SPartition.is_valid r then begin
+    let r = if SPartition.size r p < SPartition.size s p then r else s in
+    let fold state accu =
+      let fold accu trans =
+        let pt = TPartition.partition trans env.splitter_partition in
+        let accu =
+          if TPartition.is_marked pt env.splitter_partition then accu
+          else pt :: accu
+        in
+        let () = TPartition.mark trans env.splitter_partition in
+        accu
+      in
+      List.fold_left fold accu inv.(state)
+    in
+    let splitter_touched = SPartition.fold r fold p [] in
+    let fold_touched todo pt =
+      let npt = TPartition.split pt env.splitter_partition in
+      if TPartition.is_valid npt then npt :: todo
+      else todo
+    in
+    List.fold_left fold_touched todo splitter_touched
+  end else
+    todo
+
+let reduce_aux automaton =
+  let env, splitter_todo, initial = init automaton in
+  let inv = reverse automaton in
+  (* Mark every state in each initial partition and split *)
+  let ps = SPartition.partition 0 env.state_partition in
+  let splitter_todo =
+    let separate todo pt =
+      let iter state () = SPartition.mark state env.state_partition in
+      let () = List.fold_right iter pt () in
+      split_partition ps inv env todo
+    in
+    List.fold_left separate splitter_todo initial
+  in
+  (* Main loop *)
+  let rec loop = function
+  | [] -> ()
+  | pt :: todo ->
+    let fold t state_touched =
+      let previous = env.transition_source.(t) in
+      let equiv = SPartition.partition previous env.state_partition in
+      let state_touched =
+        if SPartition.is_marked equiv env.state_partition then state_touched
+        else equiv :: state_touched
+      in
+      let () = SPartition.mark previous env.state_partition in
+      state_touched
+    in
+    let state_touched = TPartition.fold pt fold env.splitter_partition [] in
+    let fold_touched todo equiv = split_partition equiv inv env todo in
+    let splitter_todo = List.fold_left fold_touched todo state_touched in
+    loop splitter_todo
+  in
+  let () = loop splitter_todo in
+  (env, inv)
+
+let reduce automaton =
+  let (ans, _) = reduce_aux automaton in
+  let mapping = Array.make (SPartition.length ans.state_partition) [] in
+  let iter set =
+    let pi = SPartition.represent set in
+    let iter i =
+      let map = Array.get mapping pi in
+      Array.set mapping pi (i :: map)
+    in
+    SPartition.iter set iter ans.state_partition
+  in
+  let () = SPartition.iter_all iter ans.state_partition in
+  mapping
+
+end
diff --git a/lib/hopcroft.mli b/lib/hopcroft.mli
new file mode 100644
index 000000000000..7721acc95375
--- /dev/null
+++ b/lib/hopcroft.mli
@@ -0,0 +1,38 @@
+(************************************************************************)
+(*         *      The Rocq Prover / The Rocq Development Team           *)
+(*  v      *         Copyright INRIA, CNRS and contributors             *)
+(*  state list array
+  (** Associate the array of equivalence classes of the states of an automaton *)
+end
+
+module Make (Label : Map.OrderedType) : S with type label = Label.t and type state = int
diff --git a/lib/newProfile.ml b/lib/newProfile.ml
index a890b204826b..82279aafbea4 100644
--- a/lib/newProfile.ml
+++ b/lib/newProfile.ml
@@ -106,6 +106,7 @@ module Counters = struct
     minor_words : float;
     major_collections : int;
     minor_collections : int;
+    heap_words : int;
     instr : System.instruction_count;
   }
 
@@ -114,6 +115,7 @@ module Counters = struct
     minor_words = 0.;
     major_collections = 0;
     minor_collections = 0;
+    heap_words = 0;
     instr = Ok 0L;
   }
 
@@ -124,6 +126,7 @@ module Counters = struct
       minor_words = gc.minor_words;
       major_collections = gc.major_collections;
       minor_collections = gc.minor_collections;
+      heap_words = gc.heap_words;
       instr = Instr.read_counter();
     }
 
@@ -134,6 +137,7 @@ module Counters = struct
     minor_words = a.minor_words +. b.minor_words;
     major_collections = a.major_collections + b.major_collections;
     minor_collections = a.minor_collections + b.minor_collections;
+    heap_words = max a.heap_words b.heap_words;
     instr = System.instruction_count_add a.instr b.instr;
   }
 
@@ -142,6 +146,7 @@ module Counters = struct
     minor_words = b.minor_words -. a.minor_words;
     major_collections = b.major_collections - a.major_collections;
     minor_collections = b.minor_collections - a.minor_collections;
+    heap_words = b.heap_words;
     instr = System.instructions_between ~c_start:a.instr ~c_end:b.instr;
   }
 
@@ -154,6 +159,7 @@ module Counters = struct
        (str "minor words:" ++ spc() ++ ppw x.minor_words) ::
        (str "major collections:" ++ spc() ++ int x.major_collections) ::
        (str "minor collections:" ++ spc() ++ int x.minor_collections) ::
+       (str "max heap size:" ++ spc() ++ ppw (float_of_int x.heap_words)) ::
        match x.instr with
        | Ok count -> [str "instructions:" ++ spc() ++ str (Int64.to_string count)]
        | Error _ -> [])
@@ -169,6 +175,7 @@ module Counters = struct
     ("minor_words", ppw x.minor_words) ::
     ("major_collect", ppi x.major_collections) ::
     ("minor_collect", ppi x.minor_collections) ::
+    ("heap_words", ppi x.heap_words) ::
     instr
 
   let make_diffs ~start ~stop = format (stop - start)
diff --git a/lib/pp.ml b/lib/pp.ml
index db3200fc3ace..82575e82bc2c 100644
--- a/lib/pp.ml
+++ b/lib/pp.ml
@@ -108,7 +108,9 @@ let sized_str n s = Ppcmd_sized_string (n,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
+let comment = function
+  | [] -> Ppcmd_empty
+  | l -> Ppcmd_comment l
 
 (* derived commands *)
 let mt    () = Ppcmd_empty
@@ -146,19 +148,12 @@ let qstring s = str (CString.quote_coq_string s)
 let qs = qstring
 let quote s = h (str "\"" ++ s ++ str "\"")
 
-let rec pr_com ft s =
-  let (s1,os) =
-    try
-      let n = String.index s '\n' in
-      String.sub s 0 n, Some (String.sub s (n+1) (String.length s - n - 1))
-    with Not_found -> s,None in
-  Format.pp_print_as ft (utf8_length s1) s1;
-  match os with
-      Some s2 -> Format.pp_force_newline ft (); pr_com ft s2
-    | None -> ()
-
 let pr_com ft s =
-  pr_com ft s;
+  let lines = String.split_on_char '\n' s in
+  List.iteri (fun i line ->
+      let () = if i <> 0 then Format.pp_force_newline ft () in
+      Format.pp_print_as ft (utf8_length line) line)
+    lines;
   Format.pp_print_break ft 0 0
 
 let start_pfx = "start."
@@ -381,14 +376,16 @@ let pp_as_format ?(with_tags=false) pp =
     | Pp_hovbox i -> if i = 0 then () else fprintf fmt "<%d>" i
   in
   let close_box () = fprintf fmt "%s" "@]" in
-  let rec pprec pp =
-  match pp with
-  | Ppcmd_empty -> ()
-  | Ppcmd_string s ->
+  let pp_string s =
     if has_format_special s then begin
       fprintf fmt "%%s";
       args := s :: !args
     end else fprintf fmt "%s" s
+  in
+  let rec pprec pp =
+  match pp with
+  | Ppcmd_empty -> ()
+  | Ppcmd_string s -> pp_string s
   | Ppcmd_sized_string (n, s) ->
     fprintf fmt "@<%d>%%s" n;
     args := s :: !args
@@ -410,8 +407,18 @@ let pp_as_format ?(with_tags=false) pp =
       | _ -> fprintf fmt "%s<%d %d>" "@;" nspaces offset
     end
   | Ppcmd_force_newline -> fprintf fmt "%s" "@."
-  | Ppcmd_comment [] -> ()
-  | Ppcmd_comment _ -> failwith "not implemented pp_as_format on nonempty Ppcmd_comment"
+  | Ppcmd_comment com ->
+    let pr_com_as_format com =
+      let lines = String.split_on_char '\n' com in
+      let () =
+        List.iteri (fun i line ->
+            let () = if i <> 0 then fprintf fmt "%s" "@." in
+            pp_string line)
+          lines
+      in
+      fprintf fmt "%s" "@<0 0>;"
+    in
+    List.iter pr_com_as_format com
   in
   let () = pprec pp in
   let buf = return () in
diff --git a/lib/spawn.ml b/lib/spawn.ml
index d51e51f4bdd4..08eb0c289da0 100644
--- a/lib/spawn.ml
+++ b/lib/spawn.ml
@@ -157,7 +157,6 @@ type process = {
   cout : out_channel;
   oob_resp : in_channel option;
   oob_req  : out_channel option;
-  gchan : ML.async_chan;
   pid : int;
   mutable watch : ML.watch_id option;
   mutable alive : bool;
@@ -192,7 +191,7 @@ let spawn ?(prefer_sock=prefer_sock) ?(env=Unix.environment ())
   Unix.set_nonblock (fst main);
   let gchan = ML.async_chan_of_file_or_socket (fst main) in
   let alive, watch = true, None in
-  let p = { cin; cout; gchan; pid; oob_resp; oob_req; alive; watch } in
+  let p = { cin; cout; pid; oob_resp; oob_req; alive; watch } in
   p.watch <- Some (
     ML.add_watch ~callback:(fun cl ->
       try
diff --git a/library/dune b/library/dune
index 739f57384473..1e0fbc55c19d 100644
--- a/library/dune
+++ b/library/dune
@@ -4,7 +4,3 @@
  (public_name rocq-runtime.library)
  (wrapped false)
  (libraries kernel))
-
-(deprecated_library_name
- (old_public_name coq-core.library)
- (new_public_name rocq-runtime.library))
diff --git a/library/global.ml b/library/global.ml
index e42b2970aef4..7723bfdc70b9 100644
--- a/library/global.ml
+++ b/library/global.ml
@@ -83,7 +83,8 @@ let push_named_def d = globalize0 (Safe_typing.push_named_def d)
 let push_section_context c = globalize0 (Safe_typing.push_section_context c)
 let add_univ_constraints c = globalize0 (Safe_typing.push_context_set ~strict:true (Univ.Level.Set.empty, c))
 let push_context_set c = globalize0 (Safe_typing.push_context_set ~strict:true c)
-let push_qualities ~rigid c = globalize0 (Safe_typing.push_qualities ~rigid c)
+let new_global_sort () = globalize Safe_typing.new_global_sort
+let merge_elim_constraints csts = globalize0 (Safe_typing.merge_elim_constraints csts)
 
 let set_impredicative_set c = globalize0 (Safe_typing.set_impredicative_set c)
 let set_indices_matter b = globalize0 (Safe_typing.set_indices_matter b)
@@ -163,7 +164,6 @@ let add_module_parameter mbid mte inl =
 (** Queries on the global environment *)
 
 let universes () = Environ.universes (env())
-let qualities () = Environ.qvars (env())
 let elim_graph () = Environ.qualities (env())
 let named_context () = Environ.named_context (env())
 let named_context_val () = Environ.named_context_val (env())
@@ -249,6 +249,9 @@ let set_strategy k l =
 let set_share_reduction b =
   globalize0 (Safe_typing.set_share_reduction b)
 
+let set_unfold_dep_heuristic b =
+  globalize0 (Safe_typing.set_unfold_dep_heuristic b)
+
 let set_VM b = globalize0 (Safe_typing.set_VM b)
 let set_native_compiler b = globalize0 (Safe_typing.set_native_compiler b)
 
diff --git a/library/global.mli b/library/global.mli
index 6a5f32e80a3a..459b6fb8b061 100644
--- a/library/global.mli
+++ b/library/global.mli
@@ -22,7 +22,6 @@ val safe_env : unit -> Safe_typing.safe_environment
 val env : unit -> Environ.env
 
 val universes : unit -> UGraph.t
-val qualities : unit -> Sorts.QVar.Set.t
 val elim_graph : unit -> QGraph.t
 val named_context_val : unit -> Environ.named_context_val
 val named_context : unit -> Constr.named_context
@@ -69,7 +68,8 @@ val add_univ_constraints : Univ.UnivConstraints.t -> unit
 val push_context_set : Univ.ContextSet.t -> unit
 
 (** Extra sort qualities *)
-val push_qualities : rigid:bool -> Sorts.QContextSet.t -> unit
+val new_global_sort : unit -> Sorts.QGlobal.t
+val merge_elim_constraints : Sorts.ElimConstraints.t -> unit
 
 (** Non-interactive modules and module types *)
 
@@ -192,6 +192,8 @@ val set_strategy : Conv_oracle.evaluable -> Conv_oracle.level -> unit
 
 val set_share_reduction : bool -> unit
 
+val set_unfold_dep_heuristic : bool -> unit
+
 val set_VM : bool -> unit
 val set_native_compiler : bool -> unit
 
diff --git a/library/libnames.mli b/library/libnames.mli
index 4f135c6d71b6..ad1770029d43 100644
--- a/library/libnames.mli
+++ b/library/libnames.mli
@@ -56,7 +56,7 @@ val path_pop_n_suffixes : int -> full_path -> full_path
 val path_pop_suffix : full_path -> full_path
 
 (** The prefix of the path *)
-val dirpath : full_path -> DirPath.t [@@deprecated "Compose [dirpath_of_path] and [pop_dirpath]"]
+val dirpath : full_path -> DirPath.t [@@deprecated "(9.1) Compose [dirpath_of_path] and [pop_dirpath]"]
 val basename : full_path -> Id.t
 
 (** The full path as a [DirPath.t]. *)
diff --git a/library/nametab.ml b/library/nametab.ml
index ba3ff57fa953..b149fe692b65 100644
--- a/library/nametab.ml
+++ b/library/nametab.ml
@@ -738,9 +738,9 @@ end
 module Univs = EasyNoWarn(UnivsV)()
 
 module QualityV = struct
-  include Sorts.QGlobal
+  include Sorts.Quality
   let is_var _ = None
-  module Map = HMap.Make(Sorts.QGlobal)
+  module Map = HMap.Make(Sorts.Quality)
   let stage = Summary.Stage.Interp
   let summary_name = "sorttab"
 end
diff --git a/library/nametab.mli b/library/nametab.mli
index ced1d18c6a9d..dbe3abd9bfe8 100644
--- a/library/nametab.mli
+++ b/library/nametab.mli
@@ -176,7 +176,7 @@ module XRefs : WarnedTab
 
 module Univs : NAMETAB with type elt = Univ.UGlobal.t
 
-module Quality : NAMETAB with type elt = Sorts.QGlobal.t
+module Quality : NAMETAB with type elt = Sorts.Quality.t
 
 (** Module types, modules and open modules/modtypes/sections form three separate name spaces
     (maybe this will change someday) *)
diff --git a/library/summary.ml b/library/summary.ml
index 69dddfe77908..552ff88df335 100644
--- a/library/summary.ml
+++ b/library/summary.ml
@@ -221,4 +221,65 @@ let ref ?(stage=Stage.Interp) ?(local=false) ~name x =
     in
     r
 
+(** Observables *)
+module type OBSERVABLE =
+sig
+  type token
+  type value
+
+  val register : name:string -> ?override:bool -> value -> token
+
+  val activate : token -> unit
+  val deactivate : token -> unit
+
+  val is_active : token -> bool
+end
+
+module type OBSERVABLE_USER =
+sig
+  include OBSERVABLE
+
+  val all_active : unit -> (string * value) list
+end
+
+module MakeObservable
+    (Obs : sig
+       type value
+       val stage : Stage.t
+       val local : bool
+       val name : string
+     end) : OBSERVABLE_USER with type value = Obs.value =
+struct
+  type token = string
+  type value = Obs.value
+
+  let observers = Stdlib.ref CString.Map.empty
+  let active_observers : token list ref = ref ~stage:Obs.stage ~local:Obs.local ~name:Obs.name []
+
+  let register ~name ?(override=false) value : token =
+    if not override && CString.Map.mem name !observers then
+      CErrors.anomaly Pp.(str Obs.name ++ str " observer " ++
+                          str name ++ str " already exists")
+    else
+      observers := CString.Map.add name value !observers ;
+    name
+
+  let remove name = Util.List.remove String.equal name !active_observers
+
+  let activate name : unit =
+    assert (CString.Map.mem name !observers);
+    active_observers := name :: remove name;
+    ()
+
+  let deactivate name : unit =
+    active_observers := remove name;
+    ()
+
+  let is_active tkn = List.mem tkn !active_observers
+
+  let all_active () : (token * value) list =
+    List.map (fun k -> k, CString.Map.get k !observers) !active_observers
+end
+
+
 let dump = Dyn.dump
diff --git a/library/summary.mli b/library/summary.mli
index 3079dd5599c5..c02e4d4d1834 100644
--- a/library/summary.mli
+++ b/library/summary.mli
@@ -108,5 +108,61 @@ module Interp : sig
 
 end
 
+(** {6 Observables}
+
+    [OBSERVABLE] captures the pattern of backtrackable state that can be enabled
+    and disabled. To use it, [register] the value that you want to record and then
+    [activate] and [deactivate] the value using the returned [token].
+
+    Indirection is used to be able to handle non-marshallable values.
+*)
+module type OBSERVABLE =
+sig
+  (** The type of tokens to manipulate values. This is always marshallable. *)
+  type token
+
+  (** The value being stored. May be non-marshallable (typically a closure). *)
+  type value
+
+  (** Register a new value and get the token used to enable and disable it. *)
+  val register : name:string -> ?override:bool -> value -> token
+
+  (** Activate/deactive the value attached to the token. *)
+  val activate : token -> unit
+  val deactivate : token -> unit
+
+  (** Determine if the value for the given token is active. *)
+  val is_active : token -> bool
+end
+
+(** The implementation side of observation.
+    This should be held internally with the creator of the state.
+    Only the [OBSERVABLE] signature should be exposed.
+ *)
+module type OBSERVABLE_USER =
+sig
+  include OBSERVABLE
+
+  (** Get all of the active values *)
+  val all_active : unit -> (string * value) list
+end
+
+(** Generic implementation of [OBSERVABLE_USER]. *)
+module MakeObservable
+    (Obs : sig
+       (** An arbitrary type, does not need to be marshallable. *)
+       type value
+
+       val stage : Stage.t
+
+       (** Whether the list of active observers is process-local.
+           Unlike [ref ~local] this doesn't matter for marshalling since
+           observers apply indirection to be always marshallable. *)
+       val local : bool
+
+       (** The name of the summary. *)
+       val name : string
+     end) : OBSERVABLE_USER with type value = Obs.value
+
 (** {6 Debug} *)
 val dump : unit -> (int * string) list
diff --git a/parsing/cLexer.ml b/parsing/cLexer.ml
index f9f8d860c89e..663fa52086e5 100644
--- a/parsing/cLexer.ml
+++ b/parsing/cLexer.ml
@@ -793,6 +793,7 @@ module MakeLexer (Diff : sig val mode : bool end)
     let get () =
       (!comment_begin, Buffer.contents current_comment, !between_commands, !comments)
     let drop () = set (init ())
+    let drop_comments (o,s,b,_) = (o,s,b,[])
     let get_comments (_,_,_,c) = c
 
   end
diff --git a/parsing/cLexer.mli b/parsing/cLexer.mli
index ba3a61aa164c..ba53050fcab7 100644
--- a/parsing/cLexer.mli
+++ b/parsing/cLexer.mli
@@ -14,17 +14,17 @@
   matched whenever the keyword is followed by an identifier or a
   parenthesized text. Eg
 
-    constr:x
-    string:[....]
-    ltac:(....)
-    ltac:{....}
+    [constr:x]
+    [string:[....]]
+    [ltac:(....)]
+    [ltac:{....}]
 
   The delimiter is made of 1 or more occurrences of the same parenthesis,
   eg ((.....)) or [[[[....]]]]. The idea being that if the text happens to
   contain the closing delimiter, one can make the delimiter longer and avoid
   confusion (no escaping). Eg
 
-    string:[[ .. ']' .. ]]
+    [string:(( .. ')' .. ))]
 
 
   Nesting the delimiter is allowed, eg ((..((...))..)) is OK.
diff --git a/parsing/dune b/parsing/dune
index eba467d73945..ce6dd790937e 100644
--- a/parsing/dune
+++ b/parsing/dune
@@ -5,10 +5,6 @@
  (modules_without_implementation notation_gram)
  (libraries rocq-runtime.gramlib interp))
 
-(deprecated_library_name
- (old_public_name coq-core.parsing)
- (new_public_name rocq-runtime.parsing))
-
 (rule
  (targets g_prim.ml)
  (deps (:mlg g_prim.mlg))
diff --git a/parsing/extend.ml b/parsing/extend.ml
index 5d65538e8245..9640a18a4227 100644
--- a/parsing/extend.ml
+++ b/parsing/extend.ml
@@ -66,7 +66,7 @@ type 'custom simple_constr_prod_entry_key =
 
 type binder_target = ForBinder | ForTerm
 
-type binder_entry_kind = ETBinderOpen | ETBinderClosed of constr_prod_entry_key option * (bool * string) list
+type binder_entry_kind = ETBinderOpen | ETBinderClosed of constr_prod_entry_key option * Procq.ty_pattern list
 
 and constr_prod_entry_key =
   | ETProdIdent           (* Parsed as an ident *)
@@ -76,7 +76,7 @@ and constr_prod_entry_key =
   | ETProdOneBinder of bool (* Parsed as name, or name:type or 'pattern, possibly in closed form *)
   | ETProdConstr of Constrexpr.notation_entry * (production_level * production_position) (* Parsed as constr or custom when extending a constr or custom entry; parsed as pattern or custom pattern when extending a pattern or custom pattern entry *)
   | ETProdPattern of int  (* Parsed as pattern as a binder (as subpart of a constr) *)
-  | ETProdConstrList of Constrexpr.notation_entry * (production_level * production_position) * (bool * string) list (* Parsed as a non-empty list of constr or custom entry *)
+  | ETProdConstrList of Constrexpr.notation_entry * (production_level * production_position) * Procq.ty_pattern list (* Parsed as a non-empty list of constr or custom entry *)
   | ETProdBinderList of binder_entry_kind  (* Parsed as non-empty list of local binders *)
 
 (** {5 AST for user-provided entries} *)
diff --git a/parsing/extend.mli b/parsing/extend.mli
index 96031a037e86..6c8b81923610 100644
--- a/parsing/extend.mli
+++ b/parsing/extend.mli
@@ -52,7 +52,7 @@ type 'custom simple_constr_prod_entry_key =
 
 type binder_target = ForBinder | ForTerm
 
-type binder_entry_kind = ETBinderOpen | ETBinderClosed of constr_prod_entry_key option * (bool * string) list
+type binder_entry_kind = ETBinderOpen | ETBinderClosed of constr_prod_entry_key option * Procq.ty_pattern list
 
 and constr_prod_entry_key =
   | ETProdIdent           (* Parsed as an ident *)
@@ -62,7 +62,7 @@ and constr_prod_entry_key =
   | ETProdOneBinder of bool (* Parsed as name, or name:type or 'pattern, possibly in closed form *)
   | ETProdConstr of Constrexpr.notation_entry * (production_level * production_position) (* Parsed as constr or pattern, or a subentry of those *)
   | ETProdPattern of int  (* Parsed as pattern as a binder (as subpart of a constr) *)
-  | ETProdConstrList of Constrexpr.notation_entry * (production_level * production_position) * (bool * string) list (* Parsed as non-empty list of constr, or subentries of those *)
+  | ETProdConstrList of Constrexpr.notation_entry * (production_level * production_position) * Procq.ty_pattern list (* Parsed as non-empty list of constr, or subentries of those *)
   | ETProdBinderList of binder_entry_kind  (* Parsed as non-empty list of local binders *)
 
 (** {5 AST for user-provided entries} *)
diff --git a/parsing/g_constr.mlg b/parsing/g_constr.mlg
index 6bddc7fb58e2..a461df52e8b5 100644
--- a/parsing/g_constr.mlg
+++ b/parsing/g_constr.mlg
@@ -112,8 +112,8 @@ let force_quality ?loc = function
   | Prop -> CQConstant QProp
   | Set -> CErrors.user_err ?loc Pp.(str "Universe levels cannot be Set.")
   | Type -> CQConstant QType
-  | Anon loc -> CQualVar (CQAnon (Some loc))
-  | Global qid -> CQualVar (CQVar qid)
+  | Anon loc -> CQAnon (Some loc)
+  | Global qid -> CQVar qid
 
 (* XXX use registered ref? but currently constrexpr doesn't have a node for registered refs
    and we can't do [Rocqlib.lib_ref] at parsing time, it's only available in the interp phase. *)
@@ -122,7 +122,7 @@ let sigref loc = Libnames.qualid_of_string ~loc "Corelib.Init.Specif.sig"
 }
 
 GRAMMAR EXTEND Gram
-  GLOBAL: binder_constr lconstr constr term
+  GLOBAL: lconstr constr term
   universe_name sort sort_quality_or_set sort_quality_var
   global constr_pattern cpattern Constr.ident
   closed_binder open_binders binder binders binders_fixannot
@@ -168,7 +168,7 @@ GRAMMAR EXTEND Gram
     [ [ "Prop" -> { CQConstant Sorts.Quality.QProp }
       | "SProp" -> { CQConstant Sorts.Quality.QSProp }
       | "Type" -> { CQConstant Sorts.Quality.QType }
-      | v = reference -> { CQualVar (CQVar v) } ] ]
+      | v = reference -> { CQVar v } ] ]
   ;
   universe_increment:
     [ [ "+"; n = natural -> { n }
@@ -215,7 +215,40 @@ GRAMMAR EXTEND Gram
         { let { CAst.loc = locid; v = id } = lid in
           let args = List.map (fun x -> CAst.make @@ CRef (qualid_of_ident ?loc:x.CAst.loc x.CAst.v, None), None) args in
           CAst.make ~loc @@ CApp(CAst.make ?loc:locid @@ CPatVar id,args) }
-      | c = binder_constr -> { c } ]
+      | "forall"; bl = open_binders; ","; c = term LEVEL "200" ->
+        { mkProdCN ~loc bl c }
+      | "fun"; bl = open_binders; "=>"; c = term LEVEL "200" ->
+        { mkLambdaCN ~loc bl c }
+      | "let"; id=name; bl = binders; ty = let_type_cstr; ":=";
+        c1 = term LEVEL "200"; "in"; c2 = term LEVEL "200" ->
+        { let ty,c1 = match ty, c1 with
+          | (_,None), { CAst.v = CCast(c, Some DEFAULTcast, t) } -> (Loc.tag ?loc:(constr_loc t) @@ Some t), c (* Tolerance, see G_vernac.def_body *)
+          | _, _ -> ty, c1 in
+          CAst.make ~loc @@ CLetIn(id,mkLambdaCN ?loc:(constr_loc c1) bl c1,
+                 Option.map (mkProdCN ?loc:(fst ty) bl) (snd ty), c2) }
+      | "let"; "fix"; fx = fix_decl; "in"; c = term LEVEL "200" ->
+        { let {CAst.loc=locf;CAst.v=({CAst.loc=li;CAst.v=id} as lid,_,_,_,_,_ as dcl)} = fx in
+          let fix = CAst.make ?loc:locf @@ CFix (lid,[dcl]) in
+          CAst.make ~loc @@ CLetIn( CAst.make ?loc:li @@ Name id,fix,None,c) }
+      | "let"; "cofix"; fx = cofix_body; "in"; c = term LEVEL "200" ->
+        { let {CAst.loc=locf;CAst.v=({CAst.loc=li;CAst.v=id} as lid,_,_,_,_ as dcl)} = fx in
+          let cofix = CAst.make ?loc:locf @@ CCoFix (lid,[dcl]) in
+          CAst.make ~loc @@ CLetIn( CAst.make ?loc:li @@ Name id,cofix,None,c) }
+      | "let"; lb = ["("; l=LIST0 name SEP ","; ")" -> { l } | "()" -> { [] } ];
+        po = as_return_type; ":="; c1 = term LEVEL "200"; "in";
+        c2 = term LEVEL "200" ->
+        { CAst.make ~loc @@ CLetTuple (lb,po,c1,c2) }
+      | "let"; "'"; p = pattern LEVEL "200"; t = OPT [ "in"; t = pattern LEVEL "200" -> { t } ];
+        ":="; c1 = term LEVEL "200"; rt = OPT case_type;
+        "in"; c2 = term LEVEL "200" ->
+        { CAst.make ~loc @@
+          CCases (LetPatternStyle, rt, [c1, aliasvar p, t], [CAst.make ~loc ([[p]], c2)]) }
+      | "if"; c = term LEVEL "200"; po = as_return_type;
+        "then"; b1 = term LEVEL "200";
+        "else"; b2 = term LEVEL "200" ->
+        { CAst.make ~loc @@ CIf (c, po, b1, b2) }
+      | "fix"; c = fix_decls -> { let (id,dcls) = c in CAst.make ~loc @@ CFix (id,dcls) }
+      | "cofix"; c = cofix_decls -> { let (id,dcls) = c in CAst.make ~loc @@ CCoFix (id,dcls) } ]
     | "9"
       [ ".."; c = term LEVEL "0"; ".." ->
         { CAst.make ~loc @@ CAppExpl ((qualid_of_ident ~loc ldots_var, None),[c]) } ]
@@ -270,50 +303,6 @@ GRAMMAR EXTEND Gram
     [ [ id = global; bl = binders; ":="; c = lconstr ->
         { (id, mkLambdaCN ~loc bl c) } ] ]
   ;
-  binder_constr:
-    [ [ "forall"; bl = open_binders; ","; c = term LEVEL "200" ->
-        { mkProdCN ~loc bl c }
-      | "fun"; bl = open_binders; "=>"; c = term LEVEL "200" ->
-        { mkLambdaCN ~loc bl c }
-      | "let"; id=name; bl = binders; ty = let_type_cstr; ":=";
-        c1 = term LEVEL "200"; "in"; c2 = term LEVEL "200" ->
-        { let ty,c1 = match ty, c1 with
-          | (_,None), { CAst.v = CCast(c, Some DEFAULTcast, t) } -> (Loc.tag ?loc:(constr_loc t) @@ Some t), c (* Tolerance, see G_vernac.def_body *)
-          | _, _ -> ty, c1 in
-          CAst.make ~loc @@ CLetIn(id,mkLambdaCN ?loc:(constr_loc c1) bl c1,
-                 Option.map (mkProdCN ?loc:(fst ty) bl) (snd ty), c2) }
-      | "let"; "fix"; fx = fix_decl; "in"; c = term LEVEL "200" ->
-        { let {CAst.loc=locf;CAst.v=({CAst.loc=li;CAst.v=id} as lid,_,_,_,_,_ as dcl)} = fx in
-          let fix = CAst.make ?loc:locf @@ CFix (lid,[dcl]) in
-          CAst.make ~loc @@ CLetIn( CAst.make ?loc:li @@ Name id,fix,None,c) }
-      | "let"; "cofix"; fx = cofix_body; "in"; c = term LEVEL "200" ->
-        { let {CAst.loc=locf;CAst.v=({CAst.loc=li;CAst.v=id} as lid,_,_,_,_ as dcl)} = fx in
-          let cofix = CAst.make ?loc:locf @@ CCoFix (lid,[dcl]) in
-          CAst.make ~loc @@ CLetIn( CAst.make ?loc:li @@ Name id,cofix,None,c) }
-      | "let"; lb = ["("; l=LIST0 name SEP ","; ")" -> { l } | "()" -> { [] } ];
-        po = as_return_type; ":="; c1 = term LEVEL "200"; "in";
-        c2 = term LEVEL "200" ->
-        { CAst.make ~loc @@ CLetTuple (lb,po,c1,c2) }
-      | "let"; "'"; p = pattern LEVEL "200"; ":="; c1 = term LEVEL "200";
-        "in"; c2 = term LEVEL "200" ->
-        { CAst.make ~loc @@
-          CCases (LetPatternStyle, None,    [c1, None, None],       [CAst.make ~loc ([[p]], c2)]) }
-      | "let"; "'"; p = pattern LEVEL "200"; ":="; c1 = term LEVEL "200";
-        rt = case_type; "in"; c2 = term LEVEL "200" ->
-        { CAst.make ~loc @@
-          CCases (LetPatternStyle, Some rt, [c1, aliasvar p, None], [CAst.make ~loc ([[p]], c2)]) }
-      | "let"; "'"; p = pattern LEVEL "200"; "in"; t = pattern LEVEL "200";
-        ":="; c1 = term LEVEL "200"; rt = case_type;
-        "in"; c2 = term LEVEL "200" ->
-        { CAst.make ~loc @@
-          CCases (LetPatternStyle, Some rt, [c1, aliasvar p, Some t], [CAst.make ~loc ([[p]], c2)]) }
-      | "if"; c = term LEVEL "200"; po = as_return_type;
-        "then"; b1 = term LEVEL "200";
-        "else"; b2 = term LEVEL "200" ->
-        { CAst.make ~loc @@ CIf (c, po, b1, b2) }
-      | "fix"; c = fix_decls -> { let (id,dcls) = c in CAst.make ~loc @@ CFix (id,dcls) }
-      | "cofix"; c = cofix_decls -> { let (id,dcls) = c in CAst.make ~loc @@ CCoFix (id,dcls) } ] ]
-  ;
   arg:
     [ [ test_lpar_id_coloneq; "("; id = identref; ":="; c = lconstr; ")" -> { (c,Some (CAst.make ?loc:id.CAst.loc @@ ExplByName id.CAst.v)) }
       | test_lpar_nat_coloneq; "("; n = natural; ":="; c = lconstr; ")" -> { (c,Some (CAst.make ~loc @@ ExplByPos n)) }
@@ -377,7 +366,7 @@ GRAMMAR EXTEND Gram
   ;
   term_match:
     [ [ "match"; ci = LIST1 case_item SEP ","; ty = OPT case_type; "with";
-        br = branches; "end" -> { CAst.make ~loc @@ CCases(RegularStyle,ty,ci,br) } ] ]
+        br = branches; "end" -> { CAst.make ~loc @@ CCases(MatchStyle,ty,ci,br) } ] ]
   ;
   case_item:
     [ [ c = term LEVEL "100";
@@ -516,7 +505,9 @@ GRAMMAR EXTEND Gram
         { List.map (fun (n, b, t) -> CLocalAssum ([n], None, Generalized (MaxImplicit, b), t)) tc }
       | "`["; tc = LIST1 typeclass_constraint SEP "," ; "]" ->
         { List.map (fun (n, b, t) -> CLocalAssum ([n], None, Generalized (NonMaxImplicit, b), t)) tc }
-      | "'"; p = pattern LEVEL "0" -> { [CLocalPattern p] } ] ]
+      | "'"; p = pattern LEVEL "0" -> { [CLocalPattern p] }
+      | "&"; c = term LEVEL "99" ->
+        { [CLocalAssum ([CAst.make ~loc Anonymous], None, Default Explicit, c)] } ] ]
   ;
   one_open_binder:
     [ [ na = name -> { (pat_of_name na, Explicit) }
diff --git a/parsing/notation_gram.mli b/parsing/notation_gram.mli
index b69f38fc5379..42ebf6230085 100644
--- a/parsing/notation_gram.mli
+++ b/parsing/notation_gram.mli
@@ -8,11 +8,9 @@
 (*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
-open Names
-
 type grammar_constr_prod_item =
-  | GramConstrTerminal of bool (* true = in keyword position *) * string
-  | GramConstrNonTerminal of Extend.constr_prod_entry_key * Id.t option
+  | GramConstrTerminal of Procq.ty_pattern
+  | GramConstrNonTerminal of Extend.constr_prod_entry_key
   | GramConstrListMark of int * bool * int
     (* tells action rule to make a list of the n previous parsed items;
        concat with last parsed list when true; additionally release
@@ -22,6 +20,7 @@ type grammar_constr_prod_item =
 
 type one_notation_grammar = {
   notgram_level : Notationextern.level;
+  notgram_needs_hack : bool;
   notgram_assoc : Gramlib.Gramext.g_assoc option;
   notgram_notation : Constrexpr.notation;
   notgram_prods : grammar_constr_prod_item list list;
diff --git a/parsing/procq.ml b/parsing/procq.ml
index 8cd3a4ff576f..7242d8a8be35 100644
--- a/parsing/procq.ml
+++ b/parsing/procq.ml
@@ -103,24 +103,22 @@ let make_entry_unsync make remake () =
 
 let add_kw = { add_kw = CLexer.add_keyword_tok }
 
-let no_add_kw = { add_kw = fun () _ -> () }
-
 let epsilon_value (type s tr a) f (e : (s, tr, a) Symbol.t) =
   let r = Production.make (Rule.next Rule.stop e) (fun x _ -> f x) in
   let { GState.estate; kwstate; recover; has_non_assoc } = gstate() in
   let estate, entry = Entry.make "epsilon" estate in
   let ext = Fresh (Gramlib.Gramext.First, [None, None, [r]]) in
-  let estate, kwstate = safe_extend add_kw estate kwstate entry ext in
+  let estate = safe_extend estate entry ext in
+  let kwstate = add_extend_kws add_kw kwstate ext in
   let strm = Stream.empty () in
   let strm = Parsable.make strm in
   try Some (Entry.parse entry strm {estate;kwstate;recover;has_non_assoc}) with e when CErrors.noncritical e -> None
 
 let extend_gstate ~ignore_kw {GState.kwstate; estate; recover; has_non_assoc} e ext =
-  let estate, kwstate =
-    if ignore_kw then
-      let estate, () = safe_extend no_add_kw estate () e ext in
-      estate, kwstate
-    else safe_extend add_kw estate kwstate e ext
+  let estate = safe_extend estate e ext in
+  let kwstate =
+    if ignore_kw then kwstate
+    else add_extend_kws add_kw kwstate ext
   in
   {GState.kwstate; estate; recover; has_non_assoc}
 
@@ -191,7 +189,8 @@ module Entry = struct
       (fun estate e -> Unsafe.existing_of_parser estate e p)
       ()
   let parse_token_stream e strm = parse_token_stream e strm (gstate())
-  let print fmt e = let gstate = gstate() in print fmt e gstate.estate gstate.kwstate
+  let print ~flatten fmt e = let gstate = gstate() in
+    print ~flatten fmt e gstate.estate gstate.kwstate
   let is_empty e = is_empty e (gstate()).estate
   let accumulate_in e = accumulate_in e (gstate()).estate
   let all_in () = all_in () (gstate()).estate
@@ -276,7 +275,8 @@ let eoi_entry en =
    (use eoi_entry) *)
 
 let parse_string f ?loc x =
-  let strm = Stream.of_string x in
+  let offset = loc |> Option.map (fun loc -> loc.Loc.bp) in
+  let strm = Stream.of_string ?offset x in
   Entry.parse f (Parsable.make ?loc strm)
 
 module GrammarObj =
@@ -346,7 +346,6 @@ module Constr =
     let term = Entry.make "term"
     let constr_eoi = eoi_entry constr
     let lconstr = Entry.make "lconstr"
-    let binder_constr = Entry.make "binder_constr"
     let ident = Entry.make "ident"
     let global = Entry.make "global"
     let universe_name = Entry.make "universe_name"
diff --git a/parsing/procq.mli b/parsing/procq.mli
index 914dd95ce5c3..6de4d6739fe0 100644
--- a/parsing/procq.mli
+++ b/parsing/procq.mli
@@ -82,11 +82,9 @@ end
         |
         | translated to a parsing production by Metasyntax.make_production
         V
-      [GramConstrNonTerminal (ETConstr (NextLevel,(BorderProd Left,LeftA)),
-                              Some "x");
+      [GramConstrNonTerminal (ETConstr (NextLevel,(BorderProd Left,LeftA)));
        GramConstrTerminal ("","+");
-       GramConstrNonTerminal (ETConstr (NextLevel,(BorderProd Right,LeftA)),
-                              Some "y")]
+       GramConstrNonTerminal (ETConstr (NextLevel,(BorderProd Right,LeftA)))]
        : grammar_constr_prod_item list
         |
         | Egrammar.make_constr_prod_item
@@ -175,7 +173,6 @@ module Constr :
     val constr : constr_expr Entry.t
     val constr_eoi : constr_expr Entry.t
     val lconstr : constr_expr Entry.t
-    val binder_constr : constr_expr Entry.t
     val term : constr_expr Entry.t
     val ident : Id.t Entry.t
     val global : qualid Entry.t
diff --git a/parsing/tok.ml b/parsing/tok.ml
index bac0e3b7c6b7..3b9004d4b10d 100644
--- a/parsing/tok.ml
+++ b/parsing/tok.ml
@@ -63,6 +63,34 @@ let equal_p (type a b) (t1 : a p) (t2 : b p) : (a, b) Util.eq option =
   | PEOI, PEOI -> Some Util.Refl
   | _ -> None
 
+let compare_p (type a b) (t1 : a p) (t2 : b p) : int =
+  match t1, t2 with
+  | PIDENT None, PIDENT None -> 0
+  | PIDENT None, _ -> -1
+  | _, PIDENT None -> 1
+  | (PIDENT (Some s1) | PKEYWORD s1), (PIDENT (Some s2) | PKEYWORD s2) -> String.compare s1 s2
+  | (PIDENT (Some _) | PKEYWORD _), _ -> -1
+  | _, (PIDENT (Some _) | PKEYWORD _) -> 1
+  | PFIELD s1, PFIELD s2 -> Option.compare String.compare s1 s2
+  | PFIELD _, _ -> -1
+  | _, PFIELD _ -> 1
+  | PNUMBER n1, PNUMBER n2 -> Option.compare NumTok.Unsigned.compare n1 n2
+  | PNUMBER _, _ -> -1
+  | _, PNUMBER _ -> 1
+  | PSTRING s1, PSTRING s2 -> Option.compare String.compare s1 s2
+  | PSTRING _, _ -> -1
+  | _, PSTRING _ -> 1
+  | PLEFTQMARK, PLEFTQMARK -> 0
+  | PLEFTQMARK, _ -> -1
+  | _, PLEFTQMARK -> 1
+  | PBULLET s1, PBULLET s2 -> Option.compare String.compare s1 s2
+  | PBULLET _, _ -> -1
+  | _, PBULLET _ -> 1
+  | PQUOTATION s1, PQUOTATION s2 -> String.compare s1 s2
+  | PQUOTATION _, _ -> -1
+  | _, PQUOTATION _ -> 1
+  | PEOI, PEOI -> 0
+
 let token_text : type c. c p -> string = function
   | PKEYWORD t -> "'" ^ t ^ "'"
   | PIDENT None -> "identifier"
diff --git a/parsing/tok.mli b/parsing/tok.mli
index ef62bb8876f3..522e346ba461 100644
--- a/parsing/tok.mli
+++ b/parsing/tok.mli
@@ -34,8 +34,12 @@ type t =
   | QUOTATION of string * string
   | EOI
 
+(** [PIDENT (Some s)] and [PKEYWORD s] are equal *)
 val equal_p : 'a p -> 'b p -> ('a, 'b) Util.eq option
 
+(** Returns 0 iff equal_p returns Some *)
+val compare_p : 'a p -> 'b p -> int
+
 (* pass true for diff_mode *)
 val extract_string : bool -> t -> string
 
diff --git a/perf/dune b/perf/dune
index 561ee7eda48e..3b1a6b303a87 100644
--- a/perf/dune
+++ b/perf/dune
@@ -12,7 +12,3 @@
    (= %{system} "linux_eabihf")
    (= %{system} "linux_elf")
    (= %{system} "elf"))))
-
-(deprecated_library_name
- (old_public_name coq-core.perf)
- (new_public_name rocq-runtime.perf))
diff --git a/plugins/btauto/dune b/plugins/btauto/dune
index 76fa2d7b2d7b..88cf5fabbba0 100644
--- a/plugins/btauto/dune
+++ b/plugins/btauto/dune
@@ -4,10 +4,6 @@
  (synopsis "Rocq's btauto plugin")
  (libraries rocq-runtime.plugins.ltac))
 
-(deprecated_library_name
- (old_public_name coq-core.plugins.btauto)
- (new_public_name rocq-runtime.plugins.btauto))
-
 (rule
  (targets g_btauto.ml)
  (deps (:mlg g_btauto.mlg))
diff --git a/plugins/btauto/refl_btauto.ml b/plugins/btauto/refl_btauto.ml
index 7a1bb77ee2fb..2f8bbde022bf 100644
--- a/plugins/btauto/refl_btauto.ml
+++ b/plugins/btauto/refl_btauto.ml
@@ -10,12 +10,13 @@
 
 open Constr
 
-let bt_lib_constr n = lazy (UnivGen.constr_of_monomorphic_global (Global.env ()) @@ Rocqlib.lib_ref n)
+let bt_lib_constr n () = UnivGen.constr_of_monomorphic_global (Global.env ()) @@ Rocqlib.lib_ref n
+let bt_force f = f ()
 
 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  = Constr.mkApp (Lazy.force c, v)
+let lapp c v  = Constr.mkApp (c(), v)
 
 let (===) = Constr.equal
 
@@ -39,7 +40,7 @@ module RocqPositive = struct
 
   (* A Rocq nat from an int *)
   let rec of_int n =
-    if n <= 1 then Lazy.force _xH
+    if n <= 1 then _xH()
     else
       let ans = of_int (n / 2) in
       if n mod 2 = 0 then lapp _xO [|ans|]
@@ -49,7 +50,7 @@ end
 
 module Env = struct
 
-  module ConstrHashtbl = Hashtbl.Make (Constr)
+  module ConstrHashtbl = Hashtbl.Make (Termops.ConstrData)
 
   type t = (int ConstrHashtbl.t * int ref)
 
@@ -75,7 +76,7 @@ end
 
 module Bool = struct
 
-  let ind    = lazy (Globnames.destIndRef (Rocqlib.lib_ref "core.bool.type"))
+  let ind () = Globnames.destIndRef (Rocqlib.lib_ref "core.bool.type")
   let typ    = bt_lib_constr "core.bool.type"
   let trueb  = bt_lib_constr "core.bool.true"
   let falseb = bt_lib_constr "core.bool.false"
@@ -94,12 +95,12 @@ module Bool = struct
   | Ifb of t * t * t
 
   let quote (env : Env.t) genv sigma (c : Constr.t) : t =
-    let trueb = Lazy.force trueb in
-    let falseb = Lazy.force falseb in
-    let andb = Lazy.force andb in
-    let orb = Lazy.force orb in
-    let xorb = Lazy.force xorb in
-    let negb = Lazy.force negb in
+    let trueb = bt_force trueb in
+    let falseb = bt_force falseb in
+    let andb = bt_force andb in
+    let orb = bt_force orb in
+    let xorb = bt_force xorb in
+    let negb = bt_force negb in
 
     let rec aux c = match decomp_term sigma c with
     | App (head, args) ->
@@ -115,7 +116,7 @@ module Bool = struct
     | Case (info, _, _, _, _, arg, pats) ->
       let is_bool =
         let i = info.ci_ind in
-        Environ.QInd.equal genv i (Lazy.force ind)
+        Environ.QInd.equal genv i (bt_force ind)
       in
       if is_bool then
         Ifb ((aux arg), (aux (snd pats.(0))), (aux (snd pats.(1))))
@@ -151,8 +152,8 @@ module Btauto = struct
 
   let rec convert = function
   | Bool.Var n -> lapp f_var [|RocqPositive.of_int n|]
-  | Bool.Const true -> Lazy.force f_top
-  | Bool.Const false -> Lazy.force f_btm
+  | Bool.Const true -> bt_force f_top
+  | Bool.Const false -> bt_force f_btm
   | Bool.Andb (b1, b2) -> lapp f_cnj [|convert b1; convert b2|]
   | Bool.Orb (b1, b2) -> lapp f_dsj [|convert b1; convert b2|]
   | Bool.Negb b -> lapp f_neg [|convert b|]
@@ -160,7 +161,7 @@ module Btauto = struct
   | Bool.Ifb (b1, b2, b3) -> lapp f_ifb [|convert b1; convert b2; convert b3|]
 
   let convert_env env : Constr.t =
-    RocqList.of_list (Lazy.force Bool.typ) env
+    RocqList.of_list (bt_force Bool.typ) env
 
   let reify env t = lapp eval [|convert_env env; convert t|]
 
@@ -173,11 +174,11 @@ module Btauto = struct
     let var = EConstr.Unsafe.to_constr var in
     let rec to_list l = match decomp_term sigma l with
       | App (c, _)
-        when c === (Lazy.force RocqList._nil) -> []
+        when c === (bt_force RocqList._nil) -> []
       | App (c, [|_; h; t|])
-        when c === (Lazy.force RocqList._cons) ->
-        if h === (Lazy.force Bool.trueb) then (true :: to_list t)
-        else if h === (Lazy.force Bool.falseb) then (false :: to_list t)
+        when c === (bt_force RocqList._cons) ->
+        if h === (bt_force Bool.trueb) then (true :: to_list t)
+        else if h === (bt_force Bool.falseb) then (false :: to_list t)
         else invalid_arg "to_list"
       | _ -> invalid_arg "to_list"
     in
@@ -214,7 +215,7 @@ module Btauto = struct
   let try_unification env =
     Proofview.Goal.enter begin fun gl ->
       let concl = Proofview.Goal.concl gl in
-      let eq = Lazy.force eq in
+      let eq = bt_force eq in
       let concl = EConstr.Unsafe.to_constr concl in
       let t = decomp_term (Proofview.Goal.sigma gl) concl in
       match t with
@@ -233,8 +234,8 @@ module Btauto = struct
       let concl = EConstr.Unsafe.to_constr concl in
       let genv = Proofview.Goal.env gl in
       let sigma = Proofview.Goal.sigma gl in
-      let eq = Lazy.force eq in
-      let bool = Lazy.force Bool.typ in
+      let eq = bt_force eq in
+      let bool = bt_force Bool.typ in
       let t = decomp_term sigma concl in
       match t with
       | App (c, [|typ; tl; tr|])
@@ -249,7 +250,7 @@ module Btauto = struct
           let changed_gl = EConstr.of_constr changed_gl in
           Tacticals.tclTHENLIST [
             Tactics.change_concl changed_gl;
-            Tactics.apply (EConstr.of_constr (Lazy.force soundness));
+            Tactics.apply (EConstr.of_constr (bt_force soundness));
             Tactics.normalise_vm_in_concl;
             try_unification env
           ]
diff --git a/plugins/cc/ccalgo.ml b/plugins/cc/ccalgo.ml
index c6f223563de4..37187f2f930f 100644
--- a/plugins/cc/ccalgo.ml
+++ b/plugins/cc/ccalgo.ml
@@ -238,7 +238,7 @@ struct
     | Sort (Type _u) -> mkSort (type1)
     | _ -> Constr.map drop_univ c
 
-  let mkSymb s = make (Symb (s, Constr.hash (drop_univ s)))
+  let mkSymb s = make (Symb (s, Termops.ConstrData.hash (drop_univ s)))
 
   let mkProduct (s1, s2) = make (Product (s1, s2))
 
@@ -341,7 +341,7 @@ type node =
 module Constrhash = Hashtbl.Make
   (struct type t = constr
           let equal = eq_constr_nounivs
-          let hash = Constr.hash
+          let hash = Termops.ConstrData.hash (* XXX no guarantee that hash is compatible with equal *)
    end)
 module Typehash = Constrhash
 
@@ -895,7 +895,7 @@ let new_state_var typ state =
   let ids = Environ.ids_of_named_context_val (Environ.named_context_val state.env) in
   let id = Namegen.next_ident_away __eps__ ids in
   let r = EConstr.ERelevance.relevant in (* TODO relevance *)
-  state.env<- EConstr.push_named (Context.Named.Declaration.LocalAssum (make_annot id r,typ)) state.env;
+  state.env<- EConstr.push_named ProofVar (Context.Named.Declaration.LocalAssum (make_annot id r,typ)) state.env;
   id
 
 let complete_one_class state i=
diff --git a/plugins/cc/ccprojectability.ml b/plugins/cc/ccprojectability.ml
index 654f0fd892ee..a0889a68648c 100644
--- a/plugins/cc/ccprojectability.ml
+++ b/plugins/cc/ccprojectability.ml
@@ -218,7 +218,7 @@ let make_selector_match_indices env sigma ~pos ~special c (ind_fam, ind_args) re
   let brl =
     List.map build_branch(CList.interval 1 (Array.length mip.mind_consnames)) in
   let rci = ERelevance.relevant in (* TODO relevance *)
-  let ci = make_case_info env ind RegularStyle in
+  let ci = make_case_info env ind MatchStyle in
   make_case_or_project env sigma indt ci (p, rci) c (Array.of_list brl)
 
 (*builds a projection in the dependently typed case where a term_composition was found for the fields type*)
diff --git a/plugins/cc/cctac.ml b/plugins/cc/cctac.ml
index 2e173ac6cf71..8f0b536910be 100644
--- a/plugins/cc/cctac.ml
+++ b/plugins/cc/cctac.ml
@@ -28,14 +28,14 @@ open Proofview.Notations
 module RelDecl = Context.Rel.Declaration
 module NamedDecl = Context.Named.Declaration
 
-let _f_equal    = lazy (Rocqlib.lib_ref "core.eq.congr")
-let _eq_rect    = lazy (Rocqlib.lib_ref "core.eq.rect")
-let _refl_equal = lazy (Rocqlib.lib_ref "core.eq.refl")
-let _sym_eq     = lazy (Rocqlib.lib_ref "core.eq.sym")
-let _trans_eq   = lazy (Rocqlib.lib_ref "core.eq.trans")
-let _eq         = lazy (Rocqlib.lib_ref "core.eq.type")
-let _False      = lazy (Rocqlib.lib_ref "core.False.type")
-let _not        = lazy (Rocqlib.lib_ref "core.not.type")
+let rocq_f_equal    () = Rocqlib.lib_ref "core.eq.congr"
+let rocq_eq_rect    () = Rocqlib.lib_ref "core.eq.rect"
+let rocq_refl_equal () = Rocqlib.lib_ref "core.eq.refl"
+let rocq_sym_eq     () = Rocqlib.lib_ref "core.eq.sym"
+let rocq_trans_eq   () = Rocqlib.lib_ref "core.eq.trans"
+let rocq_eq         () = Rocqlib.lib_ref "core.eq.type"
+let rocq_False      () = Rocqlib.lib_ref "core.False.type"
+let rocq_not        () = Rocqlib.lib_ref "core.not.type"
 
 let whd env sigma t =
   Reductionops.clos_whd_flags RedFlags.betaiotazeta env sigma t
@@ -104,7 +104,7 @@ let atom_of_constr b env sigma term =
   let kot = EConstr.kind sigma wh in
     match kot with
       App (f,args)->
-        if isRefX env sigma (Lazy.force _eq) f && Int.equal (Array.length args) 3
+        if isRefX env sigma (rocq_eq()) f && Int.equal (Array.length args) 3
           then `Eq (args.(0),
                    decompose_term env sigma args.(1),
                    decompose_term env sigma args.(2))
@@ -150,7 +150,7 @@ let rec has_open_head = function
 let patterns_of_constr b env sigma nrels term =
   let f,args=
     try destApp sigma ((if b then whd else whd_delta) env sigma term) with DestKO -> raise Not_found in
-        if isRefX env sigma (Lazy.force _eq) f && Int.equal (Array.length args) 3
+        if isRefX env sigma (rocq_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
@@ -173,12 +173,12 @@ let patterns_of_constr b env sigma nrels term =
 let rec quantified_atom_of_constr b env sigma nrels term =
   match EConstr.kind sigma ((if b then whd else whd_delta) env sigma term) with
       Prod (id,atom,ff) ->
-        if isRefX env sigma (Lazy.force _False) ff then
+        if isRefX env sigma (rocq_False()) ff then
           let patts=patterns_of_constr b env sigma nrels atom in
               `Nrule patts
         else
           quantified_atom_of_constr b (EConstr.push_rel (RelDecl.LocalAssum (id,atom)) env) sigma (succ nrels) ff
-    | App (f,[|atom|]) when isRefX env sigma (Lazy.force _not) f ->
+    | App (f,[|atom|]) when isRefX env sigma (rocq_not()) f ->
         let patts=patterns_of_constr b env sigma nrels atom in
               `Nrule patts
     | _ ->
@@ -188,7 +188,7 @@ let rec quantified_atom_of_constr b env sigma nrels term =
 let litteral_of_constr b env sigma term =
   match EConstr.kind sigma ((if b then whd else whd_delta) env sigma term) with
     | Prod (id,atom,ff) ->
-        if isRefX env sigma (Lazy.force _False) ff then
+        if isRefX env sigma (rocq_False()) ff then
           match (atom_of_constr b env sigma atom) with
               `Eq(t,a,b) -> `Neq(t,a,b)
             | `Other(p) -> `Nother(p)
@@ -199,7 +199,7 @@ let litteral_of_constr b env sigma term =
             with Not_found ->
               `Other (decompose_term env sigma term)
           end
-    | App (f,[|atom|]) when isRefX env sigma (Lazy.force _not) f ->
+    | App (f,[|atom|]) when isRefX env sigma (rocq_not()) f ->
           begin match (atom_of_constr b env sigma atom) with
               `Eq(t,a,b) -> `Neq(t,a,b)
             | `Other(p) -> `Nother(p)
@@ -256,7 +256,7 @@ let fresh_id env id =
   Namegen.next_ident_away id (Environ.ids_of_named_context_val @@ Environ.named_context_val env)
 
 let app_global f args k =
-  Tacticals.pf_constr_of_global (Lazy.force f) >>= fun fc -> k (mkApp (fc, args))
+  Tacticals.pf_constr_of_global (f()) >>= fun fc -> k (mkApp (fc, args))
 
 let assert_before n c =
   Proofview.Goal.enter begin fun gl ->
@@ -288,7 +288,7 @@ let type_and_refresh_ env sigma c =
 let constr_of_term c = EConstr.of_constr (ATerm.constr c)
 
 let app_global_ env sigma ref args =
-  let (sigma, c) = Evd.fresh_global env sigma (Lazy.force ref) in
+  let (sigma, c) = Evd.fresh_global env sigma (ref()) in
   Typing.checked_appvect env sigma c args
 
 (* Assumes ⊢ typ : Sort, ⊢ lhs : typ and ⊢ rhs : typ
@@ -296,24 +296,24 @@ let app_global_ env sigma ref args =
 let rec proof_term env sigma (typ, lhs, rhs) p = match p.p_rule with
 | Ax c ->
   let c = EConstr.of_constr @@ constr_of_axiom c in
-  let sigma, expected = app_global_ env sigma _eq [|typ; lhs; rhs|] in
+  let sigma, expected = app_global_ env sigma rocq_eq [|typ; lhs; rhs|] in
   let sigma = Typing.check env sigma c expected in
   sigma, c
 | SymAx c ->
   let c = EConstr.of_constr @@ constr_of_axiom c in
-  let sigma, expected = app_global_ env sigma _eq [|typ; rhs; lhs|] in
+  let sigma, expected = app_global_ env sigma rocq_eq [|typ; rhs; lhs|] in
   let sigma = Typing.check env sigma c expected in
-  app_global_ env sigma _sym_eq [|typ; rhs; lhs; c|]
+  app_global_ env sigma rocq_sym_eq [|typ; rhs; lhs; c|]
 | Refl t ->
   let t = constr_of_term t in
-  app_global_ env sigma _refl_equal [|typ; t|]
+  app_global_ env sigma rocq_refl_equal [|typ; t|]
 | Trans (p1, p2) ->
   let t1 = constr_of_term p1.p_lhs in
   let t2 = constr_of_term p1.p_rhs in
   let t3 = constr_of_term p2.p_rhs in
   let sigma, p1 = proof_term env sigma (typ, t1, t2) p1 in
   let sigma, p2 = proof_term env sigma (typ, t2, t3) p2 in
-  app_global_ env sigma _trans_eq [|typ; t1; t2; t3; p1; p2|]
+  app_global_ env sigma rocq_trans_eq [|typ; t1; t2; t3; p1; p2|]
 | Congr (p1, p2) ->
   (* p1 : ⊢ f = g : forall x : A, B *)
   (* p2 : ⊢ t = u : A *)
@@ -328,20 +328,20 @@ let rec proof_term env sigma (typ, lhs, rhs) p = match p.p_rule with
   let sigma, p1 = proof_term env sigma (funty, f, g) p1 in
   let sigma, p2 = proof_term env sigma (argty, t, u) p2 in
   (* lemma1 : ⊢ f t = g t : B{t} *)
-  let sigma, lemma1 = app_global_ env sigma _f_equal [|funty; typ; appf; f; g; p1|] in
+  let sigma, lemma1 = app_global_ env sigma rocq_f_equal [|funty; typ; appf; f; g; p1|] in
   (* lemma2 : ⊢ g t = g u : B{t}, this only type-checks when B{t} ≡ B{u} *)
   let sigma, lemma2 =
-    try app_global_ env sigma _f_equal [|argty; typ; g; t; u; p2|]
+    try app_global_ env sigma rocq_f_equal [|argty; typ; g; t; u; p2|]
     with e when CErrors.noncritical e ->
       (* Fallback if ⊢ g t ≡ g u *)
       begin match Evarconv.unify_delay env sigma (mkApp (g, [|t|])) (mkApp (g, [|u|])) with
       | sigma ->
-        app_global_ env sigma _refl_equal [|typ; mkApp (g, [|t|])|]
+        app_global_ env sigma rocq_refl_equal [|typ; mkApp (g, [|t|])|]
       | exception Evarconv.UnableToUnify _ ->
         CErrors.user_err (Pp.str "I don't know how to handle dependent equality")
       end
   in
-  app_global_ env sigma _trans_eq [|typ; mkApp (f, [|t|]); mkApp (g, [|t|]); mkApp (g, [|u|]); lemma1; lemma2|]
+  app_global_ env sigma rocq_trans_eq [|typ; mkApp (f, [|t|]); mkApp (g, [|t|]); mkApp (g, [|u|]); lemma1; lemma2|]
 | Inject (prf, cstr, nargs, argind) ->
   (* prf : ⊢ ci v = ci w : Ind(args) *)
   let ti = constr_of_term prf.p_lhs in
@@ -351,7 +351,7 @@ let rec proof_term env sigma (typ, lhs, rhs) p = match p.p_rule with
   let sigma, argty = type_and_refresh_ env sigma ti in
   let sigma, proj = Ccprojectability.build_projection env sigma cstr argind typ default special argty in
   let sigma, prf = proof_term env sigma (argty, ti, tj) prf in
-  app_global_ env sigma _f_equal [|argty; typ; proj; ti; tj; prf|]
+  app_global_ env sigma rocq_f_equal [|argty; typ; proj; ti; tj; prf|]
 
 let proof_tac (typ, lhs, rhs) p : unit Proofview.tactic =
   Proofview.Goal.enter begin fun gl ->
@@ -369,7 +369,7 @@ let refute_tac c t1 t2 p =
   let hid = Tacmach.pf_get_new_id (Id.of_string "Heq") gl in
   let false_t=mkApp (c,[|mkVar hid|]) in
   let k intype =
-    let neweq= app_global _eq [|intype;tt1;tt2|] in
+    let neweq= app_global rocq_eq [|intype;tt1;tt2|] in
     Tacticals.tclTHENS (neweq (assert_before (Name hid)))
       [proof_tac (intype, tt1, tt2) p; simplest_elim false_t]
   in type_and_refresh tt1 >>= k
@@ -387,11 +387,11 @@ let convert_to_goal_tac c t1 t2 p =
   Proofview.Goal.enter begin fun gl ->
   let tt1=constr_of_term t1 and tt2=constr_of_term t2 in
   let k sort =
-    let neweq= app_global _eq [|sort;tt1;tt2|] in
+    let neweq= app_global rocq_eq [|sort;tt1;tt2|] in
     let e = Tacmach.pf_get_new_id (Id.of_string "e") gl in
     let x = Tacmach.pf_get_new_id (Id.of_string "X") gl in
     let identity=mkLambda (make_annot (Name x) ERelevance.relevant,sort,mkRel 1) in
-    let endt = app_global _eq_rect [|sort; tt1; identity; mkVar c; tt2; mkVar e|] in
+    let endt = app_global rocq_eq_rect [|sort; tt1; identity; mkVar c; tt2; mkVar e|] in
     Tacticals.tclTHENS (neweq (assert_before (Name e)))
                            [proof_tac (sort, tt1, tt2) p; endt refine_exact_check]
   in type_and_refresh tt2 >>= k
@@ -416,7 +416,7 @@ let discriminate_tac cstru p =
     let evm, intype = Typing.type_of env evm lhs in
     let evm, intype = refresh_type env evm intype in
     let hid = Tacmach.pf_get_new_id (Id.of_string "Heq") gl in
-    let neweq=app_global _eq [|intype;lhs;rhs|] in
+    let neweq=app_global rocq_eq [|intype;lhs;rhs|] in
     Tacticals.tclTHEN (Proofview.Unsafe.tclEVARS evm)
                           (Tacticals.tclTHENS (neweq (assert_before (Name hid)))
       [proof_tac (intype, lhs, rhs) p; Equality.discrHyp hid])
@@ -430,11 +430,11 @@ let cc_tactic depth additional_terms b =
     let sigma = Proofview.Goal.sigma gl in
     let concl = Proofview.Goal.concl gl in
     Rocqlib.(check_required_library logic_module_name);
-    let _ = debug_congruence (fun () -> Pp.str "Reading goal ...") in
+    let () = debug_congruence (fun () -> Pp.str "Reading goal ...") in
     let state = make_prb env sigma concl depth additional_terms b in
-    let _ = debug_congruence (fun () -> Pp.str "Problem built, solving ...") in
+    let () = debug_congruence (fun () -> Pp.str "Problem built, solving ...") in
     let sol = execute true state in
-    let _ = debug_congruence (fun () -> Pp.str "Computation completed.") in
+    let () = debug_congruence (fun () -> Pp.str "Computation completed.") in
     let uf=forest state in
     match sol with
       None -> Tacticals.tclFAIL (str (if b then "simple congruence failed" else "congruence failed"))
@@ -513,9 +513,9 @@ let negative_concl_introf =
     let concl = Proofview.Goal.concl gl in
     let nt = whd env sigma concl in
     match EConstr.kind sigma nt with
-      Prod (_,_,ff) when isRefX env sigma (Lazy.force _False) ff -> introf
-    | App (f,[|t|]) when isRefX env sigma (Lazy.force _not) f ->
-        Tacticals.pf_constr_of_global (Lazy.force _False) >>= fun ff ->
+      Prod (_,_,ff) when isRefX env sigma (rocq_False()) ff -> introf
+    | App (f,[|t|]) when isRefX env sigma (rocq_not()) f ->
+        Tacticals.pf_constr_of_global (rocq_False()) >>= fun ff ->
         Refine.refine ~typecheck:true begin fun sigma ->
           let sigma, e = Evarutil.new_evar env sigma (mk_neg_ty ff t nt) in sigma, (mkApp (mk_neg_tm ff t nt, [|e|]))
         end >>= fun _ -> intro >>= fun _ -> intro
@@ -548,7 +548,7 @@ let simple_congruence_tac depth l =
 *)
 
 let mk_eq f c1 c2 k =
-  Tacticals.pf_constr_of_global (Lazy.force f) >>= fun fc ->
+  Tacticals.pf_constr_of_global (f()) >>= fun fc ->
   Proofview.Goal.enter begin fun gl ->
     let env = Proofview.Goal.env gl in
     let sigma = Proofview.Goal.sigma gl in
@@ -566,12 +566,12 @@ let f_equal =
     let sigma = Proofview.Goal.sigma gl in
     let cut_eq c1 c2 =
         Tacticals.tclTHENS
-          (mk_eq _eq c1 c2 Tactics.cut)
-          [Proofview.tclUNIT ();Tacticals.tclTRY ((app_global _refl_equal [||]) apply)]
+          (mk_eq rocq_eq c1 c2 Tactics.cut)
+          [Proofview.tclUNIT ();Tacticals.tclTRY ((app_global rocq_refl_equal [||]) apply)]
     in
     Proofview.tclORELSE
       begin match EConstr.kind sigma concl with
-      | App (r,[|_;t;t'|]) when isRefX env sigma (Lazy.force _eq) r ->
+      | App (r,[|_;t;t'|]) when isRefX env sigma (rocq_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 =
diff --git a/plugins/cc/dune b/plugins/cc/dune
index 974e7c558adb..b3d37a540ffc 100644
--- a/plugins/cc/dune
+++ b/plugins/cc/dune
@@ -5,10 +5,6 @@
  (modules (:standard \ g_congruence))
  (libraries rocq-runtime.tactics))
 
-(deprecated_library_name
- (old_public_name coq-core.plugins.cc_core)
- (new_public_name rocq-runtime.plugins.cc_core))
-
 (library
  (name cc_plugin)
  (public_name rocq-runtime.plugins.cc)
@@ -17,10 +13,6 @@
  (flags :standard -open Cc_core_plugin)
  (libraries rocq-runtime.plugins.ltac rocq-runtime.plugins.cc_core))
 
-(deprecated_library_name
- (old_public_name coq-core.plugins.cc)
- (new_public_name rocq-runtime.plugins.cc))
-
 (rule
  (targets g_congruence.ml)
  (deps (:mlg g_congruence.mlg))
diff --git a/plugins/derive/derive.ml b/plugins/derive/derive.ml
index 7c053f83e628..a56278ad75dd 100644
--- a/plugins/derive/derive.ml
+++ b/plugins/derive/derive.ml
@@ -31,10 +31,10 @@ let rec fill_assumptions env sigma = function
         ~typeclass_candidate:false t
     in
     let decl = LocalDef (na,ev,t) in
-    let sigma, env, ctx = fill_assumptions (EConstr.push_named decl env) sigma ctx in
+    let sigma, env, ctx = fill_assumptions (EConstr.push_named ProofVar decl env) sigma ctx in
     sigma, env, decl :: ctx
   | LocalDef _ as decl :: ctx ->
-    let sigma, env, ctx = fill_assumptions (EConstr.push_named decl env) sigma ctx in
+    let sigma, env, ctx = fill_assumptions (EConstr.push_named ProofVar decl env) sigma ctx in
     sigma, env, decl :: ctx
 
 (** [start_deriving f suchthat lemma] starts a proof of [suchthat]
@@ -43,8 +43,11 @@ let rec fill_assumptions env sigma = function
     and [lemma] as the proof. *)
 let start_deriving ~atts bl suchthat name : Declare.Proof.t =
 
-  let scope, _local, poly, program_mode, user_warns, typing_flags, using, clearbody =
-    atts.scope, atts.locality, atts.poly,  atts.program, atts.user_warns, atts.typing_flags, atts.using, atts.clearbody in
+  let {
+    scope; poly; program=program_mode;
+    user_warns; typing_flags; using; clearbody;
+    } = atts
+  in
   if program_mode then CErrors.user_err (Pp.str "Program mode not supported.");
 
   let env = Global.env () in
@@ -67,7 +70,7 @@ let start_deriving ~atts bl suchthat name : Declare.Proof.t =
       | LocalDef (id, c, t) as d :: ctx ->
         TCons ( env , sigma , t , (fun sigma ef' ->
             let sigma = Evd.define (fst (EConstr.destEvar sigma ef')) c sigma in
-            aux (EConstr.push_named d env) sigma ctx)) in
+            aux (EConstr.push_named ProofVar d env) sigma ctx)) in
     aux env sigma ctx' in
   let kind = Decls.(IsDefinition Definition) in
   let info = Declare.Info.make ~poly ~kind () in
diff --git a/plugins/derive/dune b/plugins/derive/dune
index 8482dea0f071..a62785e6f7c5 100644
--- a/plugins/derive/dune
+++ b/plugins/derive/dune
@@ -4,10 +4,6 @@
  (synopsis "Rocq's derive plugin")
  (libraries rocq-runtime.vernac))
 
-(deprecated_library_name
- (old_public_name coq-core.plugins.derive)
- (new_public_name rocq-runtime.plugins.derive))
-
 (rule
  (targets g_derive.ml)
  (deps (:mlg g_derive.mlg))
diff --git a/plugins/extraction/dune b/plugins/extraction/dune
index c2bc727e9977..db1b963ec9e6 100644
--- a/plugins/extraction/dune
+++ b/plugins/extraction/dune
@@ -4,10 +4,6 @@
  (synopsis "Rocq's extraction plugin")
  (libraries rocq-runtime.vernac))
 
-(deprecated_library_name
- (old_public_name coq-core.plugins.extraction)
- (new_public_name rocq-runtime.plugins.extraction))
-
 (rule
  (targets g_extraction.ml)
  (deps (:mlg g_extraction.mlg))
diff --git a/plugins/extraction/extract_env.ml b/plugins/extraction/extract_env.ml
index 3dacb0308e6b..e1e4e59ecbc0 100644
--- a/plugins/extraction/extract_env.ml
+++ b/plugins/extraction/extract_env.ml
@@ -185,7 +185,7 @@ let factor_fix env sg l cb msb =
 
 let vm_state =
   (* VM bytecode is not needed here *)
-  let vm_handler _ _ _ () = (), None in
+  let vm_handler _ _ _ () = (), Vmemitcodes.BCuncompiled in
   ((), { Mod_typing.vm_handler })
 
 let expand_mexpr env mp me =
@@ -222,7 +222,7 @@ let env_for_mtb_with_def env mp me reso idl =
   let l = List.hd idl in
   let spot = function (l',SFBconst _) -> Id.equal l l' | _ -> false in
   let before = fst (List.split_when spot struc) in
-  Modops.add_structure mp before reso env
+  Environ.Internal.overwrite_structure mp before reso env
 
 let make_cst resolver mp l =
   Mod_subst.constant_of_delta_kn resolver (KerName.make mp l)
diff --git a/plugins/extraction/extraction.ml b/plugins/extraction/extraction.ml
index cb56c7d8bcba..697be94d02a8 100644
--- a/plugins/extraction/extraction.ml
+++ b/plugins/extraction/extraction.ml
@@ -70,11 +70,11 @@ type flag = info * scheme
 (*s [flag_of_type] transforms a type [t] into a [flag].
   Really important function. *)
 
-let info_of_quality = let open UnivGen.QualityOrSet in function
-  | Qual (QConstant QSProp | QConstant QProp) -> Logic
-  | Set | Qual (QConstant QType | QVar _) -> Info
+let info_of_quality = let open Sorts.Quality in function
+  | QConstant QSProp | QConstant QProp -> Logic
+  | QConstant QType | QVar _ | QGlobal _ -> Info
 
-let info_of_sort s = info_of_quality (UnivGen.QualityOrSet.of_sort s)
+let info_of_sort s = info_of_quality (Sorts.quality s)
 
 let rec flag_of_type env sg t : flag =
   let t = whd_all env sg t in
@@ -748,11 +748,7 @@ let rec extract_term table env sg mle mlt c args =
     | Evar _ | Meta _ -> MLaxiom "evar"
     | 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 ty = Context.Named.Declaration.get_type @@ EConstr.lookup_named v env in
        let vty = extract_type table env sg [] 0 ty [] in
        let r = { glob = GlobRef.VarRef v; inst = InfvInst.empty } in
        let extract_var mlt = put_magic (mlt,vty) (MLglob r) in
diff --git a/plugins/extraction/miniml.ml b/plugins/extraction/miniml.ml
index f33127e581b3..67fc19af0b24 100644
--- a/plugins/extraction/miniml.ml
+++ b/plugins/extraction/miniml.ml
@@ -44,10 +44,11 @@ struct
     let map q = match q with
     | Sorts.Quality.QConstant (QProp | QSProp) -> false
     | Sorts.Quality.QConstant QType -> true
+    | QGlobal _ -> true
     | Sorts.Quality.QVar qv ->
       match Sorts.QVar.repr qv with
       | Var _ -> CErrors.anomaly (Pp.str "Non-ground instance")
-      | Unif _ | Global _ -> true (* informative by default *)
+      | Unif _ | Secvar _ -> true (* informative by default *)
     in
     Array.map map qvars
 
diff --git a/plugins/firstorder/dune b/plugins/firstorder/dune
index 9da3d2ffae69..d1dab9ffcce0 100644
--- a/plugins/firstorder/dune
+++ b/plugins/firstorder/dune
@@ -5,10 +5,6 @@
  (modules (:standard \ g_ground))
  (libraries rocq-runtime.tactics))
 
-(deprecated_library_name
- (old_public_name coq-core.plugins.firstorder_core)
- (new_public_name rocq-runtime.plugins.firstorder_core))
-
 (library
  (name firstorder_plugin)
  (public_name rocq-runtime.plugins.firstorder)
@@ -17,10 +13,6 @@
  (modules g_ground)
  (libraries rocq-runtime.plugins.firstorder_core rocq-runtime.plugins.ltac))
 
-(deprecated_library_name
- (old_public_name coq-core.plugins.firstorder)
- (new_public_name rocq-runtime.plugins.firstorder))
-
 (rule
  (targets g_ground.ml)
  (deps (:mlg g_ground.mlg))
diff --git a/plugins/firstorder/formula.ml b/plugins/firstorder/formula.ml
index f952b9d10957..7ae14a531579 100644
--- a/plugins/firstorder/formula.ml
+++ b/plugins/firstorder/formula.ml
@@ -45,7 +45,7 @@ val repr : uid -> int
 end =
 struct
 
-module CM = Map.Make(Constr)
+module CM = Map.Make(Termops.ConstrData)
 
 type t = {
   max_uid : int;
diff --git a/plugins/firstorder/g_ground.mlg b/plugins/firstorder/g_ground.mlg
index 59e8a377387b..2b1694c58f9f 100644
--- a/plugins/firstorder/g_ground.mlg
+++ b/plugins/firstorder/g_ground.mlg
@@ -85,22 +85,6 @@ let gen_ground_tac ist taco ids bases =
   end
   (fun (e, info) -> Proofview.tclZERO ~info e)
 
-(* special for compatibility with Intuition
-
-let constant str = Rocqlib.get_constr str
-
-let defined_connectives=lazy
-  [[],EvalConstRef (destConst (constant "core.not.type"));
-   [],EvalConstRef (destConst (constant "core.iff.type"))]
-
-let normalize_evaluables=
-  onAllHypsAndConcl
-    (function
-         None->unfold_in_concl (Lazy.force defined_connectives)
-       | Some id->
-           unfold_in_hyp (Lazy.force defined_connectives)
-           (Tacexpr.InHypType id)) *)
-
 open Ppconstr
 open Printer
 let pr_firstorder_using_raw _ _ _ = Pptactic.pr_auto_using pr_qualid
diff --git a/plugins/firstorder/instances.ml b/plugins/firstorder/instances.ml
index f31c9e99d1f5..398a821c6691 100644
--- a/plugins/firstorder/instances.ml
+++ b/plugins/firstorder/instances.ml
@@ -24,7 +24,7 @@ open Names
 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
+        let cmp c1 c2 = Termops.ConstrData.compare (EConstr.Unsafe.to_constr c1) (EConstr.Unsafe.to_constr c2) in
         match inst1,inst2 with
             Phantom(d1),Phantom(d2)->
               (cmp d1 d2)
diff --git a/plugins/firstorder/unify.ml b/plugins/firstorder/unify.ml
index 1988e2bb5538..43dab386a18d 100644
--- a/plugins/firstorder/unify.ml
+++ b/plugins/firstorder/unify.ml
@@ -114,7 +114,7 @@ let repr i = i
 
 let compare (i1, c1) (i2, c2) =
   let c = Int.compare i1 i2 in
-  if c = 0 then Constr.compare (EConstr.Unsafe.to_constr c1) (EConstr.Unsafe.to_constr c2) else c
+  if c = 0 then Termops.ConstrData.compare (EConstr.Unsafe.to_constr c1) (EConstr.Unsafe.to_constr c2) else c
 
 let is_ground (m, _) = Int.equal m 0
 
diff --git a/plugins/funind/dune b/plugins/funind/dune
index 8a170e4a77a0..74ab8ed0c418 100644
--- a/plugins/funind/dune
+++ b/plugins/funind/dune
@@ -4,10 +4,6 @@
  (synopsis "Rocq's functional induction plugin")
  (libraries rocq-runtime.plugins.ltac rocq-runtime.plugins.extraction))
 
-(deprecated_library_name
- (old_public_name coq-core.plugins.funind)
- (new_public_name rocq-runtime.plugins.funind))
-
 (rule
  (targets g_indfun.ml)
  (deps (:mlg g_indfun.mlg))
diff --git a/plugins/funind/functional_principles_proofs.ml b/plugins/funind/functional_principles_proofs.ml
index 484462f7dc61..7238bc3eb7c3 100644
--- a/plugins/funind/functional_principles_proofs.ml
+++ b/plugins/funind/functional_principles_proofs.ml
@@ -36,7 +36,7 @@ let list_chop ?(msg = "") n l =
 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 *)
+  (*   let refl_equal_term = refl_equal() in *)
   mkApp (constructor, [|type_of_t; t|])
 
 type pte_info =
@@ -60,7 +60,7 @@ let is_trivial_eq sigma t =
   let res =
     try
       match EConstr.kind sigma t with
-      | App (f, [|_; t1; t2|]) when eq_constr sigma f (Lazy.force eq) ->
+      | App (f, [|_; t1; t2|]) when eq_constr sigma f (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
@@ -81,7 +81,7 @@ let is_incompatible_eq env sigma t =
   let res =
     try
       match EConstr.kind sigma t with
-      | App (f, [|_; t1; t2|]) when eq_constr sigma f (Lazy.force eq) ->
+      | App (f, [|_; t1; t2|]) when eq_constr sigma f (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
@@ -172,11 +172,11 @@ let change_eq env sigma hyp_id (context : rel_context) x t end_of_type =
   let f_eq, args = destApp sigma t in
   let constructor, t1, t2, t1_typ =
     try
-      if eq_constr f_eq (Lazy.force eq) then
+      if eq_constr f_eq (eq()) then
         let t1 = (args.(1), args.(0))
         and t2 = (args.(2), args.(0))
         and t1_typ = args.(0) in
-        (Lazy.force refl_equal, t1, t2, t1_typ)
+        (refl_equal(), t1, t2, t1_typ)
       else if eq_constr f_eq (jmeq ()) then
         (jmeq_refl (), (args.(1), args.(0)), (args.(3), args.(2)), args.(0))
       else nochange "not an equality"
@@ -444,8 +444,8 @@ let clean_hyp_with_heq ptes_infos eq_hyps hyp_id env sigma =
         let real_type_of_hyp = it_mkProd_or_LetIn popped_t' context in
         let hd, args = destApp sigma t_x in
         let get_args hd args =
-          if eq_constr sigma hd (Lazy.force eq) then
-            (Lazy.force refl_equal, args.(0), args.(1))
+          if eq_constr sigma hd (eq()) then
+            (refl_equal(), args.(0), args.(1))
           else (jmeq_refl (), args.(0), args.(1))
         in
         tclTHENLIST
@@ -615,7 +615,7 @@ let build_proof (interactive_proof : bool) (fnames : Constant.t list) ptes_infos
                 in
                 tclTYPEOFTHEN t (fun _ type_of_term ->
                     let term_eq =
-                      make_refl_eq (Lazy.force refl_equal) type_of_term t
+                      make_refl_eq (refl_equal()) type_of_term t
                     in
                     tclTHENLIST
                       [ Generalize.generalize (term_eq :: List.map mkVar dyn_infos.rec_hyps)
@@ -763,7 +763,6 @@ type static_fix_info =
   { idx : int
   ; name : Id.t
   ; types : types
-  ; offset : int
   ; nb_realargs : int
   ; body_with_param : constr
   ; num_in_block : int }
@@ -801,7 +800,7 @@ let generalize_non_dep hyp =
               Id.List.mem hyp hyps
               || List.exists (Termops.occur_var_in_decl env sigma hyp) keep
               || Termops.occur_var env sigma hyp hyp_typ
-              || Termops.is_section_variable (Global.env ()) hyp
+              || Termops.is_section_variable_env env hyp
               (* should be dangerous *)
             then (clear, decl :: keep)
             else (hyp :: clear, keep))
@@ -865,7 +864,7 @@ let generate_equation_lemma env evd fnames f fun_num nb_params nb_args rec_args_
     let evd, t = Typing.type_of ~refresh:true env evd f in
     (decompose_prod_n_decls evd (nb_params + nb_args) t, evd)
   in
-  let eqn = mkApp (Lazy.force eq, [|type_of_f; eq_lhs; eq_rhs|]) in
+  let eqn = mkApp (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 = Constant.label (fst (destConst evd f)) in
@@ -1082,7 +1081,6 @@ let prove_princ_for_struct (evd : Evd.evar_map ref) interactive_proof fun_num
                 { idx = idxs.(i) - fix_offset
                 ; name = Nameops.Name.get_id (fresh_id names.(i).binder_name)
                 ; types
-                ; offset = fix_offset
                 ; nb_realargs =
                     List.length (fst (decompose_lambda sigma bodies.(i)))
                     - fix_offset
@@ -1393,7 +1391,7 @@ let new_prove_with_tcc is_mes acc_inv hrec tcc_hyps eqs : unit Proofview.tactic
                    ; observe_tac "finishing using"
                        (tclCOMPLETE
                           (Eauto.eauto_with_bases ~depth:5
-                             [(fun _ sigma -> (sigma, Lazy.force refl_equal))]
+                             [(fun _ sigma -> (sigma, refl_equal()))]
                              [Hints.Hint_db.empty TransparentState.empty false]))
                    ]) ] ] ]
 
diff --git a/plugins/funind/functional_principles_types.ml b/plugins/funind/functional_principles_types.ml
index 8cc89c153d3c..138548108a0d 100644
--- a/plugins/funind/functional_principles_types.ml
+++ b/plugins/funind/functional_principles_types.ml
@@ -73,7 +73,7 @@ let compute_new_princ_type_from_rel env rel_to_fun sorts princ_type =
     List.map_i change_predicate_sort 0 princ_type_info.predicates
   in
   let env_with_params_and_predicates =
-    List.fold_right Environ.push_named new_predicates env_with_params
+    List.fold_right (Environ.push_named ProofVar) new_predicates env_with_params
   in
   let rel_as_kn =
     fst
diff --git a/plugins/funind/g_indfun.mlg b/plugins/funind/g_indfun.mlg
index ea5cf5c05494..1124d25a9d98 100644
--- a/plugins/funind/g_indfun.mlg
+++ b/plugins/funind/g_indfun.mlg
@@ -198,7 +198,7 @@ END
 let pr_fun_scheme_arg (princ_name,fun_name,s) =
   Names.Id.print princ_name.CAst.v ++ str " :=" ++ spc() ++ str "Induction for " ++
   Libnames.pr_qualid fun_name ++ spc() ++ str "Sort " ++
-  UnivGen.QualityOrSet.pr Sorts.QVar.raw_pr s
+  UnivGen.QualityOrSet.pr Sorts.Quality.raw_printer s
 
 }
 
diff --git a/plugins/funind/gen_principle.ml b/plugins/funind/gen_principle.ml
index 5d4cb68ee2d8..9806eea7b056 100644
--- a/plugins/funind/gen_principle.ml
+++ b/plugins/funind/gen_principle.ml
@@ -54,7 +54,7 @@ let build_newrecursive lnameargsardef =
         let open Context.Named.Declaration in
         let r = ERelevance.relevant in
         (* TODO relevance *)
-        ( EConstr.push_named
+        ( EConstr.push_named ProofVar
             (LocalAssum (Context.make_annot recname r, arity))
             env
         , Id.Map.add recname impl impls ))
@@ -204,7 +204,7 @@ let build_functional_principle env (sigma : Evd.evar_map) old_princ_type sorts f
   let ftac = proof_tac funs mutr_nparams in
   let uctx = Evd.ustate sigma in
   let typ = EConstr.of_constr new_principle_type in
-  let body, typ, univs, _safe, _uctx =
+  let body, typ, univs, _uctx =
     Subproof.build_by_tactic env ~uctx ~poly:PolyFlags.default ~typ ftac
   in
   (* uctx was ignored before *)
@@ -1109,8 +1109,7 @@ let prove_fun_complete funcs graphs schemes lemmas_types_infos i :
             in
             if
               infos.is_general
-              || Rtree.is_infinite Declareops.eq_recarg
-                   graph_def.Declarations.mind_recargs
+              || Inductiveops.mis_is_recursive graph_def
             then
               let eq_lemma = match infos.equation_lemma with
               | None -> CErrors.anomaly (Pp.str "Cannot find equation lemma.")
@@ -1322,7 +1321,7 @@ let make_scheme evd (fas : (Constant.t EConstr.puniverses * UnivGen.QualityOrSet
   let first_type, other_princ_types =
     match l_schemes with
     | s :: l_schemes -> (s, l_schemes)
-    | _ -> CErrors.anomaly (Pp.str "")
+    | _ -> assert false
   in
   let opaque =
     let finfos =
diff --git a/plugins/funind/glob_term_to_relation.ml b/plugins/funind/glob_term_to_relation.ml
index a9bdbb4a7891..0138c0d71c03 100644
--- a/plugins/funind/glob_term_to_relation.ml
+++ b/plugins/funind/glob_term_to_relation.ml
@@ -228,8 +228,8 @@ let mk_result ctxt value avoid =
   Some functions to deal with overlapping patterns
 **************************************************)
 
-let rocq_True_ref = lazy (Rocqlib.lib_ref "core.True.type")
-let rocq_False_ref = lazy (Rocqlib.lib_ref "core.False.type")
+let rocq_True_ref () = Rocqlib.lib_ref "core.True.type"
+let rocq_False_ref () = Rocqlib.lib_ref "core.False.type"
 
 (*
   [make_discr_match_el \[e1,...en\]] builds match e1,...,en with
@@ -254,8 +254,8 @@ let make_discr_match_brl i =
     (fun j {CAst.v = idl, patl, _} ->
       CAst.make
       @@
-      if Int.equal j i then (idl, patl, mkGRef (Lazy.force rocq_True_ref))
-      else (idl, patl, mkGRef (Lazy.force rocq_False_ref)))
+      if Int.equal j i then (idl, patl, mkGRef (rocq_True_ref()))
+      else (idl, patl, mkGRef (rocq_False_ref())))
     0
 
 (*
@@ -310,8 +310,8 @@ let raw_push_named (na, raw_value, raw_typ) env =
     let na = make_annot id ERelevance.relevant in
     (* TODO relevance *)
     match raw_value with
-    | None -> EConstr.push_named (NamedDecl.LocalAssum (na, typ)) env
-    | Some value -> EConstr.push_named (NamedDecl.LocalDef (na, value, typ)) env
+    | None -> EConstr.push_named ProofVar (NamedDecl.LocalAssum (na, typ)) env
+    | Some value -> EConstr.push_named ProofVar (NamedDecl.LocalDef (na, value, typ)) env
     )
 
 let add_pat_variables sigma pat typ env : Environ.env =
@@ -362,7 +362,7 @@ let add_pat_variables sigma pat typ env : Environ.env =
                ++ Printer.pr_lconstr_env env sigma new_t
                ++ fnl () );
              let open Context.Named.Declaration in
-             (Environ.push_named (LocalAssum (na, new_t)) env, mkVar id :: ctxt)
+             (Environ.push_named ProofVar (LocalAssum (na, new_t)) env, mkVar id :: ctxt)
            | LocalDef (({binder_name = Name id} as na), v, t) ->
              let na = {na with binder_name = id} in
              let new_t = substl ctxt t in
@@ -379,7 +379,7 @@ let add_pat_variables sigma pat typ env : Environ.env =
                ++ Printer.pr_lconstr_env env sigma new_v
                ++ fnl () );
              let open Context.Named.Declaration in
-             ( Environ.push_named (LocalDef (na, new_v, new_t)) env
+             ( Environ.push_named ProofVar (LocalDef (na, new_v, new_t)) env
              , mkVar id :: ctxt ))
          (Environ.rel_context new_env)
          ~init:(env, []))
@@ -643,7 +643,7 @@ let rec build_entry_lc env sigma funnames avoid rt :
       match n with
       | Anonymous -> env
       | Name id ->
-        EConstr.push_named
+        EConstr.push_named ProofVar
           (NamedDecl.LocalDef (make_annot id v_r, v_as_constr, v_type))
           env
     in
@@ -1151,7 +1151,7 @@ let rec rebuild_cons env nb_args relname args crossed_types depth rt =
     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 evd = Evd.from_ustate ctx in
     let type_t' = Retyping.get_type_of env evd t' in
     let new_env =
       EConstr.push_rel (LocalDef (make_annot n ERelevance.relevant, t', type_t')) env
@@ -1318,7 +1318,7 @@ let do_build_inductive evd (funconstants : pconstant list)
         let u = EConstr.EInstance.make u in
         let evd, t = Typing.type_of env evd (EConstr.mkConstU (c, u)) in
         ( evd
-        , EConstr.push_named (LocalAssum (make_annot id ERelevance.relevant, t)) env
+        , EConstr.push_named ProofVar (LocalAssum (make_annot id ERelevance.relevant, t)) env
         ))
       funnames
       (Array.of_list funconstants)
@@ -1379,7 +1379,7 @@ let do_build_inductive evd (funconstants : pconstant list)
         in
         let r = ERelevance.relevant in
         (* TODO relevance *)
-        EConstr.push_named (LocalAssum (make_annot rel_name r, rex)) env)
+        EConstr.push_named ProofVar (LocalAssum (make_annot rel_name r, rex)) env)
       env relnames rel_arities
   in
   (* and of the real constructors*)
diff --git a/plugins/funind/glob_termops.ml b/plugins/funind/glob_termops.ml
index 4b7b51537e99..623e3df74438 100644
--- a/plugins/funind/glob_termops.ml
+++ b/plugins/funind/glob_termops.ml
@@ -24,7 +24,7 @@ let mkGApp (rt, rtl) = DAst.make @@ GApp (rt, rtl)
 let mkGLambda (n, t, b) = DAst.make @@ GLambda (n, None, Explicit, t, b)
 let mkGProd (n, t, b) = DAst.make @@ GProd (n, None, Explicit, t, b)
 let mkGLetIn (n, b, t, c) = DAst.make @@ GLetIn (n, None, b, t, c)
-let mkGCases (rto, l, brl) = DAst.make @@ GCases (RegularStyle, rto, l, brl)
+let mkGCases (rto, l, brl) = DAst.make @@ GCases (MatchStyle, rto, l, brl)
 
 let mkGHole () =
   DAst.make
@@ -589,8 +589,7 @@ let resolve_and_replace_implicits exptyp env sigma rt =
       undeclared_evars_rr = false;
       unconstrained_sorts = false;
     } in
-    let hypnaming = Evarutil.VarSet.variables (Global.env ()) in
-    let genv = GlobEnv.make ~hypnaming env sigma Glob_ops.empty_lvar in
+    let genv = GlobEnv.make env sigma Glob_ops.empty_lvar in
     let pretyper = { default_pretyper with pretype_hole; pretype_type } in
     let sigma', _ = eval_pretyper pretyper ~flags:pretype_flags (Some exptyp) genv sigma rt in
     solve_remaining_evars flags env ~initial:sigma sigma'
diff --git a/plugins/funind/indfun.ml b/plugins/funind/indfun.ml
index 8e63b7745166..ea707813aee1 100644
--- a/plugins/funind/indfun.ml
+++ b/plugins/funind/indfun.ml
@@ -60,11 +60,12 @@ let functional_induction with_clean c princl pat =
                   ( str "Cannot find induction information on "
                   ++ Termops.pr_global_env env (ConstRef c') )
             in
-            match Retyping.get_sort_quality_of env sigma concl with
+            match Retyping.get_sort_quality_or_set_of env sigma concl with
             | Qual (QConstant QSProp) -> finfo.sprop_lemma
             | Qual (QConstant QProp) -> finfo.prop_lemma
             | Set -> finfo.rec_lemma
             | Qual (QConstant QType | QVar _) -> finfo.rect_lemma
+            | Qual (QGlobal _) -> CErrors.user_err Pp.(str "Cannot handle global sort.")
           in
           let sigma, princ =
             (* then we get the principle *)
@@ -78,7 +79,7 @@ let functional_induction with_clean c princl pat =
               let princ_name =
                 Elimschemes.make_elimination_ident
                   (Constant.label c')
-                  (Retyping.get_sort_quality_of env sigma concl)
+                  (Retyping.get_sort_quality_or_set_of env sigma concl)
               in
               let princ_ref =
                 match
diff --git a/plugins/funind/indfun_common.ml b/plugins/funind/indfun_common.ml
index b36b4f4290b0..ce58ee601f5f 100644
--- a/plugins/funind/indfun_common.ml
+++ b/plugins/funind/indfun_common.ml
@@ -78,8 +78,8 @@ 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 (EConstr.of_constr (rocq_constant "core.eq.type"))
-let refl_equal = lazy (EConstr.of_constr (rocq_constant "core.eq.refl"))
+let eq () = EConstr.of_constr (rocq_constant "core.eq.type")
+let refl_equal () = EConstr.of_constr (rocq_constant "core.eq.refl")
 
 let without_implicit_declarations f () =
   let old_implicit_args = Impargs.is_implicit_args ()
@@ -103,7 +103,8 @@ let full_detype_flags () =
 
 let full_extern_flags () =
   let flags = PrintingFlags.Extern.current() in
-  PrintingFlags.Extern.make_raw flags
+  let flags = PrintingFlags.Extern.make_raw flags in
+  { flags with depth = None }
 
 let extern_env_full_printing () =
   Constrextern.empty_extern_env ~flags:(full_extern_flags())
diff --git a/plugins/funind/indfun_common.mli b/plugins/funind/indfun_common.mli
index d723d9233d44..c7b764374941 100644
--- a/plugins/funind/indfun_common.mli
+++ b/plugins/funind/indfun_common.mli
@@ -30,8 +30,8 @@ val chop_rprod_n :
   -> Glob_term.glob_constr
   -> (Name.t * Glob_term.glob_constr) list * Glob_term.glob_constr
 
-val eq : EConstr.constr Lazy.t
-val refl_equal : EConstr.constr Lazy.t
+val eq : unit -> EConstr.constr
+val refl_equal : unit -> EConstr.constr
 val jmeq : unit -> EConstr.constr
 val jmeq_refl : unit -> EConstr.constr
 val make_eq : unit -> EConstr.constr
diff --git a/plugins/funind/invfun.ml b/plugins/funind/invfun.ml
index 08b2a3dc2720..0308a837a8ac 100644
--- a/plugins/funind/invfun.ml
+++ b/plugins/funind/invfun.ml
@@ -103,7 +103,7 @@ let functional_inversion kn hid fconst f_correct =
               [applist (f_correct, Array.to_list f_args @ [res; mkVar hid])]
           ; clear [hid]
           ; Simple.intro hid
-          ; Inv.inv Inv.FullInversion None (Tactypes.NamedHyp (CAst.make hid))
+          ; Inv.inv_clause Inv.FullInversion None [] (Tactypes.NamedHyp (CAst.make hid))
           ; Proofview.Goal.enter (fun gl ->
                 let new_ids =
                   List.filter
diff --git a/plugins/funind/recdef.ml b/plugins/funind/recdef.ml
index 00dcd1774d32..0d81630d88e6 100644
--- a/plugins/funind/recdef.ml
+++ b/plugins/funind/recdef.ml
@@ -131,7 +131,7 @@ let le_n = function () -> rocq_init_constant "num.nat.le_n"
 let rocq_sig_ref = function
   | () -> find_reference ["Corelib"; "Init"; "Specif"] "sig"
 
-let rocq_proj1_sig = lazy (Rocqlib.build_sigma ()).proj1
+let rocq_proj1_sig () = (Rocqlib.build_sigma ()).proj1
 
 let rocq_O = function () -> rocq_init_constant "num.nat.O"
 let rocq_S = function () -> rocq_init_constant "num.nat.S"
@@ -170,7 +170,7 @@ let (value_f : Constr.rel_context -> GlobRef.t -> Constr.t) =
   let env = Global.env () in
   let sigma = Evd.from_env env in
   let env = Environ.push_rel_context context env in
-  let proj = Globnames.destConstRef (Lazy.force rocq_proj1_sig) in
+  let proj = Globnames.destConstRef (rocq_proj1_sig()) in
   let proj_body = constant_value_in env (proj, UVars.Instance.empty) in (* Why not to keep it named? *)
   let arg = mkApp (mkRef (fterm, EInstance.empty), Context.Rel.instance mkRel 0 context) in
   let t, p = Hipattern.match_sigma env sigma (Retyping.get_type_of env sigma arg) in
@@ -276,14 +276,10 @@ let check_not_nested env sigma forbidden e =
 
 (* ['a info] contains the local information for traveling *)
 type 'a infos =
-  { nb_arg : int
-  ; (* function number of arguments *)
-    concl_tac : unit Proofview.tactic
+  { concl_tac : unit Proofview.tactic
   ; (* final tactic to finish proofs *)
     rec_arg_id : Id.t
   ; (*name of the declared recursive argument *)
-    is_mes : bool
-  ; (* type of recursion *)
     ih : Id.t
   ; (* induction hypothesis name *)
     f_id : Id.t
@@ -321,7 +317,6 @@ type ('a, 'b) journey_info_tac =
 *)
 type journey_info =
   { letiN : (Name.t * constr * types * constr, constr) journey_info_tac
-  ; lambdA : (Name.t * types * constr, constr) journey_info_tac
   ; casE :
          (   (constr infos -> unit Proofview.tactic)
           -> constr infos
@@ -709,7 +704,7 @@ let mkDestructEq not_on_hyp env sigma expr =
   let to_revert_constr = List.rev_map mkVar to_revert in
   let sigma, type_of_expr = Typing.type_of env sigma expr in
   let new_hyps =
-    mkApp (Lazy.force refl_equal, [|type_of_expr; expr|]) :: to_revert_constr
+    mkApp (refl_equal(), [|type_of_expr; expr|]) :: to_revert_constr
   in
   let tac =
     pf_typel new_hyps (fun _ ->
@@ -857,7 +852,6 @@ let terminate_app_rec (f, args) expr_info continuation_tac _ =
 let terminate_info =
   { message = "prove_terminate with term "
   ; letiN = terminate_letin
-  ; lambdA = (fun _ _ _ _ -> assert false)
   ; casE = terminate_case
   ; otherS = terminate_others
   ; apP = terminate_app
@@ -1112,7 +1106,6 @@ let equation_app_rec (f, args) expr_info continuation_tac info =
 let equation_info =
   { message = "prove_equation with term "
   ; letiN = (fun _ -> assert false)
-  ; lambdA = (fun _ _ _ _ -> assert false)
   ; casE = equation_case
   ; otherS = equation_others
   ; apP = equation_app
@@ -1277,10 +1270,8 @@ let whole_start concl_tac nb_args is_mes func input_type relation rec_arg_num :
               is_final = true
             ; (* and on leaf (more or less) *)
               f_terminate = delayed_force rocq_O
-            ; nb_arg = nb_args
             ; concl_tac
             ; rec_arg_id
-            ; is_mes
             ; ih = hrec
             ; f_id
             ; f_constr = mkVar f_id
@@ -1453,7 +1444,7 @@ let open_new_goal ~lemma build_proof sigma using_lemmas ref_ goal_name
                         (mkVar (List.nth !lid !h_num), NoBindings))
                      e_assumption
                  ; Eauto.eauto_with_bases ~depth:5
-                     [(fun _ sigma -> (sigma, Lazy.force refl_equal))]
+                     [(fun _ sigma -> (sigma, refl_equal()))]
                      [Hints.Hint_db.empty TransparentState.empty false] ]))
     in
     let lemma = build_proof env (Evd.from_env env) start_tac end_tac in
@@ -1521,7 +1512,7 @@ let com_terminate interactive_proof tcc_lemma_name tcc_lemma_ref is_mes
   in
   try
     let sigma, new_goal_type = build_new_goal_type lemma in
-    let sigma = Evd.from_ctx (Evd.ustate sigma) in
+    let sigma = Evd.from_ustate (Evd.ustate sigma) in
     open_new_goal ~lemma start_proof sigma using_lemmas tcc_lemma_ref
       (Some tcc_lemma_name) new_goal_type
   with EmptySubgoals ->
@@ -1561,7 +1552,7 @@ let com_eqn uctx nb_arg eq_name functional_ref f_ref terminate_ref
     | GlobRef.ConstRef c -> is_opaque_constant c
     | _ -> anomaly ~label:"terminate_lemma" (Pp.str "not a constant.")
   in
-  let evd = Evd.from_ctx uctx in
+  let evd = Evd.from_ustate uctx in
   let f_constr = constr_of_monomorphic_global (Global.env ()) f_ref in
   let equation_lemma_type = subst1 f_constr equation_lemma_type in
   let info = Declare.Info.make () in
@@ -1577,8 +1568,7 @@ let com_eqn uctx nb_arg eq_name functional_ref f_ref terminate_ref
          (start_equation f_ref terminate_ref (fun x ->
               prove_eq
                 (fun _ -> Proofview.tclUNIT ())
-                { nb_arg
-                ; f_terminate =
+                { f_terminate =
                     EConstr.of_constr
                       (constr_of_monomorphic_global (Global.env ()) terminate_ref)
                 ; f_constr = EConstr.of_constr f_constr
@@ -1600,7 +1590,6 @@ let com_eqn uctx nb_arg eq_name functional_ref f_ref terminate_ref
                 ; args_assoc = []
                 ; f_id = Id.of_string "______"
                 ; rec_arg_id = Id.of_string "______"
-                ; is_mes = false
                 ; ih = Id.of_string "______" }))
          lemma
   in
@@ -1641,9 +1630,8 @@ let recursive_definition ~interactive_proof ~is_mes function_name rec_impls
   let function_r = ERelevance.relevant in
   (* TODO relevance *)
   let env =
-    EConstr.push_named
-      (Context.Named.Declaration.LocalAssum
-         (make_annot function_name function_r, function_type))
+    EConstr.push_named ProofVar
+      (LocalAssum (make_annot function_name function_r, function_type))
       env
   in
   (* Pp.msgnl (str "function type := " ++ Printer.pr_lconstr function_type);  *)
@@ -1700,7 +1688,7 @@ let recursive_definition ~interactive_proof ~is_mes function_name rec_impls
   in
   let relation, evuctx = interp_constr env_with_pre_rec_args evd r in
   let () = check_relation_type env_with_pre_rec_args evd relation in
-  let evd = Evd.from_ctx evuctx in
+  let evd = Evd.from_ustate evuctx in
   let tcc_lemma_name = add_suffix function_name "_tcc" in
   let tcc_lemma_constr = ref Undefined in
   (* let _ = Pp.msgnl (fun _ _ -> str "relation := " ++ Printer.pr_lconstr_env env_with_pre_rec_args relation) in *)
diff --git a/plugins/ltac/coretactics.mlg b/plugins/ltac/coretactics.mlg
index 4b9b0b766ba4..c2438e383e34 100644
--- a/plugins/ltac/coretactics.mlg
+++ b/plugins/ltac/coretactics.mlg
@@ -335,7 +335,7 @@ let register_list_tactical name f =
     begin match Tacinterp.Value.to_list v with
     | None -> Tacticals.tclZEROMSG (Pp.str "Expected a list")
     | Some tacs ->
-      let tacs = List.map (fun tac -> Tacinterp.tactic_of_value ist tac) tacs in
+      let tacs = List.map (fun tac -> Tacinterp.tactic_of_val ist tac) tacs in
       f tacs
     end
   | _ -> assert false
diff --git a/plugins/ltac/dune b/plugins/ltac/dune
index 9effa7f6c3d4..b6d64157b9d4 100644
--- a/plugins/ltac/dune
+++ b/plugins/ltac/dune
@@ -6,10 +6,6 @@
  (modules_without_implementation tacexpr)
  (libraries rocq-runtime.vernac))
 
-(deprecated_library_name
- (old_public_name coq-core.plugins.ltac)
- (new_public_name rocq-runtime.plugins.ltac))
-
 (library
  (name tauto_plugin)
  (public_name rocq-runtime.plugins.tauto)
@@ -17,10 +13,6 @@
  (modules tauto)
  (libraries rocq-runtime.plugins.ltac))
 
-(deprecated_library_name
- (old_public_name coq-core.plugins.tauto)
- (new_public_name rocq-runtime.plugins.tauto))
-
 (rule
  (targets extratactics.ml)
  (deps (:mlg extratactics.mlg))
diff --git a/plugins/ltac/extraargs.mlg b/plugins/ltac/extraargs.mlg
index 01b22b8b24cf..cb386946c156 100644
--- a/plugins/ltac/extraargs.mlg
+++ b/plugins/ltac/extraargs.mlg
@@ -266,11 +266,15 @@ let pr_by_arg_tac env sigma _prc _prlc prtac opt_c =
     | None -> mt ()
     | Some t -> hov 2 (str "by" ++ spc () ++ prtac env sigma (Constrexpr.LevelLe 3) t)
 
+let top_pr_by_arg_tac env sigma prc prlc _prtac opt_c =
+  pr_by_arg_tac env sigma prc prlc (fun env _ _ t -> Pptactic.pr_tacvalue env t) opt_c
 }
 
 ARGUMENT EXTEND by_arg_tac
   TYPED AS tactic option
-  PRINTED BY { pr_by_arg_tac env sigma }
+  PRINTED BY { top_pr_by_arg_tac env sigma }
+  RAW_PRINTED BY { pr_by_arg_tac env sigma }
+  GLOB_PRINTED BY { pr_by_arg_tac env sigma }
 | [ "by" tactic3(c) ] -> { Some c }
 | [ ] -> { None }
 END
diff --git a/plugins/ltac/extraargs.mli b/plugins/ltac/extraargs.mli
index 91af7c80d7ab..27592b63f9a4 100644
--- a/plugins/ltac/extraargs.mli
+++ b/plugins/ltac/extraargs.mli
@@ -57,7 +57,7 @@ val by_arg_tac : Tacexpr.raw_tactic_expr option Procq.Entry.t
 val wit_by_arg_tac :
   (raw_tactic_expr option,
   glob_tactic_expr option,
-  Geninterp.Val.t option) Genarg.genarg_type
+  Tacarg.tacvalue option) Genarg.genarg_type
 
 val pr_by_arg_tac :
   Environ.env -> Evd.evar_map ->
diff --git a/plugins/ltac/extratactics.mlg b/plugins/ltac/extratactics.mlg
index b62c553dbfbe..30c7aff4d81b 100644
--- a/plugins/ltac/extratactics.mlg
+++ b/plugins/ltac/extratactics.mlg
@@ -195,7 +195,7 @@ END
 
 {
 
-let rewrite_star ist clause orient occs c (tac : Geninterp.Val.t option) =
+let rewrite_star ist clause orient occs c (tac : Tacarg.tacvalue option) =
   let tac' = Option.map (fun t -> Tacinterp.tactic_of_value ist t, FirstSolved) tac in
   Internals.with_delayed_uconstr ist c
     (fun c -> general_rewrite ~where:clause ~l2r:orient occs ?tac:tac' ~freeze:true ~dep:true ~with_evars:true (c,NoBindings))
@@ -505,6 +505,10 @@ TACTIC EXTEND is_hyp
 | [ "is_var" constr(x) ] -> { Internals.is_var x }
 END
 
+TACTIC EXTEND is_secvar
+| [ "is_section_var" constr(x) ] -> { Internals.is_section_var x }
+END
+
 TACTIC EXTEND is_fix
 | [ "is_fix" constr(x) ] -> { Internals.is_fix x }
 END
@@ -675,6 +679,28 @@ TACTIC EXTEND optimize_heap
 | [ "optimize_heap" ] -> { Internals.tclOPTIMIZE_HEAP }
 END
 
+{
+  type mem_unit = Mw | Kw
+  let pr_mem_unit _ _ _ = function
+    | Mw -> Pp.str "Mw"
+    | Kw -> Pp.str "kw"
+
+let to_kw n = function
+  | Mw -> { Control.kilowords = Int64.(mul (of_int n) 1000L) }
+  | Kw -> { Control.kilowords = Int64.of_int n }
+}
+
+ARGUMENT EXTEND memory_unit PRINTED BY { pr_mem_unit }
+| [ "Mw" ] -> { Mw }
+| [ "kw" ] -> { Kw }
+END
+
+TACTIC EXTEND alloclimit
+| [ "alloc_limit" natural(n) memory_unit(m) tactic(tac) ] -> {
+  Internals.alloc_limit ist (to_kw n m) tac
+}
+END
+
 VERNAC COMMAND EXTEND infoH CLASSIFIED AS QUERY
 | ![ proof_query ] [ "infoH" tactic(tac) ] -> { Internals.infoH tac }
 END
diff --git a/engine/ftactic.ml b/plugins/ltac/ftactic.ml
similarity index 100%
rename from engine/ftactic.ml
rename to plugins/ltac/ftactic.ml
diff --git a/engine/ftactic.mli b/plugins/ltac/ftactic.mli
similarity index 100%
rename from engine/ftactic.mli
rename to plugins/ltac/ftactic.mli
diff --git a/plugins/ltac/g_ltac.mlg b/plugins/ltac/g_ltac.mlg
index 5e205ee765bc..2267b7579996 100644
--- a/plugins/ltac/g_ltac.mlg
+++ b/plugins/ltac/g_ltac.mlg
@@ -292,8 +292,7 @@ GRAMMAR EXTEND Gram
   ;
   term: LEVEL "0"
     [ [ IDENT "ltac"; ":"; "("; tac = Pltac.ltac_expr; ")" ->
-        { let arg = Genarg.in_gen (Genarg.rawwit Tacarg.wit_ltac_in_term) tac in
-          CAst.make ~loc @@ CGenarg arg } ] ]
+        { CAst.make ~loc @@ CGenarg (Raw (Tacarg.wit_ltac_in_term, tac)) } ] ]
   ;
   END
 
@@ -424,7 +423,7 @@ VERNAC COMMAND EXTEND VernacTacticNotation
   { VtSideff ([], VtNow) } SYNTERP AS tacobj {
     let n = Option.default 0 n in
     let local = Locality.make_module_locality locality in
-    Tacentries.add_tactic_notation_syntax local n ?deprecation r
+    Tacentries.add_tactic_notation_syntax local n r
   } ->
   {
     Tacentries.add_tactic_notation ?deprecation tacobj e
diff --git a/plugins/ltac/g_rewrite.mlg b/plugins/ltac/g_rewrite.mlg
index 110caa28f4e4..22a9f51c9e6e 100644
--- a/plugins/ltac/g_rewrite.mlg
+++ b/plugins/ltac/g_rewrite.mlg
@@ -17,9 +17,9 @@ open Locus
 open Constrexpr
 open Glob_term
 open Genintern
-open Geninterp
 open Extraargs
 open Rewrite
+open RewriteStratAst
 open ComRewrite
 open Stdarg
 open Tactypes
@@ -37,7 +37,7 @@ DECLARE PLUGIN "rocq-runtime.plugins.ltac"
 
 type constr_expr_with_bindings = constr_expr with_bindings
 type glob_constr_with_bindings = glob_constr_and_expr with_bindings
-type glob_constr_with_bindings_sign = interp_sign * glob_constr_and_expr with_bindings
+type glob_constr_with_bindings_sign = Tacinterp.interp_sign * glob_constr_and_expr with_bindings
 
 let pr_glob_constr_with_bindings_sign env sigma _ _ _ (ge : glob_constr_with_bindings_sign) =
   Printer.pr_glob_constr_env env sigma (fst (fst (snd ge)))
@@ -66,19 +66,24 @@ END
 
 {
 
-let subst_strategy sub = map_strategy
+let subst_strategy sub =
+  RewriteStratAst.map_strategy
     (Tacsubst.subst_glob_constr_and_expr sub)
+    (fun (x, y, z) -> (x, Tacsubst.subst_glob_constr_and_expr sub y, z))
     (Tacsubst.subst_glob_red_expr sub)
     (fun x -> x)
+    (Tacsubst.subst_tactic sub)
 
 let pr_strategy _ _ _ (s : strategy) = Pp.str ""
-let pr_raw_strategy env sigma prc prlc _ (s : Tacexpr.raw_strategy) =
+let pr_raw_strategy env sigma prc prlc prt (s : Tacexpr.raw_strategy) =
   let prr = Pptactic.pr_red_expr env sigma (prc, prlc, Pputils.pr_or_by_notation Libnames.pr_qualid, prc,Pputils.pr_or_var Pp.int, Redexpr.pr_raw_user_red_expr) in
-  Rewrite.pr_strategy (prc env sigma) prr Pputils.pr_lident s
-let pr_glob_strategy env sigma prc prlc _ (s : Tacexpr.glob_strategy) =
+  RewriteStratAst.pr_strategy (prc env sigma) (prc env sigma) prr Pputils.pr_lident (prt env sigma Constrexpr.LevelSome) s
+let pr_glob_strategy env sigma prc prlc prt (s : Tacexpr.glob_strategy) =
   let prcst = Pputils.pr_or_var Pptactic.(pr_and_short_name (pr_evaluable_reference_env env)) in
   let prr = Pptactic.pr_red_expr env sigma (prc, prlc, prcst, prc, Pputils.pr_or_var Pp.int, Redexpr.pr_glob_user_red_expr) in
-  Rewrite.pr_strategy (prc env sigma) prr Id.print s
+  let prpat (_, c, _) = prc env sigma c in
+  let prt = prt env sigma Constrexpr.LevelSome in
+  RewriteStratAst.pr_strategy (prc env sigma) prpat prr Id.print prt s
 
 }
 
@@ -96,17 +101,12 @@ END
 GRAMMAR EXTEND Gram
   GLOBAL: rewstrategy;
   rewstrategy:
-    [ NONA
-      [ IDENT "fix"; id = identref; ":="; s = rewstrategy1 -> { StratFix (id, s) }
-      | h = ne_rewstrategy1_list_sep_semicolon -> { h } ] ]
-  ;
-  ne_rewstrategy1_list_sep_semicolon:
-    [ LEFTA
-      [ h = SELF; ";"; h' = rewstrategy1 -> { StratBinary (Compose, h, h') }
-      | h = rewstrategy1 -> { h } ] ]
-  ;
-  rewstrategy1:
-    [ RIGHTA
+    [ "2" NONA
+      [ IDENT "fix"; id = identref; ":="; s = rewstrategy LEVEL "1" -> { StratFix (id, s) }
+      | h = LIST1 rewstrategy LEVEL "1" SEP ";" -> {
+          let x, h = match h with [] -> assert false | x::h -> x, h in
+          List.fold_left (fun a b -> StratBinary (Compose, a, b)) x h } ]
+    | "1" RIGHTA
       [ "<-"; c = constr -> { StratConstr (c, false) }
       | IDENT "subterms"; h = SELF -> { StratUnary (Subterms, h) }
       | IDENT "subterm"; h = SELF -> { StratUnary (Subterm, h) }
@@ -118,16 +118,15 @@ GRAMMAR EXTEND Gram
       | IDENT "try"; h = SELF -> { StratUnary (Try, h) }
       | IDENT "any"; h = SELF -> { StratUnary (Any, h) }
       | IDENT "repeat"; h = SELF -> { StratUnary (Repeat, h) }
-      | IDENT "choice"; h = LIST1 rewstrategy0 -> { StratNAry (Choice, h) }
+      | IDENT "choice"; h = LIST1 rewstrategy LEVEL "0" -> { StratNAry (Choice, h) }
       | IDENT "old_hints"; h = preident -> { StratHints (true, h) }
       | IDENT "hints"; h = preident -> { StratHints (false, h) }
       | IDENT "terms"; h = LIST0 constr -> { StratTerms h }
       | IDENT "eval"; r = red_expr -> { StratEval r }
       | IDENT "fold"; c = constr -> { StratFold c }
-      | h = rewstrategy0 -> { h } ] ]
-  ;
-  rewstrategy0:
-    [ NONA
+      | IDENT "matches"; c = constr -> { StratMatches c }
+      | IDENT "tactic"; c = tactic -> { StratTactic c } ]
+    | "0" NONA
       [ c = constr -> { StratConstr (c, true) }
       | IDENT "id" -> { StratId }
       | IDENT "fail" -> { StratFail }
diff --git a/plugins/ltac/g_rewrite.mli b/plugins/ltac/g_rewrite.mli
index 7c01a1db23be..870bf3a3c603 100644
--- a/plugins/ltac/g_rewrite.mli
+++ b/plugins/ltac/g_rewrite.mli
@@ -15,7 +15,7 @@ type glob_constr_with_bindings =
     Genintern.glob_constr_and_expr Tactypes.with_bindings
 
 type glob_constr_with_bindings_sign =
-    Geninterp.interp_sign *
+    Tacinterp.interp_sign *
     Genintern.glob_constr_and_expr Tactypes.with_bindings
 
 val wit_glob_constr_with_bindings :
diff --git a/plugins/ltac/internals.ml b/plugins/ltac/internals.ml
index bab239eed096..53a8b4175fb1 100644
--- a/plugins/ltac/internals.ml
+++ b/plugins/ltac/internals.ml
@@ -126,6 +126,20 @@ let is_var x =
     | Var _ ->  Proofview.tclUNIT ()
     | _ -> Tacticals.tclFAIL (Pp.str "Not a variable or hypothesis")
 
+let is_section_var x =
+  (* we can enter_one because a constr argument is focusing *)
+  Proofview.Goal.enter_one ~__LOC__ begin fun gl ->
+    let env = Proofview.Goal.env gl in
+    let sigma = Proofview.Goal.sigma gl in
+    match EConstr.kind sigma x with
+    | Var id ->
+      (* check:false because we don't want to anomaly here if the user
+         sneaks in some unbound variable *)
+      if Termops.is_section_variable_env ~check:false env id then Proofview.tclUNIT ()
+      else Tacticals.tclFAIL (Pp.str "Not a section variable.")
+    | _ -> Tacticals.tclFAIL (Pp.str "Not a variable or hypothesis.")
+  end
+
 let is_fix x =
   Proofview.tclEVARMAP >>= fun sigma ->
   match EConstr.kind sigma x with
@@ -168,6 +182,14 @@ let unshelve ist t =
   Proofview.Unsafe.tclGETGOALS >>= fun ogls ->
   Proofview.Unsafe.tclSETGOALS (gls @ ogls)
 
+let alloc_limit ?loc ist n tac =
+  let tac = Tacinterp.tactic_of_value ist tac in
+  let tac = Proofview.tclALLOCLIMIT n tac in
+  if Memprof_coq.is_real_memprof then tac
+  else
+    Proofview.tclLIFT (Proofview.NonLogical.make (CWarnings.warn_no_memprof ?loc)) >>= fun () ->
+    tac
+
 (** tactic analogous to "OPTIMIZE HEAP" *)
 
 let tclOPTIMIZE_HEAP =
diff --git a/plugins/ltac/internals.mli b/plugins/ltac/internals.mli
index 0c33c7e3a89f..3d9090326c71 100644
--- a/plugins/ltac/internals.mli
+++ b/plugins/ltac/internals.mli
@@ -30,8 +30,8 @@ val with_delayed_uconstr : Tacinterp.interp_sign ->
   closed_glob_constr -> (EConstr.constr -> unit tactic) -> unit tactic
 val replace_in_clause_maybe_by : Tacinterp.interp_sign -> bool option ->
   closed_glob_constr -> EConstr.constr ->
-  Locus.clause -> Tacinterp.Value.t option -> unit tactic
-val replace_term : Geninterp.interp_sign -> bool option -> closed_glob_constr ->
+  Locus.clause -> Tacarg.tacvalue option -> unit tactic
+val replace_term : Tacinterp.interp_sign -> bool option -> closed_glob_constr ->
   Locus.clause -> unit tactic
 
 val discrHyp : Names.Id.t -> unit tactic
@@ -44,6 +44,7 @@ val refine_tac : Tacinterp.interp_sign -> simple:bool -> with_classes:bool ->
 val has_evar : EConstr.t -> unit tactic
 val is_evar : EConstr.t -> unit tactic
 val is_var : EConstr.t -> unit tactic
+val is_section_var : EConstr.t -> unit tactic
 val is_fix : EConstr.t -> unit tactic
 val is_cofix : EConstr.t -> unit tactic
 val is_ind : EConstr.t -> unit tactic
@@ -51,7 +52,7 @@ val is_constructor : EConstr.t -> unit tactic
 val is_proj : EConstr.t -> unit tactic
 val is_const : EConstr.t -> unit tactic
 
-val unshelve : Tacinterp.interp_sign -> Tacinterp.Value.t -> unit tactic
+val unshelve : Tacinterp.interp_sign -> Tacarg.tacvalue -> unit tactic
 
 val decompose : EConstr.t list -> EConstr.t -> unit tactic
 
@@ -59,7 +60,7 @@ val tclOPTIMIZE_HEAP : unit tactic
 
 val onSomeWithHoles : ('a option -> unit tactic) -> 'a Tactypes.delayed_open option -> unit tactic
 
-val exact : Geninterp.interp_sign -> Ltac_pretype.closed_glob_constr -> unit Proofview.tactic
+val exact : Tacinterp.interp_sign -> Ltac_pretype.closed_glob_constr -> unit Proofview.tactic
 
 (** {5 Commands} *)
 
@@ -67,3 +68,5 @@ val declare_equivalent_keys : Constrexpr.constr_expr -> Constrexpr.constr_expr -
 
 val infoH : pstate:Declare.Proof.t -> Tacexpr.raw_tactic_expr -> unit
 (** ProofGeneral command *)
+
+val alloc_limit : ?loc:Loc.t -> Tacinterp.interp_sign -> Control.kilowords -> Tacarg.tacvalue -> unit tactic
diff --git a/plugins/ltac/leminv.ml b/plugins/ltac/leminv.ml
index c823e999577d..11e896c380d6 100644
--- a/plugins/ltac/leminv.ml
+++ b/plugins/ltac/leminv.ml
@@ -118,11 +118,11 @@ let rec add_prods_sign env sigma t =
     | Prod (na,c1,b) ->
         let id = id_of_name_using_hdchar env sigma t na.binder_name in
         let b'= subst1 (mkVar id) b in
-        add_prods_sign (push_named (LocalAssum ({na with binder_name=id},c1)) env) sigma b'
+        add_prods_sign (push_named ProofVar (LocalAssum ({na with binder_name=id},c1)) env) sigma b'
     | LetIn (na,c1,t1,b) ->
         let id = id_of_name_using_hdchar env sigma t na.binder_name in
         let b'= subst1 (mkVar id) b in
-        add_prods_sign (push_named (LocalDef ({na with binder_name=id},c1,t1)) env) sigma b'
+        add_prods_sign (push_named ProofVar (LocalDef ({na with binder_name=id},c1,t1)) env) sigma b'
     | _ -> (env,t)
 
 (* [dep_option] indicates whether the inversion lemma is dependent or not.
@@ -156,8 +156,7 @@ let compute_first_inversion_scheme env sigma ind sort dep_option =
       let ivars = Termops.global_vars_set env sigma i in
       let revargs,ownsign =
         fold_named_context
-          (fun env d (revargs,hyps) ->
-            let d = EConstr.of_named_decl d in
+          (fun env status d (revargs,hyps) ->
              let id = NamedDecl.get_id d in
              if Id.Set.mem id ivars then
                ((mkVar id)::revargs, Context.Named.add d hyps)
@@ -170,7 +169,7 @@ let compute_first_inversion_scheme env sigma ind sort dep_option =
       (pty,goal)
   in
   let npty = nf_all env sigma pty in
-  let extenv = push_named (LocalAssum (make_annot p ERelevance.relevant,npty)) env in
+  let extenv = push_named ProofVar (LocalAssum (make_annot p ERelevance.relevant,npty)) env in
   extenv, goal
 
 (* [inversion_scheme sign I]
@@ -198,21 +197,19 @@ let inversion_scheme ~name ~poly env sigma t sort dep_option inv_op =
     user_err
     (str"Computed inversion goal was not closed in initial signature.");
   *)
-  let pf = Proof.start ~name ~poly (Evd.from_ctx (ustate sigma)) [invEnv,invGoal] in
+  let pf = Proof.start ~name ~poly (Evd.from_ustate (ustate sigma)) [invEnv,invGoal] in
   let pf, _, () = Proof.run_tactic env (tclTHEN intro (onLastHypId inv_op)) pf in
   let pfterm = List.hd (Proof.partial_proof pf) in
-  let global_named_context = Global.named_context_val () in
   let ownSign = ref begin
     fold_named_context
-      (fun env d sign ->
-        let d = EConstr.of_named_decl d in
-         if mem_named_context_val (NamedDecl.get_id d) global_named_context then sign
+      (fun env status d sign ->
+         if status = SecVar then sign
          else Context.Named.add d sign)
       invEnv ~init:Context.Named.empty
   end in
   let avoid = ref Id.Set.empty in
   let Proof.{sigma} = Proof.data pf in
-  let sigma = Evd.minimize_universes sigma in
+  let sigma = Evd.minimize_universes ~poly sigma in
   let rec fill_holes c =
     match EConstr.kind sigma c with
     | Evar (e,args) ->
@@ -244,7 +241,7 @@ let add_inversion_lemma_exn ~poly na com comsort bool tac =
   let env = Global.env () in
   let sigma = Evd.from_env env in
   let c, uctx = Constrintern.interp_type env sigma com in
-  let sigma = Evd.from_ctx uctx in
+  let sigma = Evd.from_ustate uctx in
   let sigma, sort = Evd.fresh_sort_in_quality ~rigid:univ_rigid sigma comsort in
   add_inversion_lemma ~poly na env sigma c sort bool tac
 
diff --git a/plugins/ltac/pltac.ml b/plugins/ltac/pltac.ml
index 9f1017c56d54..9121fcbba8e1 100644
--- a/plugins/ltac/pltac.ml
+++ b/plugins/ltac/pltac.ml
@@ -60,7 +60,6 @@ let () =
   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/pptactic.ml b/plugins/ltac/pptactic.ml
index 5b6feb19a422..b3575c44833c 100644
--- a/plugins/ltac/pptactic.ml
+++ b/plugins/ltac/pptactic.ml
@@ -91,7 +91,7 @@ type 'a extra_genarg_printer =
   Environ.env -> Evd.evar_map ->
   (Environ.env -> Evd.evar_map -> EConstr.constr -> Pp.t) ->
   (Environ.env -> Evd.evar_map -> EConstr.constr -> Pp.t) ->
-  (Environ.env -> Evd.evar_map -> entry_relative_level -> Val.t -> Pp.t) ->
+  (Environ.env -> Evd.evar_map -> entry_relative_level -> tacvalue -> Pp.t) ->
   'a -> Pp.t
 
 type 'a raw_extra_genarg_printer_with_level =
@@ -112,7 +112,7 @@ type 'a extra_genarg_printer_with_level =
   Environ.env -> Evd.evar_map ->
   (Environ.env -> Evd.evar_map -> EConstr.constr -> Pp.t) ->
   (Environ.env -> Evd.evar_map -> EConstr.constr -> Pp.t) ->
-  (Environ.env -> Evd.evar_map -> entry_relative_level -> Val.t -> Pp.t) ->
+  (Environ.env -> Evd.evar_map -> entry_relative_level -> tacvalue -> Pp.t) ->
   entry_relative_level -> 'a -> Pp.t
 
 let string_of_genarg_arg (ArgumentType arg) =
@@ -144,29 +144,15 @@ let string_of_genarg_arg (ArgumentType arg) =
       let (v1, v2) = unbox v Val.typ_pair in
       str "(" ++ pr_value lev v1 ++ str ", " ++ pr_value lev v2 ++ str ")"
     else
-      let Val.Dyn (tag, x) = v in
-      let name = Val.repr tag in
-      let default = str "<" ++ str name ++ str ">" in
-      match ArgT.name name with
-      | None -> default
-      | Some (ArgT.Any arg) ->
-        let wit = ExtraArg arg in
-        match val_tag (Topwit wit) with
-        | Val.Base t ->
-          begin match Val.eq t tag with
-          | None -> default
-          | Some Refl ->
-             let open Genprint in
-             match generic_top_print (in_gen (Topwit wit) x) with
-             | TopPrinterBasic pr -> pr ()
-             | TopPrinterNeedsContext pr ->
-               let env = Global.env() in
-               pr env (Evd.from_env env)
-             | TopPrinterNeedsContextAndLevel { default_ensure_surrounded; printer } ->
-               let env = Global.env() in
-               printer env (Evd.from_env env) default_ensure_surrounded
-          end
-        | _ -> default
+      let open Genprint in
+      match generic_val_print v with
+      | TopPrinterBasic pr -> pr ()
+      | TopPrinterNeedsContext pr ->
+        let env = Global.env() in
+        pr env (Evd.from_env env)
+      | TopPrinterNeedsContextAndLevel { default_ensure_surrounded; printer } ->
+        let env = Global.env() in
+        printer env (Evd.from_env env) default_ensure_surrounded
 
   let pr_with_occurrences prvar pr c = Ppred.pr_with_occurrences prvar pr keyword c
   let pr_red_expr env sigma pr c = Ppred.pr_red_expr_env env sigma pr keyword c
@@ -514,10 +500,10 @@ let string_of_genarg_arg (ArgumentType arg) =
 (* When the [ssreflect.SsrSynax] module is imported, ssreflect
    operates in reduced compatibility mode. During printing, we try to
    account for this when this module is imported. *)
-let { Goptions.get = ssr_loaded } =
-  Goptions.declare_bool_option_and_ref ~stage:Synterp ~key:["SSR";"Loaded"] ~value:false ()
+let { Goptions.get = ssr_rewrite_loaded } =
+  Goptions.declare_bool_option_and_ref ~stage:Synterp ~key:["SSRRewriteLoaded"] ~value:false ()
 
-  let pr_orient b = if b then if ssr_loaded () then str "-> " else mt () else str "<- "
+  let pr_orient b = if b then if ssr_rewrite_loaded () then str "-> " else mt () else str "<- "
 
   let pr_multi = let open Equality in function
     | Precisely 1 -> mt ()
@@ -666,7 +652,6 @@ let pr_let_clauses recflag pr_gen pr l =
     pr_lconstr   : Environ.env -> Evd.evar_map -> 'trm -> Pp.t;
     pr_dconstr   : Environ.env -> Evd.evar_map -> 'dtrm -> Pp.t;
     pr_red_pattern   : Environ.env -> Evd.evar_map -> 'rpat -> Pp.t;
-    pr_pattern   : Environ.env -> Evd.evar_map -> 'pat -> Pp.t;
     pr_lpattern  : Environ.env -> Evd.evar_map -> 'pat -> Pp.t;
     pr_constant  : 'cst -> Pp.t;
     pr_reference : 'ref -> Pp.t;
@@ -1104,7 +1089,6 @@ let pr_let_clauses recflag pr_gen pr l =
       pr_dconstr = pr_constr_expr;
       pr_lconstr = pr_lconstr_expr;
       pr_red_pattern = pr_constr_expr;
-      pr_pattern = pr_constr_pattern_expr;
       pr_lpattern = pr_lconstr_pattern_expr;
       pr_constant = pr_or_by_notation pr_qualid;
       pr_reference = pr_qualid;
@@ -1137,7 +1121,6 @@ let pr_let_clauses recflag pr_gen pr l =
         pr_dconstr = (fun env sigma -> pr_and_constr_expr (pr_glob_constr_env env sigma));
         pr_lconstr = (fun env sigma -> pr_and_constr_expr (pr_lglob_constr_env env sigma));
         pr_red_pattern = (fun env sigma -> pr_and_constr_expr (pr_glob_constr_env env sigma));
-        pr_pattern = (fun env sigma -> pr_pat_and_constr_expr (pr_glob_constr_env env sigma));
         pr_constant = pr_or_var (pr_and_short_name (pr_evaluable_reference_env env));
         pr_lpattern = (fun env sigma -> pr_pat_and_constr_expr (pr_lglob_constr_env env sigma));
         pr_reference = pr_ltac_or_var (pr_located pr_ltac_constant);
@@ -1175,7 +1158,6 @@ let pr_let_clauses recflag pr_gen pr l =
         pr_dconstr = (fun env sigma -> pr_and_constr_expr (pr_glob_constr_env env sigma));
         pr_lconstr = pr_leconstr_env;
         pr_red_pattern = pr_constr_pattern_env;
-        pr_pattern = pr_constr_pattern_env;
         pr_lpattern = pr_lconstr_pattern_env;
         pr_constant = pr_evaluable_reference_env env;
         pr_reference = pr_located pr_ltac_constant;
@@ -1418,26 +1400,47 @@ let () =
   register_basic_print0 Stdarg.wit_pre_ident str str str;
   register_basic_print0 Stdarg.wit_string qstring qstring qstring
 
+let pr_tacvalue_ref = ref (fun _ _ : Pp.t -> assert false)
+
+let pr_tacvalue env v = !pr_tacvalue_ref env v
+
 let () =
   let printer env sigma _ _ prtac = prtac env sigma in
-  declare_extra_genarg_pprule_with_level wit_tactic printer printer printer
+  let top_print env sigma _ _ _ _ v = pr_tacvalue env v in
+  declare_extra_genarg_pprule_with_level wit_tactic printer printer top_print
   ltop (LevelLe 0)
 
 let () =
-  declare_extra_genarg_pprule_with_level wit_ltac_in_term
-    (fun env sigma _ _ prtac l tac -> prtac env sigma l tac)
-    (fun env sigma _ _ prtac l (used_ntnvars,tac) ->
-       let ppids =
-         let ids = Id.Set.elements used_ntnvars in
-         if List.is_empty ids then mt()
-         else hov 0 (pr_sequence Id.print ids ++ str " |-") ++ spc()
-       in
-       hov 2 (ppids ++ prtac env sigma l tac))
-    (fun env sigma _ _ _ _ tac -> Util.Empty.abort tac)
-  ltop (LevelLe 0)
+  let printer f x =
+    Genprint.PrinterNeedsLevel {
+      default_already_surrounded = ltop;
+      default_ensure_surrounded = LevelLe 0;
+      printer = (fun env sigma n -> f env sigma n x);
+    }
+  in
+  let pr_glob_tac_in_term env sigma l (used_ntnvars,tac) =
+    let ppids =
+      let ids = Id.Set.elements used_ntnvars in
+      if List.is_empty ids then mt()
+      else hov 0 (pr_sequence Id.print ids ++ str " |-") ++ spc()
+    in
+    hov 2 (ppids ++ pr_glob_tactic_level env l tac)
+  in
+  Genprint.register_constr_print wit_ltac_in_term
+    (printer pr_raw_tactic_level)
+    (printer pr_glob_tac_in_term)
 
 let () =
-  let pr_unit _env _sigma _ _ _ _ () = str "()" in
-  let printer env sigma _ _ prtac = prtac env sigma in
-  declare_extra_genarg_pprule_with_level wit_ltac printer printer pr_unit
-  ltop (LevelLe 0)
+  let printer f x =
+    Genprint.PrinterNeedsLevel {
+      default_already_surrounded = ltop;
+      default_ensure_surrounded = LevelLe 0;
+      printer = (fun env sigma n -> f env sigma n x);
+    }
+  in
+  Gentactic.register_print wit_ltac (printer pr_raw_tactic_level)
+    (printer (fun env _sigma n x -> pr_glob_tactic_level env n x))
+
+module Internal = struct
+  let pr_tacvalue_ref = pr_tacvalue_ref
+end
diff --git a/plugins/ltac/pptactic.mli b/plugins/ltac/pptactic.mli
index a93dfb56324a..5dfe18498fb7 100644
--- a/plugins/ltac/pptactic.mli
+++ b/plugins/ltac/pptactic.mli
@@ -42,7 +42,7 @@ type 'a extra_genarg_printer =
   Environ.env -> Evd.evar_map ->
   (Environ.env -> Evd.evar_map -> EConstr.constr -> Pp.t) ->
   (Environ.env -> Evd.evar_map -> EConstr.constr -> Pp.t) ->
-  (Environ.env -> Evd.evar_map -> entry_relative_level -> Val.t -> Pp.t) ->
+  (Environ.env -> Evd.evar_map -> entry_relative_level -> Tacarg.tacvalue -> Pp.t) ->
   'a -> Pp.t
 
 type 'a raw_extra_genarg_printer_with_level =
@@ -63,7 +63,7 @@ type 'a extra_genarg_printer_with_level =
   Environ.env -> Evd.evar_map ->
   (Environ.env -> Evd.evar_map -> EConstr.constr -> Pp.t) ->
   (Environ.env -> Evd.evar_map -> EConstr.constr -> Pp.t) ->
-  (Environ.env -> Evd.evar_map -> entry_relative_level -> Val.t -> Pp.t) ->
+  (Environ.env -> Evd.evar_map -> entry_relative_level -> Tacarg.tacvalue -> Pp.t) ->
   entry_relative_level -> 'a -> Pp.t
 
 val declare_extra_genarg_pprule :
@@ -155,6 +155,8 @@ val pr_match_rule : bool -> ('a -> Pp.t) -> ('b -> Pp.t) ->
 
 val pr_value : entry_relative_level -> Val.t -> Pp.t
 
+val pr_tacvalue : env -> Tacarg.tacvalue -> Pp.t
+
 val pp_ltac_call_kind : ltac_call_kind -> Pp.t
 
 val ltop : entry_relative_level
@@ -162,4 +164,8 @@ val ltop : entry_relative_level
 val make_constr_printer : (env -> Evd.evar_map -> entry_relative_level -> 'a -> Pp.t) ->
   'a Genprint.top_printer
 
-val ssr_loaded : unit -> bool
+val ssr_rewrite_loaded : unit -> bool
+
+module Internal : sig
+  val pr_tacvalue_ref : (env -> Tacarg.tacvalue -> Pp.t) ref
+end
diff --git a/plugins/ltac/rewriteStratAst.ml b/plugins/ltac/rewriteStratAst.ml
new file mode 100644
index 000000000000..3edf88a2fa86
--- /dev/null
+++ b/plugins/ltac/rewriteStratAst.ml
@@ -0,0 +1,148 @@
+(************************************************************************)
+(*         *      The Rocq Prover / The Rocq Development Team           *)
+(*  v      *         Copyright INRIA, CNRS and contributors             *)
+(*  s
+  | StratUnary (s, str) -> StratUnary (s, map_strategy f g h i j str)
+  | StratBinary (s, str, str') -> StratBinary (s, map_strategy f g h i j str, map_strategy f g h i j str')
+  | StratNAry (s, strs) -> StratNAry (s, List.map (map_strategy f g h i j) strs)
+  | StratConstr (c, b) -> StratConstr (f c, b)
+  | StratTerms l -> StratTerms (List.map f l)
+  | StratHints (b, id) -> StratHints (b, id)
+  | StratEval r -> StratEval (h r)
+  | StratFold c -> StratFold (f c)
+  | StratVar id -> StratVar (i id)
+  | StratFix (id, s) -> StratFix (i id, map_strategy f g h i j s)
+  | StratMatches c -> StratMatches (g c)
+  | StratTactic t -> StratTactic (j t)
+
+let pr_ustrategy = function
+| Subterms -> str "subterms"
+| Subterm -> str "subterm"
+| Innermost -> str "innermost"
+| Outermost -> str "outermost"
+| Bottomup -> str "bottomup"
+| Topdown -> str "topdown"
+| Progress -> str "progress"
+| Try -> str "try"
+| Any -> str "any"
+| Repeat -> str "repeat"
+
+let paren p = str "(" ++ p ++ str ")"
+
+let rec pr_strategy0 prc prcp prr prid prtac = function
+| StratId -> str "id"
+| StratFail -> str "fail"
+| StratRefl -> str "refl"
+| str -> paren (pr_strategy prc prcp prr prid prtac str)
+
+and pr_strategy1 prc prcp prr prid prtac = function
+| StratUnary (s, str) ->
+  pr_ustrategy s ++ spc () ++ pr_strategy1 prc prcp prr prid prtac str
+| StratNAry (Choice, strs) ->
+  str "choice" ++ brk (1,2) ++ prlist_with_sep spc (fun str -> hov 0 (pr_strategy0 prc prcp prr prid prtac str)) strs
+| StratConstr (c, true) -> prc c
+| StratConstr (c, false) -> str "<-" ++ spc () ++ prc c
+| StratVar id -> prid id
+| StratTerms cl -> str "terms" ++ spc () ++ pr_sequence prc cl
+| StratHints (old, id) ->
+  let cmd = if old then "old_hints" else "hints" in
+  str cmd ++ spc () ++ str id
+| StratEval r -> str "eval" ++ spc () ++ prr r
+| StratFold c -> str "fold" ++ spc () ++ prc c
+| StratMatches p -> str "pattern" ++ spc () ++ prcp p
+| StratTactic t -> str"tactic" ++ spc () ++ prtac t
+| str -> pr_strategy0 prc prcp prr prid prtac str
+
+and pr_strategy2 prc prcp prr prid prtac = function
+| StratBinary (Compose, str1, str2) ->
+  pr_strategy2 prc prcp prr prid prtac str1 ++ str ";" ++ spc () ++ hov 0 (pr_strategy1 prc prcp prr prid prtac str2)
+| str -> hov 0 (pr_strategy1 prc prcp prr prid prtac str)
+
+and pr_strategy prc prcp prr prid prtac = function
+| StratFix (id,s) -> str "fix" ++ spc() ++ prid id ++ spc() ++ str ":=" ++ spc() ++ hov 0 (pr_strategy1 prc prcp prr prid prtac s)
+| str -> pr_strategy2 prc prcp prr prid prtac str
+
+let strategy_of_ast bindings strat =
+  let rec aux bindings = function
+  | StratId -> Strategies.id
+  | StratFail -> Strategies.fail
+  | StratRefl -> Strategies.refl
+  | StratUnary (f, s) ->
+    let s' = aux bindings s in
+    let f' = match f with
+      | Subterms -> Strategies.all_subterms
+      | Subterm -> Strategies.one_subterm
+      | Innermost -> Strategies.innermost
+      | Outermost -> Strategies.outermost
+      | Bottomup -> Strategies.bottomup
+      | Topdown -> Strategies.topdown
+      | Progress -> Strategies.progress
+      | Try -> Strategies.try_
+      | Any -> Strategies.any
+      | Repeat -> Strategies.repeat
+    in f' s'
+  | StratBinary (f, s, t) ->
+    let s' = aux bindings s in
+    let t' = aux bindings t in
+    let f' = match f with
+      | Compose -> Strategies.seq
+    in f' s' t'
+  | StratNAry (Choice, strs) ->
+    let strs = List.map (aux bindings) strs in
+    begin match strs with
+      | [] -> assert false
+      | s::strs -> List.fold_left Strategies.choice s strs
+    end
+  | StratConstr ((_, c), b) -> Strategies.one_lemma c b None AllOccurrences
+  | StratHints (old, id) -> if old then Strategies.old_hints id else Strategies.hints id
+  | StratTerms l -> Strategies.lemmas (List.map (fun (_, c) -> (c, true, None)) l)
+  | StratEval r ->
+    Strategies.with_env @@ fun env sigma ->
+    let sigma, r = r env sigma in
+    sigma, Strategies.reduce r
+  | StratFold c -> Strategies.fold_glob (fst c)
+  | StratVar id -> Id.Map.get id bindings
+  | StratFix (id, s) -> Strategies.fix (fun self -> aux (Id.Map.add id self bindings) s)
+  | StratMatches p -> Strategies.matches p
+  | StratTactic t -> Strategies.ltac1_tactic_call t
+  in aux bindings strat
+
+
+let strategy_of_ast s = strategy_of_ast Id.Map.empty s
diff --git a/plugins/ltac/rewriteStratAst.mli b/plugins/ltac/rewriteStratAst.mli
new file mode 100644
index 000000000000..829c532873de
--- /dev/null
+++ b/plugins/ltac/rewriteStratAst.mli
@@ -0,0 +1,48 @@
+(************************************************************************)
+(*         *      The Rocq Prover / The Rocq Development Team           *)
+(*  v      *         Copyright INRIA, CNRS and contributors             *)
+(* 
+  Rewrite.strategy
+
+val map_strategy : ('a -> 'b) -> ('c -> 'd) -> ('e -> 'f) -> ('g -> 'h) -> ('i -> 'j) ->
+  ('a, 'c, 'e, 'g, 'i) strategy_ast -> ('b, 'd, 'f, 'h, 'j) strategy_ast
+
+val pr_strategy : ('a -> Pp.t) -> ('b -> Pp.t) -> ('c -> Pp.t) -> ('d -> Pp.t) -> ('e -> Pp.t) ->
+  ('a, 'b, 'c, 'd, 'e) strategy_ast -> Pp.t
diff --git a/plugins/ltac/tacarg.ml b/plugins/ltac/tacarg.ml
index c42da18f3bf4..aaf285cef808 100644
--- a/plugins/ltac/tacarg.ml
+++ b/plugins/ltac/tacarg.ml
@@ -27,12 +27,30 @@ let wit_open_constr_with_bindings = make0 "open_constr_with_bindings"
 let wit_bindings = make0 "bindings"
 let wit_quantified_hypothesis = wit_quant_hyp
 
-let wit_tactic : (raw_tactic_expr, glob_tactic_expr, Val.t) genarg_type =
+(* we can put ocaml closures (through geninterp vals) in tacvalues so no need to be marshallable *)
+type tacvalue = ..
+
+let wit_tactic : (raw_tactic_expr, glob_tactic_expr, tacvalue) genarg_type =
   make0 "tactic"
 
-let wit_ltac_in_term = make0 "ltac_in_term"
+let wit_ltac_in_term = GenConstr.create "ltac_in_term"
 
-let wit_ltac = make0 ~dyn:(val_tag (topwit Stdarg.wit_unit)) "ltac"
+let wit_ltac = Gentactic.make "ltac"
 
 let wit_destruction_arg =
   make0 "destruction_arg"
+
+module Internal = struct
+  let defined_tacvalue = ref false
+
+  let define_tacvalue (type a) () =
+    assert (not !defined_tacvalue);
+    defined_tacvalue := true;
+    let module M = (struct type tacvalue += V of a end) in
+    let of_v x = M.V x in
+    let to_v = function
+      | M.V x -> x
+      | _ -> assert false
+    in
+    of_v, to_v
+end
diff --git a/plugins/ltac/tacarg.mli b/plugins/ltac/tacarg.mli
index cd1f7dd5b005..680a515abd3e 100644
--- a/plugins/ltac/tacarg.mli
+++ b/plugins/ltac/tacarg.mli
@@ -42,17 +42,24 @@ val wit_quantified_hypothesis : quantified_hypothesis uniform_genarg_type
 
 (** Generic arguments based on Ltac. *)
 
-val wit_tactic : (raw_tactic_expr, glob_tactic_expr, Geninterp.Val.t) genarg_type
+type tacvalue
 
-val wit_ltac_in_term : (raw_tactic_expr, Names.Id.Set.t * glob_tactic_expr, Util.Empty.t) genarg_type
+val wit_tactic : (raw_tactic_expr, glob_tactic_expr, tacvalue) genarg_type
+
+val wit_ltac_in_term : (raw_tactic_expr, Names.Id.Set.t * glob_tactic_expr) GenConstr.tag
 
 (** [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_ltac : (raw_tactic_expr, glob_tactic_expr) Gentactic.tag
 
 val wit_destruction_arg :
   (constr_expr with_bindings Tactics.destruction_arg,
    glob_constr_and_expr with_bindings Tactics.destruction_arg,
    delayed_open_constr_with_bindings Tactics.destruction_arg) genarg_type
 
+module Internal : sig
+
+  val define_tacvalue : unit -> ('a -> tacvalue) * (tacvalue -> 'a)
+
+end
diff --git a/plugins/ltac/taccoerce.ml b/plugins/ltac/taccoerce.ml
index 5b19076420bd..6267f211c7f3 100644
--- a/plugins/ltac/taccoerce.ml
+++ b/plugins/ltac/taccoerce.ml
@@ -43,34 +43,6 @@ let pr_value env v =
   | TopPrinterNeedsContextAndLevel { default_already_surrounded; printer } ->
      pr_with_env (fun env sigma -> printer env sigma default_already_surrounded)
 
-(** 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 *
-      Loc.t option * (* when executing a global Ltac function: the location where this function was called *)
-      Val.t Id.Map.t * (* closure *)
-      Name.t list * (* binders *)
-      Tacexpr.glob_tactic_expr (* body *)
-  | VRec of Val.t Id.Map.t ref * Tacexpr.glob_tactic_expr
-
-let tacvalue_tag : tacvalue Val.typ =
-  let tag = Val.create "tacvalue" in
-  let pr = function
-    | VFun (a,_,loc,ids,l,tac) ->
-      let tac = if List.is_empty l then tac else CAst.make ?loc @@ Tacexpr.TacFun (l,tac) in
-      let pr_env env sigma = if Id.Map.is_empty ids then mt () else cut () ++ str "where" ++ Id.Map.fold (fun id c pp -> cut () ++ Id.print id ++ str " := " ++ pr_value (Some (env,sigma)) c ++ pp) ids (mt ()) in
-      Genprint.TopPrinterNeedsContext (fun env sigma -> v 0 (hov 0 (Pptactic.pr_glob_tactic env tac) ++ pr_env env sigma))
-    | _ -> Genprint.TopPrinterBasic (fun _ -> str "") in
-  let () = Genprint.register_val_print0 tag pr in
-  tag
-
 let constr_context_tag : Constr_matching.context Val.typ =
   let tag = Val.create "constr_context" in
   let pr env sigma lev c : Pp.t = Printer.pr_econstr_n_env env sigma lev (Constr_matching.repr_context c) in
@@ -109,6 +81,8 @@ struct
 
 type t = Val.t
 
+let tacvalue_tag = val_tag (topwit wit_tactic)
+
 let of_tacvalue v = Val.Dyn (tacvalue_tag, v)
 
 let to_tacvalue v = prj tacvalue_tag v
@@ -175,6 +149,7 @@ let rec prj : type a. a Val.tag -> Val.t -> a = fun tag v -> match tag with
 | Val.Pair (tag1, tag2) ->
   let (x, y) = unbox Val.typ_pair v (to_pair v) in
   (prj tag1 x, prj tag2 y)
+| Val.Any -> v
 | Val.Base t ->
   let Val.Dyn (t', x) = v in
   match Val.eq t t' with
@@ -270,10 +245,10 @@ let coerce_to_ident_not_fresh sigma v =
        | Sort s ->
           begin
             match ESorts.kind sigma s with
-            | Sorts.SProp -> Id.of_string "SProp"
-            | Sorts.Prop -> Id.of_string "Prop"
-            | Sorts.Set -> Id.of_string "Set"
-            | Sorts.Type _ | Sorts.QSort _ -> Id.of_string "Type"
+            | SProp -> Id.of_string "SProp"
+            | Prop -> Id.of_string "Prop"
+            | Set -> Id.of_string "Set"
+            | Type _ | VSort _ | GSort _ -> Id.of_string "Type"
           end
        | _ -> fail()
 
diff --git a/plugins/ltac/taccoerce.mli b/plugins/ltac/taccoerce.mli
index b15637a262a9..90baac82f5bb 100644
--- a/plugins/ltac/taccoerce.mli
+++ b/plugins/ltac/taccoerce.mli
@@ -21,17 +21,6 @@ open Tactypes
 exception CannotCoerceTo of string
 (** Exception raised whenever a coercion failed. *)
 
-(** 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 * Loc.t option * Val.t Id.Map.t *
-      Name.t list * Tacexpr.glob_tactic_expr
-  | VRec of Val.t Id.Map.t ref * Tacexpr.glob_tactic_expr
-
 (** {5 High-level access to values}
 
   The [of_*] functions cast a given argument into a value. The [to_*] do the
@@ -43,8 +32,8 @@ module Value :
 sig
   type t = Val.t
 
-  val of_tacvalue : tacvalue -> t
-  val to_tacvalue : t -> tacvalue option
+  val of_tacvalue : Tacarg.tacvalue -> t
+  val to_tacvalue : t -> Tacarg.tacvalue option
   val of_constr : constr -> t
   val to_constr : t -> constr option
   val of_uconstr : Ltac_pretype.closed_glob_constr -> t
diff --git a/plugins/ltac/tacentries.ml b/plugins/ltac/tacentries.ml
index 83adcc7b212e..8119414ebae1 100644
--- a/plugins/ltac/tacentries.ml
+++ b/plugins/ltac/tacentries.ml
@@ -331,10 +331,13 @@ let cons_production_parameter = function
 let add_glob_tactic_notation ?deprecation tacobj ids tac =
   let open Tacenv in
   let body =
-    { alias_args = ids; alias_body = tac; alias_deprecation = deprecation } in
+    { alias_args = ids; alias_body = tac; alias_deprecation = deprecation;
+      alias_is_ml = None;
+    }
+  in
   Lib.add_leaf (inTacticGrammar (tacobj, body))
 
-let add_glob_tactic_notation_syntax local ~level ?deprecation prods forml =
+let add_glob_tactic_notation_syntax local ~level prods forml =
   let parule = {
     tacgram_level = level;
     tacgram_prods = prods;
@@ -350,12 +353,12 @@ let add_glob_tactic_notation_syntax local ~level ?deprecation prods forml =
 
 let add_tactic_notation ?deprecation tacobj e =
   let ids = List.map_filter cons_production_parameter tacobj.tacobj_tacgram.tacgram_prods in
-  let tac = Tacintern.glob_tactic_env ids (Global.env()) e in
+  let tac = Tacintern.glob_tactic_env ids (Global.env()) UnivNames.empty_binders e in
   add_glob_tactic_notation ?deprecation tacobj ids tac
 
-let add_tactic_notation_syntax local n ?deprecation prods =
+let add_tactic_notation_syntax local n prods =
   let prods = List.map interp_prod_item prods in
-  add_glob_tactic_notation_syntax local ~level:n ?deprecation prods false
+  add_glob_tactic_notation_syntax local ~level:n prods false
 
 (**********************************************************************)
 (* ML Tactic entries                                                  *)
@@ -380,7 +383,9 @@ let extend_atomic_tactic name entries =
       let default = epsilon_value inj e in
       match default with
       | None -> raise NonEmptyArgument
-      | Some def -> Tacintern.intern_tactic_or_tacarg (Genintern.empty_glob_sign ~strict:true Environ.empty_env) def
+      | Some def ->
+        Tacintern.intern_tactic_or_tacarg
+          (Genintern.empty_glob_sign ~strict:true Environ.empty_env UnivNames.empty_binders) def
     in
     try Some (hd, List.map empty_value rem) with NonEmptyArgument -> None
   in
@@ -407,8 +412,10 @@ let synterp_add_ml_tactic_notation name ~level ?deprecation prods =
     let entry = { mltac_name = name; mltac_index = len - i - 1 } in
     let map id = Reference (Locus.ArgVar (CAst.make id)) in
     let tac = CAst.make (TacML (entry, List.map map ids)) in
-    let tacobj = add_glob_tactic_notation_syntax false ~level ?deprecation prods true in
-    tacobj, { Tacenv.alias_args = ids; alias_body = tac; alias_deprecation = deprecation }
+    let tacobj = add_glob_tactic_notation_syntax false ~level prods true in
+    tacobj, { Tacenv.alias_args = ids; alias_body = tac; alias_deprecation = deprecation;
+              alias_is_ml = Some entry;
+            }
   in
   let for_interp = List.mapi map (List.rev prods) in
   name, level, prods, for_interp
@@ -635,7 +642,7 @@ let get_identifier i =
   Names.Id.of_string_soft (Printf.sprintf "$%i" i)
 
 type _ ty_sig =
-| TyNil : (Geninterp.interp_sign -> unit Proofview.tactic) ty_sig
+| TyNil : (Tacinterp.interp_sign -> unit Proofview.tactic) ty_sig
 | TyIdent : string * 'r ty_sig -> 'r ty_sig
 | TyArg : ('a, 'b, 'c) Extend.ty_user_symbol * 'r ty_sig -> ('c -> 'r) ty_sig
 
@@ -662,7 +669,7 @@ let rec clause_of_sign : type a. int -> a ty_sig -> Genarg.ArgT.any Extend.user_
 let clause_of_ty_ml = function
   | TyML (t,_) -> clause_of_sign 1 t
 
-let rec eval_sign : type a. a ty_sig -> a -> Geninterp.Val.t list -> Geninterp.interp_sign -> unit Proofview.tactic =
+let rec eval_sign : type a. a ty_sig -> a -> Geninterp.Val.t list -> Tacinterp.interp_sign -> unit Proofview.tactic =
   fun sign tac ->
     match sign with
     | TyNil ->
@@ -680,7 +687,7 @@ let rec eval_sign : type a. a ty_sig -> a -> Geninterp.Val.t list -> Geninterp.i
         f (tac v') vals ist
       end tac
 
-let eval : ty_ml -> Geninterp.Val.t list -> Geninterp.interp_sign -> unit Proofview.tactic = function
+let eval : ty_ml -> Geninterp.Val.t list -> Tacinterp.interp_sign -> unit Proofview.tactic = function
   | TyML (t,tac) -> eval_sign t tac
 let eval_of_ty_ml = eval
 
@@ -707,7 +714,7 @@ let lift_constr_tac_to_ml_tac vars tac =
     let map = function
     | Anonymous -> None
     | Name id ->
-      let c = Id.Map.find id ist.Geninterp.lfun in
+      let c = Id.Map.find id ist.Tacinterp.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
@@ -717,7 +724,7 @@ let lift_constr_tac_to_ml_tac vars tac =
   end in
   tac
 
-let tactic_extend plugin_name tacname ~level ?deprecation sign =
+let tactic_extend plugin_name tacname ~level ?warn ?deprecation sign =
   let open Tacexpr in
   let ml_tactic_name =
     { mltac_tactic = tacname;
@@ -743,6 +750,8 @@ let tactic_extend plugin_name tacname ~level ?deprecation sign =
        [lift_constr_tac_to_ml_tac] function. *)
     let body = CAst.make (Tacexpr.TacFun (vars, CAst.make (Tacexpr.TacML (ml, [])))) in
     let id = Names.Id.of_string name in
+    (* currently custom warning not handled in this path *)
+    assert (Option.is_empty warn);
     let obj () = Tacenv.register_ltac true false id body ?deprecation in
     let () = Tacenv.register_ml_tactic ml_tactic_name [|tac|] in
     Mltop.(declare_cache_obj_full (interp_only_obj obj) plugin_name)
@@ -751,7 +760,7 @@ let tactic_extend plugin_name tacname ~level ?deprecation sign =
       synterp_add_ml_tactic_notation ml_tactic_name ~level ?deprecation (List.map clause_of_ty_ml sign)
     in
     let interp = interp_add_ml_tactic_notation in
-    Tacenv.register_ml_tactic ml_tactic_name @@ Array.of_list (List.map eval sign);
+    Tacenv.register_ml_tactic ?warn ml_tactic_name @@ Array.of_list (List.map eval sign);
     Mltop.declare_cache_obj_full (CacheObj {synterp; interp}) plugin_name
 
 type (_, 'a) ml_ty_sig =
@@ -834,14 +843,13 @@ let in_tacval =
   let subst_fun s v = v in
   let () = Genintern.register_intern0 wit intern_fun in
   let () = Gensubst.register_subst0 wit subst_fun in
-  (* No need to register a value tag for it via register_val0 since we will
-     never access this genarg directly. *)
+  let () = Geninterp.register_val0 wit (Some Any) in
   let interp_fun ist tac =
-    let args = List.map (fun id -> Id.Map.get id ist.Geninterp.lfun) tac.tacval_var in
+    let args = List.map (fun id -> Id.Map.get id ist.Tacinterp.lfun) tac.tacval_var in
     let tac = MLTacMap.get tac.tacval_tac !ml_table in
     tac args
   in
-  let () = Geninterp.register_interp0 wit interp_fun in
+  let () = Tacinterp.Register.register_interp0 wit interp_fun in
   (fun v -> Genarg.in_gen (Genarg.Glbwit wit) v)
 
 
@@ -879,10 +887,10 @@ type 'b argument_subst =
 
 type ('b, 'c) argument_interp =
 | ArgInterpRet : ('c, 'c) argument_interp
-| ArgInterpFun : ('b, Val.t) interp_fun -> ('b, 'c) argument_interp
-| ArgInterpWit : ('a, 'b, 'r) Genarg.genarg_type -> ('b, 'c) argument_interp
+| ArgInterpFun : ('b, 'c) Tacinterp.Register.interp_fun -> ('b, 'c) argument_interp
+| ArgInterpWit : ('a, 'b, 'c) Genarg.genarg_type -> ('b, 'c) argument_interp
 | ArgInterpSimple :
-  (Geninterp.interp_sign -> Environ.env -> Evd.evar_map -> 'b -> 'c) -> ('b, 'c) argument_interp
+  (Tacinterp.interp_sign -> Environ.env -> Evd.evar_map -> 'b -> 'c) -> ('b, 'c) argument_interp
 
 type ('a, 'b, 'c) tactic_argument = {
   arg_parsing : 'a Vernacextend.argument_rule;
@@ -909,18 +917,18 @@ match arg.arg_subst with
     let ans = Genarg.out_gen (glbwit wit) (Tacsubst.subst_genarg s (Genarg.in_gen (glbwit wit) v)) in
     ans
 
-let interp_fun (type a b c) name (arg : (a, b, c) tactic_argument) (tag : c Val.tag) : (b, Val.t) interp_fun =
+let interp_fun (type a b c) name (arg : (a, b, c) tactic_argument) (tag : c Val.tag) : (b, c) Tacinterp.Register.interp_fun =
 match arg.arg_interp with
-| ArgInterpRet -> (fun ist v -> Ftactic.return (Geninterp.Val.inject tag v))
+| ArgInterpRet -> (fun ist v -> Ftactic.return v)
 | ArgInterpFun f -> f
 | ArgInterpWit wit ->
-  (fun ist x -> Tacinterp.interp_genarg ist (Genarg.in_gen (glbwit wit) x))
+  (fun ist x -> Tacinterp.interp_genarg wit ist x)
 | ArgInterpSimple f ->
   (fun ist v -> Ftactic.enter begin fun gl ->
     let env = Proofview.Goal.env gl in
     let sigma = Proofview.Goal.sigma gl in
     let v = f ist env sigma v in
-    Ftactic.return (Geninterp.Val.inject tag v)
+    Ftactic.return v
   end)
 
 let argument_extend (type a b c) ~plugin ~name ~ignore_kw (arg : (a, b, c) tactic_argument) =
@@ -935,7 +943,7 @@ let argument_extend (type a b c) ~plugin ~name ~ignore_kw (arg : (a, b, c) tacti
     let () = register_val0 wit (Some tag) in
     tag
   in
-  let () = register_interp0 wit (interp_fun name arg tag) in
+  let () = Tacinterp.Register.register_interp0 wit (interp_fun name arg tag) in
   let entry = match arg.arg_parsing with
   | Vernacextend.Arg_alias e ->
     let () = Procq.register_grammar wit e in
diff --git a/plugins/ltac/tacentries.mli b/plugins/ltac/tacentries.mli
index 1b9531b2d1a8..aa31a8f38e8b 100644
--- a/plugins/ltac/tacentries.mli
+++ b/plugins/ltac/tacentries.mli
@@ -43,7 +43,7 @@ val add_tactic_notation :
     productions [prods] and returning the body [expr] *)
 
 val add_tactic_notation_syntax :
-  locality_flag -> int -> ?deprecation:Deprecation.t -> raw_argument
+  locality_flag -> int -> raw_argument
   grammar_tactic_prod_item_expr list ->
   tactic_grammar_obj
 
@@ -77,7 +77,7 @@ val print_ltac : Libnames.qualid -> Pp.t
 
 type (_, 'a) ml_ty_sig =
 | MLTyNil : ('a, 'a) ml_ty_sig
-| MLTyArg : ('r, 'a) ml_ty_sig -> (Geninterp.Val.t -> 'r, 'a) ml_ty_sig
+| MLTyArg : ('r, 'a) ml_ty_sig -> (Tacinterp.Value.t -> 'r, 'a) ml_ty_sig
 
 val ml_tactic_extend : plugin:string -> name:string -> local:locality_flag ->
   ?deprecation:Deprecation.t -> ('r, unit Proofview.tactic) ml_ty_sig -> 'r -> unit
@@ -88,26 +88,27 @@ val ml_tactic_extend : plugin:string -> name:string -> local:locality_flag ->
     argument. *)
 
 val ml_val_tactic_extend : plugin:string -> name:string -> local:locality_flag ->
-  ?deprecation:Deprecation.t -> ('r, Geninterp.Val.t Ftactic.t) ml_ty_sig -> 'r -> unit
+  ?deprecation:Deprecation.t -> ('r, Tacinterp.Value.t Ftactic.t) ml_ty_sig -> 'r -> unit
 (** Same as {!ml_tactic_extend} but the function can return an argument
     instead. *)
 
 (** {5 TACTIC EXTEND} *)
 
 type _ ty_sig =
-| TyNil : (Geninterp.interp_sign -> unit Proofview.tactic) ty_sig
+| TyNil : (Tacinterp.interp_sign -> unit Proofview.tactic) ty_sig
 | TyIdent : string * 'r ty_sig -> 'r ty_sig
 | TyArg : ('a, 'b, 'c) Extend.ty_user_symbol * 'r ty_sig -> ('c -> 'r) ty_sig
 
 type ty_ml = TyML : 'r ty_sig * 'r -> ty_ml
 
 val tactic_extend : string -> string -> level:Int.t ->
+  ?warn:(?loc:Loc.t -> unit -> unit) ->
   ?deprecation:Deprecation.t -> ty_ml list -> unit
 
 val eval_of_ty_ml :
   ty_ml ->
-  Geninterp.Val.t list ->
-  Geninterp.interp_sign ->
+  Tacinterp.Value.t list ->
+  Tacinterp.interp_sign ->
   unit Proofview.tactic
 
 (** grammar rule for [add_tactic_notation] *)
@@ -155,10 +156,10 @@ type 'b argument_subst =
 
 type ('b, 'c) argument_interp =
 | ArgInterpRet : ('c, 'c) argument_interp
-| ArgInterpFun : ('b, Geninterp.Val.t) Geninterp.interp_fun -> ('b, 'c) argument_interp
-| ArgInterpWit : ('a, 'b, 'r) Genarg.genarg_type -> ('b, 'c) argument_interp
+| ArgInterpFun : ('b, 'c) Tacinterp.Register.interp_fun -> ('b, 'c) argument_interp
+| ArgInterpWit : ('a, 'b, 'c) Genarg.genarg_type -> ('b, 'c) argument_interp
 | ArgInterpSimple :
-  (Geninterp.interp_sign -> Environ.env -> Evd.evar_map -> 'b -> 'c) -> ('b, 'c) argument_interp
+  (Tacinterp.interp_sign -> Environ.env -> Evd.evar_map -> 'b -> 'c) -> ('b, 'c) argument_interp
 
 type ('a, 'b, 'c) tactic_argument = {
   arg_parsing : 'a Vernacextend.argument_rule;
diff --git a/plugins/ltac/tacenv.ml b/plugins/ltac/tacenv.ml
index 818e1d536ea7..e4146d6c8400 100644
--- a/plugins/ltac/tacenv.ml
+++ b/plugins/ltac/tacenv.ml
@@ -43,6 +43,7 @@ type alias_tactic =
   { alias_args: Id.t list;
     alias_body: glob_tactic_expr;
     alias_deprecation: Deprecation.t option;
+    alias_is_ml : ml_tactic_entry option;
   }
 
 let alias_map = Summary.ref ~name:"tactic-alias"
@@ -59,8 +60,15 @@ let check_alias key = KerName.Map.mem key !alias_map
 
 (** ML tactic extensions (TacML) *)
 
+module TacStore = Store.Make ()
+
+type interp_sign =
+  { lfun : Geninterp.Val.t Id.Map.t
+  ; poly : PolyFlags.t
+  ; extra : TacStore.t }
+
 type ml_tactic =
-  Geninterp.Val.t list -> Geninterp.interp_sign -> unit Proofview.tactic
+  Geninterp.Val.t list -> interp_sign -> unit Proofview.tactic
 
 module MLName =
 struct
@@ -78,7 +86,7 @@ let pr_tacname t =
 
 let tac_tab = ref MLTacMap.empty
 
-let register_ml_tactic ?(overwrite = false) s (t : ml_tactic array) =
+let register_ml_tactic ?(overwrite = false) ?warn s (t : ml_tactic array) =
   let () =
     if MLTacMap.mem s !tac_tab then
       if overwrite then
@@ -86,11 +94,19 @@ let register_ml_tactic ?(overwrite = false) s (t : ml_tactic array) =
       else
         CErrors.anomaly (str "Cannot redeclare tactic " ++ pr_tacname s ++ str ".")
   in
-  tac_tab := MLTacMap.add s t !tac_tab
+  tac_tab := MLTacMap.add s (warn,t) !tac_tab
+
+let intern_check_ml_tac_alias ?loc { mltac_name = s; mltac_index = i } =
+  try
+    let warn, _tacs = MLTacMap.find s !tac_tab in
+    Option.iter (fun w -> w ?loc ()) warn
+  with Not_found ->
+    CErrors.user_err ?loc
+      (str "The tactic " ++ pr_tacname s ++ str " is not installed.")
 
 let interp_ml_tactic { mltac_name = s; mltac_index = i } =
   try
-    let tacs = MLTacMap.find s !tac_tab in
+    let _warn, tacs = MLTacMap.find s !tac_tab in
     let () = if Array.length tacs <= i then raise Not_found in
     tacs.(i)
   with Not_found ->
diff --git a/plugins/ltac/tacenv.mli b/plugins/ltac/tacenv.mli
index 6a5111f6905f..83117f406490 100644
--- a/plugins/ltac/tacenv.mli
+++ b/plugins/ltac/tacenv.mli
@@ -33,6 +33,7 @@ type alias_tactic =
   { alias_args: Id.t list;
     alias_body: glob_tactic_expr;
     alias_deprecation: Deprecation.t option;
+    alias_is_ml : ml_tactic_entry option;
   }
 (** Contents of a tactic notation *)
 
@@ -84,12 +85,22 @@ val ltac_entries : unit -> ltac_entry KerName.Map.t
 
 (** {5 ML tactic extensions} *)
 
+module TacStore : Store.S
+
+type interp_sign =
+  { lfun : Geninterp.Val.t Id.Map.t
+  ; poly : PolyFlags.t
+  ; extra : TacStore.t }
+
 type ml_tactic =
-  Val.t list -> Geninterp.interp_sign -> unit Proofview.tactic
+  Val.t list -> interp_sign -> unit Proofview.tactic
 (** Type of external tactics, used by [TacML]. *)
 
-val register_ml_tactic : ?overwrite:bool -> ml_tactic_name -> ml_tactic array -> unit
+val register_ml_tactic : ?overwrite:bool -> ?warn:(?loc:Loc.t -> unit -> unit) ->
+  ml_tactic_name -> ml_tactic array -> unit
 (** Register an external tactic. *)
 
+val intern_check_ml_tac_alias : ?loc:Loc.t -> ml_tactic_entry -> unit
+
 val interp_ml_tactic : ml_tactic_entry -> ml_tactic
 (** Get the named tactic. Raises a user error if it does not exist. *)
diff --git a/plugins/ltac/tacexpr.mli b/plugins/ltac/tacexpr.mli
index 71c2e3fe89be..82912ad78e7b 100644
--- a/plugins/ltac/tacexpr.mli
+++ b/plugins/ltac/tacexpr.mli
@@ -378,8 +378,8 @@ type atomic_tactic_expr =
 
 (** Misc *)
 
-type raw_strategy = (constr_expr, Redexpr.raw_red_expr, lident) Rewrite.strategy_ast
-type glob_strategy = (Genintern.glob_constr_and_expr, Redexpr.glob_red_expr, Id.t) Rewrite.strategy_ast
+type raw_strategy = (constr_expr, constr_expr, Redexpr.raw_red_expr, lident, raw_tactic_expr) RewriteStratAst.strategy_ast
+type glob_strategy = (Genintern.glob_constr_and_expr, Genintern.glob_constr_pattern_and_expr, Redexpr.glob_red_expr, Id.t, glob_tactic_expr) RewriteStratAst.strategy_ast
 
 (** Traces *)
 
diff --git a/plugins/ltac/tacintern.ml b/plugins/ltac/tacintern.ml
index fba856625661..b9c3762ac797 100644
--- a/plugins/ltac/tacintern.ml
+++ b/plugins/ltac/tacintern.ml
@@ -44,7 +44,7 @@ type glob_sign = Genintern.glob_sign = {
   strict_check : bool;
 }
 
-let make_empty_glob_sign ~strict = Genintern.empty_glob_sign ~strict (Global.env ())
+let make_empty_glob_sign ~strict = Genintern.empty_glob_sign ~strict (Global.env ()) UnivNames.empty_binders
 
 (* We have identifier <| global_reference <| constr *)
 
@@ -215,15 +215,10 @@ 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 pattern_mode isarity {ltacvars=lfun; genv=env; extra; intern_sign; strict_check} c =
+let intern_constr_gen pattern_mode isarity ist c =
   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' = Constrintern.intern_core scope ~strict_check ~pattern_mode ~ltacvars env Evd.(from_env env) intern_sign c in
-  (c',if strict_check then None else Some c)
+  let c' = Constrintern.intern_core scope ~pattern_mode ist c in
+  (c',if ist.strict_check then None else Some c)
 
 let intern_constr = intern_constr_gen false false
 let intern_type = intern_constr_gen false true
@@ -305,7 +300,7 @@ let evalref_of_globref ?loc r =
     in
     if not is_proof_variable then Dumpglob.add_glob ?loc r
   in
-  Tacred.soft_evaluable_of_global_reference ?loc r
+  Tacred.evaluable_of_global_reference ?loc r
 
 let intern_smart_global ist = function
   | {v=AN r} -> intern_global_reference ist r
@@ -610,7 +605,12 @@ and intern_tactic_seq onlytac ist tac =
   (* For extensions *)
   | TacAlias (s,l) ->
       let alias = Tacenv.interp_alias s in
-      Option.iter (fun o -> warn_deprecated_alias ?loc (s,o)) @@ alias.Tacenv.alias_deprecation;
+      let () = alias.Tacenv.alias_deprecation |> Option.iter @@ fun o ->
+        warn_deprecated_alias ?loc (s,o)
+      in
+      let () = alias.Tacenv.alias_is_ml |> Option.iter @@ fun ml ->
+        Tacenv.intern_check_ml_tac_alias ?loc ml
+      in
       let l = List.map (intern_tacarg false ist) l in
       ist.ltacvars, CAst.make ?loc (TacAlias (s,l))
   | TacML (opn,l) ->
@@ -701,7 +701,7 @@ let used_all_ntnvars ntnvars =
   in
   Id.Map.domain ntnvars
 
-let intern_ltac_in_term ist tac =
+let intern_ltac_in_term ?loc:_ ist tac =
   let tac = intern_tactic_or_tacarg ist tac in
   used_all_ntnvars ist.intern_sign.notation_variable_status, tac
 
@@ -710,21 +710,22 @@ let intern_ltac_in_term ist tac =
 let glob_tactic x =
   intern_pure_tactic (make_empty_glob_sign ~strict:true) x
 
-let glob_tactic_env l env x =
+let glob_tactic_env l env univs x =
   let ltacvars =
     List.fold_left (fun accu x -> Id.Set.add x accu) Id.Set.empty l in
-  intern_pure_tactic { (Genintern.empty_glob_sign ~strict:true env) with ltacvars } x
+  intern_pure_tactic { (Genintern.empty_glob_sign ~strict:true env univs) with ltacvars } x
 
 let intern_strategy ist s =
+  let open RewriteStratAst in
   let rec aux stratvars = function
-    | Rewrite.StratVar x ->
+    | StratVar x ->
       (* We could make this whole branch assert false, since it's
          unreachable except from plugins. But maybe it's useful if any
          plug-in wants to craft a strategy by hand. *)
-      if Id.Set.mem x.v stratvars then Rewrite.StratVar x.v
+      if Id.Set.mem x.v stratvars then StratVar x.v
       else CErrors.user_err ?loc:x.loc Pp.(str "Unbound strategy" ++ spc() ++ Id.print x.v)
     | StratConstr ({ v = CRef (qid, None) }, true) when idset_mem_qualid qid stratvars ->
-      let (_, x) = repr_qualid qid in Rewrite.StratVar x
+      let (_, x) = repr_qualid qid in StratVar x
     | StratConstr (c, b) -> StratConstr (intern_constr ist c, b)
     | StratFix (x, s) -> StratFix (x.v, aux (Id.Set.add x.v stratvars) s)
     | StratId | StratFail | StratRefl as s -> s
@@ -735,6 +736,12 @@ let intern_strategy ist s =
     | StratHints (b, id) -> StratHints (b, id)
     | StratEval r -> StratEval (intern_red_expr ist r)
     | StratFold c -> StratFold (intern_constr ist c)
+    | StratMatches c ->
+       let _, ip = intern_constr_pattern ist ~as_type:false ~ltacvars:Id.Set.empty c in
+       StratMatches ip
+    | StratTactic t ->
+       let it = intern_tactic_or_tacarg ist t in
+       StratTactic it
   in
   aux Id.Set.empty s
 
@@ -775,8 +782,8 @@ let () =
   Genintern.register_intern0 wit_ident intern_ident';
   Genintern.register_intern0 wit_hyp (lift intern_hyp);
   Genintern.register_intern0 wit_tactic (lift intern_tactic_or_tacarg);
-  Genintern.register_intern0 wit_ltac_in_term (lift intern_ltac_in_term);
-  Genintern.register_intern0 wit_ltac (lift intern_ltac);
+  Genintern.register_intern_constr wit_ltac_in_term intern_ltac_in_term;
+  Gentactic.register_intern 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));
diff --git a/plugins/ltac/tacintern.mli b/plugins/ltac/tacintern.mli
index 4cec4a408414..571807fbe89e 100644
--- a/plugins/ltac/tacintern.mli
+++ b/plugins/ltac/tacintern.mli
@@ -35,7 +35,7 @@ val make_empty_glob_sign : strict:bool -> glob_sign
 val glob_tactic : raw_tactic_expr -> glob_tactic_expr
 
 val glob_tactic_env :
-  Id.t list -> Environ.env -> raw_tactic_expr -> glob_tactic_expr
+  Id.t list -> Environ.env -> UnivNames.universe_binders -> raw_tactic_expr -> glob_tactic_expr
 
 (** Low-level variants *)
 
diff --git a/plugins/ltac/tacinterp.ml b/plugins/ltac/tacinterp.ml
index 1dfe4e53ec0f..c9bbb0f958f3 100644
--- a/plugins/ltac/tacinterp.ml
+++ b/plugins/ltac/tacinterp.ml
@@ -40,6 +40,44 @@ open Proofview.Notations
 open Context.Named.Declaration
 open Ltac_pretype
 
+module TacStore = Tacenv.TacStore
+
+(** Abstract application, to print ltac functions *)
+type appl =
+  | UnnamedAppl (** For generic applications: nothing is printed *)
+  | GlbAppl of (Names.KerName.t * Geninterp.Val.t list) list
+       (** For calls to global constants, some may alias other. *)
+
+type tacvalue_v =
+  | VFun of appl * ltac_trace * Loc.t option * Geninterp.Val.t Id.Map.t *
+      Name.t list * glob_tactic_expr
+  | VRec of Geninterp.Val.t Id.Map.t ref * glob_tactic_expr
+
+(* Signature for interpretation: val_interp and interpretation functions *)
+type interp_sign = Tacenv.interp_sign =
+  { lfun : Geninterp.Val.t Id.Map.t
+  ; poly : PolyFlags.t
+  ; extra : TacStore.t }
+
+module Register =
+struct
+type ('glb, 'top) interp_fun = interp_sign -> 'glb -> 'top Ftactic.t
+
+module InterpObj =
+struct
+  type ('raw, 'glb, 'top) obj = ('glb, 'top) interp_fun
+  let name = "interp"
+  let default _ = None
+end
+
+module Interp = Register(InterpObj)
+
+let interp = Interp.obj
+
+let register_interp0 = Interp.register0
+
+end
+
 let do_profile trace ?count_call tac =
   Profile_tactic.do_profile_gen (function
       | (_, c) :: _ -> Some (Pptactic.pp_ltac_call_kind c)
@@ -64,9 +102,6 @@ let prj : type a. a Val.typ -> Val.t -> a option = fun t v ->
   | None -> None
   | Some Refl -> Some x
 
-let in_list tag v =
-  let tag = match tag with Val.Base tag -> tag | _ -> assert false in
-  Val.Dyn (Val.typ_list, List.map (fun x -> Val.Dyn (tag, x)) v)
 let in_gen wit v =
   let t = match val_tag wit with
   | Val.Base t -> t
@@ -114,6 +149,30 @@ let combine_appl appl1 appl2 =
 let of_tacvalue = Value.of_tacvalue
 let to_tacvalue = Value.to_tacvalue
 
+let (of_tacvalue_v : tacvalue_v -> tacvalue), to_tacvalue_v = Tacarg.Internal.define_tacvalue ()
+
+let pr_tacvalue env v = match to_tacvalue_v v with
+  | VFun (a,_,loc,ids,l,tac) ->
+    let open Pp in
+    let tac = if List.is_empty l then tac else CAst.make ?loc @@ Tacexpr.TacFun (l,tac) in
+    let pr_env env =
+      if Id.Map.is_empty ids then mt ()
+      else
+        cut () ++ str "where" ++
+        Id.Map.fold (fun id c pp ->
+            cut () ++ Id.print id ++ str " := " ++ Pptactic.pr_value Pptactic.ltop c ++ pp)
+          ids (mt ())
+    in
+    v 0 (hov 0 (Pptactic.pr_glob_tactic env tac) ++ pr_env env)
+  | VRec _ -> str ""
+
+let () =
+  Pptactic.Internal.pr_tacvalue_ref := fun env v ->
+    pr_tacvalue env v
+
+let to_tacvalue_val v = Option.map to_tacvalue_v @@ to_tacvalue v
+let of_tacvalue_val v = of_tacvalue @@ of_tacvalue_v v
+
 (* Debug reference *)
 let debug = ref DebugOff
 
@@ -130,25 +189,17 @@ let is_traced () =
 
 (** More naming applications *)
 let name_vfun appl vle =
-  match to_tacvalue vle with
+  match to_tacvalue_val vle with
   | Some (VFun (appl0,trace,loc,lfun,vars,t)) ->
-    of_tacvalue (VFun (combine_appl appl0 appl,trace,loc,lfun,vars,t))
+    of_tacvalue_val (VFun (combine_appl appl0 appl,trace,loc,lfun,vars,t))
   | Some (VRec _) | None -> vle
 
-module TacStore = Geninterp.TacStore
-
 let f_avoid_ids : Id.Set.t TacStore.field = TacStore.field "f_avoid_ids"
 (* ids inherited from the call context (needed to get fresh ids) *)
 let f_debug : debug_info TacStore.field = TacStore.field "f_debug"
 let f_trace : ltac_trace TacStore.field = TacStore.field "f_trace"
 let f_loc : Loc.t TacStore.field = TacStore.field "f_loc"
 
-(* Signature for interpretation: val_interp and interpretation functions *)
-type interp_sign = Geninterp.interp_sign =
-  { lfun : value Id.Map.t
-  ; poly : PolyFlags.t
-  ; extra : TacStore.t }
-
 let add_extra_trace trace extra = TacStore.set extra f_trace trace
 let extract_trace ist =
   if is_traced () then match TacStore.get ist.extra f_trace with
@@ -245,7 +296,7 @@ let pr_closure env ist body =
 let pr_inspect env expr result =
   let pp_expr = Pptactic.pr_glob_tactic env expr in
   let pp_result =
-    match to_tacvalue result with
+    match to_tacvalue_val result with
     | Some (VFun (_, _, _, ist, ul, b)) ->
       let body = if List.is_empty ul then b else CAst.make (TacFun (ul, b)) in
       str "a closure with body " ++ fnl() ++ pr_closure env ist body
@@ -270,7 +321,7 @@ let push_trace call ist =
   else [],[]
 
 let propagate_trace ist loc id v =
-  match to_tacvalue v with
+  match to_tacvalue_val v with
   | None ->  Proofview.tclUNIT v
   | Some tacv ->
     match tacv with
@@ -283,12 +334,12 @@ let propagate_trace ist loc id v =
       let t = if List.is_empty it then b else CAst.make (TacFun (it,b)) in
       let trace = push_trace(loc,LtacVarCall (kn,id,t)) ist in
       let ans = VFun (appl,trace,loc,lfun,it,b) in
-      Proofview.tclUNIT (of_tacvalue ans)
+      Proofview.tclUNIT (of_tacvalue_val ans)
     | VRec _ ->  Proofview.tclUNIT v
 
 let append_trace trace v =
-  match to_tacvalue v with
-  | Some (VFun (appl,trace',loc,lfun,it,b)) -> of_tacvalue (VFun (appl,trace',loc,lfun,it,b))
+  match to_tacvalue_val v with
+  | Some (VFun (appl,trace',loc,lfun,it,b)) -> of_tacvalue_val (VFun (appl,trace',loc,lfun,it,b))
   | _ -> v
 
 (* Dynamically check that an argument is a tactic *)
@@ -296,8 +347,8 @@ let coerce_to_tactic loc id v =
   let fail () = user_err ?loc
     (str "Variable " ++ Id.print id ++ str " should be bound to a tactic.")
   in
-  match to_tacvalue v with
-  | Some (VFun (appl,trace,_,lfun,it,b)) -> of_tacvalue (VFun (appl,trace,loc,lfun,it,b))
+  match to_tacvalue_val v with
+  | Some (VFun (appl,trace,_,lfun,it,b)) -> of_tacvalue_val (VFun (appl,trace,loc,lfun,it,b))
   | _ -> fail ()
 
 let intro_pattern_of_ident id = CAst.make @@ IntroNaming (IntroIdentifier id)
@@ -404,6 +455,14 @@ let interp_hyp_list_as_list ist env sigma ({loc;v=id} as x) =
 let interp_hyp_list ist env sigma l =
   List.flatten (List.map (interp_hyp_list_as_list ist env sigma) l)
 
+let interp_genarg_var_list ist lc =
+  Ftactic.enter begin fun gl ->
+  let env = Proofview.Goal.env gl in
+  let sigma = Proofview.Goal.sigma gl in
+  let lc = interp_hyp_list ist env sigma lc in
+  Ftactic.return lc
+  end
+
 let interp_reference ist env sigma = function
   | ArgArg (_,r) -> r
   | ArgVar {loc;v=id} ->
@@ -626,7 +685,7 @@ let constr_flags () = {
 
 (* Interprets a constr; expects evars to be solved *)
 let interp_constr_gen kind ist env sigma c =
-  let flags = { (constr_flags ()) with poly = ist.Geninterp.poly } in
+  let flags = { (constr_flags ()) with poly = ist.poly } in
   interp_gen kind ist false flags env sigma c
 
 let interp_constr = interp_constr_gen WithoutTypeConstraint
@@ -705,6 +764,15 @@ let interp_constr_in_compound_list inj_fun dest_fun interp_fun ist env sigma l =
 let interp_constr_list ist env sigma c =
   interp_constr_in_compound_list (fun x -> x) (fun x -> x) interp_constr ist env sigma c
 
+let interp_genarg_constr_list ist lc =
+  Ftactic.enter begin fun gl ->
+  let env = Proofview.Goal.env gl in
+  let sigma = Proofview.Goal.sigma gl in
+  let (sigma,lc) = interp_constr_list ist env sigma lc in
+  Proofview.tclTHEN (Proofview.Unsafe.tclEVARS sigma)
+  (Ftactic.return lc)
+  end
+
 let interp_open_constr_list =
   interp_constr_in_compound_list (fun x -> x) (fun x -> x) interp_open_constr
 
@@ -750,12 +818,6 @@ let interp_red_expr ist env sigma r =
   in
   Redexpr.Interp.interp_red_expr ist env sigma r
 
-let interp_strategy ist _env _sigma s =
-  let interp_redexpr r = fun env sigma -> interp_red_expr ist env sigma r in
-  let interp_constr c = (fst c, fun env sigma -> interp_open_constr ist env sigma c) in
-  let s = Rewrite.map_strategy interp_constr interp_redexpr (fun x -> x) s in
-  Rewrite.strategy_of_ast s
-
 let interp_may_eval f ist env sigma = function
   | ConstrEval (r,c) ->
       let (sigma,redexp) = interp_red_expr ist env sigma r in
@@ -1070,11 +1132,48 @@ let rec read_match_rule ist env sigma = function
 (* Fully evaluate an untyped constr *)
 let type_uconstr ?(flags = (constr_flags ()))
   ?(expected_type = WithoutTypeConstraint) ist c =
-  let flags = { flags with poly = ist.Geninterp.poly } in
+  let flags = { flags with poly = ist.poly } in
   begin fun env sigma ->
     Pretyping.understand_uconstr ~flags ~expected_type env sigma c
   end
 
+let rec interp_genarg : 'raw 'glb 'top.
+  ('raw, 'glb, 'top) genarg_type -> interp_sign -> 'glb -> 'top Ftactic.t =
+  fun (type raw glb top) (wit:(raw, glb, top) genarg_type) ist (x:glb) : top Ftactic.t ->
+  (* Ad-hoc handling of some types. *)
+  match genarg_type_eq wit (wit_list wit_hyp) with
+  | Some Refl -> interp_genarg_var_list ist x
+  | None ->
+  match genarg_type_eq wit (wit_list wit_constr) with
+  | Some Refl -> interp_genarg_constr_list ist x
+  | None ->
+    let open Ftactic.Notations in
+    match wit with
+    | ListArg wit ->
+      let map x = interp_genarg wit ist x in
+      Ftactic.List.map map x
+    | OptArg wit ->
+      begin match x with
+      | None -> Ftactic.return None
+      | Some x ->
+        interp_genarg wit ist x >>= fun x ->
+        Ftactic.return (Some x)
+      end
+    | PairArg (wit1, wit2) ->
+      let (p, q) = x in
+      interp_genarg wit1 ist p >>= fun p ->
+      interp_genarg wit2 ist q >>= fun q ->
+      Ftactic.return (p, q)
+    | ExtraArg s ->
+      Register.interp wit ist x
+
+(* Interprets extended tactic generic arguments *)
+let generic_interp_genarg ist x : Val.t Ftactic.t =
+  let open Ftactic.Notations in
+  let GenArg (Glbwit wit, x) = x in
+  interp_genarg wit ist x >>= fun v ->
+  Ftactic.return (Val.inject (val_tag wit) v)
+
 (* Interprets an l-tac expression into a value *)
 let rec val_interp ist ?(appl=UnnamedAppl) (tac:glob_tactic_expr) : Val.t Ftactic.t =
   (* The name [appl] of applied top-level Ltac names is ignored in
@@ -1087,7 +1186,7 @@ let rec val_interp ist ?(appl=UnnamedAppl) (tac:glob_tactic_expr) : Val.t Ftacti
   let value_interp ist =
   match tac2 with
   | TacFun (it, body) ->
-    Ftactic.return (of_tacvalue (VFun (UnnamedAppl, extract_trace ist, extract_loc ist, ist.lfun, it, body)))
+    Ftactic.return (of_tacvalue_val (VFun (UnnamedAppl, extract_trace ist, extract_loc ist, ist.lfun, it, body)))
   | TacLetIn (true,l,u) -> interp_letrec ist l u
   | TacLetIn (false,l,u) -> interp_letin ist l u
   | TacMatchGoal (lz,lr,lmr) -> interp_match_goal ist lz lr lmr
@@ -1095,7 +1194,7 @@ let rec val_interp ist ?(appl=UnnamedAppl) (tac:glob_tactic_expr) : Val.t Ftacti
   | TacArg v -> interp_tacarg ist v
   | _ ->
     (* Delayed evaluation *)
-    Ftactic.return (of_tacvalue (VFun (UnnamedAppl, extract_trace ist, extract_loc ist, ist.lfun, [], tac)))
+    Ftactic.return (of_tacvalue_val (VFun (UnnamedAppl, extract_trace ist, extract_loc ist, ist.lfun, [], tac)))
   in
   let open Ftactic in
   Control.check_for_interrupt ();
@@ -1188,7 +1287,7 @@ and eval_tactic_ist ist tac : unit Proofview.tactic =
       Tacticals.tclORELSE (interp_tactic ist tac1) (interp_tactic ist tac2)
   | TacFirst l -> Tacticals.tclFIRST (List.map (interp_tactic ist) l)
   | TacSolve l -> Tacticals.tclSOLVE (List.map (interp_tactic ist) l)
-  | TacArg _ -> Ftactic.run (val_interp (ensure_loc loc ist) tac) (fun v -> tactic_of_value ist v)
+  | TacArg _ -> Ftactic.run (val_interp (ensure_loc loc ist) tac) (fun v -> tactic_of_val ist v)
   | TacSelect (sel, tac) -> Goal_select.tclSELECT sel (interp_tactic ist tac)
 
   (* For extensions *)
@@ -1206,7 +1305,7 @@ and eval_tactic_ist ist tac : unit Proofview.tactic =
         ; poly
         ; extra = add_extra_loc loc (add_extra_trace trace ist.extra) } in
         val_interp ist alias.Tacenv.alias_body >>= fun v ->
-        Ftactic.lift (tactic_of_value ist v)
+        Ftactic.lift (tactic_of_val ist v)
       in
       let tac =
         Ftactic.with_env interp_vars >>= fun (env, lr) ->
@@ -1241,7 +1340,7 @@ and eval_tactic_ist ist tac : unit Proofview.tactic =
       Ftactic.run args tac
 
 and force_vrec ist v : Val.t Ftactic.t =
-  match to_tacvalue v with
+  match to_tacvalue_val v with
   | Some (VRec (lfun,body)) -> val_interp {ist with lfun = !lfun} body
   | _ -> Ftactic.return v
 
@@ -1276,7 +1375,7 @@ and interp_ltac_reference ?loc' mustbetac ist r : Val.t Ftactic.t =
 
 and interp_tacarg ist arg : Val.t Ftactic.t =
   match arg with
-  | TacGeneric (_,arg) -> interp_genarg ist arg
+  | TacGeneric (_,arg) -> generic_interp_genarg ist arg
   | Reference r -> interp_ltac_reference false ist r
   | ConstrMayEval c ->
       Ftactic.enter begin fun gl ->
@@ -1321,7 +1420,7 @@ and interp_tacarg ist arg : Val.t Ftactic.t =
 and interp_app loc ist fv largs : Val.t Ftactic.t =
   Proofview.tclProofInfo [@ocaml.warning "-3"] >>= fun (_name, poly) ->
   let (>>=) = Ftactic.bind in
-  match to_tacvalue fv with
+  match to_tacvalue_val fv with
   | None | Some (VRec _) -> Tacticals.tclZEROMSG (str "Illegal tactic application.")
   (* if var=[] and body has been delayed by val_interp, then body
       is not a tactic that expects arguments.
@@ -1368,7 +1467,7 @@ and interp_app loc ist fv largs : Val.t Ftactic.t =
       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,loc,newlfun,lvar,body)))
+      Ftactic.return (of_tacvalue_val (VFun(push_appl appl largs,trace,loc,newlfun,lvar,body)))
   | Some (VFun(appl,trace,_,olfun,[],body)) ->
     let extra_args = List.length largs in
     let info = Exninfo.reify () in
@@ -1379,61 +1478,10 @@ and interp_app loc ist fv largs : Val.t Ftactic.t =
        str ".")
 
 (* Gives the tactic corresponding to the tactic value *)
-and tactic_of_value ist vle =
+and tactic_of_val ist vle =
   match to_tacvalue vle with
-  | Some vle ->
-  begin match vle with
-  | VFun (appl,trace,loc,lfun,[],t) ->
-    Proofview.tclProofInfo [@ocaml.warning "-3"] >>= fun (_name, poly) ->
-      let ist = {
-        lfun = lfun;
-        poly;
-        (* todo: debug stack needs "trace" but that gives incorrect results for profiling
-           Couldn't figure out how to make them play together.  Currently no way both can
-           be enabled. Perhaps profiling should be redesigned as suggested in profile_ltac.mli *)
-        extra = TacStore.set ist.extra f_trace (if Profile_tactic.get_profiling() then ([],[]) else trace); } in
-      let tac = name_if_glob appl (eval_tactic_ist ist t) in
-      let (stack, _) = trace in
-      do_profile stack (catch_error_tac_loc loc stack tac)
-  | VFun (appl,(stack,_),loc,vmap,vars,_) ->
-     let tactic_nm =
-       match appl with
-         UnnamedAppl -> "An unnamed user-defined tactic"
-       | GlbAppl apps ->
-          let nms = List.map (fun (kn,_) -> string_of_qualid (Tacenv.shortest_qualid_of_tactic 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
-     let info = Exninfo.reify () in
-     catch_error_tac stack @@
-     Tacticals.tclZEROMSG ~info
-       Pp.(str tactic_nm ++ str " was not fully applied:" ++ spc() ++
-           str "There is a missing argument for variable" ++ spc() ++ Name.print (List.hd vars) ++
-           (if numargs > 1 then
-              spc() ++ str "and " ++ int (numargs - 1) ++
-              str " more"
-            else mt()) ++ pr_comma() ++
-           (match numgiven with
-            | 0 ->
-              str "no arguments at all were provided."
-            | 1 ->
-              str "1 argument was provided."
-            | _ ->
-              int numgiven ++ str " arguments were provided."))
-  | VRec _ ->
-    let info = Exninfo.reify () in
-    Tacticals.tclZEROMSG ~info (str "A fully applied tactic is expected.")
-  end
+  | Some vle -> tactic_of_value ist vle
   | None ->
-  if has_type vle (topwit wit_tactic) then
-    let tac = out_gen (topwit wit_tactic) vle in
-    tactic_of_value ist tac
-  else
     let name =
       let Dyn (t, _) = vle in
       Val.repr t
@@ -1441,12 +1489,59 @@ and tactic_of_value ist vle =
     let info = Exninfo.reify () in
     Tacticals.tclZEROMSG ~info (str "Expression does not evaluate to a tactic (got a " ++ str name ++ str ").")
 
+and tactic_of_value ist v = match to_tacvalue_v v with
+  | VFun (appl,trace,loc,lfun,[],t) ->
+    Proofview.tclProofInfo [@ocaml.warning "-3"] >>= fun (_name, poly) ->
+    let ist = {
+      lfun = lfun;
+      poly;
+      (* todo: debug stack needs "trace" but that gives incorrect results for profiling
+         Couldn't figure out how to make them play together.  Currently no way both can
+         be enabled. Perhaps profiling should be redesigned as suggested in profile_ltac.mli *)
+      extra = TacStore.set ist.extra f_trace (if Profile_tactic.get_profiling() then ([],[]) else trace); } in
+    let tac = name_if_glob appl (eval_tactic_ist ist t) in
+    let (stack, _) = trace in
+    do_profile stack (catch_error_tac_loc loc stack tac)
+  | VFun (appl,(stack,_),loc,vmap,vars,_) ->
+    let tactic_nm =
+      match appl with
+        UnnamedAppl -> "An unnamed user-defined tactic"
+      | GlbAppl apps ->
+        let nms = List.map (fun (kn,_) -> string_of_qualid (Tacenv.shortest_qualid_of_tactic 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
+    let info = Exninfo.reify () in
+    catch_error_tac stack @@
+    Tacticals.tclZEROMSG ~info
+      Pp.(str tactic_nm ++ str " was not fully applied:" ++ spc() ++
+          str "There is a missing argument for variable" ++ spc() ++ Name.print (List.hd vars) ++
+          (if numargs > 1 then
+             spc() ++ str "and " ++ int (numargs - 1) ++
+             str " more"
+           else mt()) ++ pr_comma() ++
+          (match numgiven with
+           | 0 ->
+             str "no arguments at all were provided."
+           | 1 ->
+             str "1 argument was provided."
+           | _ ->
+             int numgiven ++ str " arguments were provided."))
+  | VRec _ ->
+    let info = Exninfo.reify () in
+    Tacticals.tclZEROMSG ~info (str "A fully applied tactic is expected.")
+
 (* Interprets the clauses of a recursive LetIn *)
 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 ({v=na}, b) =
-    let v = of_tacvalue (VRec (lref, CAst.make (TacArg b))) in
+    let v = of_tacvalue_val (VRec (lref, CAst.make (TacArg 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
@@ -1476,7 +1571,7 @@ and interp_match_success ist { Tactic_matching.subst ; context ; terms ; lhs } =
   let lfun = extend_values_with_bindings subst (lctxt +++ hyp_subst +++ ist.lfun) in
   let ist = { ist with lfun } in
   val_interp ist lhs >>= fun v ->
-  match to_tacvalue v with
+  match to_tacvalue_val v with
   | Some (VFun (appl,trace,loc,lfun,[],t)) ->
       let ist =
         { lfun = lfun
@@ -1487,7 +1582,7 @@ and interp_match_success ist { Tactic_matching.subst ; context ; terms ; lhs } =
       let dummy = VFun (appl, extract_trace ist, loc, Id.Map.empty, [],
         CAst.make (TacId [])) in
       let (stack, _) = trace in
-      catch_error_tac stack (tac <*> Ftactic.return (of_tacvalue dummy))
+      catch_error_tac stack (tac <*> Ftactic.return (of_tacvalue_val dummy))
   | _ -> Ftactic.return v
 
 
@@ -1549,61 +1644,6 @@ and interp_match_goal ist lz lr lmr =
       interp_match_successes lz ist (Tactic_matching.match_goal env sigma hyps concl ilr)
     end
 
-(* Interprets extended tactic generic arguments *)
-and interp_genarg ist x : Val.t Ftactic.t =
-    let open Ftactic.Notations in
-    (* Ad-hoc handling of some types. *)
-    let tag = genarg_tag x in
-    if argument_type_eq tag (unquote (topwit (wit_list wit_hyp))) then
-      interp_genarg_var_list ist x
-    else if argument_type_eq tag (unquote (topwit (wit_list wit_constr))) then
-      interp_genarg_constr_list ist x
-    else
-    let GenArg (Glbwit wit, x) as x0 = x in
-    match wit with
-    | ListArg wit ->
-      let map x = interp_genarg ist (Genarg.in_gen (glbwit wit) x) in
-      Ftactic.List.map map x >>= fun l ->
-      Ftactic.return (Val.Dyn (Val.typ_list, l))
-    | OptArg wit ->
-      begin match x with
-      | None -> Ftactic.return (Val.Dyn (Val.typ_opt, None))
-      | Some x ->
-        interp_genarg ist (Genarg.in_gen (glbwit wit) x) >>= fun x ->
-        Ftactic.return (Val.Dyn (Val.typ_opt, Some x))
-      end
-    | PairArg (wit1, wit2) ->
-      let (p, q) = x in
-      interp_genarg ist (Genarg.in_gen (glbwit wit1) p) >>= fun p ->
-      interp_genarg ist (Genarg.in_gen (glbwit wit2) q) >>= fun q ->
-      Ftactic.return (Val.Dyn (Val.typ_pair, (p, q)))
-    | ExtraArg s ->
-      Geninterp.generic_interp ist x0
-
-(** returns [true] for genargs which have the same meaning
-    independently of goals. *)
-
-and interp_genarg_constr_list ist x =
-  Ftactic.enter begin fun gl ->
-  let env = Proofview.Goal.env 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
-  Proofview.tclTHEN (Proofview.Unsafe.tclEVARS sigma)
-  (Ftactic.return lc)
-  end
-
-and interp_genarg_var_list ist x =
-  Ftactic.enter begin fun gl ->
-  let env = Proofview.Goal.env gl in
-  let sigma = Proofview.Goal.sigma gl in
-  let lc = Genarg.out_gen (glbwit (wit_list wit_hyp)) x in
-  let lc = interp_hyp_list ist env sigma lc in
-  let lc = in_list (val_tag wit_hyp) lc in
-  Ftactic.return lc
-  end
-
 (* Interprets tactic expressions : returns a "constr" *)
 and interp_ltac_constr ist e : EConstr.t Ftactic.t =
   let (>>=) = Ftactic.bind in
@@ -1646,7 +1686,7 @@ and interp_ltac_constr ist e : EConstr.t Ftactic.t =
 
 (* Interprets tactic expressions : returns a "tactic" *)
 and interp_tactic ist tac : unit Proofview.tactic =
-  Ftactic.run (val_interp ist tac) (fun v -> tactic_of_value ist v)
+  Ftactic.run (val_interp ist tac) (fun v -> tactic_of_val ist v)
 
 (* Provides a "name" for the trace to atomic tactics *)
 and name_atomic ?env tacexpr tac : unit Proofview.tactic =
@@ -1725,7 +1765,7 @@ and interp_atomic ist tac : unit Proofview.tactic =
           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 sigma
+          Evd.Monad.List.map_right (fun c sigma -> f sigma c) l sigma
         in
         Tacticals.tclTHEN (Proofview.Unsafe.tclEVARS sigma)
         (FixTactics.mutual_fix (interp_ident ist env sigma id) n l_interp)
@@ -1741,7 +1781,7 @@ and interp_atomic ist tac : unit Proofview.tactic =
           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 sigma
+          Evd.Monad.List.map_right (fun c sigma -> f sigma c) l sigma
         in
         Tacticals.tclTHEN (Proofview.Unsafe.tclEVARS sigma)
         (FixTactics.mutual_cofix (interp_ident ist env sigma id) l_interp)
@@ -1980,14 +2020,25 @@ let eval_tactic_ist ist t =
   Proofview.tclLIFT (db_initialize false) <*>
   eval_tactic_ist ist t
 
+let interp_strategy ist env sigma s =
+  let interp_redexpr r = fun env sigma -> interp_red_expr ist env sigma r in
+  let interp_constr c = (fst c, fun env sigma -> interp_open_constr ist env sigma c) in
+  let interp_pattern (_, p, up) = Patternops.interp_pattern env sigma Glob_ops.empty_lvar up in
+  let s = RewriteStratAst.map_strategy interp_constr interp_pattern interp_redexpr
+            (fun x -> x) (interp_tactic ist) s in
+  RewriteStratAst.strategy_of_ast s
+
 (** FFI *)
 
 module Value = struct
 
   include Taccoerce.Value
 
+  let closure ist tac =
+    of_tacvalue_v @@ VFun (UnnamedAppl, extract_trace ist, None, ist.lfun, [], tac)
+
   let of_closure ist tac =
-    let closure = VFun (UnnamedAppl, extract_trace ist, None, ist.lfun, [], tac) in
+    let closure = closure ist tac in
     of_tacvalue closure
 
   let apply_expr f args =
@@ -1997,17 +2048,17 @@ module Value = struct
       (succ i, x :: vars, Id.Map.add id arg lfun)
     in
     let (_, args, lfun) = List.fold_right fold args (0, [], Id.Map.empty) in
-    let lfun = Id.Map.add (Id.of_string "F") f lfun in
+    let lfun = Id.Map.add (Id.of_string "F") (of_tacvalue f) lfun in
     let ist = { (default_ist ()) with lfun = lfun; } in
     ist, CAst.make @@ TacArg (TacCall (CAst.make (ArgVar CAst.(make @@ Id.of_string "F"),args)))
 
 
   (** Apply toplevel tactic values *)
-  let apply (f : value) (args: value list) =
+  let apply f (args: value list) =
     let ist, tac = apply_expr f args in
     eval_tactic_ist ist tac
 
-  let apply_val (f : value) (args: value list) =
+  let apply_val f (args: value list) =
     let ist, tac = apply_expr f args in
     val_interp ist tac
 
@@ -2020,12 +2071,14 @@ let interp_tac_gen lfun avoid_ids debug t =
   Proofview.tclProofInfo [@ocaml.warning "-3"] >>= fun (_name, poly) ->
   Proofview.Goal.enter begin fun gl ->
   let env = Proofview.Goal.env gl in
+  let sigma = Proofview.Goal.sigma 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; poly; extra } in
   let ltacvars = Id.Map.domain lfun in
+  let univs = Evd.universe_binders sigma in
   eval_tactic_ist ist
-    (intern_pure_tactic { (Genintern.empty_glob_sign ~strict:false env) with ltacvars } t)
+    (intern_pure_tactic { (Genintern.empty_glob_sign ~strict:false env univs) with ltacvars } t)
   end
 
 let interp t = interp_tac_gen Id.Map.empty Id.Set.empty (get_debug()) t
@@ -2039,18 +2092,19 @@ type ltac_expr = {
 (* 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;ast} =
-  let hide_interp env =
-    let ist = Genintern.empty_glob_sign ~strict:false env in
+  let hide_interp env sigma =
+    let ist = Genintern.empty_glob_sign ~strict:false env (Evd.universe_binders sigma) in
     let te = intern_pure_tactic ist ast in
     let t = eval_tactic te in
     t
   in
   if global then
     Proofview.tclENV >>= fun env ->
-    hide_interp env
+    Proofview.tclEVARMAP >>= fun sigma ->
+    hide_interp env sigma
   else
     Proofview.Goal.enter begin fun gl ->
-      hide_interp (Proofview.Goal.env gl)
+      hide_interp (Proofview.Goal.env gl) (Proofview.Goal.sigma gl)
     end
 
 let ComTactic.Interpreter hide_interp = ComTactic.register_tactic_interpreter "ltac1" hide_interp
@@ -2059,11 +2113,7 @@ let ComTactic.Interpreter hide_interp = ComTactic.register_tactic_interpreter "l
 (** Register standard arguments *)
 
 let register_interp0 wit f =
-  let open Ftactic.Notations in
-  let interp ist v =
-    f ist v >>= fun v -> Ftactic.return (Val.inject (val_tag wit) v)
-  in
-  Geninterp.register_interp0 wit interp
+  Register.register_interp0 wit f
 
 let def_intern ist x = (ist, x)
 let def_subst _ x = x
@@ -2143,12 +2193,17 @@ let () =
   ()
 
 let () =
-  let interp ist tac = Ftactic.return (Value.of_closure ist tac) in
+  let interp ist tac = Ftactic.return (Value.closure ist tac) in
   register_interp0 wit_tactic interp
 
 let () =
-  let interp ist tac = eval_tactic_ist ist tac >>= fun () -> Ftactic.return () in
-  register_interp0 wit_ltac interp
+  let interp lfun tac =
+    let open Proofview.Notations in
+    Proofview.tclProofInfo[@ocaml.warning"-3"] >>= fun (_name, poly) ->
+    let ist = { lfun; poly; extra = TacStore.empty } in
+    eval_tactic_ist ist tac
+  in
+  Gentactic.register_interp wit_ltac interp
 
 let () =
   register_interp0 wit_uconstr (fun ist c -> Ftactic.enter begin fun gl ->
@@ -2180,7 +2235,8 @@ let () =
     | Some ty -> sigma, ty
     | None -> GlobEnv.new_type_evar env sigma ~src:(loc,Evar_kinds.InternalHole)
     in
-    let (c, sigma) = Subproof.refine_by_tactic ~name ~poly (GlobEnv.renamed_env env) sigma ty tac in
+    let inline = Abstract.get_inline_abstract_subproof () in
+    let (c, sigma) = Subproof.refine_by_tactic ~inline ~name ~poly (GlobEnv.renamed_env env) sigma ty tac in
     let j = { Environ.uj_val = c; uj_type = ty } in
     (j, sigma)
   in
diff --git a/plugins/ltac/tacinterp.mli b/plugins/ltac/tacinterp.mli
index 8ed131672b33..d9394b101ccb 100644
--- a/plugins/ltac/tacinterp.mli
+++ b/plugins/ltac/tacinterp.mli
@@ -18,6 +18,14 @@ open Tactypes
 
 val ltac_trace_info : ltac_stack Exninfo.t
 
+module TacStore = Tacenv.TacStore
+
+(** Signature for interpretation: val\_interp and interpretation functions *)
+type interp_sign = Tacenv.interp_sign =
+  { lfun : Geninterp.Val.t Id.Map.t
+  ; poly : PolyFlags.t
+  ; extra : TacStore.t }
+
 module Value :
 sig
   type t = Geninterp.Val.t
@@ -26,29 +34,21 @@ sig
   val of_int : int -> t
   val to_int : t -> int option
   val to_list : t -> t list option
-  val of_closure : Geninterp.interp_sign -> glob_tactic_expr -> t
+  val closure : interp_sign -> glob_tactic_expr -> Tacarg.tacvalue
+  val of_closure : interp_sign -> glob_tactic_expr -> t
   val cast : 'a typed_abstract_argument_type -> Geninterp.Val.t -> 'a
-  val apply : t -> t list -> unit Proofview.tactic
-  val apply_val : t -> t list -> t Ftactic.t
+  val apply : Tacarg.tacvalue -> t list -> unit Proofview.tactic
+  val apply_val : Tacarg.tacvalue -> t list -> t Ftactic.t
 end
 
 (** Values for interpretation *)
 type value = Value.t
 
-module TacStore : Store.S with
-  type t = Geninterp.TacStore.t
-  and type 'a field = 'a Geninterp.TacStore.field
-
-(** Signature for interpretation: val\_interp and interpretation functions *)
-type interp_sign = Geninterp.interp_sign =
-  { lfun : value Id.Map.t
-  ; poly : PolyFlags.t
-  ; extra : TacStore.t }
-
 open Genintern
 
 val f_avoid_ids : Id.Set.t TacStore.field
 val f_debug : debug_info TacStore.field
+val extract_loc : interp_sign -> Loc.t option
 
 val extract_ltac_constr_values : interp_sign -> Environ.env ->
   Ltac_pretype.constr_under_binders Id.Map.t
@@ -64,11 +64,12 @@ 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
+  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
+val interp_genarg : (_, 'glb, 'top) genarg_type -> interp_sign -> 'glb -> 'top Ftactic.t
+val generic_interp_genarg : interp_sign -> glob_generic_argument -> Value.t Ftactic.t
 
 (** Interprets any expression *)
 val val_interp : interp_sign -> glob_tactic_expr -> (value -> unit Proofview.tactic) -> unit Proofview.tactic
@@ -118,7 +119,8 @@ val eval_tactic : glob_tactic_expr -> unit Proofview.tactic
 val eval_tactic_ist : interp_sign -> glob_tactic_expr -> unit Proofview.tactic
 (** Same as [eval_tactic], but with the provided [interp_sign]. *)
 
-val tactic_of_value : interp_sign -> Value.t -> unit Proofview.tactic
+val tactic_of_value : interp_sign -> Tacarg.tacvalue -> unit Proofview.tactic
+val tactic_of_val : interp_sign -> Value.t -> unit Proofview.tactic
 
 (** Globalization + interpretation *)
 
@@ -149,5 +151,13 @@ val interp_ident : interp_sign -> Environ.env -> Evd.evar_map -> Id.t -> Id.t
 val interp_intro_pattern : interp_sign -> Environ.env -> Evd.evar_map ->
   glob_constr_and_expr intro_pattern_expr CAst.t -> intro_pattern
 
-val default_ist : unit -> Geninterp.interp_sign
+val default_ist : unit -> interp_sign
 (** Empty ist with debug set on the current value. *)
+
+module Register :
+sig
+type ('glb, 'top) interp_fun = interp_sign -> 'glb -> 'top Ftactic.t
+
+val register_interp0 :
+  ('raw, 'glb, 'top) genarg_type -> ('glb, 'top) interp_fun -> unit
+end
diff --git a/plugins/ltac/tacsubst.ml b/plugins/ltac/tacsubst.ml
index 9ab6a9c31551..8d90d8ed73ce 100644
--- a/plugins/ltac/tacsubst.ml
+++ b/plugins/ltac/tacsubst.ml
@@ -287,8 +287,8 @@ let () =
   Gensubst.register_subst0 wit_intropattern subst_intro_pattern [@warning "-3"];
   Gensubst.register_subst0 wit_simple_intropattern subst_intro_pattern;
   Gensubst.register_subst0 wit_tactic subst_tactic;
-  Gensubst.register_subst0 wit_ltac_in_term (fun s (used_ntnvars,tac) -> used_ntnvars, subst_tactic s tac);
-  Gensubst.register_subst0 wit_ltac subst_tactic;
+  Gensubst.register_constr_subst wit_ltac_in_term (fun s (used_ntnvars,tac) -> used_ntnvars, subst_tactic s tac);
+  Gentactic.register_subst wit_ltac subst_tactic;
   Gensubst.register_subst0 wit_constr subst_glob_constr;
   Gensubst.register_subst0 wit_clause_dft_concl (fun _ v -> v);
   Gensubst.register_subst0 wit_uconstr (fun subst c -> subst_glob_constr subst c);
diff --git a/plugins/ltac/tauto.ml b/plugins/ltac/tauto.ml
index f0e590b2f29e..174c090b0d17 100644
--- a/plugins/ltac/tauto.ml
+++ b/plugins/ltac/tauto.ml
@@ -244,6 +244,10 @@ let val_of_id id =
 
 let find_cut _ ist =
   let k = Id.Map.find (Names.Id.of_string "k") ist.lfun in
+  let k = match Taccoerce.Value.to_tacvalue k with
+    | Some k -> k
+    | None -> CErrors.user_err Pp.(str "Argument to find_cut should be a tactic.")
+  in
   Proofview.Goal.enter begin fun gl ->
   let sigma = Proofview.Goal.sigma gl in
   let hyps0 = Proofview.Goal.hyps gl in
diff --git a/plugins/ltac2/dune b/plugins/ltac2/dune
index d812d2990fad..3b16570950ae 100644
--- a/plugins/ltac2/dune
+++ b/plugins/ltac2/dune
@@ -5,10 +5,6 @@
  (modules_without_implementation tac2expr tac2qexpr tac2types)
  (libraries vernac rocq-runtime.plugins.cc_core))
 
-(deprecated_library_name
- (old_public_name coq-core.plugins.ltac2)
- (new_public_name rocq-runtime.plugins.ltac2))
-
 (rule
  (targets g_ltac2.ml)
  (deps (:mlg g_ltac2.mlg))
diff --git a/plugins/ltac2/g_ltac2.mlg b/plugins/ltac2/g_ltac2.mlg
index 45113d4d3c03..0e186207807b 100644
--- a/plugins/ltac2/g_ltac2.mlg
+++ b/plugins/ltac2/g_ltac2.mlg
@@ -200,8 +200,6 @@ GRAMMAR EXTEND Gram
           lc = LIST1 let_clause SEP "with"; "in";
           e = ltac2_expr LEVEL "6" ->
         { CAst.make ~loc @@ CTacLet (isrec, lc, e) }
-      | "match"; e = ltac2_expr LEVEL "5"; "with"; bl = branches; "end" ->
-        { CAst.make ~loc @@ CTacCse (e, bl) }
       | "if"; e = ltac2_expr LEVEL "5"; "then"; e1 = ltac2_expr LEVEL "5"; "else"; e2 = ltac2_expr LEVEL "5" ->
         { CAst.make ~loc @@ CTacIft (e, e1, e2) }
       ]
@@ -234,6 +232,8 @@ GRAMMAR EXTEND Gram
         { CAst.make ~loc @@ CTacRec (Some e, a) }
       | "{"; a = tac2rec_fieldexprs; "}" ->
         { CAst.make ~loc @@ CTacRec (None, a) }
+      | "match"; e = ltac2_expr LEVEL "5"; "with"; bl = branches; "end" ->
+        { CAst.make ~loc @@ CTacCse (e, bl) }
       | a = ltac2_atom -> { a } ]
     ]
   ;
@@ -458,16 +458,18 @@ GRAMMAR EXTEND Gram
         { SexprRec (loc, id, tok) }
     ] ]
   ;
-  syn_level:
+  syn_target:
     [ [ -> { None, None }
       | ":"; n = Prim.natural -> { None, Some n }
       | ":"; id = qualid; n = OPT [ "("; n = Prim.natural; ")" -> { n } ] -> { Some id, n }
     ] ]
   ;
   tac2def_syn:
-    [ [ toks = LIST1 ltac2_syntax_class; n = syn_level; ":=";
+    [ [ toks = LIST1 ltac2_syntax_class; n = syn_target; sc = OPT [ "%"; sc = qualid -> { sc } ]; ":=";
         e = ltac2_expr ->
-        { (toks, n, e) }
+        { let target_entry, target_level = n in
+          (toks, { Tac2syn.target_entry; target_level; target_scope = sc }, e)
+        }
     ] ]
   ;
   tac2abbrev_syn:
@@ -944,8 +946,7 @@ let rules = [
       (Rule.stop ++ Symbol.nterm test_dollar_ident ++ Symbol.token (PKEYWORD "$") ++ Symbol.nterm Prim.ident)
     begin fun id _ _ loc ->
       let id = CAst.make ~loc id in
-      let arg = Genarg.in_gen (Genarg.rawwit Tac2env.wit_ltac2_var_quotation) (None, id) in
-      CAst.make ~loc (CGenarg arg)
+      CAst.make ~loc (CGenarg (Raw (Tac2env.wit_ltac2_var_quotation, (None, id))))
     end
   );
 
@@ -955,8 +956,7 @@ let rules = [
        Symbol.token (PKEYWORD "$") ++ Symbol.nterm Prim.identref ++
        Symbol.token (PKEYWORD ":") ++ Symbol.nterm Prim.identref)
     begin fun id _ kind _ _ loc ->
-      let arg = Genarg.in_gen (Genarg.rawwit Tac2env.wit_ltac2_var_quotation) (Some kind, id) in
-      CAst.make ~loc (CGenarg arg)
+      CAst.make ~loc (CGenarg (Raw (Tac2env.wit_ltac2_var_quotation, (Some kind, id))))
     end
   );
 
@@ -965,8 +965,7 @@ let rules = [
       (Rule.stop ++ Symbol.nterm test_ampersand_ident ++ Symbol.token (PKEYWORD "&") ++ Symbol.nterm Prim.ident)
     begin fun id _ _ loc ->
       let tac = Tac2quote.of_exact_hyp ~loc (CAst.make ~loc id) in
-      let arg = Genarg.in_gen (Genarg.rawwit Tac2env.wit_ltac2_constr) tac in
-      CAst.make ~loc (CGenarg arg)
+      CAst.make ~loc (CGenarg (Raw (Tac2env.wit_ltac2_constr, tac)))
     end
   );
 
@@ -975,8 +974,7 @@ let rules = [
       (Rule.stop ++ Symbol.token (PIDENT (Some "ltac2")) ++ Symbol.token (PKEYWORD ":") ++
        Symbol.token (PKEYWORD "(") ++ Symbol.nterm ltac2_expr ++ Symbol.token (PKEYWORD ")"))
     begin fun _ tac _ _ _ loc ->
-      let arg = Genarg.in_gen (Genarg.rawwit Tac2env.wit_ltac2_constr) tac in
-      CAst.make ~loc (CGenarg arg)
+      CAst.make ~loc (CGenarg (Raw (Tac2env.wit_ltac2_constr, tac)))
     end
   )
 ] in
@@ -991,7 +989,7 @@ let rules = [
 
 let pr_ltac2entry = Tac2print.pr_strexpr
 let pr_ltac2expr e = Tac2print.pr_rawexpr_gen E5 ~avoid:Id.Set.empty e
-let pr_ltac2def_syn (a,b,c) = Tac2entries.pr_register_notation a b c
+let pr_ltac2def_syn (a,b,c) = Tac2syn.pr_register_notation a b c
 let pr_ltac2abbrev_syn (a,c) = Tac2entries.pr_register_abbreviation a c
 
 }
@@ -1041,26 +1039,43 @@ VERNAC COMMAND EXTEND VernacDeclareTactic2Definition
   } -> {
   Tac2entries.import_type qid id
   }
-| [ "Ltac2" "Custom" "Entry" identref(id) ] => { Vernacextend.(VtSideff ([], VtNow)) } SYNTERP AS _ {
-  Tac2entries.register_custom_entry id
+END
+
+VERNAC COMMAND EXTEND Ltac2NotationCommands CLASSIFIED AS SIDEFF
+| [ "Ltac2" "Custom" "Entry" identref(id) ] => { (VtSideff ([], VtNow)) }
+  SYNTERP AS _ {
+    Tac2syn.register_custom_entry id
   } -> {
   ()
 }
-| #[ raw_attributes ] [ "Ltac2" "Notation" ltac2def_syn(e) ] => { Vernacextend.(VtSideff ([], VtNow)) } SYNTERP AS synterpv {
+| #[ raw_attributes ] [ "Ltac2" "Notation" ltac2def_syn(e) ] => { (VtSideff ([], VtNow)) }
+  SYNTERP AS synterpv {
     let (toks, n, body) = e in
     Tac2entries.register_notation raw_attributes toks n body
   } ->
   {
     Tac2entries.register_notation_interpretation synterpv
   }
-| #[ raw_attributes ] [ "Ltac2" "Abbreviation" ltac2abbrev_syn(e) ] => { Vernacextend.(VtSideff ([], VtNow)) } SYNTERP AS synterpv {
+| #[ raw_attributes ] [ "Ltac2" "Abbreviation" ltac2abbrev_syn(e) ] SYNTERP AS synterpv {
     let (id, body) = e in
     Tac2entries.register_abbreviation raw_attributes id body
   } ->
   {
     Tac2entries.register_notation_interpretation synterpv
   }
-| ![proof_opt_query] [ "Ltac2" "Eval" ltac2_expr(e) ] => { Vernacextend.classify_as_query } -> {
+| [ "Ltac2" "Declare" "Scope" ident(sc) ] -> {
+  Tac2syn.declare_scope sc
+  }
+| #[ local = hint_locality ] [ "Ltac2" "Open" "Scope" reference(sc) ] -> {
+  Tac2syn.open_scope local sc
+  }
+| #[ local = hint_locality ] [ "Ltac2" "Close" "Scope" reference(sc) ] -> {
+  Tac2syn.close_scope local sc
+  }
+END
+
+VERNAC COMMAND EXTEND Ltac2Eval CLASSIFIED AS QUERY
+| ![proof_opt_query] [ "Ltac2" "Eval" ltac2_expr(e) ] -> {
   fun ~pstate -> Tac2entries.perform_eval ~pstate e
   }
 END
diff --git a/plugins/ltac2/g_ltac2.mli b/plugins/ltac2/g_ltac2.mli
index 0abb3d94ef27..3944c1aa2cbc 100644
--- a/plugins/ltac2/g_ltac2.mli
+++ b/plugins/ltac2/g_ltac2.mli
@@ -39,7 +39,7 @@ val tac2def_typ : Tac2expr.strexpr Procq.Entry.t
 val tac2def_ext : Tac2expr.strexpr Procq.Entry.t
 
 val tac2def_syn :
-  (Tac2expr.sexpr list * Tac2entries.notation_target *
+  (Tac2expr.sexpr list * Tac2syn.notation_target *
    Tac2expr.raw_tacexpr)
   Procq.Entry.t
 
@@ -55,11 +55,11 @@ val wit_ltac2_entry : Tac2expr.strexpr Genarg.vernac_genarg_type
 val ltac2_entry : Tac2expr.strexpr Procq.Entry.t
 
 val wit_ltac2def_syn :
-  (Tac2expr.sexpr list * Tac2entries.notation_target * Tac2expr.raw_tacexpr)
+  (Tac2expr.sexpr list * Tac2syn.notation_target * Tac2expr.raw_tacexpr)
     Genarg.vernac_genarg_type
 
 val ltac2def_syn :
-  (Tac2expr.sexpr list * Tac2entries.notation_target *
+  (Tac2expr.sexpr list * Tac2syn.notation_target *
    Tac2expr.raw_tacexpr)
   Procq.Entry.t
 
diff --git a/plugins/ltac2/tac2core.ml b/plugins/ltac2/tac2core.ml
index 00a63dc17653..38ca97720bc7 100644
--- a/plugins/ltac2/tac2core.ml
+++ b/plugins/ltac2/tac2core.ml
@@ -718,7 +718,7 @@ let () =
   define "constr_case" (inductive @-> tac valexpr) @@ fun ind ->
   Proofview.tclENV >>= fun env ->
   try
-    let ans = Inductiveops.make_case_info env ind Constr.RegularStyle in
+    let ans = Inductiveops.make_case_info env ind Constr.MatchStyle in
     return (Tac2ffi.of_case ans)
   with e when CErrors.noncritical e ->
     throw Tac2ffi.err_notfound
@@ -754,7 +754,7 @@ let () =
         let sigma, j = Typing.type_judgment env sigma {uj_val=t; uj_type=t_ty} in
         sigma, EConstr.ESorts.relevance_of_sort j.utj_type
       in
-      let nenv = EConstr.push_named (LocalAssum (Context.make_annot id t_rel, t)) env in
+      let nenv = EConstr.push_named ProofVar (LocalAssum (Context.make_annot id t_rel, t)) env in
       let (sigma, (evt, s)) = Evarutil.new_type_evar nenv sigma Evd.univ_flexible in
       let relevance = EConstr.ESorts.relevance_of_sort s in
       let (sigma, evk) = Evarutil.new_pure_evar (Environ.named_context_val nenv) sigma ~relevance evt in
@@ -992,6 +992,8 @@ let () = define "current_exninfo" (unit @-> tac exninfo) @@ fun () ->
 
 let () = define "message_of_exninfo" (exninfo @-> ret pp) CErrors.print_extra
 
+let () = define "print_err" (err @-> ret pp) @@ fun (e,_) -> CErrors.print e
+
 (** Control *)
 
 (** exn -> 'a *)
@@ -1079,6 +1081,30 @@ let () =
     Proofview.tclUNIT ()
   else throw Tac2ffi.err_notfound
 
+let is_permutation len l =
+  if not (Int.equal len (Array.length l)) then false else
+  let items = Array.make len false in
+  (* returns true iff [l] (seen as a 1-indexed list) maps ints in [1; len] to [1; len] injectively.
+     Thanks to pigeonhole theorem this means [l] is a permutation of [1; len]. *)
+  Array.for_all (fun x ->
+      if 1 <= x && x <= len && not items.(x-1) then
+        let () = items.(x-1) <- true in
+        true
+      else false)
+    l
+
+let () =
+  define "reorder_goals" (list int @-> tac unit) @@ fun l ->
+  Proofview.Unsafe.tclGETGOALS >>= fun gls ->
+  let len = List.length gls in
+  let l = Array.of_list l in
+  if not (is_permutation len l) then
+    throw (err_invalid_arg (Pp.str "reorder_goals"))
+  else
+    let gls = Array.of_list gls in
+    let gls = List.init len (fun i -> gls.(l.(i) - 1)) in
+    Proofview.Unsafe.tclSETGOALS gls
+
 let () =
   define "unshelve" (thunk valexpr @-> tac valexpr) @@ fun t ->
   Proofview.with_shelf (thaw t) >>= fun (gls,v) ->
@@ -1335,9 +1361,45 @@ let () =
   define "ind_get_projections" (ind_data @-> ret (option (array projection)))
   @@ fun (ind,mib) ->
   Declareops.inductive_make_projections ind mib
-  |> Option.map fst
   |> Option.map (Array.map (fun (p,_) -> Projection.make p false))
 
+(** Schemes *)
+
+let () =
+  define "scheme_lookup" (scheme_kind @-> reference @-> ret (option reference))
+  @@ DeclareScheme.lookup_scheme_opt
+
+let define_scheme_kind name =
+  define ("scheme_kind_" ^ name) (ret scheme_kind) name
+
+let () = define_scheme_kind "rect_dep"
+let () = define_scheme_kind "rec_dep"
+let () = define_scheme_kind "ind_dep"
+let () = define_scheme_kind "sind_dep"
+let () = define_scheme_kind "rect_nodep"
+let () = define_scheme_kind "rec_nodep"
+let () = define_scheme_kind "ind_nodep"
+let () = define_scheme_kind "sind_nodep"
+let () = define_scheme_kind "case_dep"
+let () = define_scheme_kind "case_nodep"
+let () = define_scheme_kind "casep_dep"
+let () = define_scheme_kind "casep_nodep"
+let () = define_scheme_kind "scase_dep"
+let () = define_scheme_kind "scase_nodep"
+let () = define_scheme_kind "sym"
+let () = define_scheme_kind "sym_involutive"
+let () = define_scheme_kind "rew"
+let () = define_scheme_kind "rew_dep"
+let () = define_scheme_kind "rew_fwd_dep"
+let () = define_scheme_kind "rew_r"
+let () = define_scheme_kind "rew_r_dep"
+let () = define_scheme_kind "rew_fwd_r_dep"
+let () = define_scheme_kind "congr"
+let () = define_scheme_kind "beq"
+let () = define_scheme_kind "dec_bl"
+let () = define_scheme_kind "dec_lb"
+let () = define_scheme_kind "eq_dec"
+
 (** Proj *)
 
 let () =
diff --git a/plugins/ltac2/tac2entries.ml b/plugins/ltac2/tac2entries.ml
index 193d204936c2..399fdaa88177 100644
--- a/plugins/ltac2/tac2entries.ml
+++ b/plugins/ltac2/tac2entries.ml
@@ -8,9 +8,6 @@
 (*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
-(* must be before open Libobject, otherwise Dyn is Libobject.Dyn *)
-module SynclassDyn = Dyn.Make()
-
 open Pp
 open Util
 open CAst
@@ -22,12 +19,13 @@ open Nametab
 open Tac2expr
 open Tac2print
 open Tac2intern
+open Tac2subst
 
 (** Grammar entries *)
 
 module Pltac =
 struct
-let ltac2_expr = Procq.Entry.make "ltac2_expr"
+let ltac2_expr = Tac2syn.Internal.ltac2_expr
 let tac2expr_in_env = Procq.Entry.make "tac2expr_in_env"
 
 let q_ident = Procq.Entry.make "q_ident"
@@ -360,7 +358,7 @@ let register_ltac ?deprecation ?(local = false) ?(mut = false) isrec tactics =
     if isrec then inline_rec_tactic tactics else tactics
   in
   let map (lid, ({loc=eloc} as e)) =
-    let (e, t) = intern ~strict:true [] e in
+    let (e, t) = intern ~strict:true UnivNames.empty_binders [] e in
     let () = check_value ?loc:eloc e in
     let () = check_ltac_exists lid in
     (lid.v, e, t)
@@ -604,475 +602,41 @@ let import_type qid as_id =
       });
     Lib.add_leaf (inImportType as_id orig)
 
-(** Parsing *)
-
-type 'a token =
-| TacTerm of string
-| TacNonTerm of Name.t * 'a
-
-type syntax_class_rule =
-| SyntaxRule : (raw_tacexpr, _, 'a) Procq.Symbol.t * ('a -> raw_tacexpr) -> syntax_class_rule
-
-module Tac2Custom = KerName
-
-type used_levels = Int.Set.t Tac2Custom.Map.t
-
-let no_used_levels = Tac2Custom.Map.empty
-
-let union_used_levels a b =
-  Tac2Custom.Map.union (fun _ a b -> Some (Int.Set.union a b)) a b
-
-(* hardcoded syntactic classes, from ltac2 or further plugins *)
-type 'glb syntax_class_decl = {
-  intern_synclass : sexpr list -> used_levels * 'glb;
-  interp_synclass : 'glb -> syntax_class_rule;
-}
-
-type syntax_class = SynclassDyn.t
-
-module SynclassInterpMap = SynclassDyn.Map(struct
-    type 'a t = 'a -> syntax_class_rule
-  end)
-
-let syntax_class_interns : (sexpr list -> used_levels * SynclassDyn.t) Id.Map.t ref =
-  ref Id.Map.empty
-
-let syntax_class_interps = ref SynclassInterpMap.empty
-
-module CustomV = struct
-  include Tac2Custom
-  let is_var _ = None
-  let stage = Summary.Stage.Synterp
-  let summary_name = "ltac2_customentrytab"
-end
-module CustomTab = Nametab.EasyNoWarn(CustomV)()
-
-let ltac2_custom_map : raw_tacexpr Procq.Entry.t Tac2Custom.Map.t Procq.GramState.field =
-  Procq.GramState.field "ltac2_custom_map"
-
-let ltac2_custom_entry : (Tac2Custom.t, raw_tacexpr) Procq.entry_command =
-  Procq.create_entry_command "ltac2" {
-    eext_fun = (fun kn e state ->
-      let map = Option.default Tac2Custom.Map.empty (Procq.GramState.get state ltac2_custom_map) in
-      let map = Tac2Custom.Map.add kn e map in
-      Procq.GramState.set state ltac2_custom_map map);
-    eext_name = (fun kn -> "custom-ltac2:" ^ Tac2Custom.to_string kn);
-    eext_eq = Tac2Custom.equal;
-  }
-
-let find_custom_entry kn =
-  Tac2Custom.Map.get kn @@ Option.get @@ Procq.GramState.get (Procq.gramstate()) ltac2_custom_map
-
-let () =
-  Metasyntax.register_custom_grammar_for_print @@ fun name ->
-  match CustomTab.locate name with
-  | exception Not_found -> None
-  | name -> Some [Any (find_custom_entry name)]
-
-let load_custom_entry i ((sp,kn),local) =
-  let () = CustomTab.push (Until i) sp kn in
-  let () = Procq.extend_entry_command ltac2_custom_entry kn in
-  let () = assert (not local) in
-  ()
-
-let import_custom_entry i ((sp,kn),local) =
-  let () = CustomTab.push (Exactly i) sp kn in
-  ()
-
-let cache_custom_entry o =
-  load_custom_entry 1 o;
-  import_custom_entry 1 o
-
-let inCustomEntry : Id.t -> bool -> Libobject.obj =
-  declare_named_object {
-    (default_object "Ltac2 custom entry") with
-    object_stage = Synterp;
-    cache_function = cache_custom_entry;
-    load_function = load_custom_entry;
-    open_function = filtered_open import_custom_entry;
-    subst_function = (fun (_,x) -> x);
-    classify_function = (fun local -> if local then Dispose else Substitute);
-  }
-
-let check_custom_entry_name id =
-  (* XXX allow it anyway? the name can be accessed by qualifying it *)
-  if Id.Map.mem id !syntax_class_interns then
-    CErrors.user_err
-      Pp.(str "Cannot declare " ++ Id.print id ++
-          str " as a ltac2 custom entry:" ++ spc() ++
-          str "that name is already used for a builtin syntactic class.")
-  else if CustomTab.exists (Lib.make_path id) then
-    CErrors.user_err Pp.(str "Ltac2 custom entry " ++ Id.print id ++ str " already exists.")
-
-let register_custom_entry name =
-  let name = name.CAst.v in
-  check_custom_entry_name name;
-  (* not yet implemented: module local custom entries
-     NB: will need checks that exported notations don't rely on the local entries *)
-  let local = false in
-  Lib.add_leaf (inCustomEntry name local)
-
-let register_syntax_class id (s:_ syntax_class_decl) =
-  assert (not (Id.Map.mem id !syntax_class_interns));
-  let tag = SynclassDyn.create (Id.to_string id) in
-  let intern args =
-    let used, data = s.intern_synclass args in
-    used, SynclassDyn.Dyn (tag, data)
-  in
-  syntax_class_interns := Id.Map.add id intern !syntax_class_interns;
-  syntax_class_interps := SynclassInterpMap.add tag s.interp_synclass !syntax_class_interps
-
-let level_name lev = string_of_int lev
-
-let terminal_synclass_tag : string SynclassDyn.tag = SynclassDyn.create ""
-
-let interp_terminal str : syntax_class_rule =
-  let v_unit = CAst.make @@ CTacCst (AbsKn (Tuple 0)) in
-  SyntaxRule (Procq.Symbol.token (Tok.PIDENT (Some str)), (fun _ -> v_unit))
-
-let () =
-  syntax_class_interps := SynclassInterpMap.add terminal_synclass_tag interp_terminal !syntax_class_interps
-
-type custom_synclass_data = {
-  custom_synclass_name : Tac2Custom.t;
-  custom_synclass_level : int option;
-}
-
-let interp_custom_entry data : syntax_class_rule =
-  let ename = data.custom_synclass_name in
-  let entry = find_custom_entry ename in
-  match data.custom_synclass_level with
-  | None ->
-    SyntaxRule (Procq.Symbol.nterm entry, (fun expr -> expr))
-  | Some lev ->
-    SyntaxRule (Procq.Symbol.nterml entry (level_name lev), (fun expr -> expr))
-
-let custom_synclass_tag : custom_synclass_data SynclassDyn.tag = SynclassDyn.create ""
-
-let () =
-  syntax_class_interps := SynclassInterpMap.add custom_synclass_tag interp_custom_entry !syntax_class_interps
-
-let intern_custom_entry ?loc qid ename args : used_levels * custom_synclass_data =
-  let lev =
-    match args with
-    | [] -> None
-    | [SexprInt {CAst.v=lev}] -> Some lev
-    | _ :: _ ->
-      CErrors.user_err ?loc
-        Pp.(str "Invalid arguments for ltac2 custom entry " ++ pr_qualid qid ++ str ".")
-  in
-  let used = match lev with
-    | None -> no_used_levels
-    | Some lev -> Tac2Custom.Map.singleton ename (Int.Set.singleton lev)
-  in
-  used, { custom_synclass_name = ename;
-    custom_synclass_level = lev;
-  }
-
-let intern_syntactic_class ?loc qid args =
-  let is_class =
-    if qualid_is_ident qid then Id.Map.find_opt (qualid_basename qid) !syntax_class_interns
-    else None
-  in
-  match is_class with
-  | Some intern -> intern args
-  | None ->
-    match CustomTab.locate qid with
-    | kn ->
-      let used, data = intern_custom_entry ?loc qid kn args in
-      used, SynclassDyn.Dyn (custom_synclass_tag, data)
-    | exception Not_found ->
-      CErrors.user_err ?loc (str "Unknown syntactic class" ++ spc () ++ pr_qualid qid)
-
-module ParseToken =
-struct
-
-let loc_of_token = function
-| SexprStr {loc} -> loc
-| SexprInt {loc} -> loc
-| SexprRec (loc, _, _) -> Some loc
-
-let intern_syntax_class = function
-| SexprRec (_, {loc;v=Some id}, toks) ->
-  intern_syntactic_class id toks
-| SexprStr {v=str} -> no_used_levels, SynclassDyn.Dyn (terminal_synclass_tag, str)
-| tok ->
-  let loc = loc_of_token tok in
-  CErrors.user_err ?loc (str "Invalid parsing token")
-
-let check_name na =
-  match na.CAst.v with
-  | None -> Anonymous
-  | Some id ->
-    let id = if qualid_is_ident id then qualid_basename id
-      else CErrors.user_err ?loc:id.loc Pp.(str "Must be an identifier.")
-    in
-    let () = check_lowercase (CAst.make ?loc:na.CAst.loc id) in
-    Name id
-
-let parse_token = function
-| SexprStr {v=s} -> no_used_levels, TacTerm s
-| SexprRec (_, na, [tok]) ->
-  let na = check_name na in
-  let used, syntax_class = intern_syntax_class tok in
-  used, TacNonTerm (na, syntax_class)
-| tok ->
-  let loc = loc_of_token tok in
-  CErrors.user_err ?loc (str "Invalid parsing token")
-
-let name_of_token = function
-  | SexprStr _ -> Anonymous
-  | SexprRec (_, na, _) -> check_name na
-  | tok ->
-    let loc = loc_of_token tok in
-    CErrors.user_err ?loc (str "Invalid parsing token")
-
-let rec print_syntax_class = function
-| SexprStr s -> str s.CAst.v
-| SexprInt i -> int i.CAst.v
-| SexprRec (_, {v=na}, []) -> Option.cata pr_qualid (str "_") na
-| SexprRec (_, {v=na}, e) ->
-  Option.cata pr_qualid (str "_") na ++ str "(" ++ pr_sequence print_syntax_class e ++ str ")"
-
-let print_token = function
-| SexprStr {v=s} -> quote (str s)
-| SexprRec (_, {v=na}, [tok]) -> print_syntax_class tok
-| _ -> assert false
-
-end
-
-let intern_syntax_class = ParseToken.intern_syntax_class
-
-type synext = {
-  synext_kn : KerName.t;
-  (* for printing, XXX print the internalized version? *)
-  synext_raw : sexpr list;
-  synext_used : used_levels;
-  synext_tok : SynclassDyn.t token list;
-  synext_entry : Tac2Custom.t option * int;
-  synext_loc : bool;
-  synext_depr : Deprecation.t option;
-}
-
-type krule =
-| KRule :
-  (raw_tacexpr, _, 'act, Loc.t -> raw_tacexpr) Procq.Rule.t *
-  ((Loc.t -> (Name.t * raw_tacexpr) list -> raw_tacexpr) -> 'act) -> krule
-
-let interp_syntax_class (SynclassDyn.Dyn (tag, data)) =
-  let interp = SynclassInterpMap.find tag !syntax_class_interps in
-  interp data
-
-let rec get_rule (tok : SynclassDyn.t token list) : krule = match tok with
-| [] -> KRule (Procq.Rule.stop, fun k loc -> k loc [])
-| TacNonTerm (na, v) :: tok ->
-  let SyntaxRule (syntax_class, inj) = interp_syntax_class v in
-  let KRule (rule, act) = get_rule tok in
-  let rule = Procq.Rule.next rule syntax_class in
-  let act k e = act (fun loc acc -> k loc ((na, inj e) :: acc)) in
-  KRule (rule, act)
-| TacTerm t :: tok ->
-  let KRule (rule, act) = get_rule tok in
-  let rule = Procq.(Rule.next rule (Symbol.token (CLexer.terminal t))) in
-  let act k _ = act k in
-  KRule (rule, act)
-
-let deprecated_ltac2_notation =
-  Deprecation.create_warning
-    ~object_name:"Ltac2 notation"
-    ~warning_name_if_no_since:"deprecated-ltac2-notation"
-    (fun (toks : sexpr list) -> pr_sequence ParseToken.print_token toks)
-
-let ltac2_levels = Procq.GramState.field "ltac2_levels"
-
-(* XXX optional lev and do reusefirst like in egramrocq? *)
-let fresh_level st entry lev =
-  match entry with
-  | None -> st, None
-  | Some entry ->
-    let all_levels = Option.default Tac2Custom.Map.empty @@ Procq.GramState.get st ltac2_levels in
-    let entry_levels = Option.default Int.Set.empty @@ Tac2Custom.Map.find_opt entry all_levels in
-    let last_before = Int.Set.find_first_opt (fun lev' -> lev' >= lev) entry_levels in
-    if Option.equal Int.equal last_before (Some lev) then st, None
-    else
-      let pos = match last_before with
-        | None -> Gramlib.Gramext.First
-        | Some lev' -> Gramlib.Gramext.After (level_name lev')
-      in
-      let entry_levels = Int.Set.add lev entry_levels in
-      let all_levels = Tac2Custom.Map.add entry entry_levels all_levels in
-      let st = Procq.GramState.set st ltac2_levels all_levels in
-      st, Some pos
-
-let check_levels st used_levels =
-  let all_levels = Option.default Tac2Custom.Map.empty @@ Procq.GramState.get st ltac2_levels in
-  let iter kn used =
-    let known = Option.default Int.Set.empty (Tac2Custom.Map.find_opt kn all_levels) in
-    let missing = Int.Set.diff used known in
-    if not (Int.Set.is_empty missing) then
-      CErrors.user_err
-        Pp.(str "Unknown " ++ str (String.plural (Int.Set.cardinal missing) "level") ++
-            str " for ltac2 custom entry " ++ CustomTab.pr kn)
-  in
-  Tac2Custom.Map.iter iter used_levels
-
-let perform_notation syn st =
-  let tok = syn.synext_tok in
-  let used = syn.synext_used in
-  let KRule (rule, act) = get_rule tok in
-  let mk loc args =
-    let () = match syn.synext_depr with
-    | None -> ()
-    | Some depr -> deprecated_ltac2_notation ~loc (syn.synext_raw, depr)
-    in
-    let map (na, e) =
-      ((CAst.make ?loc:e.loc na), e)
-    in
-    let bnd = List.map map args in
-    CAst.make ~loc @@ CTacSyn (bnd, syn.synext_kn)
-  in
-  let rule = Procq.Production.make rule (act mk) in
-  let entry, lev = syn.synext_entry in
-  let st, fresh = fresh_level st entry lev in
-  let () = check_levels st used in
-  let pos = Some (level_name lev) in
-  let rule = match fresh with
-    | None -> Procq.Reuse (pos, [rule])
-    | Some pos' ->
-      (* BothA means we can have SELF on both the left and right of a rule. *)
-      Procq.Fresh (pos', [pos, Some BothA, [rule]])
-  in
-  let entry = match entry with
-    | None -> Pltac.ltac2_expr
-    | Some entry -> find_custom_entry entry
-  in
-  [Procq.ExtendRule (entry, rule)], st
-
-let ltac2_notation =
-  Procq.create_grammar_command "ltac2-notation" { gext_fun = perform_notation; gext_eq = (==) (* FIXME *) }
-
-let cache_synext syn =
-  Procq.extend_grammar_command ~ignore_kw:false ltac2_notation syn
-
-let subst_synext (subst, syn) =
-  let kn = Mod_subst.subst_kn subst syn.synext_kn in
-  if kn == syn.synext_kn then syn
-  else { syn with synext_kn = kn }
-
-let classify_synext o =
-  if o.synext_loc then Dispose else Substitute
-
-let ltac2_notation_cat = Libobject.create_category "ltac2.notations"
-
-let inTac2Notation : synext -> obj =
-  declare_object {(default_object "TAC2-NOTATION") with
-     object_stage = Summary.Stage.Synterp;
-     cache_function  = cache_synext;
-     open_function   = simple_open ~cat:ltac2_notation_cat cache_synext;
-     subst_function = subst_synext;
-     classify_function = classify_synext}
-
-let cache_synext_interp (local,kn,tac) =
-  Tac2env.define_notation kn tac
-
-let subst_notation_data subst = function
-  | Tac2env.UntypedNota body as n ->
-    let body' = Tac2intern.subst_rawexpr subst body in
-    if body' == body then n else UntypedNota body'
-  | TypedNota { nota_prms=prms; nota_argtys=argtys; nota_ty=ty; nota_body=body } as n ->
-    let body' = Tac2intern.subst_expr subst body in
-    let argtys' = Id.Map.Smart.map (subst_type subst) argtys in
-    let ty' = subst_type subst ty in
-    if body' == body && argtys' == argtys && ty' == ty then n
-    else TypedNota {nota_body=body'; nota_argtys=argtys'; nota_ty=ty'; nota_prms=prms}
-
-let subst_synext_interp (subst, (local,kn,tac as o)) =
-  let tac' = subst_notation_data subst tac in
-  let kn' = Mod_subst.subst_kn subst kn in
-  if kn' == kn && tac' == tac then o else
-  (local, kn', tac')
-
-let classify_synext_interp (local,_,_) =
-  if local then Dispose else Substitute
-
-let inTac2NotationInterp : (bool*KerName.t*Tac2env.notation_data) -> obj =
-  declare_object {(default_object "TAC2-NOTATION-INTERP") with
-     cache_function  = cache_synext_interp;
-     open_function   = simple_open ~cat:ltac2_notation_cat cache_synext_interp;
-     subst_function = subst_synext_interp;
-     classify_function = classify_synext_interp}
-
-type abbreviation = {
-  abbr_body : raw_tacexpr;
-  abbr_depr : Deprecation.t option;
-}
+(** {5 Parsing} *)
 
 let perform_abbreviation visibility ((sp, kn), abbr) =
-  let () = Tac2env.push_ltac visibility sp (TacAlias kn) in
-  Tac2env.define_alias ?deprecation:abbr.abbr_depr kn abbr.abbr_body
+  let () = Tac2env.push_ltac visibility sp (TacAbbrev kn) in
+  Tac2env.define_abbrev kn abbr
 
 let load_abbreviation i obj = perform_abbreviation (Until i) obj
 let open_abbreviation i obj = perform_abbreviation (Exactly i) obj
 
 let cache_abbreviation ((sp, kn), abbr) =
-  let () = Tac2env.push_ltac (Until 1) sp (TacAlias kn) in
-  Tac2env.define_alias ?deprecation:abbr.abbr_depr kn abbr.abbr_body
+  let () = Tac2env.push_ltac (Until 1) sp (TacAbbrev kn) in
+  Tac2env.define_abbrev kn abbr
 
 let subst_abbreviation (subst, abbr) =
-  let body' = subst_rawexpr subst abbr.abbr_body in
-  if body' == abbr.abbr_body then abbr
-  else { abbr_body = body'; abbr_depr = abbr.abbr_depr }
-
-let classify_abbreviation o = Substitute
+  let open Tac2env in
+  let ty' = subst_type subst abbr.abbrev_ty in
+  let body' = subst_expr subst abbr.abbrev_body in
+  if ty' == abbr.abbrev_ty && body' == abbr.abbrev_body then abbr
+  else { abbr with abbrev_body = body'; abbrev_ty = ty'; }
 
-let inTac2Abbreviation : Id.t -> abbreviation -> obj =
+let inTac2Abbreviation : Id.t -> Tac2env.abbrev_data -> obj =
   declare_named_object {(default_object "TAC2-ABBREVIATION") with
      cache_function  = cache_abbreviation;
      load_function   = load_abbreviation;
-     open_function   = filtered_open ~cat:ltac2_notation_cat open_abbreviation;
+     open_function   = filtered_open ~cat:Tac2syn.ltac2_notation_cat open_abbreviation;
      subst_function = subst_abbreviation;
-     classify_function = classify_abbreviation}
-
-let rec string_of_syntax_class = function
-| SexprStr s -> Printf.sprintf "str(%s)" s.CAst.v
-| SexprInt i -> Printf.sprintf "int(%i)" i.CAst.v
-| SexprRec (_, {v=na}, []) -> Option.cata string_of_qualid "_" na
-| SexprRec (_, {v=na}, e) ->
-  Printf.sprintf "%s(%s)" (Option.cata string_of_qualid "_" na) (String.concat " " (List.map string_of_syntax_class e))
-
-let string_of_token = function
-| SexprStr {v=s} -> Printf.sprintf "str(%s)" s
-| SexprRec (_, {v=na}, [tok]) -> string_of_syntax_class tok
-| _ -> assert false
-
-let make_fresh_key tokens =
-  let prods = String.concat "_" (List.map string_of_token tokens) in
-  (* We embed the hash of the kernel name in the label so that the identifier
-      should be mostly unique. This ensures that including two modules
-      together won't confuse the corresponding labels. *)
-  let hash = (ModPath.hash (Lib.current_mp ())) land 0x7FFFFFFF in
-  let lbl = Id.of_string_soft (Printf.sprintf "%s_%08X" prods hash) in
-  Lib.make_kn lbl
-
-type notation_interpretation_data =
-| Abbreviation of Id.t * Deprecation.t option * raw_tacexpr
-| Synext of bool * KerName.t * Id.Set.t * raw_tacexpr
-
-type notation_target = qualid option * int option
-
-let pr_register_notation tkn (entry,lev) body =
-  let pptarget = match entry, lev with
-    | None, None -> mt()
-    | None, Some lev -> spc() ++ str ": " ++ int lev
-    | Some entry, None -> spc() ++ str ": " ++ pr_qualid entry
-    | Some entry, Some lev ->
-      spc() ++ str ": " ++ pr_qualid entry ++ str "(" ++ int lev ++ str ")"
-  in
-  prlist_with_sep spc Tac2print.pr_syntax_class tkn ++
-  pptarget ++ spc() ++
-  hov 2 (str ":= " ++ Tac2print.pr_rawexpr_gen E5 ~avoid:Id.Set.empty body)
+     classify_function = (fun _ -> Substitute);
+}
+
+type ('scope,'body) notation_interpretation_data =
+| Abbreviation of Id.t * Deprecation.t option * 'body
+| Synext of ('scope, 'body) Tac2syn.notation_interpretation
 
 let pr_register_abbreviation id body =
+  let open Pp in
   Id.print id.CAst.v ++
   hov 2 (str ":= " ++ Tac2print.pr_rawexpr_gen E5 ~avoid:Id.Set.empty body)
 
@@ -1083,83 +647,34 @@ let register_abbreviation atts id body =
 
 let warn_deprecated_notation_for_abbreviation =
     CWarnings.create ~name:"ltac2-notation-for-abbreviation" ~category:Deprecation.Version.v9_2
-      (fun () -> strbrk "Use of \"Ltac2 Notation\" keyword for abbreviations is deprecated, use \"Ltac2 Abbreviation\" instead.")
+      Pp.(fun () -> strbrk "Use of \"Ltac2 Notation\" keyword for abbreviations is deprecated, use \"Ltac2 Abbreviation\" instead.")
 
-let tactic_qualid = qualid_of_ident (Id.of_string "tactic")
+let is_abbrev_target target =
+  let open Tac2syn in
+  Option.is_empty target.target_entry && Option.is_empty target.target_level
+  && Option.is_empty target.target_scope
 
-let register_notation atts tkn (entry,lev) body =
-  match tkn, entry, lev with
-  | [SexprRec (_, {loc;v=Some id}, [])], None, None ->
+let register_notation atts tkn target body =
+  match tkn, is_abbrev_target target with
+  | [SexprRec (_, {loc;v=Some id}, [])], true ->
     warn_deprecated_notation_for_abbreviation ();
     let id = if qualid_is_ident id then qualid_basename id
       else CErrors.user_err ?loc:id.loc Pp.(str "Must be an identifier.")
     in
     register_abbreviation atts CAst.(make ?loc id) body
   | _ ->
-    let deprecation, local = Attributes.(parse Notations.(deprecation ++ locality)) atts in
-    let local = Option.default false local in
-    (* Check that the tokens make sense *)
-    let entries = List.map ParseToken.name_of_token tkn in
-    let fold accu tok = match tok with
-    | Name id -> Id.Set.add id accu
-    | Anonymous -> accu
-    in
-    let ids = List.fold_left fold Id.Set.empty entries in
-    let entry = match entry with
-      | Some entry ->
-        if qualid_eq entry tactic_qualid then None
-        else begin
-          try Some (CustomTab.locate entry)
-          with Not_found -> CErrors.user_err Pp.(str "Unknown entry " ++ pr_qualid entry ++ str ".")
-        end
-      | None -> None
-    in
-    (* Globalize so that names are absolute *)
-    let lev = if Option.has_some entry then
-        let lev = match lev with
-          | Some lev -> lev
-          | None -> user_err (str "Custom entry level must be explicit.")
-        in
-        let () = if lev < 0 then user_err (str "Custom entry levels must be nonnegative.") in
-        lev
-      else match lev with
-        | Some n ->
-          let () =
-            if n < 0 || n > 6 then
-              user_err (str "Notation levels must range between 0 and 6")
-          in
-          n
-        | None ->
-          (* autodetect level *)
-          begin match tkn with
-          | SexprStr s :: _ when Names.Id.is_valid s.CAst.v -> 1
-          | _ -> 5
-          end
-    in
-    let key = make_fresh_key tkn in
-    let tokens = List.rev_map ParseToken.parse_token tkn in
-    let used, tokens = List.split tokens in
-    let used = List.fold_left union_used_levels no_used_levels used in
-    let ext = {
-      synext_kn = key;
-      synext_raw = tkn;
-      synext_used = used;
-      synext_tok = tokens;
-      synext_entry = (entry,lev);
-      synext_loc = local;
-      synext_depr = deprecation;
-    } in
-    Lib.add_leaf (inTac2Notation ext);
-    Synext (local,key,ids,body)
+    let data = Tac2syn.register_notation atts tkn target body in
+    Synext data
 
 let register_notation_interpretation = function
   | Abbreviation (id, deprecation, body) ->
-    let body = Tac2intern.globalize Id.Set.empty body in
-    let abbr = { abbr_body = body; abbr_depr = deprecation } in
+    let abbr = Tac2intern.intern_abbrev deprecation body in
     Lib.add_leaf (inTac2Abbreviation id abbr)
-  | Synext (local,kn,ids,body) ->
-    let data = intern_notation_data ids body in
-    Lib.add_leaf (inTac2NotationInterp (local,kn,data))
+  | Synext data ->
+    let data = Tac2syn.intern_notation_interpretation intern_notation_data data in
+    Tac2syn.register_notation_interpretation data
+
+(** {5 Redefinition} *)
 
 type redefinition = {
   redef_local : Libobject.locality;
@@ -1200,7 +715,7 @@ let open_redefinition (_,redef as o) =
 
 let subst_redefinition (subst, redef) =
   let kn = Mod_subst.subst_kn subst redef.redef_kn in
-  let body = Tac2intern.subst_expr subst redef.redef_body in
+  let body = subst_expr subst redef.redef_body in
   if kn == redef.redef_kn && body == redef.redef_body then redef
   else { redef_local = redef.redef_local;
          redef_kn = kn;
@@ -1233,7 +748,7 @@ let register_redefinition ~local qid old ({loc=eloc} as e) =
   in
   let kn = match kn with
   | TacConstant kn -> kn
-  | TacAlias _ ->
+  | TacAbbrev _ ->
     user_err ?loc:qid.CAst.loc (str "Cannot redefine syntactic abbreviations")
   in
   let data = Tac2env.interp_global kn in
@@ -1245,7 +760,7 @@ let register_redefinition ~local qid old ({loc=eloc} as e) =
   | None -> []
   | Some { CAst.v = id } -> [id, data.Tac2env.gdata_type]
   in
-  let (e, t) = intern ~strict:true ctx e in
+  let (e, t) = intern UnivNames.empty_binders ~strict:true ctx e in
   let () = check_value ?loc:eloc e in
   let () =
     if not (Tac2intern.check_subtype t data.Tac2env.gdata_type) then
@@ -1264,8 +779,6 @@ let register_redefinition ~local qid old ({loc=eloc} as e) =
 
 let perform_eval ~pstate e =
   let env = Global.env () in
-  let (e, ty) = Tac2intern.intern ~strict:false [] e in
-  let v = Tac2interp.interp Tac2interp.empty_environment e in
   let proof =
     match pstate with
     | None ->
@@ -1275,6 +788,9 @@ let perform_eval ~pstate e =
     | Some pstate ->
       Declare.Proof.get pstate
   in
+  let { Proof.sigma } = Proof.data proof in
+  let (e, ty) = Tac2intern.intern ~strict:false (Evd.universe_binders sigma) [] e in
+  let v = Tac2interp.interp Tac2interp.empty_environment e in
   let (proof, _, ans) = Proof.run_tactic (Global.env ()) v proof in
   let { Proof.sigma } = Proof.data proof in
   let name = int_name () in
@@ -1333,13 +849,45 @@ let pr_frame = function
     str "Extn " ++ str (Tac2dyn.Arg.repr tag) ++ str ":" ++ spc () ++
     obj.Tac2env.ml_print env sigma arg
 
-let () = register_handler begin function
-| Tac2interp.LtacError (kn, args) ->
+let print_raw_error kn args =
   let t_exn = KerName.make Tac2env.rocq_prefix (Id.of_string "exn") in
   let v = Tac2ffi.of_open (kn, args) in
   let t = GTypRef (Other t_exn, []) in
   let c = Tac2print.pr_valexpr (Global.env ()) Evd.empty v t in
-  Some (hov 0 (str "Uncaught Ltac2 exception:" ++ spc () ++ hov 0 c))
+  hov 0 (str "Uncaught Ltac2 exception:" ++ spc () ++ hov 0 c)
+
+let print_error kn args =
+  let env = Global.env() in
+  let sigma = Evd.from_env env in
+  let user_print = KerName.make Tac2quote.Refs.control_prefix (Id.of_string "print_exn") in
+  let user_print = Tac2interp.eval_global user_print in
+  let user_print = Tac2ffi.(to_fun1 of_exn (to_option to_pp)) user_print in
+  let user_print () =
+    let res, _, _, _, _ =
+    Proofview.apply ~name:(Id.of_string_soft "ltac2 error printing") ~poly:PolyFlags.default
+      env
+      (user_print (Tac2interp.LtacError (kn, args), Exninfo.null))
+      (snd @@ Proofview.init sigma [])
+    in
+    res
+  in
+  match user_print() with
+  | Some msg -> msg
+  | None -> print_raw_error kn args
+  | exception e when CErrors.noncritical e ->
+    let e = Exninfo.capture e in
+    let ppe = match e with
+      | Tac2interp.LtacError (kn', args'), _info ->
+        (* don't use iprint: high risk of looping *)
+        (* XXX print the info? currently CErrors.print_extra is not exposed *)
+        print_raw_error kn' args'
+      | _ -> CErrors.iprint e
+    in
+    print_raw_error kn args ++ fnl() ++
+    hov 2 (str "Custom Ltac2 printer failed:" ++ spc() ++ ppe)
+
+let () = register_handler begin function
+| Tac2interp.LtacError (kn, args) -> Some (print_error kn args)
 | _ -> None
 end
 
@@ -1442,10 +990,10 @@ let print_tacref ~print_def qid = function
     let data = Tac2env.interp_global kn in
     let info = Option.map fst (Tac2env.get_compiled_global kn) in
     print_constant ~print_def qid data ?info
-  | TacAlias kn ->
-    let { Tac2env.alias_body = body } = Tac2env.interp_alias kn in
+  | TacAbbrev kn ->
+    let { Tac2env.abbrev_body = body } = Tac2env.interp_abbrev kn in
     str "Notation" ++ spc() ++ pr_qualid qid ++ str " :=" ++ spc()
-    ++ Tac2print.pr_rawexpr_gen E5 ~avoid:Id.Set.empty body
+    ++ Tac2print.pr_glbexpr_gen E5 ~avoid:Id.Set.empty body
 
 let print_constructor qid kn =
   let cdata = Tac2env.interp_constructor kn in
@@ -1498,7 +1046,7 @@ let () =
     let hdr = match kn with
       | Type _ -> str "Ltac2 Type"
       | TacRef (TacConstant _) -> str "Ltac2"
-      | TacRef (TacAlias _) -> str "Ltac2 Notation"
+      | TacRef (TacAbbrev _) -> str "Ltac2 Notation"
       | Constructor _ -> str "Ltac2 Constructor"
     in
     hdr ++ spc () ++ pr_path (path_of_object kn)
@@ -1557,7 +1105,7 @@ let print_signatures () =
   Feedback.msg_notice (prlist_with_sep fnl pr_entry entries)
 
 let typecheck_expr e =
-  let e, (_,t) = Tac2intern.intern ~strict:false [] e in
+  let e, (_,t) = Tac2intern.intern ~strict:false UnivNames.empty_binders [] e in
   let name = int_name() in
   let pp =
     pr_glbexpr_gen E5 ~avoid:Id.Set.empty e ++ spc() ++
@@ -1567,14 +1115,15 @@ let typecheck_expr e =
 
 let globalize_expr e =
   let avoid = Id.Set.empty in
-  let e = Tac2intern.debug_globalize_allow_ext avoid e in
-  Feedback.msg_notice (Tac2print.pr_rawexpr_gen E5 ~avoid e)
+  let e, t, errors = Tac2intern.intern_accumulate_errors ~strict:false [] e in
+  (* XXX print type and errors? *)
+  Feedback.msg_notice (Tac2print.pr_glbexpr_gen E5 ~avoid e)
 
 (** Calling tactics *)
 
 let ltac2_interp e =
   let loc = e.loc in
-  let (e, t) = intern ~strict:false [] e in
+  let (e, t) = intern ~strict:false UnivNames.empty_binders [] e in
   let () = check_unit ?loc t in
   let tac = Tac2interp.interp Tac2interp.empty_environment e in
   Proofview.tclIGNORE tac
diff --git a/plugins/ltac2/tac2entries.mli b/plugins/ltac2/tac2entries.mli
index a85a76be09c3..38b494f4e67a 100644
--- a/plugins/ltac2/tac2entries.mli
+++ b/plugins/ltac2/tac2entries.mli
@@ -25,55 +25,23 @@ val import_type : qualid -> Id.t -> unit
 val register_primitive : ?deprecation:Deprecation.t -> ?local:bool ->
   Names.lident -> raw_typexpr -> ml_tactic_name -> unit
 
-val register_struct : Attributes.vernac_flags -> strexpr -> unit
-
-type notation_interpretation_data
-
-type notation_target = qualid option * int option
-
-val pr_register_notation : sexpr list -> notation_target -> raw_tacexpr -> Pp.t
+type ('scope,'body) notation_interpretation_data
 
 val pr_register_abbreviation : Id.t CAst.t -> raw_tacexpr -> Pp.t
 
 val register_notation : Attributes.vernac_flags -> sexpr list ->
-  notation_target -> raw_tacexpr -> notation_interpretation_data
+  Tac2syn.notation_target -> 'body -> (qualid option, 'body) notation_interpretation_data
 
 val register_abbreviation : Attributes.vernac_flags -> Id.t CAst.t ->
-  raw_tacexpr -> notation_interpretation_data
+  'body -> (_ option, 'body) notation_interpretation_data
 
-val register_notation_interpretation : notation_interpretation_data -> unit
+val register_notation_interpretation
+  : (qualid option, raw_tacexpr) notation_interpretation_data -> unit
 
-val register_custom_entry : lident -> unit
+val register_struct : Attributes.vernac_flags -> strexpr -> unit
 
 val perform_eval : pstate:Declare.Proof.t option -> raw_tacexpr -> unit
 
-(** {5 Notations} *)
-
-type syntax_class_rule =
-| SyntaxRule : (raw_tacexpr, _, 'a) Procq.Symbol.t * ('a -> raw_tacexpr) -> syntax_class_rule
-
-type used_levels
-
-val no_used_levels : used_levels
-
-val union_used_levels : used_levels -> used_levels -> used_levels
-
-type 'glb syntax_class_decl = {
-  intern_synclass : sexpr list -> used_levels * 'glb;
-  interp_synclass : 'glb -> syntax_class_rule;
-}
-
-val register_syntax_class : Id.t -> _ syntax_class_decl -> unit
-(** Create a new syntax class with the provided name *)
-
-type syntax_class
-
-val intern_syntax_class : sexpr -> used_levels * syntax_class
-(** Use this to internalize the syntax class arguments for interpretation functions *)
-
-val interp_syntax_class : syntax_class -> syntax_class_rule
-(** Use this to interpret the syntax class arguments for interpretation functions *)
-
 (** {5 Inspecting} *)
 
 val print_located_tactic : Libnames.qualid -> unit
@@ -92,14 +60,6 @@ val typecheck_expr : raw_tacexpr -> unit
 
 val globalize_expr : raw_tacexpr -> unit
 
-module Tac2Custom : module type of KerName
-
-module CustomTab : Nametab.NAMETAB with type elt = Tac2Custom.t
-
-val find_custom_entry : Tac2Custom.t -> raw_tacexpr Procq.Entry.t
-(** NB: Do not save the result of this function across summary resets,
-    the Entry.t gets regenerated on (parsing) summary unfreeze. *)
-
 (** {5 Eval loop} *)
 
 (** Evaluate a tactic expression in the current environment *)
diff --git a/plugins/ltac2/tac2env.ml b/plugins/ltac2/tac2env.ml
index 8dd95904820d..46ebb31b360b 100644
--- a/plugins/ltac2/tac2env.ml
+++ b/plugins/ltac2/tac2env.ml
@@ -37,9 +37,11 @@ type projection_data = {
   pdata_indx : int;
 }
 
-type alias_data = {
-  alias_body : raw_tacexpr;
-  alias_depr : Deprecation.t option;
+type abbrev_data = {
+  abbrev_prms : int;
+  abbrev_ty : int glb_typexpr;
+  abbrev_body : glb_tacexpr;
+  abbrev_depr : Deprecation.t option;
 }
 
 type ltac_state = {
@@ -47,7 +49,7 @@ type ltac_state = {
   ltac_constructors : constructor_data KerName.Map.t;
   ltac_projections : projection_data KerName.Map.t;
   ltac_types : glb_quant_typedef KerName.Map.t;
-  ltac_aliases : alias_data KerName.Map.t;
+  ltac_abbrevs : abbrev_data KerName.Map.t;
 }
 
 let empty_state = {
@@ -55,7 +57,7 @@ let empty_state = {
   ltac_constructors = KerName.Map.empty;
   ltac_projections = KerName.Map.empty;
   ltac_types = KerName.Map.empty;
-  ltac_aliases = KerName.Map.empty;
+  ltac_abbrevs = KerName.Map.empty;
 }
 
 type compile_info = {
@@ -66,17 +68,6 @@ let ltac_state = Summary.ref empty_state ~name:"ltac2-state"
 
 let compiled_tacs = Summary.ref ~local:true ~name:"ltac2-compiled-state" KerName.Map.empty
 
-type notation_data =
-  | UntypedNota of raw_tacexpr
-  | TypedNota of {
-      nota_prms : int;
-      nota_argtys : int glb_typexpr Id.Map.t;
-      nota_ty : int glb_typexpr;
-      nota_body : glb_tacexpr;
-    }
-
-let ltac_notations = Summary.ref KerName.Map.empty ~name:"ltac2-notations"
-
 let define_global kn e =
   let state = !ltac_state in
   ltac_state := { state with ltac_tactics = KerName.Map.add kn e state.ltac_tactics }
@@ -117,17 +108,11 @@ let define_type kn e =
 
 let interp_type kn = KerName.Map.find kn ltac_state.contents.ltac_types
 
-let define_alias ?deprecation kn tac =
+let define_abbrev kn data =
   let state = !ltac_state in
-  let data = { alias_body = tac; alias_depr = deprecation } in
-  ltac_state := { state with ltac_aliases = KerName.Map.add kn data state.ltac_aliases }
-
-let interp_alias kn = KerName.Map.find kn ltac_state.contents.ltac_aliases
+  ltac_state := { state with ltac_abbrevs = KerName.Map.add kn data state.ltac_abbrevs }
 
-let define_notation kn tac =
-  ltac_notations := KerName.Map.add kn tac !ltac_notations
-
-let interp_notation kn = KerName.Map.find kn !ltac_notations
+let interp_abbrev kn = KerName.Map.find kn ltac_state.contents.ltac_abbrevs
 
 module ML =
 struct
@@ -154,16 +139,16 @@ let interp_primitive name = MLMap.find name !primitive_map
 
 type tacref = Tac2expr.tacref =
 | TacConstant of ltac_constant
-| TacAlias of ltac_alias
+| TacAbbrev of ltac_abbrev
 
 module TacRef =
 struct
 type t = tacref
 let compare r1 r2 = match r1, r2 with
 | TacConstant c1, TacConstant c2 -> KerName.compare c1 c2
-| TacAlias c1, TacAlias c2 -> KerName.compare c1 c2
-| TacConstant _, TacAlias _ -> -1
-| TacAlias _, TacConstant _ -> 1
+| TacAbbrev c1, TacAbbrev c2 -> KerName.compare c1 c2
+| TacConstant _, TacAbbrev _ -> -1
+| TacAbbrev _, TacConstant _ -> 1
 
 let equal r1 r2 = compare r1 r2 == 0
 end
@@ -306,12 +291,9 @@ type var_quotation_kind =
   | PatternVar
   | HypVar
 
-let wit_ltac2_constr = Genarg.make0 "ltac2:in-constr"
-let wit_ltac2_var_quotation = Genarg.make0 "ltac2:quotation"
-let wit_ltac2_tac = Genarg.make0 "ltac2:tactic"
-
-let () = Geninterp.register_val0 wit_ltac2_tac
-    (Some (Geninterp.val_tag (Genarg.topwit Stdarg.wit_unit)))
+let wit_ltac2_constr = GenConstr.create "ltac2:in-constr"
+let wit_ltac2_var_quotation = GenConstr.create "ltac2:quotation"
+let wit_ltac2_tac = Gentactic.make "ltac2:tactic"
 
 let is_constructor_id id =
   let id = Id.to_string id in
diff --git a/plugins/ltac2/tac2env.mli b/plugins/ltac2/tac2env.mli
index 11c16b53ca14..e57ddf02887e 100644
--- a/plugins/ltac2/tac2env.mli
+++ b/plugins/ltac2/tac2env.mli
@@ -8,7 +8,6 @@
 (*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
-open Genarg
 open Names
 open Libnames
 open Nametab
@@ -84,30 +83,17 @@ type projection_data = {
 val define_projection : ltac_projection -> projection_data -> unit
 val interp_projection : ltac_projection -> projection_data
 
-(** {5 Toplevel definition of aliases} *)
+(** {5 Toplevel definition of abbreviations} *)
 
-type alias_data = {
-  alias_body : raw_tacexpr;
-  alias_depr : Deprecation.t option;
+type abbrev_data = {
+  abbrev_prms : int;
+  abbrev_ty : int glb_typexpr;
+  abbrev_body : glb_tacexpr;
+  abbrev_depr : Deprecation.t option;
 }
 
-val define_alias : ?deprecation:Deprecation.t -> ltac_constant -> raw_tacexpr -> unit
-val interp_alias : ltac_constant -> alias_data
-
-(** {5 Toplevel definition of notations} *)
-
-(* no deprecation info: deprecation warning is emitted by the parser *)
-type notation_data =
-  | UntypedNota of raw_tacexpr
-  | TypedNota of {
-      nota_prms : int;
-      nota_argtys : int glb_typexpr Id.Map.t;
-      nota_ty : int glb_typexpr;
-      nota_body : glb_tacexpr;
-    }
-
-val define_notation : ltac_notation -> notation_data -> unit
-val interp_notation : ltac_notation -> notation_data
+val define_abbrev : ltac_constant -> abbrev_data -> unit
+val interp_abbrev : ltac_constant -> abbrev_data
 
 (** {5 Name management} *)
 
@@ -181,10 +167,10 @@ val ltac1_prefix : ModPath.t
 
 (** {5 Generic arguments} *)
 
-val wit_ltac2_constr : (raw_tacexpr, Id.Set.t * glb_tacexpr, Util.Empty.t) genarg_type
+val wit_ltac2_constr : (raw_tacexpr, Id.Set.t * glb_tacexpr) GenConstr.tag
 (** Ltac2 quotations in Gallina terms *)
 
-val wit_ltac2_tac : (raw_tacexpr, glb_tacexpr, unit) genarg_type
+val wit_ltac2_tac : (raw_tacexpr, glb_tacexpr) Gentactic.tag
 (** Ltac2 as a generic tactic depending on proof mode (eg as argument to Solve Obligations) *)
 
 type var_quotation_kind =
@@ -193,7 +179,7 @@ type var_quotation_kind =
   | PatternVar
   | HypVar
 
-val wit_ltac2_var_quotation : (lident option * lident, var_quotation_kind * Id.t, Util.Empty.t) genarg_type
+val wit_ltac2_var_quotation : (lident option * lident, var_quotation_kind * Id.t) GenConstr.tag
 (** Ltac2 quotations for variables "$x" or "$kind:foo" in Gallina terms.
     NB: "$x" means "$constr:x" *)
 
diff --git a/plugins/ltac2/tac2expr.mli b/plugins/ltac2/tac2expr.mli
index 724c3a791875..18bd7533149e 100644
--- a/plugins/ltac2/tac2expr.mli
+++ b/plugins/ltac2/tac2expr.mli
@@ -18,7 +18,7 @@ type lid = Id.t
 type uid = Id.t
 
 type ltac_constant = KerName.t
-type ltac_alias = KerName.t
+type ltac_abbrev = KerName.t
 type ltac_notation = KerName.t
 type ltac_constructor = KerName.t
 type ltac_projection = KerName.t
@@ -26,7 +26,7 @@ type type_constant = KerName.t
 
 type tacref =
 | TacConstant of ltac_constant
-| TacAlias of ltac_alias
+| TacAbbrev of ltac_abbrev
 
 type 'a or_relid =
 | RelId of qualid
@@ -157,13 +157,17 @@ type raw_patexpr_r =
 
 and raw_patexpr = raw_patexpr_r CAst.t
 
+(** This type is equated with a specific type using Obj.magic, not
+    sure if there's a better solution. *)
+type tacsyn
+
 type raw_tacexpr_r =
 | CTacAtm of atom
 | CTacRef of tacref or_relid
 | CTacCst of ltac_constructor or_tuple or_relid
 | CTacFun of raw_patexpr list * raw_tacexpr
 | CTacApp of raw_tacexpr * raw_tacexpr list
-| CTacSyn of (lname * raw_tacexpr) list * KerName.t
+| CTacSyn of tacsyn
 | CTacLet of rec_flag * (raw_patexpr * raw_tacexpr) list * raw_tacexpr
 | CTacCnv of raw_tacexpr * raw_typexpr
 | CTacSeq of raw_tacexpr * raw_tacexpr
@@ -173,7 +177,7 @@ type raw_tacexpr_r =
 | CTacPrj of raw_tacexpr * ltac_projection or_relid
 | CTacSet of raw_tacexpr * ltac_projection or_relid * raw_tacexpr
 | CTacExt : ('a, _) Tac2dyn.Arg.tag * 'a -> raw_tacexpr_r
-| CTacGlb of int * (lname * raw_tacexpr * int glb_typexpr option) list * glb_tacexpr * int glb_typexpr
+| CTacGlb of int * (Name.t * raw_tacexpr * int glb_typexpr option) list * glb_tacexpr * int glb_typexpr
 (** CTacGlb is essentially an expanded typed notation.
     Arguments bound with Anonymous have no type constraint. *)
 
diff --git a/plugins/ltac2/tac2extravals.ml b/plugins/ltac2/tac2extravals.ml
index a2dc2a353699..14756530b72f 100644
--- a/plugins/ltac2/tac2extravals.ml
+++ b/plugins/ltac2/tac2extravals.ml
@@ -11,7 +11,6 @@
 open Util
 open Pp
 open Names
-open Genarg
 open Tac2ffi
 open Tac2env
 open Tac2expr
@@ -34,8 +33,8 @@ let gtypref kn = GTypRef (Other kn, [])
 
 let of_glob_constr (c:Glob_term.glob_constr) =
   match DAst.get c with
-  | GGenarg (GenArg (Glbwit tag, v)) ->
-    begin match genarg_type_eq tag wit_ltac2_var_quotation with
+  | GGenarg (Glb (tag, v)) ->
+    begin match GenConstr.eq tag wit_ltac2_var_quotation with
     | Some Refl ->
       begin match (fst v) with
       | ConstrVar -> GlbTacexpr (GTacVar (snd v))
@@ -46,14 +45,8 @@ let of_glob_constr (c:Glob_term.glob_constr) =
   | _ -> GlbVal c
 
 let intern_constr ist c =
-  let {Genintern.ltacvars=lfun; genv=env; extra; intern_sign; strict_check} = ist in
   let scope = Pretyping.WithoutTypeConstraint in
-  let ltacvars = {
-    Constrintern.ltac_vars = lfun;
-    ltac_bound = Id.Set.empty;
-    ltac_extra = extra;
-  } in
-  let c' = Constrintern.intern_core scope ~strict_check ~ltacvars env (Evd.from_env env) intern_sign c in
+  let c' = Constrintern.intern_core scope ist c in
   c'
 
 let intern_constr_tacexpr ist c =
@@ -268,7 +261,8 @@ let () =
     | Some ty -> sigma, ty
     | None -> GlobEnv.new_type_evar env sigma ~src:(loc,Evar_kinds.InternalHole)
     in
-    let c, sigma = Subproof.refine_by_tactic ~name ~poly (GlobEnv.renamed_env env) sigma concl tac in
+    let inline = Abstract.get_inline_abstract_subproof () in
+    let c, sigma = Subproof.refine_by_tactic ~inline ~name ~poly (GlobEnv.renamed_env env) sigma concl tac in
     let j = { Environ.uj_val = c; Environ.uj_type = concl } in
     (j, sigma)
   in
@@ -354,10 +348,9 @@ let () =
   let interp _ist tac =
     (* XXX should we be doing something with the ist? *)
     let tac = Tac2interp.(interp empty_environment) tac in
-    Proofview.tclBIND tac (fun _ ->
-        Ftactic.return (Geninterp.Val.inject (Geninterp.val_tag (topwit Stdarg.wit_unit)) ()))
+    Proofview.tclIGNORE tac
   in
-  Geninterp.register_interp0 wit_ltac2_tac interp
+  Gentactic.register_interp wit_ltac2_tac interp
 
 let () =
   let interp env sigma ist (kind,id) =
@@ -391,7 +384,7 @@ let () =
         | HypVar -> str "hyp:"
       in
       str "$" ++ ppkind ++ Id.print id) in
-  Genprint.register_noval_print0 wit_ltac2_var_quotation pr_raw pr_glb
+  Genprint.register_constr_print wit_ltac2_var_quotation pr_raw pr_glb
 
 let () =
   let subs ntnvars globs (ids, tac as orig) =
@@ -419,7 +412,6 @@ let () =
   let pr_raw e = Genprint.PrinterBasic (fun _env _sigma ->
       let avoid = Id.Set.empty in
       (* FIXME avoid set, same as pr_glb *)
-      let e = Tac2intern.debug_globalize_allow_ext avoid e in
       Tac2print.pr_rawexpr_gen ~avoid E5 e) in
   let pr_glb (ids, e) =
     let ids =
@@ -435,25 +427,23 @@ let () =
     *)
     Genprint.PrinterBasic Pp.(fun _env _sigma -> ids ++ Tac2print.pr_glbexpr ~avoid:Id.Set.empty e)
   in
-  Genprint.register_noval_print0 wit_ltac2_constr pr_raw pr_glb
+  Genprint.register_constr_print wit_ltac2_constr pr_raw pr_glb
 
 let () =
   let pr_raw e = Genprint.PrinterBasic (fun _ _ ->
-      let e = Tac2intern.debug_globalize_allow_ext Id.Set.empty e in
       Tac2print.pr_rawexpr_gen ~avoid:Id.Set.empty E5 e)
   in
   let pr_glb e = Genprint.PrinterBasic (fun _ _ -> Tac2print.pr_glbexpr ~avoid:Id.Set.empty e) in
-  let pr_top () = assert false in
-  Genprint.register_print0 wit_ltac2_tac pr_raw pr_glb pr_top
+  Gentactic.register_print wit_ltac2_tac pr_raw pr_glb
 
 (** Built-in notation entries *)
 
 let add_syntax_class_full s f =
-  Tac2entries.register_syntax_class (Id.of_string s) f
+  Tac2syn.register_syntax_class (Id.of_string s) f
 
 let add_syntax_class s intern f =
   add_syntax_class_full s {
-    intern_synclass = (fun s -> Tac2entries.no_used_levels, intern s);
+    intern_synclass = (fun s -> Tac2syn.no_used_levels, intern s);
     interp_synclass = (fun s -> f s);
   }
 
@@ -463,16 +453,23 @@ let syntax_class_fail s args =
 
 let q_unit = CAst.make @@ CTacCst (AbsKn (Tuple 0))
 
-let add_expr_syntax_class name entry f =
+module TacSyn = Tac2syn.Syntax
+
+let add_expr_syntax_class0 name entry f =
   add_syntax_class name begin function
   | [] -> ()
   | arg -> syntax_class_fail name arg
   end begin fun () ->
-    Tac2entries.SyntaxRule (Procq.Symbol.nterm entry, f)
+    Tac2syn.SyntaxRule (TacSyn.nterm entry, f)
   end
 
+let add_expr_syntax_class name entry f =
+  (* XXX name for register_entry? *)
+  let entry = Tac2syn.Syntax.register_entry entry in
+  add_expr_syntax_class0 name entry f
+
 let add_generic_syntax_class s entry arg =
-  add_expr_syntax_class s entry (fun x -> CAst.make @@ CTacExt (arg, x))
+  add_expr_syntax_class0 s entry (fun x -> CAst.make @@ CTacExt (arg, x))
 
 open CAst
 
@@ -480,85 +477,83 @@ let () = add_syntax_class "keyword" begin function
 | [SexprStr {loc;v=s}] -> s
 | arg -> syntax_class_fail "keyword" arg
   end begin fun s ->
-    let syntax_class = Procq.Symbol.token (Tok.PKEYWORD s) in
-    Tac2entries.SyntaxRule (syntax_class, (fun _ -> q_unit))
+    let syntax_class = TacSyn.token (Tok.PKEYWORD s) in
+    Tac2syn.SyntaxRule (syntax_class, (fun _ -> q_unit))
   end
 
 let () = add_syntax_class "terminal" begin function
 | [SexprStr {loc;v=s}] -> s
 | arg -> syntax_class_fail "terminal" arg
   end begin fun s ->
-    let syntax_class = Procq.Symbol.token (CLexer.terminal s) in
-    Tac2entries.SyntaxRule (syntax_class, (fun _ -> q_unit))
+    let syntax_class = TacSyn.token (CLexer.terminal s) in
+    Tac2syn.SyntaxRule (syntax_class, (fun _ -> q_unit))
   end
 
 let () = add_syntax_class_full "list0" {
   intern_synclass = begin function
   | [tok] ->
-    let used, subclass = Tac2entries.intern_syntax_class tok in
+    let used, subclass = Tac2syn.intern_syntax_class tok in
     used, (subclass, None)
   | [tok; SexprStr {v=str}] ->
-    let used, subclass = Tac2entries.intern_syntax_class tok in
+    let used, subclass = Tac2syn.intern_syntax_class tok in
     used, (subclass, Some str)
   | arg -> syntax_class_fail "list0" arg
   end;
   interp_synclass = begin function
   | subclass, None ->
-    let Tac2entries.SyntaxRule (syntax_class, act) = Tac2entries.interp_syntax_class subclass in
-    let syntax_class = Procq.Symbol.list0 syntax_class in
+    let Tac2syn.SyntaxRule (syntax_class, act) = Tac2syn.interp_syntax_class subclass in
+    let syntax_class = TacSyn.list0 syntax_class in
     let act l = Tac2quote.of_list act l in
-    Tac2entries.SyntaxRule (syntax_class, act)
-  | subclass, Some str ->
-    let Tac2entries.SyntaxRule (syntax_class, act) = Tac2entries.interp_syntax_class subclass in
-    let sep = Procq.Symbol.tokens [Procq.TPattern (CLexer.terminal str)] in
-    let syntax_class = Procq.Symbol.list0sep syntax_class sep in
+    Tac2syn.SyntaxRule (syntax_class, act)
+  | subclass, Some sep ->
+    let Tac2syn.SyntaxRule (syntax_class, act) = Tac2syn.interp_syntax_class subclass in
+    let syntax_class = TacSyn.list0 syntax_class ~sep in
     let act l = Tac2quote.of_list act l in
-    Tac2entries.SyntaxRule (syntax_class, act)
+    Tac2syn.SyntaxRule (syntax_class, act)
   end;
 }
 
 let () = add_syntax_class_full "list1" {
   intern_synclass = begin function
   | [tok] ->
-    let used, subclass = Tac2entries.intern_syntax_class tok in
+    let used, subclass = Tac2syn.intern_syntax_class tok in
     used, (subclass, None)
   | [tok; SexprStr {v=str}] ->
-    let used, subclass = Tac2entries.intern_syntax_class tok in
+    let used, subclass = Tac2syn.intern_syntax_class tok in
     used, (subclass, Some str)
   | arg -> syntax_class_fail "list1" arg
   end;
   interp_synclass = begin function
   | subclass, None ->
-    let Tac2entries.SyntaxRule (syntax_class, act) = Tac2entries.interp_syntax_class subclass in
-    let syntax_class = Procq.Symbol.list1 syntax_class in
+    let Tac2syn.SyntaxRule (syntax_class, act) = Tac2syn.interp_syntax_class subclass in
+    let syntax_class = TacSyn.list1 syntax_class in
     let act l = Tac2quote.of_list act l in
-    Tac2entries.SyntaxRule (syntax_class, act)
-  | subclass, Some str ->
-    let Tac2entries.SyntaxRule (syntax_class, act) = Tac2entries.interp_syntax_class subclass in
-    let sep = Procq.Symbol.tokens [Procq.TPattern (CLexer.terminal str)] in
-    let syntax_class = Procq.Symbol.list1sep syntax_class sep in
+    Tac2syn.SyntaxRule (syntax_class, act)
+  | subclass, Some sep ->
+    let Tac2syn.SyntaxRule (syntax_class, act) = Tac2syn.interp_syntax_class subclass in
+    let syntax_class = TacSyn.list1 syntax_class ~sep in
     let act l = Tac2quote.of_list act l in
-    Tac2entries.SyntaxRule (syntax_class, act)
+    Tac2syn.SyntaxRule (syntax_class, act)
   end;
 }
 
 let () = add_syntax_class_full "opt" {
   intern_synclass = begin function
   | [tok] ->
-    let used, subclass = Tac2entries.intern_syntax_class tok in
+    let used, subclass = Tac2syn.intern_syntax_class tok in
     used, subclass
   | arg -> syntax_class_fail "opt" arg
   end;
   interp_synclass = begin fun subclass ->
-    let Tac2entries.SyntaxRule (syntax_class, act) = Tac2entries.interp_syntax_class subclass in
-    let syntax_class = Procq.Symbol.opt syntax_class in
+    let Tac2syn.SyntaxRule (syntax_class, act) = Tac2syn.interp_syntax_class subclass in
+    let syntax_class = TacSyn.opt syntax_class in
     let act opt = match opt with
       | None ->
         CAst.make @@ CTacCst (AbsKn (Other c_none))
       | Some x ->
         CAst.make @@ CTacApp (CAst.make @@ CTacCst (AbsKn (Other c_some)), [act x])
     in
-    Tac2entries.SyntaxRule (syntax_class, act)
+    Tac2syn.SyntaxRule (syntax_class, act)
   end;
 }
 
@@ -566,18 +561,18 @@ let () = add_syntax_class "self" begin function
   | [] -> ()
   | arg -> syntax_class_fail "self" arg
   end begin fun () ->
-    let syntax_class = Procq.Symbol.self in
+    let syntax_class = TacSyn.self in
     let act tac = tac in
-    Tac2entries.SyntaxRule (syntax_class, act)
+    Tac2syn.SyntaxRule (syntax_class, act)
   end
 
 let () = add_syntax_class "next" begin function
   | [] -> ()
   | arg -> syntax_class_fail "next" arg
   end begin fun () ->
-    let syntax_class = Procq.Symbol.next in
+    let syntax_class = TacSyn.next in
     let act tac = tac in
-    Tac2entries.SyntaxRule (syntax_class, act)
+    Tac2syn.SyntaxRule (syntax_class, act)
   end
 
 let () = add_syntax_class "tactic" begin function
@@ -589,22 +584,22 @@ let () = add_syntax_class "tactic" begin function
     n
   | arg -> syntax_class_fail "tactic" arg
   end begin fun lev ->
-    let syntax_class = Procq.Symbol.nterml ltac2_expr (string_of_int lev) in
+    let syntax_class = TacSyn.nterml TacSyn.ltac2_expr (string_of_int lev) in
     let act tac = tac in
-    Tac2entries.SyntaxRule (syntax_class, act)
+    Tac2syn.SyntaxRule (syntax_class, act)
   end
 
 let () = add_syntax_class_full "thunk" {
   intern_synclass = begin function
   | [tok] ->
-    let used, subclass = Tac2entries.intern_syntax_class tok in
+    let used, subclass = Tac2syn.intern_syntax_class tok in
     used, subclass
   | arg -> syntax_class_fail "thunk" arg
   end;
   interp_synclass = begin fun subclass ->
-    let Tac2entries.SyntaxRule (syntax_class, act) = Tac2entries.interp_syntax_class subclass in
+    let Tac2syn.SyntaxRule (syntax_class, act) = Tac2syn.interp_syntax_class subclass in
     let act e = Tac2quote.thunk (act e) in
-    Tac2entries.SyntaxRule (syntax_class, act)
+    Tac2syn.SyntaxRule (syntax_class, act)
   end;
 }
 
@@ -616,7 +611,7 @@ let warn_unqualified_delimiters =
   CWarnings.create_in w
     Pp.(fun (s,delims) ->
         let delims () = prlist_with_sep pr_comma Id.print @@ List.rev delims in
-        fmt "Delimiter arguments to %s must be qualified using \"delimiters\"@
+        fmt "Delimiter arguments to %s must be qualified using \"delimiters\"@\n\
 (e.g. \"%s(delimiters(%t))\")@ unless there is a unique delimiter argument." s s delims)
 
 let delimiters_qid = Libnames.qualid_of_string "delimiters"
@@ -684,27 +679,27 @@ let constr_args s arg =
   (lev, custom), scopes
 
 let constr_symb (lev,custom) =
-  let custom = Option.map (fun custom -> fst @@ Egramrocq.find_custom_entry custom) custom in
+  let custom = Option.map (fun custom -> TacSyn.custom_constr custom) custom in
   match lev, custom with
-  | None, None -> Procq.Symbol.nterm Procq.Constr.constr
-  | Some lev, None -> Procq.Symbol.nterml Procq.Constr.term lev
-  | None, Some custom -> Procq.Symbol.nterm custom
+  | None, None -> TacSyn.nterm TacSyn.constr
+  | Some lev, None -> TacSyn.nterml TacSyn.term lev
+  | None, Some custom -> TacSyn.nterm custom
   | Some lev, Some custom ->
-    Procq.Symbol.nterml custom lev
+    TacSyn.nterml custom lev
 
 let add_constr_classes (name,lname) quote =
   let () =
     let s = name in
     add_syntax_class s (constr_args s) begin function (symb,delimiters) ->
       let act e = quote ?delimiters:(Some delimiters) e in
-      Tac2entries.SyntaxRule (constr_symb symb, act)
+      Tac2syn.SyntaxRule (constr_symb symb, act)
     end
   in
   let () =
     let s = lname in
     add_syntax_class s (constr_delimiters s) begin function delimiters ->
       let act e = quote ?delimiters:(Some delimiters) e in
-      Tac2entries.SyntaxRule (Procq.Symbol.nterm Procq.Constr.lconstr, act)
+      Tac2syn.SyntaxRule (TacSyn.nterm TacSyn.lconstr, act)
     end
   in
   ()
@@ -739,56 +734,41 @@ let () = add_expr_syntax_class "goal_matching" q_goal_matching Tac2quote.of_goal
 let () = add_expr_syntax_class "format" Procq.Prim.lstring Tac2quote.of_format
 let () = add_expr_syntax_class "module" Procq.Prim.qualid Tac2quote.of_module
 
-let () = add_generic_syntax_class "pattern" Procq.Constr.constr Tac2quote.wit_pattern
-
-(** seq syntax_class, a bit hairy *)
+let () = add_generic_syntax_class "pattern" Tac2syn.Syntax.constr Tac2quote.wit_pattern
 
-open Procq
+(** seq syntax class, a bit hairy. *)
 
-type _ converter =
-| CvNil : (Loc.t -> raw_tacexpr) converter
-| CvCns : 'act converter * ('a -> raw_tacexpr) option -> ('a -> 'act) converter
+type seqrule = SeqRule : 'a TacSyn.seq * ('a -> raw_tacexpr list) -> seqrule
 
-let rec apply : type a. a converter -> raw_tacexpr list -> a = function
-| CvNil -> fun accu loc -> Tac2quote.of_tuple ~loc accu
-| CvCns (c, None) -> fun accu x -> apply c accu
-| CvCns (c, Some f) -> fun accu x -> apply c (f x :: accu)
-
-type seqrule =
-| Seqrule : (Tac2expr.raw_tacexpr, Gramlib.Grammar.norec, 'act, Loc.t -> raw_tacexpr) Rule.t * 'act converter -> seqrule
-
-let rec make_seq_rule = function
-| [] ->
-  Seqrule (Procq.Rule.stop, CvNil)
-| (skip,tok) :: rem ->
-  let Tac2entries.SyntaxRule (syntax_class, f) = Tac2entries.interp_syntax_class tok in
-  let syntax_class =
-    match Procq.generalize_symbol syntax_class with
-    | None ->
-      CErrors.user_err (str "Recursive symbols (self / next) are not allowed in local rules")
-    | Some syntax_class -> syntax_class
-  in
-  let Seqrule (r, c) = make_seq_rule rem in
-  let r = Procq.Rule.next_norec r syntax_class in
-  let f = if skip then None else Some f in
-  Seqrule (r, CvCns (c, f))
+let rec interp_seq_rule = function
+  | [] ->
+    SeqRule (TacSyn.nil, (fun () -> []))
+  | (skipx,synx) :: rest ->
+    let SeqRule (synrest, frest) = interp_seq_rule rest in
+    let Tac2syn.SyntaxRule (synx, fx) = Tac2syn.interp_syntax_class synx in
+    let f (rest, x) =
+      if skipx then frest rest
+      else
+        let x = fx x in
+        let rest = frest rest in
+        x :: rest
+    in
+    SeqRule (TacSyn.snoc synrest synx, f)
 
 let interp_seq_rule toks =
-  let Seqrule (r, c) = make_seq_rule (List.rev toks) in
-  let syntax_class =
-    Procq.(Symbol.rules [Rules.make r (apply c [])])
-  in
-  Tac2entries.SyntaxRule (syntax_class, (fun e -> e))
+  let SeqRule (syn, f) = interp_seq_rule (List.rev toks) in
+  let f x = Tac2quote.of_tuple @@ List.rev @@ f x in
+  Tac2syn.SyntaxRule (TacSyn.seq syn, f)
 
 let intern_seq_rule toks =
   List.fold_left_map (fun used tok ->
-      let used', rule = Tac2entries.intern_syntax_class tok in
+      let used', rule = Tac2syn.intern_syntax_class tok in
       let skip = match tok with
         | SexprStr _ -> true (* Leave out mere strings *)
         | _ -> false
       in
-      Tac2entries.union_used_levels used used', (skip, rule))
-    Tac2entries.no_used_levels
+      Tac2syn.union_used_levels used used', (skip, rule))
+    Tac2syn.no_used_levels
     toks
 
 let () = add_syntax_class_full "seq" {
diff --git a/plugins/ltac2/tac2ffi.ml b/plugins/ltac2/tac2ffi.ml
index 82f290c2bea4..9cb5bb22ca47 100644
--- a/plugins/ltac2/tac2ffi.ml
+++ b/plugins/ltac2/tac2ffi.ml
@@ -70,6 +70,7 @@ let val_reduction = Val.create "reduction"
 let val_rewstrategy = Val.create "rewstrategy"
 let val_modpath = Val.create "modpath"
 let val_module_field = Val.create "module_field"
+let val_scheme_kind : string Val.tag = Val.create "scheme_kind"
 
 let extract_val (type a) (type b) (tag : a Val.tag) (tag' : b Val.tag) (v : b) : a =
 match Val.eq tag tag' with
@@ -204,6 +205,23 @@ let fun2 arg1 arg2 res = {
   r_to = to_fun2 arg1.r_of arg2.r_of res.r_to;
 }
 
+type ('a, 'b, 'c, 'd) fun3 = 'a -> 'b -> 'c -> 'd Proofview.tactic
+
+let of_fun3 to_arg1 to_arg2 to_arg3 of_res f =
+  of_closure (mk_closure (arity_suc (arity_suc arity_one)) (fun x y z ->
+      Proofview.Monad.map of_res @@
+      f (to_arg1 x) (to_arg2 y) (to_arg3 z)))
+
+let to_fun3 of_arg1 of_arg2 of_arg3 to_res f x y z =
+  Proofview.Monad.map to_res @@
+  apply (to_closure f) [of_arg1 x; of_arg2 y; of_arg3 z]
+
+let fun3 arg1 arg2 arg3 res = {
+  r_of = of_fun3 arg1.r_to arg2.r_to arg3.r_to res.r_of;
+  r_to = to_fun3 arg1.r_of arg2.r_of arg3.r_of res.r_to;
+}
+
+
 let of_ext tag c =
   ValExt (tag, c)
 
@@ -260,21 +278,6 @@ let rocq_core n = Names.(KerName.make Tac2env.rocq_prefix (Id.of_string_soft n))
 
 let internal_err = rocq_core "Internal"
 
-let err_notfocussed =
-  LtacError (rocq_core "Not_focussed", [||])
-
-let err_outofbounds =
-  LtacError (rocq_core "Out_of_bounds", [||])
-
-let err_notfound =
-  LtacError (rocq_core "Not_found", [||])
-
-let err_matchfailure =
-  LtacError (rocq_core "Match_failure", [||])
-
-let err_division_by_zero =
-  LtacError (rocq_core "Division_by_zero", [||])
-
 let of_exninfo = of_ext val_exninfo
 let to_exninfo = to_ext val_exninfo
 
@@ -475,6 +478,10 @@ let of_modpath c = of_ext val_modpath c
 let to_modpath c = to_ext val_modpath c
 let modpath = repr_ext val_modpath
 
+let of_scheme_kind c = of_ext val_scheme_kind c
+let to_scheme_kind c = to_ext val_scheme_kind c
+let scheme_kind = repr_ext val_scheme_kind
+
 let of_module_field c = of_ext val_module_field c
 let to_module_field c = to_ext val_module_field c
 let module_field = repr_ext val_module_field
@@ -497,3 +504,37 @@ let reference = {
   r_of = of_reference;
   r_to = to_reference;
 }
+
+let of_strategy_level = let open Conv_oracle in function
+| Expand -> ValInt 0
+| Opaque -> ValInt 1
+| Level n -> ValBlk (0, [| of_int n |])
+
+let to_strategy_level = let open Conv_oracle in function
+| ValInt 0 -> Expand
+| ValInt 1 -> Opaque
+| ValBlk (0, [| n |]) -> Level (to_int n)
+| _ -> assert false
+
+let strategy_level = {
+  r_of = of_strategy_level;
+  r_to = to_strategy_level;
+}
+
+let err_notfocussed =
+  LtacError (rocq_core "Not_focussed", [||])
+
+let err_outofbounds =
+  LtacError (rocq_core "Out_of_bounds", [||])
+
+let err_notfound =
+  LtacError (rocq_core "Not_found", [||])
+
+let err_matchfailure =
+  LtacError (rocq_core "Match_failure", [||])
+
+let err_division_by_zero =
+  LtacError (rocq_core "Division_by_zero", [||])
+
+let err_invalid_arg msg =
+  LtacError (rocq_core "Invalid_argument", [|of_option of_pp (Some msg)|])
diff --git a/plugins/ltac2/tac2ffi.mli b/plugins/ltac2/tac2ffi.mli
index dd9627584419..93b8f67ea58d 100644
--- a/plugins/ltac2/tac2ffi.mli
+++ b/plugins/ltac2/tac2ffi.mli
@@ -113,6 +113,12 @@ val of_fun2 : (valexpr -> 'a) -> (valexpr -> 'b) -> ('c -> valexpr) -> ('a, 'b,
 val to_fun2 : ('a -> valexpr) -> ('b -> valexpr) -> (valexpr -> 'c) -> valexpr -> ('a, 'b, 'c) fun2
 val fun2 : 'a repr -> 'b repr -> 'c repr -> ('a, 'b, 'c) fun2 repr
 
+type ('a, 'b, 'c, 'd) fun3 = 'a -> 'b -> 'c -> 'd Proofview.tactic
+
+val of_fun3 : (valexpr -> 'a) -> (valexpr -> 'b) -> (valexpr -> 'c) -> ('d -> valexpr) -> ('a, 'b, 'c, 'd) fun3 -> valexpr
+val to_fun3 : ('a -> valexpr) -> ('b -> valexpr) -> ('c -> valexpr) -> (valexpr -> 'd) -> valexpr -> ('a, 'b, 'c, 'd) fun3
+val fun3 : 'a repr -> 'b repr -> 'c repr -> 'd repr -> ('a, 'b, 'c, 'd) fun3 repr
+
 val of_block : (int * valexpr array) -> valexpr
 val to_block : valexpr -> (int * valexpr array)
 val block : (int * valexpr array) repr
@@ -216,10 +222,18 @@ val of_reference : GlobRef.t -> valexpr
 val to_reference : valexpr -> GlobRef.t
 val reference : GlobRef.t repr
 
+val of_strategy_level : Conv_oracle.level -> valexpr
+val to_strategy_level : valexpr -> Conv_oracle.level
+val strategy_level : Conv_oracle.level repr
+
 val of_modpath : ModPath.t -> valexpr
 val to_modpath : valexpr -> ModPath.t
 val modpath : ModPath.t repr
 
+val of_scheme_kind : string -> valexpr
+val to_scheme_kind : valexpr -> string
+val scheme_kind : string repr
+
 module ModField : sig
   type t =
     | Ref of GlobRef.t
@@ -269,3 +283,4 @@ val err_outofbounds : exn
 val err_notfound : exn
 val err_matchfailure : exn
 val err_division_by_zero : exn
+val err_invalid_arg : Pp.t -> exn
diff --git a/plugins/ltac2/tac2intern.ml b/plugins/ltac2/tac2intern.ml
index 5a317e831d40..8f8e43f7140a 100644
--- a/plugins/ltac2/tac2intern.ml
+++ b/plugins/ltac2/tac2intern.ml
@@ -192,7 +192,7 @@ let check_elt_empty loc env t = match kind env t with
     user_err ?loc (str "Type" ++ spc () ++ pr_glbtype env t ++ spc () ++ str "is not an empty type")
 
 let check_unit ?loc t =
-  let env = empty_env () in
+  let env = empty_env UnivNames.empty_binders () in
   (* Should not matter, t should be closed. *)
   let t = fresh_type_scheme env t in
   let maybe_unit = match kind env t with
@@ -287,19 +287,19 @@ let expand_pattern avoid bnd =
   let nas = List.rev_map (fun (na, _, _) -> na) bnd in
   (nas, expand)
 
-let is_alias env qid = match get_variable env qid with
-| ArgArg (TacAlias _) -> true
+let is_abbrev env qid = match get_variable env qid with
+| ArgArg (TacAbbrev _) -> true
 | ArgVar _ | (ArgArg (TacConstant _)) -> false
 
 let is_user_name qid = match qid with
 | AbsKn _ -> false
 | RelId _ -> true
 
-let deprecated_ltac2_alias =
+let deprecated_ltac2_abbrev =
   Deprecation.create_warning
     ~object_name:"Ltac2 abbreviation"
     ~warning_name_if_no_since:"deprecated-ltac2-abbreviation"
-    (fun kn -> pr_qualid (Tac2env.shortest_qualid_of_ltac Id.Set.empty (TacAlias kn)))
+    (fun kn -> pr_qualid (Tac2env.shortest_qualid_of_ltac Id.Set.empty (TacAbbrev kn)))
 
 let deprecated_ltac2_def =
   Deprecation.create_warning
@@ -309,10 +309,10 @@ let deprecated_ltac2_def =
 
 let check_deprecated_ltac2 ?loc qid def =
   if is_user_name qid then match def with
-  | TacAlias kn ->
-    begin match (Tac2env.interp_alias kn).alias_depr with
+  | TacAbbrev kn ->
+    begin match (Tac2env.interp_abbrev kn).abbrev_depr with
     | None -> ()
-    | Some depr -> deprecated_ltac2_alias ?loc (kn, depr)
+    | Some depr -> deprecated_ltac2_abbrev ?loc (kn, depr)
     end
   | TacConstant kn ->
     begin match (Tac2env.interp_global kn).gdata_deprecation with
@@ -1076,9 +1076,12 @@ let tycon_fun_body ?loc env tycon dom =
     let () = unify ?loc env (GTypArrow (dom,codom)) tycon in
     codom
   | GTypRef _ ->
-    CErrors.user_err ?loc
-      Pp.(str "This expression should not be a function, the expected type is" ++ spc() ++
-          pr_glbtype env tycon ++ str ".")
+    let () =
+      add_error env ?loc
+        Pp.(str "This expression should not be a function, the expected type is" ++ spc() ++
+            pr_glbtype env tycon ++ str ".")
+    in
+    GTypVar (fresh_id env)
 
 let tycon_app ?loc env ~ft t =
   match kind env t with
@@ -1093,14 +1096,16 @@ let tycon_app ?loc env ~ft t =
       | GTypArrow _ -> true
       | _ -> false
     in
-    if is_fun then
-      CErrors.user_err ?loc
+    let () = if is_fun then
+      add_error env ?loc
         Pp.(str "This function has type" ++ spc() ++ pr_glbtype env ft ++
             spc() ++ str "and is applied to too many arguments.")
     else
-      CErrors.user_err ?loc
+      add_error env ?loc
         Pp.(str "This expression has type" ++ spc() ++ pr_glbtype env ft ++ str"." ++
             spc() ++ str "It is not a function and cannot be applied.")
+    in
+    GTypVar (fresh_id env), GTypVar (fresh_id env)
 
 let warn_useless_record_with = CWarnings.create ~name:"ltac2-useless-record-with" ~default:AsError
     ~category:CWarnings.CoreCategories.ltac2
@@ -1108,8 +1113,17 @@ let warn_useless_record_with = CWarnings.create ~name:"ltac2-useless-record-with
         str "All the fields are explicitly listed in this record:" ++
         spc() ++ str "the 'with' clause is useless.")
 
-let expand_notation ?loc el kn =
-  match Tac2env.interp_notation kn with
+let expand_abbrev ?loc kn =
+  let e =
+    try Tac2env.interp_abbrev kn
+    with Not_found ->
+      CErrors.anomaly (str "Missing hardwired abbrev " ++ KerName.print kn)
+  in
+  CAst.make ?loc @@ CTacGlb (e.abbrev_prms, [], e.abbrev_body, e.abbrev_ty)
+
+let expand_notation ?loc scopes syn =
+  let data, el = Tac2syn.interp_notation ?loc scopes syn in
+  match data with
   | UntypedNota body ->
     let el = List.map (fun (pat, e) -> CAst.map (fun na -> CPatVar na) pat, e) el in
     let v = if CList.is_empty el then body else CAst.make ?loc @@ CTacLet(false, el, body) in
@@ -1120,7 +1134,7 @@ let expand_notation ?loc el kn =
           | Anonymous -> None, argtys
           | Name id -> Some (Id.Map.get id argtys), Id.Map.remove id argtys
         in
-        argtys ,(na, arg, argty))
+        argtys, (na.CAst.v, arg, argty))
         argtys
         el
     in
@@ -1173,14 +1187,10 @@ let rec intern_rec env tycon {loc;v=e} =
     in
     let () = check_deprecated_ltac2 ?loc qid (TacConstant kn) in
     check (GTacRef kn, fresh_type_scheme env sch)
-  | ArgArg (TacAlias kn) ->
-    let e =
-      try Tac2env.interp_alias kn
-      with Not_found ->
-        CErrors.anomaly (str "Missing hardwired alias " ++ KerName.print kn)
-    in
-    let () = check_deprecated_ltac2 ?loc qid (TacAlias kn) in
-    intern_rec env tycon e.alias_body
+  | ArgArg (TacAbbrev kn) ->
+    let e = expand_abbrev ?loc kn in
+    let () = check_deprecated_ltac2 ?loc qid (TacAbbrev kn) in
+    intern_rec env tycon e
   end
 | CTacCst qid ->
   let kn = get_constructor env qid in
@@ -1211,22 +1221,22 @@ let rec intern_rec env tycon {loc;v=e} =
 | CTacApp ({loc;v=CTacCst qid}, args) ->
   let kn = get_constructor env qid in
   intern_constructor env loc tycon kn args
-| CTacApp ({v=CTacRef qid; loc=aloc}, args) when is_alias env qid ->
+| CTacApp ({v=CTacRef qid; loc=aloc}, args) when is_abbrev env qid ->
   let kn = match get_variable env qid with
-  | ArgArg (TacAlias kn) -> kn
+  | ArgArg (TacAbbrev kn) -> kn
   | ArgVar _ | (ArgArg (TacConstant _)) -> assert false
   in
-  let e = Tac2env.interp_alias kn in
-  let () = check_deprecated_ltac2 ?loc:aloc qid (TacAlias kn) in
+  let e = expand_abbrev ?loc:aloc kn in
+  let () = check_deprecated_ltac2 ?loc:aloc qid (TacAbbrev kn) in
   let map arg =
-    (* Thunk alias arguments *)
+    (* Thunk abbrev arguments *)
     let loc = arg.loc in
     let t_unit = CAst.make ?loc @@ CTypRef (AbsKn (Tuple 0), []) in
     let var = CAst.make ?loc @@ CPatCnv (CAst.make ?loc @@ CPatVar Anonymous, t_unit) in
     CAst.make ?loc @@ CTacFun ([var], arg)
   in
   let args = List.map map args in
-  intern_rec env tycon (CAst.make ?loc @@ CTacApp (e.alias_body, args))
+  intern_rec env tycon (CAst.make ?loc @@ CTacApp (e, args))
 | CTacApp (f, args) ->
   let loc = f.loc in
   let (f, ft) = intern_rec env None f in
@@ -1255,8 +1265,8 @@ let rec intern_rec env tycon {loc;v=e} =
   let ids = List.fold_left fold Id.Set.empty el in
   if is_rec then intern_let_rec env loc el tycon e
   else intern_let env loc ids el tycon e
-| CTacSyn (el, kn) ->
-  let v = expand_notation ?loc el kn in
+| CTacSyn syn ->
+  let v = expand_notation ?loc (Tac2typing_env.scopes env) syn in
   intern_rec env tycon v
 | CTacCnv (e, tc) ->
   let tc = intern_type env tc in
@@ -1371,7 +1381,7 @@ let rec intern_rec env tycon {loc;v=e} =
   (* External objects do not have access to the named context because this is
      not stable by dynamic semantics. *)
   let genv = Global.env_of_context Environ.empty_named_context_val in
-  let ist = empty_glob_sign ~strict:(env_strict env) genv in
+  let ist = empty_glob_sign ~strict:(env_strict env) genv (env_univs env) in
   let ist = { ist with extra = Store.set ist.extra ltac2_env env } in
   let arg, tpe = obj.ml_intern ist arg in
   let e = match arg with
@@ -1391,12 +1401,12 @@ let rec intern_rec env tycon {loc;v=e} =
   in
   let args = List.map (fun (na, arg, ty) ->
       let ty = Option.map (subst_type tysubst) ty in
-      let () = match na.CAst.v, ty with
+      let () = match na, ty with
         | Anonymous, None | Name _, Some _ -> ()
         | Anonymous, Some _ | Name _, None -> assert false
       in
       let e, _ = intern_rec env ty arg in
-      na.CAst.v, e)
+      na, e)
       args
   in
   if CList.is_empty args then body, ty
@@ -1521,29 +1531,32 @@ and intern_constructor env loc tycon kn args = match kn with
   else
     error_nargs_mismatch ?loc kn nargs (List.length args)
 | Tuple n ->
-  let () = if not (Int.equal n (List.length args)) then begin
-      if Int.equal 0 n then
-        (* parsing [() bla] produces [CTacApp (Tuple 0, [bla])] but parsing
-           [((), ()) bla] produces [CTacApp (CTacApp (Tuple 2, [(); ()]), [bla])]
-           so we only need to produce a sensible error for [Tuple 0] *)
-        let t = GTypRef (Tuple 0, []) in
-        CErrors.user_err ?loc Pp.(
-            str "This expression has type" ++ spc () ++ pr_glbtype env t ++
-            spc () ++ str "and is not a function")
-      else assert false
-    end
-  in
-  let types = List.init n (fun i -> GTypVar (fresh_id env)) in
-  let ans = GTypRef (Tuple n, types) in
-  let ans = match tycon with
-    | None -> ans
-    | Some tycon ->
-      let () = unify ?loc env ans tycon in
-      tycon
-  in
-  let map arg tpe = intern_rec_with_constraint env arg tpe in
-  let args = List.map2 map args types in
-  GTacCst (Tuple n, 0, args), ans
+  if not (Int.equal n (List.length args)) then begin
+    assert (Int.equal 0 n);
+    (* parsing [() bla] produces [CTacApp (Tuple 0, [bla])] but parsing
+         [((), ()) bla] produces [CTacApp (CTacApp (Tuple 2, [(); ()]), [bla])]
+         so we only need to produce a sensible error for [Tuple 0] *)
+    let t = GTypRef (Tuple 0, []) in
+    let () =
+      add_error env ?loc Pp.(
+        str "This expression has type" ++ spc () ++ pr_glbtype env t ++
+        spc () ++ str "and is not a function.")
+    in
+    let args = List.map (fun arg -> fst @@ intern_rec env None arg) args in
+    GTacApp (GTacCst (Tuple 0, 0, []), args), GTypVar (fresh_id env)
+  end
+  else
+    let types = List.init n (fun i -> GTypVar (fresh_id env)) in
+    let ans = GTypRef (Tuple n, types) in
+    let ans = match tycon with
+      | None -> ans
+      | Some tycon ->
+        let () = unify ?loc env ans tycon in
+        tycon
+    in
+    let map arg tpe = intern_rec_with_constraint env arg tpe in
+    let args = List.map2 map args types in
+    GTacCst (Tuple n, 0, args), ans
 
 and intern_case env loc e tycon pl =
   let e, et = intern_rec env None e in
@@ -1572,8 +1585,8 @@ and intern_case env loc e tycon pl =
 
 type context = (Id.t * type_scheme) list
 
-let intern ~strict ctx e =
-  let env = empty_env ~strict () in
+let intern ~strict univs ctx e =
+  let env = empty_env ~strict univs () in
   (* XXX not doing check_unused_variables *)
   let fold accu (id, t) = push_name (Name id) (polymorphic t) accu in
   let env = List.fold_left fold env ctx in
@@ -1583,8 +1596,20 @@ let intern ~strict ctx e =
   let t = normalize env (count, vars) t in
   (e, (!count, t))
 
+let intern_accumulate_errors ~strict ctx e =
+  let env = empty_env ~strict ~accumulate_errors:true UnivNames.empty_binders () in
+  (* XXX not doing check_unused_variables *)
+  let fold accu (id, t) = push_name (Name id) (polymorphic t) accu in
+  let env = List.fold_left fold env ctx in
+  let (e, t) = intern_rec env None e in
+  let count = ref 0 in
+  let vars = ref TVar.Map.empty in
+  let t = normalize env (count, vars) t in
+  (e, (!count, t), get_errors env)
+
 let intern_typedef self (ids, t) : glb_quant_typedef =
-  let env = set_rec self (empty_env ()) in
+  (* univs should not matter for Ltac2 types *)
+  let env = set_rec self (empty_env UnivNames.empty_binders ()) in
   (* Initialize type parameters *)
   let map id = get_alias id env in
   let ids = List.map map ids in
@@ -1627,7 +1652,7 @@ let intern_typedef self (ids, t) : glb_quant_typedef =
   | CTydOpn -> (count, GTydOpn)
 
 let intern_open_type t =
-  let env = empty_env () in
+  let env = empty_env UnivNames.empty_binders () in
   let t = intern_type env t in
   let count = ref 0 in
   let vars = ref TVar.Map.empty in
@@ -1637,7 +1662,7 @@ let intern_open_type t =
 (** Subtyping *)
 
 let check_subtype t1 t2 =
-  let env = empty_env () in
+  let env = empty_env UnivNames.empty_binders () in
   let t1 = fresh_type_scheme env t1 in
   (* We build a substitution mimicking rigid variable by using dummy tuples *)
   let rigid i = GTypRef (Tuple (i + 1), []) in
@@ -1660,7 +1685,7 @@ let get_projection0 var = match var with
 type raw_ext = RawExt : ('a, _) Tac2dyn.Arg.tag * 'a -> raw_ext
 
 let globalize_gen ~tacext ids tac =
-  let rec globalize ids ({loc;v=er} as e) = match er with
+  let rec globalize (scopes,ids as env) ({loc;v=er} as e) = match er with
     | CTacAtm _ -> e
     | CTacRef ref ->
       let mem id = Id.Set.mem id ids in
@@ -1681,67 +1706,67 @@ let globalize_gen ~tacext ids tac =
       in
       let bnd, ids = List.fold_left fold ([], ids) bnd in
       let bnd = List.rev bnd in
-      let e = globalize ids e in
+      let e = globalize (scopes,ids) e in
       CAst.make ?loc @@ CTacFun (bnd, e)
     | CTacApp (e, el) ->
-      let e = globalize ids e in
-      let el = List.map (fun e -> globalize ids e) el in
+      let e = globalize env e in
+      let el = List.map (fun e -> globalize env e) el in
       CAst.make ?loc @@ CTacApp (e, el)
     | CTacLet (isrec, bnd, e) ->
       let fold accu (pat, _) = ids_of_pattern accu pat in
       let ext = List.fold_left fold Id.Set.empty bnd in
       let eids = Id.Set.union ext ids in
-      let e = globalize eids e in
+      let e = globalize (scopes,eids) e in
       let map (qid, e) =
         let ids = if isrec then eids else ids in
         let qid = globalize_pattern ids qid in
-        (qid, globalize ids e)
+        (qid, globalize (scopes,ids) e)
       in
       let bnd = List.map map bnd in
       CAst.make ?loc @@ CTacLet (isrec, bnd, e)
-    | CTacSyn (el, kn) ->
-      let v = expand_notation ?loc el kn in
-      globalize ids v
+    | CTacSyn syn ->
+      let v = expand_notation ?loc scopes syn in
+      globalize env v
     | CTacCnv (e, t) ->
-      let e = globalize ids e in
+      let e = globalize env e in
       CAst.make ?loc @@ CTacCnv (e, t)
     | CTacSeq (e1, e2) ->
-      let e1 = globalize ids e1 in
-      let e2 = globalize ids e2 in
+      let e1 = globalize env e1 in
+      let e2 = globalize env e2 in
       CAst.make ?loc @@ CTacSeq (e1, e2)
     | CTacIft (e, e1, e2) ->
-      let e = globalize ids e in
-      let e1 = globalize ids e1 in
-      let e2 = globalize ids e2 in
+      let e = globalize env e in
+      let e1 = globalize env e1 in
+      let e2 = globalize env e2 in
       CAst.make ?loc @@ CTacIft (e, e1, e2)
     | CTacCse (e, bl) ->
-      let e = globalize ids e in
-      let bl = List.map (fun b -> globalize_case ids b) bl in
+      let e = globalize env e in
+      let bl = List.map (fun b -> globalize_case env b) bl in
       CAst.make ?loc @@ CTacCse (e, bl)
     | CTacRec (def, r) ->
-      let def = Option.map (globalize ids) def in
+      let def = Option.map (globalize env) def in
       let map (p, e) =
         let p = get_projection0 p in
-        let e = globalize ids e in
+        let e = globalize env e in
         (AbsKn p, e)
       in
       CAst.make ?loc @@ CTacRec (def, List.map map r)
     | CTacPrj (e, p) ->
-      let e = globalize ids e in
+      let e = globalize env e in
       let p = get_projection0 p in
       CAst.make ?loc @@ CTacPrj (e, AbsKn p)
     | CTacSet (e, p, e') ->
-      let e = globalize ids e in
+      let e = globalize env e in
       let p = get_projection0 p in
-      let e' = globalize ids e' in
+      let e' = globalize env e' in
       CAst.make ?loc @@ CTacSet (e, AbsKn p, e')
     | CTacExt (tag, arg) -> tacext ?loc (RawExt (tag, arg))
     | CTacGlb (prms, args, body, ty) ->
-      let args = List.map (fun (na, arg, ty) -> na, globalize ids arg, ty) args in
+      let args = List.map (fun (na, arg, ty) -> na, globalize env arg, ty) args in
       CAst.make ?loc @@ CTacGlb (prms, args, body, ty)
 
-  and globalize_case ids (p, e) =
-    (globalize_pattern ids p, globalize ids e)
+  and globalize_case (_, ids as env) (p, e) =
+    (globalize_pattern ids p, globalize env e)
 
   and globalize_pattern ids ({loc;v=pr} as p) = match pr with
     | CPatVar _ | CPatAtm _ -> p
@@ -1767,7 +1792,7 @@ let globalize_gen ~tacext ids tac =
       CAst.make ?loc @@ CPatRecord (List.map map pats)
 
   in
-  globalize ids tac
+  globalize (Tac2syn.current_scopes() ,ids) tac
 
 let globalize ids tac =
   let tacext ?loc (RawExt (tag,_)) =
@@ -1776,9 +1801,18 @@ let globalize ids tac =
   in
   globalize_gen ~tacext ids tac
 
-let debug_globalize_allow_ext ids tac =
-  let tacext ?loc (RawExt (tag,arg)) = CAst.make ?loc @@ CTacExt (tag,arg) in
-  globalize_gen ~tacext ids tac
+let intern_abbrev depr body =
+  let env = empty_env ~strict:true UnivNames.empty_binders () in
+  let body, ty = intern_rec env None body in
+  let count = ref 0 in
+  let vars = ref TVar.Map.empty in
+  let ty = normalize env (count, vars) ty in
+  let prms = !count in
+  { abbrev_body = body;
+    abbrev_ty = ty;
+    abbrev_prms = prms;
+    abbrev_depr = depr;
+  }
 
 let { Goptions.get = typed_notations } =
   Goptions.declare_bool_option_and_ref
@@ -1786,7 +1820,7 @@ let { Goptions.get = typed_notations } =
 
 let intern_notation_data ids body =
   if typed_notations () then
-    let env = empty_env ~strict:true () in
+    let env = empty_env ~strict:true UnivNames.empty_binders () in
     let fold id (env,argtys) =
       let ty = GTypVar (fresh_id env) in
       let env = push_name (Name id) (monomorphic ty) env in
@@ -1802,7 +1836,7 @@ let intern_notation_data ids body =
     let argtys = Id.Map.map (fun ty -> normalize env (count, vars) ty) argtys in
     let ty = normalize env (count, vars) ty in
     let prms = !count in
-    Tac2env.TypedNota {
+    Tac2syn.TypedNota {
       nota_prms = prms;
       nota_argtys = argtys;
       nota_ty = ty;
@@ -1810,275 +1844,7 @@ let intern_notation_data ids body =
     }
   else
     let body = globalize ids body in
-    Tac2env.UntypedNota body
-
-(** Kernel substitution *)
-
-open Mod_subst
-
-let subst_or_tuple f subst o = match o with
-| Tuple _ -> o
-| Other v ->
-  let v' = f subst v in
-  if v' == v then o else Other v'
-
-let rec subst_type subst t = match t with
-| GTypVar _ -> t
-| GTypArrow (t1, t2) ->
-  let t1' = subst_type subst t1 in
-  let t2' = subst_type subst t2 in
-  if t1' == t1 && t2' == t2 then t
-  else GTypArrow (t1', t2')
-| GTypRef (kn, tl) ->
-  let kn' = subst_or_tuple subst_kn subst kn in
-  let tl' = List.Smart.map (fun t -> subst_type subst t) tl in
-  if kn' == kn && tl' == tl then t else GTypRef (kn', tl')
-
-let rec subst_glb_pat subst = function
-  | (GPatVar _ | GPatAtm _) as pat0 -> pat0
-  | GPatRef (ctor,pats) as pat0 ->
-    let ctor' =
-      let ctyp' = Option.Smart.map (subst_kn subst) ctor.ctyp in
-      if ctyp' == ctor.ctyp then ctor
-      else {ctor with ctyp = ctyp'}
-    in
-    let pats' = List.Smart.map (subst_glb_pat subst) pats in
-    if ctor' == ctor && pats' == pats then pat0
-    else GPatRef (ctor', pats')
-  | GPatOr pats as pat0 ->
-    let pats' = List.Smart.map (subst_glb_pat subst) pats in
-    if pats' == pats then pat0
-    else GPatOr pats'
-  | GPatAs (p,x) as pat0 ->
-    let p' = subst_glb_pat subst p in
-    if p' == p then pat0
-    else GPatAs (p',x)
-
-let rec subst_expr subst e = match e with
-| GTacAtm _ | GTacVar _ | GTacPrm _ -> e
-| GTacRef kn -> GTacRef (subst_kn subst kn)
-| GTacFun (ids, e) -> GTacFun (ids, subst_expr subst e)
-| GTacApp (f, args) ->
-  GTacApp (subst_expr subst f, List.map (fun e -> subst_expr subst e) args)
-| GTacLet (r, bs, e) ->
-  let bs = List.map (fun (na, e) -> (na, subst_expr subst e)) bs in
-  GTacLet (r, bs, subst_expr subst e)
-| GTacCst (t, n, el) as e0 ->
-  let t' = subst_or_tuple subst_kn subst t in
-  let el' = List.Smart.map (fun e -> subst_expr subst e) el in
-  if t' == t && el' == el then e0 else GTacCst (t', n, el')
-| GTacCse (e, ci, cse0, cse1) ->
-  let cse0' = Array.map (fun e -> subst_expr subst e) cse0 in
-  let cse1' = Array.map (fun (ids, e) -> (ids, subst_expr subst e)) cse1 in
-  let ci' = subst_or_tuple subst_kn subst ci in
-  GTacCse (subst_expr subst e, ci', cse0', cse1')
-| GTacWth { opn_match = e; opn_branch = br; opn_default = (na, def) } as e0 ->
-  let e' = subst_expr subst e in
-  let def' = subst_expr subst def in
-  let fold kn (self, vars, p) accu =
-    let kn' = subst_kn subst kn in
-    let p' = subst_expr subst p in
-    if kn' == kn && p' == p then accu
-    else KerName.Map.add kn' (self, vars, p') (KerName.Map.remove kn accu)
-  in
-  let br' = KerName.Map.fold fold br br in
-  if e' == e && br' == br && def' == def then e0
-  else GTacWth { opn_match = e'; opn_default = (na, def'); opn_branch = br' }
-| GTacFullMatch (e,brs) as e0 ->
-  let e' = subst_expr subst e in
-  let brs' = List.Smart.map (fun (pat,br as pbr) ->
-      let pat' = subst_glb_pat subst pat in
-      let br' = subst_expr subst br in
-      if pat' == pat && br' == br then pbr
-      else (pat',br'))
-      brs
-  in
-  if e' == e && brs' == brs then e0
-  else GTacFullMatch (e', brs')
-| GTacPrj (kn, e, p) as e0 ->
-  let kn' = subst_kn subst kn in
-  let e' = subst_expr subst e in
-  if kn' == kn && e' == e then e0 else GTacPrj (kn', e', p)
-| GTacSet (kn, e, p, r) as e0 ->
-  let kn' = subst_kn subst kn in
-  let e' = subst_expr subst e in
-  let r' = subst_expr subst r in
-  if kn' == kn && e' == e && r' == r then e0 else GTacSet (kn', e', p, r')
-| GTacExt (tag, arg) ->
-  let tpe = interp_ml_object tag in
-  let arg' = tpe.ml_subst subst arg in
-  if arg' == arg then e else GTacExt (tag, arg')
-| GTacOpn (kn, el) as e0 ->
-  let kn' = subst_kn subst kn in
-  let el' = List.Smart.map (fun e -> subst_expr subst e) el in
-  if kn' == kn && el' == el then e0 else GTacOpn (kn', el')
-
-let subst_typedef subst e = match e with
-| GTydDef t ->
-  let t' = Option.Smart.map (fun t -> subst_type subst t) t in
-  if t' == t then e else GTydDef t'
-| GTydAlg galg ->
-  let map (warn, c, tl as p) =
-    let tl' = List.Smart.map (fun t -> subst_type subst t) tl in
-    if tl' == tl then p else (warn, c, tl')
-  in
-  let constrs' = List.Smart.map map galg.galg_constructors in
-  if constrs' == galg.galg_constructors then e
-  else GTydAlg { galg with galg_constructors = constrs' }
-| GTydRec fields ->
-  let map (c, mut, t as p) =
-    let t' = subst_type subst t in
-    if t' == t then p else (c, mut, t')
-  in
-  let fields' = List.Smart.map map fields in
-  if fields' == fields then e else GTydRec fields'
-| GTydOpn -> GTydOpn
-
-let subst_quant_typedef subst (prm, def as qdef) =
-  let def' = subst_typedef subst def in
-  if def' == def then qdef else (prm, def')
-
-let subst_type_scheme subst (prm, t as sch) =
-  let t' = subst_type subst t in
-  if t' == t then sch else (prm, t')
-
-let subst_or_relid subst ref = match ref with
-| RelId _ -> ref
-| AbsKn kn ->
-  let kn' = subst_or_tuple subst_kn subst kn in
-  if kn' == kn then ref else AbsKn kn'
-
-let rec subst_rawtype subst ({loc;v=tr} as t) = match tr with
-| CTypVar _ -> t
-| CTypArrow (t1, t2) ->
-  let t1' = subst_rawtype subst t1 in
-  let t2' = subst_rawtype subst t2 in
-  if t1' == t1 && t2' == t2 then t else CAst.make ?loc @@ CTypArrow (t1', t2')
-| CTypRef (ref, tl) ->
-  let ref' = subst_or_relid subst ref in
-  let tl' = List.Smart.map (fun t -> subst_rawtype subst t) tl in
-  if ref' == ref && tl' == tl then t else CAst.make ?loc @@ CTypRef (ref', tl')
-
-let subst_tacref subst ref = match ref with
-| RelId _ -> ref
-| AbsKn (TacConstant kn) ->
-  let kn' = subst_kn subst kn in
-  if kn' == kn then ref else AbsKn (TacConstant kn')
-| AbsKn (TacAlias kn) ->
-  let kn' = subst_kn subst kn in
-  if kn' == kn then ref else AbsKn (TacAlias kn')
-
-let subst_projection subst prj = match prj with
-| RelId _ -> prj
-| AbsKn kn ->
-  let kn' = subst_kn subst kn in
-  if kn' == kn then prj else AbsKn kn'
-
-let rec subst_rawpattern subst ({loc;v=pr} as p) = match pr with
-| CPatVar _ | CPatAtm _ -> p
-| CPatRef (c, pl) ->
-  let pl' = List.Smart.map (fun p -> subst_rawpattern subst p) pl in
-  let c' = subst_or_relid subst c in
-  if pl' == pl && c' == c then p else CAst.make ?loc @@ CPatRef (c', pl')
-| CPatCnv (pat, ty) ->
-  let pat' = subst_rawpattern subst pat in
-  let ty' = subst_rawtype subst ty in
-  if pat' == pat && ty' == ty then p else CAst.make ?loc @@ CPatCnv (pat', ty')
-| CPatOr pl ->
-  let pl' = List.Smart.map (fun p -> subst_rawpattern subst p) pl in
-  if pl' == pl then p else CAst.make ?loc @@ CPatOr pl'
-| CPatAs (pat,x) ->
-  let pat' = subst_rawpattern subst pat in
-  if pat' == pat then p else CAst.make ?loc @@ CPatAs (pat', x)
-| CPatRecord el ->
-  let map (prj, e as p) =
-    let prj' = subst_projection subst prj in
-    let e' = subst_rawpattern subst e in
-    if prj' == prj && e' == e then p else (prj', e')
-  in
-  let el' = List.Smart.map map el in
-  if el' == el then p else CAst.make ?loc @@ CPatRecord el'
-
-(** Used for notations *)
-let rec subst_rawexpr subst ({loc;v=tr} as t) = match tr with
-| CTacAtm _ -> t
-| CTacRef ref ->
-  let ref' = subst_tacref subst ref in
-  if ref' == ref then t else CAst.make ?loc @@ CTacRef ref'
-| CTacCst ref ->
-  let ref' = subst_or_relid subst ref in
-  if ref' == ref then t else CAst.make ?loc @@ CTacCst ref'
-| CTacFun (bnd, e) ->
-  let map pat = subst_rawpattern subst pat in
-  let bnd' = List.Smart.map map bnd in
-  let e' = subst_rawexpr subst e in
-  if bnd' == bnd && e' == e then t else CAst.make ?loc @@ CTacFun (bnd', e')
-| CTacApp (e, el) ->
-  let e' = subst_rawexpr subst e in
-  let el' = List.Smart.map (fun e -> subst_rawexpr subst e) el in
-  if e' == e && el' == el then t else CAst.make ?loc @@ CTacApp (e', el')
-| CTacLet (isrec, bnd, e) ->
-  let map (na, e as p) =
-    let na' = subst_rawpattern subst na in
-    let e' = subst_rawexpr subst e in
-    if na' == na && e' == e then p else (na', e')
-  in
-  let bnd' = List.Smart.map map bnd in
-  let e' = subst_rawexpr subst e in
-  if bnd' == bnd && e' == e then t else CAst.make ?loc @@ CTacLet (isrec, bnd', e')
-| CTacCnv (e, c) ->
-  let e' = subst_rawexpr subst e in
-  let c' = subst_rawtype subst c in
-  if c' == c && e' == e then t else CAst.make ?loc @@ CTacCnv (e', c')
-| CTacSeq (e1, e2) ->
-  let e1' = subst_rawexpr subst e1 in
-  let e2' = subst_rawexpr subst e2 in
-  if e1' == e1 && e2' == e2 then t else CAst.make ?loc @@ CTacSeq (e1', e2')
-| CTacIft (e, e1, e2) ->
-  let e' = subst_rawexpr subst e in
-  let e1' = subst_rawexpr subst e1 in
-  let e2' = subst_rawexpr subst e2 in
-  if e' == e && e1' == e1 && e2' == e2 then t else CAst.make ?loc @@ CTacIft (e', e1', e2')
-| CTacCse (e, bl) ->
-  let map (p, e as x) =
-    let p' = subst_rawpattern subst p in
-    let e' = subst_rawexpr subst e in
-    if p' == p && e' == e then x else (p', e')
-  in
-  let e' = subst_rawexpr subst e in
-  let bl' = List.Smart.map map bl in
-  if e' == e && bl' == bl then t else CAst.make ?loc @@ CTacCse (e', bl')
-| CTacRec (def, el) ->
-  let def' = Option.Smart.map (subst_rawexpr subst) def in
-  let map (prj, e as p) =
-    let prj' = subst_projection subst prj in
-    let e' = subst_rawexpr subst e in
-    if prj' == prj && e' == e then p else (prj', e')
-  in
-  let el' = List.Smart.map map el in
-  if def' == def && el' == el then t else CAst.make ?loc @@ CTacRec (def',el')
-| CTacPrj (e, prj) ->
-    let prj' = subst_projection subst prj in
-    let e' = subst_rawexpr subst e in
-    if prj' == prj && e' == e then t else CAst.make ?loc @@ CTacPrj (e', prj')
-| CTacSet (e, prj, r) ->
-    let prj' = subst_projection subst prj in
-    let e' = subst_rawexpr subst e in
-    let r' = subst_rawexpr subst r in
-    if prj' == prj && e' == e && r' == r then t else CAst.make ?loc @@ CTacSet (e', prj', r')
-| CTacGlb (prms, args, body, ty) ->
-  let args' = List.Smart.map (fun (na, arg, ty as o) ->
-      let arg' = subst_rawexpr subst arg in
-      let ty' = Option.Smart.map (subst_type subst) ty in
-      if arg' == arg && ty' == ty then o
-      else (na, arg', ty'))
-      args
-  in
-  let body' = subst_expr subst body in
-  let ty' = subst_type subst ty in
-  if args' == args && body' == body && ty' == ty then t
-  else CAst.make ?loc @@ CTacGlb (prms, args', body', ty')
-| CTacSyn _ | CTacExt _ -> assert false (** Should not be generated by globalization *)
+    UntypedNota body
 
 (** Registering *)
 
@@ -2087,7 +1853,7 @@ let genintern_core ?(check_unused=true) ist locals expected v =
   let env = match Genintern.Store.get ist.extra ltac2_env with
     | None ->
       (* Only happens when Ltac2 is called from a toplevel ltac1 quotation *)
-      empty_env ~strict:ist.strict_check ()
+      empty_env ~strict:ist.strict_check ist.intern_sign.intern_univs ()
     | Some env -> env
   in
   let env = List.fold_left (fun env (na,t) -> push_name na t env) env locals in
@@ -2107,7 +1873,7 @@ let genintern ?check_unused ist locals expected v =
 
 let () =
   let open Genintern in
-  let intern ist tac =
+  let intern ?loc ist tac =
     let t_preterm = monomorphic (GTypRef (Other t_preterm, [])) in
     let ntn_vars = ist.intern_sign.notation_variable_status in
     let locals =
@@ -2128,24 +1894,21 @@ let () =
           CErrors.user_err ?loc:tac.loc Pp.(str "Cannot use binder notation variable " ++ Id.print id ++ str " as a preterm."))
         ids
     in
-    (ist, (ids, v))
+    (ids, v)
   in
-  Genintern.register_intern0 wit_ltac2_constr intern
+  Genintern.register_intern_constr wit_ltac2_constr intern
 
 let () =
   let open Genintern in
   let intern ist tac =
     (* XXX should we try to get an env from the ist? *)
-    let env = empty_env ~strict:ist.strict_check () in
+    let env = empty_env ~strict:ist.strict_check ist.intern_sign.intern_univs () in
     let tac, _ = intern_rec env (Some (GTypRef (Tuple 0, []))) tac in
     ist, tac
   in
-  Genintern.register_intern0 wit_ltac2_tac intern
-
-let () = Gensubst.register_subst0 wit_ltac2_constr (fun s (ids, e) -> ids, subst_expr s e)
-let () = Gensubst.register_subst0 wit_ltac2_tac subst_expr
+  Gentactic.register_intern wit_ltac2_tac intern
 
-let intern_var_quotation_gen ~ispat ist (kind, { CAst.v = id; loc }) =
+let intern_var_quotation_gen ?loc ~ispat ist (kind, { CAst.v = id; loc }) =
   let open Genintern in
   let kind = match kind with
     | None -> ConstrVar
@@ -2180,7 +1943,7 @@ let intern_var_quotation_gen ~ispat ist (kind, { CAst.v = id; loc }) =
   let env = match Genintern.Store.get ist.extra ltac2_env with
     | None ->
       (* Only happens when Ltac2 is called from a constr or ltac1 quotation *)
-      empty_env ~strict:ist.strict_check ()
+      empty_env ~strict:ist.strict_check ist.intern_sign.intern_univs ()
     | Some env -> env
   in
   (* Special handling of notation variables *)
@@ -2196,11 +1959,11 @@ let intern_var_quotation_gen ~ispat ist (kind, { CAst.v = id; loc }) =
   in
   let t = fresh_mix_type_scheme env t in
   let () = unify ?loc env t (GTypRef (Other typ, [])) in
-  (ist, (kind, id))
+  (kind, id)
 
-let intern_var_quotation = intern_var_quotation_gen ~ispat:false
+let intern_var_quotation ?loc = intern_var_quotation_gen ?loc ~ispat:false
 
-let () = Genintern.register_intern0 wit_ltac2_var_quotation intern_var_quotation
+let () = Genintern.register_intern_constr wit_ltac2_var_quotation intern_var_quotation
 
 let intern_var_quotation_pat ?loc ist v =
   intern_var_quotation_gen ~ispat:true ist v
@@ -2208,4 +1971,4 @@ let intern_var_quotation_pat ?loc ist v =
 let () = Genintern.register_intern_pat wit_ltac2_var_quotation
     intern_var_quotation_pat
 
-let () = Gensubst.register_subst0 wit_ltac2_var_quotation (fun _ v -> v)
+let () = Gensubst.register_constr_subst wit_ltac2_var_quotation (fun _ v -> v)
diff --git a/plugins/ltac2/tac2intern.mli b/plugins/ltac2/tac2intern.mli
index ab1a7a5f5e7c..e84893177123 100644
--- a/plugins/ltac2/tac2intern.mli
+++ b/plugins/ltac2/tac2intern.mli
@@ -9,15 +9,18 @@
 (************************************************************************)
 
 open Names
-open Mod_subst
 open Tac2expr
 
 type context = (Id.t * type_scheme) list
 
-val intern : strict:bool -> context -> raw_tacexpr -> glb_tacexpr * type_scheme
+val intern : strict:bool -> UnivNames.universe_binders -> context -> raw_tacexpr -> glb_tacexpr * type_scheme
 val intern_typedef : (KerName.t * int) Id.Map.t -> raw_quant_typedef -> glb_quant_typedef
 val intern_open_type : raw_typexpr -> type_scheme
-val intern_notation_data : Id.Set.t -> raw_tacexpr -> Tac2env.notation_data
+val intern_notation_data : Id.Set.t -> raw_tacexpr -> Tac2syn.notation_data
+val intern_abbrev : Deprecation.t option -> raw_tacexpr -> Tac2env.abbrev_data
+
+val intern_accumulate_errors : strict:bool -> context -> raw_tacexpr ->
+  glb_tacexpr * type_scheme * Pp.t Loc.located list
 
 (** [check_unused] is default true *)
 val genintern_warn_not_unit : ?check_unused:bool ->
@@ -53,23 +56,6 @@ val check_subtype : type_scheme -> type_scheme -> bool
 (** [check_subtype t1 t2] returns [true] iff all values of instances of type [t1]
     also have type [t2]. *)
 
-val subst_type : substitution -> 'a glb_typexpr -> 'a glb_typexpr
-val subst_expr : substitution -> glb_tacexpr -> glb_tacexpr
-val subst_quant_typedef : substitution -> glb_quant_typedef -> glb_quant_typedef
-val subst_type_scheme : substitution -> type_scheme -> type_scheme
-
-val subst_rawexpr : substitution -> raw_tacexpr -> raw_tacexpr
-
-(** {5 Notations} *)
-
-val globalize : Id.Set.t -> raw_tacexpr -> raw_tacexpr
-(** Replaces all qualified identifiers by their corresponding kernel name. The
-    set represents bound variables in the context. *)
-
-val debug_globalize_allow_ext : Id.Set.t -> raw_tacexpr -> raw_tacexpr
-(** Variant of globalize which can accept CTacExt using the provided function.
-    Intended for debugging. *)
-
 (** Errors *)
 
 val error_nargs_mismatch : ?loc:Loc.t -> ltac_constructor -> int -> int -> 'a
diff --git a/plugins/ltac2/tac2print.ml b/plugins/ltac2/tac2print.ml
index 9d688108dedb..6910ab3fb8e2 100644
--- a/plugins/ltac2/tac2print.ml
+++ b/plugins/ltac2/tac2print.ml
@@ -590,7 +590,7 @@ let pr_rawexpr_gen lvl ~avoid c =
   | CTacAtm a -> pr_atom a
   | CTacRef (RelId qid) -> Libnames.pr_qualid qid
   | CTacRef (AbsKn (TacConstant r)) -> pr_tacref avoid r
-  | CTacRef (AbsKn (TacAlias _ as r)) -> Libnames.pr_qualid (Tac2env.shortest_qualid_of_ltac avoid r)
+  | CTacRef (AbsKn (TacAbbrev _ as r)) -> Libnames.pr_qualid (Tac2env.shortest_qualid_of_ltac avoid r)
   | CTacCst (RelId qid) -> Libnames.pr_qualid qid
   | CTacCst (AbsKn (Tuple 0)) -> str "()"
   | CTacCst (AbsKn (Tuple n)) -> CErrors.anomaly ?loc Pp.(str "Incorrect tuple.")
@@ -644,7 +644,7 @@ let pr_rawexpr_gen lvl ~avoid c =
       | E1 | E2 | E3 | E4 | E5 -> fun x -> x
     in
     paren (hov 0 (pr_rawexpr E0 avoid hd ++ spc() ++ pr_sequence (pr_rawexpr E0 avoid) args))
-  | CTacSyn (_,kn) -> fmt "" (fun () -> KerName.print kn)
+  | CTacSyn _ -> fmt "" (* TODO *)
   | CTacLet (isrec, bnd, e) ->
     let paren = match lvl with
       | E0 | E1 | E2 | E3 | E4 -> paren
@@ -716,8 +716,8 @@ let pr_rawexpr_gen lvl ~avoid c =
     let pr_arg (pat, arg, ty) =
       let bnd = match ty with
         | Some ty ->
-          paren (pr_name pat.CAst.v ++ spc() ++ str ":" ++ spc() ++ pr_glbtype_gen tynames T5_l ty)
-        | None -> pr_name pat.CAst.v
+          paren (pr_name pat ++ spc() ++ str ":" ++ spc() ++ pr_glbtype_gen tynames T5_l ty)
+        | None -> pr_name pat
       in
       hov (-2) (bnd  ++ str " :=" ++ spc() ++ hov 2 (pr_rawexpr E5 avoid arg))
     in
diff --git a/plugins/ltac2/tac2quote.mli b/plugins/ltac2/tac2quote.mli
index 435304f32aa7..8f41201527dd 100644
--- a/plugins/ltac2/tac2quote.mli
+++ b/plugins/ltac2/tac2quote.mli
@@ -49,6 +49,8 @@ module Refs : sig
 
   val t_module : type_constant
 
+  (** Modules *)
+  val control_prefix : ModPath.t
 end
 
 val constructor : ?loc:Loc.t -> ltac_constructor -> raw_tacexpr list -> raw_tacexpr
diff --git a/plugins/ltac2/tac2stdlib.ml b/plugins/ltac2/tac2stdlib.ml
index d968a1a70bd8..0fa26c581a20 100644
--- a/plugins/ltac2/tac2stdlib.ml
+++ b/plugins/ltac2/tac2stdlib.ml
@@ -227,6 +227,22 @@ let to_inversion_kind v = match Value.to_int v with
 
 let inversion_kind = make_to_repr to_inversion_kind
 
+let to_rewrite_success v : Rewrite.rewrite_result_info = match Value.to_tuple v with
+| [| rel; rhs; prf |] ->
+   { rew_rel = Value.to_constr rel;
+     rew_to = Value.to_constr rhs;
+     rew_prf = Value.to_constr prf }
+| _ -> assert false
+
+let to_rewrite_result v : Rewrite.rewrite_result = match v with
+| ValBlk (0, [| s |]) ->  Success (to_rewrite_success s)
+| ValInt 0 -> Identity
+| ValInt 1 -> Fail
+| _ -> assert false
+
+let rewrite_result = make_to_repr to_rewrite_result
+
+
 let to_move_location = function
 | ValInt 0 -> Logic.MoveFirst
 | ValInt 1 -> Logic.MoveLast
@@ -541,6 +557,15 @@ let () =
     (reduction @-> ret rewstrategy)
     Rewrite.Strategies.reduce
 
+let () =
+  define "rewstrat_matches"
+    (pattern @-> ret rewstrategy)
+    Rewrite.Strategies.matches
+
+let () =
+  define "rewstrat_tactic"
+    (fun3 constr constr (option constr) rewrite_result @-> ret rewstrategy)
+    Tac2tactics.wrap_tactic_call
 
 let () =
   define "tac_inversion"
@@ -710,16 +735,99 @@ let () =
 
 (** Tactics for [Ltac2/TransparentState.v]. *)
 
+let () =
+  define "empty_transparent_state" (ret transparent_state) TransparentState.empty
+
+let () =
+  define "full_transparent_state" (ret transparent_state) TransparentState.full
+
 let () =
   define "current_transparent_state"
     (unit @-> tac transparent_state)
     Tac2tactics.current_transparent_state
 
 let () =
-  define "full_transparent_state" (ret transparent_state) TransparentState.full
+  define "union_transparent_state"
+    (transparent_state @-> transparent_state @-> ret transparent_state) @@ fun ts1 ts2 ->
+    { tr_var = Id.Pred.union ts1.tr_var ts2.tr_var ;
+      tr_cst = Cpred.union ts1.tr_cst ts2.tr_cst ;
+      tr_prj = PRpred.union ts1.tr_prj ts2.tr_prj }
 
 let () =
-  define "empty_transparent_state" (ret transparent_state) TransparentState.empty
+  define "inter_transparent_state"
+    (transparent_state @-> transparent_state @-> ret transparent_state) @@ fun ts1 ts2 ->
+    { tr_var = Id.Pred.inter ts1.tr_var ts2.tr_var ;
+      tr_cst = Cpred.inter ts1.tr_cst ts2.tr_cst ;
+      tr_prj = PRpred.inter ts1.tr_prj ts2.tr_prj }
+
+let () =
+  define "diff_transparent_state"
+    (transparent_state @-> transparent_state @-> ret transparent_state) @@ fun ts1 ts2 ->
+    { tr_var = Id.Pred.diff ts1.tr_var ts2.tr_var ;
+      tr_cst = Cpred.diff ts1.tr_cst ts2.tr_cst ;
+      tr_prj = PRpred.diff ts1.tr_prj ts2.tr_prj }
+
+let () =
+  define "add_constant_transparent_state"
+    (constant @-> transparent_state @-> ret transparent_state) @@ fun c ts ->
+    { tr_var = ts.tr_var ;
+      tr_cst = Cpred.add c ts.tr_cst ;
+      tr_prj = ts.tr_prj }
+
+let () =
+  define "add_proj_transparent_state"
+    (projection @-> transparent_state @-> ret transparent_state) @@ fun p ts ->
+    { tr_var = ts.tr_var ;
+      tr_cst = ts.tr_cst ;
+      tr_prj = PRpred.add (Projection.repr p) ts.tr_prj }
+
+let () =
+  define "add_var_transparent_state"
+    (ident @-> transparent_state @-> ret transparent_state) @@ fun v ts ->
+    { tr_var = Id.Pred.add v ts.tr_var ;
+      tr_cst = ts.tr_cst ;
+      tr_prj = ts.tr_prj }
+
+let () =
+  define "remove_constant_transparent_state"
+    (constant @-> transparent_state @-> ret transparent_state) @@ fun c ts ->
+    { tr_var = ts.tr_var ;
+      tr_cst = Cpred.remove c ts.tr_cst ;
+      tr_prj = ts.tr_prj }
+
+let () =
+  define "remove_proj_transparent_state"
+    (projection @-> transparent_state @-> ret transparent_state) @@ fun p ts ->
+    { tr_var = ts.tr_var ;
+      tr_cst = ts.tr_cst ;
+      tr_prj = PRpred.remove (Projection.repr p) ts.tr_prj }
+
+let () =
+  define "remove_var_transparent_state"
+    (ident @-> transparent_state @-> ret transparent_state) @@ fun v ts ->
+    { tr_var = Id.Pred.remove v ts.tr_var ;
+      tr_cst = ts.tr_cst ;
+      tr_prj = ts.tr_prj }
+
+let () =
+  define "mem_constant_transparent_state"
+    (constant @-> transparent_state @-> ret bool) @@ fun c ts ->
+    Cpred.mem c ts.tr_cst
+
+let () =
+  define "mem_proj_transparent_state"
+    (projection @-> transparent_state @-> ret bool) @@ fun p ts ->
+    PRpred.mem (Projection.repr p) ts.tr_prj
+
+let () =
+  define "mem_var_transparent_state"
+    (ident @-> transparent_state @-> ret bool) @@ fun v ts ->
+    Id.Pred.mem v ts.tr_var
+
+let () =
+  define "with_strategy"
+    (strategy_level @-> list reference @-> thunk valexpr @-> tac valexpr)
+    Tac2tactics.with_strategy
 
 (** Tactics around Evarconv unification (in [Ltac2/Unification.v]). *)
 
diff --git a/plugins/ltac2/tac2subst.ml b/plugins/ltac2/tac2subst.ml
new file mode 100644
index 000000000000..1970964f0cc3
--- /dev/null
+++ b/plugins/ltac2/tac2subst.ml
@@ -0,0 +1,281 @@
+(************************************************************************)
+(*         *      The Rocq Prover / The Rocq Development Team           *)
+(*  v      *         Copyright INRIA, CNRS and contributors             *)
+(*  o
+| Other v ->
+  let v' = f subst v in
+  if v' == v then o else Other v'
+
+let rec subst_type subst t = match t with
+| GTypVar _ -> t
+| GTypArrow (t1, t2) ->
+  let t1' = subst_type subst t1 in
+  let t2' = subst_type subst t2 in
+  if t1' == t1 && t2' == t2 then t
+  else GTypArrow (t1', t2')
+| GTypRef (kn, tl) ->
+  let kn' = subst_or_tuple subst_kn subst kn in
+  let tl' = List.Smart.map (fun t -> subst_type subst t) tl in
+  if kn' == kn && tl' == tl then t else GTypRef (kn', tl')
+
+let rec subst_glb_pat subst = function
+  | (GPatVar _ | GPatAtm _) as pat0 -> pat0
+  | GPatRef (ctor,pats) as pat0 ->
+    let ctor' =
+      let ctyp' = Option.Smart.map (subst_kn subst) ctor.ctyp in
+      if ctyp' == ctor.ctyp then ctor
+      else {ctor with ctyp = ctyp'}
+    in
+    let pats' = List.Smart.map (subst_glb_pat subst) pats in
+    if ctor' == ctor && pats' == pats then pat0
+    else GPatRef (ctor', pats')
+  | GPatOr pats as pat0 ->
+    let pats' = List.Smart.map (subst_glb_pat subst) pats in
+    if pats' == pats then pat0
+    else GPatOr pats'
+  | GPatAs (p,x) as pat0 ->
+    let p' = subst_glb_pat subst p in
+    if p' == p then pat0
+    else GPatAs (p',x)
+
+let rec subst_expr subst e = match e with
+| GTacAtm _ | GTacVar _ | GTacPrm _ -> e
+| GTacRef kn -> GTacRef (subst_kn subst kn)
+| GTacFun (ids, e) -> GTacFun (ids, subst_expr subst e)
+| GTacApp (f, args) ->
+  GTacApp (subst_expr subst f, List.map (fun e -> subst_expr subst e) args)
+| GTacLet (r, bs, e) ->
+  let bs = List.map (fun (na, e) -> (na, subst_expr subst e)) bs in
+  GTacLet (r, bs, subst_expr subst e)
+| GTacCst (t, n, el) as e0 ->
+  let t' = subst_or_tuple subst_kn subst t in
+  let el' = List.Smart.map (fun e -> subst_expr subst e) el in
+  if t' == t && el' == el then e0 else GTacCst (t', n, el')
+| GTacCse (e, ci, cse0, cse1) ->
+  let cse0' = Array.map (fun e -> subst_expr subst e) cse0 in
+  let cse1' = Array.map (fun (ids, e) -> (ids, subst_expr subst e)) cse1 in
+  let ci' = subst_or_tuple subst_kn subst ci in
+  GTacCse (subst_expr subst e, ci', cse0', cse1')
+| GTacWth { opn_match = e; opn_branch = br; opn_default = (na, def) } as e0 ->
+  let e' = subst_expr subst e in
+  let def' = subst_expr subst def in
+  let fold kn (self, vars, p) accu =
+    let kn' = subst_kn subst kn in
+    let p' = subst_expr subst p in
+    if kn' == kn && p' == p then accu
+    else KerName.Map.add kn' (self, vars, p') (KerName.Map.remove kn accu)
+  in
+  let br' = KerName.Map.fold fold br br in
+  if e' == e && br' == br && def' == def then e0
+  else GTacWth { opn_match = e'; opn_default = (na, def'); opn_branch = br' }
+| GTacFullMatch (e,brs) as e0 ->
+  let e' = subst_expr subst e in
+  let brs' = List.Smart.map (fun (pat,br as pbr) ->
+      let pat' = subst_glb_pat subst pat in
+      let br' = subst_expr subst br in
+      if pat' == pat && br' == br then pbr
+      else (pat',br'))
+      brs
+  in
+  if e' == e && brs' == brs then e0
+  else GTacFullMatch (e', brs')
+| GTacPrj (kn, e, p) as e0 ->
+  let kn' = subst_kn subst kn in
+  let e' = subst_expr subst e in
+  if kn' == kn && e' == e then e0 else GTacPrj (kn', e', p)
+| GTacSet (kn, e, p, r) as e0 ->
+  let kn' = subst_kn subst kn in
+  let e' = subst_expr subst e in
+  let r' = subst_expr subst r in
+  if kn' == kn && e' == e && r' == r then e0 else GTacSet (kn', e', p, r')
+| GTacExt (tag, arg) ->
+  let tpe = Tac2env.interp_ml_object tag in
+  let arg' = tpe.ml_subst subst arg in
+  if arg' == arg then e else GTacExt (tag, arg')
+| GTacOpn (kn, el) as e0 ->
+  let kn' = subst_kn subst kn in
+  let el' = List.Smart.map (fun e -> subst_expr subst e) el in
+  if kn' == kn && el' == el then e0 else GTacOpn (kn', el')
+
+let subst_typedef subst e = match e with
+| GTydDef t ->
+  let t' = Option.Smart.map (fun t -> subst_type subst t) t in
+  if t' == t then e else GTydDef t'
+| GTydAlg galg ->
+  let map (warn, c, tl as p) =
+    let tl' = List.Smart.map (fun t -> subst_type subst t) tl in
+    if tl' == tl then p else (warn, c, tl')
+  in
+  let constrs' = List.Smart.map map galg.galg_constructors in
+  if constrs' == galg.galg_constructors then e
+  else GTydAlg { galg with galg_constructors = constrs' }
+| GTydRec fields ->
+  let map (c, mut, t as p) =
+    let t' = subst_type subst t in
+    if t' == t then p else (c, mut, t')
+  in
+  let fields' = List.Smart.map map fields in
+  if fields' == fields then e else GTydRec fields'
+| GTydOpn -> GTydOpn
+
+let subst_quant_typedef subst (prm, def as qdef) =
+  let def' = subst_typedef subst def in
+  if def' == def then qdef else (prm, def')
+
+let subst_type_scheme subst (prm, t as sch) =
+  let t' = subst_type subst t in
+  if t' == t then sch else (prm, t')
+
+let subst_or_relid subst ref = match ref with
+| RelId _ -> ref
+| AbsKn kn ->
+  let kn' = subst_or_tuple subst_kn subst kn in
+  if kn' == kn then ref else AbsKn kn'
+
+let rec subst_rawtype subst ({CAst.loc;v=tr} as t) = match tr with
+| CTypVar _ -> t
+| CTypArrow (t1, t2) ->
+  let t1' = subst_rawtype subst t1 in
+  let t2' = subst_rawtype subst t2 in
+  if t1' == t1 && t2' == t2 then t else CAst.make ?loc @@ CTypArrow (t1', t2')
+| CTypRef (ref, tl) ->
+  let ref' = subst_or_relid subst ref in
+  let tl' = List.Smart.map (fun t -> subst_rawtype subst t) tl in
+  if ref' == ref && tl' == tl then t else CAst.make ?loc @@ CTypRef (ref', tl')
+
+let subst_tacref subst ref = match ref with
+| RelId _ -> ref
+| AbsKn (TacConstant kn) ->
+  let kn' = subst_kn subst kn in
+  if kn' == kn then ref else AbsKn (TacConstant kn')
+| AbsKn (TacAbbrev kn) ->
+  let kn' = subst_kn subst kn in
+  if kn' == kn then ref else AbsKn (TacAbbrev kn')
+
+let subst_projection subst prj = match prj with
+| RelId _ -> prj
+| AbsKn kn ->
+  let kn' = subst_kn subst kn in
+  if kn' == kn then prj else AbsKn kn'
+
+let rec subst_rawpattern subst ({CAst.loc;v=pr} as p) = match pr with
+| CPatVar _ | CPatAtm _ -> p
+| CPatRef (c, pl) ->
+  let pl' = List.Smart.map (fun p -> subst_rawpattern subst p) pl in
+  let c' = subst_or_relid subst c in
+  if pl' == pl && c' == c then p else CAst.make ?loc @@ CPatRef (c', pl')
+| CPatCnv (pat, ty) ->
+  let pat' = subst_rawpattern subst pat in
+  let ty' = subst_rawtype subst ty in
+  if pat' == pat && ty' == ty then p else CAst.make ?loc @@ CPatCnv (pat', ty')
+| CPatOr pl ->
+  let pl' = List.Smart.map (fun p -> subst_rawpattern subst p) pl in
+  if pl' == pl then p else CAst.make ?loc @@ CPatOr pl'
+| CPatAs (pat,x) ->
+  let pat' = subst_rawpattern subst pat in
+  if pat' == pat then p else CAst.make ?loc @@ CPatAs (pat', x)
+| CPatRecord el ->
+  let map (prj, e as p) =
+    let prj' = subst_projection subst prj in
+    let e' = subst_rawpattern subst e in
+    if prj' == prj && e' == e then p else (prj', e')
+  in
+  let el' = List.Smart.map map el in
+  if el' == el then p else CAst.make ?loc @@ CPatRecord el'
+
+(** Used for notations *)
+let rec subst_rawexpr subst ({CAst.loc;v=tr} as t) = match tr with
+| CTacAtm _ -> t
+| CTacRef ref ->
+  let ref' = subst_tacref subst ref in
+  if ref' == ref then t else CAst.make ?loc @@ CTacRef ref'
+| CTacCst ref ->
+  let ref' = subst_or_relid subst ref in
+  if ref' == ref then t else CAst.make ?loc @@ CTacCst ref'
+| CTacFun (bnd, e) ->
+  let map pat = subst_rawpattern subst pat in
+  let bnd' = List.Smart.map map bnd in
+  let e' = subst_rawexpr subst e in
+  if bnd' == bnd && e' == e then t else CAst.make ?loc @@ CTacFun (bnd', e')
+| CTacApp (e, el) ->
+  let e' = subst_rawexpr subst e in
+  let el' = List.Smart.map (fun e -> subst_rawexpr subst e) el in
+  if e' == e && el' == el then t else CAst.make ?loc @@ CTacApp (e', el')
+| CTacLet (isrec, bnd, e) ->
+  let map (na, e as p) =
+    let na' = subst_rawpattern subst na in
+    let e' = subst_rawexpr subst e in
+    if na' == na && e' == e then p else (na', e')
+  in
+  let bnd' = List.Smart.map map bnd in
+  let e' = subst_rawexpr subst e in
+  if bnd' == bnd && e' == e then t else CAst.make ?loc @@ CTacLet (isrec, bnd', e')
+| CTacCnv (e, c) ->
+  let e' = subst_rawexpr subst e in
+  let c' = subst_rawtype subst c in
+  if c' == c && e' == e then t else CAst.make ?loc @@ CTacCnv (e', c')
+| CTacSeq (e1, e2) ->
+  let e1' = subst_rawexpr subst e1 in
+  let e2' = subst_rawexpr subst e2 in
+  if e1' == e1 && e2' == e2 then t else CAst.make ?loc @@ CTacSeq (e1', e2')
+| CTacIft (e, e1, e2) ->
+  let e' = subst_rawexpr subst e in
+  let e1' = subst_rawexpr subst e1 in
+  let e2' = subst_rawexpr subst e2 in
+  if e' == e && e1' == e1 && e2' == e2 then t else CAst.make ?loc @@ CTacIft (e', e1', e2')
+| CTacCse (e, bl) ->
+  let map (p, e as x) =
+    let p' = subst_rawpattern subst p in
+    let e' = subst_rawexpr subst e in
+    if p' == p && e' == e then x else (p', e')
+  in
+  let e' = subst_rawexpr subst e in
+  let bl' = List.Smart.map map bl in
+  if e' == e && bl' == bl then t else CAst.make ?loc @@ CTacCse (e', bl')
+| CTacRec (def, el) ->
+  let def' = Option.Smart.map (subst_rawexpr subst) def in
+  let map (prj, e as p) =
+    let prj' = subst_projection subst prj in
+    let e' = subst_rawexpr subst e in
+    if prj' == prj && e' == e then p else (prj', e')
+  in
+  let el' = List.Smart.map map el in
+  if def' == def && el' == el then t else CAst.make ?loc @@ CTacRec (def',el')
+| CTacPrj (e, prj) ->
+    let prj' = subst_projection subst prj in
+    let e' = subst_rawexpr subst e in
+    if prj' == prj && e' == e then t else CAst.make ?loc @@ CTacPrj (e', prj')
+| CTacSet (e, prj, r) ->
+    let prj' = subst_projection subst prj in
+    let e' = subst_rawexpr subst e in
+    let r' = subst_rawexpr subst r in
+    if prj' == prj && e' == e && r' == r then t else CAst.make ?loc @@ CTacSet (e', prj', r')
+| CTacGlb (prms, args, body, ty) ->
+  let args' = List.Smart.map (fun (na, arg, ty as o) ->
+      let arg' = subst_rawexpr subst arg in
+      let ty' = Option.Smart.map (subst_type subst) ty in
+      if arg' == arg && ty' == ty then o
+      else (na, arg', ty'))
+      args
+  in
+  let body' = subst_expr subst body in
+  let ty' = subst_type subst ty in
+  if args' == args && body' == body && ty' == ty then t
+  else CAst.make ?loc @@ CTacGlb (prms, args', body', ty')
+| CTacSyn _ | CTacExt _ -> assert false (** Should not be generated by globalization *)
+
+let () = Gensubst.register_constr_subst Tac2env.wit_ltac2_constr (fun s (ids, e) -> ids, subst_expr s e)
+let () = Gentactic.register_subst Tac2env.wit_ltac2_tac subst_expr
diff --git a/plugins/ltac2/tac2subst.mli b/plugins/ltac2/tac2subst.mli
new file mode 100644
index 000000000000..eb3649fdd40c
--- /dev/null
+++ b/plugins/ltac2/tac2subst.mli
@@ -0,0 +1,19 @@
+(************************************************************************)
+(*         *      The Rocq Prover / The Rocq Development Team           *)
+(*  v      *         Copyright INRIA, CNRS and contributors             *)
+(*  'a glb_typexpr -> 'a glb_typexpr
+val subst_expr : substitution -> glb_tacexpr -> glb_tacexpr
+val subst_quant_typedef : substitution -> glb_quant_typedef -> glb_quant_typedef
+val subst_type_scheme : substitution -> type_scheme -> type_scheme
+
+val subst_rawexpr : substitution -> raw_tacexpr -> raw_tacexpr
diff --git a/plugins/ltac2/tac2syn.ml b/plugins/ltac2/tac2syn.ml
new file mode 100644
index 000000000000..111cb782f683
--- /dev/null
+++ b/plugins/ltac2/tac2syn.ml
@@ -0,0 +1,943 @@
+(************************************************************************)
+(*         *      The Rocq Prover / The Rocq Development Team           *)
+(*  v      *         Copyright INRIA, CNRS and contributors             *)
+(* 
+    CErrors.user_err ?loc:sc.loc Pp.(str "Unknown Ltac2 scope " ++ Libnames.pr_qualid sc ++ str ".")
+
+let load_scope i ((sp,kn),()) =
+  ScopeTab.push (Until i) sp kn
+
+let import_scope i ((sp,kn),()) =
+  ScopeTab.push (Exactly i) sp kn
+
+let cache_scope o =
+  load_scope 1 o;
+  import_scope 1 o
+
+let inScope : Id.t -> unit -> Libobject.obj =
+  let open Libobject in
+  declare_named_object {
+    (default_object "Ltac2 notation scope") with
+    object_stage = Interp;
+    cache_function = cache_scope;
+    load_function = load_scope;
+    open_function = filtered_open import_scope;
+    subst_function = (fun (_,()) -> ());
+    classify_function = (fun () -> Substitute);
+  }
+
+let declare_scope id =
+  let () = if ScopeTab.exists (Lib.make_path id) then
+      CErrors.user_err Pp.(str "Ltac2 notation scope " ++ Id.print id ++ str " already exists.")
+  in
+  Lib.add_leaf (inScope id ())
+
+let current_scopes = Summary.ref ~name:"ltac2-current-scopes" []
+
+type open_close_scope = Open | Close
+
+let cache_open_close_scope (sc,openclose) =
+  match openclose with
+  | Open -> current_scopes := sc :: (List.remove Tac2Scope.equal sc !current_scopes)
+  | Close -> current_scopes := List.remove Tac2Scope.equal sc !current_scopes
+
+let inOpenCloseScope =
+  Libobject.declare_object @@
+  Libobject.object_with_locality "Ltac2 open/close scope"
+    ~cache:cache_open_close_scope
+    ~subst:(Some (fun (subst,(sc,openclose)) -> Mod_subst.subst_kn subst sc, openclose))
+    ~discharge:(fun x -> x)
+
+let open_close_scope local sc openclose =
+  let sc = find_scope sc in
+  Lib.add_leaf (inOpenCloseScope (local,(sc,openclose)))
+
+let open_scope local sc = open_close_scope local sc Open
+let close_scope local sc = open_close_scope local sc Close
+
+let default_scope = Summary.ref ~name:"ltac2-default-scope" None
+
+let cache_default_scope sc =
+  let () = if Option.has_some !default_scope then
+      CErrors.user_err Pp.(str "Declare ML Module for the Ltac2 plugin in multiple Rocq modules is not supported.")
+  in
+  default_scope := Some sc
+
+let inDefaultScope =
+  Libobject.declare_object @@
+  Libobject.superglobal_object "ltac2 default scope"
+    ~cache:cache_default_scope
+    ~subst:None
+    ~discharge:(fun _ -> assert false)
+
+let declare_default_scope () =
+  let sc = Id.of_string "core" in
+  declare_scope sc;
+  let sc = ScopeTab.locate (Libnames.qualid_of_ident sc) in
+  Lib.add_leaf (inDefaultScope sc)
+
+let () =
+  Mltop.(declare_cache_obj_full (interp_only_obj declare_default_scope) "rocq-runtime.plugins.ltac2")
+
+let default_scope () = match !default_scope with
+  | Some v -> v
+  | None -> assert false
+
+let current_scopes () = !current_scopes
+
+module Tac2Custom = KerName
+
+module CustomV = struct
+  include Tac2Custom
+  let is_var _ = None
+  let stage = Summary.Stage.Synterp
+  let summary_name = "ltac2_customentrytab"
+end
+module CustomTab = Nametab.EasyNoWarn(CustomV)()
+
+let ltac2_custom_map : raw_tacexpr Procq.Entry.t Tac2Custom.Map.t Procq.GramState.field =
+  Procq.GramState.field "ltac2_custom_map"
+
+let ltac2_custom_entry : (Tac2Custom.t, raw_tacexpr) Procq.entry_command =
+  Procq.create_entry_command "ltac2" {
+    eext_fun = (fun kn e state ->
+      let map = Option.default Tac2Custom.Map.empty (Procq.GramState.get state ltac2_custom_map) in
+      let map = Tac2Custom.Map.add kn e map in
+      Procq.GramState.set state ltac2_custom_map map);
+    eext_name = (fun kn -> "custom-ltac2:" ^ Tac2Custom.to_string kn);
+    eext_eq = Tac2Custom.equal;
+  }
+
+let find_custom_entry kn =
+  Tac2Custom.Map.get kn @@ Option.get @@ Procq.GramState.get (Procq.gramstate()) ltac2_custom_map
+
+let () =
+  Metasyntax.register_custom_grammar_for_print @@ fun name ->
+  match CustomTab.locate name with
+  | exception Not_found -> None
+  | name -> Some [Any (find_custom_entry name)]
+
+let load_custom_entry i ((sp,kn),local) =
+  let () = CustomTab.push (Until i) sp kn in
+  let () = Procq.extend_entry_command ltac2_custom_entry kn in
+  let () = assert (not local) in
+  ()
+
+let import_custom_entry i ((sp,kn),local) =
+  let () = CustomTab.push (Exactly i) sp kn in
+  ()
+
+let cache_custom_entry o =
+  load_custom_entry 1 o;
+  import_custom_entry 1 o
+
+let inCustomEntry : Id.t -> bool -> Libobject.obj =
+  let open Libobject in
+  declare_named_object {
+    (default_object "Ltac2 custom entry") with
+    object_stage = Synterp;
+    cache_function = cache_custom_entry;
+    load_function = load_custom_entry;
+    open_function = filtered_open import_custom_entry;
+    subst_function = (fun (_,x) -> x);
+    classify_function = (fun local -> if local then Dispose else Substitute);
+  }
+
+module Syntax = struct
+
+  module DynEntry = Dyn.Make()
+
+  module EntryMap = DynEntry.Map(struct type 'a t = 'a Procq.Entry.t end)
+
+  let entries = ref EntryMap.empty
+
+  (* NB someday we may want to allow registering more custom entry kinds
+     instead of handling custom constr and custom ltac2 specially *)
+  type 'a entry =
+    | RegisteredEntry of 'a DynEntry.tag
+    | CustomConstr : Globnames.CustomName.t -> Constrexpr.constr_expr entry
+    | CustomLtac2 : Tac2Custom.t -> raw_tacexpr entry
+
+  let register_entry ?name entry =
+    let name = Option.default (Procq.Entry.name entry) name in
+    let tag = DynEntry.create name in
+    entries := EntryMap.add tag entry !entries;
+    RegisteredEntry tag
+
+  let get_entry : type a. a entry -> a Procq.Entry.t = function
+    | RegisteredEntry e -> EntryMap.find e !entries
+    | CustomConstr e -> fst @@ Egramrocq.find_custom_entry e
+    | CustomLtac2 e -> find_custom_entry e
+
+  let entry_equal : type a b. a entry -> b entry -> (a, b) Util.eq option = fun a b ->
+    match a, b with
+    | RegisteredEntry a, RegisteredEntry b -> DynEntry.eq a b
+    | CustomConstr a, CustomConstr b ->
+      if Globnames.CustomName.equal a b then Some Refl else None
+    | CustomLtac2 a, CustomLtac2 b ->
+      if Tac2Custom.equal a b then Some Refl else None
+    | (RegisteredEntry _ | CustomConstr _ | CustomLtac2 _), _ -> None
+
+  let entry_compare : type a b. a entry -> b entry -> int = fun a b ->
+    match a, b with
+    | RegisteredEntry a, RegisteredEntry b -> DynEntry.compare a b
+    | RegisteredEntry _, _ -> -1
+    | _, RegisteredEntry _ -> 1
+    | CustomConstr a, CustomConstr b -> Globnames.CustomName.compare a b
+    | CustomConstr _, _ -> -1
+    | _, CustomConstr _ -> 1
+    | CustomLtac2 a, CustomLtac2 b -> Tac2Custom.compare a b
+
+  type 'a t =
+    | NTerm of 'a entry
+    | NTerml of 'a entry * string
+    | List0 : 'a t * string option -> 'a list t
+    | List1 : 'a t * string option -> 'a list t
+    | Opt : 'a t -> 'a option t
+    | Self : raw_tacexpr t
+    | Next : raw_tacexpr t
+    | Token of 'a Tok.p
+    | Tokens : Procq.ty_pattern list -> unit t
+    | Seq of 'a seq
+
+  and _ seq =
+    | Nil : unit seq
+    | Snoc : 'a seq * 'b t -> ('a * 'b) seq
+    (* We use snoc lists for seq because that works better when translating to Procq.Rule.t
+       (the same argument is on the outside of the tuple ['r] and of the function type ['f]) *)
+
+  type _ rec_ =
+    | NoRec : Gramlib.Grammar.norec rec_
+    | MayRec
+
+  type 'a symbol = Symb : 'mayrec rec_ * (raw_tacexpr, 'mayrec, 'a) Procq.Symbol.t -> 'a symbol
+
+  (* Procq.Rule.t contains the type ['fulla] parsed by the whole seq in it last argument.
+     We connect it to the type ['a] involved in the head of the seq using this GADT.
+     (and also handle mayrec) *)
+  type ('a,'fulla) rule =
+      Rule :
+        'mayrec rec_ *
+        (('a -> Loc.t -> 'fulla) -> 'f) *
+        (raw_tacexpr, 'mayrec, 'f, Loc.t -> 'fulla) Procq.Rule.t ->
+        ('a,'fulla) rule
+
+  let norec s = Symb (NoRec, s)
+
+  let rec to_symbol : type a. a t -> a symbol = fun s ->
+    let open Procq.Symbol in
+    match s with
+    | NTerm e -> norec @@ nterm (get_entry e)
+    | NTerml (e, lev) -> norec @@ nterml (get_entry e) lev
+    | List0 (s, None) ->
+      let Symb (mayrec, s) = to_symbol s in
+      Symb (mayrec, list0 s)
+    | List0 (s, Some sep) ->
+      let Symb (mayrec, s) = to_symbol s in
+      let sep = tokens [TPattern (CLexer.terminal sep)] in
+      Symb (mayrec, list0sep s sep)
+    | List1 (s, None) ->
+      let Symb (mayrec, s) = to_symbol s in
+      Symb (mayrec, list1 s)
+    | List1 (s, Some sep) ->
+      let Symb (mayrec, s) = to_symbol s in
+      let sep = tokens [TPattern (CLexer.terminal sep)] in
+      Symb (mayrec, list1sep s sep)
+    | Opt s ->
+      let Symb (mayrec, s) = to_symbol s in
+      Symb (mayrec, opt s)
+    | Self -> Symb (MayRec, self)
+    | Next -> Symb (MayRec, next)
+    | Token p -> norec @@ token p
+    | Tokens l -> norec @@ tokens l
+    | Seq s -> seq_to_symbol s
+
+  and seq_to_rule : type a fulla. a seq -> (a,fulla) rule =
+    fun s ->
+    match s with
+    | Nil -> Rule (NoRec, (fun f (loc:Loc.t) -> f () loc), Procq.Rule.stop)
+    | Snoc (hd, x) ->
+      let Rule (rechd, f, hd) = seq_to_rule hd in
+      let Symb (recx, x) = to_symbol x in
+      let f (g:a -> Loc.t -> fulla) x = f (fun hd loc -> g (hd, x) loc) in
+      match rechd, recx with
+      | NoRec, NoRec ->
+        let rule = Procq.Rule.next_norec hd x in
+        Rule (NoRec, f, rule)
+      | MayRec, _ | _, MayRec ->
+        let rule = Procq.Rule.next hd x in
+        Rule (MayRec, f, rule)
+
+  and seq_to_symbol : type a. a seq -> a symbol = fun s ->
+    let open Procq.Symbol in
+    let Rule (mayrec, f, r) = seq_to_rule s in
+    match mayrec with
+    | MayRec ->
+      CErrors.user_err Pp.(str "Recursive symbols (self / next) are not allowed in local rules.")
+    | NoRec -> norec @@ rules [Procq.Rules.make r (f (fun (x:a) (_:Loc.t) -> x))]
+
+  let constr = register_entry Procq.Constr.constr
+  let lconstr = register_entry Procq.Constr.lconstr
+  let term = register_entry Procq.Constr.term
+
+  let custom_constr c = CustomConstr c
+  let custom_ltac2 c = CustomLtac2 c
+
+  let ltac2_expr = register_entry internal_ltac2_expr
+
+  let nterm e = NTerm e
+  let nterml e lev = NTerml (e, lev)
+  let list0 ?sep s = List0 (s, sep)
+  let list1 ?sep s = List1 (s, sep)
+  let opt s = Opt s
+  let self = Self
+  let next = Next
+  let token p = Token p
+  let tokens l = Tokens l
+
+  let seq s = Seq s
+  let nil = Nil
+  let snoc a b = Snoc (a, b)
+
+  let rec equal : type a b. a t -> b t -> (a, b) Util.eq option = fun a b ->
+    match a, b with
+    | NTerm a, NTerm b -> entry_equal a b
+    | NTerml (a, leva), NTerml (b, levb) ->
+      let e = entry_equal a b in
+      if Option.has_some e && String.equal leva levb then e
+      else None
+    | List0 (a, sepa), List0 (b, sepb) ->
+      begin match equal a b with
+      | None -> None
+      | Some Refl -> if Option.equal String.equal sepa sepb then Some Refl else None
+      end
+    | List1 (a, sepa), List1 (b, sepb) ->
+      begin match equal a b with
+      | None -> None
+      | Some Refl -> if Option.equal String.equal sepa sepb then Some Refl else None
+      end
+    | Opt a, Opt b ->
+      begin match equal a b with
+      | None -> None
+      | Some Refl -> Some Refl
+      end
+    | Self, Self -> Some Refl
+    | Next, Next -> Some Refl
+    | Token a, Token b -> Tok.equal_p a b
+    | Tokens a, Tokens b ->
+      let eq (Procq.TPattern p1) (Procq.TPattern p2) = Option.has_some (Tok.equal_p p1 p2) in
+      if CList.for_all2eq eq a b then Some Refl else None
+    | Seq s1, Seq s2  -> equal_seq s1 s2
+    | (NTerm _ | NTerml _ | List0 _ | List1 _ | Opt _
+      | Self | Next | Token _ | Tokens _ | Seq _), _ ->
+      None
+
+  and equal_seq : type a b. a seq -> b seq -> (a, b) Util.eq option = fun a b ->
+    match a, b with
+    | Nil, Nil -> Some Refl
+    | Snoc (a1, a2), Snoc (b1, b2) ->
+      begin match equal_seq a1 b1 with
+      | None -> None
+      | Some Refl -> match equal a2 b2 with
+        | None -> None
+        | Some Refl -> Some Refl
+      end
+    | (Nil | Snoc _), _ -> None
+
+  let rec compare : type a b. a t -> b t -> int = fun a b ->
+    match a, b with
+    | NTerm a, NTerm b -> entry_compare a b
+    | NTerm _, _ -> -1
+    | _, NTerm _ -> 1
+    | NTerml (a, leva), NTerml (b, levb) ->
+      let e = entry_compare a b in
+      if e <> 0 then e else String.compare leva levb
+    | NTerml _, _ -> -1
+    | _, NTerml _ -> 1
+    | List0 (a, sepa), List0 (b, sepb) ->
+      begin match compare a b with
+      | 0 -> Option.compare String.compare sepa sepb
+      | c -> c
+      end
+    | List0 _, _ -> -1
+    | _, List0 _ -> 1
+    | List1 (a, sepa), List1 (b, sepb) ->
+      begin match compare a b with
+      | 0 -> Option.compare String.compare sepa sepb
+      | c -> c
+      end
+    | List1 _, _ -> -1
+    | _, List1 _ -> 1
+    | Opt a, Opt b -> compare a b
+    | Opt _, _ -> -1
+    | _, Opt _ -> 1
+    | Self, Self -> 0
+    | Self, _ -> -1
+    | _, Self -> 1
+    | Next, Next -> 0
+    | Next, _ -> -1
+    | _, Next -> 1
+    (* XXX treating [PIDENT (Some s)] and [PKEYWORD s] as equal may be
+       questionable, consider moving Tok.compare_p to this file (only
+       user at this time) and comparing them to be different
+       (AFAICT compare = 0 -> equal = Some Refl is the more important invariant,
+       we don't care as much about the other direction) *)
+    | Token a, Token b -> Tok.compare_p a b
+    | Token _, _ -> -1
+    | _, Token _ -> 1
+    | Tokens a, Tokens b ->
+      let cmp (Procq.TPattern p1) (Procq.TPattern p2) = Tok.compare_p p1 p2 in
+      CList.compare cmp a b
+    | Tokens _, _ -> -1
+    | _, Tokens _ -> 1
+    | Seq s1, Seq s2  -> compare_seq s1 s2
+
+  and compare_seq : type a b. a seq -> b seq -> int = fun a b ->
+    match a, b with
+    | Nil, Nil -> 0
+    | Nil, _ -> -1
+    | _, Nil -> 1
+    | Snoc (a1, a2), Snoc (b1, b2) ->
+      begin match compare_seq a1 b1 with
+      | 0 -> compare a2 b2
+      | c -> c
+      end
+end
+
+module ParsedNota = struct
+  (* parsing rule + which entry it is in *)
+  (* XXX also include level? *)
+  type 'a t = 'a Syntax.seq * Tac2Custom.t option
+
+  type any = Any : _ t -> any
+
+  let compare (a1,a2) (b1,b2) =
+    let c = Option.compare Tac2Custom.compare a2 b2 in
+    if c <> 0 then c else Syntax.compare_seq a1 b1
+
+  module Any = struct
+    type t = any
+    let compare (Any x) (Any y) = compare x y
+  end
+  module AnyMap = CMap.Make(Any)
+end
+
+module TacSyn = struct
+  type t = WithArgs : 'a ParsedNota.t * 'a -> t
+
+  let make (x:t) : tacsyn = Obj.magic x
+  let get (x:tacsyn) : t = Obj.magic x
+
+end
+
+type 'a token =
+| TacTerm of string
+| TacNonTerm of Name.t * 'a
+
+type syntax_class_rule =
+| SyntaxRule : 'a Syntax.t * ('a -> raw_tacexpr) -> syntax_class_rule
+
+type used_levels = Int.Set.t Tac2Custom.Map.t
+
+let no_used_levels = Tac2Custom.Map.empty
+
+let union_used_levels a b =
+  Tac2Custom.Map.union (fun _ a b -> Some (Int.Set.union a b)) a b
+
+(* hardcoded syntactic classes, from ltac2 or further plugins *)
+type 'glb syntax_class_decl = {
+  intern_synclass : sexpr list -> used_levels * 'glb;
+  interp_synclass : 'glb -> syntax_class_rule;
+}
+
+module SynclassDyn = Dyn.Make()
+
+type syntax_class = SynclassDyn.t
+
+module SynclassInterpMap = SynclassDyn.Map(struct
+    type 'a t = 'a -> syntax_class_rule
+  end)
+
+let syntax_class_interns : (sexpr list -> used_levels * SynclassDyn.t) Id.Map.t ref =
+  ref Id.Map.empty
+
+let syntax_class_interps = ref SynclassInterpMap.empty
+
+let check_custom_entry_name id =
+  (* XXX allow it anyway? the name can be accessed by qualifying it *)
+  if Id.Map.mem id !syntax_class_interns then
+    CErrors.user_err
+      Pp.(str "Cannot declare " ++ Id.print id ++
+          str " as a ltac2 custom entry:" ++ spc() ++
+          str "that name is already used for a builtin syntactic class.")
+  else if CustomTab.exists (Lib.make_path id) then
+    CErrors.user_err Pp.(str "Ltac2 custom entry " ++ Id.print id ++ str " already exists.")
+
+let register_custom_entry name =
+  let name = name.CAst.v in
+  check_custom_entry_name name;
+  (* not yet implemented: module local custom entries
+     NB: will need checks that exported notations don't rely on the local entries *)
+  let local = false in
+  Lib.add_leaf (inCustomEntry name local)
+
+let register_syntax_class id (s:_ syntax_class_decl) =
+  assert (not (Id.Map.mem id !syntax_class_interns));
+  let tag = SynclassDyn.create (Id.to_string id) in
+  let intern args =
+    let used, data = s.intern_synclass args in
+    used, SynclassDyn.Dyn (tag, data)
+  in
+  syntax_class_interns := Id.Map.add id intern !syntax_class_interns;
+  syntax_class_interps := SynclassInterpMap.add tag s.interp_synclass !syntax_class_interps
+
+let level_name lev = string_of_int lev
+
+let terminal_synclass_tag : string SynclassDyn.tag = SynclassDyn.create ""
+
+let interp_terminal str : syntax_class_rule =
+  let v_unit = CAst.make @@ CTacCst (AbsKn (Tuple 0)) in
+  SyntaxRule (Syntax.token (Tok.PIDENT (Some str)), (fun _ -> v_unit))
+
+let () =
+  syntax_class_interps := SynclassInterpMap.add terminal_synclass_tag interp_terminal !syntax_class_interps
+
+type custom_synclass_data = {
+  custom_synclass_name : Tac2Custom.t;
+  custom_synclass_level : int option;
+}
+
+let interp_custom_entry data : syntax_class_rule =
+  let ename = data.custom_synclass_name in
+  let entry = Syntax.custom_ltac2 ename in
+  match data.custom_synclass_level with
+  | None ->
+    SyntaxRule (Syntax.nterm entry, (fun expr -> expr))
+  | Some lev ->
+    SyntaxRule (Syntax.nterml entry (level_name lev), (fun expr -> expr))
+
+let custom_synclass_tag : custom_synclass_data SynclassDyn.tag = SynclassDyn.create ""
+
+let () =
+  syntax_class_interps := SynclassInterpMap.add custom_synclass_tag interp_custom_entry !syntax_class_interps
+
+let intern_custom_entry ?loc qid ename args : used_levels * custom_synclass_data =
+  let lev =
+    match args with
+    | [] -> None
+    | [SexprInt {CAst.v=lev}] -> Some lev
+    | _ :: _ ->
+      CErrors.user_err ?loc
+        Pp.(str "Invalid arguments for ltac2 custom entry " ++ pr_qualid qid ++ str ".")
+  in
+  let used = match lev with
+    | None -> no_used_levels
+    | Some lev -> Tac2Custom.Map.singleton ename (Int.Set.singleton lev)
+  in
+  used, { custom_synclass_name = ename;
+    custom_synclass_level = lev;
+  }
+
+let intern_syntactic_class ?loc qid args =
+  let is_class =
+    if qualid_is_ident qid then Id.Map.find_opt (qualid_basename qid) !syntax_class_interns
+    else None
+  in
+  match is_class with
+  | Some intern -> intern args
+  | None ->
+    match CustomTab.locate qid with
+    | kn ->
+      let used, data = intern_custom_entry ?loc qid kn args in
+      used, SynclassDyn.Dyn (custom_synclass_tag, data)
+    | exception Not_found ->
+      CErrors.user_err ?loc Pp.(str "Unknown syntactic class" ++ spc () ++ pr_qualid qid)
+
+module ParseToken =
+struct
+
+let loc_of_token = function
+| SexprStr {loc} -> loc
+| SexprInt {loc} -> loc
+| SexprRec (loc, _, _) -> Some loc
+
+let intern_syntax_class = function
+| SexprRec (_, {loc;v=Some id}, toks) ->
+  intern_syntactic_class id toks
+| SexprStr {v=str} -> no_used_levels, SynclassDyn.Dyn (terminal_synclass_tag, str)
+| tok ->
+  let loc = loc_of_token tok in
+  CErrors.user_err ?loc Pp.(str "Invalid parsing token")
+
+let check_name na =
+  match na.CAst.v with
+  | None -> Anonymous
+  | Some id ->
+    let id = if qualid_is_ident id then qualid_basename id
+      else CErrors.user_err ?loc:id.loc Pp.(str "Must be an identifier.")
+    in
+    let () = check_lowercase (CAst.make ?loc:na.CAst.loc id) in
+    Name id
+
+let parse_token = function
+| SexprStr {v=s} -> no_used_levels, TacTerm s
+| SexprRec (_, na, [tok]) ->
+  let na = check_name na in
+  let used, syntax_class = intern_syntax_class tok in
+  used, TacNonTerm (na, syntax_class)
+| tok ->
+  let loc = loc_of_token tok in
+  CErrors.user_err ?loc Pp.(str "Invalid parsing token")
+
+let rec print_syntax_class = let open Pp in function
+| SexprStr s -> str s.CAst.v
+| SexprInt i -> int i.CAst.v
+| SexprRec (_, {v=na}, []) -> Option.cata pr_qualid (str "_") na
+| SexprRec (_, {v=na}, e) ->
+  Option.cata pr_qualid (str "_") na ++ str "(" ++ pr_sequence print_syntax_class e ++ str ")"
+
+let print_token = let open Pp in function
+| SexprStr {v=s} -> quote (str s)
+| SexprRec (_, {v=na}, [tok]) -> print_syntax_class tok
+| _ -> assert false
+
+end
+
+let intern_syntax_class = ParseToken.intern_syntax_class
+
+type synext = {
+  synext_used : used_levels;
+  synext_tok : ParsedNota.any;
+  synext_level : int;
+  synext_local : bool;
+}
+
+let interp_syntax_class (SynclassDyn.Dyn (tag, data)) =
+  let interp = SynclassInterpMap.find tag !syntax_class_interps in
+  interp data
+
+type any_seq = AnySeq : _ Syntax.seq -> any_seq
+
+let rec get_nota_parsing (tok : SynclassDyn.t token list) : any_seq = match tok with
+| [] -> AnySeq Nil
+| TacNonTerm (_, v) :: tok ->
+  let SyntaxRule (syntax_class, _) = interp_syntax_class v in
+  let AnySeq rest = get_nota_parsing tok in
+  AnySeq (Snoc (rest, syntax_class))
+| TacTerm t :: tok ->
+  let AnySeq rest = get_nota_parsing tok in
+  AnySeq (Snoc (rest, Syntax.token (CLexer.terminal t)))
+
+let deprecated_ltac2_notation =
+  Deprecation.create_warning
+    ~object_name:"Ltac2 notation"
+    ~warning_name_if_no_since:"deprecated-ltac2-notation"
+    Pp.(fun (toks : sexpr list) -> pr_sequence ParseToken.print_token toks)
+
+let ltac2_levels = Procq.GramState.field "ltac2_levels"
+
+(* XXX optional lev and do reusefirst like in egramrocq? *)
+let fresh_level st entry lev =
+  match entry with
+  | None -> st, None
+  | Some entry ->
+    let all_levels = Option.default Tac2Custom.Map.empty @@ Procq.GramState.get st ltac2_levels in
+    let entry_levels = Option.default Int.Set.empty @@ Tac2Custom.Map.find_opt entry all_levels in
+    let last_before = Int.Set.find_first_opt (fun lev' -> lev' >= lev) entry_levels in
+    if Option.equal Int.equal last_before (Some lev) then st, None
+    else
+      let pos = match last_before with
+        | None -> Gramlib.Gramext.First
+        | Some lev' -> Gramlib.Gramext.After (level_name lev')
+      in
+      let entry_levels = Int.Set.add lev entry_levels in
+      let all_levels = Tac2Custom.Map.add entry entry_levels all_levels in
+      let st = Procq.GramState.set st ltac2_levels all_levels in
+      st, Some pos
+
+let check_levels st used_levels =
+  let all_levels = Option.default Tac2Custom.Map.empty @@ Procq.GramState.get st ltac2_levels in
+  let iter kn used =
+    let known = Option.default Int.Set.empty (Tac2Custom.Map.find_opt kn all_levels) in
+    let missing = Int.Set.diff used known in
+    if not (Int.Set.is_empty missing) then
+      CErrors.user_err
+        Pp.(str "Unknown " ++ str (String.plural (Int.Set.cardinal missing) "level") ++
+            str " for ltac2 custom entry " ++ CustomTab.pr kn)
+  in
+  Tac2Custom.Map.iter iter used_levels
+
+let perform_notation syn st =
+  let Any parsing = syn.synext_tok in
+  let used = syn.synext_used in
+  let rule, entry = parsing in
+  let Rule (_, f, rule) = Syntax.seq_to_rule rule in
+  let g args loc =
+    CAst.make ~loc @@ CTacSyn (TacSyn.make @@ WithArgs (parsing, args))
+  in
+  let rule = Procq.Production.make rule (f g) in
+  let lev = syn.synext_level in
+  let st, fresh = fresh_level st entry lev in
+  let () = check_levels st used in
+  let pos = Some (level_name lev) in
+  let rule = match fresh with
+    | None -> Procq.Reuse (pos, [rule])
+    | Some pos' ->
+      (* BothA means we can have SELF on both the left and right of a rule. *)
+      Procq.Fresh (pos', [pos, Some BothA, [rule]])
+  in
+  let entry = match entry with
+    | None -> internal_ltac2_expr
+    | Some entry -> find_custom_entry entry
+  in
+  [Procq.ExtendRule (entry, rule)], st
+
+let ltac2_notation =
+  Procq.create_grammar_command "ltac2-notation" { gext_fun = perform_notation; gext_eq = (==) (* FIXME *) }
+
+let cache_synext syn =
+  Procq.extend_grammar_command ~ignore_kw:false ltac2_notation syn
+
+(* XXX missing subst on custom entries, including recursively in SynclassDyn.t *)
+let subst_synext (subst, syn) = syn
+
+let ltac2_notation_cat = Libobject.create_category "ltac2.notations"
+
+let inTac2Notation : synext -> Libobject.obj =
+  let open Libobject in
+  declare_object {(default_object "TAC2-NOTATION") with
+     object_stage = Summary.Stage.Synterp;
+     cache_function  = cache_synext;
+     open_function   = simple_open ~cat:ltac2_notation_cat cache_synext;
+     subst_function = subst_synext;
+     classify_function = (fun o -> if o.synext_local then Dispose else Substitute);
+  }
+
+type notation_data =
+  | UntypedNota of raw_tacexpr
+  | TypedNota of {
+      nota_prms : int;
+      nota_argtys : int glb_typexpr Id.Map.t;
+      nota_ty : int glb_typexpr;
+      nota_body : glb_tacexpr;
+    }
+
+type ('scope,'body) notation_interpretation = {
+  nota_local : bool;
+  (* sexpr used for printing deprecation message, XXX print the internalized version? *)
+  nota_raw : sexpr list;
+  nota_depr : Deprecation.t option;
+  nota_parsing : ParsedNota.any;
+  nota_scope : 'scope;
+  nota_tok : SynclassDyn.t token list;
+  nota_body : 'body;
+}
+
+let notation_data : (Tac2Scope.t, notation_data) notation_interpretation Tac2Scope.Map.t ParsedNota.AnyMap.t ref =
+  Summary.ref ~name:"tac2notation-data" ParsedNota.AnyMap.empty
+
+let rec interp_notation_args : type a. a Syntax.seq -> _ -> a -> _ = fun parsing toks args ->
+  match parsing, toks, args with
+  | Nil, (_::_), ()
+  | Snoc _, [], (_, _) -> assert false
+  | Nil, [], () -> []
+  | Snoc (hd, _), TacTerm _ :: toks, (args, _) -> interp_notation_args hd toks args
+  | Snoc (hd, x), TacNonTerm (na, tok) :: toks, (args, arg) ->
+    let SyntaxRule (x', inj) = interp_syntax_class tok in
+    let Refl = match Syntax.equal x x' with
+      | None -> assert false
+      | Some e -> e
+    in
+    let arg = inj arg in
+    (* XXX loc (only used for untyped notations though) *)
+    (CAst.make na, arg) :: interp_notation_args hd toks args
+
+(* to have scoped notations: add a scope stack argument here,
+   per-scope notations in the notation_data map, and user syntax for
+   scopes *)
+let interp_notation ?loc scopes syn
+  : notation_data * (lname * raw_tacexpr) list =
+  let WithArgs ((rule, _ as parsing), args) = TacSyn.get syn in
+  let data =
+    (* NB no Reserve Notation for ltac2 so can't have a notation without interp data *)
+    ParsedNota.AnyMap.get (Any parsing) !notation_data
+  in
+  let data = match List.find_map (fun sc -> Tac2Scope.Map.find_opt sc data) scopes with
+    | Some data -> data
+    | None ->
+      CErrors.user_err ?loc
+        Pp.(str "Unknown interpretation for Ltac2 notation in currently open scopes" ++ spc() ++
+            str "(notation available in scopes: " ++
+            pr_enum (fun (sc,_) -> ScopeTab.pr sc) (Tac2Scope.Map.bindings data) ++
+            str ").")
+  in
+  let () = match data.nota_depr with
+    | None -> ()
+    | Some depr -> deprecated_ltac2_notation ?loc (data.nota_raw, depr)
+  in
+  let args = interp_notation_args rule data.nota_tok args in
+  data.nota_body, args
+
+let cache_synext_interp data =
+  let add_data m =
+    let m = Option.default Tac2Scope.Map.empty m in
+    let m = Tac2Scope.Map.add data.nota_scope data m in
+    Some m
+  in
+  notation_data := ParsedNota.AnyMap.update data.nota_parsing add_data !notation_data
+
+let subst_notation_data subst = function
+  | UntypedNota body as n ->
+    let body' = subst_rawexpr subst body in
+    if body' == body then n else UntypedNota body'
+  | TypedNota { nota_prms=prms; nota_argtys=argtys; nota_ty=ty; nota_body=body } as n ->
+    let body' = subst_expr subst body in
+    let argtys' = Id.Map.Smart.map (subst_type subst) argtys in
+    let ty' = subst_type subst ty in
+    if body' == body && argtys' == argtys && ty' == ty then n
+    else TypedNota {nota_body=body'; nota_argtys=argtys'; nota_ty=ty'; nota_prms=prms}
+
+(* XXX missing subst on custom entries, recursively in SynclassDyn.t *)
+let subst_synext_interp (subst, data) =
+  let body' = subst_notation_data subst data.nota_body in
+  if body' == data.nota_body then data else
+  { data with nota_body = body' }
+
+let inTac2NotationInterp : _ -> Libobject.obj =
+  let open Libobject in
+  declare_object {(default_object "TAC2-NOTATION-INTERP") with
+     cache_function  = cache_synext_interp;
+     open_function   = simple_open ~cat:ltac2_notation_cat cache_synext_interp;
+     subst_function = subst_synext_interp;
+     classify_function = (fun data -> if data.nota_local then Dispose else Substitute);
+}
+
+type notation_target = {
+  target_entry : qualid option;
+  target_level : int option;
+  target_scope : qualid option;
+}
+
+let pr_register_notation tkn target body =
+  let open Pp in
+  let pptarget = match target.target_entry, target.target_level with
+    | None, None -> mt()
+    | None, Some lev -> spc() ++ str ": " ++ int lev
+    | Some entry, None -> spc() ++ str ": " ++ pr_qualid entry
+    | Some entry, Some lev ->
+      spc() ++ str ": " ++ pr_qualid entry ++ str "(" ++ int lev ++ str ")"
+  in
+  prlist_with_sep spc Tac2print.pr_syntax_class tkn ++
+  pptarget ++ spc() ++
+  hov 2 (str ":= " ++ Tac2print.pr_rawexpr_gen E5 ~avoid:Id.Set.empty body)
+
+let tactic_qualid = qualid_of_ident (Id.of_string "tactic")
+
+let register_notation atts tkn target body =
+  let deprecation, local = Attributes.(parse Notations.(deprecation ++ locality)) atts in
+  let local = Option.default false local in
+  let entry = match target.target_entry with
+    | Some entry ->
+      if qualid_eq entry tactic_qualid then None
+      else begin
+        try Some (CustomTab.locate entry)
+        with Not_found -> CErrors.user_err Pp.(str "Unknown entry " ++ pr_qualid entry ++ str ".")
+      end
+    | None -> None
+  in
+  (* Globalize so that names are absolute *)
+  let lev = if Option.has_some entry then
+      let lev = match target.target_level with
+        | Some lev -> lev
+        | None -> CErrors.user_err Pp.(str "Custom entry level must be explicit.")
+      in
+      let () = if lev < 0 then CErrors.user_err Pp.(str "Custom entry levels must be nonnegative.") in
+      lev
+    else match target.target_level with
+      | Some n ->
+        let () =
+          if n < 0 || n > 6 then
+            CErrors.user_err Pp.(str "Notation levels must range between 0 and 6")
+        in
+        n
+      | None ->
+        (* autodetect level *)
+        begin match tkn with
+        | SexprStr s :: _ when Names.Id.is_valid s.CAst.v -> 1
+        | _ -> 5
+        end
+  in
+  let tokens = List.rev_map ParseToken.parse_token tkn in
+  let used, tokens = List.split tokens in
+  let used = List.fold_left union_used_levels no_used_levels used in
+  let AnySeq parsing = get_nota_parsing tokens in
+  let parsing = ParsedNota.Any (parsing, entry) in
+  let ext = {
+    synext_used = used;
+    synext_tok = parsing;
+    synext_level = lev;
+    synext_local = local;
+  } in
+  Lib.add_leaf (inTac2Notation ext);
+  {
+    nota_local = local;
+    nota_raw = tkn;
+    nota_depr = deprecation;
+    nota_parsing = parsing;
+    nota_tok = tokens;
+    nota_scope = target.target_scope;
+    nota_body = body;
+  }
+
+let intern_notation_interpretation intern_body data =
+  let accumulate_ids acc = function
+    | TacTerm _ -> acc
+    | TacNonTerm (Anonymous, _) -> acc
+    | TacNonTerm (Name id, _) -> Id.Set.add id acc
+  in
+  let ids = List.fold_left accumulate_ids Id.Set.empty data.nota_tok in
+  let body = intern_body ids data.nota_body in
+  let scope = match data.nota_scope with
+    | None -> default_scope()
+    | Some sc -> find_scope sc
+  in
+  { data with nota_body = body; nota_scope = scope }
+
+let register_notation_interpretation data =
+  Lib.add_leaf (inTac2NotationInterp data)
+
+module Internal = struct
+  let ltac2_expr = internal_ltac2_expr
+end
diff --git a/plugins/ltac2/tac2syn.mli b/plugins/ltac2/tac2syn.mli
new file mode 100644
index 000000000000..897cdff223a0
--- /dev/null
+++ b/plugins/ltac2/tac2syn.mli
@@ -0,0 +1,147 @@
+(************************************************************************)
+(*         *      The Rocq Prover / The Rocq Development Team           *)
+(*  v      *         Copyright INRIA, CNRS and contributors             *)
+(*  unit
+
+val open_scope : Libobject.locality -> qualid -> unit
+
+val close_scope : Libobject.locality -> qualid -> unit
+
+val default_scope : unit -> Tac2Scope.t
+
+val current_scopes : unit -> Tac2Scope.t list
+
+module Tac2Custom : module type of KerName
+
+module CustomTab : Nametab.NAMETAB with type elt = Tac2Custom.t
+
+val find_custom_entry : Tac2Custom.t -> raw_tacexpr Procq.Entry.t
+(** NB: Do not save the result of this function across summary resets,
+    the Entry.t gets regenerated on (parsing) summary unfreeze. *)
+
+module Syntax : sig
+
+  (** Type of notation syntax parsing ['a].
+      Unlike [Procq.Symbol.t] it fully supports comparison and is marshallable. *)
+  type 'a t
+
+  (** Sequence of [t]. *)
+  type 'a seq
+
+  (** Marshal-stable proxy for [Procq.Entry.t]. *)
+  type 'a entry
+
+  (** Must be called at toplevel, with non backtrackable entry.
+      [name] defaults to the entry name but can be given another value if there is a conflict.
+      Registering the same entry twice produces different [entry] values. *)
+  val register_entry : ?name:string -> 'a Procq.Entry.t -> 'a entry
+
+  (** Pre-registered entries. *)
+
+  val constr : Constrexpr.constr_expr entry
+  val lconstr : Constrexpr.constr_expr entry
+  val term : Constrexpr.constr_expr entry
+  val custom_constr : Globnames.CustomName.t -> Constrexpr.constr_expr entry
+
+  (* XXX make pltac use Syntax.entry? currently its entries are
+     registered in tac2extravals (but maybe not all of them) *)
+  val ltac2_expr : raw_tacexpr entry
+  val custom_ltac2 : Tac2Custom.t -> raw_tacexpr entry
+
+  (** Constructors for [t], copying [Procq.Symbol] constructors. *)
+
+  val nterm : 'a entry -> 'a t
+  val nterml : 'a entry -> string -> 'a t
+  val list0 : ?sep:string -> 'a t -> 'a list t
+  val list1 : ?sep:string -> 'a t -> 'a list t
+  val opt : 'a t -> 'a option t
+  val self : raw_tacexpr t
+  val next : raw_tacexpr t
+  val token : 'a Tok.p -> 'a t
+  val tokens : Procq.ty_pattern list -> unit t
+
+  (** Instead of [rules] we have the less general [seq]. *)
+  val seq : 'a seq -> 'a t
+
+  val nil : unit seq
+  val snoc : 'a seq -> 'b t -> ('a * 'b) seq
+end
+
+type syntax_class_rule =
+| SyntaxRule : 'a Syntax.t * ('a -> raw_tacexpr) -> syntax_class_rule
+
+type used_levels
+
+val no_used_levels : used_levels
+
+val union_used_levels : used_levels -> used_levels -> used_levels
+
+type 'glb syntax_class_decl = {
+  intern_synclass : sexpr list -> used_levels * 'glb;
+  interp_synclass : 'glb -> syntax_class_rule;
+}
+
+val register_syntax_class : Id.t -> _ syntax_class_decl -> unit
+(** Create a new syntax class with the provided name *)
+
+type syntax_class
+
+val intern_syntax_class : sexpr -> used_levels * syntax_class
+(** Use this to internalize the syntax class arguments for interpretation functions *)
+
+val interp_syntax_class : syntax_class -> syntax_class_rule
+(** Use this to interpret the syntax class arguments for interpretation functions *)
+
+type notation_data =
+  | UntypedNota of raw_tacexpr
+  | TypedNota of {
+      nota_prms : int;
+      nota_argtys : int glb_typexpr Id.Map.t;
+      nota_ty : int glb_typexpr;
+      nota_body : glb_tacexpr;
+    }
+
+val interp_notation : ?loc:Loc.t -> Tac2Scope.t list -> tacsyn -> notation_data * (lname * raw_tacexpr) list
+
+type ('scope, 'body) notation_interpretation
+
+val ltac2_notation_cat : Libobject.category
+
+type notation_target = {
+  target_entry : qualid option;
+  target_level : int option;
+  target_scope : qualid option;
+}
+
+val pr_register_notation : sexpr list -> notation_target -> raw_tacexpr -> Pp.t
+
+val register_notation : Attributes.vernac_flags -> sexpr list ->
+  notation_target -> 'body -> (qualid option, 'body) notation_interpretation
+(** Does not handle the deprecated abbreviation syntax *)
+
+val intern_notation_interpretation : (Id.Set.t -> 'raw -> 'glb) -> (qualid option, 'raw) notation_interpretation ->
+  (Tac2Scope.t, 'glb) notation_interpretation
+
+val register_notation_interpretation : (Tac2Scope.t, notation_data) notation_interpretation -> unit
+
+val register_custom_entry : lident -> unit
+
+module Internal : sig
+  (** Re-exported in Tac2entries.Pltac *)
+  val ltac2_expr : raw_tacexpr Procq.Entry.t
+end
diff --git a/plugins/ltac2/tac2tactics.ml b/plugins/ltac2/tac2tactics.ml
index c1e241b489d1..5efd07b530bc 100644
--- a/plugins/ltac2/tac2tactics.ml
+++ b/plugins/ltac2/tac2tactics.ml
@@ -396,6 +396,9 @@ let current_transparent_state () =
 
 let evarconv_unify state x y = Tactics.evarconv_unify ~state x y
 
+let with_strategy lvl ql tac =
+  Tactics.with_set_strategy [(lvl, ql)] (thaw tac)
+
 (** Inversion *)
 
 let inversion knd arg pat ids =
@@ -435,3 +438,31 @@ let congruence n l = Cc_core_plugin.Cctac.congruence_tac n (Option.default [] l)
 let simple_congruence n l = Cc_core_plugin.Cctac.simple_congruence_tac n (Option.default [] l)
 
 let f_equal = Cc_core_plugin.Cctac.f_equal
+
+(* Strategy tactic call *)
+
+let wrap_tactic_call f =
+  let open Evarutil in
+  let open Proofview in
+  let open Proofview.Notations in
+  let wrapf ~env ~carrier ~lhs ~rel =
+    Proofview.tclEVARMAP >>= fun sigma ->
+      let ectx = ext_named_context_of_env env sigma in
+      let subst = ext_csubst ectx in
+      let carriern = Evarutil.csubst_subst sigma subst carrier in
+      let lhsn = Evarutil.csubst_subst sigma subst lhs in
+      let reln = Option.map (Evarutil.csubst_subst sigma subst) rel in
+      let sigma, unit = Evd.fresh_global env sigma (Rocqlib.lib_ref "core.unit.type") in
+      let sigma, unitval = Evd.fresh_global env sigma (Rocqlib.lib_ref "core.unit.tt") in
+      let sigma, goalev = Evd.new_pure_evar ~relevance:EConstr.ERelevance.relevant (ext_named_context_val ectx) sigma unit in
+      Unsafe.tclEVARS sigma <*>
+      Unsafe.tclNEWGOALS [with_empty_state goalev] <*>
+      f carriern lhsn reln >>= fun res ->
+      tclEVARMAP >>= fun sigma ->
+      if Evd.is_defined sigma goalev then
+        Tacticals.tclZEROMSG Pp.(str"The tactic called by Ltac2.Rewrite.Strategy.tactic should not solve the goal, it is provided as read-only information.")
+      else
+        let rev_subst = ext_rev_subst ectx in
+        let res = Rewrite.subst_rewrite_result sigma rev_subst res in
+        Unsafe.tclEVARS (Evd.define goalev unitval sigma) <*> tclUNIT res
+  in Rewrite.Strategies.tactic_call wrapf
diff --git a/plugins/ltac2/tac2tactics.mli b/plugins/ltac2/tac2tactics.mli
index b71da8969263..6e0bb2618176 100644
--- a/plugins/ltac2/tac2tactics.mli
+++ b/plugins/ltac2/tac2tactics.mli
@@ -122,6 +122,8 @@ val current_transparent_state : unit -> TransparentState.t tactic
 
 val evarconv_unify : TransparentState.t -> constr -> constr -> unit tactic
 
+val with_strategy : Conv_oracle.level -> GlobRef.t list -> 'a thunk -> 'a tactic
+
 (** Internal *)
 
 val mk_intro_pattern : intro_pattern -> Tactypes.intro_pattern
@@ -131,3 +133,5 @@ val congruence : int option -> constr list option -> unit Proofview.tactic
 val simple_congruence : int option -> constr list option -> unit Proofview.tactic
 
 val f_equal : unit Proofview.tactic
+
+val wrap_tactic_call : (constr -> constr -> constr option -> Rewrite.rewrite_result Proofview.tactic) -> Rewrite.strategy
diff --git a/plugins/ltac2/tac2typing_env.ml b/plugins/ltac2/tac2typing_env.ml
index 4f2fac4a0eb9..a50be8688de4 100644
--- a/plugins/ltac2/tac2typing_env.ml
+++ b/plugins/ltac2/tac2typing_env.ml
@@ -105,9 +105,14 @@ type mix_type_scheme = int * mix_var glb_typexpr
    so instead we use mutation to detect them *)
 type used = { mutable used : bool }
 
+(* TODO delay printing? but printing depends on env which is mutable *)
+type error = Pp.t Loc.located
+
 type t = {
   env_var : (mix_type_scheme * used) Id.Map.t;
   (** Type schemes of bound variables *)
+  env_scopes : Tac2syn.Tac2Scope.t list;
+  (** Currently open scopes *)
   env_cst : UF.elt glb_typexpr UF.t;
   (** Unification state *)
   env_als : UF.elt Id.Map.t ref;
@@ -118,19 +123,40 @@ type t = {
   (** Recursive type definitions *)
   env_strict : bool;
   (** True iff in strict mode *)
+  env_errs : error list ref option;
+  (** [None] if raise on first error, [Some] if accumulate errors *)
+  env_univs : UnivNames.universe_binders;
+  (** Local universe names *)
 }
 
-let empty_env ?(strict=true) () = {
+let empty_env ?(strict=true) ?(accumulate_errors=false) univs () = {
   env_var = Id.Map.empty;
+  env_scopes = Tac2syn.current_scopes();
   env_cst = UF.create ();
   env_als = ref Id.Map.empty;
   env_opn = true;
   env_rec = Id.Map.empty;
   env_strict = strict;
+  env_errs = if accumulate_errors then Some (ref []) else None;
+  env_univs = univs;
 }
 
+let add_error ?loc env msg =
+  match env.env_errs with
+  | None -> CErrors.user_err ?loc msg
+  | Some errs -> errs := (loc,msg) :: !errs
+
+let get_errors env =
+  match env.env_errs with
+  | None -> assert false
+  | Some errs -> !errs
+
 let env_strict env = env.env_strict
 
+let env_univs env = env.env_univs
+
+let scopes env = env.env_scopes
+
 let set_rec self env = { env with env_rec = self }
 
 let reject_unbound_tvar env = { env with env_opn = false }
@@ -228,7 +254,7 @@ let is_unfoldable kn = match snd (Tac2env.interp_type kn) with
 | GTydDef (Some _) -> true
 | GTydDef None | GTydAlg _ | GTydRec _ | GTydOpn -> false
 
-let unfold env kn args =
+let unfold kn args =
   let (nparams, def) = Tac2env.interp_type kn in
   let def = match def with
   | GTydDef (Some t) -> t
@@ -247,7 +273,7 @@ let rec kind env t = match t with
   | Some t -> kind env t
   end
 | GTypRef (Other kn, tl) ->
-  if is_unfoldable kn then kind env (unfold env kn tl) else t
+  if is_unfoldable kn then kind env (unfold kn tl) else t
 | GTypArrow _ | GTypRef (Tuple _, _) -> t
 
 (** Normalize unification variables without unfolding type aliases *)
@@ -328,7 +354,7 @@ let rec unify0 env t1 t2 = match kind env t1, kind env t2 with
 let unify ?loc env t1 t2 =
   try unify0 env t1 t2
   with CannotUnify (u1, u2) ->
-    CErrors.user_err ?loc Pp.(str "This expression has type" ++ spc () ++ pr_glbtype env t1 ++
+    add_error env ?loc Pp.(str "This expression has type" ++ spc () ++ pr_glbtype env t1 ++
       spc () ++ str "but an expression was expected of type" ++ spc () ++ pr_glbtype env t2)
 
 let unify_arrow ?loc env ft args =
@@ -343,12 +369,17 @@ let unify_arrow ?loc env ft args =
     let () = unify ?loc env (GTypVar id) (GTypArrow (t, ft)) in
     iter ft args true
   | GTypRef _, _ :: _ ->
-    if is_fun then
-      CErrors.user_err ?loc Pp.(str "This function has type" ++ spc () ++ pr_glbtype env ft0 ++
-        spc () ++ str "and is applied to too many arguments")
-    else
-      CErrors.user_err ?loc Pp.(str "This expression has type" ++ spc () ++ pr_glbtype env ft0 ++
-        spc () ++ str "and is not a function")
+    let () =
+      if is_fun then
+        add_error env ?loc
+          Pp.(str "This function has type" ++ spc () ++ pr_glbtype env ft0 ++
+              spc () ++ str "and is applied to too many arguments")
+      else
+        add_error env ?loc
+          Pp.(str "This expression has type" ++ spc () ++ pr_glbtype env ft0 ++
+              spc () ++ str "and is not a function")
+    in
+    GTypVar (fresh_id env)
   in
   iter ft args false
 
diff --git a/plugins/ltac2/tac2typing_env.mli b/plugins/ltac2/tac2typing_env.mli
index dadc5fdb0a07..681306dee881 100644
--- a/plugins/ltac2/tac2typing_env.mli
+++ b/plugins/ltac2/tac2typing_env.mli
@@ -21,13 +21,23 @@ end
 
 type t
 
-(** default strict:true *)
-val empty_env : ?strict:bool -> unit -> t
+(** default strict:true, accumulate_errors:false *)
+val empty_env : ?strict:bool -> ?accumulate_errors:bool -> UnivNames.universe_binders -> unit -> t
+
+(** In accumulate mode, add the error to the list in the env. Otherwise raise UserError. *)
+val add_error : ?loc:Loc.t -> t -> Pp.t -> unit
+
+(** Get accumulated errors. Assertion failure if not in accumulate mode. *)
+val get_errors : t -> Pp.t Loc.located list
+
+val scopes : t -> Tac2syn.Tac2Scope.t list
 
 val set_rec : (KerName.t * int) Id.Map.t -> t -> t
 
 val reject_unbound_tvar : t -> t
 
+val env_univs : t -> UnivNames.universe_binders
+
 val env_strict : t -> bool
 
 val env_name : t -> TVar.t -> string
diff --git a/plugins/ltac2_ltac1/dune b/plugins/ltac2_ltac1/dune
index 1572d8f8fd10..299bbc51cda8 100644
--- a/plugins/ltac2_ltac1/dune
+++ b/plugins/ltac2_ltac1/dune
@@ -4,10 +4,6 @@
  (synopsis "Ltac2 and Ltac1 interoperability plugin")
  (libraries ltac_plugin ltac2_plugin))
 
-(deprecated_library_name
- (old_public_name coq-core.plugins.ltac2_ltac1)
- (new_public_name rocq-runtime.plugins.ltac2_ltac1))
-
 (rule
  (targets g_ltac2_ltac1.ml)
  (deps (:mlg g_ltac2_ltac1.mlg))
diff --git a/plugins/ltac2_ltac1/tac2core_ltac1.ml b/plugins/ltac2_ltac1/tac2core_ltac1.ml
index 3f621b2b5987..2dee098c7a9f 100644
--- a/plugins/ltac2_ltac1/tac2core_ltac1.ml
+++ b/plugins/ltac2_ltac1/tac2core_ltac1.ml
@@ -51,7 +51,7 @@ let () =
 let () =
   define "ltac1_run" (ltac1 @-> tac unit) @@ fun v ->
   let open Ltac_plugin in
-  Tacinterp.tactic_of_value (Tacinterp.default_ist ()) v
+  Tacinterp.tactic_of_val (Tacinterp.default_ist ()) v
 
 let () =
   define "ltac1_apply" (ltac1 @-> list ltac1 @-> closure @-> tac unit) @@ fun f args k ->
@@ -148,7 +148,7 @@ let () =
       let ist = { env_ist = Id.Map.empty } in
       let lfun = Tac2interp.set_env ist lfun in
       let ist = Ltac_plugin.Tacinterp.default_ist () in
-      let ist = { ist with Geninterp.lfun = lfun } in
+      let ist = { ist with lfun } in
       let tac = (Ltac_plugin.Tacinterp.eval_tactic_ist ist tac : unit Proofview.tactic) in
       tac >>= fun () ->
       return v_unit
@@ -207,7 +207,7 @@ let () =
       let ist = { env_ist = Id.Map.empty } in
       let lfun = Tac2interp.set_env ist lfun in
       let ist = Ltac_plugin.Tacinterp.default_ist () in
-      let ist = { ist with Geninterp.lfun = lfun } in
+      let ist = { ist with lfun } in
       return (Tac2ffi.repr_of ltac1 (Tacinterp.Value.of_closure ist tac))
     in
     let len = List.length ids in
@@ -242,19 +242,24 @@ let () =
 
 (** Ltac2 in Ltac1 *)
 
+let make0 name =
+  let wit = Genarg.make0 name in
+  let () = Geninterp.register_val0 wit (Some Any) in
+  wit
+
 (** Embedding Ltac2 closures of type [Ltac1.t -> Ltac1.t] inside Ltac1. There is
     no relevant data because arguments are passed by conventional names. *)
-let wit_ltac2_val : (Util.Empty.t, unit, Util.Empty.t) genarg_type =
-  Genarg.make0 "ltac2:Ltac1.lambda"
+let wit_ltac2_val : (Util.Empty.t, unit, Geninterp.Val.t) genarg_type =
+  make0 "ltac2:Ltac1.lambda"
 
 (** Ltac2 quotations in Ltac1 code *)
-let wit_ltac2in1 : (Id.t CAst.t list * raw_tacexpr, Id.t list * glb_tacexpr, Util.Empty.t) genarg_type
-  = Genarg.make0 "ltac2in1"
+let wit_ltac2in1 : (Id.t CAst.t list * raw_tacexpr, Id.t list * glb_tacexpr, Geninterp.Val.t) genarg_type
+  = make0 "ltac2in1"
 
 (** Ltac2 quotations in Ltac1 returning Ltac1 values.
     When ids are bound interning turns them into Ltac1.lambda. *)
-let wit_ltac2in1_val : (Id.t CAst.t list * raw_tacexpr, glb_tacexpr, Util.Empty.t) genarg_type
-  = Genarg.make0 "ltac2in1val"
+let wit_ltac2in1_val : (Id.t CAst.t list * raw_tacexpr, glb_tacexpr, Geninterp.Val.t) genarg_type
+  = make0 "ltac2in1val"
 
 let pr_ltac2in1_ids ids =
   if List.is_empty ids then mt ()
@@ -269,7 +274,7 @@ let () =
     Genprint.PrinterBasic Pp.(fun _env _sigma ->
         pr_ltac2in1_ids ids ++ Tac2print.pr_glbexpr ~avoid:(Id.Set.of_list ids) e)
   in
-  Genprint.register_noval_print0 wit_ltac2in1 pr_raw pr_glb
+  Genprint.register_print0 wit_ltac2in1 pr_raw pr_glb Genprint.generic_val_print
 
 let () =
   let pr_raw (ids, e) = Genprint.PrinterBasic (fun _env _sigma ->
@@ -280,7 +285,7 @@ let () =
     Genprint.PrinterBasic (fun _env _sigma ->
         Tac2print.pr_glbexpr ~avoid:Id.Set.empty e)
   in
-  Genprint.register_noval_print0 wit_ltac2in1_val pr_raw pr_glb
+  Genprint.register_print0 wit_ltac2in1_val pr_raw pr_glb Genprint.generic_val_print
 
 let () =
   let open Tac2typing_env in
@@ -307,8 +312,8 @@ let () =
   in
   Genintern.register_intern0 wit_ltac2in1_val intern
 
-let () = Gensubst.register_subst0 wit_ltac2in1 (fun s (ids, e) -> ids, Tac2intern.subst_expr s e)
-let () = Gensubst.register_subst0 wit_ltac2in1_val Tac2intern.subst_expr
+let () = Gensubst.register_subst0 wit_ltac2in1 (fun s (ids, e) -> ids, Tac2subst.subst_expr s e)
+let () = Gensubst.register_subst0 wit_ltac2in1_val Tac2subst.subst_expr
 
 let () =
   let create name wit =
@@ -351,7 +356,7 @@ let () =
     let ans = Tac2ffi.repr_to ltac1 ans in
     Ftactic.return ans
   in
-  let () = Geninterp.register_interp0 wit_ltac2_val interp_fun in
+  let () = Tacinterp.Register.register_interp0 wit_ltac2_val interp_fun in
   define "ltac1_lambda" (valexpr @-> ret ltac1) @@ fun f ->
   let body = Tacexpr.TacGeneric (Some ltac2_ltac1_plugin, in_gen (glbwit wit_ltac2_val) ()) in
   let clos = CAst.make (Tacexpr.TacFun ([Name arg_id], CAst.make (Tacexpr.TacArg body))) in
@@ -406,13 +411,13 @@ let () =
     let ist = { ist with lfun = Id.Map.singleton self_id self } in
     Ftactic.return (Value.of_closure ist clos)
   in
-  Geninterp.register_interp0 wit_ltac2in1 interp
+  Tacinterp.Register.register_interp0 wit_ltac2in1 interp
 
 let () =
   let interp ist tac =
     let ist = { env_ist = Id.Map.empty } in
     Tac2interp.interp ist tac >>= fun v ->
     let v = repr_to ltac1 v in
-    Ftactic.return v
+    Ltac_plugin.Ftactic.return v
   in
-  Geninterp.register_interp0 wit_ltac2in1_val interp
+  Ltac_plugin.Tacinterp.Register.register_interp0 wit_ltac2in1_val interp
diff --git a/plugins/ltac2_ltac1/tac2core_ltac1.mli b/plugins/ltac2_ltac1/tac2core_ltac1.mli
index b18a601eec63..9c85d662bd20 100644
--- a/plugins/ltac2_ltac1/tac2core_ltac1.mli
+++ b/plugins/ltac2_ltac1/tac2core_ltac1.mli
@@ -12,13 +12,13 @@ open Names
 open Genarg
 open Ltac2_plugin.Tac2expr
 
-val wit_ltac2in1 : (Id.t CAst.t list * raw_tacexpr, Id.t list * glb_tacexpr, Util.Empty.t) genarg_type
+val wit_ltac2in1 : (Id.t CAst.t list * raw_tacexpr, Id.t list * glb_tacexpr, Geninterp.Val.t) genarg_type
 (** Ltac2 quotations in Ltac1 code *)
 
-val wit_ltac2in1_val : (Id.t CAst.t list * raw_tacexpr, glb_tacexpr, Util.Empty.t) genarg_type
+val wit_ltac2in1_val : (Id.t CAst.t list * raw_tacexpr, glb_tacexpr, Geninterp.Val.t) genarg_type
 (** Ltac2 quotations in Ltac1 returning Ltac1 values.
     When ids are bound interning turns them into Ltac1.lambda. *)
 
-val wit_ltac2_val : (Util.Empty.t, unit, Util.Empty.t) genarg_type
+val wit_ltac2_val : (Util.Empty.t, unit, Geninterp.Val.t) genarg_type
 (** Embedding Ltac2 closures of type [Ltac1.t -> Ltac1.t] inside Ltac1. There is
     no relevant data because arguments are passed by conventional names. *)
diff --git a/plugins/micromega/certificate.ml b/plugins/micromega/certificate.ml
index f5d0b3b6fb7e..ab3cd815ae3b 100644
--- a/plugins/micromega/certificate.ml
+++ b/plugins/micromega/certificate.ml
@@ -40,24 +40,21 @@ type zres = (Mc.zArithProof, int * Mc.z list) res
 type qres = (Mc.q Mc.psatz, int * Mc.q list) res
 
 type 'a number_spec =
-  { bigint_to_number : Z.t -> 'a
-  ; number_to_num : 'a -> Q.t
+  { number_to_num : 'a -> Q.t
   ; zero : 'a
   ; unit : 'a
   ; mult : 'a -> 'a -> 'a
   ; eqb : 'a -> 'a -> bool }
 
 let z_spec =
-  { bigint_to_number = Ml2C.bigint
-  ; number_to_num = (fun x -> Q.of_bigint (C2Ml.z_big_int x))
+  { number_to_num = (fun x -> Q.of_bigint (C2Ml.z_big_int x))
   ; zero = Mc.Z0
   ; unit = Mc.Zpos Mc.XH
   ; mult = Mc.Z.mul
   ; eqb = Mc.Z.eqb }
 
 let q_spec =
-  { bigint_to_number = (fun x -> {Mc.qnum = Ml2C.bigint x; Mc.qden = Mc.XH})
-  ; number_to_num = C2Ml.q_to_num
+  { number_to_num = C2Ml.q_to_num
   ; zero = {Mc.qnum = Mc.Z0; Mc.qden = Mc.XH}
   ; unit = {Mc.qnum = Mc.Zpos Mc.XH; Mc.qden = Mc.XH}
   ; mult = Mc.qmult
diff --git a/plugins/micromega/coq_micromega.ml b/plugins/micromega/coq_micromega.ml
index 59f96189a07f..939c73eb4914 100644
--- a/plugins/micromega/coq_micromega.ml
+++ b/plugins/micromega/coq_micromega.ml
@@ -165,154 +165,154 @@ let selecti s m =
 let constr_of_ref str =
   EConstr.of_constr (UnivGen.constr_of_monomorphic_global (Global.env ()) (Rocqlib.lib_ref str))
 
-let rocq_and = lazy (constr_of_ref "core.and.type")
-let rocq_or = lazy (constr_of_ref "core.or.type")
-let rocq_not = lazy (constr_of_ref "core.not.type")
-let rocq_iff = lazy (constr_of_ref "core.iff.type")
-let rocq_True = lazy (constr_of_ref "core.True.type")
-let rocq_False = lazy (constr_of_ref "core.False.type")
-let rocq_bool = lazy (constr_of_ref "core.bool.type")
-let rocq_true = lazy (constr_of_ref "core.bool.true")
-let rocq_false = lazy (constr_of_ref "core.bool.false")
-let rocq_andb = lazy (constr_of_ref "core.bool.andb")
-let rocq_orb = lazy (constr_of_ref "core.bool.orb")
-let rocq_implb = lazy (constr_of_ref "core.bool.implb")
-let rocq_eqb = lazy (constr_of_ref "core.bool.eqb")
-let rocq_negb = lazy (constr_of_ref "core.bool.negb")
-let rocq_cons = lazy (constr_of_ref "core.list.cons")
-let rocq_nil = lazy (constr_of_ref "core.list.nil")
-let rocq_list = lazy (constr_of_ref "core.list.type")
-let rocq_O = lazy (constr_of_ref "num.nat.O")
-let rocq_S = lazy (constr_of_ref "num.nat.S")
-let rocq_nat = lazy (constr_of_ref "num.nat.type")
-let rocq_unit = lazy (constr_of_ref "core.unit.type")
-
-(*  let rocq_option = lazy (init_constant "option")*)
-let rocq_None = lazy (constr_of_ref "core.option.None")
-let rocq_tt = lazy (constr_of_ref "core.unit.tt")
-let rocq_Inl = lazy (constr_of_ref "core.sum.inl")
-let rocq_Inr = lazy (constr_of_ref "core.sum.inr")
-let rocq_N0 = lazy (constr_of_ref "num.N.N0")
-let rocq_Npos = lazy (constr_of_ref "num.N.Npos")
-let rocq_xH = lazy (constr_of_ref "num.pos.xH")
-let rocq_xO = lazy (constr_of_ref "num.pos.xO")
-let rocq_xI = lazy (constr_of_ref "num.pos.xI")
-let rocq_Z = lazy (constr_of_ref "num.Z.type")
-let rocq_ZERO = lazy (constr_of_ref "num.Z.Z0")
-let rocq_POS = lazy (constr_of_ref "num.Z.Zpos")
-let rocq_NEG = lazy (constr_of_ref "num.Z.Zneg")
-let rocq_Q = lazy (constr_of_ref "rat.Q.type")
-let rocq_Qmake = lazy (constr_of_ref "rat.Q.Qmake")
-let rocq_R = lazy (constr_of_ref "reals.R.type")
-let rocq_Rcst = lazy (constr_of_ref "micromega.Rcst.type")
-let rocq_C0 = lazy (constr_of_ref "micromega.Rcst.C0")
-let rocq_C1 = lazy (constr_of_ref "micromega.Rcst.C1")
-let rocq_CQ = lazy (constr_of_ref "micromega.Rcst.CQ")
-let rocq_CZ = lazy (constr_of_ref "micromega.Rcst.CZ")
-let rocq_CPlus = lazy (constr_of_ref "micromega.Rcst.CPlus")
-let rocq_CMinus = lazy (constr_of_ref "micromega.Rcst.CMinus")
-let rocq_CMult = lazy (constr_of_ref "micromega.Rcst.CMult")
-let rocq_CPow = lazy (constr_of_ref "micromega.Rcst.CPow")
-let rocq_CInv = lazy (constr_of_ref "micromega.Rcst.CInv")
-let rocq_COpp = lazy (constr_of_ref "micromega.Rcst.COpp")
-let rocq_R0 = lazy (constr_of_ref "reals.R.R0")
-let rocq_R1 = lazy (constr_of_ref "reals.R.R1")
-let rocq_proofTerm = lazy (constr_of_ref "micromega.ZArithProof.type")
-let rocq_doneProof = lazy (constr_of_ref "micromega.ZArithProof.DoneProof")
-let rocq_ratProof = lazy (constr_of_ref "micromega.ZArithProof.RatProof")
-let rocq_cutProof = lazy (constr_of_ref "micromega.ZArithProof.CutProof")
-let rocq_splitProof = lazy (constr_of_ref "micromega.ZArithProof.SplitProof")
-let rocq_enumProof = lazy (constr_of_ref "micromega.ZArithProof.EnumProof")
-let rocq_ExProof = lazy (constr_of_ref "micromega.ZArithProof.ExProof")
-let rocq_IsProp = lazy (constr_of_ref "micromega.kind.isProp")
-let rocq_IsBool = lazy (constr_of_ref "micromega.kind.isBool")
-let rocq_Zgt = lazy (constr_of_ref "num.Z.gt")
-let rocq_Zge = lazy (constr_of_ref "num.Z.ge")
-let rocq_Zle = lazy (constr_of_ref "num.Z.le")
-let rocq_Zlt = lazy (constr_of_ref "num.Z.lt")
-let rocq_Zgtb = lazy (constr_of_ref "num.Z.gtb")
-let rocq_Zgeb = lazy (constr_of_ref "num.Z.geb")
-let rocq_Zleb = lazy (constr_of_ref "num.Z.leb")
-let rocq_Zltb = lazy (constr_of_ref "num.Z.ltb")
-let rocq_Zeqb = lazy (constr_of_ref "num.Z.eqb")
-let rocq_eq = lazy (constr_of_ref "core.eq.type")
-let rocq_Zplus = lazy (constr_of_ref "num.Z.add")
-let rocq_Zminus = lazy (constr_of_ref "num.Z.sub")
-let rocq_Zopp = lazy (constr_of_ref "num.Z.opp")
-let rocq_Zmult = lazy (constr_of_ref "num.Z.mul")
-let rocq_Zpower = lazy (constr_of_ref "num.Z.pow")
-let rocq_Qle = lazy (constr_of_ref "rat.Q.Qle")
-let rocq_Qlt = lazy (constr_of_ref "rat.Q.Qlt")
-let rocq_Qeq = lazy (constr_of_ref "rat.Q.Qeq")
-let rocq_Qplus = lazy (constr_of_ref "rat.Q.Qplus")
-let rocq_Qminus = lazy (constr_of_ref "rat.Q.Qminus")
-let rocq_Qopp = lazy (constr_of_ref "rat.Q.Qopp")
-let rocq_Qmult = lazy (constr_of_ref "rat.Q.Qmult")
-let rocq_Qpower = lazy (constr_of_ref "rat.Q.Qpower")
-let rocq_Rgt = lazy (constr_of_ref "reals.R.Rgt")
-let rocq_Rge = lazy (constr_of_ref "reals.R.Rge")
-let rocq_Rle = lazy (constr_of_ref "reals.R.Rle")
-let rocq_Rlt = lazy (constr_of_ref "reals.R.Rlt")
-let rocq_Rplus = lazy (constr_of_ref "reals.R.Rplus")
-let rocq_Rminus = lazy (constr_of_ref "reals.R.Rminus")
-let rocq_Ropp = lazy (constr_of_ref "reals.R.Ropp")
-let rocq_Rmult = lazy (constr_of_ref "reals.R.Rmult")
-let rocq_Rinv = lazy (constr_of_ref "reals.R.Rinv")
-let rocq_Rpower = lazy (constr_of_ref "reals.R.pow")
-let rocq_powerZR = lazy (constr_of_ref "reals.R.powerRZ")
-let rocq_IZR = lazy (constr_of_ref "reals.R.IZR")
-let rocq_IQR = lazy (constr_of_ref "reals.R.Q2R")
-let rocq_PEX = lazy (constr_of_ref "micromega.PExpr.PEX")
-let rocq_PEc = lazy (constr_of_ref "micromega.PExpr.PEc")
-let rocq_PEadd = lazy (constr_of_ref "micromega.PExpr.PEadd")
-let rocq_PEopp = lazy (constr_of_ref "micromega.PExpr.PEopp")
-let rocq_PEmul = lazy (constr_of_ref "micromega.PExpr.PEmul")
-let rocq_PEsub = lazy (constr_of_ref "micromega.PExpr.PEsub")
-let rocq_PEpow = lazy (constr_of_ref "micromega.PExpr.PEpow")
-let rocq_PX = lazy (constr_of_ref "micromega.Pol.PX")
-let rocq_Pc = lazy (constr_of_ref "micromega.Pol.Pc")
-let rocq_Pinj = lazy (constr_of_ref "micromega.Pol.Pinj")
-let rocq_OpEq = lazy (constr_of_ref "micromega.Op2.OpEq")
-let rocq_OpNEq = lazy (constr_of_ref "micromega.Op2.OpNEq")
-let rocq_OpLe = lazy (constr_of_ref "micromega.Op2.OpLe")
-let rocq_OpLt = lazy (constr_of_ref "micromega.Op2.OpLt")
-let rocq_OpGe = lazy (constr_of_ref "micromega.Op2.OpGe")
-let rocq_OpGt = lazy (constr_of_ref "micromega.Op2.OpGt")
-let rocq_PsatzLet = lazy (constr_of_ref "micromega.Psatz.PsatzLet")
-let rocq_PsatzIn = lazy (constr_of_ref "micromega.Psatz.PsatzIn")
-let rocq_PsatzSquare = lazy (constr_of_ref "micromega.Psatz.PsatzSquare")
-let rocq_PsatzMulE = lazy (constr_of_ref "micromega.Psatz.PsatzMulE")
-let rocq_PsatzMultC = lazy (constr_of_ref "micromega.Psatz.PsatzMulC")
-let rocq_PsatzAdd = lazy (constr_of_ref "micromega.Psatz.PsatzAdd")
-let rocq_PsatzC = lazy (constr_of_ref "micromega.Psatz.PsatzC")
-let rocq_PsatzZ = lazy (constr_of_ref "micromega.Psatz.PsatzZ")
-
-(*  let rocq_GT     = lazy (m_constant "GT")*)
-
-let rocq_DeclaredConstant =
-  lazy (constr_of_ref "micromega.DeclaredConstant.type")
-
-let rocq_TT = lazy (constr_of_ref "micromega.GFormula.TT")
-let rocq_FF = lazy (constr_of_ref "micromega.GFormula.FF")
-let rocq_AND = lazy (constr_of_ref "micromega.GFormula.AND")
-let rocq_OR = lazy (constr_of_ref "micromega.GFormula.OR")
-let rocq_NOT = lazy (constr_of_ref "micromega.GFormula.NOT")
-let rocq_Atom = lazy (constr_of_ref "micromega.GFormula.A")
-let rocq_X = lazy (constr_of_ref "micromega.GFormula.X")
-let rocq_IMPL = lazy (constr_of_ref "micromega.GFormula.IMPL")
-let rocq_IFF = lazy (constr_of_ref "micromega.GFormula.IFF")
-let rocq_EQ = lazy (constr_of_ref "micromega.GFormula.EQ")
-let rocq_Formula = lazy (constr_of_ref "micromega.BFormula.type")
-let rocq_eKind = lazy (constr_of_ref "micromega.eKind")
+let rocq_and () = constr_of_ref "core.and.type"
+let rocq_or () = constr_of_ref "core.or.type"
+let rocq_not () = constr_of_ref "core.not.type"
+let rocq_iff () = constr_of_ref "core.iff.type"
+let rocq_True () = constr_of_ref "core.True.type"
+let rocq_False () = constr_of_ref "core.False.type"
+let rocq_bool () = constr_of_ref "core.bool.type"
+let rocq_true () = constr_of_ref "core.bool.true"
+let rocq_false () = constr_of_ref "core.bool.false"
+let rocq_andb () = constr_of_ref "core.bool.andb"
+let rocq_orb () = constr_of_ref "core.bool.orb"
+let rocq_implb () = constr_of_ref "core.bool.implb"
+let rocq_eqb () = constr_of_ref "core.bool.eqb"
+let rocq_negb () = constr_of_ref "core.bool.negb"
+let rocq_cons () = constr_of_ref "core.list.cons"
+let rocq_nil () = constr_of_ref "core.list.nil"
+let rocq_list () = constr_of_ref "core.list.type"
+let rocq_O () = constr_of_ref "num.nat.O"
+let rocq_S () = constr_of_ref "num.nat.S"
+let rocq_nat () = constr_of_ref "num.nat.type"
+let rocq_unit () = constr_of_ref "core.unit.type"
+
+(*  let rocq_option () = init_constant "option"*)
+let rocq_None () = constr_of_ref "core.option.None"
+let rocq_tt () = constr_of_ref "core.unit.tt"
+let rocq_Inl () = constr_of_ref "core.sum.inl"
+let rocq_Inr () = constr_of_ref "core.sum.inr"
+let rocq_N0 () = constr_of_ref "num.N.N0"
+let rocq_Npos () = constr_of_ref "num.N.Npos"
+let rocq_xH () = constr_of_ref "num.pos.xH"
+let rocq_xO () = constr_of_ref "num.pos.xO"
+let rocq_xI () = constr_of_ref "num.pos.xI"
+let rocq_Z () = constr_of_ref "num.Z.type"
+let rocq_ZERO () = constr_of_ref "num.Z.Z0"
+let rocq_POS () = constr_of_ref "num.Z.Zpos"
+let rocq_NEG () = constr_of_ref "num.Z.Zneg"
+let rocq_Q () = constr_of_ref "rat.Q.type"
+let rocq_Qmake () = constr_of_ref "rat.Q.Qmake"
+let rocq_R () = constr_of_ref "reals.R.type"
+let rocq_Rcst () = constr_of_ref "micromega.Rcst.type"
+let rocq_C0 () = constr_of_ref "micromega.Rcst.C0"
+let rocq_C1 () = constr_of_ref "micromega.Rcst.C1"
+let rocq_CQ () = constr_of_ref "micromega.Rcst.CQ"
+let rocq_CZ () = constr_of_ref "micromega.Rcst.CZ"
+let rocq_CPlus () = constr_of_ref "micromega.Rcst.CPlus"
+let rocq_CMinus () = constr_of_ref "micromega.Rcst.CMinus"
+let rocq_CMult () = constr_of_ref "micromega.Rcst.CMult"
+let rocq_CPow () = constr_of_ref "micromega.Rcst.CPow"
+let rocq_CInv () = constr_of_ref "micromega.Rcst.CInv"
+let rocq_COpp () = constr_of_ref "micromega.Rcst.COpp"
+let rocq_R0 () = constr_of_ref "reals.R.R0"
+let rocq_R1 () = constr_of_ref "reals.R.R1"
+let rocq_proofTerm () = constr_of_ref "micromega.ZArithProof.type"
+let rocq_doneProof () = constr_of_ref "micromega.ZArithProof.DoneProof"
+let rocq_ratProof () = constr_of_ref "micromega.ZArithProof.RatProof"
+let rocq_cutProof () = constr_of_ref "micromega.ZArithProof.CutProof"
+let rocq_splitProof () = constr_of_ref "micromega.ZArithProof.SplitProof"
+let rocq_enumProof () = constr_of_ref "micromega.ZArithProof.EnumProof"
+let rocq_ExProof () = constr_of_ref "micromega.ZArithProof.ExProof"
+let rocq_IsProp () = constr_of_ref "micromega.kind.isProp"
+let rocq_IsBool () = constr_of_ref "micromega.kind.isBool"
+let rocq_Zgt () = constr_of_ref "num.Z.gt"
+let rocq_Zge () = constr_of_ref "num.Z.ge"
+let rocq_Zle () = constr_of_ref "num.Z.le"
+let rocq_Zlt () = constr_of_ref "num.Z.lt"
+let rocq_Zgtb () = constr_of_ref "num.Z.gtb"
+let rocq_Zgeb () = constr_of_ref "num.Z.geb"
+let rocq_Zleb () = constr_of_ref "num.Z.leb"
+let rocq_Zltb () = constr_of_ref "num.Z.ltb"
+let rocq_Zeqb () = constr_of_ref "num.Z.eqb"
+let rocq_eq () = constr_of_ref "core.eq.type"
+let rocq_Zplus () = constr_of_ref "num.Z.add"
+let rocq_Zminus () = constr_of_ref "num.Z.sub"
+let rocq_Zopp () = constr_of_ref "num.Z.opp"
+let rocq_Zmult () = constr_of_ref "num.Z.mul"
+let rocq_Zpower () = constr_of_ref "num.Z.pow"
+let rocq_Qle () = constr_of_ref "rat.Q.Qle"
+let rocq_Qlt () = constr_of_ref "rat.Q.Qlt"
+let rocq_Qeq () = constr_of_ref "rat.Q.Qeq"
+let rocq_Qplus () = constr_of_ref "rat.Q.Qplus"
+let rocq_Qminus () = constr_of_ref "rat.Q.Qminus"
+let rocq_Qopp () = constr_of_ref "rat.Q.Qopp"
+let rocq_Qmult () = constr_of_ref "rat.Q.Qmult"
+let rocq_Qpower () = constr_of_ref "rat.Q.Qpower"
+let rocq_Rgt () = constr_of_ref "reals.R.Rgt"
+let rocq_Rge () = constr_of_ref "reals.R.Rge"
+let rocq_Rle () = constr_of_ref "reals.R.Rle"
+let rocq_Rlt () = constr_of_ref "reals.R.Rlt"
+let rocq_Rplus () = constr_of_ref "reals.R.Rplus"
+let rocq_Rminus () = constr_of_ref "reals.R.Rminus"
+let rocq_Ropp () = constr_of_ref "reals.R.Ropp"
+let rocq_Rmult () = constr_of_ref "reals.R.Rmult"
+let rocq_Rinv () = constr_of_ref "reals.R.Rinv"
+let rocq_Rpower () = constr_of_ref "reals.R.pow"
+let rocq_powerZR () = constr_of_ref "reals.R.powerRZ"
+let rocq_IZR () = constr_of_ref "reals.R.IZR"
+let rocq_IQR () = constr_of_ref "reals.R.Q2R"
+let rocq_PEX () = constr_of_ref "micromega.PExpr.PEX"
+let rocq_PEc () = constr_of_ref "micromega.PExpr.PEc"
+let rocq_PEadd () = constr_of_ref "micromega.PExpr.PEadd"
+let rocq_PEopp () = constr_of_ref "micromega.PExpr.PEopp"
+let rocq_PEmul () = constr_of_ref "micromega.PExpr.PEmul"
+let rocq_PEsub () = constr_of_ref "micromega.PExpr.PEsub"
+let rocq_PEpow () = constr_of_ref "micromega.PExpr.PEpow"
+let rocq_PX () = constr_of_ref "micromega.Pol.PX"
+let rocq_Pc () = constr_of_ref "micromega.Pol.Pc"
+let rocq_Pinj () = constr_of_ref "micromega.Pol.Pinj"
+let rocq_OpEq () = constr_of_ref "micromega.Op2.OpEq"
+let rocq_OpNEq () = constr_of_ref "micromega.Op2.OpNEq"
+let rocq_OpLe () = constr_of_ref "micromega.Op2.OpLe"
+let rocq_OpLt () = constr_of_ref "micromega.Op2.OpLt"
+let rocq_OpGe () = constr_of_ref "micromega.Op2.OpGe"
+let rocq_OpGt () = constr_of_ref "micromega.Op2.OpGt"
+let rocq_PsatzLet () = constr_of_ref "micromega.Psatz.PsatzLet"
+let rocq_PsatzIn () = constr_of_ref "micromega.Psatz.PsatzIn"
+let rocq_PsatzSquare () = constr_of_ref "micromega.Psatz.PsatzSquare"
+let rocq_PsatzMulE () = constr_of_ref "micromega.Psatz.PsatzMulE"
+let rocq_PsatzMultC () = constr_of_ref "micromega.Psatz.PsatzMulC"
+let rocq_PsatzAdd () = constr_of_ref "micromega.Psatz.PsatzAdd"
+let rocq_PsatzC () = constr_of_ref "micromega.Psatz.PsatzC"
+let rocq_PsatzZ () = constr_of_ref "micromega.Psatz.PsatzZ"
+
+(*  let rocq_GT     () = m_constant "GT"*)
+
+let rocq_DeclaredConstant () =
+  constr_of_ref "micromega.DeclaredConstant.type"
+
+let rocq_TT () = constr_of_ref "micromega.GFormula.TT"
+let rocq_FF () = constr_of_ref "micromega.GFormula.FF"
+let rocq_AND () = constr_of_ref "micromega.GFormula.AND"
+let rocq_OR () = constr_of_ref "micromega.GFormula.OR"
+let rocq_NOT () = constr_of_ref "micromega.GFormula.NOT"
+let rocq_Atom () = constr_of_ref "micromega.GFormula.A"
+let rocq_X () = constr_of_ref "micromega.GFormula.X"
+let rocq_IMPL () = constr_of_ref "micromega.GFormula.IMPL"
+let rocq_IFF () = constr_of_ref "micromega.GFormula.IFF"
+let rocq_EQ () = constr_of_ref "micromega.GFormula.EQ"
+let rocq_Formula () = constr_of_ref "micromega.BFormula.type"
+let rocq_eKind () = constr_of_ref "micromega.eKind"
 
 (**
     * Initialization : a few Caml symbols are derived from other libraries;
     * QMicromega, ZArithRing, RingMicromega.
     *)
 
-let rocq_QWitness = lazy (constr_of_ref "micromega.QWitness.type")
-let rocq_Build = lazy (constr_of_ref "micromega.Formula.Build_Formula")
-let rocq_Cstr = lazy (constr_of_ref "micromega.Formula.type")
+let rocq_QWitness () = constr_of_ref "micromega.QWitness.type"
+let rocq_Build () = constr_of_ref "micromega.Formula.Build_Formula"
+let rocq_Cstr () = constr_of_ref "micromega.Formula.type"
 
 (**
     * Parsing and dumping : transformation functions between Caml and Rocq
@@ -350,8 +350,8 @@ let rec parse_nat sigma term =
 
 let rec dump_nat x =
   match x with
-  | Mc.O -> Lazy.force rocq_O
-  | Mc.S p -> EConstr.mkApp (Lazy.force rocq_S, [|dump_nat p|])
+  | Mc.O -> rocq_O()
+  | Mc.S p -> EConstr.mkApp (rocq_S(), [|dump_nat p|])
 
 let rec parse_positive sigma term =
   let i, c = get_left_construct sigma term in
@@ -363,9 +363,9 @@ let rec parse_positive sigma term =
 
 let rec dump_positive x =
   match x with
-  | Mc.XH -> Lazy.force rocq_xH
-  | Mc.XO p -> EConstr.mkApp (Lazy.force rocq_xO, [|dump_positive p|])
-  | Mc.XI p -> EConstr.mkApp (Lazy.force rocq_xI, [|dump_positive p|])
+  | Mc.XH -> rocq_xH()
+  | Mc.XO p -> EConstr.mkApp (rocq_xO(), [|dump_positive p|])
+  | Mc.XI p -> EConstr.mkApp (rocq_xI(), [|dump_positive p|])
 
 let parse_n sigma term =
   let i, c = get_left_construct sigma term in
@@ -376,8 +376,8 @@ let parse_n sigma term =
 
 let dump_n x =
   match x with
-  | Mc.N0 -> Lazy.force rocq_N0
-  | Mc.Npos p -> EConstr.mkApp (Lazy.force rocq_Npos, [|dump_positive p|])
+  | Mc.N0 -> rocq_N0()
+  | Mc.Npos p -> EConstr.mkApp (rocq_Npos(), [|dump_positive p|])
 
 (** [is_ground_term env sigma term] holds if the term [term]
       is an instance of the typeclass [DeclConstant.GT term]
@@ -394,7 +394,7 @@ let is_declared_term env evd t =
     try
       ignore
         (Class_tactics.resolve_one_typeclass env evd
-           (EConstr.mkApp (Lazy.force rocq_DeclaredConstant, [|typ; t|])));
+           (EConstr.mkApp (rocq_DeclaredConstant(), [|typ; t|])));
       true
     with Not_found -> false )
   | _ -> false
@@ -416,20 +416,20 @@ let parse_z sigma term =
 
 let dump_z x =
   match x with
-  | Mc.Z0 -> Lazy.force rocq_ZERO
-  | Mc.Zpos p -> EConstr.mkApp (Lazy.force rocq_POS, [|dump_positive p|])
-  | Mc.Zneg p -> EConstr.mkApp (Lazy.force rocq_NEG, [|dump_positive p|])
+  | Mc.Z0 -> rocq_ZERO()
+  | Mc.Zpos p -> EConstr.mkApp (rocq_POS(), [|dump_positive p|])
+  | Mc.Zneg p -> EConstr.mkApp (rocq_NEG(), [|dump_positive p|])
 
 
 let dump_q q =
   EConstr.mkApp
-    ( Lazy.force rocq_Qmake
+    ( rocq_Qmake()
     , [|dump_z q.Micromega.qnum; dump_positive q.Micromega.qden|] )
 
 let parse_q sigma term =
   match EConstr.kind sigma term with
   | App (c, args) ->
-    if EConstr.eq_constr sigma c (Lazy.force rocq_Qmake) then
+    if EConstr.eq_constr sigma c (rocq_Qmake()) then
       {Mc.qnum = parse_z sigma args.(0); Mc.qden = parse_positive sigma args.(1)}
     else raise ParseError
   | _ -> raise ParseError
@@ -449,38 +449,38 @@ let rec pp_Rcst o cst =
 
 let rec dump_Rcst cst =
   match cst with
-  | Mc.C0 -> Lazy.force rocq_C0
-  | Mc.C1 -> Lazy.force rocq_C1
-  | Mc.CQ q -> EConstr.mkApp (Lazy.force rocq_CQ, [|dump_q q|])
-  | Mc.CZ z -> EConstr.mkApp (Lazy.force rocq_CZ, [|dump_z z|])
+  | Mc.C0 -> rocq_C0()
+  | Mc.C1 -> rocq_C1()
+  | Mc.CQ q -> EConstr.mkApp (rocq_CQ(), [|dump_q q|])
+  | Mc.CZ z -> EConstr.mkApp (rocq_CZ(), [|dump_z z|])
   | Mc.CPlus (x, y) ->
-    EConstr.mkApp (Lazy.force rocq_CPlus, [|dump_Rcst x; dump_Rcst y|])
+    EConstr.mkApp (rocq_CPlus(), [|dump_Rcst x; dump_Rcst y|])
   | Mc.CMinus (x, y) ->
-    EConstr.mkApp (Lazy.force rocq_CMinus, [|dump_Rcst x; dump_Rcst y|])
+    EConstr.mkApp (rocq_CMinus(), [|dump_Rcst x; dump_Rcst y|])
   | Mc.CMult (x, y) ->
-    EConstr.mkApp (Lazy.force rocq_CMult, [|dump_Rcst x; dump_Rcst y|])
+    EConstr.mkApp (rocq_CMult(), [|dump_Rcst x; dump_Rcst y|])
   | Mc.CPow (x, y) ->
     EConstr.mkApp
-      ( Lazy.force rocq_CPow
+      ( rocq_CPow()
       , [| dump_Rcst x
          ; ( match y with
            | Mc.Inl z ->
              EConstr.mkApp
-               ( Lazy.force rocq_Inl
-               , [|Lazy.force rocq_Z; Lazy.force rocq_nat; dump_z z|] )
+               ( rocq_Inl()
+               , [|rocq_Z(); rocq_nat(); dump_z z|] )
            | Mc.Inr n ->
              EConstr.mkApp
-               ( Lazy.force rocq_Inr
-               , [|Lazy.force rocq_Z; Lazy.force rocq_nat; dump_nat n|] ) ) |] )
-  | Mc.CInv t -> EConstr.mkApp (Lazy.force rocq_CInv, [|dump_Rcst t|])
-  | Mc.COpp t -> EConstr.mkApp (Lazy.force rocq_COpp, [|dump_Rcst t|])
+               ( rocq_Inr()
+               , [|rocq_Z(); rocq_nat(); dump_nat n|] ) ) |] )
+  | Mc.CInv t -> EConstr.mkApp (rocq_CInv(), [|dump_Rcst t|])
+  | Mc.COpp t -> EConstr.mkApp (rocq_COpp(), [|dump_Rcst t|])
 
 let rec dump_list typ dump_elt l =
   match l with
-  | [] -> EConstr.mkApp (Lazy.force rocq_nil, [|typ|])
+  | [] -> EConstr.mkApp (rocq_nil(), [|typ|])
   | e :: l ->
     EConstr.mkApp
-      (Lazy.force rocq_cons, [|typ; dump_elt e; dump_list typ dump_elt l|])
+      (rocq_cons(), [|typ; dump_elt e; dump_list typ dump_elt l|])
 
 
 let undump_var = parse_positive
@@ -488,7 +488,7 @@ let undump_var = parse_positive
 let dump_var = dump_positive
 
 let undump_expr undump_constant sigma e =
-  let is c c' = EConstr.eq_constr sigma c (Lazy.force c') in
+  let is c c' = EConstr.eq_constr sigma c (c'()) in
   let rec xundump e =
     match EConstr.kind sigma e with
     | App (c, [|_; n|]) when is c rocq_PEX -> Mc.PEX (undump_var sigma n)
@@ -509,29 +509,29 @@ let undump_expr undump_constant sigma e =
 let dump_expr typ dump_z e =
   let rec dump_expr e =
     match e with
-    | Mc.PEX n -> EConstr.mkApp (Lazy.force rocq_PEX, [|typ; dump_var n|])
-    | Mc.PEc z -> EConstr.mkApp (Lazy.force rocq_PEc, [|typ; dump_z z|])
+    | Mc.PEX n -> EConstr.mkApp (rocq_PEX(), [|typ; dump_var n|])
+    | Mc.PEc z -> EConstr.mkApp (rocq_PEc(), [|typ; dump_z z|])
     | Mc.PEadd (e1, e2) ->
-      EConstr.mkApp (Lazy.force rocq_PEadd, [|typ; dump_expr e1; dump_expr e2|])
+      EConstr.mkApp (rocq_PEadd(), [|typ; dump_expr e1; dump_expr e2|])
     | Mc.PEsub (e1, e2) ->
-      EConstr.mkApp (Lazy.force rocq_PEsub, [|typ; dump_expr e1; dump_expr e2|])
-    | Mc.PEopp e -> EConstr.mkApp (Lazy.force rocq_PEopp, [|typ; dump_expr e|])
+      EConstr.mkApp (rocq_PEsub(), [|typ; dump_expr e1; dump_expr e2|])
+    | Mc.PEopp e -> EConstr.mkApp (rocq_PEopp(), [|typ; dump_expr e|])
     | Mc.PEmul (e1, e2) ->
-      EConstr.mkApp (Lazy.force rocq_PEmul, [|typ; dump_expr e1; dump_expr e2|])
+      EConstr.mkApp (rocq_PEmul(), [|typ; dump_expr e1; dump_expr e2|])
     | Mc.PEpow (e, n) ->
-      EConstr.mkApp (Lazy.force rocq_PEpow, [|typ; dump_expr e; dump_n n|])
+      EConstr.mkApp (rocq_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 -> EConstr.mkApp (Lazy.force rocq_Pc, [|typ; dump_c n|])
+    | Mc.Pc n -> EConstr.mkApp (rocq_Pc(), [|typ; dump_c n|])
     | Mc.Pinj (p, pol) ->
-      EConstr.mkApp (Lazy.force rocq_Pinj, [|typ; dump_positive p; dump_pol pol|])
+      EConstr.mkApp (rocq_Pinj(), [|typ; dump_positive p; dump_pol pol|])
     | Mc.PX (pol1, p, pol2) ->
       EConstr.mkApp
-        ( Lazy.force rocq_PX
+        ( rocq_PX()
         , [|typ; dump_pol pol1; dump_positive p; dump_pol pol2|] )
   in
   dump_pol e
@@ -550,23 +550,23 @@ let pp_cnf_tag o (f : 'cst cnf) =
   List.iter (fun l -> Printf.fprintf o "[%a]" pp_clause_tag l) f
 
 let dump_psatz typ dump_z e =
-  let z = Lazy.force typ in
+  let z = typ() in
   let rec dump_cone e =
     match e with
     | Mc.PsatzLet (e1, e2) ->
-      EConstr.mkApp (Lazy.force rocq_PsatzLet, [|z; dump_cone e1; dump_cone e2|])
-    | Mc.PsatzIn n -> EConstr.mkApp (Lazy.force rocq_PsatzIn, [|z; dump_nat n|])
+      EConstr.mkApp (rocq_PsatzLet(), [|z; dump_cone e1; dump_cone e2|])
+    | Mc.PsatzIn n -> EConstr.mkApp (rocq_PsatzIn(), [|z; dump_nat n|])
     | Mc.PsatzMulC (e, c) ->
       EConstr.mkApp
-        (Lazy.force rocq_PsatzMultC, [|z; dump_pol z dump_z e; dump_cone c|])
+        (rocq_PsatzMultC(), [|z; dump_pol z dump_z e; dump_cone c|])
     | Mc.PsatzSquare e ->
-      EConstr.mkApp (Lazy.force rocq_PsatzSquare, [|z; dump_pol z dump_z e|])
+      EConstr.mkApp (rocq_PsatzSquare(), [|z; dump_pol z dump_z e|])
     | Mc.PsatzAdd (e1, e2) ->
-      EConstr.mkApp (Lazy.force rocq_PsatzAdd, [|z; dump_cone e1; dump_cone e2|])
+      EConstr.mkApp (rocq_PsatzAdd(), [|z; dump_cone e1; dump_cone e2|])
     | Mc.PsatzMulE (e1, e2) ->
-      EConstr.mkApp (Lazy.force rocq_PsatzMulE, [|z; dump_cone e1; dump_cone e2|])
-    | Mc.PsatzC p -> EConstr.mkApp (Lazy.force rocq_PsatzC, [|z; dump_z p|])
-    | Mc.PsatzZ -> EConstr.mkApp (Lazy.force rocq_PsatzZ, [|z|])
+      EConstr.mkApp (rocq_PsatzMulE(), [|z; dump_cone e1; dump_cone e2|])
+    | Mc.PsatzC p -> EConstr.mkApp (rocq_PsatzC(), [|z; dump_z p|])
+    | Mc.PsatzZ -> EConstr.mkApp (rocq_PsatzZ(), [|z|])
   in
   dump_cone e
 
@@ -582,15 +582,15 @@ let undump_op sigma c =
   | _ -> raise ParseError
 
 let dump_op = function
-  | Mc.OpEq -> Lazy.force rocq_OpEq
-  | Mc.OpNEq -> Lazy.force rocq_OpNEq
-  | Mc.OpLe -> Lazy.force rocq_OpLe
-  | Mc.OpGe -> Lazy.force rocq_OpGe
-  | Mc.OpGt -> Lazy.force rocq_OpGt
-  | Mc.OpLt -> Lazy.force rocq_OpLt
+  | Mc.OpEq -> rocq_OpEq()
+  | Mc.OpNEq -> rocq_OpNEq()
+  | Mc.OpLe -> rocq_OpLe()
+  | Mc.OpGe -> rocq_OpGe()
+  | Mc.OpGt -> rocq_OpGt()
+  | Mc.OpLt -> rocq_OpLt()
 
 let undump_cstr undump_constant sigma c =
-  let is c c' = EConstr.eq_constr sigma c (Lazy.force c') in
+  let is c c' = EConstr.eq_constr sigma c (c'()) in
   match EConstr.kind sigma c with
   | App (c, [|_; e1; o; e2|]) when is c rocq_Build ->
     {Mc.flhs = undump_expr undump_constant sigma e1;
@@ -600,7 +600,7 @@ let undump_cstr undump_constant sigma c =
 
 let dump_cstr typ dump_constant {Mc.flhs = e1; Mc.fop = o; Mc.frhs = e2} =
   EConstr.mkApp
-    ( Lazy.force rocq_Build
+    ( rocq_Build()
     , [| typ
        ; dump_expr typ dump_constant e1
        ; dump_op o
@@ -608,7 +608,7 @@ let dump_cstr typ dump_constant {Mc.flhs = e1; Mc.fop = o; Mc.frhs = e2} =
 
 let assoc_const sigma x l =
   try
-    snd (List.find (fun (x', y) -> EConstr.eq_constr sigma x (Lazy.force x')) l)
+    snd (List.find (fun (x', y) -> EConstr.eq_constr sigma x (x'())) l)
   with Not_found -> raise ParseError
 
 let zop_table_prop =
@@ -649,8 +649,8 @@ let parse_operator table_prop table_bool has_equality typ (env, sigma) k
   | [|ty; a1; a2|] ->
     if
       has_equality
-      && EConstr.eq_constr sigma op (Lazy.force rocq_eq)
-      && is_convertible env sigma ty (Lazy.force typ)
+      && EConstr.eq_constr sigma op (rocq_eq())
+      && is_convertible env sigma ty (typ())
     then (Mc.OpEq, args.(1), args.(2))
     else raise ParseError
   | _ -> raise ParseError
@@ -667,7 +667,7 @@ type 'a op =
 
 let assoc_ops sigma x l =
   try
-    snd (List.find (fun (x', y) -> EConstr.eq_constr sigma x (Lazy.force x')) l)
+    snd (List.find (fun (x', y) -> EConstr.eq_constr sigma x (x'())) l)
   with Not_found -> Ukn "Oups"
 
 (**
@@ -863,8 +863,8 @@ let rconstant (genv, sigma) term =
   let rec rconstant term =
     match EConstr.kind sigma term with
     | Const x ->
-      if EConstr.eq_constr sigma term (Lazy.force rocq_R0) then Mc.C0
-      else if EConstr.eq_constr sigma term (Lazy.force rocq_R1) then Mc.C1
+      if EConstr.eq_constr sigma term (rocq_R0()) then Mc.C0
+      else if EConstr.eq_constr sigma term (rocq_R1()) then Mc.C1
       else raise ParseError
     | App (op, args) -> (
       try
@@ -875,18 +875,18 @@ let rconstant (genv, sigma) term =
         f a b
       with ParseError -> (
         match op with
-        | op when EConstr.eq_constr sigma op (Lazy.force rocq_Rinv) ->
+        | op when EConstr.eq_constr sigma op (rocq_Rinv()) ->
           let arg = rconstant 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 EConstr.eq_constr sigma op (Lazy.force rocq_Rpower) ->
+        | op when EConstr.eq_constr sigma op (rocq_Rpower()) ->
           Mc.CPow
             ( rconstant args.(0)
             , Mc.Inr (parse_more_constant nconstant (genv, sigma) args.(1)) )
-        | op when EConstr.eq_constr sigma op (Lazy.force rocq_IQR) ->
+        | op when EConstr.eq_constr sigma op (rocq_IQR()) ->
           Mc.CQ (qconstant (genv, sigma) args.(0))
-        | op when EConstr.eq_constr sigma op (Lazy.force rocq_IZR) ->
+        | op when EConstr.eq_constr sigma op (rocq_IZR()) ->
           Mc.CZ (parse_more_constant zconstant (genv, sigma) args.(0))
         | _ -> raise ParseError ) )
     | _ -> raise ParseError
@@ -972,25 +972,23 @@ type formula_op =
   ; op_tt : EConstr.t
   ; op_ff : EConstr.t }
 
-let prop_op =
-  lazy
+let prop_op() =
     { op_impl = None (* implication is Prod *)
-    ; op_and = Lazy.force rocq_and
-    ; op_or = Lazy.force rocq_or
-    ; op_iff = Lazy.force rocq_iff
-    ; op_not = Lazy.force rocq_not
-    ; op_tt = Lazy.force rocq_True
-    ; op_ff = Lazy.force rocq_False }
-
-let bool_op =
-  lazy
-    { op_impl = Some (Lazy.force rocq_implb)
-    ; op_and = Lazy.force rocq_andb
-    ; op_or = Lazy.force rocq_orb
-    ; op_iff = Lazy.force rocq_eqb
-    ; op_not = Lazy.force rocq_negb
-    ; op_tt = Lazy.force rocq_true
-    ; op_ff = Lazy.force rocq_false }
+    ; op_and = rocq_and()
+    ; op_or = rocq_or()
+    ; op_iff = rocq_iff()
+    ; op_not = rocq_not()
+    ; op_tt = rocq_True()
+    ; op_ff = rocq_False() }
+
+let bool_op () =
+    { op_impl = Some (rocq_implb())
+    ; op_and = rocq_andb()
+    ; op_or = rocq_orb()
+    ; op_iff = rocq_eqb()
+    ; op_not = rocq_negb()
+    ; op_tt = rocq_true()
+    ; op_ff = rocq_false() }
 
 let is_implb sigma l o =
   match o with None -> false | Some c -> EConstr.eq_constr sigma l c
@@ -1002,10 +1000,10 @@ let parse_formula (genv, sigma) parse_atom env tg term =
       (Mc.A (b, at, (tg, t)), env, Tag.next tg)
     with ParseError -> (Mc.X (b, t), env, tg)
   in
-  let prop_op = Lazy.force prop_op in
-  let bool_op = Lazy.force bool_op in
-  let eq = Lazy.force rocq_eq in
-  let bool = Lazy.force rocq_bool in
+  let prop_op = prop_op() in
+  let bool_op = bool_op() in
+  let eq = rocq_eq() in
+  let bool = rocq_bool() in
   let rec xparse_formula op k env tg term =
     match EConstr.kind sigma term with
     | App (l, rst) -> (
@@ -1049,17 +1047,15 @@ let parse_formula (genv, sigma) parse_atom env tg term =
   in
   xparse_formula prop_op Mc.IsProp env tg (*Reductionops.whd_zeta*) term
 
-(*  let dump_bool b = Lazy.force (if b then rocq_true else rocq_false)*)
-
 let undump_kind sigma k =
-  if EConstr.eq_constr sigma k (Lazy.force rocq_IsProp) then Mc.IsProp
+  if EConstr.eq_constr sigma k (rocq_IsProp()) then Mc.IsProp
   else Mc.IsBool
 
 let dump_kind k =
-  Lazy.force (match k with Mc.IsProp -> rocq_IsProp | Mc.IsBool -> rocq_IsBool)
+  match k with Mc.IsProp -> rocq_IsProp() | Mc.IsBool -> rocq_IsBool()
 
 let undump_formula undump_atom tg sigma f =
-  let is c c' = EConstr.eq_constr sigma c (Lazy.force c') in
+  let is c c' = EConstr.eq_constr sigma c (c'()) in
   let kind k = undump_kind sigma k in
   let rec xundump f =
     match EConstr.kind sigma f with
@@ -1088,10 +1084,10 @@ let undump_formula undump_atom tg sigma f =
 let dump_formula typ dump_atom f =
   let app_ctor c args =
     EConstr.mkApp
-      ( Lazy.force c
+      ( c()
       , Array.of_list
-          ( typ :: Lazy.force rocq_eKind :: Lazy.force rocq_unit
-          :: Lazy.force rocq_unit :: args ) )
+          ( typ :: rocq_eKind() :: rocq_unit()
+          :: rocq_unit() :: args ) )
   in
   let rec xdump f =
     match f with
@@ -1103,13 +1099,13 @@ let dump_formula typ dump_atom f =
       app_ctor rocq_IMPL
         [ dump_kind k
         ; xdump x
-        ; EConstr.mkApp (Lazy.force rocq_None, [|Lazy.force rocq_unit|])
+        ; EConstr.mkApp (rocq_None(), [|rocq_unit()|])
         ; xdump y ]
     | Mc.NOT (k, x) -> app_ctor rocq_NOT [dump_kind k; xdump x]
     | Mc.IFF (k, x, y) -> app_ctor rocq_IFF [dump_kind k; xdump x; xdump y]
     | Mc.EQ (x, y) -> app_ctor rocq_EQ [xdump x; xdump y]
     | Mc.A (k, x, _) ->
-      app_ctor rocq_Atom [dump_kind k; dump_atom x; Lazy.force rocq_tt]
+      app_ctor rocq_Atom [dump_kind k; dump_atom x; rocq_tt()]
     | Mc.X (k, t) -> app_ctor rocq_X [dump_kind k; t]
   in
   xdump f
@@ -1165,68 +1161,65 @@ type 'cst dump_expr =
   ; dump_op_prop : (Mc.op2 * EConstr.constr) list
   ; dump_op_bool : (Mc.op2 * EConstr.constr) list }
 
-let dump_zexpr =
-  lazy
-    { interp_typ = Lazy.force rocq_Z
-    ; dump_cst = dump_z
-    ; dump_add = Lazy.force rocq_Zplus
-    ; dump_sub = Lazy.force rocq_Zminus
-    ; dump_opp = Lazy.force rocq_Zopp
-    ; dump_mul = Lazy.force rocq_Zmult
-    ; dump_pow = Lazy.force rocq_Zpower
-    ; dump_pow_arg = (fun n -> dump_z (CamlToCoq.z (CoqToCaml.n n)))
-    ; dump_op_prop = List.map (fun (x, y) -> (y, Lazy.force x)) zop_table_prop
-    ; dump_op_bool = List.map (fun (x, y) -> (y, Lazy.force x)) zop_table_bool
-    }
-
-let dump_qexpr =
-  lazy
-    { interp_typ = Lazy.force rocq_Q
-    ; dump_cst = dump_q
-    ; dump_add = Lazy.force rocq_Qplus
-    ; dump_sub = Lazy.force rocq_Qminus
-    ; dump_opp = Lazy.force rocq_Qopp
-    ; dump_mul = Lazy.force rocq_Qmult
-    ; dump_pow = Lazy.force rocq_Qpower
-    ; dump_pow_arg = (fun n -> dump_z (CamlToCoq.z (CoqToCaml.n n)))
-    ; dump_op_prop = List.map (fun (x, y) -> (y, Lazy.force x)) qop_table_prop
-    ; dump_op_bool = List.map (fun (x, y) -> (y, Lazy.force x)) qop_table_bool
-    }
+let dump_zexpr () =
+  { interp_typ = rocq_Z()
+  ; dump_cst = dump_z
+  ; dump_add = rocq_Zplus()
+  ; dump_sub = rocq_Zminus()
+  ; dump_opp = rocq_Zopp()
+  ; dump_mul = rocq_Zmult()
+  ; dump_pow = rocq_Zpower()
+  ; dump_pow_arg = (fun n -> dump_z (CamlToCoq.z (CoqToCaml.n n)))
+  ; dump_op_prop = List.map (fun (x, y) -> (y, x())) zop_table_prop
+  ; dump_op_bool = List.map (fun (x, y) -> (y, x())) zop_table_bool
+  }
+
+let dump_qexpr () =
+  { interp_typ = rocq_Q()
+  ; dump_cst = dump_q
+  ; dump_add = rocq_Qplus()
+  ; dump_sub = rocq_Qminus()
+  ; dump_opp = rocq_Qopp()
+  ; dump_mul = rocq_Qmult()
+  ; dump_pow = rocq_Qpower()
+  ; dump_pow_arg = (fun n -> dump_z (CamlToCoq.z (CoqToCaml.n n)))
+  ; dump_op_prop = List.map (fun (x, y) -> (y, x())) qop_table_prop
+  ; dump_op_bool = List.map (fun (x, y) -> (y, x())) qop_table_bool
+  }
 
 let rec dump_Rcst_as_R cst =
   match cst with
-  | Mc.C0 -> Lazy.force rocq_R0
-  | Mc.C1 -> Lazy.force rocq_R1
-  | Mc.CQ q -> EConstr.mkApp (Lazy.force rocq_IQR, [|dump_q q|])
-  | Mc.CZ z -> EConstr.mkApp (Lazy.force rocq_IZR, [|dump_z z|])
+  | Mc.C0 -> rocq_R0()
+  | Mc.C1 -> rocq_R1()
+  | Mc.CQ q -> EConstr.mkApp (rocq_IQR(), [|dump_q q|])
+  | Mc.CZ z -> EConstr.mkApp (rocq_IZR(), [|dump_z z|])
   | Mc.CPlus (x, y) ->
-    EConstr.mkApp (Lazy.force rocq_Rplus, [|dump_Rcst_as_R x; dump_Rcst_as_R y|])
+    EConstr.mkApp (rocq_Rplus(), [|dump_Rcst_as_R x; dump_Rcst_as_R y|])
   | Mc.CMinus (x, y) ->
-    EConstr.mkApp (Lazy.force rocq_Rminus, [|dump_Rcst_as_R x; dump_Rcst_as_R y|])
+    EConstr.mkApp (rocq_Rminus(), [|dump_Rcst_as_R x; dump_Rcst_as_R y|])
   | Mc.CMult (x, y) ->
-    EConstr.mkApp (Lazy.force rocq_Rmult, [|dump_Rcst_as_R x; dump_Rcst_as_R y|])
+    EConstr.mkApp (rocq_Rmult(), [|dump_Rcst_as_R x; dump_Rcst_as_R y|])
   | Mc.CPow (x, y) -> (
     match y with
     | Mc.Inl z ->
-      EConstr.mkApp (Lazy.force rocq_powerZR, [|dump_Rcst_as_R x; dump_z z|])
+      EConstr.mkApp (rocq_powerZR(), [|dump_Rcst_as_R x; dump_z z|])
     | Mc.Inr n ->
-      EConstr.mkApp (Lazy.force rocq_Rpower, [|dump_Rcst_as_R x; dump_nat n|]) )
-  | Mc.CInv t -> EConstr.mkApp (Lazy.force rocq_Rinv, [|dump_Rcst_as_R t|])
-  | Mc.COpp t -> EConstr.mkApp (Lazy.force rocq_Ropp, [|dump_Rcst_as_R t|])
-
-let dump_rexpr =
-  lazy
-    { interp_typ = Lazy.force rocq_R
-    ; dump_cst = dump_Rcst_as_R
-    ; dump_add = Lazy.force rocq_Rplus
-    ; dump_sub = Lazy.force rocq_Rminus
-    ; dump_opp = Lazy.force rocq_Ropp
-    ; dump_mul = Lazy.force rocq_Rmult
-    ; dump_pow = Lazy.force rocq_Rpower
-    ; dump_pow_arg = (fun n -> dump_nat (CamlToCoq.nat (CoqToCaml.n n)))
-    ; dump_op_prop = List.map (fun (x, y) -> (y, Lazy.force x)) rop_table_prop
-    ; dump_op_bool = List.map (fun (x, y) -> (y, Lazy.force x)) rop_table_bool
-    }
+      EConstr.mkApp (rocq_Rpower(), [|dump_Rcst_as_R x; dump_nat n|]) )
+  | Mc.CInv t -> EConstr.mkApp (rocq_Rinv(), [|dump_Rcst_as_R t|])
+  | Mc.COpp t -> EConstr.mkApp (rocq_Ropp(), [|dump_Rcst_as_R t|])
+
+let dump_rexpr () =
+  { interp_typ = rocq_R()
+  ; dump_cst = dump_Rcst_as_R
+  ; dump_add = rocq_Rplus()
+  ; dump_sub = rocq_Rminus()
+  ; dump_opp = rocq_Ropp()
+  ; dump_mul = rocq_Rmult()
+  ; dump_pow = rocq_Rpower()
+  ; dump_pow_arg = (fun n -> dump_nat (CamlToCoq.nat (CoqToCaml.n n)))
+  ; dump_op_prop = List.map (fun (x, y) -> (y, x())) rop_table_prop
+  ; dump_op_bool = List.map (fun (x, y) -> (y, x())) rop_table_bool
+  }
 
 let prodn n env b =
   let rec prodrec = function
@@ -1246,7 +1239,7 @@ let prodn n env b =
 
 let eKind = function
   | Mc.IsProp -> EConstr.mkProp
-  | Mc.IsBool -> Lazy.force rocq_bool
+  | Mc.IsBool -> rocq_bool()
 
 let make_goal_of_formula gl dexpr form =
   let vars_idx =
@@ -1287,7 +1280,7 @@ let make_goal_of_formula gl dexpr form =
   let mkop_prop op e1 e2 =
     try EConstr.mkApp (List.assoc op dexpr.dump_op_prop, [|e1; e2|])
     with Not_found ->
-      EConstr.mkApp (Lazy.force rocq_eq, [|dexpr.interp_typ; e1; e2|])
+      EConstr.mkApp (rocq_eq(), [|dexpr.interp_typ; e1; e2|])
   in
   let dump_cstr_prop i {Mc.flhs; Mc.fop; Mc.frhs} =
     mkop_prop fop (dump_expr i flhs) (dump_expr i frhs)
@@ -1295,55 +1288,55 @@ let make_goal_of_formula gl dexpr form =
   let mkop_bool op e1 e2 =
     try EConstr.mkApp (List.assoc op dexpr.dump_op_bool, [|e1; e2|])
     with Not_found ->
-      EConstr.mkApp (Lazy.force rocq_eq, [|dexpr.interp_typ; e1; e2|])
+      EConstr.mkApp (rocq_eq(), [|dexpr.interp_typ; e1; e2|])
   in
   let dump_cstr_bool i {Mc.flhs; Mc.fop; Mc.frhs} =
     mkop_bool fop (dump_expr i flhs) (dump_expr i frhs)
   in
   let rec xdump_prop pi xi f =
     match f with
-    | Mc.TT _ -> Lazy.force rocq_True
-    | Mc.FF _ -> Lazy.force rocq_False
+    | Mc.TT _ -> rocq_True()
+    | Mc.FF _ -> rocq_False()
     | Mc.AND (_, x, y) ->
       EConstr.mkApp
-        (Lazy.force rocq_and, [|xdump_prop pi xi x; xdump_prop pi xi y|])
+        (rocq_and(), [|xdump_prop pi xi x; xdump_prop pi xi y|])
     | Mc.OR (_, x, y) ->
       EConstr.mkApp
-        (Lazy.force rocq_or, [|xdump_prop pi xi x; xdump_prop pi xi y|])
+        (rocq_or(), [|xdump_prop pi xi x; xdump_prop pi xi y|])
     | Mc.IFF (_, x, y) ->
       EConstr.mkApp
-        (Lazy.force rocq_iff, [|xdump_prop pi xi x; xdump_prop pi xi y|])
+        (rocq_iff(), [|xdump_prop pi xi x; xdump_prop pi xi y|])
     | Mc.IMPL (_, x, _, y) ->
       EConstr.mkArrow (xdump_prop pi xi x) ERelevance.relevant
         (xdump_prop (pi + 1) (xi + 1) y)
     | Mc.NOT (_, x) ->
-      EConstr.mkArrow (xdump_prop pi xi x) ERelevance.relevant (Lazy.force rocq_False)
+      EConstr.mkArrow (xdump_prop pi xi x) ERelevance.relevant (rocq_False())
     | Mc.EQ (x, y) ->
       EConstr.mkApp
-        ( Lazy.force rocq_eq
-        , [|Lazy.force rocq_bool; xdump_bool pi xi x; xdump_bool pi xi y|] )
+        ( rocq_eq()
+        , [|rocq_bool(); xdump_bool pi xi x; xdump_bool pi xi y|] )
     | Mc.A (_, x, _) -> dump_cstr_prop xi x
     | Mc.X (_, t) ->
       let idx = Env.get_rank props t in
       EConstr.mkRel (pi + idx)
   and xdump_bool pi xi f =
     match f with
-    | Mc.TT _ -> Lazy.force rocq_true
-    | Mc.FF _ -> Lazy.force rocq_false
+    | Mc.TT _ -> rocq_true()
+    | Mc.FF _ -> rocq_false()
     | Mc.AND (_, x, y) ->
       EConstr.mkApp
-        (Lazy.force rocq_andb, [|xdump_bool pi xi x; xdump_bool pi xi y|])
+        (rocq_andb(), [|xdump_bool pi xi x; xdump_bool pi xi y|])
     | Mc.OR (_, x, y) ->
       EConstr.mkApp
-        (Lazy.force rocq_orb, [|xdump_bool pi xi x; xdump_bool pi xi y|])
+        (rocq_orb(), [|xdump_bool pi xi x; xdump_bool pi xi y|])
     | Mc.IFF (_, x, y) ->
       EConstr.mkApp
-        (Lazy.force rocq_eqb, [|xdump_bool pi xi x; xdump_bool pi xi y|])
+        (rocq_eqb(), [|xdump_bool pi xi x; xdump_bool pi xi y|])
     | Mc.IMPL (_, x, _, y) ->
       EConstr.mkApp
-        (Lazy.force rocq_implb, [|xdump_bool pi xi x; xdump_bool pi xi y|])
+        (rocq_implb(), [|xdump_bool pi xi x; xdump_bool pi xi y|])
     | Mc.NOT (_, x) ->
-      EConstr.mkApp (Lazy.force rocq_negb, [|xdump_bool pi xi x|])
+      EConstr.mkApp (rocq_negb(), [|xdump_bool pi xi x|])
     | Mc.EQ (x, y) -> assert false
     | Mc.A (_, x, _) -> dump_cstr_bool xi x
     | Mc.X (_, t) ->
@@ -1386,18 +1379,18 @@ let set sigma l concl =
   in
   xset concl l
 
-let rocq_Branch = lazy (constr_of_ref "micromega.VarMap.Branch")
-let rocq_Elt = lazy (constr_of_ref "micromega.VarMap.Elt")
-let rocq_Empty = lazy (constr_of_ref "micromega.VarMap.Empty")
-let rocq_VarMap = lazy (constr_of_ref "micromega.VarMap.type")
+let rocq_Branch () = constr_of_ref "micromega.VarMap.Branch"
+let rocq_Elt () = constr_of_ref "micromega.VarMap.Elt"
+let rocq_Empty () = constr_of_ref "micromega.VarMap.Empty"
+let rocq_VarMap () = constr_of_ref "micromega.VarMap.type"
 
 let rec dump_varmap typ m =
   match m with
-  | Mc.Empty -> EConstr.mkApp (Lazy.force rocq_Empty, [|typ|])
-  | Mc.Elt v -> EConstr.mkApp (Lazy.force rocq_Elt, [|typ; v|])
+  | Mc.Empty -> EConstr.mkApp (rocq_Empty(), [|typ|])
+  | Mc.Elt v -> EConstr.mkApp (rocq_Elt(), [|typ; v|])
   | Mc.Branch (l, o, r) ->
     EConstr.mkApp
-      (Lazy.force rocq_Branch, [|typ; dump_varmap typ l; o; dump_varmap typ r|])
+      (rocq_Branch(), [|typ; dump_varmap typ l; o; dump_varmap typ r|])
 
 let vm_of_list env =
   match env with
@@ -1408,30 +1401,30 @@ let vm_of_list env =
       Mc.Empty env
 
 let rec dump_proof_term = function
-  | Micromega.DoneProof -> Lazy.force rocq_doneProof
+  | Micromega.DoneProof -> rocq_doneProof()
   | Micromega.RatProof (cone, rst) ->
     EConstr.mkApp
-      ( Lazy.force rocq_ratProof
+      ( rocq_ratProof()
       , [|dump_psatz rocq_Z dump_z cone; dump_proof_term rst|] )
   | Micromega.CutProof (cone, prf) ->
     EConstr.mkApp
-      ( Lazy.force rocq_cutProof
+      ( rocq_cutProof()
       , [|dump_psatz rocq_Z dump_z cone; dump_proof_term prf|] )
   | Micromega.SplitProof (p, prf1, prf2) ->
     EConstr.mkApp
-      ( Lazy.force rocq_splitProof
-      , [| dump_pol (Lazy.force rocq_Z) dump_z p
+      ( rocq_splitProof()
+      , [| dump_pol (rocq_Z()) dump_z p
          ; dump_proof_term prf1
          ; dump_proof_term prf2 |] )
   | Micromega.EnumProof (c1, c2, prfs) ->
     EConstr.mkApp
-      ( Lazy.force rocq_enumProof
+      ( rocq_enumProof()
       , [| dump_psatz rocq_Z dump_z c1
          ; dump_psatz rocq_Z dump_z c2
-         ; dump_list (Lazy.force rocq_proofTerm) dump_proof_term prfs |] )
+         ; dump_list (rocq_proofTerm()) dump_proof_term prfs |] )
   | Micromega.ExProof (p, prf) ->
     EConstr.mkApp
-      (Lazy.force rocq_ExProof, [|dump_positive p; dump_proof_term prf|])
+      (rocq_ExProof(), [|dump_positive p; dump_proof_term prf|])
 
 let rec size_of_psatz = function
   | Micromega.PsatzIn _ -> 1
@@ -1495,25 +1488,23 @@ type ('synt_c, 'prf) domain_spec =
   ; dump_proof : 'prf -> EConstr.constr
   ; coeff_eq : 'synt_c -> 'synt_c -> bool }
 
-let zz_domain_spec =
-  lazy
-    { typ = Lazy.force rocq_Z
-    ; coeff = Lazy.force rocq_Z
-    ; dump_coeff = dump_z
-    ; undump_coeff = parse_z
-    ; proof_typ = Lazy.force rocq_proofTerm
-    ; dump_proof = dump_proof_term
-    ; coeff_eq = Mc.Z.eqb }
-
-let qq_domain_spec =
-  lazy
-    { typ = Lazy.force rocq_Q
-    ; coeff = Lazy.force rocq_Q
-    ; dump_coeff = dump_q
-    ; undump_coeff = parse_q
-    ; proof_typ = Lazy.force rocq_QWitness
-    ; dump_proof = dump_psatz rocq_Q dump_q
-    ; coeff_eq = Mc.qeq_bool }
+let zz_domain_spec () =
+  { typ = rocq_Z()
+  ; coeff = rocq_Z()
+  ; dump_coeff = dump_z
+  ; undump_coeff = parse_z
+  ; proof_typ = rocq_proofTerm()
+  ; dump_proof = dump_proof_term
+  ; coeff_eq = Mc.Z.eqb }
+
+let qq_domain_spec () =
+  { typ = rocq_Q()
+  ; coeff = rocq_Q()
+  ; dump_coeff = dump_q
+  ; undump_coeff = parse_q
+  ; proof_typ = rocq_QWitness()
+  ; dump_proof = dump_psatz rocq_Q dump_q
+  ; coeff_eq = Mc.qeq_bool }
 
 let max_tag f =
   1
@@ -1533,7 +1524,7 @@ let max_tag f =
 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 = EConstr.mkApp (Lazy.force rocq_Cstr, [|spec.coeff|]) in
+  let formula_typ = EConstr.mkApp (rocq_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? *)
@@ -1546,11 +1537,11 @@ let micromega_order_change spec cert cert_typ env ff (*: unit Proofview.tactic*)
                [ ( "__ff"
                  , ff
                  , EConstr.mkApp
-                     ( Lazy.force rocq_Formula
-                     , [|formula_typ; Lazy.force rocq_IsProp|] ) )
+                     ( rocq_Formula()
+                     , [|formula_typ; rocq_IsProp()|] ) )
                ; ( "__varmap"
                  , vm
-                 , EConstr.mkApp (Lazy.force rocq_VarMap, [|spec.typ|]) )
+                 , EConstr.mkApp (rocq_VarMap(), [|spec.typ|]) )
                ; ("__wit", cert, cert_typ) ] concl) ])
 
 (**
@@ -1559,21 +1550,18 @@ let micromega_order_change spec cert cert_typ env ff (*: unit Proofview.tactic*)
 
 open Certificate
 
-type ('option, 'a, 'prf, 'model) prover =
-  { name : string
-  ; (* name of the prover *)
-    get_option : unit -> 'option
-  ; (* find the options of the prover *)
-    prover : 'option * 'a list -> ('prf, 'model) Certificate.res
-  ; (* the prover itself *)
-    hyps : 'prf -> ISet.t
-  ; (* extract the indexes of the hypotheses really used in the proof *)
-    compact : 'prf -> (int -> int) -> 'prf
-  ; (* remap the hyp indexes according to function *)
-    pp_prf : out_channel -> 'prf -> unit
-  ; (* pretting printing of proof *)
-    pp_f : out_channel -> 'a -> unit
-        (* pretty printing of the formulas (polynomials)*) }
+type ('option, 'a, 'prf, 'model) prover = {
+  (* find the options of the prover *)
+  get_option : unit -> 'option;
+  (* the prover itself *)
+  prover : 'option * 'a list -> ('prf, 'model) Certificate.res;
+  (* extract the indexes of the hypotheses really used in the proof *)
+  hyps : 'prf -> ISet.t;
+  (* remap the hyp indexes according to function *)
+  compact : 'prf -> (int -> int) -> 'prf;
+  (* pretting printing of proof *)
+  pp_prf : out_channel -> 'prf -> unit;
+}
 
 (**
   * Given a  prover and a disjunction of atoms, find a proof of any of
@@ -1700,24 +1688,24 @@ let abstract_formula : TagSet.t -> 'a formula -> 'a formula =
   let to_constr =
     Mc.
       { mkTT =
-          (let rocq_True = Lazy.force rocq_True in
-           let rocq_true = Lazy.force rocq_true in
+          (let rocq_True = rocq_True() in
+           let rocq_true = rocq_true() in
            function Mc.IsProp -> rocq_True | Mc.IsBool -> rocq_true)
       ; mkFF =
-          (let rocq_False = Lazy.force rocq_False in
-           let rocq_false = Lazy.force rocq_false in
+          (let rocq_False = rocq_False() in
+           let rocq_false = rocq_false() in
            function Mc.IsProp -> rocq_False | Mc.IsBool -> rocq_false)
       ; mkA = (fun k a (tg, t) -> t)
       ; mkAND =
-          (let rocq_and = Lazy.force rocq_and in
-           let rocq_andb = Lazy.force rocq_andb in
+          (let rocq_and = rocq_and() in
+           let rocq_andb = rocq_andb() in
            fun k x y ->
              EConstr.mkApp
                ( (match k with Mc.IsProp -> rocq_and | Mc.IsBool -> rocq_andb)
                , [|x; y|] ))
       ; mkOR =
-          (let rocq_or = Lazy.force rocq_or in
-           let rocq_orb = Lazy.force rocq_orb in
+          (let rocq_or = rocq_or() in
+           let rocq_orb = rocq_orb() in
            fun k x y ->
              EConstr.mkApp
                ( (match k with Mc.IsProp -> rocq_or | Mc.IsBool -> rocq_orb)
@@ -1726,24 +1714,24 @@ let abstract_formula : TagSet.t -> 'a formula -> 'a formula =
           (fun k x y ->
             match k with
             | Mc.IsProp -> EConstr.mkArrow x ERelevance.relevant y
-            | Mc.IsBool -> EConstr.mkApp (Lazy.force rocq_implb, [|x; y|]))
+            | Mc.IsBool -> EConstr.mkApp (rocq_implb(), [|x; y|]))
       ; mkIFF =
-          (let rocq_iff = Lazy.force rocq_iff in
-           let rocq_eqb = Lazy.force rocq_eqb in
+          (let rocq_iff = rocq_iff() in
+           let rocq_eqb = rocq_eqb() in
            fun k x y ->
              EConstr.mkApp
                ( (match k with Mc.IsProp -> rocq_iff | Mc.IsBool -> rocq_eqb)
                , [|x; y|] ))
       ; mkNOT =
-          (let rocq_not = Lazy.force rocq_not in
-           let rocq_negb = Lazy.force rocq_negb in
+          (let rocq_not = rocq_not() in
+           let rocq_negb = rocq_negb() in
            fun k x ->
              EConstr.mkApp
                ( (match k with Mc.IsProp -> rocq_not | Mc.IsBool -> rocq_negb)
                , [|x|] ))
       ; mkEQ =
-          (let rocq_eq = Lazy.force rocq_eq in
-           fun x y -> EConstr.mkApp (rocq_eq, [|Lazy.force rocq_bool; x; y|])) }
+          (let rocq_eq = rocq_eq() in
+           fun x y -> EConstr.mkApp (rocq_eq, [|rocq_bool(); x; y|])) }
   in
   Mc.abst_form to_constr (fun (t, _) -> TagSet.mem t hyps) true Mc.IsProp f
 
@@ -1916,8 +1904,8 @@ let micromega_gen parse_arith pre_process cnf spec dumpexpr prover tac =
             (EConstr.named_context genv) concl
         in
         let env = Env.elements env in
-        let spec = Lazy.force spec in
-        let dumpexpr = Lazy.force dumpexpr in
+        let spec = spec() in
+        let dumpexpr = dumpexpr() in
         if debug then
           Feedback.msg_debug (Pp.str "Env " ++ Env.pp (genv, sigma) env);
         match
@@ -1946,7 +1934,7 @@ let micromega_gen parse_arith pre_process cnf spec dumpexpr prover tac =
               ; intro_props
               ; intro_vars
               ; micromega_order_change spec res'
-                  (EConstr.mkApp (Lazy.force rocq_list, [|spec.proof_typ|]))
+                  (EConstr.mkApp (rocq_list(), [|spec.proof_typ|]))
                   env' ff_arith ]
           in
           let goal_props =
@@ -1979,9 +1967,9 @@ let micromega_wit_gen pre_process cnf spec prover wit_id ff =
   Proofview.Goal.enter (fun gl ->
       let sigma = Proofview.Goal.sigma gl in
       try
-        let spec = Lazy.force spec in
+        let spec = spec() in
         let undump_cstr = undump_cstr spec.undump_coeff in
-        let tg = Tag.from 0, Lazy.force rocq_tt in
+        let tg = Tag.from 0, rocq_tt() in
         let ff = undump_formula undump_cstr tg sigma ff in
         match
           micromega_tauto ~abstract:false pre_process cnf spec prover [] ff
@@ -1992,20 +1980,20 @@ let micromega_wit_gen pre_process cnf spec prover wit_id ff =
         | Model (m, e) ->
           Tacticals.tclFAIL (Pp.str " Cannot find witness")
         | Prf (_ids, _ff', res') ->
-          let tres' = EConstr.mkApp (Lazy.force rocq_list, [|spec.proof_typ|]) in
+          let tres' = EConstr.mkApp (rocq_list(), [|spec.proof_typ|]) in
           Tactics.letin_tac
             None (Names.Name wit_id) res' (Some tres') Locusops.nowhere
       with CsdpNotFound -> fail_csdp_not_found ())
 
 let micromega_order_changer cert env ff =
   (*let ids = Util.List.map_i (fun i _ -> (Names.Id.of_string ("__v"^(string_of_int i)))) 0 env in *)
-  let coeff = Lazy.force rocq_Rcst in
+  let coeff = rocq_Rcst() in
   let dump_coeff = dump_Rcst in
-  let typ = Lazy.force rocq_R in
+  let typ = rocq_R() in
   let cert_typ =
-    EConstr.mkApp (Lazy.force rocq_list, [|Lazy.force rocq_QWitness|])
+    EConstr.mkApp (rocq_list(), [|rocq_QWitness()|])
   in
-  let formula_typ = EConstr.mkApp (Lazy.force rocq_Cstr, [|coeff|]) in
+  let formula_typ = EConstr.mkApp (rocq_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.enter (fun gl ->
@@ -2017,22 +2005,21 @@ let micromega_order_changer cert env ff =
                [ ( "__ff"
                  , ff
                  , EConstr.mkApp
-                     ( Lazy.force rocq_Formula
-                     , [|formula_typ; Lazy.force rocq_IsProp|] ) )
-               ; ("__varmap", vm, EConstr.mkApp (Lazy.force rocq_VarMap, [|typ|]))
+                     ( rocq_Formula()
+                     , [|formula_typ; rocq_IsProp()|] ) )
+               ; ("__varmap", vm, EConstr.mkApp (rocq_VarMap(), [|typ|]))
                ; ("__wit", cert, cert_typ) ] concl)
           (*      Tacticals.tclTHENLIST (List.map (fun id ->  (Tactics.introduction id)) ids)*)
         ])
 
 let micromega_genr prover tac =
   let parse_arith = parse_rarith in
-  let spec =
-    lazy
-      { typ = Lazy.force rocq_R
-      ; coeff = Lazy.force rocq_Rcst
+  let spec () =
+      { typ = rocq_R()
+      ; coeff = rocq_Rcst()
       ; dump_coeff = dump_q
       ; undump_coeff = parse_q
-      ; proof_typ = Lazy.force rocq_QWitness
+      ; proof_typ = rocq_QWitness()
       ; dump_proof = dump_psatz rocq_Q dump_q
       ; coeff_eq = Mc.qeq_bool }
   in
@@ -2047,7 +2034,7 @@ let micromega_genr prover tac =
             (EConstr.named_context genv) concl
         in
         let env = Env.elements env in
-        let spec = Lazy.force spec in
+        let spec = spec() in
         let hyps' =
           List.map
             (fun (n, f) ->
@@ -2078,7 +2065,7 @@ let micromega_genr prover tac =
           in
           let ff' = abstract_wrt_formula ff' ff in
           let arith_goal, props, vars, ff_arith =
-            make_goal_of_formula (genv, sigma) (Lazy.force dump_rexpr) ff'
+            make_goal_of_formula (genv, sigma) (dump_rexpr()) ff'
           in
           let intro (id, _) = Tactics.introduction id in
           let intro_vars = Tacticals.tclTHENLIST (List.map intro vars) in
@@ -2191,12 +2178,18 @@ end)
   *)
 
 let require_csdp =
-  lazy (if System.is_in_system_path "csdp" then () else raise CsdpNotFound)
+  let checked = ref false in
+  fun () ->
+    if !checked then ()
+    else begin
+      let () = if System.is_in_system_path "csdp" then () else raise CsdpNotFound in
+      checked := true
+    end
 
 let really_call_csdpcert :
     provername -> micromega_polys -> Sos_types.positivstellensatz option =
  fun provername poly ->
-  Lazy.force require_csdp;
+  require_csdp();
   let cmdname = "csdpcert" in
   match (command cmdname [|cmdname|] (provername, poly) : csdp_certificate) with
   | F str ->
@@ -2351,80 +2344,72 @@ let memo_nra =
       lift_pexpr_prover (Certificate.nlinear_prover o) s)
 
 let linear_prover_Q =
-  { name = "linear prover"
-  ; get_option = lra_proof_depth
+  { get_option = lra_proof_depth
   ; prover =
       (fun (o, l) ->
         lift_pexpr_prover (Certificate.linear_prover_with_cert o) l)
   ; hyps = hyps_of_cone
   ; compact = compact_cone
   ; pp_prf = pp_psatz pp_q
-  ; pp_f = (fun o x -> pp_pol pp_q o (fst x)) }
+  }
 
 let linear_prover_R =
-  { name = "linear prover"
-  ; get_option = lra_proof_depth
+  { get_option = lra_proof_depth
   ; prover =
       (fun (o, l) ->
         lift_pexpr_prover (Certificate.linear_prover_with_cert o) l)
   ; hyps = hyps_of_cone
   ; compact = compact_cone
   ; pp_prf = pp_psatz pp_q
-  ; pp_f = (fun o x -> pp_pol pp_q o (fst x)) }
+  }
 
 let nlinear_prover_R =
-  { name = "nra"
-  ; get_option = lra_proof_depth
+  { get_option = lra_proof_depth
   ; prover = memo_nra
   ; hyps = hyps_of_cone
   ; compact = compact_cone
   ; pp_prf = pp_psatz pp_q
-  ; pp_f = (fun o x -> pp_pol pp_q o (fst x)) }
+  }
 
 let non_linear_prover_Q str o =
-  { name = "real nonlinear prover"
-  ; get_option = (fun () -> (str, o))
+  { get_option = (fun () -> (str, o))
   ; prover = (fun (o, l) -> call_csdpcert_q o l)
   ; hyps = hyps_of_cone
   ; compact = compact_cone
   ; pp_prf = pp_psatz pp_q
-  ; pp_f = (fun o x -> pp_pol pp_q o (fst x)) }
+  }
 
 let non_linear_prover_R str o =
-  { name = "real nonlinear prover"
-  ; get_option = (fun () -> (str, o))
+  { get_option = (fun () -> (str, o))
   ; prover = (fun (o, l) -> call_csdpcert_q o l)
   ; hyps = hyps_of_cone
   ; compact = compact_cone
   ; pp_prf = pp_psatz pp_q
-  ; pp_f = (fun o x -> pp_pol pp_q o (fst x)) }
+  }
 
 let non_linear_prover_Z str o =
-  { name = "real nonlinear prover"
-  ; get_option = (fun () -> (str, o))
+  { get_option = (fun () -> (str, o))
   ; prover = (fun (o, l) -> lift_ratproof (call_csdpcert_z o) l)
   ; hyps = hyps_of_pt
   ; compact = compact_pt
   ; pp_prf = pp_proof_term
-  ; pp_f = (fun o x -> pp_pol pp_z o (fst x)) }
+  }
 
 let linear_Z =
-  { name = "lia"
-  ; get_option = get_lia_option
+  { get_option = get_lia_option
   ; prover = memo_lia
   ; hyps = hyps_of_pt
   ; compact = compact_pt
   ; pp_prf = pp_proof_term
-  ; pp_f = (fun o x -> pp_pol pp_z o (fst x)) }
+  }
 
 let nlinear_Z =
-  { name = "nlia"
-  ; get_option = get_lia_option
+  { get_option = get_lia_option
   ; prover = memo_nlia
   ; hyps = hyps_of_pt
   ; compact = compact_pt
   ; pp_prf = pp_proof_term
-  ; pp_f = (fun o x -> pp_pol pp_z o (fst x)) }
+  }
 
 (**
   * Functions instantiating micromega_gen with the appropriate theories and
diff --git a/plugins/micromega/dune b/plugins/micromega/dune
index 9c995f2f22aa..0e55d5097672 100644
--- a/plugins/micromega/dune
+++ b/plugins/micromega/dune
@@ -5,10 +5,6 @@
  (synopsis "Rocq's micromega core plugin")
  (libraries zarith rocq-runtime.clib))
 
-(deprecated_library_name
- (old_public_name coq-core.plugins.micromega_core)
- (new_public_name rocq-runtime.plugins.micromega_core))
-
 (library
  (name micromega_plugin)
  (public_name rocq-runtime.plugins.micromega)
@@ -18,10 +14,6 @@
  (synopsis "Rocq's micromega plugin")
  (libraries rocq-runtime.plugins.ltac rocq-runtime.plugins.micromega_core))
 
-(deprecated_library_name
- (old_public_name coq-core.plugins.micromega)
- (new_public_name rocq-runtime.plugins.micromega))
-
 (executable
  (name csdpcert)
  (public_name csdpcert)
@@ -37,10 +29,6 @@
  (synopsis "Rocq's zify plugin")
  (libraries rocq-runtime.plugins.ltac))
 
-(deprecated_library_name
- (old_public_name coq-core.plugins.zify)
- (new_public_name rocq-runtime.plugins.zify))
-
 (rule
  (targets g_micromega.ml)
  (deps (:mlg g_micromega.mlg))
diff --git a/plugins/micromega/zify.ml b/plugins/micromega/zify.ml
index 0ce229de0ed1..a1ffa54725ae 100644
--- a/plugins/micromega/zify.ml
+++ b/plugins/micromega/zify.ml
@@ -11,11 +11,13 @@
 open Constr
 open Names
 open Pp
-open Lazy
 module NamedDecl = Context.Named.Declaration
 
 module ERelevance = EConstr.ERelevance
 
+(* many cases, TODO clean them up someday *)
+[@@@warning "-unused-field"]
+
 let debug_zify = CDebug.create ~name:"zify" ()
 
 (* The following [constr] are necessary for constructing the proof terms *)
@@ -26,43 +28,43 @@ let zify str =
        (Rocqlib.lib_ref ("ZifyClasses." ^ str)))
 
 (** classes *)
-let rocq_InjTyp = lazy (Rocqlib.lib_ref "ZifyClasses.InjTyp")
-
-let rocq_BinOp = lazy (Rocqlib.lib_ref "ZifyClasses.BinOp")
-let rocq_UnOp = lazy (Rocqlib.lib_ref "ZifyClasses.UnOp")
-let rocq_CstOp = lazy (Rocqlib.lib_ref "ZifyClasses.CstOp")
-let rocq_BinRel = lazy (Rocqlib.lib_ref "ZifyClasses.BinRel")
-let rocq_PropBinOp = lazy (Rocqlib.lib_ref "ZifyClasses.PropBinOp")
-let rocq_PropUOp = lazy (Rocqlib.lib_ref "ZifyClasses.PropUOp")
-let rocq_BinOpSpec = lazy (Rocqlib.lib_ref "ZifyClasses.BinOpSpec")
-let rocq_UnOpSpec = lazy (Rocqlib.lib_ref "ZifyClasses.UnOpSpec")
-let rocq_Saturate = lazy (Rocqlib.lib_ref "ZifyClasses.Saturate")
+let rocq_InjTyp () = Rocqlib.lib_ref "ZifyClasses.InjTyp"
+
+let rocq_BinOp () = Rocqlib.lib_ref "ZifyClasses.BinOp"
+let rocq_UnOp () = Rocqlib.lib_ref "ZifyClasses.UnOp"
+let rocq_CstOp () = Rocqlib.lib_ref "ZifyClasses.CstOp"
+let rocq_BinRel () = Rocqlib.lib_ref "ZifyClasses.BinRel"
+let rocq_PropBinOp () = Rocqlib.lib_ref "ZifyClasses.PropBinOp"
+let rocq_PropUOp () = Rocqlib.lib_ref "ZifyClasses.PropUOp"
+let rocq_BinOpSpec () = Rocqlib.lib_ref "ZifyClasses.BinOpSpec"
+let rocq_UnOpSpec () = Rocqlib.lib_ref "ZifyClasses.UnOpSpec"
+let rocq_Saturate () = Rocqlib.lib_ref "ZifyClasses.Saturate"
 
 (* morphism like lemma *)
 
-let mkapp2 = lazy (zify "mkapp2")
-let mkapp = lazy (zify "mkapp")
-let eq_refl = lazy (zify "eq_refl")
-let eq = lazy (zify "eq")
-let mkrel = lazy (zify "mkrel")
-let iff_refl = lazy (zify "iff_refl")
-let eq_iff = lazy (zify "eq_iff")
-let rew_iff = lazy (zify "rew_iff")
-let rew_iff_rev = lazy (zify "rew_iff_rev")
+let mkapp2 () = zify "mkapp2"
+let mkapp () = zify "mkapp"
+let eq_refl () = zify "eq_refl"
+let eq () = zify "eq"
+let mkrel () = zify "mkrel"
+let iff_refl () = zify "iff_refl"
+let eq_iff () = zify "eq_iff"
+let rew_iff () = zify "rew_iff"
+let rew_iff_rev () = zify "rew_iff_rev"
 
 (* propositional logic *)
 
-let op_and = lazy (zify "and")
-let op_and_morph = lazy (zify "and_morph")
-let op_or = lazy (zify "or")
-let op_or_morph = lazy (zify "or_morph")
-let op_impl_morph = lazy (zify "impl_morph")
-let op_iff = lazy (zify "iff")
-let op_iff_morph = lazy (zify "iff_morph")
-let op_not = lazy (zify "not")
-let op_not_morph = lazy (zify "not_morph")
-let op_True = lazy (zify "True")
-let op_I = lazy (zify "I")
+let op_and () = zify "and"
+let op_and_morph () = zify "and_morph"
+let op_or () = zify "or"
+let op_or_morph () = zify "or_morph"
+let op_impl_morph () = zify "impl_morph"
+let op_iff () = zify "iff"
+let op_iff_morph () = zify "iff_morph"
+let op_not () = zify "not"
+let op_not_morph () = zify "not_morph"
+let op_True () = zify "True"
+let op_I () = zify "I"
 
 (** [unsafe_to_constr c] returns a [Constr.t] without considering an evar_map.
     This is useful for calling Constr.hash *)
@@ -91,24 +93,26 @@ let rec find_option pred l =
   | e :: l -> ( match pred e with Some r -> r | None -> find_option pred l )
 
 module ConstrMap = struct
-  open Names.GlobRef
 
-  type 'a t = 'a list Map.t
+  open Environ
+
+  type 'a t = 'a list QGlobRef.Map.t
 
-  let add gr e m =
-    Map.update gr (function None -> Some [e] | Some l -> Some (e :: l)) m
+  let add env gr e m = match QGlobRef.Map.find_opt env gr m with
+  | None -> QGlobRef.Map.add env gr [e] m
+  | Some l -> QGlobRef.Map.add env gr (e :: l) m
 
-  let empty = Map.empty
+  let empty = QGlobRef.Map.empty
 
-  let find evd h m =
-    match Map.find (fst (EConstr.destRef evd h)) m with
+  let find env evd h m =
+    match QGlobRef.Map.find env (fst (EConstr.destRef evd h)) m with
     | e :: _ -> e
     | [] -> assert false
 
-  let find_all evd h m = Map.find (fst (EConstr.destRef evd h)) m
+  let find_all env evd h m = QGlobRef.Map.find env (fst (EConstr.destRef evd h)) m
 
   let fold f m acc =
-    Map.fold
+    QGlobRef.Map.fold
       (fun k l acc -> List.fold_left (fun acc e -> f k e acc) acc l)
       m acc
 end
@@ -117,7 +121,7 @@ module HConstr = struct
   module M = Map.Make (struct
     type t = EConstr.t
 
-    let compare c c' = Constr.compare (unsafe_to_constr c) (unsafe_to_constr c')
+    let compare c c' = Termops.ConstrData.compare (unsafe_to_constr c) (unsafe_to_constr c')
   end)
 
   type 'a t = 'a M.t
@@ -373,7 +377,7 @@ module type Elt = sig
   (** name *)
   val name : string
 
-  val gref : GlobRef.t Lazy.t
+  val gref : unit -> GlobRef.t
   val table : (term_kind * decl_kind) ConstrMap.t ref
   val cast : elt decl -> decl_kind
   val dest : decl_kind -> elt decl option
@@ -412,7 +416,7 @@ module EInj = struct
 
   let is_cstr_true evd c =
     match EConstr.kind evd c with
-    | Lambda (_, _, c) -> EConstr.eq_constr_nounivs evd c (Lazy.force op_True)
+    | Lambda (_, _, c) -> EConstr.eq_constr_nounivs evd c (op_True())
     | _ -> false
 
   let mk_elt evd i (a : EConstr.t array) =
@@ -642,23 +646,23 @@ module MakeTable (E : Elt) : S = struct
     with DestKO -> CErrors.user_err Pp.(str "Add Zify "++str E.name ++ str ": the term "++
                                           gl_pr_constr c ++ str " should be a global reference")
 
-  let register_hint evd t elt =
+  let register_hint env evd t elt =
     match EConstr.kind evd t with
     | App (c, _) ->
        let gr = safe_ref evd c in
-       E.table := ConstrMap.add gr (Application t, E.cast elt) !E.table
+       E.table := ConstrMap.add env gr (Application t, E.cast elt) !E.table
     | _ ->
        let gr = safe_ref evd t in
-       E.table := ConstrMap.add gr (OtherTerm t, E.cast elt) !E.table
+       E.table := ConstrMap.add env gr (OtherTerm t, E.cast elt) !E.table
 
   let register_constr env evd c =
     let c = EConstr.of_constr c in
     let t = get_type_of env evd c in
     match EConstr.kind evd t with
-    | App (intyp, args) when EConstr.isRefX env evd (Lazy.force E.gref) intyp ->
+    | App (intyp, args) when EConstr.isRefX env evd (E.gref()) intyp ->
       let styp = args.(E.get_key) in
       let elt = {decl = c; deriv = make_elt (evd, c)} in
-      register_hint evd styp elt
+      register_hint env evd styp elt
     | _ ->
       let env = Global.env () in
       raise
@@ -667,7 +671,7 @@ module MakeTable (E : Elt) : S = struct
              str "Cannot register " ++ pr_constr env evd c
              ++ str ". It has type " ++ pr_constr env evd t
              ++ str " instead of type "
-             ++ Printer.pr_global (Lazy.force E.gref)
+             ++ Printer.pr_global (E.gref())
              ++ str " X1 ... Xn"))
 
   let register_obj : Libobject.locality * Constr.constr -> Libobject.obj =
@@ -785,7 +789,7 @@ module CstrTable = struct
   module HConstr = Hashtbl.Make (struct
     type t = EConstr.t
 
-    let hash c = Constr.hash (unsafe_to_constr c)
+    let hash c = Termops.ConstrData.hash (unsafe_to_constr c)
     let equal c c' = Constr.equal (unsafe_to_constr c) (unsafe_to_constr c')
   end)
 
@@ -847,9 +851,9 @@ type prf =
 (** [eq_proof typ source target] returns (target = target : source = target) *)
 let eq_proof typ source target =
   EConstr.mkCast
-    ( EConstr.mkApp (force eq_refl, [|typ; target|])
+    ( EConstr.mkApp (eq_refl(), [|typ; target|])
     , DEFAULTcast
-    , EConstr.mkApp (force eq, [|typ; source; target|]) )
+    , EConstr.mkApp (eq(), [|typ; source; target|]) )
 
 let interp_prf evd inj source prf =
   let inj_source =
@@ -858,9 +862,9 @@ let interp_prf evd inj source prf =
   match prf with
   | Term ->
     let target = Tacred.compute (Global.env ()) evd inj_source in
-    (target, EConstr.mkApp (force eq_refl, [|inj.target; target|]))
+    (target, EConstr.mkApp (eq_refl(), [|inj.target; target|]))
   | Same ->
-    (inj_source, EConstr.mkApp (force eq_refl, [|inj.target; inj_source|]))
+    (inj_source, EConstr.mkApp (eq_refl(), [|inj.target; inj_source|]))
   | Conv trm -> (trm, eq_proof inj.target inj_source trm)
   | Prf (target, prf) -> (target, prf)
 
@@ -904,7 +908,7 @@ let app_unop env evd src unop arg prf =
   let cunop = unop.EUnOpT.classify_unop in
   let default a' prf' =
     let target = EConstr.mkApp (unop.EUnOpT.tuop, [|a'|]) in
-    let evd, h = Typing.checked_appvect env evd (force mkapp)
+    let evd, h = Typing.checked_appvect env evd (mkapp())
         [| unop.source1
          ; unop.source2
          ; unop.target1
@@ -979,7 +983,7 @@ let app_binop env evd src binop arg1 prf1 arg2 prf2 =
     in
     let default a1 prf1 a2 prf2 =
       let res = mkApp a1 a2 in
-      let evd, head = Typing.checked_appvect env evd (force mkapp2)
+      let evd, head = Typing.checked_appvect env evd (mkapp2())
           [| binop.source1
            ; binop.source2
            ; binop.source3
@@ -1090,20 +1094,20 @@ type prop_op =
 let classify_prop env evd e =
   match EConstr.kind evd e with
   | Prod (a, p1, p2) when is_arrow env evd a p1 p2 ->
-    BINOP (mk_propop IMPL arrow (force op_impl_morph), p1, p2)
+    BINOP (mk_propop IMPL arrow (op_impl_morph()), p1, p2)
   | App (c, a) -> (
     match Array.length a with
     | 1 ->
-      if EConstr.eq_constr_nounivs evd (force op_not) c then
-        UNOP (mk_propop NOT c (force op_not_morph), a.(0))
+      if EConstr.eq_constr_nounivs evd (op_not()) c then
+        UNOP (mk_propop NOT c (op_not_morph()), a.(0))
       else OTHEROP (c, a)
     | 2 ->
-      if EConstr.eq_constr_nounivs evd (force op_and) c then
-        BINOP (mk_propop AND c (force op_and_morph), a.(0), a.(1))
-      else if EConstr.eq_constr_nounivs evd (force op_or) c then
-        BINOP (mk_propop OR c (force op_or_morph), a.(0), a.(1))
-      else if EConstr.eq_constr_nounivs evd (force op_iff) c then
-        BINOP (mk_propop IFF c (force op_iff_morph), a.(0), a.(1))
+      if EConstr.eq_constr_nounivs evd (op_and()) c then
+        BINOP (mk_propop AND c (op_and_morph()), a.(0), a.(1))
+      else if EConstr.eq_constr_nounivs evd (op_or()) c then
+        BINOP (mk_propop OR c (op_or_morph()), a.(0), a.(1))
+      else if EConstr.eq_constr_nounivs evd (op_iff()) c then
+        BINOP (mk_propop IFF c (op_iff_morph()), a.(0), a.(1))
       else OTHEROP (c, a)
     | _ -> OTHEROP (c, a) )
   | _ -> OTHEROP (e, [||])
@@ -1158,7 +1162,7 @@ let rec trans_expr env evd e =
       let k, t =
         find_option
           (match_operator env evd c a (Some inj))
-          (ConstrMap.find_all evd c !table_cache)
+          (ConstrMap.find_all env evd c !table_cache)
       in
       let n = Array.length a in
       match k with
@@ -1225,7 +1229,7 @@ let trans_binrel env evd src rop a1 prf1 a2 prf2 =
       let a2', prf2 = interp_prf evd rop.inj a2 prf2 in
       (* XXX do we need to check more of this application or check other applications?
          This one found necessary in #16803 *)
-      let evd, h = Typing.checked_appvect env evd (force mkrel) [| rop.source; rop.target |] in
+      let evd, h = Typing.checked_appvect env evd (mkrel()) [| rop.source; rop.target |] in
       evd, TProof
         ( EConstr.mkApp (rop.EBinRelT.tbrel, [|a1'; a2'|])
         , EConstr.mkApp
@@ -1249,8 +1253,8 @@ let trans_binrel env evd src rop a1 prf1 a2 prf2 =
 let mkprf t p =
   EConstr.(
     match p with
-    | IProof -> (t, mkApp (force iff_refl, [|t|]))
-    | CProof t' -> (t', mkApp (force eq_iff, [|t; t'; eq_proof mkProp t t'|]))
+    | IProof -> (t, mkApp (iff_refl(), [|t|]))
+    | CProof t' -> (t', mkApp (eq_iff(), [|t; t'; eq_proof mkProp t t'|]))
     | TProof (t', p) -> (t', p))
 
 let mkprf t p =
@@ -1302,7 +1306,7 @@ let rec trans_prop env evd e =
       let k, t =
         find_option
           (match_operator env evd c a None)
-          (ConstrMap.find_all evd c !table_cache)
+          (ConstrMap.find_all env evd c !table_cache)
       in
       let n = Array.length a in
       match k with
@@ -1331,7 +1335,7 @@ let trans_check_prop env evd t =
 
 let get_hyp_typ = function
   | NamedDecl.LocalDef (h, _, ty) | NamedDecl.LocalAssum (h, ty) ->
-    (h.Context.binder_name, EConstr.of_constr ty)
+    (h.Context.binder_name, ty)
 
 let trans_hyps env evd l =
   List.fold_left
@@ -1362,7 +1366,7 @@ let trans_hyp h t0 prfp =
           let target = Reductionops.nf_betaiota env evd t' in
           let h' = Tactics.fresh_id_in_env Id.Set.empty h env in
           let prf =
-            EConstr.mkApp (force rew_iff, [|t0; target; prf; EConstr.mkVar h|])
+            EConstr.mkApp (rew_iff(), [|t0; target; prf; EConstr.mkVar h|])
           in
           tclTHEN
             (Tactics.pose_proof (Name.Name h') prf)
@@ -1386,7 +1390,7 @@ let trans_concl prfp =
         let typ = get_type_of env evd prf in
         match EConstr.kind evd typ with
         | App (c, a) when Array.length a = 2 ->
-          Tactics.apply (EConstr.mkApp (Lazy.force rew_iff_rev, [|a.(0); a.(1); prf|]))
+          Tactics.apply (EConstr.mkApp (rew_iff_rev(), [|a.(0); a.(1); prf|]))
         | _ ->
           raise (CErrors.anomaly Pp.(str "zify cannot transform conclusion")))
 
@@ -1414,11 +1418,11 @@ let do_let tac (h : Constr.named_declaration) =
         try
           let x = id.Context.binder_name in
           ignore
-            (let eq = Lazy.force eq in
+            (let eq = eq() in
              find_option
                (match_operator env evd eq
                   [|EConstr.of_constr ty; EConstr.mkVar x; EConstr.of_constr t|] None)
-               (ConstrMap.find_all evd eq !table_cache));
+               (ConstrMap.find_all env evd eq !table_cache));
           tac x (EConstr.of_constr t) (EConstr.of_constr ty)
         with Not_found -> Tacticals.tclIDTAC)
 
@@ -1429,7 +1433,7 @@ let iter_let_aux tac =
       init_cache ();
       Tacticals.tclMAP (do_let tac) sign)
 
-let iter_let (tac : Ltac_plugin.Tacinterp.Value.t) =
+let iter_let (tac : Ltac_plugin.Tacarg.tacvalue) =
   iter_let_aux (fun (id : Names.Id.t) t ty ->
       Ltac_plugin.Tacinterp.Value.apply tac
         [ Ltac_plugin.Tacinterp.Value.of_constr (EConstr.mkVar id)
@@ -1445,7 +1449,7 @@ let zify_tac =
       init_cache ();
       let evd = Proofview.Goal.sigma gl in
       let env = Proofview.Goal.env gl in
-      let sign = Environ.named_context env in
+      let sign = EConstr.named_context env in
       let concl = Proofview.Goal.concl gl in
       let evd, concl = trans_check_prop env evd concl in
       let evd, hyps = trans_hyps env evd sign in
@@ -1477,10 +1481,10 @@ let register_constr {map; spec_name; term_name; fresh; proofs} c thm =
     ; proofs = Set (tname, c) :: Pose (sname, thm) :: proofs } )
 
 let fresh_subscript env =
-  let ctx = (Environ.named_context_val env).Environ.env_named_map in
+  let ctx = Environ.ids_of_named_context_val (Environ.named_context_val env) in
   Nameops.Subscript.succ
-    (Names.Id.Map.fold
-       (fun id _ s ->
+    (Names.Id.Set.fold
+       (fun id s ->
          let _, s' = Nameops.get_subscript id in
          let cmp = Nameops.Subscript.compare s s' in
          if cmp = 0 then s else if cmp < 0 then s' else s)
@@ -1514,7 +1518,7 @@ let rec spec_of_term env evd (senv : spec_env) t =
     try (EConstr.mkVar (HConstr.find t' senv'.map), senv')
     with Not_found -> (
       try
-        match snd (ConstrMap.find evd c !specs_cache) with
+        match snd (ConstrMap.find env evd c !specs_cache) with
         | UnOpSpec s | BinOpSpec s ->
           let thm = EConstr.mkApp (s.deriv.ESpecT.spec, a') in
           register_constr senv' t' thm
@@ -1560,7 +1564,7 @@ let find_hyp evd t l =
   with Not_found -> None
 
 let find_proof evd t l =
-  if EConstr.eq_constr evd t (Lazy.force op_True) then Some (Lazy.force op_I)
+  if EConstr.eq_constr evd t (op_True()) then Some (op_I())
   else
     let l = List.map (fun decl -> NamedDecl.get_id decl, NamedDecl.get_type decl) l in
     find_hyp evd t l
@@ -1605,7 +1609,7 @@ let get_all_sat env evd c =
   List.fold_left
     (fun acc e -> match e with _, Saturate s -> s :: acc | _ -> acc)
     []
-    ( try ConstrMap.find_all evd c !saturate_cache
+    ( try ConstrMap.find_all env evd c !saturate_cache
       with DestKO | Not_found -> [] )
 
 let saturate =
diff --git a/plugins/micromega/zify.mli b/plugins/micromega/zify.mli
index 30ae2100ccc5..57b3444bcf98 100644
--- a/plugins/micromega/zify.mli
+++ b/plugins/micromega/zify.mli
@@ -29,5 +29,5 @@ module Saturate : S
 val zify_tac : unit Proofview.tactic
 val saturate : unit Proofview.tactic
 val iter_specs : unit Proofview.tactic
-val iter_let : Ltac_plugin.Tacinterp.Value.t -> unit Proofview.tactic
+val iter_let : Ltac_plugin.Tacarg.tacvalue -> unit Proofview.tactic
 val elim_let : unit Proofview.tactic
diff --git a/plugins/nsatz/dune b/plugins/nsatz/dune
index a5ff46814122..795cb89edecc 100644
--- a/plugins/nsatz/dune
+++ b/plugins/nsatz/dune
@@ -5,10 +5,6 @@
  (modules (:standard \ g_nsatz))
  (libraries rocq-runtime.tactics))
 
-(deprecated_library_name
- (old_public_name coq-core.plugins.nsatz_core)
- (new_public_name rocq-runtime.plugins.nsatz_core))
-
 (library
  (name nsatz_plugin)
  (public_name rocq-runtime.plugins.nsatz)
@@ -17,10 +13,6 @@
  (flags :standard -open Nsatz_core_plugin)
  (libraries rocq-runtime.plugins.nsatz_core rocq-runtime.plugins.ltac))
 
-(deprecated_library_name
- (old_public_name coq-core.plugins.nsatz)
- (new_public_name rocq-runtime.plugins.nsatz))
-
 (rule
  (targets g_nsatz.ml)
  (deps (:mlg g_nsatz.mlg))
diff --git a/plugins/nsatz/nsatz.ml b/plugins/nsatz/nsatz.ml
index da85d5eab3b0..bdb31b1917f0 100644
--- a/plugins/nsatz/nsatz.ml
+++ b/plugins/nsatz/nsatz.ml
@@ -124,7 +124,8 @@ let mul = function
   | (Const n,q) when Q.(equal one) n -> q
   | (p,q) -> Mul(p,q)
 
-let gen_constant n = lazy (UnivGen.constr_of_monomorphic_global (Global.env ()) (Rocqlib.lib_ref n))
+let gen_constant n () = UnivGen.constr_of_monomorphic_global (Global.env ()) (Rocqlib.lib_ref n)
+let force_constant f : constr = f ()
 
 let tpexpr  = gen_constant "plugins.ring.pexpr"
 let ttconst = gen_constant "plugins.ring.const"
@@ -151,14 +152,14 @@ let pxH = gen_constant "num.pos.xH"
 let nN0 = gen_constant "num.N.N0"
 let nNpos = gen_constant "num.N.Npos"
 
-let mkt_app name l =  mkApp (Lazy.force name, Array.of_list l)
+let mkt_app name l =  mkApp (force_constant name, Array.of_list l)
 
-let tlp () = mkt_app tlist [mkt_app tpexpr [Lazy.force tz]]
+let tlp () = mkt_app tlist [mkt_app tpexpr [force_constant tz]]
 let tllp () = mkt_app tlist [tlp()]
 
 let mkt_pos n =
   let rec mkt_pos n =
-  if Z.(equal one) n then Lazy.force pxH
+  if Z.(equal one) n then force_constant pxH
   else if Z.is_even n then
     mkt_app pxO [mkt_pos Z.(n asr 1)]
   else
@@ -167,11 +168,11 @@ let mkt_pos n =
 
 let mkt_n n =
   if Q.(equal zero) n
-  then Lazy.force nN0
+  then force_constant nN0
   else mkt_app nNpos [mkt_pos n]
 
 let mkt_z z  =
-  if Q.(equal zero) z then  Lazy.force z0
+  if Q.(equal zero) z then  force_constant z0
   else if Q.(lt zero) z then
     mkt_app zpos [mkt_pos z]
   else
@@ -180,28 +181,28 @@ let mkt_z z  =
 let rec mkt_term t  =  match t with
 | Zero -> mkt_term (Const Q.zero)
 | Const r -> let n = r |> Q.num |> Q.of_bigint in
-  mkt_app ttconst [Lazy.force tz; mkt_z n]
-| Var v -> mkt_app ttvar [Lazy.force tz; mkt_pos (Q.of_string v)]
-| Opp t1 -> mkt_app  ttopp [Lazy.force tz; mkt_term t1]
-| Add (t1,t2) -> mkt_app  ttadd [Lazy.force tz; mkt_term t1; mkt_term t2]
-| Sub (t1,t2) -> mkt_app  ttsub [Lazy.force tz; mkt_term t1; mkt_term t2]
-| Mul (t1,t2) -> mkt_app  ttmul [Lazy.force tz; mkt_term t1; mkt_term t2]
+  mkt_app ttconst [force_constant tz; mkt_z n]
+| Var v -> mkt_app ttvar [force_constant tz; mkt_pos (Q.of_string v)]
+| Opp t1 -> mkt_app  ttopp [force_constant tz; mkt_term t1]
+| Add (t1,t2) -> mkt_app  ttadd [force_constant tz; mkt_term t1; mkt_term t2]
+| Sub (t1,t2) -> mkt_app  ttsub [force_constant tz; mkt_term t1; mkt_term t2]
+| Mul (t1,t2) -> mkt_app  ttmul [force_constant tz; mkt_term t1; mkt_term t2]
 | Pow (t1,n) ->  if Int.equal n 0 then
-    mkt_app ttconst [Lazy.force tz; mkt_z Q.one]
+    mkt_app ttconst [force_constant tz; mkt_z Q.one]
 else
-    mkt_app ttpow [Lazy.force tz; mkt_term t1; mkt_n (Q.of_int n)]
+    mkt_app ttpow [force_constant tz; mkt_term t1; mkt_n (Q.of_int n)]
 
 let rec parse_pos p =
   match Constr.kind p with
 | App (a,[|p2|]) ->
-    if Constr.equal a (Lazy.force pxO) then Q.(mul (of_int 2)) (parse_pos p2)
+    if Constr.equal a (force_constant pxO) then Q.(mul (of_int 2)) (parse_pos p2)
     else Q.(add one) Q.(mul (of_int 2) (parse_pos p2))
 | _ -> Q.one
 
 let parse_z z =
   match Constr.kind z with
 | App (a,[|p2|]) ->
-    if Constr.equal a (Lazy.force zpos) then parse_pos p2 else Q.neg (parse_pos p2)
+    if Constr.equal a (force_constant zpos) then parse_pos p2 else Q.neg (parse_pos p2)
 | _ -> Q.zero
 
 let parse_n z =
@@ -213,15 +214,15 @@ let parse_n z =
 let rec parse_term p =
   match Constr.kind p with
 | App (a,[|_;p2|]) ->
-    if Constr.equal a (Lazy.force ttvar) then Var (Q.to_string (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)
+    if Constr.equal a (force_constant ttvar) then Var (Q.to_string (parse_pos p2))
+    else if Constr.equal a (force_constant ttconst) then Const (parse_z p2)
+    else if Constr.equal a (force_constant ttopp) then Opp (parse_term p2)
     else Zero
 | App (a,[|_;p2;p3|]) ->
-    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
+    if Constr.equal a (force_constant ttadd) then Add (parse_term p2, parse_term p3)
+    else if Constr.equal a (force_constant ttsub) then Sub (parse_term p2, parse_term p3)
+    else if Constr.equal a (force_constant ttmul) then Mul (parse_term p2, parse_term p3)
+    else if Constr.equal a (force_constant ttpow) then
       Pow (parse_term p2, Q.to_int (parse_n p3))
     else Zero
 | _ -> Zero
@@ -521,9 +522,9 @@ let nsatz lpol =
          let ltterm =
            List.fold_right
              (fun t r ->
-                mkt_app lcons [mkt_app tpexpr [Lazy.force tz];t;r])
+                mkt_app lcons [mkt_app tpexpr [force_constant tz];t;r])
              lt
-             (mkt_app lnil [mkt_app tpexpr [Lazy.force tz]]) in
+             (mkt_app lnil [mkt_app tpexpr [force_constant tz]]) in
          mkt_app lcons [tlp ();ltterm;r])
       res
       (mkt_app lnil [tlp ()]) in
diff --git a/plugins/ring/dune b/plugins/ring/dune
index 10ad5dfef3f9..425ec66f5394 100644
--- a/plugins/ring/dune
+++ b/plugins/ring/dune
@@ -4,10 +4,6 @@
  (synopsis "Rocq's ring plugin")
  (libraries rocq-runtime.plugins.ltac))
 
-(deprecated_library_name
- (old_public_name coq-core.plugins.ring)
- (new_public_name rocq-runtime.plugins.ring))
-
 (rule
  (targets g_ring.ml)
  (deps (:mlg g_ring.mlg))
diff --git a/plugins/ring/ring.ml b/plugins/ring/ring.ml
index 16f4634155ab..e9e11ef2b4e6 100644
--- a/plugins/ring/ring.ml
+++ b/plugins/ring/ring.ml
@@ -171,7 +171,7 @@ let _ = add_tacdef false ((Loc.ghost,Id.of_string"ring_closed_term"
 
 let ic env sigma c =
   let c, uctx = Constrintern.interp_constr env sigma c in
-  (Evd.from_ctx uctx, c)
+  (Evd.from_ustate uctx, c)
 
 let ic_unsafe env sigma c = (*FIXME remove *)
   fst (Constrintern.interp_constr env sigma c)
@@ -195,7 +195,7 @@ let decl_constant na suff univs c =
 
 (* Calling a global tactic *)
 let ltac_call tac (args:glob_tactic_arg list) =
-  CAst.make @@ TacArg (TacCall (CAst.make (ArgArg(Loc.tag @@ Lazy.force tac),args)))
+  CAst.make @@ TacArg (TacCall (CAst.make (ArgArg(Loc.tag tac),args)))
 
 let constr_of sigma v = match Value.to_constr v with
   | Some c -> EConstr.to_constr sigma c
@@ -264,8 +264,7 @@ let cdir = ["Stdlib";plugin_dir]
 
 let znew_ring_path =
   DirPath.make (List.map Id.of_string ["InitialRing";plugin_dir;"Stdlib"])
-let zltac s =
-  lazy(KerName.make (ModPath.MPfile znew_ring_path) (Id.of_string s))
+let zltac s = KerName.make (ModPath.MPfile znew_ring_path) (Id.of_string s)
 
 (* Ring theory *)
 
@@ -330,7 +329,7 @@ let _ = add_map "ring"
 (****************************************************************************)
 (* Ring database *)
 
-module Cmap = Map.Make(Constr)
+module Cmap = Map.Make(Termops.ConstrData)
 
 let from_carrier = Summary.ref Cmap.empty ~name:"ring-tac-carrier-table"
 
@@ -512,7 +511,7 @@ 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.tag @@ Lazy.force ltac_inv_morph_nothing) in
+        let t = ArgArg(Loc.tag ltac_inv_morph_nothing) in
               CAst.make (TacArg (TacCall (CAst.make (t,[]))))
 
 let make_hyp env sigma c =
@@ -535,7 +534,7 @@ let interp_power env sigma pow =
   let sigma, carrier = Evd.fresh_global env sigma (rocq_hypo ()) in
   match pow with
   | None ->
-      let t = ArgArg(Loc.tag (Lazy.force ltac_inv_morph_nothing)) in
+      let t = ArgArg(Loc.tag ltac_inv_morph_nothing) in
       let sigma, c = plapp sigma rocq_None [|carrier|] in
       sigma, (CAst.make (TacArg (TacCall (CAst.make (t,[])))), c)
   | Some (tac, spec) ->
@@ -688,7 +687,7 @@ let ltac_ring_structure e =
   [req;sth;ext;morph;th;cst_tac;pow_tac;
    lemma1;lemma2;pretac;posttac]
 
-let ring_lookup (f : Value.t) lH rl t =
+let ring_lookup f lH rl t =
   Proofview.Goal.enter begin fun gl ->
     let sigma = Proofview.Goal.sigma gl in
     let env = Proofview.Goal.env gl in
@@ -708,7 +707,7 @@ let new_field_path =
   DirPath.make (List.map Id.of_string ["Field_tac";plugin_dir;"Stdlib"])
 
 let field_ltac s =
-  lazy(KerName.make (ModPath.MPfile new_field_path) (Id.of_string s))
+  KerName.make (ModPath.MPfile new_field_path) (Id.of_string s)
 
 
 let _ = add_map "field"
@@ -967,7 +966,7 @@ let ltac_field_structure e =
   [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 =
+let field_lookup f lH rl t =
   Proofview.Goal.enter begin fun gl ->
     let sigma = Proofview.Goal.sigma gl in
     let env = Proofview.Goal.env gl in
diff --git a/plugins/ring/ring.mli b/plugins/ring/ring.mli
index 0b946d9fe188..fc8f0e043b5f 100644
--- a/plugins/ring/ring.mli
+++ b/plugins/ring/ring.mli
@@ -25,7 +25,7 @@ val add_theory :
 val print_rings : unit -> unit
 
 val ring_lookup :
-  Geninterp.Val.t ->
+  Ltac_plugin.Tacarg.tacvalue ->
   constr list ->
   constr list -> constr -> unit Proofview.tactic
 
@@ -37,6 +37,6 @@ val add_field_theory :
 val print_fields : unit -> unit
 
 val field_lookup :
-  Geninterp.Val.t ->
+  Ltac_plugin.Tacarg.tacvalue ->
   constr list ->
   constr list -> constr -> unit Proofview.tactic
diff --git a/plugins/rtauto/dune b/plugins/rtauto/dune
index bccf74b584c5..8fa6e944dc8d 100644
--- a/plugins/rtauto/dune
+++ b/plugins/rtauto/dune
@@ -4,10 +4,6 @@
  (synopsis "Rocq's rtauto plugin")
  (libraries rocq-runtime.plugins.ltac))
 
-(deprecated_library_name
- (old_public_name coq-core.plugins.rtauto)
- (new_public_name rocq-runtime.plugins.rtauto))
-
 (rule
  (targets g_rtauto.ml)
  (deps (:mlg g_rtauto.mlg))
diff --git a/plugins/rtauto/refl_tauto.ml b/plugins/rtauto/refl_tauto.ml
index 72f37be96178..3476ca2c24bb 100644
--- a/plugins/rtauto/refl_tauto.ml
+++ b/plugins/rtauto/refl_tauto.ml
@@ -52,17 +52,17 @@ module Search = struct
 
 end
 
-let force count lazc = incr count;Lazy.force lazc
+let force count lazc () = incr count;lazc()
 
 let step_count = ref 0
 
 let node_count = ref 0
 
-let li_False = lazy (destInd (constr_of_monomorphic_global (Global.env ()) @@ Rocqlib.lib_ref "core.False.type"))
-let li_and   = lazy (destInd (constr_of_monomorphic_global (Global.env ()) @@ Rocqlib.lib_ref "core.and.type"))
-let li_or    = lazy (destInd (constr_of_monomorphic_global (Global.env ()) @@ Rocqlib.lib_ref "core.or.type"))
+let li_False () = destInd (constr_of_monomorphic_global (Global.env ()) @@ Rocqlib.lib_ref "core.False.type")
+let li_and   () = destInd (constr_of_monomorphic_global (Global.env ()) @@ Rocqlib.lib_ref "core.and.type")
+let li_or    () = destInd (constr_of_monomorphic_global (Global.env ()) @@ Rocqlib.lib_ref "core.or.type")
 
-let gen_constant n = lazy (constr_of_monomorphic_global (Global.env ()) (Rocqlib.lib_ref n))
+let gen_constant n () = constr_of_monomorphic_global (Global.env ()) (Rocqlib.lib_ref n)
 
 let l_xI = gen_constant "num.pos.xI"
 let l_xO = gen_constant "num.pos.xO"
@@ -122,7 +122,7 @@ let rec make_form env sigma atom_env term =
   match EConstr.kind sigma cciterm with
     Prod(_,a,b) ->
      if noccurn sigma 1 b &&
-          QualityOrSet.is_prop (Retyping.get_sort_quality_of env sigma a)
+          Sorts.Quality.is_qprop (Retyping.get_sort_quality_of env sigma a)
      then
        let fa = make_form env sigma atom_env a in
        let fb = make_form env sigma atom_env b in
@@ -132,18 +132,18 @@ let rec make_form env sigma atom_env term =
   | Cast(a,_,_) ->
      make_form env sigma atom_env a
   | Ind (ind, _) ->
-     if Environ.QInd.equal env ind (fst (Lazy.force li_False))
+     if Environ.QInd.equal env ind (fst (li_False()))
      then Bot
      else make_atom atom_env (normalize term)
   | App(hd,argv) when Int.equal (Array.length argv) 2 ->
      begin
        try
          let ind, _ = destInd sigma hd in
-         if Environ.QInd.equal env ind (fst (Lazy.force li_and)) then
+         if Environ.QInd.equal env ind (fst (li_and())) then
            let fa = make_form env sigma atom_env argv.(0) in
            let fb = make_form env sigma atom_env argv.(1) in
            Conjunct (fa,fb)
-         else if Environ.QInd.equal env ind (fst (Lazy.force li_or)) then
+         else if Environ.QInd.equal env ind (fst (li_or())) then
            let fa = make_form env sigma atom_env argv.(0) in
            let fb = make_form env sigma atom_env argv.(1) in
            Disjunct (fa,fb)
@@ -160,28 +160,28 @@ let rec make_hyps env sigma atom_env lenv = function
      let hrec=
        make_hyps env sigma atom_env (typ::lenv) rest in
      if List.exists (fun c -> Termops.local_occur_var sigma id.binder_name c) lenv ||
-          (not (QualityOrSet.is_prop (Retyping.get_sort_quality_of env sigma typ)))
+          (not (Sorts.Quality.is_qprop (Retyping.get_sort_quality_of env sigma typ)))
      then
        hrec
      else
        (id,make_form env sigma atom_env typ)::hrec
 
 let rec build_pos n =
-  if n<=1 then force node_count l_xH
+  if n<=1 then force node_count l_xH ()
   else if Int.equal (n land 1) 0 then
-    mkApp (force node_count l_xO,[|build_pos (n asr 1)|])
+    mkApp (force node_count l_xO (),[|build_pos (n asr 1)|])
   else
-    mkApp (force node_count l_xI,[|build_pos (n asr 1)|])
+    mkApp (force node_count l_xI (),[|build_pos (n asr 1)|])
 
 let rec build_form = function
-    Atom n -> mkApp (force node_count l_Atom,[|build_pos n|])
+    Atom n -> mkApp (force node_count l_Atom (),[|build_pos n|])
   | Arrow (f1,f2) ->
-      mkApp (force node_count l_Arrow,[|build_form f1;build_form f2|])
-  | Bot -> force node_count l_Bot
+      mkApp (force node_count l_Arrow (),[|build_form f1;build_form f2|])
+  | Bot -> force node_count l_Bot ()
   | Conjunct (f1,f2) ->
-      mkApp (force node_count l_Conjunct,[|build_form f1;build_form f2|])
+      mkApp (force node_count l_Conjunct (),[|build_form f1;build_form f2|])
   | Disjunct (f1,f2) ->
-      mkApp (force node_count l_Disjunct,[|build_form f1;build_form f2|])
+      mkApp (force node_count l_Disjunct (),[|build_form f1;build_form f2|])
 
 let rec decal k = function
     [] -> k
@@ -199,49 +199,49 @@ let add_pop size d pops=
 let rec build_proof pops size =
   function
       Ax i ->
-        mkApp (force step_count l_Ax,
+        mkApp (force step_count l_Ax (),
                [|build_pos (decal i pops)|])
       | I_Arrow p ->
-          mkApp (force step_count l_I_Arrow,
+          mkApp (force step_count l_I_Arrow (),
                  [|build_proof pops (size + 1) p|])
       | E_Arrow(i,j,p) ->
-          mkApp (force step_count l_E_Arrow,
+          mkApp (force step_count l_E_Arrow (),
                  [|build_pos (decal i pops);
                    build_pos (decal j pops);
                    build_proof pops (size + 1) p|])
       | D_Arrow(i,p1,p2) ->
-          mkApp (force step_count l_D_Arrow,
+          mkApp (force step_count l_D_Arrow (),
                  [|build_pos (decal i pops);
                    build_proof pops (size + 2) p1;
                    build_proof pops (size + 1) p2|])
       | E_False i ->
-          mkApp (force step_count l_E_False,
+          mkApp (force step_count l_E_False (),
                  [|build_pos (decal i pops)|])
       | I_And(p1,p2) ->
-          mkApp (force step_count l_I_And,
+          mkApp (force step_count l_I_And (),
                  [|build_proof pops size p1;
                    build_proof pops size p2|])
       | E_And(i,p) ->
-          mkApp (force step_count l_E_And,
+          mkApp (force step_count l_E_And (),
                  [|build_pos (decal i pops);
                    build_proof pops (size + 2) p|])
       | D_And(i,p) ->
-          mkApp (force step_count l_D_And,
+          mkApp (force step_count l_D_And (),
                  [|build_pos (decal i pops);
                    build_proof pops (size + 1) p|])
       | I_Or_l(p) ->
-          mkApp (force step_count l_I_Or_l,
+          mkApp (force step_count l_I_Or_l (),
                  [|build_proof pops size p|])
       | I_Or_r(p) ->
-          mkApp (force step_count l_I_Or_r,
+          mkApp (force step_count l_I_Or_r (),
                  [|build_proof pops size p|])
       | E_Or(i,p1,p2) ->
-          mkApp (force step_count l_E_Or,
+          mkApp (force step_count l_E_Or (),
                  [|build_pos (decal i pops);
                    build_proof pops (size + 1) p1;
                    build_proof pops (size + 1) p2|])
       | D_Or(i,p) ->
-          mkApp (force step_count l_D_Or,
+          mkApp (force step_count l_D_Or (),
                  [|build_pos (decal i pops);
                    build_proof pops (size + 2) p|])
       | Pop(d,p) ->
@@ -249,8 +249,8 @@ let rec build_proof pops size =
 
 let build_env gamma=
   List.fold_right (fun (p,_) e ->
-                     mkApp(force node_count l_push,[|mkProp;p;e|]))
-    gamma.env (mkApp (force node_count l_empty,[|mkProp|]))
+                     mkApp(force node_count l_push (),[|mkProp;p;e|]))
+    gamma.env (mkApp (force node_count l_empty (),[|mkProp|]))
 
 let { Goptions.get = verbose } =
   Goptions.declare_bool_option_and_ref
@@ -275,7 +275,7 @@ let rtauto_tac =
     Rocqlib.check_required_library ["Stdlib";"rtauto";"Rtauto"];
     let gamma={next=1;env=[]} in
     let () =
-      if not (QualityOrSet.is_prop (Retyping.get_sort_quality_of env sigma concl))
+      if not (Sorts.Quality.is_qprop (Retyping.get_sort_quality_of env sigma concl))
       then user_err (Pp.str "Goal should be in Prop.") in
     let glf = make_form env sigma gamma concl in
     let hyps = make_hyps env sigma gamma [concl] hyps in
@@ -307,7 +307,7 @@ let rtauto_tac =
         end in
     let build_start_time=System.get_time () in
     let () = step_count := 0; node_count := 0 in
-    let main = mkApp (force node_count l_Reflect,
+    let main = mkApp (force node_count l_Reflect (),
                       [|build_env gamma;
                         build_form formula;
                         build_proof [] 0 prf|]) in
diff --git a/plugins/ssr/dune b/plugins/ssr/dune
index 1e1b9c2ed181..1a9ad655d417 100644
--- a/plugins/ssr/dune
+++ b/plugins/ssr/dune
@@ -6,10 +6,6 @@
  (flags :standard -open Gramlib)
  (libraries rocq-runtime.plugins.ssrmatching))
 
-(deprecated_library_name
- (old_public_name coq-core.plugins.ssreflect)
- (new_public_name rocq-runtime.plugins.ssreflect))
-
 (rule
  (targets ssrvernac.ml)
  (deps (:mlg ssrvernac.mlg))
diff --git a/plugins/ssr/ssrast.mli b/plugins/ssr/ssrast.mli
index 930b0a58110b..3479eb1e00ca 100644
--- a/plugins/ssr/ssrast.mli
+++ b/plugins/ssr/ssrast.mli
@@ -68,7 +68,7 @@ type ast_glob_env = {
 type ast_closure_term = {
   body : Constrexpr.constr_expr;
   glob_env : ast_glob_env option; (* for Tacintern.intern_constr *)
-  interp_env :  Geninterp.interp_sign option; (* for Tacinterp.interp_open_constr_with_bindings *)
+  interp_env :  Tacinterp.interp_sign option; (* for Tacinterp.interp_open_constr_with_bindings *)
   annotation : [ `None | `Parens | `DoubleParens | `At ];
 }
 
diff --git a/plugins/ssr/ssrbwd.ml b/plugins/ssr/ssrbwd.ml
index e15dd93b8ef3..0c7da9dd6f43 100644
--- a/plugins/ssr/ssrbwd.ml
+++ b/plugins/ssr/ssrbwd.ml
@@ -151,7 +151,7 @@ let inner_ssrapplytac gviews (ggenl, gclr) ist =
     let env = Proofview.Goal.env gl in
     let concl = Proofview.Goal.concl gl in
     let clr', lemma = interp_agens ist env sigma ~concl agens in
-    let sigma = Evd.merge_universe_context sigma (Evd.ustate (fst lemma)) in
+    let sigma = Evd.merge_ustate sigma (Evd.ustate (fst lemma)) in
     Tacticals.tclTHENLIST [Proofview.Unsafe.tclEVARS sigma; cleartac clr; refine_with ~beta:true lemma; cleartac clr']
   | _, _ ->
     Tacticals.tclTHENLIST [apply_top_tac; cleartac clr]))
diff --git a/plugins/ssr/ssrcommon.ml b/plugins/ssr/ssrcommon.ml
index f84eeaab288e..40258be845cb 100644
--- a/plugins/ssr/ssrcommon.ml
+++ b/plugins/ssr/ssrcommon.ml
@@ -47,7 +47,7 @@ let hyp_id (SsrHyp (_, id)) = id
 let hyp_err ?loc msg id =
   CErrors.user_err ?loc Pp.(str msg ++ Id.print id)
 
-let not_section_id id = not (Termops.is_section_variable (Global.env ()) id)
+let not_section_id id = not (Termops.is_section_variable (Global.env ()) id) [@@warning "-3"]
 
 let hyps_ids = List.map hyp_id
 
@@ -222,7 +222,7 @@ let glob_ast_closure_term (ist : Genintern.glob_sign) t =
 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) env sigma t =
+let interp_ast_closure_term (ist : Tacinterp.interp_sign) env sigma t =
   (* sigma is only useful if we want to interp *now*, later we have
    * a potentially different gl.sigma *)
   { t with interp_env = Some ist }
@@ -251,7 +251,7 @@ let add_internal_name pt = internal_names := pt :: !internal_names
 let is_internal_name s = List.exists (fun p -> p s) !internal_names
 
 let mk_internal_id s =
-  let s' = Printf.sprintf "_%s_" s in
+  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'
 
@@ -262,19 +262,22 @@ 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 mk_tagged_id t i = Id.of_string (Printf.sprintf "%s%d‗" t i)
+(* [is_dll s n] test if character at pos [n] of [s] is UTF8 double low line '‗'.
+   Assumes [n] <= [String.length n - 3]. *)
+let is_dll s n = s.[n] = '\226' && s.[n+1] = '\128' && s.[n+2] = '\151'
 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 n = String.length s and m = String.length t in
+  m < n - 3 && is_dll s (n - 3) && same_prefix s t m && skip_digits s m = n - 3
 
-let evar_tag = "_evar_"
+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 wildcard_tag = "‗the_"
+let wildcard_post = "_wildcard‗"
 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
@@ -283,19 +286,19 @@ let has_wildcard_tag s =
   skip_digits s m = n - m' - 2
 let _ = add_internal_name has_wildcard_tag
 
-let discharged_tag = "_discharged_"
+let discharged_tag = "‗discharged_"
 let mk_discharged_id id =
-  Id.of_string (Printf.sprintf "%s%s_" discharged_tag (Id.to_string 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 m = String.length discharged_tag and n = String.length s in
+  m < n - 3 && is_dll s (n - 3) && 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 s = Id.to_string id in let n = String.length s - 3 in
+  let dn = String.length t - 3 - n in let i0 = j0 - dn in
+  if not (i0 >= m && is_dll 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
@@ -309,9 +312,9 @@ let max_suffix m (t, j0 as tj0) id  =
 let mk_anon_id t gl_ids =
   let gl_ids = List.map NamedDecl.get_id (EConstr.named_context_of_val gl_ids) in
   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 s = ref (Printf.sprintf  "‗%s‗" t) in
+    if is_internal_name !s then s := "‗" ^ !s;
+    let n = String.length !s - 3 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
@@ -320,10 +323,12 @@ let mk_anon_id t gl_ids =
   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 n = length s - 3 in
+  let cat_dll s =
+    set s (n + 1) '\226'; set s (n + 2) '\128'; cat s (of_string "\151") 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
+    if i < m then (set s n '0'; set s m '1'; cat_dll s) else
     (set s i (Char.chr (Char.code (get s i) + 1)); s) in
   Id.of_string_soft (Bytes.to_string (loop (n - 1)))
 
@@ -485,7 +490,7 @@ let abs_evars_pirrel env sigma0 (sigma, c0) =
     let evi = Evd.find_undefined sigma k in
     (* FIXME? this is not the right environment in general *)
     let k_ty = Retyping.get_sort_quality_of env sigma (Evd.evar_concl evi) in
-    let is_prop = UnivGen.QualityOrSet.is_prop k_ty in
+    let is_prop = Sorts.Quality.is_qprop k_ty in
     let t = abs_evar n k in
     (k, (n, t, is_prop, Evd.evar_relevance evi)) :: put evlist t
   | _ -> EConstr.fold sigma put evlist c in
@@ -551,7 +556,7 @@ let nb_evar_deps = function
     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 e when CErrors.noncritical e -> 0)
+    (try int_of_string (String.sub s m (String.length s - 3 - m)) with e when CErrors.noncritical e -> 0)
   | _ -> 0
 
 let type_id env sigma t = Id.of_string (Namegen.hdchar env sigma t)
@@ -687,7 +692,7 @@ let abs_ssrterm ?(resolve_typeclasses=false) ist env sigma t =
        sigma, Evarutil.nf_evar sigma ct in
   let c, abstracted_away, ucst = abs_evars env sigma0 t in
   let n = List.length abstracted_away in
-  let sigma = Evd.merge_universe_context sigma0 ucst in
+  let sigma = Evd.merge_ustate sigma0 ucst in
   let t = abs_cterm env sigma n c in
   sigma, t, n
 
@@ -761,7 +766,7 @@ let pf_interp_ty ?(resolve_typeclasses=false) env sigma0 ist ty =
        sigma, Evarutil.nf_evar sigma cty in
    let c, evs, ucst = abs_evars env sigma0 ty in
    let n = List.length evs in
-   let sigma0 = Evd.merge_universe_context sigma0 ucst in
+   let sigma0 = Evd.merge_ustate sigma0 ucst in
    let lam_c = abs_cterm env sigma0 n c in
    let ctx, c = EConstr.decompose_lambda_n_assum sigma n lam_c in
    sigma0, n, EConstr.it_mkProd_or_LetIn c ctx, lam_c
@@ -926,7 +931,7 @@ let refine_with ?(first_goes_last=false) ?beta ?(with_evars=true) oc =
   let sigma = Proofview.Goal.sigma gl in
   let uct = Evd.ustate (fst oc) in
   let n, oc = abs_evars_pirrel env sigma oc in
-  Proofview.Unsafe.tclEVARS (Evd.set_universe_context sigma uct) <*>
+  Proofview.Unsafe.tclEVARS (Evd.set_ustate sigma uct) <*>
   Proofview.tclORELSE (applyn ~with_evars ~first_goes_last ?beta n oc)
     (fun _ -> Proofview.tclZERO dependent_apply_error)
   end
@@ -1049,7 +1054,7 @@ let get_hyp env sigma id =
 (* XXX the k of the redex should percolate out *)
 let pf_interp_gen_aux env sigma ~concl to_ind ((oclr, occ), t) =
   let pat = interp_cpattern env sigma t None in (* UGLY API *)
-  let sigma = Evd.merge_universe_context sigma (Evd.ustate @@ pat.pat_sigma) in
+  let sigma = Evd.merge_ustate sigma (Evd.ustate @@ pat.pat_sigma) in
   let sigma, c, cl = fill_rel_occ_pattern env sigma concl pat occ in
   let clr = interp_clr sigma (oclr, (tag_of_cpattern t, c)) in
   if not(occur_existential sigma c) then
@@ -1062,7 +1067,7 @@ let pf_interp_gen_aux env sigma ~concl to_ind ((oclr, occ), t) =
     else let sigma, ccl =  pf_mkprod env sigma c cl in false, pat, ccl, c, clr, sigma
   else if to_ind && occ = None then
     let p, evs, ucst' = abs_evars env sigma (pat.pat_sigma, c) in
-    let sigma = Evd.merge_universe_context sigma ucst' in
+    let sigma = Evd.merge_ustate sigma ucst' in
     if List.is_empty evs then anomaly "occur_existential but no evars" else
     let sigma, pty, rp = pfe_type_relevance_of env sigma p in
     false, pat, EConstr.mkProd (make_annot (constr_name sigma c) rp, pty, concl), p, clr, sigma
@@ -1131,7 +1136,7 @@ let abs_wgen env sigma keep_let f gen (args,c) =
   | _, Some ((x, "@"), Some p) ->
      let x = hoi_id x in
      let cp = interp_cpattern env sigma p None in
-     let sigma = Evd.merge_universe_context sigma (Evd.ustate cp.pat_sigma) in
+     let sigma = Evd.merge_ustate sigma (Evd.ustate cp.pat_sigma) in
      let sigma, t, c = fill_rel_occ_pattern env sigma c cp None in
      evar_closed t p;
      let ut = red_product_skip_id env sigma t in
@@ -1140,7 +1145,7 @@ let abs_wgen env sigma keep_let f gen (args,c) =
   | _, Some ((x, _), Some p) ->
      let x = hoi_id x in
      let cp = interp_cpattern env sigma p None in
-     let sigma = Evd.merge_universe_context sigma (Evd.ustate cp.pat_sigma) in
+     let sigma = Evd.merge_ustate sigma (Evd.ustate cp.pat_sigma) in
      let sigma, t, c = fill_rel_occ_pattern env sigma c cp None in
      evar_closed t p;
      let sigma, ty, r = pfe_type_relevance_of env sigma t in
@@ -1198,7 +1203,7 @@ let unsafe_intro env decl ~relevance b =
   let open Context.Named.Declaration in
   Refine.refine_with_principal ~typecheck:false begin fun sigma ->
     let ctx = Environ.named_context_val env in
-    let nctx = EConstr.push_named_context_val decl ctx in
+    let nctx = EConstr.push_named_context_val ProofVar decl ctx in
     let inst = EConstr.identity_subst_val (Environ.named_context_val env) in
     let ninst = SList.cons (EConstr.mkRel 1) inst in
     let nb = EConstr.Vars.subst1 (EConstr.mkVar (get_id decl)) b in
@@ -1207,8 +1212,10 @@ let unsafe_intro env decl ~relevance b =
   end
 
 let set_decl_id id = let open Context in function
-  | Rel.Declaration.LocalAssum(name,ty) -> Named.Declaration.LocalAssum({name with binder_name=id},ty)
-  | Rel.Declaration.LocalDef(name,ty,t) -> Named.Declaration.LocalDef({name with binder_name=id},ty,t)
+  | Rel.Declaration.LocalAssum(name,ty) ->
+    Named.Declaration.LocalAssum({name with binder_name=id},ty)
+  | Rel.Declaration.LocalDef(name,ty,t) ->
+    Named.Declaration.LocalDef({name with binder_name=id},ty,t)
 
 let rec decompose_assum env sigma orig_goal =
   let open Context in
@@ -1265,7 +1272,7 @@ let tclINTRO ~id ~conclusion:k = Goal.enter begin fun gl ->
        let ids = Environ.named_context_val env in
        mk_anon_id ssr_anon_hyp ids
   in
-  if Id.Map.mem id already_used.Environ.env_named_map then
+  if Environ.mem_named_ctxt id already_used then
     errorstrm Pp.(Id.print id ++ str" already used");
   unsafe_intro env (set_decl_id id decl) ~relevance t <*>
   (if no_red then tclUNIT () else tclFULL_BETAIOTA) <*>
diff --git a/plugins/ssr/ssrcommon.mli b/plugins/ssr/ssrcommon.mli
index 8274657acbee..309fd844cd7f 100644
--- a/plugins/ssr/ssrcommon.mli
+++ b/plugins/ssr/ssrcommon.mli
@@ -117,7 +117,7 @@ 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 -> env -> evar_map -> ast_closure_term -> ast_closure_term
+val interp_ast_closure_term : Tacinterp.interp_sign -> env -> evar_map -> ast_closure_term -> 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
@@ -149,6 +149,9 @@ val mkSsrConst : Environ.env -> Evd.evar_map -> string -> Evd.evar_map * EConstr
 
 val is_discharged_id : Id.t -> bool
 val mk_discharged_id : Id.t -> Id.t
+(* [is_dll s n] test if character at pos [n] of [s] is UTF8 double low line '‗'.
+   Assumes [n] < [String.length n - 3]. *)
+val is_dll : string -> int -> bool
 val is_tagged : string -> string -> bool
 val has_discharged_tag : string -> bool
 val ssrqid : string -> Libnames.qualid
@@ -157,7 +160,7 @@ val nbargs_open_constr : Environ.env -> Evd.evar_map * EConstr.t -> int
 val pf_nbargs : Environ.env -> Evd.evar_map -> EConstr.t -> int
 
 val ssrevaltac :
-  Tacinterp.interp_sign -> Tacinterp.Value.t -> unit Proofview.tactic
+  Tacinterp.interp_sign -> Tacarg.tacvalue -> unit Proofview.tactic
 
 val convert_concl_no_check : EConstr.t -> unit Proofview.tactic
 val convert_concl : check:bool -> EConstr.t -> unit Proofview.tactic
diff --git a/plugins/ssr/ssrelim.ml b/plugins/ssr/ssrelim.ml
index f38b5c2e6be8..5c5164c552f1 100644
--- a/plugins/ssr/ssrelim.ml
+++ b/plugins/ssr/ssrelim.ml
@@ -145,7 +145,7 @@ let fire_subst sigma t = Reductionops.nf_evar sigma t
 let mkTpat env sigma0 (sigma, t) = (* takes a term, refreshes it and makes a T pattern *)
   let t, evs, ucst = abs_evars env sigma0 (sigma, fire_subst sigma t) in
   let t, _, _, sigma = saturate ~beta:true env sigma t (List.length evs) in
-  { pat_sigma = Evd.merge_universe_context sigma ucst; pat_pat = T t }
+  { pat_sigma = Evd.merge_ustate sigma ucst; pat_pat = T t }
 
 let redex_of_pattern env p = match redex_of_pattern p with
 | None -> CErrors.anomaly (Pp.str "pattern without redex.")
@@ -154,7 +154,7 @@ let redex_of_pattern env p = match redex_of_pattern p with
 let unif_redex env sigma0 nsigma p t = (* t is a hint for the redex of p *)
   let t, evs, ucst = abs_evars env sigma0 (nsigma, fire_subst nsigma t) in
   let t, _, _, sigma = saturate ~beta:true env p.pat_sigma t (List.length evs) in
-  let sigma = Evd.merge_universe_context sigma ucst in
+  let sigma = Evd.merge_ustate sigma ucst in
   match p.pat_pat with
   | X_In_T p -> { pat_sigma = sigma; pat_pat = E_As_X_In_T (t, p) }
   | _ ->
@@ -335,14 +335,14 @@ let generate_pred env sigma0 ~concl patterns predty eqid is_rec deps elim_args n
       cl, sigma, post @ [h, p, inf_t, occ]
     else try
       let c, cl, ucst = match_pat env sigma0 p occ h cl in
-      let sigma = Evd.merge_universe_context sigma ucst in
+      let sigma = Evd.merge_ustate sigma ucst in
       let sigma = try unify_HO env sigma inf_t c
                 with exn when CErrors.noncritical exn -> error sigma c inf_t in
       cl, sigma, post
     with
     | NoMatch | NoProgress ->
         let e, ucst = redex_of_pattern env p in
-        let sigma = Evd.merge_universe_context sigma ucst in
+        let sigma = Evd.merge_ustate sigma ucst in
         let e, evs, _ucst = abs_evars env sigma (p.pat_sigma, e) in
         let e, _, _, sigma = saturate ~beta:true env sigma e (List.length evs) in
         let sigma = try unify_HO env sigma inf_t e
@@ -380,7 +380,7 @@ let generate_pred env sigma0 ~concl patterns predty eqid is_rec deps elim_args n
           let open Proofview.Notations in
           Proofview.Goal.enter begin fun s ->
           let sigma = Proofview.Goal.sigma s in
-          let sigma = Evd.merge_universe_context sigma ucst in
+          let sigma = Evd.merge_ustate sigma ucst in
           let sigma, shelve = Evar.Map.fold (fun e info (sigma, shelve) ->
               if not @@ Evd.mem sigma e then
                 Evd.add sigma e info, e::shelve else
diff --git a/plugins/ssr/ssrequality.ml b/plugins/ssr/ssrequality.ml
index d4cc38261cd4..a505ace81f1b 100644
--- a/plugins/ssr/ssrequality.ml
+++ b/plugins/ssr/ssrequality.ml
@@ -100,7 +100,7 @@ let congrtac ((n, t), ty) ist =
   debug_ssr (fun () -> (Pp.str"===congr==="));
   debug_ssr (fun () -> Pp.(str"concl=" ++ Printer.pr_econstr_env env sigma concl));
   let nsigma, _ as it = interp_term env sigma ist t in
-  let sigma = Evd.merge_universe_context sigma (Evd.ustate nsigma) in
+  let sigma = Evd.merge_ustate sigma (Evd.ustate nsigma) in
   let f, _, _ucst = abs_evars env sigma it in
   let ist' = {ist with lfun =
     Id.Map.add pattern_id (Tacinterp.Value.of_constr f) Id.Map.empty } in
@@ -287,7 +287,7 @@ let unfoldintac occ rdx t (kt,_) =
       try find_T env c h ~k:(fun env c _ _ -> body env t c)
       with NoMatch when easy -> c
       | NoMatch | NoProgress -> errorstrm Pp.(str"No occurrence of "
-        ++ pr_econstr_pat env sigma0 t ++ spc() ++ str "in " ++ Printer.pr_econstr_env env sigma c)),
+        ++ pr_econstr_pat env sigma t ++ spc() ++ str "in " ++ Printer.pr_econstr_env env sigma0 c)),
     (fun () -> try ignore @@ end_T () with
       | NoMatch when easy -> ()
       | NoMatch -> anomaly "unfoldintac")
@@ -296,14 +296,14 @@ let unfoldintac occ rdx t (kt,_) =
       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)
+          | Const _ when EConstr.eq_constr_nounivs sigma0 c t -> body env c c
+          | App (f,a) when EConstr.eq_constr_nounivs sigma0 f t -> EConstr.mkApp (body env t t,a)
           | Proj _ when same_proj env sigma0 c t -> body env t c
           | _ ->
             let c = Reductionops.whd_betaiotazeta env 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)
+            | Const _ when EConstr.eq_constr_nounivs sigma0 c t -> body env c c
+            | App (f,a) when EConstr.eq_constr_nounivs sigma0 f t -> EConstr.mkApp (body env t t,a)
             | Proj _ when same_proj env 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))
@@ -407,7 +407,7 @@ let pirrel_rewrite ?(under=false) ?(map_redex=id_map_redex) pred rdx rdx_ty c_so
           let sigma, predty = Typing.type_of penv sigma pred in
           let p_sort = Retyping.get_sort_of penv sigma pred in
           sigma, predty, p_sort in
-        let (sigma, elim), _ = Equality.lookup_eq_eliminator_with_error env sigma eq ~dep:false ~inccl:true ~l2r:(Some (dir = L2R)) ~c_sort ~e_sort ~p_sort in
+        let (sigma, elim), _ = Equality.lookup_eq_eliminator_with_error env sigma eq ~dep:false ~inccl:true ~l2r:(dir = L2R) ~c_sort ~e_sort ~p_sort in
         sigma, { Environ.uj_val = mkLambda (id, rdx_ty, pred); uj_type = mkProd (id, rdx_ty, predty) } , elim
       in
       let elimT = Retyping.get_type_of env sigma elim in
@@ -447,7 +447,7 @@ let pirrel_rewrite ?(under=false) ?(map_redex=id_map_redex) pred rdx rdx_ty c_so
          let miss = 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 ->
-                 not @@ UnivGen.QualityOrSet.is_prop (Retyping.get_sort_quality_of
+                 not @@ Sorts.Quality.is_qprop (Retyping.get_sort_quality_of
                    env sigma (Evd.evar_concl (Evd.find_undefined sigma k))))
                  evs in
              if open_evs <> [] then Some name else None)
@@ -458,7 +458,7 @@ let pirrel_rewrite ?(under=false) ?(map_redex=id_map_redex) pred rdx rdx_ty c_so
   end
 
 let pf_merge_uc_of s sigma =
-  Evd.merge_universe_context sigma (Evd.ustate s)
+  Evd.merge_ustate sigma (Evd.ustate s)
 
 let rwcltac ?under ?map_redex cl rdx dir (sigma, r) =
   let open Proofview.Notations in
@@ -468,7 +468,7 @@ let rwcltac ?under ?map_redex cl rdx dir (sigma, r) =
   let concl = Proofview.Goal.concl gl in
   let sigma = resolve_typeclasses ~where:r ~fail:false env sigma in
   let r_n, evs, ucst = abs_evars env sigma0 (sigma, r) in
-  let sigma0 = Evd.set_universe_context sigma0 ucst in
+  let sigma0 = Evd.set_ustate sigma0 ucst in
   let n = List.length evs in
   let r_n' = abs_cterm env sigma0 n r_n in
   let r' = EConstr.Vars.subst_var sigma pattern_id r_n' in
@@ -676,7 +676,7 @@ let rwrxtac ?under ?map_redex occ rdx_pat dir rule =
   let concl0 = Reductionops.nf_evar sigma0 concl0 in
   let concl = eval_pattern env0 sigma0 concl0 rdx_pat occ find_R in
   let (d, (_, sigma, uc, t)), rdx = conclude concl in
-  let r = Evd.merge_universe_context sigma uc, t in
+  let r = Evd.merge_ustate sigma uc, t in
   rwcltac ?under ?map_redex concl rdx d r
   end
 
@@ -731,10 +731,10 @@ let rwargtac ?under ?map_redex ist ((dir, mult), (((oclr, occ), grx), (kind, gt)
     (* Evarmaps below are extensions of sigma, so setting the universe context is correct *)
     let sigma = match rx with
     | None -> sigma
-    | Some { pat_sigma = s } -> Evd.set_universe_context sigma (Evd.ustate s)
+    | Some { pat_sigma = s } -> Evd.set_ustate sigma (Evd.ustate s)
     in
     let t = interp env sigma gt in
-    let sigma = Evd.set_universe_context sigma  (Evd.ustate (fst t)) in
+    let sigma = Evd.set_ustate sigma  (Evd.ustate (fst t)) in
     Proofview.Unsafe.tclEVARS sigma <*>
     (match kind with
     | RWred sim -> simplintac occ rx sim
@@ -760,14 +760,16 @@ let ssrrewritetac ?under ?map_redex ist rwargs =
 (** The "unlock" tactic *)
 
 let unfoldtac occ ko t kt =
+  let open Proofview.Notations in
   Proofview.Goal.enter begin fun gl ->
   let env = Proofview.Goal.env gl in
   let sigma = Proofview.Goal.sigma gl in
   let concl = Proofview.Goal.concl gl in
   let concl = Evarutil.nf_evar sigma concl in
-  let cl, c = fill_occ_term env sigma concl occ (fst (strip_unfold_term env t kt)) in
+  let cl, sigma, c = fill_occ_term env sigma concl occ (fst (strip_unfold_term env t kt)) in
   let cl' = EConstr.Vars.subst1 (Tacred.unfoldn [OnlyOccurrences [1], get_evalref env sigma c] env sigma c) cl in
   let f = if ko = None then RedFlags.betaiotazeta else RedFlags.betaiota in
+  Proofview.Unsafe.tclEVARS sigma <*>
   convert_concl ~check:true (Reductionops.clos_norm_flags f env sigma cl')
   end
 
diff --git a/plugins/ssr/ssrfwd.ml b/plugins/ssr/ssrfwd.ml
index 9026c0f9ba77..d8204ea57364 100644
--- a/plugins/ssr/ssrfwd.ml
+++ b/plugins/ssr/ssrfwd.ml
@@ -63,7 +63,7 @@ let ssrsettac id ((_, (pat, pty)), (_, occ)) =
   let (c, ucst), cl =
     try fill_occ_pattern ~raise_NoMatch:true env sigma cl pat occ 1
     with NoMatch -> redex_of_pattern_tc env pat, cl in
-  let sigma = Evd.merge_universe_context sigma ucst in
+  let sigma = Evd.merge_ustate sigma ucst in
   if Termops.occur_existential sigma c then errorstrm(str"The pattern"++spc()++
     pr_econstr_pat env sigma c++spc()++str"did not match and has holes."++spc()++
     str"Did you mean pose?") else
diff --git a/plugins/ssr/ssrfwd.mli b/plugins/ssr/ssrfwd.mli
index dd13cc5a1ff3..82b18b657d08 100644
--- a/plugins/ssr/ssrfwd.mli
+++ b/plugins/ssr/ssrfwd.mli
@@ -25,7 +25,7 @@ val havetac : ist ->
            ((((Ssrast.ssrclear option * Ssrast.ssripat list) * Ssrast.ssripats) *
              Ssrast.ssripats) *
             (((Ssrast.ssrfwdkind * 'a) * ast_closure_term) *
-             (bool * Tacinterp.Value.t option list))) ->
+             (bool * Tacarg.tacvalue option list))) ->
            bool ->
            bool -> unit Proofview.tactic
 
@@ -44,7 +44,7 @@ val wlogtac :
     list *
     ('c *
        ast_closure_term) ->
-  Ltac_plugin.Tacinterp.Value.t Ssrast.ssrhint ->
+  Tacarg.tacvalue Ssrast.ssrhint ->
   bool ->
   [< `Gen of Names.Id.t option option | `NoGen > `NoGen ] ->
   unit Proofview.tactic
@@ -55,7 +55,7 @@ val sufftac :
      Ssrast.ssripat list) *
     (('a *
         ast_closure_term) *
-       (bool * Tacinterp.Value.t option list)) ->
+       (bool * Tacarg.tacvalue option list)) ->
   unit Proofview.tactic
 
 (* pad_intro (by default false) indicates whether the intro-pattern
@@ -67,7 +67,7 @@ val undertac :
   ?pad_intro:bool ->
   Ltac_plugin.Tacinterp.interp_sign ->
   Ssrast.ssripats option -> Ssrequality.ssrrwarg ->
-  Ltac_plugin.Tacinterp.Value.t Ssrast.ssrhint -> unit Proofview.tactic
+  Tacarg.tacvalue Ssrast.ssrhint -> unit Proofview.tactic
 
 val overtac :
   unit Proofview.tactic
diff --git a/plugins/ssr/ssripats.ml b/plugins/ssr/ssripats.ml
index 18625ad3a794..1a2aaa97c846 100644
--- a/plugins/ssr/ssripats.ml
+++ b/plugins/ssr/ssripats.ml
@@ -291,7 +291,7 @@ let intro_clear ids =
     let env = Proofview.Goal.env gl in
     let fold (used_ids, clear_ids, ren) id =
       let new_id = Ssrcommon.mk_anon_id (Id.to_string id) used_ids in
-      let used_ids = Environ.push_named_context_val (LocalAssum (annotR new_id, mkProp)) used_ids in
+      let used_ids = Environ.push_named_context_val ProofVar (LocalAssum (annotR new_id, mkProp)) used_ids in
       (used_ids, new_id :: clear_ids, (id, new_id) :: ren)
     in
     let _, clear_ids, ren = List.fold_left fold (Environ.named_context_val env, [], []) ids in
@@ -748,9 +748,9 @@ let tclLAST_GEN ~to_ind ((oclr, occ), t) conclusion = tclINDEPENDENTL begin
       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 _ ->
+      | LocalAssum _ ->
           Ssrcommon.errorstrm Pp.(str "@ can be used with let-ins only")
-      | Context.Named.Declaration.LocalDef (name, b, ty) ->
+      | LocalDef (name, b, ty) ->
           Unsafe.tclEVARS sigma <*>
           tclUNIT (true, EConstr.mkLetIn (map_annot Name.mk_name name,b,ty,cl), c, clr)
     else
@@ -760,7 +760,7 @@ let tclLAST_GEN ~to_ind ((oclr, occ), t) conclusion = tclINDEPENDENTL begin
   else
     if to_ind && occ = None then
       let p, _, ucst' = Ssrcommon.abs_evars env sigma0 (pat.pat_sigma, c) in
-      let sigma = Evd.merge_universe_context sigma ucst' in
+      let sigma = Evd.merge_ustate sigma ucst' in
       Unsafe.tclEVARS sigma <*>
       Ssrcommon.tacTYPEOF p >>= fun pty ->
       (* TODO: check bug: cl0 no lift? *)
diff --git a/plugins/ssr/ssrparser.mlg b/plugins/ssr/ssrparser.mlg
index 00a6e0f23d7e..30e70f5f6e33 100644
--- a/plugins/ssr/ssrparser.mlg
+++ b/plugins/ssr/ssrparser.mlg
@@ -41,19 +41,6 @@ open Ssrequality
 open Ssripats
 open Libobject
 
-(** Ssreflect load check. *)
-
-(* To allow ssrcoq to be fully compatible with the "plain" Rocq, 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 is_ssr_loaded = Pptactic.ssr_loaded
-
 }
 
 DECLARE PLUGIN "rocq-runtime.plugins.ssreflect"
@@ -99,7 +86,7 @@ let register_ssrtac name f prods =
   let ids = List.map_filter get_id prods in
   let tac = CAst.make (TacML (ssrtac_entry name, List.map map ids)) in
   let key = KerName.make path (Id.of_string ("ssrparser_" ^ name)) in
-  let body = Tacenv.{ alias_args = ids; alias_body = tac; alias_deprecation = None } in
+  let body = Tacenv.{ alias_args = ids; alias_body = tac; alias_deprecation = None; alias_is_ml = Some (ssrtac_entry name) } in
   let parule = {
     pptac_level = 0;
     pptac_prods = prods
@@ -158,11 +145,11 @@ let add_genarg tag pr =
   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 interp ist x = Ftactic.return x in
   let gen_pr env sigma _ _ _ = pr env sigma in
   let () = Genintern.register_intern0 wit glob in
   let () = Gensubst.register_subst0 wit subst in
-  let () = Geninterp.register_interp0 wit interp in
+  let () = Tacinterp.Register.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
@@ -1583,7 +1570,7 @@ END
 {
 
 let sq_brace_tacnames =
-   ["first"; "solve"; "do"; "rewrite"; "have"; "suffices"; "wlog"]
+   ["first"; "solve"; "do"; "rewrite"; "rw"; "have"; "suffices"; "wlog"]
    (* "by" is a keyword *)
 
 let test_ssrseqvar =
@@ -1626,31 +1613,20 @@ let ltac_expr = Pltac.ltac_expr
 
 (* Since Rocq 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.    *)
+(* 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.    *)
 
 {
 
-let { Goptions.get = ssr_reserved_ids } =
-  Goptions.declare_bool_option_and_ref ~stage:Synterp ~key:["SsrIdents"] ~value:true ()
-
 let is_ssr_reserved s =
-  let n = String.length s in n > 2 && s.[0] = '_' && s.[n - 1] = '_'
+  let n = String.length s in n > 6 && is_dll s 0 && is_dll s (n - 3)
 
 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
+  if is_ssr_reserved s then begin
+    CErrors.user_err ~loc (str ("The identifier " ^ s ^ " is reserved."))
+  end; Id.of_string s
 
 let ssr_null_entry = Procq.Entry.(of_parser "ssr_null" { parser_fun = fun _ _ -> Ok () })
 
@@ -1663,7 +1639,7 @@ END
 
 {
 
-let perm_tag = "_perm_Hyp_"
+let perm_tag = "‗perm_Hyp_"
 let _ = add_internal_name (is_tagged perm_tag)
 
 }
@@ -1740,7 +1716,6 @@ module Internal = struct
   let pr_intros = pr_intros
   let pr_view = pr_view
   let pr_mult = pr_mult
-  let is_ssr_loaded = is_ssr_loaded
   let pr_hpats = pr_hpats
   let pr_fwd = pr_fwd
   let pr_hint = pr_hint
@@ -1752,5 +1727,3 @@ module Internal = struct
 end
 
 }
-
-(* vim: set filetype=ocaml foldmethod=marker: *)
diff --git a/plugins/ssr/ssrparser.mli b/plugins/ssr/ssrparser.mli
index 8a69a80558d7..04d1096784b5 100644
--- a/plugins/ssr/ssrparser.mli
+++ b/plugins/ssr/ssrparser.mli
@@ -13,12 +13,12 @@
 open Ltac_plugin
 
 val ssrtacarg : Tacexpr.raw_tactic_expr Procq.Entry.t
-val wit_ssrtacarg : (Tacexpr.raw_tactic_expr, Tacexpr.glob_tactic_expr, Geninterp.Val.t) Genarg.genarg_type
+val wit_ssrtacarg : (Tacexpr.raw_tactic_expr, Tacexpr.glob_tactic_expr, Tacarg.tacvalue) Genarg.genarg_type
 val pr_ssrtacarg : Environ.env -> Evd.evar_map -> 'a -> 'b ->
   (Environ.env -> Evd.evar_map -> Constrexpr.entry_relative_level -> 'c) -> 'c
 
 val ssrtclarg : Tacexpr.raw_tactic_expr Procq.Entry.t
-val wit_ssrtclarg : (Tacexpr.raw_tactic_expr, Tacexpr.glob_tactic_expr, Geninterp.Val.t) Genarg.genarg_type
+val wit_ssrtclarg : (Tacexpr.raw_tactic_expr, Tacexpr.glob_tactic_expr, Tacarg.tacvalue) Genarg.genarg_type
 val pr_ssrtclarg : Environ.env -> Evd.evar_map -> 'a -> 'b ->
   (Environ.env -> Evd.evar_map -> Constrexpr.entry_relative_level -> 'c -> 'd) -> 'c -> 'd
 
@@ -31,28 +31,28 @@ open Ssrast
 
 type ssrfwdview = ast_closure_term list
 
-val wit_ssrseqarg : (Tacexpr.raw_tactic_expr ssrseqarg, Tacexpr.glob_tactic_expr ssrseqarg, Geninterp.Val.t ssrseqarg) Genarg.genarg_type
+val wit_ssrseqarg : (Tacexpr.raw_tactic_expr ssrseqarg, Tacexpr.glob_tactic_expr ssrseqarg, Tacarg.tacvalue ssrseqarg) Genarg.genarg_type
 
 val wit_ssrintros_ne : ssripats Genarg.uniform_genarg_type
 val wit_ssrintrosarg :
   (Tacexpr.raw_tactic_expr * ssripats,
    Tacexpr.glob_tactic_expr * ssripats,
-   Geninterp.Val.t * ssripats) Genarg.genarg_type
+   Tacarg.tacvalue * ssripats) Genarg.genarg_type
 
 val wit_ssripatrep : ssripat Genarg.uniform_genarg_type
 val wit_ssrclauses : clauses Genarg.uniform_genarg_type
 val wit_ssrhavefwdwbinders :
   (Tacexpr.raw_tactic_expr fwdbinders,
    Tacexpr.glob_tactic_expr fwdbinders,
-   Tacinterp.Value.t fwdbinders) Genarg.genarg_type
+   Tacarg.tacvalue fwdbinders) Genarg.genarg_type
 val wit_ssrhintarg :
   (Tacexpr.raw_tactic_expr ssrhint,
    Tacexpr.glob_tactic_expr ssrhint,
-   Tacinterp.Value.t ssrhint) Genarg.genarg_type
+   Tacarg.tacvalue ssrhint) Genarg.genarg_type
 val wit_ssrhint3arg :
   (Tacexpr.raw_tactic_expr ssrhint,
    Tacexpr.glob_tactic_expr ssrhint,
-   Tacinterp.Value.t ssrhint) Genarg.genarg_type
+   Tacarg.tacvalue ssrhint) Genarg.genarg_type
 
 val wit_ssrfwdid : Names.Id.t Genarg.uniform_genarg_type
 
@@ -62,12 +62,12 @@ val wit_ssrsetfwd :
 val wit_ssrdoarg :
   (Tacexpr.raw_tactic_expr ssrdoarg,
    Tacexpr.glob_tactic_expr ssrdoarg,
-   Tacinterp.Value.t ssrdoarg) Genarg.genarg_type
+   Tacarg.tacvalue ssrdoarg) Genarg.genarg_type
 
 val wit_ssrhint :
   (Tacexpr.raw_tactic_expr ssrhint,
    Tacexpr.glob_tactic_expr ssrhint,
-   Tacinterp.Value.t ssrhint) Genarg.genarg_type
+   Tacarg.tacvalue ssrhint) Genarg.genarg_type
 
 val ssrhpats : ssrhpats Procq.Entry.t
 val wit_ssrhpats : ssrhpats Genarg.uniform_genarg_type
@@ -79,7 +79,7 @@ val wit_ssrposefwd : (ssrfwdfmt * ast_closure_term) Genarg.uniform_genarg_type
 val wit_ssrhavefwd
   : ((ssrfwdfmt * ast_closure_term) * Tacexpr.raw_tactic_expr ssrhint
     , (ssrfwdfmt * ast_closure_term) * Tacexpr.glob_tactic_expr ssrhint
-    , (ssrfwdfmt * ast_closure_term) * Geninterp.Val.t ssrhint)
+    , (ssrfwdfmt * ast_closure_term) * Tacarg.tacvalue ssrhint)
     Genarg.genarg_type
 
 val wit_ssrrpat : ssripat Genarg.uniform_genarg_type
@@ -188,8 +188,6 @@ module Internal : sig
 
   val pr_mult : ssrmult -> Pp.t
 
-  val is_ssr_loaded : unit -> bool
-
   val pr_hpats : ssrhpats -> Pp.t
 
   val pr_fwd : (Ssrast.ssrfwdkind * Ssrast.ssrbindfmt list) * Ssrast.ast_closure_term -> Pp.t
@@ -267,13 +265,13 @@ val wit_ssrmult_ne : (int * ssrmmod) Genarg.uniform_genarg_type
 val wit_ssrortacarg :
   (Tacexpr.raw_tactic_expr ssrhint,
    bool * Ltac_plugin.Tacexpr.glob_tactic_expr option list,
-   bool * Geninterp.Val.t option list)
+   bool * Tacarg.tacvalue option list)
     Genarg.genarg_type
 
 val wit_ssrortacs :
   (Tacexpr.raw_tactic_expr option list,
    Tacexpr.glob_tactic_expr option list,
-   Geninterp.Val.t option list)
+   Tacarg.tacvalue option list)
     Genarg.genarg_type
 
 val wit_ssrsimpl_ne :
@@ -282,4 +280,4 @@ val wit_ssrsimpl_ne :
 val wit_ssrstruct : Names.Id.t option Genarg.uniform_genarg_type
 
 val wit_ssrtac3arg :
-    (Tacexpr.raw_tactic_expr, Tacexpr.glob_tactic_expr, Geninterp.Val.t) Genarg.genarg_type
+    (Tacexpr.raw_tactic_expr, Tacexpr.glob_tactic_expr, Tacarg.tacvalue) Genarg.genarg_type
diff --git a/plugins/ssr/ssrtacs.mlg b/plugins/ssr/ssrtacs.mlg
index eb63b42f655b..64e86faad268 100644
--- a/plugins/ssr/ssrtacs.mlg
+++ b/plugins/ssr/ssrtacs.mlg
@@ -740,41 +740,15 @@ let pr_ssrrwargs _ _ _ rwargs = pr_list spc pr_rwarg rwargs
 ARGUMENT EXTEND ssrrwargs TYPED AS ssrrwarg list PRINTED BY { pr_ssrrwargs }
 END
 
-{
-
-let ssr_rw_syntax = Summary.ref ~name:"SSR:rewrite" true
-
-let () =
-  Goptions.(declare_bool_option
-    { optstage = Summary.Stage.Synterp;
-      optkey   = ["SsrRewrite"];
-      optread  = (fun _ -> !ssr_rw_syntax);
-      optdepr  = None;
-      optwrite = (fun b -> ssr_rw_syntax := b) })
-
-let lbrace = Char.chr 123
-(** Workaround to a limitation of coqpp *)
-
-let test_ssr_rw_syntax =
-  let test kwstate strm =
-    if not !ssr_rw_syntax then Error () else
-    if is_ssr_loaded () then Ok () else
-    match LStream.peek_nth kwstate 0 strm with
-    | Some (Tok.KEYWORD key) when List.mem key.[0] [lbrace; '['; '/'] -> Ok ()
-    | _ -> Error () in
-  Procq.Entry.(of_parser "test_ssr_rw_syntax" { parser_fun = test })
-
-}
-
 GRAMMAR EXTEND Gram
   GLOBAL: ssrrwargs;
-  ssrrwargs: TOP [[ test_ssr_rw_syntax; a = LIST1 ssrrwarg -> { a } ]];
+  ssrrwargs: TOP [[ a = LIST1 ssrrwarg -> { a } ]];
 END
 
-(** The "rewrite" tactic *)
+(** The "rw" tactic *)
 
-TACTIC EXTEND ssrrewrite
-  | [ "rewrite" ssrrwargs(args) ssrclauses(clauses) ] ->
+TACTIC EXTEND ssrrw
+  | [ "rw" ssrrwargs(args) ssrclauses(clauses) ] ->
     { tclCLAUSES (ssrrewritetac ist args) clauses }
 END
 
@@ -1050,5 +1024,3 @@ TACTIC EXTEND under
     Ssrfwd.undertac ~pad_intro:true ist (Some [IPatAnon All]) arg h
     }
 END
-
-(* vim: set filetype=ocaml foldmethod=marker: *)
diff --git a/plugins/ssr/ssrtacs.mli b/plugins/ssr/ssrtacs.mli
index 57cd2e1b3b97..062f2c1c2d43 100644
--- a/plugins/ssr/ssrtacs.mli
+++ b/plugins/ssr/ssrtacs.mli
@@ -10,6 +10,8 @@ open Ssrparser
 
 val wit_ssrarg : ssrarg Genarg.uniform_genarg_type
 val wit_ssrrwarg : ssrrwarg Genarg.uniform_genarg_type
+val ssrrwargs : ssrrwarg list Procq.Entry.t
+val pr_ssrrwargs : 'a -> 'b -> 'c -> ssrrwarg list -> Pp.t
 val wit_ssrrwargs : ssrrwarg list Genarg.uniform_genarg_type
 
 val wit_ssrseqdir : ssrdir Genarg.uniform_genarg_type
@@ -17,7 +19,7 @@ val wit_ssrseqdir : ssrdir Genarg.uniform_genarg_type
 val wit_ssrsufffwd :
   (Tacexpr.raw_tactic_expr ffwbinders,
    Tacexpr.glob_tactic_expr ffwbinders,
-   Geninterp.Val.t ffwbinders) Genarg.genarg_type
+   Tacarg.tacvalue ffwbinders) Genarg.genarg_type
 
 val wit_ssrcasearg : (cpattern ssragens) ssrmovearg Genarg.uniform_genarg_type
 val wit_ssrmovearg : (cpattern ssragens) ssrmovearg Genarg.uniform_genarg_type
diff --git a/plugins/ssr/ssrtacticals.mli b/plugins/ssr/ssrtacticals.mli
index 0ab1980ed026..0928ee8e87b7 100644
--- a/plugins/ssr/ssrtacticals.mli
+++ b/plugins/ssr/ssrtacticals.mli
@@ -15,11 +15,11 @@ open Ssrmatching_plugin
 
 val tclSEQAT :
   Tacinterp.interp_sign ->
-  Tacinterp.Value.t ->
+  Tacarg.tacvalue ->
   Ssrast.ssrdir ->
   int Locus.or_var *
-    (('a * Tacinterp.Value.t option list) *
-       Tacinterp.Value.t option) ->
+    (('a * Tacarg.tacvalue option list) *
+       Tacarg.tacvalue option) ->
   unit Proofview.tactic
 
 val tclCLAUSES :
@@ -33,12 +33,12 @@ val tclCLAUSES :
 
 val hinttac :
            Tacinterp.interp_sign ->
-           bool -> bool * Tacinterp.Value.t option list -> unit Proofview.tactic
+           bool -> bool * Tacarg.tacvalue option list -> unit Proofview.tactic
 
 val ssrdotac :
   Tacinterp.interp_sign ->
   ((int Locus.or_var * Ssrast.ssrmmod) *
-     (bool * Tacinterp.Value.t option list)) *
+     (bool * Tacarg.tacvalue option list)) *
     ((Ssrast.ssrhyps *
         ((Ssrast.ssrhyp_or_id * string) *
            Ssrmatching.cpattern option)
diff --git a/plugins/ssr/ssrvernac.mlg b/plugins/ssr/ssrvernac.mlg
index 1df591df336e..ccd46159c1d5 100644
--- a/plugins/ssr/ssrvernac.mlg
+++ b/plugins/ssr/ssrvernac.mlg
@@ -17,7 +17,6 @@ module CoqConstr = Constr
 open CoqConstr
 open Constrexpr
 open Constrexpr_ops
-open Procq
 open Procq.Prim
 open Procq.Constr
 open Pvernac.Vernac_
@@ -47,8 +46,6 @@ IGNORE KEYWORDS
 (** Alternative notations for "match" and anonymous arguments. *)(* ************)
 
 (* Syntax:                                                        *)
-(*  if  is  then ... else ...                      *)
-(*  if  is  [in ..] return ... then ... else ...   *)
 (*  let:  :=  in ...                               *)
 (*  let:  [in ...] :=  return ... in ...           *)
 (* The scope of a top-level 'as' in the pattern extends over the  *)
@@ -76,7 +73,6 @@ let aliasvar = function
 let mk_cnotype mp = aliasvar mp, None
 let mk_ctype mp t = aliasvar mp, Some t
 let mk_rtype t = Some t
-let mk_dthen ?loc (mp, ct, rt) c = (CAst.make ?loc (mp, c)), ct, rt
 let mk_let ?loc rt ct mp c1 =
   CAst.make ?loc @@ CCases (LetPatternStyle, rt, ct, [CAst.make ?loc (mp, c1)])
 let mk_pat c (na, t) = (c, na, t)
@@ -84,28 +80,11 @@ let mk_pat c (na, t) = (c, na, t)
 }
 
 GRAMMAR EXTEND Gram
-  GLOBAL: binder_constr;
+  GLOBAL: term;
   ssr_rtype: [[ "return"; t = term 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 dp c } ]];
-  ssr_elsepat: [[ "else" -> { [[CAst.make ~loc @@ CPatAtom None]] } ]];
-  ssr_else: [[ mp = ssr_elsepat; c = lconstr -> { CAst.make ~loc (mp, c) } ]];
-  binder_constr: TOP [
-    [ "if"; c = term LEVEL "200"; "is"; db1 = ssr_dthen; b2 = ssr_else ->
-      { let b1, ct, rt = db1 in CAst.make ~loc @@ CCases (MatchStyle, rt, [mk_pat c ct], [b1; b2]) }
-    | "if"; c = term 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 @@ CCases (MatchStyle, rt, [mk_pat c ct], [b1; b2]) }
-    | "let"; ":"; mp = ssr_mpat; ":="; c = lconstr; "in"; c1 = lconstr ->
+  term: LEVEL "10" [
+    [ "let"; ":"; mp = ssr_mpat; ":="; c = lconstr; "in"; c1 = lconstr ->
       { mk_let ~loc no_rt [mk_pat c no_ct] mp c1 }
     | "let"; ":"; mp = ssr_mpat; ":="; c = lconstr;
       rt = ssr_rtype; "in"; c1 = lconstr ->
@@ -116,14 +95,6 @@ GRAMMAR EXTEND Gram
   ] ];
 END
 
-GRAMMAR EXTEND Gram
-  GLOBAL: closed_binder;
-  closed_binder: TOP [
-    [ ["of" -> { () } | "&" -> { () } ]; c = term LEVEL "99" ->
-      { [CLocalAssum ([CAst.make ~loc Anonymous], None, Default Explicit, c)] }
-  ] ];
-END
-
 (** Vernacular commands: Prenex Implicits *)
 
 (* This should really be implemented as an extension to the implicit   *)
@@ -299,59 +270,3 @@ VERNAC COMMAND EXTEND HintView CLASSIFIED AS SIDEFF
        | Some k ->
           Ssrview.AdaptorDb.declare k hints }
 END
-
-(** Search compatibility *)
-
-{
-
-open G_vernac
-}
-
-GRAMMAR EXTEND Gram
-  GLOBAL: query_command;
-
-  query_command: TOP
-    [ [ IDENT "Search"; s = search_query; l = search_queries; "." ->
-          { let (sl,m) = l in
-            fun g ->
-              Vernacexpr.VernacSearch (Vernacexpr.Search (s::sl),g, m) }
-      ] ]
-;
-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 Rocq. We patch this here by     *)
-(* adding new parsing rules that recognize the new keywords.           *)
-(*   To make matters worse, the Rocq 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
-
-}
-
-GRAMMAR EXTEND Gram
-  GLOBAL: hypident;
-  hypident: TOP [
-  [ "("; IDENT "type"; "of"; id = Prim.identref; ")" -> { id, Locus.InHypTypeOnly }
-  | "("; IDENT "value"; "of"; id = Prim.identref; ")" -> { id, Locus.InHypValueOnly }
-  ] ];
-END
-
-GRAMMAR EXTEND Gram
-  GLOBAL: constr_eval;
-  constr_eval: TOP [
-    [ IDENT "type"; "of"; c = Constr.constr -> { Tacexpr.ConstrTypeOf c }]
-  ];
-END
-
-(* vim: set filetype=ocaml foldmethod=marker: *)
diff --git a/plugins/ssr/ssrview.ml b/plugins/ssr/ssrview.ml
index f0c0cf1fce16..7dbf4f3ef8cf 100644
--- a/plugins/ssr/ssrview.ml
+++ b/plugins/ssr/ssrview.ml
@@ -170,21 +170,24 @@ let is_tac_in_term ?extra_scope { annotation; body; glob_env; interp_env } =
     in
     (* We unravel notations *)
     let g = intern_constr_expr ist sigma body in
+    let default = tclUNIT (`Term (annotation, interp_env, g)) in
     match DAst.get g with
-    | Glob_term.GGenarg x
-      when Genarg.has_type x (Genarg.glbwit Tacarg.wit_ltac_in_term)
-      ->
-      let _, tac = Genarg.out_gen (Genarg.glbwit Tacarg.wit_ltac_in_term) x in
-      tclUNIT (`Tac tac)
-    | _ -> tclUNIT (`Term (annotation, interp_env, g))
+    | Glob_term.GGenarg (Glb (tag, v)) ->
+      begin match GenConstr.eq tag Tacarg.wit_ltac_in_term with
+      | None -> default
+      | Some Refl ->
+        let (_used_ntn_vars, v): Id.Set.t * Tacexpr.glob_tactic_expr = v in
+        tclUNIT (`Tac v)
+      end
+    | _ -> default
 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
+    ist with Tacinterp.lfun =
+      Id.Map.add fresh_id (Taccoerce.Value.of_constr p) ist.Tacinterp.lfun} in
   tclUNIT (ist,Glob_term.GVar fresh_id)
 
 let mkGHole =
diff --git a/plugins/ssrmatching/dune b/plugins/ssrmatching/dune
index f4d547b9b036..9db7fadd14bb 100644
--- a/plugins/ssrmatching/dune
+++ b/plugins/ssrmatching/dune
@@ -4,10 +4,6 @@
  (synopsis "Rocq ssrmatching plugin")
  (libraries rocq-runtime.plugins.ltac))
 
-(deprecated_library_name
- (old_public_name coq-core.plugins.ssrmatching)
- (new_public_name rocq-runtime.plugins.ssrmatching))
-
 (rule
  (targets g_ssrmatching.ml)
  (deps (:mlg g_ssrmatching.mlg))
diff --git a/plugins/ssrmatching/ssrmatching.ml b/plugins/ssrmatching/ssrmatching.ml
index 4f06465d2ca4..115960f31834 100644
--- a/plugins/ssrmatching/ssrmatching.ml
+++ b/plugins/ssrmatching/ssrmatching.ml
@@ -98,11 +98,11 @@ let add_genarg tag pr =
   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 interp ist x = Ftactic.return x in
   let gen_pr env sigma _ _ _ = pr env sigma in
   let () = Genintern.register_intern0 wit glob in
   let () = Gensubst.register_subst0 wit subst in
-  let () = Geninterp.register_interp0 wit interp in
+  let () = Tacinterp.Register.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
@@ -160,12 +160,18 @@ exception NoProgress
 
 let unif_EQ env sigma p c =
   let env = Environ.set_universes (Evd.universes sigma) env in
-  Reductionops.is_conv env sigma p c
+  Reductionops.infer_conv env sigma p c
+
+let unif_EQ_ref env ise p c =
+  match unif_EQ env !ise p c with
+  | None -> false
+  | Some ise' -> ise := ise'; true
 
 let unif_EQ_args env sigma pa a =
   let n = Array.length pa in
-  let rec loop i = (i = n) || unif_EQ env sigma pa.(i) a.(i) && loop (i + 1) in
-  loop 0
+  let ise = ref sigma in
+  let rec loop i = (i = n) || unif_EQ_ref env ise pa.(i) a.(i) && loop (i + 1) in
+  if loop 0 then Some !ise else None
 
 let unif_HO env ise p c =
   try Evarconv.unify_delay env ise p c
@@ -343,7 +349,7 @@ let unif_end ?(solve_TC=true) env sigma0 ise0 pt ok =
   let c, s, uc, t = nf_open_term sigma0 ise pt in
   let ise1 = create_evar_defs s in
   let ise1 = Evd.set_typeclass_evars ise1 (Evar.Set.filter (fun ev -> Evd.is_undefined ise1 ev) tcs) in
-  let ise1 = Evd.set_universe_context ise1 uc in
+  let ise1 = Evd.set_ustate ise1 uc in
   let ise2 =
     if solve_TC then Typeclasses.resolve_typeclasses ~fail:true env ise1
     else ise1 in
@@ -356,7 +362,7 @@ let unif_end ?(solve_TC=true) env sigma0 ise0 pt ok =
 let unify_HO env sigma0 t1 t2 =
   let sigma = unif_HO env sigma0 t1 t2 in
   let _, sigma, uc, _ = unif_end ~solve_TC:false env sigma0 sigma t2 (fun _ -> true) in
-  Evd.set_universe_context sigma uc
+  Evd.set_ustate sigma uc
 
 (* This is what the definition of iter_constr should be... *)
 let iter_constr_LR sigma f c = match EConstr.kind sigma c with
@@ -447,7 +453,7 @@ let pr_econstr_pat env sigma c0 =
     let dummy_prod = mkProd (make_annot Anonymous Sorts.Relevant,mkProp,mkProp) in
     let na = make_annot (EConstr.destVar sigma ehole_var) Sorts.Relevant in
     Context.Named.Declaration.(LocalAssum (na, dummy_prod)) in
-  let env = Environ.push_named dummy_decl env in
+  let env = Environ.push_named ProofVar dummy_decl env in
   pr_econstr_env env sigma (wipe_evar c0)
 
 (* Turn (new) evars into metas *)
@@ -696,7 +702,9 @@ let match_upats_HO ~on_instance upats env sigma0 ise c =
         begin if !i0 < np then i0 := np; true end in
       if skip then () else try
         let ise' = match u.up_k with
-        | KpatFixed | KpatConst -> ise
+        | KpatFixed -> ise
+        | KpatConst -> (* Ensure universe instances are unified *)
+          unif_HO env ise u.up_f f
         | KpatEvar _ ->
           let open EConstr in
           let pka = Evd.expand_existential ise @@ destEvar ise u.up_f in
@@ -804,6 +812,13 @@ let subst_occ { nocc; max_occ; occ_set; use_occ; skip_occ } =
   if !nocc = max_occ then skip_occ := use_occ;
   if !nocc <= max_occ then occ_set.(!nocc - 1) else not use_occ
 
+let match_constr_universes env sigma x y =
+  match EConstr.eq_constr_universes env sigma x y with
+  | None -> None
+  | Some pbs ->
+      try Some (Evd.add_constraints sigma pbs)
+      with UGraph.UniverseInconsistency _ | Evd.UniversesDiffer | QGraph.EliminationError _ -> None
+
 let match_EQ env sigma (ise, u) =
   let open EConstr in
   match u.up_k with
@@ -812,14 +827,17 @@ let match_EQ env sigma (ise, u) =
     let env' =
       EConstr.push_rel (Context.Rel.Declaration.LocalAssum(x, t)) env in
     let match_let f = match EConstr.kind ise f with
-    | LetIn (_, v, _, b) -> unif_EQ env sigma pv v && unif_EQ env' sigma pb b
-    | _ -> false in match_let
-  | KpatFixed -> fun c -> EConstr.eq_constr_nounivs sigma u.up_f c
-  | KpatConst -> fun c -> EConstr.eq_constr_nounivs sigma u.up_f c
+    | LetIn (_, v, _, b) ->
+      begin match unif_EQ env sigma pv v with
+      | Some sigma' -> unif_EQ env' sigma' pb b
+      | None -> None end
+    | _ -> None in match_let
+  | KpatFixed -> fun c -> match_constr_universes env sigma u.up_f c
+  | KpatConst -> fun c -> match_constr_universes env sigma u.up_f c
   | KpatLam -> fun c ->
       (match EConstr.kind sigma c with
       | Lambda _ -> unif_EQ env sigma u.up_f c
-      | _ -> false)
+      | _ -> None)
   | _ -> unif_EQ env sigma u.up_f
 
 let p2t p = EConstr.mkApp(p.up_f,p.up_a)
@@ -899,18 +917,26 @@ let find_tpattern ~disable_FO ~raise_NoMatch ~instances ~upat_that_matched ~upat
     | NoProgress when (not raise_NoMatch) ->
       ssrfail env ise upats_origin upats SsrProgressFail
     | NoProgress -> raise NoMatch);
-  let _, sigma, _, ({up_f = pf; up_a = pa} as u) = match instances with
+  let expl, sigma, uc, ({up_f = pf; up_a = pa} as u) = match instances with
   | Some _ -> assert_done_multires upat_that_matched
   | None -> List.hd (pi3(assert_done upat_that_matched))
   in
 (*   pp(lazy(str"sigma@tmatch=" ++ pr_evar_map None sigma)); *)
   if !(occ_state.skip_occ) then ((*ignore(k env u.up_t 0);*) c) else
-  let match_EQ = match_EQ env sigma (ise, u) in
+  let evd = ref (Evd.set_ustate sigma uc) in
+  let match_EQ f = match_EQ env !evd (ise, u) f in
   let pn = Array.length pa in
   let rec subst_loop (env,h as acc) c' =
     if !(occ_state.skip_occ) then c' else
     let f, a = splay_app sigma c' in
-    if Array.length a >= pn && match_EQ f && unif_EQ_args env sigma pa a then
+    let test () = match match_EQ f with
+      | Some sigma ->
+        (match unif_EQ_args env sigma pa a with
+         | Some sigma -> evd := sigma; true
+         | None -> false)
+      | None -> false
+    in
+    if Array.length a >= pn && test () then
       let open EConstr in
       let a1, a2 = Array.chop (Array.length pa) a in
       let fa1 = mkApp (f, a1) in
@@ -929,7 +955,12 @@ let find_tpattern ~disable_FO ~raise_NoMatch ~instances ~upat_that_matched ~upat
       let self acc c = subst_loop acc c in
       let f' = map_constr_with_binders_left_to_right env sigma inc_h self acc f in
       mkApp (f', Array.map_left (subst_loop acc) a) in
-      subst_loop (env,h) c
+  let c' = subst_loop (env,h) c in
+  let () = (* Fixup !upat_that_matched to record universe unifications for followup EQ matches in later occurrences of a pattern *)
+    match !upat_that_matched with
+    | Some (env, n, _ :: tl) -> upat_that_matched := Some (env, n, (expl, sigma, Evd.ustate !evd, u) :: tl)
+    | _ -> assert false
+  in c'
 
 let conclude_tpattern ~raise_NoMatch ~upat_that_matched ~upats_origin ~upats { max_occ; nocc } : conclude = fun () ->
   let env, (c, sigma, uc, ({up_f = pf; up_a = pa} as u)) =
@@ -1004,7 +1035,7 @@ let pp_pattern env { pat_sigma = sigma; pat_pat = p } =
 type cpattern =
   { kind : ssrtermkind
   ; pattern : Genintern.glob_constr_and_expr
-  ; interpretation : Geninterp.interp_sign option }
+  ; interpretation : Tacinterp.interp_sign option }
 
 let pr_term {kind; pattern; _} =
   let env = Global.env () in
@@ -1166,6 +1197,8 @@ let thin id sigma goal =
   let cl = Evd.evar_concl evi in
   let relevance = Evd.evar_relevance evi in
   let ans =
+    (* Why can this get called with an unknown id? *)
+    if not @@ Environ.mem_named id env then Some (sigma, Environ.named_context_val env, cl) else
     try Some (Evarutil.clear_hyps_in_evi env sigma (Environ.named_context_val env) cl ids)
     with Evarutil.ClearDependencyError _ -> None
   in
@@ -1461,7 +1494,7 @@ let fill_rel_occ_pattern env sigma cl pat occ =
     try fill_occ_pattern ~raise_NoMatch:true env sigma cl pat occ 1
     with NoMatch -> redex_of_pattern_nf env pat, cl
   in
-  let sigma = Evd.merge_universe_context sigma us in
+  let sigma = Evd.merge_ustate sigma us in
   sigma, e, cl
 
 (* clenup interface for external use *)
@@ -1483,12 +1516,12 @@ let fill_occ_term env sigma0 cl occ (sigma, t) =
   try
     let changed, sigma', uc, t', cl, _= pf_fill_occ env cl occ sigma0 t (sigma, t) 1 in
     if changed then CErrors.user_err Pp.(str "matching impacts evars")
-    else cl, t'
+    else cl, Evd.set_ustate sigma' uc, t'
   with NoMatch -> try
       let changed, sigma', uc, t' =
         unif_end env sigma0 (create_evar_defs sigma) t (fun _ -> true) in
       if changed then raise NoMatch
-      else cl, t'
+      else cl, Evd.set_ustate sigma' uc, t'
     with e when CErrors.noncritical e ->
       errorstrm (str "partial term " ++ pr_econstr_pat env sigma t
                  ++ str " does not match any subterm of the goal")
@@ -1497,7 +1530,7 @@ let cpattern_of_id id =
   { kind= NoFlag
   ; pattern = DAst.make @@ GRef (GlobRef.VarRef  id, None), None
   ; interpretation =
-      Some Geninterp.({ lfun = Id.Map.empty;
+      Some Tacinterp.({ lfun = Id.Map.empty;
                         poly = PolyFlags.default;
                         extra = Tacinterp.TacStore.empty })}
 
@@ -1521,7 +1554,7 @@ let ssrpatterntac arg =
   let pat = interp_rpattern env sigma0 arg in
   let (t, uc), concl_x =
     fill_occ_pattern env sigma0 concl0 pat noindex 1 in
-  let sigma = Evd.set_universe_context sigma0 uc in
+  let sigma = Evd.set_ustate sigma0 uc in
   let sigma, tty = Typing.type_of env sigma t in
   let concl = EConstr.mkLetIn (make_annot (Name (Id.of_string "selected")) EConstr.ERelevance.relevant, t, tty, concl_x) in
   Proofview.Unsafe.tclEVARS sigma <*>
diff --git a/plugins/ssrmatching/ssrmatching.mli b/plugins/ssrmatching/ssrmatching.mli
index 447b3ed93b42..742c9d53e741 100644
--- a/plugins/ssrmatching/ssrmatching.mli
+++ b/plugins/ssrmatching/ssrmatching.mli
@@ -14,6 +14,7 @@ open Environ
 open Evd
 open Constr
 open Genintern
+open Ltac_plugin.Tacinterp
 
 (** ******** Small Scale Reflection pattern matching facilities ************* *)
 
@@ -26,7 +27,7 @@ type ssrtermkind = | InParens | WithAt | NoFlag | Cpattern
 type cpattern =
   { kind : ssrtermkind
   ; pattern : Genintern.glob_constr_and_expr
-  ; interpretation : Geninterp.interp_sign option }
+  ; interpretation : interp_sign option }
 val pr_cpattern : cpattern -> Pp.t
 
 (** Pattern interpretation and matching *)
@@ -75,7 +76,7 @@ val interp_rpattern :
     [ty] is an optional type for the redex of [cpat] *)
 val interp_cpattern :
   Environ.env -> Evd.evar_map ->
-  cpattern -> (glob_constr_and_expr * Geninterp.interp_sign) option ->
+  cpattern -> (glob_constr_and_expr * interp_sign) option ->
     pattern
 
 (** The set of occurrences to be matched. The boolean is set to true
@@ -209,7 +210,7 @@ val mk_tpattern_matcher :
  * [concl] where [occ] occurrences of [t] have been replaced
  * by [Rel 1] and the instance of [t] *)
 
-val fill_occ_term : Environ.env -> Evd.evar_map -> EConstr.t -> occ -> evar_map * EConstr.t -> EConstr.t * EConstr.t
+val fill_occ_term : Environ.env -> Evd.evar_map -> EConstr.t -> occ -> evar_map * EConstr.t -> EConstr.t * Evd.evar_map * EConstr.t
 
 (** Helpers to make stateful closures. Example: a [find_P] function may be
     called many times, but the pattern instantiation phase is performed only the
@@ -251,15 +252,15 @@ sig
   val wit_rpatternty : (rpattern, rpattern, rpattern) Genarg.genarg_type
   val glob_rpattern : Genintern.glob_sign -> rpattern -> rpattern
   val subst_rpattern : Mod_subst.substitution -> rpattern -> rpattern
-  val interp_rpattern : Geninterp.interp_sign -> env -> evar_map -> rpattern -> rpattern
+  val interp_rpattern : interp_sign -> env -> evar_map -> rpattern -> rpattern
   val pr_rpattern : rpattern -> Pp.t
   val mk_rpattern : (cpattern * cpattern, cpattern) ssrpattern -> rpattern
-  val mk_lterm : Constrexpr.constr_expr -> Geninterp.interp_sign option -> cpattern
-  val mk_term : ssrtermkind -> Constrexpr.constr_expr -> Geninterp.interp_sign option -> cpattern
+  val mk_lterm : Constrexpr.constr_expr -> interp_sign option -> cpattern
+  val mk_term : ssrtermkind -> Constrexpr.constr_expr -> interp_sign option -> cpattern
 
   val glob_cpattern : Genintern.glob_sign -> cpattern -> cpattern
   val subst_ssrterm : Mod_subst.substitution -> cpattern -> cpattern
-  val interp_ssrterm : Geninterp.interp_sign -> env -> evar_map -> cpattern -> cpattern
+  val interp_ssrterm : interp_sign -> env -> evar_map -> cpattern -> cpattern
   val pr_ssrterm : cpattern -> Pp.t
 end
 
diff --git a/plugins/ssrrewrite/dune b/plugins/ssrrewrite/dune
new file mode 100644
index 000000000000..55f94c46ba44
--- /dev/null
+++ b/plugins/ssrrewrite/dune
@@ -0,0 +1,11 @@
+(library
+ (name ssreflect_rewrite_plugin)
+ (public_name rocq-runtime.plugins.ssreflect_rewrite)
+ (synopsis "Rocq's ssreflect plugin for rewrite compatibility")
+ (flags :standard -open Gramlib)
+ (libraries rocq-runtime.plugins.ssrmatching rocq-runtime.plugins.ssreflect))
+
+(rule
+ (targets ssrrewrite.ml)
+ (deps (:mlg ssrrewrite.mlg))
+ (action (chdir %{project_root} (run rocq pp-mlg %{deps}))))
diff --git a/plugins/ssrrewrite/ssrrewrite.mlg b/plugins/ssrrewrite/ssrrewrite.mlg
new file mode 100644
index 000000000000..c50cf3fe7dfd
--- /dev/null
+++ b/plugins/ssrrewrite/ssrrewrite.mlg
@@ -0,0 +1,140 @@
+(************************************************************************)
+(*         *      The Rocq Prover / The Rocq Development Team           *)
+(*  v      *         Copyright INRIA, CNRS and contributors             *)
+(*  [Quickfix.make ~loc (Pp.str "rw")])
+    (fun () -> Pp.str "The 'rewrite' tactic has been renamed 'rw'.")
+
+let warn_deprecated_rewrite ?loc () =
+  (* 7 = length "rewrite" *)
+  let loc = Option.map (fun l -> Loc.sub l 0 7) loc in
+  warn_deprecated_rewrite ?loc ()
+
+}
+
+DECLARE PLUGIN "rocq-runtime.plugins.ssreflect_rewrite"
+
+(* 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.                             *)
+IGNORE KEYWORDS
+
+(* type ssrrwargs = ssrrwarg list *)
+
+ARGUMENT EXTEND ssrrewriteargs TYPED AS ssrrwarg list PRINTED BY { pr_ssrrwargs }
+END
+
+{
+
+let ssr_rewrite_syntax = Summary.ref ~name:"SSR:rewrite" true
+
+let () =
+  Goptions.(declare_bool_option
+    { optstage = Summary.Stage.Synterp;
+      optkey   = ["SsrRewrite"];
+      optread  = (fun _ -> !ssr_rewrite_syntax);
+      optdepr  = None;
+      optwrite = (fun b -> ssr_rewrite_syntax := b) })
+
+let lbrace = Char.chr 123
+(** Workaround to a limitation of coqpp *)
+
+let test_ssr_rewrite_syntax =
+  let test kwstate strm =
+    if not !ssr_rewrite_syntax then Error () else
+    if Pptactic.ssr_rewrite_loaded () then Ok () else
+    match LStream.peek_nth kwstate 0 strm with
+    | Some (Tok.KEYWORD key) when List.mem key.[0] [lbrace; '['; '/'] -> Ok ()
+    | _ -> Error () in
+  Procq.Entry.(of_parser "test_ssr_rewrite_syntax" { parser_fun = test })
+
+}
+
+GRAMMAR EXTEND Gram
+  GLOBAL: ssrrewriteargs;
+  ssrrewriteargs: TOP [[ test_ssr_rewrite_syntax; a = ssrrwargs -> { a } ]];
+END
+
+(** The "rewrite" tactic *)
+
+TACTIC EXTEND ssrrewrite WARN { warn_deprecated_rewrite }
+  | [ "rewrite" ssrrewriteargs(args) ssrclauses(clauses) ] ->
+    { tclCLAUSES (ssrrewritetac ist args) clauses }
+END
+
+{
+
+(* global syntactic changes and vernacular commands *)
+
+(** Alternative notations for "match" and anonymous arguments. *)(* ************)
+
+(* Syntax:                                                        *)
+(*  if  is  then ... else ...                      *)
+(*  if  is  [in ..] return ... then ... else ...   *)
+(* The scope of a top-level 'as' in the pattern extends over the  *)
+(* 'return' type (dependent if/let).                              *)
+(* in b       (*^--ALTERNATIVE INNER LET--------^ *)              *)
+
+(* Caveat : There is no pretty-printing support, since this would *)
+(* require a modification to the Rocq 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
+let aliasvar = function
+  | [[{ CAst.v = CPatAlias (_, na); loc }]] -> Some na
+  | _ -> None
+let mk_cnotype mp = aliasvar mp, None
+let mk_ctype mp t = aliasvar mp, Some t
+let mk_rtype t = Some t
+let mk_dthen ?loc (mp, ct, rt) c = (CAst.make ?loc (mp, c)), ct, rt
+let mk_pat c (na, t) = (c, na, t)
+
+}
+
+GRAMMAR EXTEND Gram
+  GLOBAL: term;
+  ssr_rtype: [[ "return"; t = term 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 dp c } ]];
+  ssr_elsepat: [[ "else" -> { [[CAst.make ~loc @@ CPatAtom None]] } ]];
+  ssr_else: [[ mp = ssr_elsepat; c = lconstr -> { CAst.make ~loc (mp, c) } ]];
+  term: LEVEL "10" [
+    [ "if"; c = term LEVEL "200"; "is"; db1 = ssr_dthen; b2 = ssr_else ->
+      { let b1, ct, rt = db1 in CAst.make ~loc @@ CCases (MatchStyle, rt, [mk_pat c ct], [b1; b2]) }
+    | "if"; c = term 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 @@ CCases (MatchStyle, rt, [mk_pat c ct], [b1; b2]) }
+  ] ];
+END
diff --git a/plugins/ssrrewrite/ssrrewrite.mli b/plugins/ssrrewrite/ssrrewrite.mli
new file mode 100644
index 000000000000..e69de29bb2d1
diff --git a/plugins/syntax/dune b/plugins/syntax/dune
index 333b0f6ad992..155b2e87127e 100644
--- a/plugins/syntax/dune
+++ b/plugins/syntax/dune
@@ -5,10 +5,6 @@
  (modules g_number_string number_string)
  (libraries rocq-runtime.vernac))
 
-(deprecated_library_name
- (old_public_name coq-core.plugins.number_string_notation)
- (new_public_name rocq-runtime.plugins.number_string_notation))
-
 (rule
  (targets g_number_string.ml)
  (deps (:mlg g_number_string.mlg))
diff --git a/plugins/syntax/number_string.ml b/plugins/syntax/number_string.ml
index 5acdb03981c7..aed1bafe26e7 100644
--- a/plugins/syntax/number_string.ml
+++ b/plugins/syntax/number_string.ml
@@ -16,8 +16,8 @@ open Glob_term
 open Notation
 open PrimNotations
 
-module CSet = CSet.Make (Constr)
-module CMap = CMap.Make (Constr)
+module CSet = CSet.Make (Termops.ConstrData)
+module CMap = CMap.Make (Termops.ConstrData)
 
 let mkRef env sigma g =
   let sigma, c = Evd.fresh_global env sigma g in
diff --git a/pretyping/cases.ml b/pretyping/cases.ml
index 57a3f09f4862..cf314eaa01f5 100644
--- a/pretyping/cases.ml
+++ b/pretyping/cases.ml
@@ -504,11 +504,10 @@ let remove_current_pattern eqn =
     | [] -> anomaly (Pp.str "Empty list of patterns.")
 
 let push_current_pattern ~program_mode sigma (cur,ty) eqn =
-  let hypnaming = VarSet.variables (Global.env ()) in
   match eqn.patterns with
     | pat::pats ->
         let r = ERelevance.relevant in (* TODO relevance *)
-        let _,rhs_env = push_rel ~hypnaming sigma (LocalDef (make_annot (alias_of_pat pat) r,cur,ty)) eqn.rhs.rhs_env in
+        let _,rhs_env = push_rel sigma (LocalDef (make_annot (alias_of_pat pat) r,cur,ty)) eqn.rhs.rhs_env in
         { eqn with
             rhs = { eqn.rhs with rhs_env = rhs_env };
             patterns = pats }
@@ -860,9 +859,9 @@ let recover_and_adjust_alias_names (_,avoid) names sign =
   in
   List.split (aux (names,sign))
 
-let push_rels_eqn ~hypnaming sigma sign eqn =
+let push_rels_eqn sigma sign eqn =
   {eqn with
-     rhs = {eqn.rhs with rhs_env = snd (push_rel_context ~hypnaming sigma sign eqn.rhs.rhs_env) } }
+     rhs = {eqn.rhs with rhs_env = snd (push_rel_context sigma sign eqn.rhs.rhs_env) } }
 
 let push_rels_eqn_with_names sigma sign eqn =
   let subpats = List.rev (List.firstn (List.length sign) eqn.patterns) in
@@ -870,12 +869,12 @@ let push_rels_eqn_with_names sigma sign eqn =
   let sign = recover_initial_subpattern_names subpatnames sign in
   push_rels_eqn sigma sign eqn
 
-let push_generalized_decl_eqn ~hypnaming env sigma n decl eqn =
+let push_generalized_decl_eqn env sigma n decl eqn =
   match RelDecl.get_name decl with
   | Anonymous ->
-      push_rels_eqn ~hypnaming sigma [decl] eqn
+      push_rels_eqn sigma [decl] eqn
   | Name _ ->
-      push_rels_eqn ~hypnaming sigma [RelDecl.set_name (RelDecl.get_name (Environ.lookup_rel n !!(eqn.rhs.rhs_env))) decl] eqn
+      push_rels_eqn sigma [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 }
@@ -1356,8 +1355,7 @@ let build_branch ~program_mode initial current realargs deps (realnames,curname)
   let typs' =
     List.map_i (fun i d -> (mkRel i, map_constr (lift i) d)) 1 typs in
 
-  let hypnaming = VarSet.variables (Global.env ()) in
-  let typs,extenv = push_rel_context ~hypnaming sigma typs pb.env in
+  let typs,extenv = push_rel_context sigma typs pb.env in
 
   let typs' =
     List.map (fun (c,d) ->
@@ -1436,7 +1434,7 @@ let build_branch ~program_mode initial current realargs deps (realnames,curname)
       tomatch = tomatch;
       pred = pred;
       history = history;
-      mat = List.map (push_rels_eqn_with_names ~hypnaming sigma typs) submat }
+      mat = List.map (push_rels_eqn_with_names sigma typs) submat }
 
 (**********************************************************************
  INVARIANT:
@@ -1452,7 +1450,6 @@ let build_branch ~program_mode initial current realargs deps (realnames,curname)
 (**********************************************************************)
 (* Main compiling descent *)
 let compile ~program_mode sigma pb =
-  let hypnaming = VarSet.variables (Global.env ()) in
   let rec compile sigma pb =
     match pb.tomatch with
       | Pushed cur :: rest -> match_current sigma { pb with tomatch = rest } cur
@@ -1519,7 +1516,7 @@ let compile ~program_mode sigma pb =
     let env = Name.fold_left (fun env id -> hide_variable env id) pb.env na in
     let pb =
       { pb with
-         env = snd (push_rel ~hypnaming sigma (LocalDef (annotR na,current,ty)) env);
+         env = snd (push_rel sigma (LocalDef (annotR na,current,ty)) env);
          tomatch = tomatch;
          pred = lift_predicate 1 pred tomatch;
          history = pop_history pb.history;
@@ -1556,9 +1553,9 @@ let compile ~program_mode sigma pb =
   and compile_generalization sigma pb i d rest =
     let pb =
       { pb with
-         env = snd (push_rel ~hypnaming sigma d pb.env);
+         env = snd (push_rel sigma d pb.env);
          tomatch = rest;
-         mat = List.map (push_generalized_decl_eqn ~hypnaming pb.env sigma i d) pb.mat } in
+         mat = List.map (push_generalized_decl_eqn pb.env sigma i d) pb.mat } in
     let used, sigma, j = compile sigma pb in
     used, sigma, { uj_val = mkLambda_or_LetIn d j.uj_val;
       uj_type = mkProd_wo_LetIn d j.uj_type }
@@ -1572,11 +1569,11 @@ let compile ~program_mode sigma pb =
       let alias = LocalDef (make_annot na r,c,t) in
       let pb =
         { pb with
-           env = snd (push_rel ~hypnaming sigma alias pb.env);
+           env = snd (push_rel sigma alias pb.env);
            tomatch = lift_tomatch_stack 1 rest;
            pred = lift_predicate 1 pb.pred pb.tomatch;
            history = pop_history_pattern pb.history;
-           mat = List.map (push_alias_eqn ~hypnaming sigma alias) pb.mat } in
+           mat = List.map (push_alias_eqn sigma alias) pb.mat } in
       let used, sigma, j = compile sigma pb in
       used, sigma, { uj_val =
           if isRel sigma c || isVar sigma c || count_occurrences sigma (mkRel 1) j.uj_val <= 1 then
@@ -1718,8 +1715,7 @@ let adjust_to_extended_env_and_remove_deps env extenv sigma subst t =
   (subst0, t0)
 
 let push_binder sigma d (k,env,subst) =
-  let hypnaming = VarSet.variables (Global.env ()) in
-  (k+1,snd (push_rel ~hypnaming sigma d env),List.map (fun (na,u,d) -> (na,lift 1 u,d)) subst)
+  (k+1,snd (push_rel sigma d env),List.map (fun (na,u,d) -> (na,lift 1 u,d)) subst)
 
 let rec list_assoc_in_triple x = function
     [] -> raise Not_found
@@ -1842,7 +1838,6 @@ let build_tycon ?loc env tycon_env s subst tycon extenv sigma t =
  *)
 
 let build_inversion_problem ~program_mode loc env sigma tms t =
-  let hypnaming = VarSet.variables (Global.env ()) in
   let make_patvar t (subst,avoid) =
     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
@@ -1867,14 +1862,14 @@ let build_inversion_problem ~program_mode loc env sigma tms t =
         let patl = pat :: List.rev patl in
         let patl,sign = recover_and_adjust_alias_names acc patl sign in
         let p = List.length patl in
-        let _,env' = push_rel_context ~hypnaming sigma sign env in
+        let _,env' = push_rel_context sigma sign env in
         let patl',acc_sign,acc = aux (n+p) env' (sign@acc_sign) tms acc in
         List.rev_append patl patl',acc_sign,acc
     | (t, NotInd (bo,typ)) :: tms ->
       let pat,acc = make_patvar t acc in
       let typ = lift n typ in
       let d = LocalAssum (annotR (alias_of_pat pat),typ) in
-      let patl,acc_sign,acc = aux (n+1) (snd (push_rel ~hypnaming sigma d env)) (d::acc_sign) tms acc in
+      let patl,acc_sign,acc = aux (n+1) (snd (push_rel sigma d env)) (d::acc_sign) tms acc in
       pat::patl,acc_sign,acc in
   let avoid0 = GlobEnv.vars_of_env env in
   (* [patl] is a list of patterns revealing the substructure of
@@ -1892,7 +1887,7 @@ let build_inversion_problem ~program_mode loc env sigma tms t =
   let decls =
     List.map_i (fun i d -> (mkRel i, map_constr (lift i) d)) 1 sign in
 
-  let _,pb_env = push_rel_context ~hypnaming sigma sign env in
+  let _,pb_env = push_rel_context sigma sign env in
   let decls =
     List.map (fun (c,d) -> (c,extract_inductive_data !!(pb_env) sigma d,d)) decls in
 
@@ -1951,7 +1946,7 @@ let build_inversion_problem ~program_mode loc env sigma tms t =
        main branch, knowing that the default impossible case shall
        always be coercible to one of those *)
       sigma, s
-  | Type _ | QSort _ ->
+  | Type _ | GSort _ | VSort _ ->
     (* If the sort has algebraic universes, we cannot use this sort a
        type constraint for the impossible case; especially if the
        default case is not the canonical one provided in Prop by Rocq
@@ -1968,7 +1963,7 @@ let build_inversion_problem ~program_mode loc env sigma tms t =
       history   = start_history n;
       mat       = main_eqn :: catch_all_eqn;
       caseloc   = loc;
-      casestyle = RegularStyle;
+      casestyle = MatchStyle;
       typing_function = build_tycon ?loc env pb_env s subst} in
   let _used, sigma, j = compile ~program_mode sigma pb in
   (sigma, j.uj_val)
@@ -2102,8 +2097,7 @@ let prepare_predicate_from_arsign_tycon ~program_mode env sigma loc tomatchs ars
   in
   assert (len == 0);
   let p = predicate 0 c in
-  let hypnaming = VarSet.variables (Global.env ()) in
-  let arsign,env' = List.fold_right_map (push_rel_context ~hypnaming sigma) arsign env in
+  let arsign,env' = List.fold_right_map (push_rel_context sigma) arsign env in
   try let sigma' = fst (Typing.type_of !!env' sigma p) in
         Some (sigma', p, arsign)
   with e when precatchable_exception e -> None
@@ -2165,8 +2159,7 @@ let prepare_predicate ?loc ~program_mode typing_fun env sigma tomatchs arsign ty
     (* Some type annotation *)
     | Some rtntyp ->
       (* We extract the signature of the arity *)
-      let hypnaming = VarSet.variables (Global.env ()) in
-      let building_arsign,envar = List.fold_right_map (push_rel_context ~hypnaming sigma) arsign env in
+      let building_arsign,envar = List.fold_right_map (push_rel_context sigma) arsign env in
       let sigma, rtnsort = Evd.new_sort_variable univ_flexible sigma in
       let sigma, predcclj = typing_fun (Some (mkSort rtnsort)) envar sigma rtntyp in
       let check_elim_sort sigma squash =
@@ -2420,7 +2413,6 @@ let build_ineqs env sigma prevpatterns curpats curpat_sign_len =
 
 let constrs_of_pats typing_fun env sigma eqns tomatchs sign neqs arity =
   let i = ref 0 in
-  let hypnaming = VarSet.variables (Global.env ()) in
   let (sigma, x, y, z) =
     List.fold_left
       (fun (sigma, branches, eqns, prevpatterns) eqn ->
@@ -2483,7 +2475,7 @@ let constrs_of_pats typing_fun env sigma eqns tomatchs sign neqs arity =
            let eqs_rels, arity = decompose_prod_n_decls sigma neqs arity in
              eqs_rels @ neqs_rels @ rhs_rels', arity
          in
-         let _,rhs_env = push_rel_context ~hypnaming sigma rhs_rels' env in
+         let _,rhs_env = push_rel_context sigma rhs_rels' env in
          let sigma, j = typing_fun (mk_tycon tycon) rhs_env sigma eqn.rhs.it in
          let bbody = it_mkLambda_or_LetIn j.uj_val rhs_rels'
          and btype = it_mkProd_or_LetIn j.uj_type rhs_rels' in
@@ -2697,7 +2689,6 @@ let context_of_arsign l =
 
 let compile_program_cases ?loc style (typing_function, sigma) tycon env
     (predopt, tomatchl, eqns) =
-  let hypnaming = VarSet.variables (Global.env ()) in
   let typing_fun tycon env sigma = function
     | Some t ->	typing_function tycon env sigma t
     | None -> coq_unit_judge !!env sigma in
@@ -2710,7 +2701,7 @@ let compile_program_cases ?loc style (typing_function, sigma) tycon env
   let env, sigma, tomatchs = coerce_to_indtype ~program_mode:true typing_function env sigma matx tomatchl in
   let tycon = valcon_of_tycon tycon in
   let tomatchs, tomatchs_lets, tycon' = abstract_tomatch env sigma tomatchs tycon in
-  let _,env = push_rel_context ~hypnaming sigma tomatchs_lets env in
+  let _,env = push_rel_context sigma tomatchs_lets env in
   let len = List.length eqns in
   let sigma, sign, signlen, eqs, args =
     (* The arity signature *)
@@ -2746,7 +2737,7 @@ let compile_program_cases ?loc style (typing_function, sigma) tycon env
   in
   let matx = List.rev matx in
   let _ = assert (Int.equal len (List.length lets)) in
-  let _,env = push_rel_context ~hypnaming sigma lets env in
+  let _,env = push_rel_context sigma lets env in
   let matx = List.map (fun eqn -> { eqn with rhs = { eqn.rhs with rhs_env = env } }) matx in
   let tomatchs = List.map (fun (x, y) -> lift len x, lift_tomatch_type len y) tomatchs in
   let args = List.rev_map (lift len) args in
diff --git a/pretyping/cbv.ml b/pretyping/cbv.ml
index e228c3aab231..61f74e4c605a 100644
--- a/pretyping/cbv.ml
+++ b/pretyping/cbv.ml
@@ -48,10 +48,10 @@ type cbv_value =
   | LAMBDA of int * (Name.t Constr.binder_annot * types) list * constr * cbv_value subs
   | PROD of Name.t Constr.binder_annot * types * types * cbv_value subs
   | LETIN of Name.t Constr.binder_annot * cbv_value * types * constr * cbv_value subs
-  | FIX of fixpoint * cbv_value subs * cbv_value array
-  | COFIX of cofixpoint * cbv_value subs * cbv_value array
-  | CONSTRUCT of constructor UVars.puniverses * cbv_value array
-  | PRIMITIVE of CPrimitives.t * pconstant * cbv_value array
+  | FIX of fixpoint * cbv_value subs * cbv_value list
+  | COFIX of cofixpoint * cbv_value subs * cbv_value list
+  | CONSTRUCT of constructor UVars.puniverses * cbv_value list
+  | PRIMITIVE of CPrimitives.t * pconstant * cbv_value list
   | ARRAY of UVars.Instance.t * cbv_value Parray.t * cbv_value
   | SYMBOL of { cst: Constant.t UVars.puniverses; unfoldfix: bool; rules: Declarations.machine_rewrite_rule list; stk: cbv_stack }
 
@@ -92,13 +92,13 @@ let rec shift_value n = function
   | LETIN (na,b,t,c,s) -> LETIN(na,shift_value n b,t,c,subs_shft(n,s))
   | LAMBDA (nlams,ctxt,b,s) -> LAMBDA (nlams,ctxt,b,subs_shft (n,s))
   | FIX (fix,s,args) ->
-      FIX (fix,subs_shft (n,s), Array.map (shift_value n) args)
+      FIX (fix,subs_shft (n,s), List.map (shift_value n) args)
   | COFIX (cofix,s,args) ->
-      COFIX (cofix,subs_shft (n,s), Array.map (shift_value n) args)
+      COFIX (cofix,subs_shft (n,s), List.map (shift_value n) args)
   | CONSTRUCT (c,args) ->
-      CONSTRUCT (c, Array.map (shift_value n) args)
+      CONSTRUCT (c, List.map (shift_value n) args)
   | PRIMITIVE(op,c,args) ->
-      PRIMITIVE(op,c,Array.map (shift_value n) args)
+      PRIMITIVE(op,c,List.map (shift_value n) args)
   | ARRAY (u,t,ty) ->
       ARRAY(u, Parray.map (shift_value n) t, shift_value n ty)
   | SYMBOL s -> SYMBOL { s with stk = shift_stack n s.stk }
@@ -124,12 +124,12 @@ let rec mk_fix_subs make_body n env i =
   else mk_fix_subs make_body n (subs_cons (make_body i) env) (i + 1)
 
 let contract_fixp env ((reci,i),(_,_,bds as bodies)) =
-  let make_body j = FIX(((reci,j),bodies), env, [||]) in
+  let make_body j = FIX(((reci,j),bodies), env, []) in
   let n = Array.length bds in
   mk_fix_subs make_body n env 0, bds.(i)
 
 let contract_cofixp env (i,(_,_,bds as bodies)) =
-  let make_body j = COFIX((j,bodies), env, [||]) in
+  let make_body j = COFIX((j,bodies), env, []) in
   let n = Array.length bds in
   mk_fix_subs make_body n env 0, bds.(i)
 
@@ -140,12 +140,6 @@ let make_constr_ref n k t =
   | ConstKey cst -> t
 
 (* Adds an application list. Collapse APPs! *)
-let stack_vect_app appl stack =
-  if Int.equal (Array.length appl) 0 then stack else
-    match stack with
-    | APP(args,stk) -> APP(Array.fold_right (fun v accu -> v :: accu) appl args,stk)
-    | _             -> APP(Array.to_list appl, stack)
-
 let stack_app appl stack =
   if List.is_empty appl then stack else
     match stack with
@@ -194,18 +188,18 @@ let red_set_ref flags = function
  *)
 let strip_appl head stack =
   match head with
-    | FIX (fix,env,app) -> (FIX(fix,env,[||]), stack_vect_app app stack)
-    | COFIX (cofix,env,app) -> (COFIX(cofix,env,[||]), stack_vect_app app stack)
-    | CONSTRUCT (c,app) -> (CONSTRUCT(c,[||]), stack_vect_app app stack)
-    | PRIMITIVE(op,c,app) -> (PRIMITIVE(op,c,[||]), stack_vect_app app stack)
+    | FIX (fix,env,app) -> (FIX(fix,env,[]), stack_app app stack)
+    | COFIX (cofix,env,app) -> (COFIX(cofix,env,[]), stack_app app stack)
+    | CONSTRUCT (c,app) -> (CONSTRUCT(c,[]), stack_app app stack)
+    | PRIMITIVE(op,c,app) -> (PRIMITIVE(op,c,[]), stack_app app stack)
     | LETIN _ | VAL _ | STACK _ | PROD _ | LAMBDA _ | ARRAY _ | SYMBOL _ -> (head, stack)
 
 let destack head stack =
   match head with
-  | FIX (fix,env,app) -> (FIX(fix,env,[||]), stack_vect_app app stack)
-  | COFIX (cofix,env,app) -> (COFIX(cofix,env,[||]), stack_vect_app app stack)
-  | CONSTRUCT (c,app) -> (CONSTRUCT(c,[||]), stack_vect_app app stack)
-  | PRIMITIVE(op,c,app) -> (PRIMITIVE(op,c,[||]), stack_vect_app app stack)
+  | FIX (fix,env,app) -> (FIX(fix,env,[]), stack_app app stack)
+  | COFIX (cofix,env,app) -> (COFIX(cofix,env,[]), stack_app app stack)
+  | CONSTRUCT (c,app) -> (CONSTRUCT(c,[]), stack_app app stack)
+  | PRIMITIVE(op,c,app) -> (PRIMITIVE(op,c,[]), stack_app app stack)
   | STACK (k, v, stk) -> (shift_value k v, stack_concat (shift_stack k stk) stack)
   | SYMBOL ({ stk } as s) -> (SYMBOL { s with stk=TOP }, stack_concat stk stack)
   | LETIN _ | VAL _ | PROD _ | LAMBDA _ | ARRAY _ -> (head, stack)
@@ -296,7 +290,7 @@ module VNativeEntries =
 
     let mkBool env b =
       let (ct,cf) = get_bool_constructors env in
-      CONSTRUCT(UVars.in_punivs (if b then ct else cf), [||])
+      CONSTRUCT(UVars.in_punivs (if b then ct else cf), [])
 
     let int_ty env = VAL(0, UnsafeMonomorphic.mkConst @@ get_int_type env)
 
@@ -304,91 +298,91 @@ module VNativeEntries =
 
     let mkCarry env b e =
       let (c0,c1) = get_carry_constructors env in
-      CONSTRUCT(UVars.in_punivs (if b then c1 else c0), [|int_ty env;e|])
+      CONSTRUCT(UVars.in_punivs (if b then c1 else c0), [int_ty env;e])
 
     let mkIntPair env e1 e2 =
       let int_ty = int_ty env in
       let c = get_pair_constructor env in
-      CONSTRUCT(UVars.in_punivs c, [|int_ty;int_ty;e1;e2|])
+      CONSTRUCT(UVars.in_punivs c, [int_ty;int_ty;e1;e2])
 
     let mkFloatIntPair env f i =
       let float_ty = float_ty env in
       let int_ty = int_ty env in
       let c = get_pair_constructor env in
-      CONSTRUCT(UVars.in_punivs c, [|float_ty;int_ty;f;i|])
+      CONSTRUCT(UVars.in_punivs c, [float_ty;int_ty;f;i])
 
     let mkLt env =
       let (_eq,lt,_gt) = get_cmp_constructors env in
-      CONSTRUCT(UVars.in_punivs lt, [||])
+      CONSTRUCT(UVars.in_punivs lt, [])
 
     let mkEq env =
       let (eq,_lt,_gt) = get_cmp_constructors env in
-      CONSTRUCT(UVars.in_punivs eq, [||])
+      CONSTRUCT(UVars.in_punivs eq, [])
 
     let mkGt env =
       let (_eq,_lt,gt) = get_cmp_constructors env in
-      CONSTRUCT(UVars.in_punivs gt, [||])
+      CONSTRUCT(UVars.in_punivs gt, [])
 
     let mkFLt env =
       let (_eq,lt,_gt,_nc) = get_f_cmp_constructors env in
-      CONSTRUCT(UVars.in_punivs lt, [||])
+      CONSTRUCT(UVars.in_punivs lt, [])
 
     let mkFEq env =
       let (eq,_lt,_gt,_nc) = get_f_cmp_constructors env in
-      CONSTRUCT(UVars.in_punivs eq, [||])
+      CONSTRUCT(UVars.in_punivs eq, [])
 
     let mkFGt env =
       let (_eq,_lt,gt,_nc) = get_f_cmp_constructors env in
-      CONSTRUCT(UVars.in_punivs gt, [||])
+      CONSTRUCT(UVars.in_punivs gt, [])
 
     let mkFNotComparable env =
       let (_eq,_lt,_gt,nc) = get_f_cmp_constructors env in
-      CONSTRUCT(UVars.in_punivs nc, [||])
+      CONSTRUCT(UVars.in_punivs nc, [])
 
     let mkPNormal env =
       let (pNormal,_nNormal,_pSubn,_nSubn,_pZero,_nZero,_pInf,_nInf,_nan) =
         get_f_class_constructors env in
-      CONSTRUCT(UVars.in_punivs pNormal, [||])
+      CONSTRUCT(UVars.in_punivs pNormal, [])
 
     let mkNNormal env =
       let (_pNormal,nNormal,_pSubn,_nSubn,_pZero,_nZero,_pInf,_nInf,_nan) =
         get_f_class_constructors env in
-      CONSTRUCT(UVars.in_punivs nNormal, [||])
+      CONSTRUCT(UVars.in_punivs nNormal, [])
 
     let mkPSubn env =
       let (_pNormal,_nNormal,pSubn,_nSubn,_pZero,_nZero,_pInf,_nInf,_nan) =
         get_f_class_constructors env in
-      CONSTRUCT(UVars.in_punivs pSubn, [||])
+      CONSTRUCT(UVars.in_punivs pSubn, [])
 
     let mkNSubn env =
       let (_pNormal,_nNormal,_pSubn,nSubn,_pZero,_nZero,_pInf,_nInf,_nan) =
         get_f_class_constructors env in
-      CONSTRUCT(UVars.in_punivs nSubn, [||])
+      CONSTRUCT(UVars.in_punivs nSubn, [])
 
     let mkPZero env =
       let (_pNormal,_nNormal,_pSubn,_nSubn,pZero,_nZero,_pInf,_nInf,_nan) =
         get_f_class_constructors env in
-      CONSTRUCT(UVars.in_punivs pZero, [||])
+      CONSTRUCT(UVars.in_punivs pZero, [])
 
     let mkNZero env =
       let (_pNormal,_nNormal,_pSubn,_nSubn,_pZero,nZero,_pInf,_nInf,_nan) =
         get_f_class_constructors env in
-      CONSTRUCT(UVars.in_punivs nZero, [||])
+      CONSTRUCT(UVars.in_punivs nZero, [])
 
     let mkPInf env =
       let (_pNormal,_nNormal,_pSubn,_nSubn,_pZero,_nZero,pInf,_nInf,_nan) =
         get_f_class_constructors env in
-      CONSTRUCT(UVars.in_punivs pInf, [||])
+      CONSTRUCT(UVars.in_punivs pInf, [])
 
     let mkNInf env =
       let (_pNormal,_nNormal,_pSubn,_nSubn,_pZero,_nZero,_pInf,nInf,_nan) =
         get_f_class_constructors env in
-      CONSTRUCT(UVars.in_punivs nInf, [||])
+      CONSTRUCT(UVars.in_punivs nInf, [])
 
     let mkNaN env =
       let (_pNormal,_nNormal,_pSubn,_nSubn,_pZero,_nZero,_pInf,_nInf,nan) =
         get_f_class_constructors env in
-      CONSTRUCT(UVars.in_punivs nan, [||])
+      CONSTRUCT(UVars.in_punivs nan, [])
 
     let mkArray env u t ty =
       ARRAY (u,t,ty)
@@ -428,14 +422,14 @@ and reify_value = function (* reduction under binders *)
         mkLambda (n, t, c)) b ctxt
   | FIX ((lij,fix),env,args) ->
     let fix = mkFix (lij, fix) in
-    mkApp (apply_env env fix, Array.map reify_value args)
+    mkApp (apply_env env fix, Array.map_of_list reify_value args)
   | COFIX ((j,cofix),env,args) ->
     let cofix = mkCoFix (j, cofix) in
-    mkApp (apply_env env cofix, Array.map reify_value args)
+    mkApp (apply_env env cofix, Array.map_of_list reify_value args)
   | CONSTRUCT (c,args) ->
-      mkApp(mkConstructU c, Array.map reify_value args)
+      mkApp(mkConstructU c, Array.map_of_list reify_value args)
   | PRIMITIVE(op,c,args) ->
-      mkApp(mkConstU c, Array.map reify_value args)
+      mkApp(mkConstU c, Array.map_of_list reify_value args)
   | ARRAY (u,t,ty) ->
     let t, def = Parray.to_array t in
       mkArray(u, Array.map reify_value t, reify_value def, reify_value ty)
@@ -547,7 +541,7 @@ let rec norm_head info env t stack =
 
   | Const sp ->
     Reductionops.reduction_effect_hook info.env info.sigma
-      (fst sp) (lazy (reify_stack t (strip_app stack)));
+      (fst sp) (lazy (EConstr.of_constr @@ reify_stack t (strip_app stack)));
     norm_head_ref 0 info env stack (ConstKey sp) t
 
   | LetIn (na, b, u, c) ->
@@ -576,9 +570,9 @@ let rec norm_head info env t stack =
   | Lambda _ ->
       let ctxt,b = Term.decompose_lambda t in
       (LAMBDA(List.length ctxt, List.rev ctxt,b,env), stack)
-  | Fix fix -> (FIX(fix,env,[||]), stack)
-  | CoFix cofix -> (COFIX(cofix,env,[||]), stack)
-  | Construct c -> (CONSTRUCT(c, [||]), stack)
+  | Fix fix -> (FIX(fix,env,[]), stack)
+  | CoFix cofix -> (COFIX(cofix,env,[]), stack)
+  | Construct c -> (CONSTRUCT(c, []), stack)
 
   | Array(u,t,def,ty) ->
     let ty = cbv_stack_term info TOP env ty in
@@ -604,7 +598,7 @@ and norm_head_ref k info env stack normt t =
           | ConstKey c -> c
           | RelKey _ | VarKey _ -> assert false
         in
-        (PRIMITIVE(op,c,[||]),stack)
+        (PRIMITIVE(op,c,[]),stack)
       | Declarations.Symbol (unfoldfix, rules) ->
         assert (k = 0);
         let cst = match normt with
@@ -633,99 +627,101 @@ and cbv_stack_term info stack env t =
 and cbv_stack_value info env = function
   (* a lambda meets an application -> BETA *)
   | (LAMBDA (nlams,ctxt,b,env), APP (args, stk))
-      when red_set info.reds fBETA ->
+    when red_set info.reds fBETA ->
     let rec apply env lams args =
       if Int.equal lams 0 then
         let stk = if List.is_empty args then stk else APP (args, stk) in
         cbv_stack_term info stk env b
       else match args with
-      | [] ->
-        let ctxt' = List.skipn (nlams - lams) ctxt in
-        LAMBDA (lams, ctxt', b, env)
-      | v :: args ->
-        let env = subs_cons v env in
-        apply env (lams - 1) args
+        | [] ->
+          let ctxt' = List.skipn (nlams - lams) ctxt in
+          LAMBDA (lams, ctxt', b, env)
+        | v :: args ->
+          let env = subs_cons v env in
+          apply env (lams - 1) args
     in
     apply env nlams args
-    (* a Fix applied enough -> IOTA *)
-    | (FIX(fix,env,[||]), stk)
-        when fixp_reducible info.reds 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 *)
-    | (COFIX(cofix,env,[||]), stk)
-        when cofixp_reducible info.reds cofix stk->
-        let (envf,redfix) = contract_cofixp env cofix in
-        cbv_stack_term info stk envf redfix
-
-    (* constructor in a Case -> IOTA *)
-    | (CONSTRUCT(((sp,n),_),[||]), APP(args,CASE(u,pms,_p,br,iv,ci,env,stk)))
-            when red_set info.reds fMATCH ->
-        let cargs = List.skipn ci.ci_npar args in
-        let env =
-          if (Int.equal ci.ci_cstr_ndecls.(n - 1) ci.ci_cstr_nargs.(n - 1)) then (* no lets *)
-            List.fold_left (fun accu v -> subs_cons v accu) env cargs
-          else
-            let mkclos env c = cbv_stack_term info TOP env c in
-            let ctx = expand_branch info.env u pms (sp, n) br in
-            cbv_subst_of_rel_context_instance_list mkclos ctx cargs env
-        in
-        cbv_stack_term info stk env (snd br.(n-1))
-
-    (* constructor of arity 0 in a Case -> IOTA *)
-    | (CONSTRUCT(((sp, n), _),[||]), CASE(u,pms,_,br,_,ci,env,stk))
-            when red_set info.reds fMATCH ->
-        let env =
-          if (Int.equal ci.ci_cstr_ndecls.(n - 1) ci.ci_cstr_nargs.(n - 1)) then (* no lets *)
-            env
-          else
-            let mkclos env c = cbv_stack_term info TOP env c in
-            let ctx = expand_branch info.env u pms (sp, n) br in
-            cbv_subst_of_rel_context_instance_list mkclos ctx [] env
-        in
-        cbv_stack_term info stk env (snd br.(n-1))
-
-    (* constructor in a Projection -> IOTA *)
-    | (CONSTRUCT(((sp,n),u),[||]), APP(args,PROJ(p,_,stk)))
-        when red_set info.reds fMATCH && Projection.unfolded p ->
-      let arg = List.nth args (Projection.npars p + Projection.arg p) in
-        cbv_stack_value info env (strip_appl arg stk)
-
-    (* may be reduced later by application *)
-    | (FIX(fix,env,[||]), APP(appl,TOP)) -> FIX(fix,env,Array.of_list appl)
-    | (COFIX(cofix,env,[||]), APP(appl,TOP)) -> COFIX(cofix,env,Array.of_list appl)
-    | (CONSTRUCT(c,[||]), APP(appl,TOP)) -> CONSTRUCT(c,Array.of_list appl)
-
-    (* primitive apply to arguments *)
-    | (PRIMITIVE(op,(_,u as c),[||]), APP(appl,stk)) ->
-      let nargs = CPrimitives.arity op in
-      begin match List.chop nargs appl with
-      | (args, appl) ->
-        let stk = if List.is_empty appl then stk else stack_app appl stk in
-        begin match VredNative.red_prim info.env () op u (Array.of_list args) with
-        | Some (CONSTRUCT (c, args)) ->
-          (* args must be moved to the stack to allow future reductions *)
-          cbv_stack_value info env (CONSTRUCT(c, [||]), stack_vect_app args stk)
-        | Some v ->  cbv_stack_value info env (v,stk)
-        | None -> mkSTACK(PRIMITIVE(op,c,Array.of_list args), stk)
-        end
-      | exception Failure _ ->
-        (* partial application *)
-              (assert (stk = TOP);
-               PRIMITIVE(op,c,Array.of_list appl))
-        end
-    | SYMBOL ({ cst; rules; stk } as s ), stk' ->
-        let stk = stack_concat stk stk' in
-        begin try
-          let rhs, stack = cbv_apply_rules info env (snd cst) rules stk in
-          cbv_stack_value info env (destack rhs stack)
-        with PatternFailure ->
-          SYMBOL { s with stk }
-        end
-
-    (* definitely a value *)
-    | (head,stk) -> mkSTACK(head, stk)
+
+  (* a Fix applied enough -> IOTA *)
+  | (FIX(fix,env,[]), stk)
+    when fixp_reducible info.reds 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 *)
+  | (COFIX(cofix,env,[]), stk)
+    when cofixp_reducible info.reds cofix stk->
+    let (envf,redfix) = contract_cofixp env cofix in
+    cbv_stack_term info stk envf redfix
+
+  (* constructor in a Case -> IOTA *)
+  | (CONSTRUCT(((sp,n),_),[]), APP(args,CASE(u,pms,_p,br,iv,ci,env,stk)))
+    when red_set info.reds fMATCH ->
+    let cargs = List.skipn ci.ci_npar args in
+    let env =
+      if (Int.equal ci.ci_cstr_ndecls.(n - 1) ci.ci_cstr_nargs.(n - 1)) then (* no lets *)
+        List.fold_left (fun accu v -> subs_cons v accu) env cargs
+      else
+        let mkclos env c = cbv_stack_term info TOP env c in
+        let ctx = expand_branch info.env u pms (sp, n) br in
+        cbv_subst_of_rel_context_instance_list mkclos ctx cargs env
+    in
+    cbv_stack_term info stk env (snd br.(n-1))
+
+  (* constructor of arity 0 in a Case -> IOTA *)
+  | (CONSTRUCT(((sp, n), _),[]), CASE(u,pms,_,br,_,ci,env,stk))
+    when red_set info.reds fMATCH ->
+    let env =
+      if (Int.equal ci.ci_cstr_ndecls.(n - 1) ci.ci_cstr_nargs.(n - 1)) then (* no lets *)
+        env
+      else
+        let mkclos env c = cbv_stack_term info TOP env c in
+        let ctx = expand_branch info.env u pms (sp, n) br in
+        cbv_subst_of_rel_context_instance_list mkclos ctx [] env
+    in
+    cbv_stack_term info stk env (snd br.(n-1))
+
+  (* constructor in a Projection -> IOTA *)
+  | (CONSTRUCT(((sp,n),u),[]), APP(args,PROJ(p,_,stk)))
+    when red_set info.reds fMATCH && Projection.unfolded p ->
+    let arg = List.nth args (Projection.npars p + Projection.arg p) in
+    cbv_stack_value info env (strip_appl arg stk)
+
+  (* may be reduced later by application *)
+  | (FIX(fix,env,[]), APP(appl,TOP)) -> FIX(fix,env, appl)
+  | (COFIX(cofix,env,[]), APP(appl,TOP)) -> COFIX(cofix,env, appl)
+  | (CONSTRUCT(c,[]), APP(appl,TOP)) -> CONSTRUCT(c, appl)
+
+  (* primitive apply to arguments *)
+  | (PRIMITIVE(op,(_,u as c),[]), APP(appl,stk)) ->
+    let nargs = CPrimitives.arity op in
+    begin match List.chop nargs appl with
+    | (args, appl) ->
+      let stk = if List.is_empty appl then stk else stack_app appl stk in
+      begin match VredNative.red_prim info.env () op u (Array.of_list args) with
+      | Some (CONSTRUCT (c, args)) ->
+        (* args must be moved to the stack to allow future reductions *)
+        cbv_stack_value info env (CONSTRUCT(c, []), stack_app args stk)
+      | Some v ->  cbv_stack_value info env (v,stk)
+      | None -> mkSTACK(PRIMITIVE(op,c, args), stk)
+      end
+    | exception Failure _ ->
+      (* partial application *)
+      (assert (stk = TOP);
+       PRIMITIVE(op,c, appl))
+    end
+
+  | SYMBOL ({ cst; rules; stk } as s ), stk' ->
+    let stk = stack_concat stk stk' in
+    begin try
+      let rhs, stack = cbv_apply_rules info env (snd cst) rules stk in
+      cbv_stack_value info env (destack rhs stack)
+    with PatternFailure ->
+      SYMBOL { s with stk }
+    end
+
+  (* definitely a value *)
+  | (head,stk) -> mkSTACK(head, stk)
 
 and cbv_value_cache info ref =
   try KeyTable.find info.tab ref with
@@ -804,7 +800,7 @@ and cbv_match_rigid_arg_pattern info env ctx psubst p t =
   match [@ocaml.warning "-4"] p, t with
   | PHInd (ind, pu), VAL(0, t') ->
     begin match kind t' with Ind (ind', u) when Environ.QInd.equal info.env ind ind' -> match_instance pu u psubst | _ -> raise PatternFailure end
-  | PHConstr (constr, pu), CONSTRUCT ((constr', u), [||]) ->
+  | PHConstr (constr, pu), CONSTRUCT ((constr', u), []) ->
     if Environ.QConstruct.equal info.env constr constr' then match_instance pu u psubst else raise PatternFailure
   | PHRel i, VAL(k, t') ->
     begin match kind t' with Rel n when Int.equal i (k + n) -> psubst | _ -> raise PatternFailure end
@@ -973,18 +969,18 @@ and cbv_norm_value info = function
                 (names,
                  Array.map (aux env) lty,
                  Array.map (aux (subs_liftn (Array.length lty) env)) bds)),
-         Array.map (cbv_norm_value info) args)
+         Array.map_of_list (cbv_norm_value info) args)
   | COFIX ((j,(names,lty,bds)),env,args) ->
       mkApp
         (mkCoFix (j,
                   (names,Array.map (cbv_norm_term info env) lty,
                    Array.map (cbv_norm_term info
                                 (subs_liftn (Array.length lty) env)) bds)),
-         Array.map (cbv_norm_value info) args)
+         Array.map_of_list (cbv_norm_value info) args)
   | CONSTRUCT (c,args) ->
-      mkApp(mkConstructU c, Array.map (cbv_norm_value info) args)
+      mkApp(mkConstructU c, Array.map_of_list (cbv_norm_value info) args)
   | PRIMITIVE(op,c,args) ->
-      mkApp(mkConstU c,Array.map (cbv_norm_value info) args)
+      mkApp(mkConstU c,Array.map_of_list (cbv_norm_value info) args)
   | ARRAY (u,t,ty) ->
     let ty = cbv_norm_value info ty in
     let t, def = Parray.to_array t in
diff --git a/pretyping/coercion.ml b/pretyping/coercion.ml
index f170109ca1c4..59dadd026828 100644
--- a/pretyping/coercion.ml
+++ b/pretyping/coercion.ml
@@ -752,11 +752,8 @@ let rec inh_conv_coerce_to_fail ?loc ?use_coercions env sigma ?(flags=default_fl
       | _ ->
         Exninfo.iraise (NoCoercionNoUnifier (best_failed_sigma,e), info)
 
-let default_flags_of env sigma =
-  { (default_flags_of env) with allowed_evars = Evarsolve.allow_all_but_rrpat_evars sigma }
-
 (* Look for cj' obtained from cj by inserting coercions, s.t. cj'.typ = t *)
-let inh_conv_coerce_to_gen ?loc ~program_mode ~resolve_tc ?use_coercions rigidonly env sigma ?(flags=default_flags_of env sigma) cj t =
+let inh_conv_coerce_to_gen ?loc ~program_mode ~resolve_tc ?use_coercions rigidonly env sigma ?(flags=default_flags_of env) cj t =
   let (sigma, val', otrace) =
     try
       let (sigma, val', trace) = inh_conv_coerce_to_fail ?loc ?use_coercions env sigma ~flags rigidonly cj.uj_val cj.uj_type t in
diff --git a/pretyping/combinators.ml b/pretyping/combinators.ml
index dfadbb48b263..76c38efd6443 100644
--- a/pretyping/combinators.ml
+++ b/pretyping/combinators.ml
@@ -81,7 +81,7 @@ let telescope env sigma ctx =
   let ctx, _ = List.fold_right_map (fun d env ->
       let s = Retyping.get_sort_quality_of env sigma (RelDecl.get_type d) in
       let env = EConstr.push_rel d env in
-      (d, UnivGen.QualityOrSet.quality s), env) ctx env
+      (d, s), env) ctx env
   in
   let sigma, telescope_type, letcontext, telescope_value = telescope sigma ctx in
   sigma, letcontext, { telescope_type; telescope_value }
@@ -276,5 +276,5 @@ let make_selector env sigma ~pos ~special ~default c ctype =
   let brl =
     List.map build_branch(List.interval 1 (Array.length mip.mind_consnames)) in
   let rci = ERelevance.relevant in (* TODO relevance *)
-  let ci = make_case_info env ind RegularStyle in
+  let ci = make_case_info env ind MatchStyle in
   Inductiveops.make_case_or_project env sigma indt ci (p, rci) c (Array.of_list brl)
diff --git a/pretyping/detyping.ml b/pretyping/detyping.ml
index 686f3f3343a9..cca1f9881327 100644
--- a/pretyping/detyping.ml
+++ b/pretyping/detyping.ml
@@ -285,13 +285,13 @@ let detype_level sigma l =
 let detype_qvar sigma q =
   match UState.id_of_qvar (Evd.ustate sigma) q with
   | Some id -> GLocalQVar (CAst.make (Name id))
-  | None -> GQVar q
+  | None -> GQuality (QVar q)
 
 let detype_quality sigma q =
   let open Sorts.Quality in
   match q with
-  | QConstant q -> GQConstant q
-  | QVar q -> GQualVar (detype_qvar sigma q)
+  | QConstant _ | QGlobal _ -> GQuality q
+  | QVar q -> detype_qvar sigma q
 
 let detype_universe sigma u =
   UNamed (List.map (on_fst (detype_level_name sigma)) (Univ.Universe.repr u))
@@ -304,7 +304,11 @@ let detype_sort ~universes ~qualities sigma = function
       (if universes
        then None, detype_universe sigma u
        else glob_Type_sort)
-  | QSort (q, u) ->
+  | GSort (q, u) ->
+    let q = Some (GQuality (QGlobal q)) in
+    if universes then q, detype_universe sigma u
+    else q, UAnonymous {rigid=UState.univ_flexible}
+  | VSort (q, u) ->
     if universes then
       let q = if qualities || Evd.is_rigid_qvar sigma q then
           Some (detype_qvar sigma q)
@@ -612,19 +616,18 @@ let detype_case ~flags computable detype detype_eqns avoid env sigma (ci, univs,
       n, aliastyp, Some typ
   in
   let constructs = Array.init (Array.length bl) (fun i -> (ci.ci_ind,i+1)) in
-  let tag = let st = ci.ci_pp_info.style in
-    try
-      if flags.flg.always_regular_match_style then
-        RegularStyle
-      else if st == LetPatternStyle then
-        st
-      else if PrintingLet.active ci.ci_ind then
-        LetStyle
-      else if PrintingIf.active ci.ci_ind then
-        IfStyle
-      else
-        st
-    with Not_found -> st
+  let tag =
+    let tag = ci.ci_pp_info.style in
+    if flags.flg.always_regular_match_style then
+      MatchStyle
+    else if tag == LetPatternStyle then
+      tag
+    else if PrintingLet.active ci.ci_ind then
+      LetStyle
+    else if PrintingIf.active ci.ci_ind then
+      IfStyle
+    else
+      tag
   in
   match tag, aliastyp with
   | LetStyle, None ->
@@ -982,16 +985,16 @@ and detype_binder d flags bk avoid env sigma decl c =
       let c = detype d (nongoal flags) avoid env sigma (Option.get body) in
       (* Heuristic: we display the type if in Prop *)
       let s =
-        if !Flags.in_debugger then UnivGen.QualityOrSet.qtype
+        if !Flags.in_debugger then Sorts.Quality.qtype
         else
           (* It can fail if ty is an evar, or if run inside ocamldebug or the
              OCaml toplevel since their printers don't have access to the proper sigma/env *)
           try Retyping.get_sort_quality_of (snd env) sigma ty
-          with Retyping.RetypeError _ -> UnivGen.QualityOrSet.qtype
+          with Retyping.RetypeError _ -> Sorts.Quality.qtype
       in
       let t =
         (* XXX also sprop? *)
-        if flags.flg.nonpropositional_letin_types || UnivGen.QualityOrSet.is_prop s
+        if flags.flg.nonpropositional_letin_types || Sorts.Quality.is_qprop s
         then Some (detype d (nongoal flags) avoid env sigma ty)
         else None
       in
@@ -1207,7 +1210,7 @@ let rec subst_glob_constr env subst = DAst.map (function
     else GHole nknd
 
   | GGenarg arg as raw ->
-    let arg' = Gensubst.generic_substitute subst arg in
+    let arg' = Gensubst.constr_subst subst arg in
     if arg' == arg then raw
     else GGenarg arg'
 
diff --git a/pretyping/dune b/pretyping/dune
index c02435a76aa9..690bb15e095f 100644
--- a/pretyping/dune
+++ b/pretyping/dune
@@ -5,7 +5,3 @@
  (wrapped false)
  (modules_without_implementation locus pattern glob_term ltac_pretype)
  (libraries engine))
-
-(deprecated_library_name
- (old_public_name coq-core.pretyping)
- (new_public_name rocq-runtime.pretyping))
diff --git a/pretyping/evarconv.ml b/pretyping/evarconv.ml
index 16f98fd43d5a..03ecfe8774b0 100644
--- a/pretyping/evarconv.ml
+++ b/pretyping/evarconv.ml
@@ -110,7 +110,32 @@ let eval_flexible_term ts env evd c sk =
                (delta) step. *)
             let unf = unfold_projection_under_eta env evd ts c def in
             Some (Option.default def unf, sk)
-        | OpaqueDef _ | Undef _ | Primitive _ -> None
+        | Primitive op ->
+          let nargs = CPrimitives.arity op in
+          let (args, rest_sk) = Stack.strip_app sk in
+          let args = Option.get @@ Stack.list_of_app_stack args in
+          begin match List.chop nargs args with
+          | (args, appl) ->
+            let args_red = CPrimitives.kind op in
+            assert (List.length args_red <= List.length args);
+            let args =
+              let open CPrimitives in
+              let red arg = function
+                | Kparam | Karg -> arg
+                | Kwhnf ->
+                  let flags = RedFlags.all in
+                  let flags = RedFlags.red_add_transparent flags ts in
+                  Reductionops.clos_whd_flags flags env evd arg
+              in
+              List.map2 red args args_red
+            in
+            begin match CredNative.(red_prim env evd op u @@ Array.of_list args) with
+              | Some v -> Some (v, rest_sk)
+              | None -> None
+              end
+            | exception Failure _ -> None
+          end
+        | OpaqueDef _ | Undef _ -> None
         | Symbol b ->
             try
             let r = match lookup_rewrite_rules c env with r -> r | exception Not_found -> assert false in
@@ -154,7 +179,7 @@ let flex_kind_of_term flags env evd c sk =
        if flags.modulo_betaiota then MaybeFlexible (c, sk)
        else Rigid
     | Evar ev ->
-       if is_evar_allowed flags (fst ev) then Flexible ev else Rigid
+       if is_evar_allowed flags evd (fst ev) then Flexible ev else Rigid
     | Lambda _ | Prod _ | Sort _ | Ind _ | Int _ | Float _ | String _ | Array _ -> Rigid
     | Construct _ | CoFix _ (* Incorrect: should check only app in sk *) -> Rigid
     | Meta _ -> Rigid
@@ -222,7 +247,7 @@ let occur_rigidly flags env evd (evk,_) t =
           | Reducible -> Reducible)
     | Evar (evk',l) ->
       if Evar.equal evk evk' then Rigid true
-      else if is_evar_allowed flags evk' then
+      else if is_evar_allowed flags evd evk' then
         Reducible
         else Rigid (SList.Skip.exists (fun x -> rigid_normal_occ (aux x)) l)
     | Cast (p, _, _) -> aux p
@@ -509,7 +534,7 @@ let compare_heads pbty env evd ~nargs term term' =
           else compare_constructor_instances evd u u'
       end
   | Construct _, Construct _ -> UnifFailure (evd, NotSameHead)
-  | _, _ -> anomaly (Pp.str "")
+  | _, _ -> assert false
 
 (* This function tries to unify 2 stacks element by element. It works
    from the end to the beginning. If it unifies a non empty suffix of
@@ -725,7 +750,7 @@ let rec evar_conv_x flags env evd pbty term1 term2 =
         | Success _ as x -> x
         in
           begin match EConstr.kind evd term1, EConstr.kind evd term2 with
-          | Evar ev, _ when Evd.is_undefined evd (fst ev) && is_evar_allowed flags (fst ev) ->
+          | Evar ev, _ when Evd.is_undefined evd (fst ev) && is_evar_allowed flags evd (fst ev) ->
             (match solve_simple_eqn (conv_fun evar_conv_x) flags env evd
               (position_problem true pbty,ev,term2) with
               | UnifFailure (_,(OccurCheck _ | NotClean _)) ->
@@ -736,7 +761,7 @@ let rec evar_conv_x flags env evd pbty term1 term2 =
                      Miller patterns *)
                 default ()
               | x -> x)
-          | _, Evar ev when Evd.is_undefined evd (fst ev) && is_evar_allowed flags (fst ev) ->
+          | _, Evar ev when Evd.is_undefined evd (fst ev) && is_evar_allowed flags evd (fst ev) ->
             (match solve_simple_eqn (conv_fun evar_conv_x) flags env evd
               (position_problem false pbty,ev,term1) with
               | UnifFailure (_, (OccurCheck _ | NotClean _)) ->
@@ -1793,7 +1818,7 @@ let second_order_matching flags env_rhs evd (evk,args) (test,argoccs) rhs =
      debug_ho_unification (fun () ->
        Pp.(str"abstracted: " ++ prc env_rhs evd rhs'));
      let () = check_selected_occs env_rhs evd c !occ occs in
-     let env_rhs' = push_named (NamedDecl.LocalAssum (id,idty)) env_rhs in
+     let env_rhs' = push_named ProofVar (NamedDecl.LocalAssum (id,idty)) env_rhs in
      set_holes env_rhs' evd fixed rhs' subst
   | [] -> evd, fixed, rhs in
 
@@ -1947,7 +1972,7 @@ let apply_conversion_problem_heuristic flags env evd with_ho pbty t1 t2 =
   let app_empty = Array.is_empty l1 && Array.is_empty l2 in
   match EConstr.kind evd term1, EConstr.kind evd term2 with
   | Evar (evk1,args1), (Rel _|Var _) when app_empty
-      && is_evar_allowed flags evk1
+      && is_evar_allowed flags evd evk1
       && is_constant_instance evd (evk1, args1) term2 ->
       (* The typical kind of constraint coming from pattern-matching return
          type inference *)
@@ -1957,7 +1982,7 @@ let apply_conversion_problem_heuristic flags env evd with_ho pbty t1 t2 =
          let reason = ProblemBeyondCapabilities in
          UnifFailure (evd, CannotSolveConstraint ((pbty,env,t1,t2),reason)))
   | (Rel _|Var _), Evar (evk2,args2) when app_empty
-    && is_evar_allowed flags evk2
+    && is_evar_allowed flags evd evk2
     && is_constant_instance evd (evk2, args2) term1 ->
       (* The typical kind of constraint coming from pattern-matching return
          type inference *)
@@ -1985,24 +2010,24 @@ let apply_conversion_problem_heuristic flags env evd with_ho pbty t1 t2 =
                  (position_problem true pbty) ev1 ev2)
       with IllTypedInstance (env,evd,t,u) ->
             UnifFailure (evd,InstanceNotSameType (evk1,env,t,u)))
-  | Evar ev1,_ when is_evar_allowed flags (fst ev1) && Array.length l1 <= Array.length l2 ->
+  | Evar ev1,_ when Array.length l1 <= Array.length l2 && is_evar_allowed flags evd (fst ev1) ->
       (* On "?n t1 .. tn = u u1 .. u(n+p)", try first-order unification *)
       (* and otherwise second-order matching *)
       ise_try evd
         [(fun evd -> first_order_unification flags env evd (ev1,l1) appr2);
          (fun evd ->
            second_order_matching_with_args flags env evd with_ho pbty ev1 l1 t2)]
-  | _,Evar ev2 when is_evar_allowed flags (fst ev2) && Array.length l2 <= Array.length l1 ->
+  | _,Evar ev2 when Array.length l2 <= Array.length l1 && is_evar_allowed flags evd (fst ev2) ->
       (* On "u u1 .. u(n+p) = ?n t1 .. tn", try first-order unification *)
       (* and otherwise second-order matching *)
       ise_try evd
         [(fun evd -> first_order_unification flags env evd (ev2,l2) appr1);
          (fun evd ->
            second_order_matching_with_args flags env evd with_ho pbty ev2 l2 t1)]
-  | Evar ev1,_ when is_evar_allowed flags (fst ev1) ->
+  | Evar ev1,_ when is_evar_allowed flags evd (fst ev1) ->
       (* Try second-order pattern-matching *)
       second_order_matching_with_args flags env evd with_ho pbty ev1 l1 t2
-  | _,Evar ev2 when is_evar_allowed flags (fst ev2) ->
+  | _,Evar ev2 when is_evar_allowed flags evd (fst ev2) ->
       (* Try second-order pattern-matching *)
       second_order_matching_with_args flags env evd with_ho pbty ev2 l2 t1
   | _ ->
diff --git a/pretyping/evardefine.ml b/pretyping/evardefine.ml
index 11f79dc6968e..367c02df12cc 100644
--- a/pretyping/evardefine.ml
+++ b/pretyping/evardefine.ml
@@ -86,7 +86,7 @@ let define_pure_evar_as_product env evd na evk =
   in
   let rdom = ESorts.relevance_of_sort u1 in
   let evd2,rng =
-    let newenv = push_named (LocalAssum (make_annot id rdom, dom)) evenv in
+    let newenv = push_named ProofVar (LocalAssum (make_annot id rdom, dom)) evenv in
     let src = subterm_source evk ~where:Codomain evksrc in
     let filter = Filter.extend 1 (evar_filter evi) in
       if Environ.is_impredicative_sort env (ESorts.kind evd1 s) then
@@ -139,7 +139,7 @@ let define_pure_evar_as_lambda env evd name evk =
     map_annot (fun na -> next_name_away_with_default_using_types evenv evd "x" na avoid
       (Reductionops.whd_evar evd dom)) na
   in
-  let newenv = push_named (LocalAssum (id, dom)) evenv in
+  let newenv = push_named ProofVar (LocalAssum (id, dom)) evenv in
   let filter = Filter.extend 1 (evar_filter evi) in
   let src = subterm_source evk ~where:Body (evar_source evi) in
   let abstract_arguments = Abstraction.abstract_last (Evd.evar_abstract_arguments evi) in
diff --git a/pretyping/evarsolve.ml b/pretyping/evarsolve.ml
index e197def7a93b..6c9573d5e46e 100644
--- a/pretyping/evarsolve.ml
+++ b/pretyping/evarsolve.ml
@@ -31,10 +31,10 @@ module AllowedEvars = struct
   | AllowAll
   | AllowFun of (Evar.t -> bool) * Evar.Set.t
 
-  let mem allowed evk =
+  let mem allowed sigma evk =
     match allowed with
-    | AllowAll -> true
-    | AllowFun (f,except) -> f evk && not (Evar.Set.mem evk except)
+    | AllowAll -> not (Evd.is_rewrite_rule_evar sigma evk)
+    | AllowFun (f,except) -> f evk && not (Evar.Set.mem evk except) && not (Evd.is_rewrite_rule_evar sigma evk)
 
   let remove evk = function
     | AllowAll -> AllowFun ((fun _ -> true), Evar.Set.singleton evk)
@@ -59,11 +59,8 @@ type unify_flags = {
   with_cs : bool
 }
 
-let allow_all_but_rrpat_evars evd =
-  AllowedEvars.except (Evd.get_rewrite_rule_evars evd)
-
-let is_evar_allowed flags evk =
-  AllowedEvars.mem flags.allowed_evars evk
+let is_evar_allowed flags sigma evk =
+  AllowedEvars.mem flags.allowed_evars sigma evk
 
 type unification_kind =
   | TypeUnification
@@ -120,10 +117,7 @@ let refresh_universes ?(allowed_evars=AllowedEvars.all) ?(status=univ_rigid) ?(o
   (* direction: true for fresh universes lower than the existing ones *)
   let refresh_sort status ~direction s =
     let sigma, l = new_univ_level_variable status !evdref in
-    let s' = match ESorts.kind sigma s with
-      | QSort (q, _) -> Sorts.qsort q (Univ.Universe.make l)
-      | _ -> Sorts.sort_of_univ @@ Univ.Universe.make l
-    in
+    let s' = Sorts.make (Sorts.quality @@ ESorts.kind sigma s) (Univ.Universe.make l) in
     let s' = ESorts.make s' in
     evdref := sigma;
     let evd =
@@ -135,7 +129,7 @@ let refresh_universes ?(allowed_evars=AllowedEvars.all) ?(status=univ_rigid) ?(o
     match EConstr.kind !evdref t with
     | Sort s ->
       begin match ESorts.kind !evdref s with
-      | Type u | QSort (_, u) ->
+      | Type u | GSort (_, u) | VSort (_, u) ->
          (* TODO: check if max(l,u) is not ok as well *)
         (match Univ.Universe.level u with
         | None -> refresh_sort status ~direction s
@@ -170,7 +164,7 @@ let refresh_universes ?(allowed_evars=AllowedEvars.all) ?(status=univ_rigid) ?(o
        let args' = Array.map (refresh_term_evars ~onevars ~top:false) args in
        if f' == f && args' == args then t
        else mkApp (f', args')
-    | Evar (ev, a) when onevars && AllowedEvars.mem allowed_evars ev ->
+    | Evar (ev, a) when onevars && AllowedEvars.mem allowed_evars !evdref ev ->
       let evi = Evd.find_undefined !evdref ev in
       let ty = Evd.evar_concl evi in
       let ty' = refresh ~onlyalg univ_flexible ~direction:true ty in
@@ -574,7 +568,8 @@ let free_vars_and_rels_up_alias_expansion env sigma aliases c =
         | Some (RelAlias n) -> if n >= depth+1 then fv_rels := Int.Set.add (n-depth) !fv_rels
         | None -> frec (aliases,depth) c end
     | Const _ | Ind _ | Construct _ ->
-        fv_ids := Id.Set.union (vars_of_global env (fst @@ EConstr.destRef sigma c)) !fv_ids
+        (* XXX should be Evarutil.vars_of_global to handle abstracted constants? *)
+        fv_ids := Id.Set.union (Environ.vars_of_global env (fst @@ EConstr.destRef sigma c)) !fv_ids
     | _ ->
         iter_with_full_binders env sigma
           (fun d (aliases,depth) -> (extend_alias sigma d aliases,depth+1))
@@ -875,7 +870,7 @@ let materialize_evar define_fun env evd k (evk1,args1) ty_in_env =
           let evd,b = define_evar_from_virtual_equation define_fun env evd src b
             t_in_sign sign filter inst_in_env in
           evd, Context.Named.Declaration.LocalDef (id,b,t_in_sign) in
-      (push_named_context_val d' sign, Filter.extend 1 filter,
+      (push_named_context_val ProofVar d' sign, Filter.extend 1 filter,
        SList.cons (mkRel 1) (SList.Skip.map (lift 1) inst_in_env),
        SList.cons (mkRel 1) (SList.Skip.map (lift 1) inst_in_sign),
        push_rel d env,evd,Id.Set.add id.binder_name avoid))
@@ -1374,7 +1369,7 @@ let project_evar_on_evar force unify flags env evd aliases k2 pbty (evk1,argsv1
   if Option.is_empty pbty && SList.is_default argsv2 &&
     (* This ensures that the named context of [evk2] is a permutation of the one
        from [env]. In particular its filter must be trivial. *)
-    Int.equal (SList.length argsv2) (Range.length (Environ.named_context_val env).env_named_idx) &&
+    Int.equal (SList.length argsv2) (Environ.(nb_named @@ named_context_val env)) &&
     SList.Skip.for_all (fun arg -> noccur_evar env evd evk2 arg && closed0 evd arg) argsv1 &&
     let evi2 = Evd.find_undefined evd evk2 in Option.is_empty (Evd.evar_candidates evi2)
   then
@@ -1435,8 +1430,8 @@ let preferred_orientation evd evk1 evk2 =
 
 let solve_evar_evar_aux force f unify flags env evd pbty (evk1,args1 as ev1) (evk2,args2 as ev2) =
   let aliases = make_alias_map env evd in
-  let allowed_ev1 = is_evar_allowed flags evk1 in
-  let allowed_ev2 = is_evar_allowed flags evk2 in
+  let allowed_ev1 = is_evar_allowed flags evd evk1 in
+  let allowed_ev2 = is_evar_allowed flags evd evk2 in
   if preferred_orientation evd evk1 evk2 then
     try if allowed_ev1 then
         solve_evar_evar_l2r force f unify flags env evd aliases (opp_problem pbty) ev2 ev1
@@ -1515,7 +1510,7 @@ let solve_refl ?(can_drop=false) unify flags env evd pbty evk argsv1 argsv2 =
   let candidates = filter_candidates evd evk untypedfilter NoUpdate in
   let filter = closure_of_filter ~can_drop:false evd evk untypedfilter in
   let evd',ev1 = restrict_applied_evar evd (evk, argsv1) filter candidates in
-  let allowed = is_evar_allowed flags evk in
+  let allowed = is_evar_allowed flags evd evk in
   if Evar.equal (fst ev1) evk && (not allowed || can_drop) then
     (* No refinement needed *) evd'
   else
@@ -1739,7 +1734,7 @@ let rec invert_definition unify flags choose imitate_defs
           let evd =
              (* Try now to invert args in terms of args' *)
             try
-              if not @@ is_evar_allowed flags evk' then
+              if not @@ is_evar_allowed flags evd evk' then
                 raise (CannotProject (evd, ev''));
               let evd,body = project_evar_on_evar false unify flags env' evd aliases 0 None ev'' ev' in
               let evi = Evd.find_undefined evd evk' in
@@ -1811,7 +1806,7 @@ let rec invert_definition unify flags choose imitate_defs
 
 and evar_define unify flags ?(choose=false) ?(imitate_defs=true) env evd pbty (evk,argsv as ev) rhs =
   match EConstr.kind evd rhs with
-  | Evar (evk2,argsv2 as ev2) when is_evar_allowed flags evk2 ->
+  | Evar (evk2,argsv2 as ev2) when is_evar_allowed flags evd evk2 ->
       if Evar.equal evk evk2 then
         solve_refl ~can_drop:choose
           (test_success unify) flags env evd pbty evk argsv argsv2
diff --git a/pretyping/evarsolve.mli b/pretyping/evarsolve.mli
index fba45793b6fb..cb73ec9e0cd6 100644
--- a/pretyping/evarsolve.mli
+++ b/pretyping/evarsolve.mli
@@ -24,8 +24,8 @@ module AllowedEvars : sig
   val all : t
   (** All evars can be defined *)
 
-  val mem : t -> Evar.t -> bool
-  (** [mem allowed evk] is true iff evk can be defined *)
+  val mem : t -> evar_map -> Evar.t -> bool
+  (** [mem allowed sigma evk] is true iff evk can be defined *)
 
   val from_pred : (Evar.t -> bool) -> t
   (** [from_pred p] means evars satisfying p can be defined *)
@@ -60,9 +60,7 @@ type unification_result =
 
 val is_success : unification_result -> bool
 
-val is_evar_allowed : unify_flags -> Evar.t -> bool
-
-val allow_all_but_rrpat_evars : evar_map -> AllowedEvars.t
+val is_evar_allowed : unify_flags -> evar_map -> Evar.t -> bool
 
 (** Replace the vars and rels that are aliases to other vars and rels by
    their representative that is most ancient in the context *)
diff --git a/pretyping/genConstr.ml b/pretyping/genConstr.ml
new file mode 100644
index 000000000000..c2254dcbf009
--- /dev/null
+++ b/pretyping/genConstr.ml
@@ -0,0 +1,57 @@
+(************************************************************************)
+(*         *      The Rocq Prover / The Rocq Development Team           *)
+(*  v      *         Copyright INRIA, CNRS and contributors             *)
+(*  any_tag
+
+let name s =
+  (* magic: all tags are at tuple types *)
+  D.name s |> Option.map @@ fun (D.Any t) -> Any (Obj.magic t)
+
+type raw = Raw : ('raw, _) tag * 'raw -> raw
+
+type glb = Glb : (_, 'glb) tag * 'glb -> glb
+
+module Register(M : sig type ('raw, 'glb) t end) = struct
+
+  module V = struct type _ t = V : ('raw, 'glb) M.t -> ('raw * 'glb) t end
+
+  module VMap = D.Map(V)
+
+  let vals = ref VMap.empty
+
+  let mem tag = VMap.mem tag !vals
+
+  let register tag v =
+    assert (not @@ mem tag);
+    vals := VMap.add tag (V v) !vals
+
+  let find_opt tag =
+    try
+      let V v = VMap.find tag !vals in
+      Some v
+    with Not_found -> None
+
+  let get tag =
+    try
+      let V v = VMap.find tag !vals in
+      v
+    with Not_found -> assert false
+
+end
diff --git a/pretyping/genConstr.mli b/pretyping/genConstr.mli
new file mode 100644
index 000000000000..4555266fda20
--- /dev/null
+++ b/pretyping/genConstr.mli
@@ -0,0 +1,48 @@
+(************************************************************************)
+(*         *      The Rocq Prover / The Rocq Development Team           *)
+(*  v      *         Copyright INRIA, CNRS and contributors             *)
+(*  _ tag
+
+val eq : ('raw1, 'glb1) tag -> ('raw2, 'glb2) tag -> ('raw1 * 'glb1, 'raw2 * 'glb2) Util.eq option
+
+val repr : _ tag -> string
+
+type any_tag = Any : _ tag -> any_tag
+
+val name : string -> any_tag option
+
+type raw = Raw : ('raw, _) tag * 'raw -> raw
+
+type glb = Glb : (_, 'glb) tag * 'glb -> glb
+
+module Register (M : sig type ('raw, 'glb) t end) : sig
+  val register : ('raw, 'glb) tag -> ('raw, 'glb) M.t -> unit
+
+  val mem : _ tag -> bool
+
+  val find_opt : ('raw, 'glb) tag -> ('raw, 'glb) M.t option
+
+  (** Assert false if not present *)
+  val get : ('raw, 'glb) tag -> ('raw, 'glb) M.t
+end
diff --git a/pretyping/genarg.mli b/pretyping/genarg.mli
index 0e7f00f969f4..62589f27c06f 100644
--- a/pretyping/genarg.mli
+++ b/pretyping/genarg.mli
@@ -15,36 +15,6 @@
     (raw level printers are always useful for clearer [-time] output, for beautify,
     and some other debug prints)
 
-    - extensible constr syntax beyond notations (eg [ltac:()], [ltac2:()] and ltac2 [$x]).
-      Such genargs appear in glob_term GGenarg and constrexpr CGenarg.
-      They must be registered with [Genintern.register_intern0]
-      and [GlobEnv.register_constr_interp0].
-
-      The glob level may be kept through notations and other operations like Ltac definitions
-      (eg [Ltac foo := exact ltac2:(foo)]) in which case [Gensubst.register_subst0]
-      and a glob level printer are useful.
-
-      Other useful registrations are
-      - [Genintern.register_intern_pat] and [Patternops.register_interp_pat]
-        to be used in tactic patterns.
-      - [Genintern.register_ntn_subst0] to be used in notations
-        (eg [Notation "foo" := ltac2:(foo)]).
-
-      NB: only the base [ExtraArg] is allowed here.
-
-    - tactic arguments to commands defined without depending on ltac_plugin
-      (VernacProof, HintsExtern, Hint Rewrite, etc).
-
-      Must be registered with [Genintern.register_intern0] and
-      [Genintern.register_interp0].
-
-      The glob level can be kept (currently with Hint Extern and Hint
-      Rewrite) so [Gensubst.register_subst0] is also needed.
-
-      Currently AFAICT this is just [Tacarg.wit_ltac].
-
-      NB: only the base [ExtraArg] is allowed here.
-
     - vernac arguments, used by vernac extend. Usually declared in mlg
       using VERNAC ARGUMENT EXTEND then used in VERNAC EXTEND.
 
@@ -63,7 +33,7 @@
       then used in TACTIC EXTEND.
 
       Must be registered with [Genintern.register_intern0],
-      [Gensubst.register_subst0] and [Genintern.register_interp0].
+      [Gensubst.register_subst0] and [Geninterp.register_interp0].
 
       Must be registered with [Procq.register_grammar] as tactic extend
       only gets the genarg as argument so must get the grammar from
@@ -71,7 +41,7 @@
 
       They must be associated with a [Geninterp.Val.tag] using [Geninterp.register_val0]
       (which creates a fresh tag if passed [None]).
-      Note: although [Genintern.register_interp0] registers a producer
+      Note: although [Geninterp.register_interp0] registers a producer
       of arbitrary [Geninterp.Val.t], tactic_extend requires them to be of the tag
       registered by [Geninterp.register_val0] to work properly.
 
diff --git a/pretyping/geninterp.ml b/pretyping/geninterp.ml
index 7b4a9ee1d84b..e862f12b32a9 100644
--- a/pretyping/geninterp.ml
+++ b/pretyping/geninterp.ml
@@ -8,11 +8,8 @@
 (*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
-open Names
 open Genarg
 
-module TacStore = Store.Make ()
-
 (** Dynamic toplevel values *)
 
 module ValT = Dyn.Make ()
@@ -22,13 +19,14 @@ struct
 
   type 'a typ = 'a ValT.tag
 
+  type t = Dyn : 'a typ * 'a -> t
+
   type _ tag =
   | Base : 'a typ -> 'a tag
   | List : 'a tag -> 'a list tag
   | Opt : 'a tag -> 'a option tag
   | Pair : 'a tag * 'b tag -> ('a * 'b) tag
-
-  type t = Dyn : 'a typ * 'a -> t
+  | Any : t tag
 
   let eq = ValT.eq
   let repr = ValT.repr
@@ -46,6 +44,7 @@ struct
   | Opt tag -> Dyn (typ_opt, Option.map (fun x -> inject tag x) x)
   | Pair (tag1, tag2) ->
     Dyn (typ_pair, (inject tag1 (fst x), inject tag2 (snd x)))
+  | Any -> x
 
 end
 
@@ -79,27 +78,3 @@ let register_val0 wit tag =
   | Some tag -> tag
   in
   ValRepr.register0 wit tag
-
-(** Interpretation functions *)
-
-type interp_sign =
-  { lfun : Val.t Id.Map.t
-  ; poly : PolyFlags.t
-  ; extra : TacStore.t }
-
-type ('glb, 'top) interp_fun = interp_sign -> 'glb -> 'top Ftactic.t
-
-module InterpObj =
-struct
-  type ('raw, 'glb, 'top) obj = ('glb, Val.t) interp_fun
-  let name = "interp"
-  let default _ = None
-end
-
-module Interp = Register(InterpObj)
-
-let interp = Interp.obj
-
-let generic_interp ist (GenArg (Glbwit wit, v)) = interp wit ist v
-
-let register_interp0 = Interp.register0
diff --git a/pretyping/geninterp.mli b/pretyping/geninterp.mli
index 73d724d691fc..0c92d362a595 100644
--- a/pretyping/geninterp.mli
+++ b/pretyping/geninterp.mli
@@ -11,7 +11,6 @@
 (** Interpretation functions for generic arguments and interpreted Ltac
     values. *)
 
-open Names
 open Genarg
 
 (** {6 Dynamic toplevel values} *)
@@ -22,13 +21,14 @@ sig
 
   val create : string -> 'a typ
 
+  type t = Dyn : 'a typ * 'a -> t
+
   type _ tag =
   | Base : 'a typ -> 'a tag
   | List : 'a tag -> 'a list tag
   | Opt : 'a tag -> 'a option tag
   | Pair : 'a tag * 'b tag -> ('a * 'b) tag
-
-  type t = Dyn : 'a typ * 'a -> t
+  | Any : t tag
 
   val eq : 'a typ -> 'b typ -> ('a, 'b) CSig.eq option
   val repr : 'a typ -> string
@@ -57,21 +57,3 @@ val register_val0 : ('raw, 'glb, 'top) genarg_type -> 'top Val.tag option -> uni
 (** Register the representation of a generic argument. If no tag is given as
     argument, a new fresh tag with the same name as the argument is associated
     to the generic type. *)
-
-(** {6 Interpretation functions} *)
-
-module TacStore : Store.S
-
-type interp_sign =
-  { lfun : Val.t Id.Map.t
-  ; poly : PolyFlags.t
-  ; extra : TacStore.t }
-
-type ('glb, 'top) interp_fun = interp_sign -> 'glb -> 'top Ftactic.t
-
-val interp : ('raw, 'glb, 'top) genarg_type -> ('glb, Val.t) interp_fun
-
-val generic_interp : (glob_generic_argument, Val.t) interp_fun
-
-val register_interp0 :
-  ('raw, 'glb, 'top) genarg_type -> ('glb, Val.t) interp_fun -> unit
diff --git a/pretyping/gensubst.ml b/pretyping/gensubst.ml
index 5aa3bb9fbc9c..b7e0e66c7b1e 100644
--- a/pretyping/gensubst.ml
+++ b/pretyping/gensubst.ml
@@ -27,3 +27,17 @@ let register_subst0 = Subst.register0
 
 let generic_substitute subs (GenArg (Glbwit wit, v)) =
   in_gen (glbwit wit) (substitute wit subs v)
+
+module CSubstObj = struct
+  type (_, 'g) t = 'g subst_fun
+end
+
+module CSubst = GenConstr.Register(CSubstObj)
+
+let register_constr_subst = CSubst.register
+
+let constr_subst subst (GenConstr.Glb (tag, v) as o) =
+  let substf = CSubst.get tag in
+  let v' = substf subst v in
+  if v == v' then o else
+  GenConstr.Glb (tag, v')
diff --git a/pretyping/gensubst.mli b/pretyping/gensubst.mli
index 1e0b0fd1b228..18d380598b33 100644
--- a/pretyping/gensubst.mli
+++ b/pretyping/gensubst.mli
@@ -21,3 +21,7 @@ val generic_substitute : glob_generic_argument subst_fun
 
 val register_subst0 : ('raw, 'glb, 'top) genarg_type ->
   'glb subst_fun -> unit
+
+val constr_subst : GenConstr.glb subst_fun
+
+val register_constr_subst : (_, 'glb) GenConstr.tag -> 'glb subst_fun -> unit
diff --git a/pretyping/globEnv.ml b/pretyping/globEnv.ml
index 949901339f83..a2ab718571a4 100644
--- a/pretyping/globEnv.ml
+++ b/pretyping/globEnv.ml
@@ -38,8 +38,8 @@ type t = {
   lvar : ltac_var_map;
 }
 
-let make ~hypnaming env sigma lvar =
-  let get_extra env sigma = ext_named_context_of_env ~hypnaming env sigma in
+let make env sigma lvar =
+  let get_extra env sigma = ext_named_context_of_env env sigma in
   {
     static_env = env;
     renamed_env = env;
@@ -65,33 +65,33 @@ let ltac_interp_id { ltac_idents ; ltac_genargs } id =
 
 let ltac_interp_name lvar = Nameops.Name.map (ltac_interp_id lvar)
 
-let push_rel ~hypnaming sigma d env =
+let push_rel sigma d env =
   let open Context.Rel.Declaration in
   let d' = map_name (ltac_interp_name env.lvar) d in
   let env = {
     static_env = push_rel d env.static_env;
     renamed_env = push_rel d' env.renamed_env;
-    extra = lazy (push_rel_decl_to_named_context ~hypnaming:hypnaming sigma d' (Lazy.force env.extra));
+    extra = lazy (push_rel_decl_to_named_context sigma d' (Lazy.force env.extra));
     lvar = env.lvar;
     } in
   d', env
 
-let push_rel_context ~hypnaming ?(force_names=false) sigma ctx env =
+let push_rel_context ?(force_names=false) sigma ctx env =
   let open Context.Rel.Declaration in
   let ctx' = List.Smart.map (map_name (ltac_interp_name env.lvar)) ctx in
   let ctx' = if force_names then Namegen.name_context env.renamed_env sigma ctx' else ctx' in
   let env = {
     static_env = push_rel_context ctx env.static_env;
     renamed_env = push_rel_context ctx' env.renamed_env;
-    extra = lazy (List.fold_right (fun d acc -> push_rel_decl_to_named_context ~hypnaming:hypnaming sigma d acc) 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));
     lvar = env.lvar;
     } in
   ctx', env
 
-let push_rec_types ~hypnaming sigma (lna,typarray) env =
+let push_rec_types sigma (lna,typarray) env =
   let open Context.Rel.Declaration in
   let ctxt = Array.map2_i (fun i na t -> Context.Rel.Declaration.LocalAssum (na, lift i t)) lna typarray in
-  let env,ctx = Array.fold_left_map (fun e assum -> let (d,e) = push_rel sigma assum e ~hypnaming in (e,d)) env ctxt in
+  let env,ctx = Array.fold_left_map (fun e assum -> let (d,e) = push_rel sigma assum e in (e,d)) env ctxt in
   Array.map get_annot ctx, env
 
 let new_evar env sigma ?src ?rrpat ?(naming = Namegen.IntroAnonymous) ?relevance typ =
@@ -191,17 +191,13 @@ type 'a obj_interp_fun =
 
 module ConstrInterpObj =
 struct
-  type ('r, 'g, 't) obj = 'g obj_interp_fun
-  let name = "constr_interp"
-  let default _ = None
+  type ('r, 'g) t = 'g obj_interp_fun
 end
 
-module ConstrInterp = Genarg.Register(ConstrInterpObj)
+module ConstrInterp = GenConstr.Register(ConstrInterpObj)
 
-let register_constr_interp0 = ConstrInterp.register0
+let register_constr_interp0 = ConstrInterp.register
 
-let interp_glob_genarg ?loc ~poly env sigma ty arg =
-  let open Genarg in
-  let GenArg (Glbwit tag, arg) = arg in
-  let interp = ConstrInterp.obj tag in
+let interp_glob_genarg ?loc ~poly env sigma ty (GenConstr.Glb (tag, arg)) =
+  let interp = ConstrInterp.get tag in
   interp ?loc ~poly env sigma ty arg
diff --git a/pretyping/globEnv.mli b/pretyping/globEnv.mli
index 3ddc673d3942..44065277f8c8 100644
--- a/pretyping/globEnv.mli
+++ b/pretyping/globEnv.mli
@@ -13,7 +13,6 @@ open Environ
 open Evd
 open EConstr
 open Ltac_pretype
-open Evarutil
 
 (** Type of environment extended with naming and ltac interpretation data *)
 
@@ -26,7 +25,7 @@ type 'a obj_interp_fun =
   'a -> unsafe_judgment * Evd.evar_map
 
 val register_constr_interp0 :
-  ('r, 'g, 't) Genarg.genarg_type -> 'g obj_interp_fun -> unit
+  (_, 'g) GenConstr.tag -> 'g obj_interp_fun -> unit
 
 (** {6 Pretyping name management} *)
 
@@ -41,7 +40,7 @@ val register_constr_interp0 :
 
 (** Build a pretyping environment from an ltac environment *)
 
-val make : hypnaming:naming_mode -> env -> evar_map -> ltac_var_map -> t
+val make : env -> evar_map -> ltac_var_map -> t
 
 (** Export the underlying environment *)
 
@@ -53,9 +52,9 @@ val vars_of_env : t -> Id.Set.t
 
 (** Push to the environment, returning the declaration(s) with interpreted names *)
 
-val push_rel : hypnaming:naming_mode -> evar_map -> rel_declaration -> t -> rel_declaration * t
-val push_rel_context : hypnaming:naming_mode -> ?force_names:bool -> evar_map -> rel_context -> t -> rel_context * t
-val push_rec_types : hypnaming:naming_mode -> evar_map -> Name.t EConstr.binder_annot array * constr array -> t -> Name.t EConstr.binder_annot array * t
+val push_rel : evar_map -> rel_declaration -> t -> rel_declaration * t
+val push_rel_context : ?force_names:bool -> evar_map -> rel_context -> t -> rel_context * t
+val push_rec_types : evar_map -> Name.t EConstr.binder_annot array * constr array -> t -> Name.t EConstr.binder_annot array * t
 
 (** Declare an evar using renaming information *)
 
@@ -95,4 +94,4 @@ val interp_ltac_id : t -> Id.t -> Id.t
     into account the possible renaming *)
 
 val interp_glob_genarg : ?loc:Loc.t -> poly:PolyFlags.t -> t -> evar_map -> Evardefine.type_constraint ->
-  Genarg.glob_generic_argument -> unsafe_judgment * evar_map
+  GenConstr.glb -> unsafe_judgment * evar_map
diff --git a/pretyping/glob_ops.ml b/pretyping/glob_ops.ml
index db3017fc71bc..f98f4c7f6a17 100644
--- a/pretyping/glob_ops.ml
+++ b/pretyping/glob_ops.ml
@@ -44,16 +44,11 @@ let map_glob_decl_left_to_right f (na,r,k,obd,ty) =
   let comp2 = f ty in
   (na,r,k,comp1,comp2)
 
-let glob_qvar_eq g1 g2 = match g1, g2 with
+let glob_quality_eq g1 g2 = match g1, g2 with
   | GLocalQVar na1, GLocalQVar na2 -> CAst.eq Name.equal na1 na2
-  | GQVar q1, GQVar q2 -> Sorts.QVar.equal q1 q2
+  | GQuality q1, GQuality q2 -> Sorts.Quality.equal q1 q2
   | GRawQVar q1, GRawQVar q2 -> Sorts.QVar.equal q1 q2
-  | (GLocalQVar _ | GQVar _ | GRawQVar _), _ -> false
-
-let glob_quality_eq g1 g2 = match g1, g2 with
-  | GQConstant q1, GQConstant q2 -> Sorts.Quality.Constants.equal q1 q2
-  | GQualVar q1, GQualVar q2 -> glob_qvar_eq q1 q2
-  | (GQConstant _ | GQualVar _), _ -> false
+  | (GLocalQVar _ | GQuality _ | GRawQVar _), _ -> false
 
 let glob_sort_name_eq g1 g2 = match g1, g2 with
   | GSProp, GSProp
@@ -66,7 +61,8 @@ let glob_sort_name_eq g1 g2 = match g1, g2 with
 
 exception ComplexSort
 
-let glob_Type_sort = None, UAnonymous {rigid=UnivRigid}
+let glob_rigid_univ = UAnonymous {rigid=UnivRigid}
+let glob_Type_sort = None, glob_rigid_univ
 let glob_SProp_sort = None, UNamed [GSProp, 0]
 let glob_Prop_sort = None, UNamed [GProp, 0]
 let glob_Set_sort = None, UNamed [GSet, 0]
@@ -82,7 +78,7 @@ let glob_sort_gen_eq f u1 u2 =
   | (UNamed _ | UAnonymous _), _ -> false
 
 let glob_sort_eq (q1, l1) (q2, l2) =
-  Option.equal glob_qvar_eq q1 q2 &&
+  Option.equal glob_quality_eq q1 q2 &&
   glob_sort_gen_eq
     (List.equal (fun (x,m) (y,n) ->
          glob_sort_name_eq x y
@@ -119,7 +115,7 @@ let binding_kind_eq bk1 bk2 = match bk1, bk2 with
 
 let glob_relevance_eq a b = match a, b with
   | GRelevant, GRelevant | GIrrelevant, GIrrelevant -> true
-  | GRelevanceVar q1, GRelevanceVar q2 -> glob_qvar_eq q1 q2
+  | GRelevanceVar q1, GRelevanceVar q2 -> glob_quality_eq q1 q2
   | (GRelevant | GIrrelevant | GRelevanceVar _), _ -> false
 
 let relevance_info_eq = Option.equal glob_relevance_eq
@@ -129,8 +125,7 @@ let case_style_eq s1 s2 = let open Constr in match s1, s2 with
   | IfStyle, IfStyle -> true
   | LetPatternStyle, LetPatternStyle -> true
   | MatchStyle, MatchStyle -> true
-  | RegularStyle, RegularStyle -> true
-  | (LetStyle | IfStyle | LetPatternStyle | MatchStyle | RegularStyle), _ -> false
+  | (LetStyle | IfStyle | LetPatternStyle | MatchStyle), _ -> false
 
 let rec mk_cases_pattern_eq g p1 p2 = match DAst.get p1, DAst.get p2 with
   | PatVar na1, PatVar na2 -> g na1 na2
diff --git a/pretyping/glob_ops.mli b/pretyping/glob_ops.mli
index fff80116e7c1..71e161e2d279 100644
--- a/pretyping/glob_ops.mli
+++ b/pretyping/glob_ops.mli
@@ -13,6 +13,7 @@ open Glob_term
 
 val map_glob_sort_gen : ('a -> 'b) -> 'a glob_sort_gen -> 'b glob_sort_gen
 
+val glob_rigid_univ : _ glob_sort_gen
 val glob_Type_sort : glob_sort
 val glob_SProp_sort : glob_sort
 val glob_Prop_sort : glob_sort
@@ -24,8 +25,6 @@ val glob_sort_gen_eq : ('a -> 'a -> bool) -> 'a glob_sort_gen -> 'a glob_sort_ge
 
 val glob_sort_eq : Glob_term.glob_sort -> Glob_term.glob_sort -> bool
 
-val glob_qvar_eq :  glob_qvar -> glob_qvar -> bool
-
 val glob_quality_eq :  glob_quality -> glob_quality -> bool
 
 val glob_level_eq : Glob_term.glob_level -> Glob_term.glob_level -> bool
diff --git a/pretyping/glob_term.mli b/pretyping/glob_term.mli
index 00cf61451638..f7374372433e 100644
--- a/pretyping/glob_term.mli
+++ b/pretyping/glob_term.mli
@@ -22,18 +22,14 @@ type existential_name = Id.t
 
 (** Sorts *)
 
-type glob_qvar =
+type glob_quality =
   | GLocalQVar of lname
-  | GQVar of Sorts.QVar.t
+  | GQuality of Sorts.Quality.t
   | GRawQVar of Sorts.QVar.t (* hack for funind *)
 
 type glob_relevance =
   | GRelevant | GIrrelevant
-  | GRelevanceVar of glob_qvar
-
-type glob_quality =
-  | GQConstant of Sorts.Quality.constant
-  | GQualVar of glob_qvar
+  | GRelevanceVar of glob_quality
 
 type glob_sort_name =
   | GSProp (** representation of [SProp] literal *)
@@ -57,7 +53,7 @@ type glob_level = glob_sort_name glob_sort_gen
 type glob_instance = glob_quality list * glob_level list
 
 (** sort expressions *)
-type glob_sort = (glob_qvar option * (glob_sort_name * int) list glob_sort_gen)
+type glob_sort = (glob_quality option * (glob_sort_name * int) list glob_sort_gen)
 
 type glob_constraint = glob_sort_name * Univ.UnivConstraint.kind * glob_sort_name
 
@@ -113,7 +109,7 @@ type 'a glob_constr_r =
              'a glob_constr_g array * 'a glob_constr_g array
   | GSort of glob_sort
   | GHole of glob_evar_kind
-  | GGenarg of Genarg.glob_generic_argument
+  | GGenarg of GenConstr.glb
   | GCast of 'a glob_constr_g * Constr.cast_kind option * 'a glob_constr_g
   | GProj of (Constant.t * glob_instance option) * 'a glob_constr_g list * 'a glob_constr_g
   | GInt of Uint63.t
diff --git a/pretyping/heads.ml b/pretyping/heads.ml
index 39b51b68958c..e5d7397cf866 100644
--- a/pretyping/heads.ml
+++ b/pretyping/heads.ml
@@ -39,7 +39,7 @@ let rec compute_head_const env sigma cst =
 
 and compute_head_var env sigma id = match lookup_named id env with
 | LocalDef (_,c,_) -> kind_of_head env sigma c
-| _ -> RigidHead RigidOther
+| LocalAssum _ -> RigidHead RigidOther
 
 and kind_of_head env sigma t =
   let rec aux k l t b = match EConstr.kind sigma (Reductionops.clos_whd_flags RedFlags.betaiotazeta env sigma t) with
diff --git a/pretyping/inductiveops.ml b/pretyping/inductiveops.ml
index 496330f1df31..b1a507b3eea1 100644
--- a/pretyping/inductiveops.ml
+++ b/pretyping/inductiveops.ml
@@ -15,7 +15,6 @@ open EConstr
 open Vars
 open Context
 open Declarations
-open Declareops
 open Environ
 open Reductionops
 open Context.Rel.Declaration
@@ -26,13 +25,13 @@ open Context.Rel.Declaration
 let type_of_inductive env (ind,u) =
  let u = EConstr.Unsafe.to_instance u in
  let (mib,_ as specif) = Inductive.lookup_mind_specif env ind in
- Typeops.check_hyps_inclusion env (GlobRef.IndRef ind) mib.mind_hyps;
+ EConstr.check_hyps_inclusion env (GlobRef.IndRef ind) mib.mind_hyps;
  let t = Inductive.type_of_inductive (specif,u) in
  EConstr.of_constr @@ Arguments_renaming.rename_type env t (IndRef ind)
 
 let e_type_of_inductive env sigma (ind,u) =
  let (mib,_ as specif) = Inductive.lookup_mind_specif env ind in
- Reductionops.check_hyps_inclusion env sigma (GlobRef.IndRef ind) mib.mind_hyps;
+ EConstr.check_hyps_inclusion env (GlobRef.IndRef ind) mib.mind_hyps;
  let t = Inductive.type_of_inductive (specif, EConstr.Unsafe.to_instance u) in
  EConstr.of_constr (Arguments_renaming.rename_type env t (IndRef ind))
 
@@ -41,14 +40,14 @@ let type_of_constructor env (cstr,u) =
  let u = EConstr.Unsafe.to_instance u in
  let (mib,_ as specif) =
    Inductive.lookup_mind_specif env (inductive_of_constructor cstr) in
- Typeops.check_hyps_inclusion env (GlobRef.ConstructRef cstr) mib.mind_hyps;
+ EConstr.check_hyps_inclusion env (GlobRef.ConstructRef cstr) mib.mind_hyps;
  let t = Inductive.type_of_constructor (cstr,u) specif in
  EConstr.of_constr @@ Arguments_renaming.rename_type env t (ConstructRef cstr)
 
 let e_type_of_constructor env sigma (cstr,u) =
  let (mib,_ as specif) =
    Inductive.lookup_mind_specif env (inductive_of_constructor cstr) in
- Reductionops.check_hyps_inclusion env sigma (GlobRef.ConstructRef cstr) mib.mind_hyps;
+ EConstr.check_hyps_inclusion env (GlobRef.ConstructRef cstr) mib.mind_hyps;
  let t = Inductive.type_of_constructor (cstr,EConstr.Unsafe.to_instance u) specif in
  EConstr.of_constr (Arguments_renaming.rename_type env t (ConstructRef cstr))
 
@@ -116,24 +115,22 @@ let dest_subterms p = match Rtree.Kind.kind p with
 | Rtree.Kind.Var _ -> assert false
 
 let mis_is_recursive mip =
-  let one_is_rec rvec =
-    Array.exists (fun ra ->
-      match dest_recarg ra with
-        | Mrec (RecArgInd ind) -> true
-        | Mrec (RecArgPrim _) | Norec -> false
-    ) rvec
-    in
-  Array.exists one_is_rec (dest_subterms @@ Rtree.Kind.make mip.mind_recargs)
+  let ra = mip.mind_automaton in
+  let trans = Rtree.Automaton.transitions ra (Rtree.Automaton.initial ra) in
+  let check tr = match Rtree.Automaton.data ra tr with Mrec _ -> true | Norec -> false in
+  Array.exists (fun v -> Array.exists check v) trans
 
-let mis_is_nested kn mib =
+let mis_is_nested env kn mib =
   Array.exists (fun mip ->
+    let ra = mip.mind_automaton in
+    let trans = Rtree.Automaton.transitions ra (Rtree.Automaton.initial ra) in
     Array.exists (fun rvec ->
-      Array.exists (fun ra ->
-        match dest_recarg ra with
-        | Mrec (RecArgInd (kni, _)) -> not @@ MutInd.CanOrd.equal kn kni
+      Array.exists (fun tr ->
+        match Rtree.Automaton.data ra tr with
+        | Mrec (RecArgInd (kni, _)) -> not @@ QMutInd.equal env kn kni
         | Mrec (RecArgPrim _) | Norec -> false
       ) rvec
-    ) (dest_subterms @@ Rtree.Kind.make mip.mind_recargs)
+    ) trans
   ) mib.mind_packets
 
 let mis_nf_constructor_type ((_,j),u) (mib,mip) =
@@ -222,6 +219,12 @@ let inductive_nalldecls env ind =
 
 (* Others *)
 
+let get_template_instance mib u = match mib.mind_template with
+| None -> u
+| Some templ ->
+  let () = assert (UVars.Instance.is_empty (EConstr.Unsafe.to_instance u)) in
+  EInstance.make templ.template_defaults
+
 let inductive_paramdecls env (ind,u) =
   let u = EConstr.Unsafe.to_instance u in
   let (mib,mip) = Inductive.lookup_mind_specif env ind in
@@ -229,6 +232,7 @@ let inductive_paramdecls env (ind,u) =
 
 let inductive_alldecls env (ind,u) =
   let (mib,mip) = Inductive.lookup_mind_specif env ind in
+  let u = get_template_instance mib u in
   Vars.subst_instance_context u (EConstr.of_rel_context mip.mind_arity_ctxt)
 
 let inductive_alltags env ind =
@@ -239,12 +243,6 @@ let constructor_alltags env (ind,j) =
   let (mib,mip) = Inductive.lookup_mind_specif env ind in
   Context.Rel.to_tags (fst mip.mind_nf_lc.(j-1))
 
-let constructor_has_local_defs env (indsp,j) =
-  let (mib,mip) = Inductive.lookup_mind_specif env indsp in
-  let l1 = mip.mind_consnrealdecls.(j-1) + Context.Rel.length (mib.mind_params_ctxt) in
-  let l2 = recarg_length mip.mind_recargs j + mib.mind_nparams in
-  not (Int.equal l1 l2)
-
 let inductive_has_local_defs env ind =
   let (mib,mip) = Inductive.lookup_mind_specif env ind in
   let l1 = Context.Rel.length (mib.mind_params_ctxt) + mip.mind_nrealdecls in
@@ -270,10 +268,16 @@ let squash_elim_sort sigma squash rtnsort =
      add_unif_if_cannot_elim_into Evd.set_eq_sort Sorts.sprop
      (* Squashed inductive in SProp, return sort must be SProp. *)
   | SquashToQuality (QConstant QType) ->
-         add_unif_if_cannot_elim_into Evd.set_leq_sort Sorts.set
+     add_unif_if_cannot_elim_into Evd.set_leq_sort Sorts.set
      (* Sort poly squash to type *)
+  | SquashToQuality (QGlobal _ as q) ->
+    add_unif_if_cannot_elim_into Evd.set_leq_sort (Sorts.make q Univ.Universe.type0)
+    (* sort poly squash to global *)
   | SquashToQuality (QVar q) ->
-     add_unif_if_cannot_elim_into Evd.set_leq_sort (Sorts.qsort q Univ.Universe.type0)
+     let q' = ESorts.quality sigma rtnsort in
+     let g = Evd.elim_graph sigma in
+     if Inductive.eliminates_to g (QVar q) q' then sigma
+     else Evd.set_elim_to sigma (QVar q) q'
 
 let is_squashed sigma (specif,u) =
   Inductive.is_squashed_gen
@@ -339,15 +343,15 @@ let elim_sort (mib,mip) =
      future. *)
   if Option.is_empty mip.mind_squashed &&
        not (is_record && has_args mip && Sorts.is_sprop mip.mind_sort)
-  then Sorts.Quality.qtype
-  else Sorts.quality mip.mind_sort
+  then UnivGen.QualityOrSet.qtype
+  else if Sorts.is_set mip.mind_sort then Set
+  else UnivGen.QualityOrSet.of_quality @@ Sorts.quality mip.mind_sort
 
 let top_allowed_sort env (kn,i as ind) =
   let specif = Inductive.lookup_mind_specif env ind in
   elim_sort specif
 
 let constant_sorts_below top =
-  let top = UnivGen.QualityOrSet.of_quality top in
   List.filter
     (UnivGen.QualityOrSet.eliminates_to top)
     (UnivGen.QualityOrSet.all_constants)
@@ -355,10 +359,42 @@ let constant_sorts_below top =
 let sorts_for_schemes specif =
   constant_sorts_below (elim_sort specif)
 
-let has_dependent_elim (mib,mip) =
+let has_valid_relevance sigma u ind_relevance flds =
+  match ERelevance.kind sigma ind_relevance with
+  | Sorts.Irrelevant -> true
+  | Sorts.Relevant -> Array.exists (fun r -> Sorts.is_relevant @@ ERelevance.kind sigma r) flds
+  | Sorts.RelevanceVar qv ->
+    Array.for_all (fun r -> match ERelevance.kind sigma r with
+        | Sorts.Relevant -> true
+        | Sorts.Irrelevant -> false
+        | Sorts.RelevanceVar qv' -> Sorts.QVar.equal qv qv') flds
+
+let always_dependent_elim (mib,mip) =
   match mip.mind_record with
-  | PrimRecord _ -> mib.mind_finite == BiFinite || mip.mind_relevance == Irrelevant
   | NotRecord | FakeRecord -> true
+  | PrimRecord r -> match r.has_eta with
+    | AlwaysEta -> true
+    | NoEta | MaybeEta -> mip.mind_relevance == Irrelevant
+
+let has_dependent_elim sigma (mib,mip) u =
+  match mip.mind_record with
+  | NotRecord | FakeRecord -> true
+  | PrimRecord r ->
+    match r.has_eta with
+    | AlwaysEta -> true
+    | NoEta ->
+      let ind_relevance =
+        EConstr.Vars.subst_instance_relevance u (ERelevance.make mip.mind_relevance)
+      in
+      ERelevance.is_irrelevant sigma ind_relevance
+    | MaybeEta ->
+      let ind_relevance =
+        EConstr.Vars.subst_instance_relevance u (ERelevance.make mip.mind_relevance)
+      in
+      let flds =
+        Array.map (fun r -> EConstr.Vars.subst_instance_relevance u (ERelevance.make r)) r.relevances
+      in
+      has_valid_relevance sigma u ind_relevance flds
 
 (* Annotation for cases *)
 let make_case_info env ind style =
@@ -462,20 +498,19 @@ let make_case_invert env sigma (IndType (((ind,u),params),indices)) ~case_releva
 let make_project env sigma ind pred c branches ps =
   assert(Array.length branches == 1);
   let na, ty, t = destLambda sigma pred in
+  let _, u = destInd sigma (fst (decompose_app sigma ty)) in
   let mib, mip as specif = Inductive.lookup_mind_specif env ind in
   let () =
     if (* dependent *) not (Vars.noccurn sigma 1 t) &&
-         not (has_dependent_elim specif) then
+         not (has_dependent_elim sigma specif u) then
       Pretype_errors.error_not_allowed_dependent_elimination env sigma false ind
   in
   let branch = branches.(0) in
   let ctx, br = decompose_lambda_n_decls sigma mip.mind_consnrealdecls.(0) branch in
-  let _, u = destInd sigma (fst (decompose_app sigma ty)) in
-  let u = Unsafe.to_instance u in
   let mkProj i c =
     let p, r = ps.(i) in
-    let r = UVars.subst_instance_relevance u r in
-    mkProj (Projection.make p true, ERelevance.make r, c)
+    let r = EConstr.Vars.subst_instance_relevance u (ERelevance.make r) in
+    mkProj (Projection.make p true, r, c)
   in
   let proj = match EConstr.destRel sigma br with
     | exception Constr.DestKO -> None
diff --git a/pretyping/inductiveops.mli b/pretyping/inductiveops.mli
index 0a1e75b9fc6e..49228bdaaf2d 100644
--- a/pretyping/inductiveops.mli
+++ b/pretyping/inductiveops.mli
@@ -65,7 +65,7 @@ val dest_subterms : recarg Rtree.Kind.t -> recarg Rtree.Kind.t array array
 
 (** Check if a [one_inductive_body] is recursive, possibly nestedly  *)
 val mis_is_recursive : one_inductive_body -> bool
-val mis_is_nested : MutInd.t -> mutual_inductive_body -> bool
+val mis_is_nested : env -> MutInd.t -> mutual_inductive_body -> bool
 val mis_nf_constructor_type :
   constructor puniverses -> mutual_inductive_body * one_inductive_body -> constr
 
@@ -123,10 +123,9 @@ val inductive_alltags : env -> inductive -> bool list
 val constructor_alltags : env -> constructor -> bool list
 
 (** Is there local defs in params or args ? *)
-val constructor_has_local_defs : env -> constructor -> bool
 val inductive_has_local_defs : env -> inductive -> bool
 
-val constant_sorts_below : Sorts.Quality.t -> UnivGen.QualityOrSet.t list
+val constant_sorts_below : UnivGen.QualityOrSet.t -> UnivGen.QualityOrSet.t list
 
 val sorts_for_schemes : mind_specif -> UnivGen.QualityOrSet.t list
 
@@ -143,13 +142,15 @@ val is_allowed_elimination : evar_map -> (mind_specif * EInstance.t) -> EConstr.
 val make_allowed_elimination : evar_map -> (mind_specif * EInstance.t) -> EConstr.ESorts.t -> evar_map option
 (** Returns [Some sigma'] if the elimination can be allowed, possibly adding constraints in [sigma'] *)
 
-val elim_sort : mind_specif -> Sorts.Quality.t
+val elim_sort : mind_specif -> UnivGen.QualityOrSet.t
 
-val top_allowed_sort : env -> inductive -> Sorts.Quality.t
+val top_allowed_sort : env -> inductive -> UnivGen.QualityOrSet.t
 
 (** (Co)Inductive records with primitive projections do not have eta-conversion,
     hence no dependent elimination. *)
-val has_dependent_elim : mind_specif -> bool
+val has_dependent_elim : evar_map -> mind_specif -> EInstance.t -> bool
+
+val always_dependent_elim : mind_specif -> bool
 
 (** Primitive projections *)
 val type_of_projection_knowing_arg : env -> evar_map -> Projection.t ->
@@ -236,6 +237,8 @@ val control_only_guard : env -> Evd.evar_map -> EConstr.types -> unit
 val paramdecls_fresh_template : evar_map -> mutual_inductive_body * einstance ->
   evar_map * rel_context * Inductive.template_subst option
 
+val get_template_instance : mutual_inductive_body -> einstance -> einstance
+
 module Internal : sig
   (* FIXME hack for the [QVar]s, see the implementation for more information. *)
   val nf_relevance : Evd.evar_map -> Sorts.relevance -> Sorts.relevance
diff --git a/pretyping/libBinding.ml b/pretyping/libBinding.ml
index be2f19f66a06..a6b3bb012c90 100644
--- a/pretyping/libBinding.ml
+++ b/pretyping/libBinding.ml
@@ -495,7 +495,7 @@ let get_indices indb u =
 let make_case_or_projections naming_vars mib ind indb u key_uparams key_nuparams params indices mk_case_pred case_relevance tm_match tc =
   let* env = get_env in
   let* sigma = get_sigma in
-  let case_info = Inductiveops.make_case_info env ind RegularStyle in
+  let case_info = Inductiveops.make_case_info env ind MatchStyle in
 
   let case_invert =
     if Inductiveops.Internal.should_invert_case env sigma (ERelevance.kind sigma case_relevance) case_info
diff --git a/pretyping/nativenorm.ml b/pretyping/nativenorm.ml
index c0701bf61d16..fea696a3867a 100644
--- a/pretyping/nativenorm.ml
+++ b/pretyping/nativenorm.ml
@@ -161,6 +161,10 @@ let build_branches_type env sigma mib mip (ind,u) params (pctx, p) =
     in
     let decl_with_letin = List.firstn mip.mind_consnrealdecls.(i) ctx in
     let nas = get_case_annot decl_with_letin in
+    let nas =
+      let u = EConstr.Unsafe.to_instance u in
+      Array.map (Context.map_annot_relevance (UVars.subst_instance_relevance u)) nas
+    in
     let rec get_lift decls = match decls with
     | [] -> Esubst.el_id
     | LocalDef _ :: decls -> Esubst.el_shft 1 (get_lift decls)
@@ -325,6 +329,7 @@ and nf_atom_type env sigma atom =
       let params,realargs = Array.chop nparams allargs in
       let pctx =
         let realdecls, _ = List.chop mip.mind_nrealdecls mip.mind_arity_ctxt in
+        (* NB expand_arity doesn't look at the relevances in nas *)
         let nas = List.rev_map get_annot realdecls @ [nameR (Id.of_string "c")] in
         expand_arity (mib, mip) (ind, u) params (Array.of_list nas)
       in
@@ -341,8 +346,8 @@ and nf_atom_type env sigma atom =
       let branchs = Array.mapi mkbranch bsw in
       let tcase = build_case_type (pctx, p) realargs a in
       let p = (get_case_annot pctx, p) in
-      let ci = Inductiveops.make_case_info env ind RegularStyle in
-      let iv = if Typeops.should_invert_case env relevance ci then
+      let ci = Inductiveops.make_case_info env ind MatchStyle in
+      let iv = if Inductiveops.Internal.should_invert_case env sigma relevance ci then
           CaseInvert {indices=realargs}
         else NoInvert
       in
diff --git a/pretyping/pattern.mli b/pretyping/pattern.mli
index ccc9a5642431..793ad2f512c4 100644
--- a/pretyping/pattern.mli
+++ b/pretyping/pattern.mli
@@ -46,7 +46,7 @@ type 'i constr_pattern_r =
 
 type constr_pattern = Util.Empty.t constr_pattern_r
 
-type uninstantiated_pattern = Genarg.glob_generic_argument constr_pattern_r
+type uninstantiated_pattern = GenConstr.glb constr_pattern_r
 
 (** Nota : in a [PCase], the array of branches might be shorter than
     expected, denoting the use of a final "_ => _" branch *)
diff --git a/pretyping/patternops.ml b/pretyping/patternops.ml
index 9f13b1191ec4..58b7bddbe6c4 100644
--- a/pretyping/patternops.ml
+++ b/pretyping/patternops.ml
@@ -365,7 +365,7 @@ let subst_pattern env sigma subst p =
   subst_pattern_gen (fun _ e -> Util.Empty.abort e) env sigma subst p
 
 let subst_uninstantiated_pattern env sigma subst p =
-  subst_pattern_gen Gensubst.generic_substitute env sigma subst p
+  subst_pattern_gen Gensubst.constr_subst env sigma subst p
 
 let mkPLetIn na b t c = PLetIn(na,b,t,c)
 let mkPProd na t u = PProd(na,t,u)
@@ -389,16 +389,14 @@ type 'a pat_interp_fun = Environ.env -> Evd.evar_map -> Ltac_pretype.ltac_var_ma
 
 module InterpPatObj =
 struct
-  type (_, 'g, _) obj = 'g pat_interp_fun
-  let name = "interp_pat"
-  let default _ = None
+  type (_, 'g) t = 'g pat_interp_fun
 end
 
-module InterpPat = Genarg.Register(InterpPatObj)
+module InterpPat = GenConstr.Register(InterpPatObj)
 
-let interp_pat = InterpPat.obj
+let interp_pat = InterpPat.get
 
-let register_interp_pat = InterpPat.register0
+let register_interp_pat = InterpPat.register
 
 let error_instantiate_pattern id l =
   let is = match l with
@@ -411,7 +409,7 @@ let error_instantiate_pattern id l =
 
 let interp_pattern env sigma ist p =
   let fgen vars = function
-    | Genarg.GenArg (Glbwit tag,g) -> interp_pat tag env sigma ist g
+    | GenConstr.Glb (tag, g) -> interp_pat tag env sigma ist g
   in
   let rec aux vars = function
     | PVar id as x ->
@@ -503,9 +501,9 @@ let rec pat_of_raw metas vars : _ -> _ constr_pattern_r = DAst.with_loc_val (fun
      (try PSort (Glob_ops.glob_sort_quality gs)
       with Glob_ops.ComplexSort -> user_err ?loc (str "Unexpected universe in pattern."))
   | GHole _ -> PMeta None
-  | GGenarg (GenArg (Glbwit tag, _) as g) ->
+  | GGenarg (GenConstr.Glb (tag, _) as g) ->
     let () = if not (InterpPat.mem tag) then
-        let name = Genarg.(ArgT.repr (get_arg_tag tag)) in
+        let name = GenConstr.repr tag in
         user_err ?loc (str "This quotation is not supported in patterns (" ++ str name ++ str ").")
     in
     PExtra g
diff --git a/pretyping/patternops.mli b/pretyping/patternops.mli
index 66ae09bd6997..23771290e59a 100644
--- a/pretyping/patternops.mli
+++ b/pretyping/patternops.mli
@@ -57,4 +57,4 @@ type 'a pat_interp_fun = Environ.env -> Evd.evar_map -> Ltac_pretype.ltac_var_ma
 
 val interp_pattern : uninstantiated_pattern pat_interp_fun
 
-val register_interp_pat : (_, 'g, _) Genarg.genarg_type -> 'g pat_interp_fun -> unit
+val register_interp_pat : (_, 'g) GenConstr.tag -> 'g pat_interp_fun -> unit
diff --git a/pretyping/pretyping.ml b/pretyping/pretyping.ml
index 96ded43b0f35..648d6e9c6990 100644
--- a/pretyping/pretyping.ml
+++ b/pretyping/pretyping.ml
@@ -83,19 +83,19 @@ type possible_guard = {
   possible_fix_indices : possible_fix_indices;
 } (* Note: if no fix indices are given, it has to be a cofix *)
 
-exception Found of int array option
+exception Found of (evar_map * int array) option
 
 let nf_fix sigma (nas, cs, ts) =
   let inj c = EConstr.to_constr ~abort_on_undefined_evars:false sigma c in
   (Array.map EConstr.Unsafe.to_binder_annot nas, Array.map inj cs, Array.map inj ts)
 
-let search_guard ?loc ?evars ?elim_to env {possibly_cofix; possible_fix_indices} fixdefs =
+let search_guard ?loc env sigma {possibly_cofix; possible_fix_indices} fixdefs =
   let is_singleton = function [_] -> true | _ -> false in
   let one_fix_possibility = List.for_all is_singleton possible_fix_indices in
   if one_fix_possibility && not possibly_cofix then
     let indexes = Array.of_list (List.map List.hd possible_fix_indices) in
     let fix = ((indexes, 0), fixdefs) in
-    try let () = check_fix ?evars ?elim_to env fix in Some indexes
+    try let sigma = check_fix_with_elims env sigma fix in Some (sigma, indexes)
     with reraise ->
       let (e, info) = Exninfo.capture reraise in
       let info = Option.cata (fun loc -> Loc.add_loc info loc) info loc in
@@ -105,7 +105,7 @@ let search_guard ?loc ?evars ?elim_to env {possibly_cofix; possible_fix_indices}
     if zero_fix_possibility && possibly_cofix then
       (* Maybe can we skip this check since it will be done in the kernel again *)
       let cofix = (0, fixdefs) in
-      try let () = check_cofix ?evars env cofix in None
+      try let () = check_cofix ~evars:(Evd.evar_handler sigma) env cofix in None
       with reraise ->
         let (e, info) = Exninfo.capture reraise in
         let info = Option.cata (fun loc -> Loc.add_loc info loc) info loc in
@@ -127,7 +127,7 @@ let search_guard ?loc ?evars ?elim_to env {possibly_cofix; possible_fix_indices}
                error when totality is assumed but the strutural argument is
                not specified. *)
             try
-              let () = check_fix ?evars ?elim_to env fix in raise (Found (Some indexes))
+              let sigma = check_fix_with_elims env sigma fix in raise (Found (Some (sigma, indexes)))
             with TypeError _ -> ())
           combinations in
        let () =
@@ -139,20 +139,15 @@ let search_guard ?loc ?evars ?elim_to env {possibly_cofix; possible_fix_indices}
        user_err ?loc (Pp.str errmsg)
      with Found indexes -> indexes
 
-let search_fix_guard ?loc ?evars env possible_fix_indices fixdefs =
-  Option.get (search_guard ?loc ?evars env {possibly_cofix=false; possible_fix_indices} fixdefs)
-
 let esearch_guard ?loc env sigma indexes fix =
   (* not sure if we still need to nf_fix when calling search_guard with ~evars
      (here and other callers through the code)
      OTOH search_guard needs to go through the whole term to see possible recursive calls
      so we may as well upfront normalize *)
   let fix = nf_fix sigma fix in
-  let evars = Evd.evar_handler sigma in
-  let elim_to = Inductive.eliminates_to @@ Evd.elim_graph sigma in
-  try search_guard ?loc ~evars ~elim_to env indexes fix
-  with TypeError (env,err) ->
-    Loc.raise ?loc (PretypeError (env,sigma,TypingError (of_type_error err)))
+  try search_guard ?loc env sigma indexes fix
+  with TypeError (env, err) ->
+    Loc.raise ?loc (PretypeError (env, sigma, TypingError (of_type_error err)))
 
 let esearch_fix_guard ?loc env sigma possible_fix_indices fix =
   Option.get (esearch_guard ?loc env sigma {possibly_cofix=false; possible_fix_indices} fix)
@@ -202,29 +197,23 @@ let glob_level ?loc evd : glob_level -> _ = function
          str "polymorphic universe instances must be greater or equal to Set.");
     | Some r -> r
 
-let glob_qvar ?loc evd : glob_qvar -> _ = function
-  | GQVar q -> evd, q
+let glob_quality ?loc evd : glob_quality -> _ = function
+  | GQuality q -> evd, q
   | GLocalQVar {v=Anonymous} ->
     let evd, q = new_quality_variable ?loc evd in
-    evd, q
+    evd, QVar q
   | GRawQVar q ->
     let ctx = (Sorts.QVar.Set.singleton q, Univ.Level.Set.empty), PConstraints.empty in
     let evd = Evd.merge_sort_context_set UState.univ_rigid ~src:UState.Static evd ctx in
-    evd, q
+    evd, QVar q
   | GLocalQVar {v=Name id; loc} ->
-    try evd, (Evd.quality_of_name evd id)
+    try evd, QVar (Evd.quality_of_name evd id)
     with Not_found ->
       if not (is_strict_universe_declarations()) then
         let evd, q = new_quality_variable ?loc evd in
-        evd, q
+        evd, QVar q
       else user_err ?loc Pp.(str "Undeclared quality: " ++ Id.print id ++ str".")
 
-let glob_quality ?loc evd = let open Sorts.Quality in function
-  | GQConstant q -> evd, QConstant q
-  | GQualVar (GQVar _ | GLocalQVar _ | GRawQVar _ as q) ->
-    let evd, q = glob_qvar ?loc evd q in
-    evd, QVar q
-
 type inference_hook = env -> evar_map -> Evar.t -> (evar_map * constr) option
 
 type use_typeclasses = NoUseTC | UseTCForConv | UseTC
@@ -250,15 +239,16 @@ type pretype_flags = {
   unconstrained_sorts : bool;
 }
 
-let glob_opt_qvar ?loc ~flags sigma = function
+let glob_opt_quality ?loc ~flags sigma = function
+  | Some q ->
+    let sigma, q = glob_quality ?loc sigma q in
+    sigma, q
   | None ->
-    if flags.unconstrained_sorts then
+    let collapse_sort_variables = PolyFlags.collapse_sort_variables flags.poly in
+    if flags.unconstrained_sorts || not collapse_sort_variables then
       let sigma, q = new_quality_variable ?loc sigma in
-      sigma, Some q
-    else sigma, None
-  | Some q ->
-    let sigma, q = glob_qvar ?loc sigma q in
-    sigma, Some q
+      sigma, (QVar q)
+    else sigma, Sorts.Quality.qtype
 
 let sort ?loc ~flags sigma (q, l) = match l with
 | UNamed [] -> assert false
@@ -267,7 +257,7 @@ let sort ?loc ~flags sigma (q, l) = match l with
 | UNamed [GSet, 0] when Option.is_empty q -> sigma, ESorts.set
 | UNamed ((u, n) :: us) ->
   let open Pp in
-  let sigma, q = glob_opt_qvar ?loc ~flags sigma q in
+  let sigma, q = glob_opt_quality ?loc ~flags sigma q in
   let get_level sigma u n = match level_name sigma u with
   | None ->
     user_err ?loc
@@ -289,19 +279,13 @@ let sort ?loc ~flags sigma (q, l) = match l with
   in
   let (sigma, u) = get_level sigma u n in
   let (sigma, u) = List.fold_left fold (sigma, u) us in
-  let s = match q with
-    | None -> Sorts.sort_of_univ u
-    | Some q -> Sorts.qsort q u
-  in
+  let s = Sorts.make q u in
   sigma, ESorts.make s
 | UAnonymous {rigid} ->
-  let sigma, q = glob_opt_qvar ?loc ~flags sigma q in
+  let sigma, q = glob_opt_quality ?loc ~flags sigma q in
   let sigma, l = new_univ_level_variable ?loc rigid sigma in
   let u = Univ.Universe.make l in
-  let s = match q with
-    | None -> Sorts.sort_of_univ u
-    | Some q -> Sorts.qsort q u
-  in
+  let s = Sorts.make q u in
   sigma, ESorts.make s
 
 (* Compute the set of still-undefined initial evars up to restriction
@@ -387,10 +371,7 @@ let apply_inference_hook (hook : inference_hook) env sigma frozen = match frozen
 
 let apply_heuristics env sigma =
   (* Resolve eagerly, potentially making wrong choices *)
-  let flags = {
-    (default_flags_of (Conv_oracle.get_transp_state (Environ.oracle env)))
-    with allowed_evars = Evarsolve.allow_all_but_rrpat_evars sigma
-  } in
+  let flags = default_flags_of (Conv_oracle.get_transp_state (Environ.oracle env)) in
   try solve_unif_constraints_with_heuristics ~flags env sigma
   with e when CErrors.noncritical e -> sigma
 
@@ -555,7 +536,7 @@ let pretype_global ?loc rigid env evd gr us =
     | None -> evd, None
     | Some l -> instance ?loc evd l
   in
-  Evd.fresh_global ?loc ~rigid ?names:instance !!env evd gr
+  Evd.fresh_global ?loc ?names:instance !!env evd gr
 
 let pretype_ref ?loc sigma env ref us =
   match ref with
@@ -632,7 +613,7 @@ type pretyper = {
   pretype_rec : pretyper -> glob_fix_kind * Id.t array * glob_decl list array * glob_constr array * glob_constr array -> unsafe_judgment pretype_fun;
   pretype_sort : pretyper -> glob_sort -> unsafe_judgment pretype_fun;
   pretype_hole : pretyper -> Evar_kinds.glob_evar_kind -> unsafe_judgment pretype_fun;
-  pretype_genarg : pretyper -> Genarg.glob_generic_argument -> unsafe_judgment pretype_fun;
+  pretype_genarg : pretyper -> GenConstr.glb -> unsafe_judgment pretype_fun;
   pretype_cast : pretyper -> glob_constr * cast_kind option * glob_constr -> unsafe_judgment pretype_fun;
   pretype_int : pretyper -> Uint63.t -> unsafe_judgment pretype_fun;
   pretype_float : pretyper -> Float64.t -> unsafe_judgment pretype_fun;
@@ -696,14 +677,10 @@ let pretype_instance self ~flags env sigma loc hyps evk update =
     let id = NamedDecl.get_id decl in
     let b = Option.map (replace_vars sigma subst) (NamedDecl.get_value decl) in
     let t = replace_vars sigma subst (NamedDecl.get_type decl) in
-    let uflags = {
-      (default_flags_of TransparentState.full)
-      with allowed_evars = Evarsolve.allow_all_but_rrpat_evars sigma
-    } in
     let check_body sigma id c =
       match b, c with
       | Some b, Some c -> begin
-         try (Evarconv.unify_delay ~flags:uflags !!env sigma b c)
+         try (Evarconv.unify_delay !!env sigma b c)
          with UnableToUnify (sigma, _) ->
            user_err ?loc  (str "Cannot interpret " ++
              pr_existential_key !!env sigma evk ++
@@ -721,7 +698,7 @@ let pretype_instance self ~flags env sigma loc hyps evk update =
              strbrk " should be bound to a local definition.")
       | None, _ -> sigma in
     let check_type sigma id t' =
-      try (Evarconv.unify_delay ~flags:uflags !!env sigma t t')
+      try (Evarconv.unify_delay !!env sigma t t')
       with UnableToUnify (sigma, _) ->
         user_err ?loc  (str "Cannot interpret " ++
           pr_existential_key !!env sigma evk ++
@@ -818,27 +795,26 @@ struct
     let open Context.Rel.Declaration in
     let pretype tycon env sigma c = eval_pretyper self ~flags tycon env sigma c in
     let pretype_type tycon env sigma c = eval_type_pretyper self ~flags tycon env sigma c in
-    let hypnaming = VarSet.variables (Global.env ()) in
     let rec type_bl env sigma ctxt = function
       | [] -> sigma, ctxt
       | (na,_,bk,None,ty)::bl ->
         let sigma, ty' = pretype_type empty_valcon env sigma ty in
         let rty' = ESorts.relevance_of_sort ty'.utj_type in
         let dcl = LocalAssum (make_annot na rty', ty'.utj_val) in
-        let dcl', env = push_rel ~hypnaming sigma dcl env in
+        let dcl', env = push_rel sigma dcl env in
         type_bl env sigma (Context.Rel.add dcl' ctxt) bl
       | (na,_,bk,Some bd,ty)::bl ->
         let sigma, ty' = pretype_type empty_valcon env sigma ty in
         let rty' = ESorts.relevance_of_sort ty'.utj_type in
         let sigma, bd' = pretype (mk_tycon ty'.utj_val) env sigma bd in
         let dcl = LocalDef (make_annot na rty', bd'.uj_val, ty'.utj_val) in
-        let dcl', env = push_rel ~hypnaming sigma dcl env in
+        let dcl', env = push_rel sigma dcl env in
         type_bl env sigma (Context.Rel.add dcl' ctxt) bl in
     let sigma, ctxtv = Array.fold_left_map (fun sigma -> type_bl env sigma Context.Rel.empty) sigma bl in
     let sigma, larj =
       Array.fold_left2_map
         (fun sigma e ar ->
-          pretype_type empty_valcon (snd (push_rel_context ~hypnaming sigma e env)) sigma ar)
+          pretype_type empty_valcon (snd (push_rel_context sigma e env)) sigma ar)
         sigma 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
@@ -862,7 +838,7 @@ struct
         names ftys
     in
       (* Note: bodies are not used by push_rec_types, so [||] is safe *)
-    let names,newenv = push_rec_types ~hypnaming sigma (names,ftys) env in
+    let names,newenv = push_rec_types sigma (names,ftys) env in
     let sigma, vdefj =
       Array.fold_left2_map_i
         (fun i sigma ctxt def ->
@@ -871,7 +847,7 @@ struct
            let (ctxt,ty) =
              decompose_prod_n_decls sigma (Context.Rel.length ctxt)
                (lift nbfix ftys.(i)) in
-           let ctxt,nenv = push_rel_context ~hypnaming sigma ctxt newenv in
+           let ctxt,nenv = push_rel_context sigma ctxt newenv in
            let sigma, j = pretype (mk_tycon ty) nenv sigma def in
            sigma, { uj_val = it_mkLambda_or_LetIn j.uj_val ctxt;
                     uj_type = it_mkProd_or_LetIn j.uj_type ctxt })
@@ -880,7 +856,7 @@ struct
       let nf c = nf_evar sigma 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
+      let sigma, fixj = match fixkind with
         | GFix (vn,i) ->
               (* First, let's find the guard indexes. *)
               (* If recursive argument was not given by user, we try all args.
@@ -893,16 +869,16 @@ struct
                              (fun i annot -> match annot with
                              | Some n -> [n]
                              | None -> List.interval 0 (Context.Rel.nhyps ctxtv.(i) - 1))
-           vn)
+          vn)
           in
           let fixdecls = (names,ftys,fdefs) in
-          let indexes = esearch_fix_guard ?loc !!env sigma possible_fix_indices fixdecls in
-          make_judge (mkFix ((indexes,i),fixdecls)) ftys.(i)
+          let sigma, indexes = esearch_fix_guard ?loc !!env sigma possible_fix_indices fixdecls in
+          sigma, make_judge (mkFix ((indexes,i),fixdecls)) ftys.(i)
         | GCoFix i ->
           let fixdecls = (names,ftys,fdefs) in
           let cofix = (i, fixdecls) in
           let () = esearch_cofix_guard ?loc !!env sigma fixdecls in
-          make_judge (mkCoFix cofix) ftys.(i)
+          sigma, make_judge (mkCoFix cofix) ftys.(i)
       in
       discard_trace @@ inh_conv_coerce_to_tycon ?loc ~flags env sigma fixj tycon
 
@@ -920,6 +896,11 @@ struct
         | QConstant QSProp, _ | _, QConstant QSProp -> assert false
         | QConstant QProp, q | q, QConstant QProp -> Some q
         | (QConstant QType as q), _ | _, (QConstant QType as q) -> Some q
+        | QGlobal a', QGlobal b' ->
+          (* XXX error since cannot be above prop? *)
+          if Sorts.QGlobal.equal a' b' then Some a
+          else None
+        | QGlobal _, _ | _, QGlobal _ -> None
         | QVar a', QVar b' ->
           if Sorts.QVar.equal a' b' then Some a
           else None
@@ -968,10 +949,7 @@ struct
     let usubst = match ubind with
       | None -> usubst
       | Some ubind ->
-        let u = match s with
-          | SProp | Prop | Set -> Univ.Universe.type0
-          | Type u | QSort (_,u) -> u
-        in
+        let u = Sorts.univ_of_sort s in
         Int.Map.update ubind (function
             | None -> Some u
             | Some _ ->
@@ -1005,7 +983,10 @@ struct
     | Type _ ->
       let sigma, u = Evd.new_univ_level_variable UState.univ_flexible_alg sigma in
       sigma, ESorts.make (Sorts.sort_of_univ (Univ.Universe.make u))
-    | QSort (q,u) ->
+    | GSort (q, _) ->
+      let sigma, u = Evd.new_univ_level_variable UState.univ_flexible_alg sigma in
+      sigma, ESorts.make (Sorts.gsort q (Univ.Universe.make u))
+    | VSort (q,u) ->
       let sigma, q = match Sorts.QVar.var_index q with
         | None -> sigma, q
         | Some _ ->
@@ -1019,7 +1000,7 @@ struct
           let sigma, u = Evd.new_univ_level_variable UState.univ_flexible_alg sigma in
           sigma, Univ.Universe.make u
       in
-      sigma, ESorts.make @@ Sorts.qsort q u
+      sigma, ESorts.make @@ Sorts.vsort q u
 
   let rec apply_template pretype_arg arg_state env sigma body subst boundus todoargs typ =
     let open TemplateArity in
@@ -1059,6 +1040,10 @@ struct
   let pretype_app self (f, args) =
     fun ?loc ~flags tycon env sigma ->
     let pretype tycon env sigma c = eval_pretyper self ~flags tycon env sigma c in
+    if CList.is_empty args then
+      (* "@foo" produces "GApp (foo, [])" *)
+      pretype tycon env sigma f
+    else
     let sigma, fj = pretype empty_tycon env sigma f in
     let floc = loc_of_glob_constr f in
     let length = List.length args in
@@ -1265,8 +1250,7 @@ struct
     let sigma, j = eval_type_pretyper self ~flags dom_valcon env sigma c1 in
     let name = {binder_name=name; binder_relevance=ESorts.relevance_of_sort j.utj_type} in
     let var = LocalAssum (name, j.utj_val) in
-    let hypnaming = VarSet.variables (Global.env ()) in
-    let var',env' = push_rel ~hypnaming sigma var env in
+    let var',env' = push_rel sigma var env in
     let sigma, j' = eval_pretyper self ~flags rng env' sigma c2 in
     let name = get_name var' in
     let resj = judge_of_abstraction !!env sigma (orelse_name name name') j j' in
@@ -1277,7 +1261,6 @@ struct
     let open Context.Rel.Declaration in
     let pretype_type tycon env sigma c = eval_type_pretyper self ~flags tycon env sigma c in
     let sigma, j = pretype_type empty_valcon env sigma c1 in
-    let hypnaming = VarSet.variables (Global.env ()) in
     let sigma, name, j' = match name with
       | Anonymous ->
         let sigma, j = pretype_type empty_valcon env sigma c2 in
@@ -1285,7 +1268,7 @@ struct
       | Name _ ->
         let r = ESorts.relevance_of_sort j.utj_type in
         let var = LocalAssum (make_annot name r, j.utj_val) in
-        let var, env' = push_rel ~hypnaming sigma var env in
+        let var, env' = push_rel sigma var env in
         let sigma, c2_j = pretype_type empty_valcon env' sigma c2 in
         sigma, get_name var, c2_j
     in
@@ -1311,13 +1294,12 @@ struct
       | None ->
         sigma, empty_tycon in
     let sigma, j = pretype tycon1 env sigma c1 in
-    let sigma, t = Evarsolve.refresh_universes ~allowed_evars:(Evarsolve.allow_all_but_rrpat_evars sigma)
+    let sigma, t = Evarsolve.refresh_universes
       ~onlyalg:true ~status:Evd.univ_flexible (Some false) !!env sigma j.uj_type in
     let r = Retyping.relevance_of_term !!env sigma j.uj_val in
     let var = LocalDef (make_annot name r, j.uj_val, t) in
     let tycon = lift_tycon 1 tycon in
-    let hypnaming = VarSet.variables (Global.env ()) in
-    let var, env = push_rel ~hypnaming sigma var env in
+    let var, env = push_rel sigma var env in
     let sigma, j' = pretype tycon env sigma c2 in
     let name = get_name var in
     sigma, { uj_val = mkLetIn (make_annot name r, j.uj_val, t, j'.uj_val) ;
@@ -1362,8 +1344,7 @@ struct
           | _ -> assert false
         in aux 1 1 (List.rev nal) cs.cs_args, true in
     let fsign = Context.Rel.map (whd_betaiota !!env sigma) fsign in
-    let hypnaming = VarSet.variables (Global.env ()) in
-    let fsign,env_f = push_rel_context ~hypnaming sigma fsign env in
+    let fsign,env_f = push_rel_context sigma fsign env in
     let obj sigma indt rci p v f =
       if not record then
         let f = it_mkLambda_or_LetIn f fsign in
@@ -1380,7 +1361,7 @@ struct
       let psign = LocalAssum (make_annot na indr, indt) :: arsgn in (* For locating names in [po] *)
       let predenv = Cases.make_return_predicate_ltac_lvar env sigma na c cj.uj_val in
       let nar = List.length arsgn in
-      let psign',env_p = push_rel_context ~hypnaming ~force_names:true sigma psign predenv in
+      let psign',env_p = push_rel_context ~force_names:true sigma psign predenv in
           (match po with
           | Some p ->
             let sigma, pj = pretype_type empty_valcon env_p sigma p in
@@ -1431,64 +1412,62 @@ struct
       try find_rectype !!env sigma cj.uj_type
       with Not_found ->
         let cloc = loc_of_glob_constr c in
-          error_case_not_inductive ?loc:cloc !!env sigma cj in
+        error_case_not_inductive ?loc:cloc !!env sigma cj in
     let cstrs = get_constructors !!env indf in
-      if not (Int.equal (Array.length cstrs) 2) then
-        user_err ?loc
-                      (str "If is only for inductive types with two constructors.");
-
-      let arsgn, indr =
-        let arsgn = get_arity !!env indf in
-        (* Make dependencies from arity signature impossible *)
-        List.map (set_name Anonymous) arsgn, Inductiveops.relevance_of_inductive_family !!env indf
-      in
-      let nar = List.length arsgn in
-      let indt = build_dependent_inductive !!env indf in
-      let psign = LocalAssum (make_annot na indr, indt) :: arsgn in (* For locating names in [po] *)
-      let predenv = Cases.make_return_predicate_ltac_lvar env sigma na c cj.uj_val in
-      let hypnaming = VarSet.variables (Global.env ()) in
-      let psign,env_p = push_rel_context ~hypnaming sigma psign predenv in
-      let sigma, pred, p = match po with
-        | Some p ->
-          let sigma, pj = eval_type_pretyper self ~flags empty_valcon env_p sigma p in
-          let ccl = nf_evar sigma pj.utj_val in
-          let pred = it_mkLambda_or_LetIn ccl psign in
-          let typ = lift (- nar) (beta_applist sigma (pred,[cj.uj_val])) in
-          sigma, pred, typ
-        | None ->
-          let sigma, p = match tycon with
-            | Some ty -> sigma, ty
-            | None -> new_type_evar env sigma ~src:(loc,Evar_kinds.CasesType false)
-          in
-          sigma, it_mkLambda_or_LetIn (lift (nar+1) p) psign, p in
-      let pred = nf_evar sigma pred in
-      let p = nf_evar sigma p in
-      let f sigma 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 sigma (pi, [build_dependent_constructor cs]) in
-        let cs_args = cs.cs_args in
-        let cs_args = Context.Rel.map (whd_betaiota !!env sigma) cs_args in
-        let csgn =
-          List.map (set_name Anonymous) cs_args
+    let () = if not (Int.equal (Array.length cstrs) 2) then
+        CErrors.user_err ?loc (str "If is only for inductive types with two constructors.")
+    in
+    let arsgn, indr =
+      let arsgn = get_arity !!env indf in
+      (* Make dependencies from arity signature impossible *)
+      List.map (set_name Anonymous) arsgn, Inductiveops.relevance_of_inductive_family !!env indf
+    in
+    let nar = List.length arsgn in
+    let indt = build_dependent_inductive !!env indf in
+    let psign = LocalAssum (make_annot na indr, indt) :: arsgn in (* For locating names in [po] *)
+    let predenv = Cases.make_return_predicate_ltac_lvar env sigma na c cj.uj_val in
+    let psign,env_p = push_rel_context sigma psign predenv in
+    let sigma, pred, p = match po with
+      | Some p ->
+        let sigma, pj = eval_type_pretyper self ~flags empty_valcon env_p sigma p in
+        let ccl = nf_evar sigma pj.utj_val in
+        let pred = it_mkLambda_or_LetIn ccl psign in
+        let typ = lift (- nar) (beta_applist sigma (pred,[cj.uj_val])) in
+        sigma, pred, typ
+      | None ->
+        let sigma, p = match tycon with
+          | Some ty -> sigma, ty
+          | None -> new_type_evar env sigma ~src:(loc,Evar_kinds.CasesType false)
         in
-        let _,env_c = push_rel_context ~hypnaming sigma csgn env in
-        let sigma, bj = pretype (mk_tycon pi) env_c sigma b in
-        sigma, it_mkLambda_or_LetIn bj.uj_val cs_args in
-      let sigma, b1 = f sigma cstrs.(0) b1 in
-      let sigma, b2 = f sigma cstrs.(1) b2 in
-      let sigma, v =
-        let ind,_ = dest_ind_family indf in
-        let pred = nf_evar sigma pred in
-        let sigma, rci = Typing.check_allowed_sort !!env sigma ind cj.uj_val pred in
-        let ci = make_case_info !!env (fst ind) IfStyle in
-        sigma, mkCase (EConstr.contract_case !!env sigma
-                  (ci, (pred,rci),
-                   make_case_invert !!env sigma indty ~case_relevance:rci ci, cj.uj_val,
-                   [|b1;b2|]))
+        sigma, it_mkLambda_or_LetIn (lift (nar+1) p) psign, p in
+    let pred = nf_evar sigma pred in
+    let p = nf_evar sigma p in
+    let f sigma 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 sigma (pi, [build_dependent_constructor cs]) in
+      let cs_args = cs.cs_args in
+      let cs_args = Context.Rel.map (whd_betaiota !!env sigma) cs_args in
+      let csgn =
+        List.map (set_name Anonymous) cs_args
       in
-      let cj = { uj_val = v; uj_type = p } in
-      discard_trace @@ inh_conv_coerce_to_tycon ?loc ~flags env sigma cj tycon
+      let _,env_c = push_rel_context sigma csgn env in
+      let sigma, bj = pretype (mk_tycon pi) env_c sigma b in
+      sigma, it_mkLambda_or_LetIn bj.uj_val cs_args in
+    let sigma, b1 = f sigma cstrs.(0) b1 in
+    let sigma, b2 = f sigma cstrs.(1) b2 in
+    let sigma, v =
+      let ind,_ = dest_ind_family indf in
+      let pred = nf_evar sigma pred in
+      let sigma, rci = Typing.check_allowed_sort !!env sigma ind cj.uj_val pred in
+      let ci = make_case_info !!env (fst ind) IfStyle in
+      sigma, mkCase (EConstr.contract_case !!env sigma
+                       (ci, (pred,rci),
+                        make_case_invert !!env sigma indty ~case_relevance:rci ci, cj.uj_val,
+                        [|b1;b2|]))
+    in
+    let cj = { uj_val = v; uj_type = p } in
+    discard_trace @@ inh_conv_coerce_to_tycon ?loc ~flags env sigma cj tycon
 
   let pretype_cast self (c, k, t) =
     fun ?loc ~flags tycon env sigma ->
@@ -1690,8 +1669,7 @@ let ise_pretype_gen (flags : inference_flags) env sigma lvar kind c =
       | NoUseTC -> false
       | UseTC | UseTCForConv -> true
   } in
-  let hypnaming = VarSet.variables (Global.env ()) in
-  let env = GlobEnv.make ~hypnaming env sigma lvar in
+  let env = GlobEnv.make env sigma lvar in
   let sigma', c', c'_ty = match kind with
     | WithoutTypeConstraint ->
       let sigma, j = pretype ~flags:pretype_flags empty_tycon env sigma c in
diff --git a/pretyping/pretyping.mli b/pretyping/pretyping.mli
index edb3f46f0be5..5c5766f6a061 100644
--- a/pretyping/pretyping.mli
+++ b/pretyping/pretyping.mli
@@ -42,23 +42,20 @@ type possible_guard = {
 } (* Note: if no fix indices are given, it has to be a cofix *)
 
 val search_guard :
-  ?loc:Loc.t -> ?evars:CClosure.evar_handler ->
-  ?elim_to:(Sorts.Quality.t -> Sorts.Quality.t -> bool) -> env ->
-  possible_guard -> Constr.rec_declaration -> int array option
-
-val search_fix_guard : (* For Fixpoints only *)
-  ?loc:Loc.t -> ?evars:CClosure.evar_handler -> env ->
-  possible_fix_indices -> Constr.rec_declaration -> int array
+  ?loc:Loc.t -> env -> evar_map ->
+  possible_guard -> Constr.rec_declaration -> (evar_map * int array) option
 
 val esearch_guard :
   ?loc:Loc.t -> env -> evar_map -> possible_guard ->
-  EConstr.rec_declaration -> int array option
+  EConstr.rec_declaration -> (evar_map * int array) option
 
 val esearch_fix_guard : (* For Fixpoints only *)
   ?loc:Loc.t -> env -> evar_map -> possible_fix_indices ->
-  EConstr.rec_declaration -> int array
+  EConstr.rec_declaration -> evar_map * int array
 
-val esearch_cofix_guard : ?loc:Loc.t -> env -> evar_map -> EConstr.rec_declaration -> unit
+val esearch_cofix_guard :
+  ?loc:Loc.t -> env -> evar_map ->
+  EConstr.rec_declaration -> unit
 
 type typing_constraint =
   | IsType (** Necessarily a type *)
@@ -202,7 +199,7 @@ type pretyper = {
   pretype_rec : pretyper -> glob_fix_kind * Id.t array * glob_decl list array * glob_constr array * glob_constr array -> unsafe_judgment pretype_fun;
   pretype_sort : pretyper -> glob_sort -> unsafe_judgment pretype_fun;
   pretype_hole : pretyper -> Evar_kinds.glob_evar_kind -> unsafe_judgment pretype_fun;
-  pretype_genarg : pretyper -> Genarg.glob_generic_argument -> unsafe_judgment pretype_fun;
+  pretype_genarg : pretyper -> GenConstr.glb -> unsafe_judgment pretype_fun;
   pretype_cast : pretyper -> glob_constr * Constr.cast_kind option * glob_constr -> unsafe_judgment pretype_fun;
   pretype_int : pretyper -> Uint63.t -> unsafe_judgment pretype_fun;
   pretype_float : pretyper -> Float64.t -> unsafe_judgment pretype_fun;
diff --git a/pretyping/printingFlags.ml b/pretyping/printingFlags.ml
index 1e1bc120e832..ea2bfa5cbb96 100644
--- a/pretyping/printingFlags.ml
+++ b/pretyping/printingFlags.ml
@@ -94,6 +94,9 @@ let { Goptions.get = print_relevances } =
     ~value:false
     ()
 
+(* detyping *)
+let always_print_regular_match_style = make_flag ["Printing";"Regular";"Matches"] false
+
 (* detyping.ml but extern time *)
 let { Goptions.get = print_factorize_match_patterns } =
   Goptions.declare_bool_option_and_ref
@@ -160,6 +163,11 @@ let { Goptions.get = print_float } =
     ~value:true
     ()
 
+(* extern (option handled by topfmt) *)
+let extern_depth = ref None
+let set_extern_depth d = extern_depth := d
+let extern_depth() = !extern_depth
+
 module PrintingInductiveMake (Test : sig
     val encode : Environ.env -> Libnames.qualid -> Names.inductive
     val member_message : Pp.t -> bool -> Pp.t
@@ -248,9 +256,9 @@ module Detype = struct
     primproj_params = print_primproj_params();
     unfolded_primproj_as_match = print_unfolded_primproj_asmatch();
     match_paramunivs = print_match_paramunivs();
+    always_regular_match_style = !always_print_regular_match_style;
 
     (* not yet exposed (except through Printing All) *)
-    always_regular_match_style = false;
     nonpropositional_letin_types = false;
   }
 
@@ -336,7 +344,7 @@ module Extern = struct
     projections : bool;
     float : bool;
     factorize_eqns : FactorizeEqns.t;
-    (* XXX depth? *)
+    depth : int option;
   }
 
   let current_ignore_raw () = {
@@ -352,6 +360,7 @@ module Extern = struct
     projections = !print_projections;
     float = print_float();
     factorize_eqns = FactorizeEqns.current_ignore_raw();
+    depth = extern_depth();
   }
 
   let make_raw flags = {
diff --git a/pretyping/printingFlags.mli b/pretyping/printingFlags.mli
index 8487fc6a99f1..4b7c7f2efb57 100644
--- a/pretyping/printingFlags.mli
+++ b/pretyping/printingFlags.mli
@@ -89,7 +89,8 @@ module Extern : sig
     projections : bool;
     float : bool;
     factorize_eqns : FactorizeEqns.t;
-    (* XXX depth? *)
+    (* None = unlimited *)
+    depth : int option;
   }
 
   val make_raw : t -> t
@@ -123,3 +124,5 @@ module PrintingInductiveMake (_ : sig
   : Goptions.RefConvertArg
     with type t = Names.inductive
      and module Set = Names.Indset_env
+
+val set_extern_depth : int option -> unit
diff --git a/pretyping/reductionops.ml b/pretyping/reductionops.ml
index 12919597452e..d9eb60aeffc0 100644
--- a/pretyping/reductionops.ml
+++ b/pretyping/reductionops.ml
@@ -88,19 +88,20 @@ module ReductionBehaviour = struct
     | UnfoldWhen x -> UnfoldWhen (more_args_when k x)
     | UnfoldWhenNoMatch x -> UnfoldWhenNoMatch (more_args_when k x)
 
-  type table = Cpred.t * t Cmap.t
+  type table = Cpred.t * t QConstant.Map.t
 
 (* We need to have a fast way to know the set of all constants that
   have the NeverUnfold flag.  Therefore, the table has a distinct subpart
   that is this set. *)
   let table =
-    Summary.ref ((Cpred.empty, Cmap.empty)) ~name:"reductionbehaviour"
+    Summary.ref ((Cpred.empty, QConstant.Map.empty)) ~name:"reductionbehaviour"
 
   let load _ (_,(r, b)) =
+    let env = Global.env () in
     table := (match b with
-                | None -> Cpred.remove r (fst !table), Cmap.remove r (snd !table)
-                | Some NeverUnfold -> Cpred.add r (fst !table), Cmap.remove r (snd !table)
-                | Some b -> Cpred.remove r (fst !table), Cmap.add r b (snd !table))
+                | None -> Cpred.remove r (fst !table), QConstant.Map.remove env r (snd !table)
+                | Some NeverUnfold -> Cpred.add r (fst !table), QConstant.Map.remove env r (snd !table)
+                | Some b -> Cpred.remove r (fst !table), QConstant.Map.add env r b (snd !table))
 
   let cache o = load 1 o
 
@@ -139,7 +140,7 @@ module ReductionBehaviour = struct
     if Cpred.mem r (fst table) then
       Some NeverUnfold
     else
-      Cmap.find_opt r (snd table)
+      QConstant.Map.find_opt (Global.env ()) r (snd table)
 
   let print_from_db table ref =
     let open Pp in
@@ -178,7 +179,7 @@ module ReductionBehaviour = struct
   module Db = struct
     type t = table
     let get () = !table
-    let empty = (Cpred.empty, Cmap.empty)
+    let empty = (Cpred.empty, QConstant.Map.empty)
     let print = print_from_db
     let all_never_unfold table = fst table
   end
@@ -564,7 +565,7 @@ struct
   let get_parray evd e =
     match EConstr.kind evd e with
     | Array(_u,t,def,_ty) -> Parray.of_array t def
-    | _ -> raise Not_found
+    | _ -> raise Primred.NativeDestKO
 
   let mkInt env i =
     mkInt i
@@ -852,7 +853,7 @@ let rec whd_state_gen flags ?metas env sigma =
       | None -> fold ())
     | Const (c,u as const) ->
       reduction_effect_hook env sigma c
-         (lazy (EConstr.to_constr sigma (Stack.zip sigma (x,fst (Stack.strip_app stack)))));
+         (lazy (Stack.zip sigma (x,fst (Stack.strip_app stack))));
       if RedFlags.red_set flags (RedFlags.fCONST c) then
        match constant_value_in env sigma (c, u) with
        | body ->
@@ -1146,7 +1147,8 @@ let clos_norm_flags flgs env sigma t =
       (CClosure.create_tab ())
       (Esubst.subs_id 0, UVars.Instance.empty) (EConstr.Unsafe.to_constr t))
   with e when is_sync_anomaly e ->
-    user_err Pp.(str "Tried to normalize ill-typed term")
+    let _, info = Exninfo.capture e in
+    user_err ~info Pp.(str "Tried to normalize ill-typed term")
 
 let clos_whd_flags flgs env sigma t =
   try
@@ -1155,7 +1157,8 @@ let clos_whd_flags flgs env sigma t =
       (CClosure.create_tab ())
       (CClosure.inject (EConstr.Unsafe.to_constr t)))
   with e when is_sync_anomaly e ->
-    user_err Pp.(str "Tried to normalize ill-typed term")
+    let _, info = Exninfo.capture e in
+    user_err ~info Pp.(str "Tried to normalize ill-typed term")
 
 let nf_beta = clos_norm_flags RedFlags.beta
 let nf_betaiota = clos_norm_flags RedFlags.betaiota
@@ -1266,6 +1269,30 @@ let is_conv ?(reds=TransparentState.full) env sigma x y =
 let is_conv_leq ?(reds=TransparentState.full) env sigma x y =
   is_fconv ~reds Conversion.CUMUL env sigma x y
 
+let is_conv_nounivs ?(reds=TransparentState.full) env sigma t1 t2 =
+  if EConstr.eq_constr_nounivs sigma t1 t2 then true
+  else
+    let evars = Evd.evar_handler sigma in
+    let t1 = EConstr.Unsafe.to_constr t1 in
+    let t2 = EConstr.Unsafe.to_constr t2 in
+    try
+      let env = Environ.set_universes (Evd.universes sigma) env in
+      let ignore_univs = let open Conversion in {
+        compare_sorts = (fun _ _ _ () -> Ok ());
+        compare_instances = (fun ~flex:_ _ _ () -> Ok ());
+        compare_cumul_instances = (fun _ _ _ _ () -> Ok ());
+      }
+      in
+      begin match Conversion.generic_conv ~l2r:false CONV ~evars reds env ((), ignore_univs) t1 t2 with
+      | Result.Ok () -> true
+      | Result.Error None -> false
+      | Result.Error (Some e) -> Empty.abort e
+      end
+    with
+    | e ->
+      let e = Exninfo.capture e in
+      report_anomaly e
+
 let sigma_compare_sorts pb s0 s1 sigma =
   match pb with
   | Conversion.CONV ->
@@ -1372,34 +1399,6 @@ let infer_conv_gen conv_fun ?(catch_incon=true) ?(pb=Conversion.CUMUL)
 let infer_conv = infer_conv_gen { genconv = fun pb ~l2r sigma ->
       Conversion.generic_conv pb ~l2r ~evars:(Evd.evar_handler sigma) }
 
-let infer_conv_ustate ?(catch_incon=true) ?(pb=Conversion.CUMUL)
-    ?(ts=TransparentState.full) env sigma x y =
-  try
-      let ans = match pb with
-      | Conversion.CUMUL ->
-          EConstr.leq_constr_universes env sigma x y
-      | Conversion.CONV ->
-          EConstr.eq_constr_universes env sigma x y
-      in
-      match ans with
-      | Some cstr -> Some cstr
-      | None ->
-        let x = EConstr.Unsafe.to_constr x in
-        let y = EConstr.Unsafe.to_constr y in
-        let env = Environ.set_universes (Evd.universes sigma) env in
-        match
-          Conversion.generic_conv pb ~l2r:false ~evars:(Evd.evar_handler sigma) ts
-            env (UnivProblem.Set.empty, univproblem_univ_state) x y
-        with
-        | Result.Ok cstr -> Some cstr
-        | Result.Error None -> None
-        | Result.Error (Some e) -> raise (UGraph.UniverseInconsistency e)
-  with
-  | UGraph.UniverseInconsistency _ when catch_incon -> None
-  | e ->
-    let e = Exninfo.capture e in
-    report_anomaly e
-
 let evars_of_evar_map sigma =
   { Genlambda.evars_val = Evd.evar_handler sigma }
 
@@ -1415,11 +1414,6 @@ let native_infer_conv ?(pb=Conversion.CUMUL) env sigma t1 t2 =
   infer_conv_gen { genconv = fun pb ~l2r sigma ts -> native_conv_generic pb sigma }
     ~catch_incon:true ~pb env sigma t1 t2
 
-let check_hyps_inclusion env sigma x hyps =
-  let env = Environ.set_universes (Evd.universes sigma) env in
-  let evars = Evd.evar_handler sigma in
-  Typeops.check_hyps_inclusion env ~evars x hyps
-
 (********************************************************************)
 (*             Special-Purpose Reduction                            *)
 (********************************************************************)
@@ -1672,54 +1666,20 @@ module Infer = struct
 
 open Sorts
 
-let get_algebraic = function
-| Prop | SProp -> assert false
-| Set -> Universe.type0
-| QSort (_, u) | Type u -> u
-
-let is_impredicative_sort = function
-| Prop | SProp -> true
-| _ -> false
-(* Only used for universe level comparisons, so impredicative set is still fine *)
-
-let enforce_eq_sort s1 s2 (qcsts, ucsts as cst) = match s1, s2 with
-| QSort (q1, u1), s2 ->
-  let q2 = quality s2 in
-  let qcsts = UVars.QPairSet.add (QVar q1, q2) qcsts in
-  let ucsts = if is_impredicative_sort s2 then ucsts else UnivSubst.enforce_eq u1 (get_algebraic s2) ucsts in
-  (qcsts, ucsts)
-| s1, QSort (q2, u2) ->
-  let q1 = quality s1 in
-  let qcsts = UVars.QPairSet.add (q1, QVar q2) qcsts in
-  let ucsts = if is_impredicative_sort s2 then ucsts else UnivSubst.enforce_eq (get_algebraic s1) u2 ucsts in
-  (qcsts, ucsts)
-| (SProp, SProp) | (Prop, Prop) | (Set, Set) -> cst
-| (((Prop | Set | Type _) as s1), (Prop | SProp as s2))
-| ((Prop | SProp as s1), ((Prop | Set | Type _) as s2)) ->
-  raise (UGraph.UniverseInconsistency (None, (Eq, s1, s2, None)))
-| (Set | Type _), (Set | Type _) ->
-  let ucsts' = UnivSubst.enforce_eq (get_algebraic s1) (get_algebraic s2) ucsts in
-  if ucsts == ucsts' then cst else (qcsts, ucsts')
-
-let enforce_leq_alg_sort s1 s2 g = match s1, s2 with
-| QSort (q1, u1), s2 ->
-  let q2 = quality s2 in
-  let qcsts = UVars.QPairSet.singleton (QVar q1, q2) in
-  let ucsts, g = if is_impredicative_sort s2 then UnivConstraints.empty, g else UGraph.enforce_leq_alg u1 (get_algebraic s2) g in
-  (qcsts, ucsts), g
-| s1, QSort (q2, u2) ->
-  let q1 = quality s1 in
-  let qcsts = UVars.QPairSet.singleton (q1, QVar q2) in
-  let ucsts, g = if is_impredicative_sort s2 then UnivConstraints.empty, g else UGraph.enforce_leq_alg (get_algebraic s1) u2 g  in
-  (qcsts, ucsts), g
-| (SProp, SProp) | (Prop, Prop) | (Set, Set) -> (UVars.QPairSet.empty, Univ.UnivConstraints.empty), g
-| (Prop, (Set | Type _)) -> (UVars.QPairSet.empty, Univ.UnivConstraints.empty), g
-| (((Prop | Set | Type _) as s1), (Prop | SProp as s2))
-| ((SProp as s1), ((Prop | Set | Type _) as s2)) ->
-  raise (UGraph.UniverseInconsistency (None, (Le, s1, s2, None)))
-| (Set | Type _), (Set | Type _) ->
-  let ucsts, g = UGraph.enforce_leq_alg (get_algebraic s1) (get_algebraic s2) g in
-  (UVars.QPairSet.empty, ucsts), g
+let enforce_eq_sort s1 s2 ucsts =
+  if Sorts.Quality.equal (Sorts.quality s1) (Sorts.quality s2) then
+    UnivSubst.enforce_eq (Sorts.univ_of_sort s1) (Sorts.univ_of_sort s2) ucsts
+  else
+    raise (UGraph.UniverseInconsistency (None, (Eq, s1, s2, None)))
+
+let enforce_leq_alg_sort s1 s2 g =
+  match s1, s2 with
+  | Prop, (Set | Type _) -> Univ.UnivConstraints.empty, g
+  | _ ->
+  if Sorts.Quality.equal (Sorts.quality s1) (Sorts.quality s2) then
+    UGraph.enforce_leq_alg (Sorts.univ_of_sort s1) (Sorts.univ_of_sort s2) g
+  else
+    raise (UGraph.UniverseInconsistency (None, (Le, s1, s2, None)))
 
 open Conversion
 
@@ -1730,19 +1690,14 @@ let check_eq_qualities qcst =
 let infer_eq (univs, cstrs as cuniv) s s' =
   if UGraph.check_eq_sort Sorts.Quality.equal univs s s' then Result.Ok cuniv
   else try
-    let qcsts', ucstrs' as cstrs' = enforce_eq_sort s s' (UVars.QPairSet.empty, Univ.UnivConstraints.empty) in
-    if check_eq_qualities qcsts' then
-      Result.Ok (UGraph.merge_constraints ucstrs' univs, UnivConstraints.union cstrs ucstrs')
-    else Result.Error None
+    let ucstrs' = enforce_eq_sort s s' Univ.UnivConstraints.empty in
+    Result.Ok (UGraph.merge_constraints ucstrs' univs, UnivConstraints.union cstrs ucstrs')
   with UGraph.UniverseInconsistency err -> Result.Error (Some (Univ err))
 
 let infer_leq (univs, cstrs as cuniv) s s' =
   if UGraph.check_leq_sort Sorts.Quality.equal univs s s' then Result.Ok cuniv
   else match enforce_leq_alg_sort s s' univs with
-  | (qcsts, ucsts), ugraph ->
-    if check_eq_qualities qcsts then
-      Result.Ok (univs, UnivConstraints.union cstrs ucsts)
-    else Result.Error None
+  | ucsts, ugraph -> Result.Ok (univs, UnivConstraints.union cstrs ucsts)
   | exception UGraph.UniverseInconsistency err -> Result.Error (Some (Univ err))
 
 let infer_cmp_universes pb s0 s1 cuniv =
diff --git a/pretyping/reductionops.mli b/pretyping/reductionops.mli
index fe05059bee68..8e7f6a4e3b27 100644
--- a/pretyping/reductionops.mli
+++ b/pretyping/reductionops.mli
@@ -54,14 +54,14 @@ 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
+  (Environ.env -> Evd.evar_map -> EConstr.constr -> unit) -> unit
 
 (* [set_reduction_effect local cst name] declares effect [name] to be called when [cst] is found *)
 val set_reduction_effect : Libobject.locality -> Constant.t -> 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 -> Constant.t ->
-  Constr.constr Lazy.t -> unit
+  EConstr.constr Lazy.t -> unit
 
 module Stack : sig
   type app_node
@@ -255,6 +255,8 @@ val is_conv : ?reds:TransparentState.t -> env -> evar_map -> constr -> constr ->
 val is_conv_leq : ?reds:TransparentState.t -> env -> evar_map -> constr -> constr -> bool
 val is_fconv : ?reds:TransparentState.t -> conv_pb -> env -> evar_map -> constr -> constr -> bool
 
+val is_conv_nounivs : ?reds:TransparentState.t -> env -> evar_map -> constr -> constr -> bool
+
 (** [infer_conv] Adds necessary universe constraints to the evar map.
     pb defaults to CUMUL and ts to a full transparent state.
     @raise UniverseInconsistency iff catch_incon is set to false,
@@ -263,9 +265,6 @@ val is_fconv : ?reds:TransparentState.t -> conv_pb -> env -> evar_map -> constr
 val infer_conv : ?catch_incon:bool -> ?pb:conv_pb -> ?ts:TransparentState.t ->
   env -> evar_map -> constr -> constr -> evar_map option
 
-val infer_conv_ustate : ?catch_incon:bool -> ?pb:conv_pb -> ?ts:TransparentState.t ->
-  env -> evar_map -> constr -> constr -> UnivProblem.Set.t option
-
 (** Conversion with inference of universe constraints *)
 val vm_infer_conv : ?pb:conv_pb -> env -> evar_map -> constr -> constr ->
   evar_map option
@@ -284,9 +283,6 @@ val infer_conv_gen : genconv ->
   ?catch_incon:bool -> ?pb:conv_pb -> ?ts:TransparentState.t -> env ->
   evar_map -> constr -> constr -> evar_map option
 
-val check_hyps_inclusion : env -> evar_map -> GlobRef.t -> Constr.named_context -> unit
-(** [Typeops.check_hyps_inclusion] but handles evars in the environment. *)
-
 (** {6 Heuristic for Conversion with Evar } *)
 
 type state = constr * Stack.t
diff --git a/pretyping/retyping.ml b/pretyping/retyping.ml
index 89532ca0ec26..b4c48b0992e6 100644
--- a/pretyping/retyping.ml
+++ b/pretyping/retyping.ml
@@ -56,7 +56,9 @@ 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 ++ str ".")
+ with RetypeError e as exn ->
+  let _, info = Exninfo.capture exn in
+  anomaly ~label:"retyping" ~info (print_retype_error e ++ str ".")
 
 let get_type_from_constraints env sigma t =
   if isEvar sigma (fst (decompose_app sigma t)) then
@@ -134,7 +136,7 @@ let betazetaevar_applist sigma n c l =
 
 let type_of_constant env sigma (c,u) =
   let cb = lookup_constant env sigma c in
-  let () = check_hyps_inclusion env sigma (GlobRef.ConstRef c) cb.const_hyps in
+  let () = check_hyps_inclusion env (GlobRef.ConstRef c) cb.const_hyps in
   let ty = CVars.subst_instance_constr (EConstr.Unsafe.to_instance u) cb.const_type in
   EConstr.of_constr (rename_type env ty (GlobRef.ConstRef c))
 
@@ -168,10 +170,7 @@ let bind_template bind_sort s (qsubst,usubst) =
   let usubst = match ubind with
     | None -> usubst
     | Some ubind ->
-      let u = match s with
-        | SProp | Prop | Set -> Univ.Universe.type0
-        | Type u | QSort (_,u) -> u
-      in
+      let u = Sorts.univ_of_sort s in
       Int.Map.update ubind (function
           | None -> Some u
           | Some _ ->
@@ -285,10 +284,8 @@ let retype ?metas ?(polyprop=true) sigma =
     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
-      | SProp | Prop | Set -> ESorts.type1
-      | Type u | QSort (_, u) -> ESorts.make (Sorts.sort_of_univ (Univ.Universe.super u))
-      end
+      let u = Sorts.univ_of_sort @@ ESorts.kind sigma s in
+      ESorts.make (Sorts.sort_of_univ (Univ.Universe.super u))
     | Prod (name,t,c2) ->
       let dom = sort_of env t in
       let rang = sort_of (push_rel (LocalAssum (name,t)) env) c2 in
@@ -342,7 +339,7 @@ let retype ?metas ?(polyprop=true) sigma =
 
   in type_of, sort_of, type_of_global_reference_knowing_parameters
 
-let get_sort_quality_of ?(polyprop=true) env sigma t =
+let get_sort_quality_or_set_of ?(polyprop=true) env sigma t =
   let type_of,_,type_of_global_reference_knowing_parameters = retype ~polyprop sigma in
   let rec sort_quality_of env t =
     let open UnivGen in
@@ -364,6 +361,9 @@ let get_sort_quality_of ?(polyprop=true) env sigma t =
       ESorts.quality_or_set sigma (decomp_sort env sigma (type_of env t))
   in sort_quality_of env t
 
+let get_sort_quality_of ?polyprop env sigma t =
+  UnivGen.QualityOrSet.quality @@ get_sort_quality_or_set_of ?polyprop env sigma t
+
 let get_sort_of ?(polyprop=true) env sigma t =
   let _,f,_ = retype ~polyprop sigma in anomaly_on_error (f env) t
 let type_of_global_reference_knowing_parameters env sigma c args =
@@ -399,7 +399,7 @@ let reinterpret_get_type_of ~src env sigma c =
 let get_judgment_of env evc c = { uj_val = c; uj_type = get_type_of env evc c }
 
 let get_type_of_constr ?polyprop ?lax env ?(uctx=UState.from_env env) c =
-  EConstr.Unsafe.to_constr (get_type_of ?polyprop ?lax env (Evd.from_ctx uctx) (EConstr.of_constr c))
+  EConstr.Unsafe.to_constr (get_type_of ?polyprop ?lax env (Evd.from_ustate uctx) (EConstr.of_constr c))
 
 (* Returns sorts of a context *)
 let sorts_of_context env evc ctxt =
diff --git a/pretyping/retyping.mli b/pretyping/retyping.mli
index ae2422bcc4e6..7492ef7dc2be 100644
--- a/pretyping/retyping.mli
+++ b/pretyping/retyping.mli
@@ -38,9 +38,12 @@ val get_type_of_constr : ?polyprop:bool -> ?lax:bool
 val get_sort_of :
   ?polyprop:bool -> env -> evar_map -> types -> ESorts.t
 
-val get_sort_quality_of :
+val get_sort_quality_or_set_of :
   ?polyprop:bool -> env -> evar_map -> types -> UnivGen.QualityOrSet.t
 
+val get_sort_quality_of :
+  ?polyprop:bool -> env -> evar_map -> types -> Sorts.Quality.t
+
 (** Makes an unsafe judgment from a constr *)
 val get_judgment_of : env -> evar_map -> constr -> unsafe_judgment
 
diff --git a/pretyping/structures.ml b/pretyping/structures.ml
index a5dfb660ada1..a6d3cf833a2d 100644
--- a/pretyping/structures.ml
+++ b/pretyping/structures.ml
@@ -197,7 +197,7 @@ let print = function
   | Proj_cs p -> Nametab.pr_global_env Id.Set.empty (GlobRef.ConstRef (Names.Projection.Repr.constant p))
   | Prod_cs -> str "forall _, _"
   | Default_cs -> str "_"
-  | Sort_cs s -> UnivGen.QualityOrSet.pr Sorts.QVar.raw_pr s
+  | Sort_cs s -> UnivGen.QualityOrSet.pr Sorts.Quality.raw_printer s
 
 end
 
diff --git a/pretyping/tacred.ml b/pretyping/tacred.ml
index 768e69f2f41f..ecc9e345d719 100644
--- a/pretyping/tacred.ml
+++ b/pretyping/tacred.ml
@@ -75,16 +75,7 @@ let is_evaluable env sigma = function
   | Evaluable.EvalVarRef id -> is_evaluable_var env id
   | Evaluable.EvalProjectionRef p -> is_evaluable_projection env p
 
-let value_of_evaluable_ref env sigma evref u =
-  match evref with
-  | Evaluable.EvalConstRef con ->
-    constant_value_in env sigma (con, u)
-  | Evaluable.EvalVarRef id ->
-    env |> lookup_named id |> NamedDecl.get_value |> Option.get
-  | Evaluable.EvalProjectionRef _ ->
-    assert false (* TODO *)
-
-let soft_evaluable_of_global_reference ?loc = function
+let evaluable_of_global_reference ?loc = function
   | GlobRef.ConstRef cst ->
     begin
       match Structures.PrimitiveProjections.find_opt cst with
@@ -94,15 +85,7 @@ let soft_evaluable_of_global_reference ?loc = function
   | GlobRef.VarRef id -> Evaluable.EvalVarRef id
   | r -> error_not_evaluable ?loc r
 
-let evaluable_of_global_reference env = function
-  | GlobRef.ConstRef cst when not (Environ.mem_constant cst env) || is_evaluable_const env (Evd.from_env env) cst (* FIXME *) ->
-      begin
-        match Structures.PrimitiveProjections.find_opt cst with
-        | None -> Evaluable.EvalConstRef cst
-        | Some p -> Evaluable.EvalProjectionRef p
-      end
-  | GlobRef.VarRef id when is_evaluable_var env id -> Evaluable.EvalVarRef id
-  | r -> error_not_evaluable r
+let soft_evaluable_of_global_reference = evaluable_of_global_reference
 
 let global_of_evaluable_reference = function
   | Evaluable.EvalConstRef cst -> GlobRef.ConstRef cst
@@ -620,7 +603,7 @@ let match_eval_ref env sigma constr stack =
   match EConstr.kind sigma constr with
   | Const (sp, u) ->
     let () = reduction_effect_hook env sigma sp
-        (lazy (EConstr.to_constr sigma (applist (constr,stack)))) in
+        (lazy (applist (constr,stack))) in
     let cb = lookup_constant env sigma sp in
     begin match cb.const_body with
     | Def _ -> if is_transparent env (Evaluable.EvalConstRef sp) then EvEval (EvalConst sp, u) else EvNone
@@ -637,7 +620,7 @@ let match_eval_ref_value env sigma constr stack =
   match EConstr.kind sigma constr with
   | Const (sp, u) ->
      reduction_effect_hook env sigma sp
-        (lazy (EConstr.to_constr sigma (applist (constr,stack))));
+        (lazy (applist (constr,stack)));
     if is_evaluable env sigma (EvalConstRef sp) then
       Some (constant_value_in env sigma (sp, u))
     else
@@ -1256,24 +1239,26 @@ let contextually byhead occs f env sigma t =
  * n is the number of the next occurrence of name.
  * ol is the occurrence list to find. *)
 
-let match_constr_evaluable_ref env sigma c evref =
+let match_value_constr_evaluable_ref env sigma c evref =
   match EConstr.kind sigma c, evref with
-  | Const (c,u), Evaluable.EvalConstRef c' when QConstant.equal env c c' -> Some u
-  | Proj (p,_,_), Evaluable.EvalProjectionRef p' when QProjection.Repr.equal env (Projection.repr p) p' -> Some EInstance.empty
-  | Var id, Evaluable.EvalVarRef id' when Id.equal id id' -> Some EInstance.empty
+  | Const (c,u), Evaluable.EvalConstRef c' when QConstant.equal env c c' ->
+    Some (lazy (constant_value_in env sigma (c, u)))
+  | Proj (p, r, c), Evaluable.EvalProjectionRef p' when QProjection.Repr.equal env (Projection.repr p) p' ->
+    Some (lazy (mkProj (Projection.unfold p, r, c)))
+  | Var id, Evaluable.EvalVarRef id' when Id.equal id id' ->
+    Some (lazy (env |> lookup_named id |> NamedDecl.get_value |> Option.get))
   | _, _ -> None
 
 let substlin env sigma evalref occs c =
   let count = ref (Locusops.initialize_occurrence_counter occs) in
-  let value u = value_of_evaluable_ref env sigma evalref u in
   let rec substrec () c =
     if Locusops.occurrences_done !count then c
     else
-      match match_constr_evaluable_ref env sigma c evalref with
-      | Some u ->
+      match match_value_constr_evaluable_ref env sigma c evalref with
+      | Some v ->
         let ok, count' = Locusops.update_occurrence_counter !count in
         count := count';
-        if ok then value u else c
+        if ok then Lazy.force v else c
       | None ->
         map_constr_with_binders_left_to_right env sigma
           (fun _ () -> ())
diff --git a/pretyping/tacred.mli b/pretyping/tacred.mli
index a6e4a2e20c6c..11ed06bd8542 100644
--- a/pretyping/tacred.mli
+++ b/pretyping/tacred.mli
@@ -43,13 +43,12 @@ exception NotEvaluableRef of GlobRef.t
 val error_not_evaluable : ?loc:Loc.t -> GlobRef.t -> 'a
 
 val evaluable_of_global_reference :
-  Environ.env -> GlobRef.t -> Evaluable.t
-(** Fails on opaque constants and variables
-    (both those without bodies and those marked Opaque in the conversion oracle). *)
+  ?loc:Loc.t -> GlobRef.t -> Evaluable.t
+(** Succeeds for any constant or variable even if marked opaque or otherwise not evaluable. *)
 
 val soft_evaluable_of_global_reference :
   ?loc:Loc.t -> GlobRef.t -> Evaluable.t
-(** Succeeds for any constant or variable even if marked opaque or otherwise not evaluable. *)
+[@@deprecated "(9.3) Use evaluable_of_global_reference."]
 
 val global_of_evaluable_reference :
   Evaluable.t -> GlobRef.t
diff --git a/pretyping/typing.ml b/pretyping/typing.ml
index 21dd1c9b4e49..69aa7feb35f4 100644
--- a/pretyping/typing.ml
+++ b/pretyping/typing.ml
@@ -27,11 +27,10 @@ open Context.Rel.Declaration
 module GR = Names.GlobRef
 
 let fresh_template_context env0 sigma ind (mib, _ as spec) ?(refresh_all=false) args =
-  let templ = match mib.Declarations.mind_template with
-  | None -> assert false
-  | Some t -> Array.of_list t.template_param_arguments
-  in
-  let ctx = List.rev (EConstr.of_rel_context mib.Declarations.mind_params_ctxt) in
+  let template = Option.get mib.Declarations.mind_template in
+  let templ = Array.of_list template.template_param_arguments in
+  let ctx = CVars.subst_instance_context template.template_defaults mib.Declarations.mind_params_ctxt in
+  let ctx = List.rev (EConstr.of_rel_context ctx) in
   let rec freshen i env sigma accu sorts = function
   | [] -> sigma, List.rev sorts
   | LocalAssum (na, t) as decl :: ctx ->
@@ -58,7 +57,7 @@ let fresh_template_context env0 sigma ind (mib, _ as spec) ?(refresh_all=false)
             args
         | Sorts.Prop -> TemplateProp
         | Sorts.Set -> TemplateUniv Univ.Universe.type0
-        | Sorts.Type u | Sorts.QSort (_, u) -> TemplateUniv u
+        | Sorts.Type u | Sorts.GSort (_, u) | Sorts.VSort (_, u) -> TemplateUniv u
         in
         sigma, LocalAssum (na, t), s
       | None ->
@@ -135,9 +134,10 @@ let judge_of_applied ~check env sigma funj argjv =
   let typ = hnf_prod_appvect env sigma (j_type funj) (Array.map j_val argjv) in
   sigma, { uj_val = (mkApp (j_val funj, Array.map j_val argjv)); uj_type = typ }
 
+(* XXX check_hyps_inclusion should now be cheap enough to always do *)
 let judge_of_applied_inductive_knowing_parameters ~check env sigma (ind, u) argjv =
   let (mib,_ as specif) = Inductive.lookup_mind_specif env ind in
-  let () = if check then Reductionops.check_hyps_inclusion env sigma (GR.IndRef ind) mib.mind_hyps in
+  let () = if check then EConstr.check_hyps_inclusion env (GR.IndRef ind) mib.mind_hyps in
   let sigma, paramstyp = fresh_template_context env sigma ind specif argjv in
   let u0 = EInstance.kind sigma u in
   let ty, csts = Inductive.type_of_inductive_knowing_parameters (specif, u0) paramstyp in
@@ -147,7 +147,7 @@ let judge_of_applied_inductive_knowing_parameters ~check env sigma (ind, u) argj
 
 let judge_of_applied_constructor_knowing_parameters ~check env sigma ((ind, _ as cstr), u) argjv =
   let (mib,_ as specif) = Inductive.lookup_mind_specif env ind in
-  let () = if check then Reductionops.check_hyps_inclusion env sigma (GR.IndRef ind) mib.mind_hyps in
+  let () = if check then EConstr.check_hyps_inclusion env (GR.IndRef ind) mib.mind_hyps in
   let sigma, paramstyp = fresh_template_context env sigma ind specif argjv in
   let u0 = EInstance.kind sigma u in
   let ty, csts = Inductive.type_of_constructor_knowing_parameters (cstr, u0) specif paramstyp in
@@ -207,9 +207,7 @@ let is_correct_arity env sigma c pj ind specif params =
         sigma, s
       end
     | Evar (ev,_), [] ->
-       let sigma, s = Evd.fresh_sort_in_quality sigma
-           (UnivGen.QualityOrSet.of_quality @@ elim_sort specif)
-       in
+       let sigma, s = Evd.fresh_sort_in_quality sigma (elim_sort specif) in
        let sigma = Evd.define ev (mkSort s) sigma in
        sigma, s
     | _, (LocalDef _ as d)::ar' ->
@@ -328,12 +326,23 @@ let judge_of_cast env sigma cj k tj =
   sigma, { uj_val = mkCast (cj.uj_val, k, expected_type);
            uj_type = expected_type }
 
+let check_fix_with_elims env sigma fix =
+  let evars = Evd.evar_handler sigma in
+  let sorts_opt = check_fix_pre_sorts ~evars env fix in
+  Option.fold_left (List.fold_left (fun sigma (ind_sort, out_sort) ->
+      let elim_to = Inductive.eliminates_to @@ Evd.elim_graph sigma in
+      if not (is_allowed_fixpoint elim_to ind_sort out_sort) then
+        Evd.set_elim_to sigma (Sorts.quality ind_sort) (Sorts.quality out_sort)
+      else
+        sigma
+    )) sigma sorts_opt
+
 let check_fix env sigma pfix =
   let inj c = EConstr.to_constr ~abort_on_undefined_evars:false sigma c in
   let (idx, (ids, cs, ts)) = pfix in
   let ids = Array.map EConstr.Unsafe.to_binder_annot ids in
-  let elim_to = Inductive.eliminates_to @@ Evd.elim_graph sigma in
-  check_fix ~evars:(Evd.evar_handler sigma) ~elim_to env (idx, (ids, Array.map inj cs, Array.map inj ts))
+  let fix = (idx, (ids, Array.map inj cs, Array.map inj ts)) in
+  check_fix_with_elims env sigma fix
 
 let check_cofix env sigma pcofix =
   let inj c = EConstr.to_constr sigma c in
@@ -355,18 +364,9 @@ let judge_of_set =
   { uj_val = EConstr.mkSet;
     uj_type = EConstr.mkSort (ESorts.type1) }
 
-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_sort s =
-  let open Sorts in
-  let u = match s with
-  | Prop | SProp | Set -> Univ.Universe.type1
-  | Type u | QSort (_, u) -> Univ.Universe.super u
-  in
-  { uj_val = EConstr.mkSort (ESorts.make s); uj_type = EConstr.mkType u }
+  let u = Typeops.type_of_sort s in
+  { uj_val = EConstr.mkSort (ESorts.make s); uj_type = EConstr.of_constr u }
 
 let type_of_relative env n =
   EConstr.of_constr (Typeops.type_of_relative env n)
@@ -413,7 +413,7 @@ let judge_of_letin env sigma name defj typj j =
 let type_of_constant env sigma (c,u) =
   let open Declarations in
   let cb = EConstr.lookup_constant env sigma c in
-  let () = Reductionops.check_hyps_inclusion env sigma (GR.ConstRef c) cb.const_hyps in
+  let () = EConstr.check_hyps_inclusion env (GR.ConstRef c) cb.const_hyps in
   let u = EInstance.kind sigma u in
   let uctx = Declareops.constant_polymorphic_context cb in
   let csts = UVars.AbstractContext.instantiate u uctx in
@@ -424,7 +424,7 @@ let type_of_constant env sigma (c,u) =
 let type_of_inductive env sigma (ind,u) =
   let open Declarations in
   let (mib,_ as specif) = Inductive.lookup_mind_specif env ind in
-  let () = Reductionops.check_hyps_inclusion env sigma (GR.IndRef ind) mib.mind_hyps in
+  let () = EConstr.check_hyps_inclusion env (GR.IndRef ind) mib.mind_hyps in
   let u = EInstance.kind sigma u in
   let ty, csts = Inductive.constrained_type_of_inductive (specif,u) in
   let sigma = Evd.add_poly_constraints ~src:UState.Internal sigma csts in
@@ -433,7 +433,7 @@ let type_of_inductive env sigma (ind,u) =
 let type_of_constructor env sigma ((ind,_ as ctor),u) =
   let open Declarations in
   let (mib,_ as specif) = Inductive.lookup_mind_specif env ind in
-  let () = Reductionops.check_hyps_inclusion env sigma (GR.IndRef ind) mib.mind_hyps in
+  let () = EConstr.check_hyps_inclusion env (GR.IndRef ind) mib.mind_hyps in
   let u = EInstance.kind sigma u in
   let ty, csts = Inductive.constrained_type_of_constructor (ctor,u) specif in
   let sigma = Evd.add_poly_constraints ~src:UState.Internal sigma csts in
@@ -495,22 +495,22 @@ type relevance_preunify =
 
 let check_binder_relevance env sigma s decl =
   let preunify = match ESorts.kind sigma s, ERelevance.kind sigma (get_relevance decl) with
-    | (Prop | Set | Type _), Relevant -> Trivial
-    | (Prop | Set | Type _), Irrelevant -> Impossible
+    | (Prop | Set | Type _ | GSort _), Relevant -> Trivial
+    | (Prop | Set | Type _ | GSort _), Irrelevant -> Impossible
     | SProp, Irrelevant -> Trivial
     | SProp, Relevant -> Impossible
-    | QSort (_,l), RelevanceVar q' -> DummySort (ESorts.make (Sorts.qsort q' l))
+    | VSort (_,l), RelevanceVar q' -> DummySort (ESorts.make (Sorts.vsort q' l))
     | (SProp | Prop | Set), RelevanceVar q ->
-      DummySort (ESorts.make (Sorts.qsort q Univ.Universe.type0))
-    | Type l, RelevanceVar q -> DummySort (ESorts.make (Sorts.qsort q l))
-    | QSort (_,l), Relevant ->
+      DummySort (ESorts.make (Sorts.vsort q Univ.Universe.type0))
+    | (Type l | GSort (_, l)), RelevanceVar q -> DummySort (ESorts.make (Sorts.vsort q l))
+    | VSort (_,l), Relevant ->
        begin
          match ERelevance.kind sigma (ESorts.relevance_of_sort s) with
          | Irrelevant -> Impossible
          | Relevant -> Trivial
          | RelevanceVar _ -> DummySort (ESorts.make (Sorts.sort_of_univ l))
        end
-    | QSort _, Irrelevant -> DummySort ESorts.sprop
+    | VSort _, Irrelevant -> DummySort ESorts.sprop
   in
   let unify = match preunify with
     | Trivial -> Some sigma
@@ -526,8 +526,8 @@ let check_binder_relevance env sigma s decl =
     (* TODO always anomaly *)
     let rs = ESorts.relevance_of_sort s in
     let () =
-      if not (UGraph.type_in_type (Evd.universes sigma))
-      then warn_bad_relevance_binder env sigma rs decl
+      if Environ.ignore_elim_constraints env then () else
+      warn_bad_relevance_binder env sigma rs decl
     in
     sigma, set_annot { (get_annot decl) with binder_relevance = rs } decl
 
@@ -583,7 +583,7 @@ let rec execute env sigma cstr =
     | Fix ((vn,i as vni),recdef) ->
         let sigma, (_,tys,_ as recdef') = execute_recdef env sigma recdef in
         let fix = (vni,recdef') in
-        check_fix env sigma fix;
+        let sigma = check_fix env sigma fix in
         sigma, make_judge (mkFix fix) tys.(i)
 
     | CoFix (i,recdef) ->
@@ -593,15 +593,10 @@ let rec execute env sigma cstr =
         sigma, make_judge (mkCoFix cofix) tys.(i)
 
     | Sort s ->
-      begin match ESorts.kind sigma s with
-        | SProp ->
-          if Environ.sprop_allowed env then sigma, judge_of_sprop
-          else error_not_allowed_sprop env sigma
-        | Prop -> sigma, judge_of_prop
-        | Set -> sigma, judge_of_set
-        | Type u -> sigma, judge_of_type u
-        | QSort _ as s -> sigma, judge_of_sort s
-      end
+      let s = ESorts.kind sigma s in
+      if not (Environ.sprop_allowed env) && Sorts.is_sprop s then
+        error_not_allowed_sprop env sigma
+      else sigma, judge_of_sort s
 
     | Proj (p, _, c) ->
       let sigma, cj = execute env sigma c in
@@ -839,30 +834,54 @@ let rec recheck_against env sigma good c =
 
     | App (gf, gargs),
       App (f, args) ->
-      if Array.length gargs <> Array.length args then
-        let sigma, _, fj = recheck_against env sigma gf f in
-        let sigma, jl = execute_array env sigma args in
-        (match EConstr.kind sigma f with
+      let glen = Array.length gargs in
+      let len = Array.length args in
+      if glen < len then
+        (* We are rechecking f a1 ... an x1 ... xk against gf y1 ... yk with n > 0  *)
+        let pre, args = Array.chop (len - glen) args in
+        let sigma, fj = execute env sigma f in
+        let sigma, prej = execute_array env sigma pre in
+        let (sigma, changedargs), argsj =
+          Array.fold_left2_map (fun (sigma, changed) good c ->
+              let sigma, changed', t = recheck_against env sigma good c in
+              (sigma, merge_changes changed changed'), t)
+            (sigma, Same) gargs args
+        in
+        let jl = Array.append prej argsj in
+        begin match EConstr.kind sigma f with
          | Ind (ind, u) when EInstance.is_empty u && Environ.template_polymorphic_ind ind env ->
            maybe_changed (judge_of_applied_inductive_knowing_parameters ~check:true env sigma (ind, u) jl)
          | Construct (cstr, u) when EInstance.is_empty u && Environ.template_polymorphic_ind (fst cstr) env ->
            maybe_changed (judge_of_applied_constructor_knowing_parameters ~check:true env sigma (cstr, u) jl)
          | _ ->
            (* No template polymorphism *)
-           maybe_changed (judge_of_apply env sigma fj jl))
-      else begin
+           maybe_changed (judge_of_apply env sigma fj jl)
+        end
+      else
+        (* We are rechecking f x1 ... xk against gf a1 ... an y1 ... yk with n >= 0 *)
+        let pre, gargs = if len < glen then Array.chop (glen - len) gargs else [||], gargs in
         let (sigma, changedargs), jl =
           Array.fold_left2_map (fun (sigma,changed) good c ->
               let sigma, changed', t = recheck_against env sigma good c in
               (sigma, merge_changes changed changed'), (changed', t))
             (sigma,Same) gargs args
         in
-        let sigma, changedf, fj = recheck_against env sigma gf f in
+        let sigma, changedf, fj =
+          if Int.equal glen len then recheck_against env sigma gf f
+          else
+            let sigma, fj = execute env sigma f in
+            let bodyonly = lazy begin
+              let good = mkApp (gf, pre) in
+              EConstr.eq_constr sigma (Retyping.get_type_of env sigma good) fj.uj_type
+            end in
+            let change = Changed {bodyonly} in
+            sigma, change, fj
+        in
         if unchanged changedargs && bodyonly changedf
         then assume_unchanged_type sigma
         else
           (* XXX could exploit change info when template *)
-          (match EConstr.kind sigma f with
+          begin match EConstr.kind sigma f with
            | Ind (ind, u) when EInstance.is_empty u && Environ.template_polymorphic_ind ind env ->
              let jl = Array.map snd jl in
              maybe_changed (judge_of_applied_inductive_knowing_parameters ~check:true env sigma (ind, u) jl)
@@ -871,8 +890,8 @@ let rec recheck_against env sigma good c =
              maybe_changed (judge_of_applied_constructor_knowing_parameters ~check:true env sigma (cstr, u) jl)
            | _ ->
              (* No template polymorphism *)
-             maybe_changed (judge_of_apply_against env sigma changedf fj jl))
-      end
+             maybe_changed (judge_of_apply_against env sigma changedf fj jl)
+          end
 
     | Lambda (_, gc1, gc2),
       Lambda (name, c1, c2) ->
diff --git a/pretyping/typing.mli b/pretyping/typing.mli
index 81c386ae5118..a68b2231ba01 100644
--- a/pretyping/typing.mli
+++ b/pretyping/typing.mli
@@ -37,6 +37,8 @@ val solve_evars : env -> evar_map -> constr -> evar_map * constr
 val check_allowed_sort : env -> evar_map -> inductive puniverses -> constr -> constr ->
   evar_map * ERelevance.t
 
+val check_fix_with_elims : env -> evar_map -> Constr.fixpoint -> evar_map
+
 (** Raise an error message if bodies have types not unifiable with the
     expected ones *)
 val check_type_fixpoint : ?loc:Loc.t -> env -> evar_map ->
diff --git a/pretyping/unification.ml b/pretyping/unification.ml
index 2c0e4b2d9ad0..fa75b12120b5 100644
--- a/pretyping/unification.ml
+++ b/pretyping/unification.ml
@@ -721,13 +721,12 @@ let allow_new_evars sigma =
 (* allow_K) because only closed terms are involved in *)
 (* induction/destruct/case/elim and w_unify_to_subterm_list does not *)
 (* call w_unify for induction/destruct/case/elim  (13/6/2011) *)
-let elim_core_flags sigma = { (default_core_unify_flags ()) with
+let elim_core_flags = { (default_core_unify_flags ()) with
   modulo_betaiota = false;
-  allowed_evars = allow_new_evars sigma;
 }
 
-let elim_flags_evars sigma =
-  let flags = elim_core_flags sigma in {
+let elim_flags () =
+  let flags = elim_core_flags in {
   core_unify_flags = flags;
   merge_unify_flags = flags;
   subterm_unify_flags = { flags with modulo_delta = TransparentState.empty };
@@ -735,9 +734,7 @@ let elim_flags_evars sigma =
   resolve_evars = false
 }
 
-let elim_flags () = elim_flags_evars Evd.empty
-
-let elim_no_delta_core_flags () = { (elim_core_flags Evd.empty) with
+let elim_no_delta_core_flags () = { elim_core_flags with
   modulo_delta = TransparentState.empty;
   check_applied_meta_types = false;
   use_pattern_unification = false;
@@ -813,6 +810,29 @@ let expand_table_key ~metas ts env sigma args = function
         let def = EConstr.Unsafe.to_constr def in
         let unf = unfold_projection_under_eta env ts c def in
         Some (EConstr.of_constr @@ Option.default def unf, args)
+        | exception NotEvaluableConst (IsPrimitive (u, op)) ->
+          let nargs = CPrimitives.arity op in
+          begin match Array.chop nargs args with
+          | (args, appl) ->
+            let args_red = Array.of_list @@ CPrimitives.kind op in
+            assert (Array.length args_red <= Array.length args);
+            let args =
+              let open CPrimitives in
+              let red arg = function
+                | Kparam | Karg -> arg
+                | Kwhnf ->
+                  let flags = RedFlags.all in
+                  let flags = RedFlags.red_add_transparent flags ts in
+                  Reductionops.clos_whd_flags flags env sigma arg
+              in
+              Array.map2 red args args_red
+            in
+            begin match CredNative.(red_prim env sigma op (EInstance.make u) args) with
+              | Some v -> Some (v, appl)
+              | None -> None
+              end
+            | exception Failure _ -> None
+          end
         | exception NotEvaluableConst (HasRules (u, b, r)) ->
         begin try
           let metas = Meta.meta_handler metas in
@@ -940,11 +960,11 @@ let do_reduce ~metas ts (env, nb) sigma c =
   Stack.zip sigma (whd_betaiota_deltazeta_for_iota_state ~metas
                   ts env sigma (c, Stack.empty))
 
-let is_evar_allowed flags evk =
-  AllowedEvars.mem flags.allowed_evars evk
+let is_evar_allowed sigma flags evk =
+  AllowedEvars.mem flags.allowed_evars sigma evk
 
 let isAllowedEvar sigma flags c = match EConstr.kind sigma c with
-  | Evar (evk,_) -> is_evar_allowed flags evk
+  | Evar (evk,_) -> is_evar_allowed sigma flags evk
   | _ -> false
 
 
@@ -986,19 +1006,18 @@ let check_compatibility env pbty flags subst tyM tyN =
       | None -> error_cannot_unify env sigma (m,n)
     else sigma
 
-let check_compatibility_ustate env pbty flags subst tyM tyN =
+let check_compatibility_nounivs env flags subst tyM tyN =
   let sigma = subst.subst_sigma in
   match subst_defined_metas_evars sigma (subst.subst_metam, subst.subst_metas, []) tyM with
-  | None -> UnivProblem.Set.empty
+  | None -> ()
   | Some m ->
   match subst_defined_metas_evars sigma (subst.subst_metam, subst.subst_metas, []) tyN with
-  | None -> UnivProblem.Set.empty
+  | None -> ()
   | Some n ->
     if is_ground_term sigma m && is_ground_term sigma n then
-      match infer_conv_ustate ~pb:pbty ~ts:flags.modulo_delta_types env sigma m n with
-      | Some uprob -> uprob
-      | None -> error_cannot_unify env sigma (m,n)
-    else UnivProblem.Set.empty
+      if is_conv_nounivs ~reds:flags.modulo_delta_types env sigma m n then ()
+      else error_cannot_unify env sigma (m,n)
+    else ()
 
 let rec is_neutral env sigma ts t =
   let (f, l) = decompose_app sigma t in
@@ -1153,7 +1172,7 @@ let rec unify_0_with_initial_metas (subst : subst0) conv_at_top env pb flags m n
               push_metas sigma (k, lift (-nb) cM, fst (extract_instance_status pb)) substn
             else error_cannot_unify_local curenv sigma (m,n,cM)
         | Evar (evk,_ as ev), Evar (evk',_)
-            when is_evar_allowed flags evk
+            when is_evar_allowed sigma flags evk
               && Evar.equal evk evk' ->
             begin match constr_cmp pb env sigma flags cM cN with
             | Some sigma ->
@@ -1162,14 +1181,14 @@ let rec unify_0_with_initial_metas (subst : subst0) conv_at_top env pb flags m n
               push_evars sigma (curenvnb, ev, cN) substn
             end
         | Evar (evk,_ as ev), _
-            when is_evar_allowed flags evk
+            when is_evar_allowed sigma flags evk
               && 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
                 push_evars sigma (curenvnb, ev, cN) substn
               else error_cannot_unify_local curenv sigma (m,n,cN)
         | _, Evar (evk,_ as ev)
-            when is_evar_allowed flags evk
+            when is_evar_allowed sigma flags evk
               && 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
@@ -1450,22 +1469,18 @@ let rec unify_0_with_initial_metas (subst : subst0) conv_at_top env pb flags m n
         (* No subterm restriction there, too much incompatibilities
            don't care about universes from comparing the types
         *)
-         let _ : UnivProblem.Set.t =
-           if opt.with_types then
-             try (* Ensure we call conversion on terms of the same type *)
-               let tyM = get_type_of curenv ~lax:true sigma m1 in
-               let tyN = get_type_of curenv ~lax:true sigma n1 in
-               check_compatibility_ustate curenv CUMUL flags substn tyM tyN
-             with RetypeError _ ->
-               (* Renounce, maybe metas/evars prevents typing *) UnivProblem.Set.empty
-           else UnivProblem.Set.empty
-         in
-        match infer_conv_ustate ~pb ~ts:convflags curenv sigma m1 n1 with
-        | Some uprob ->
-          begin match Evd.add_constraints sigma uprob with
-          | sigma -> Some (push_sigma sigma substn)
-          | exception (UGraph.UniverseInconsistency _ | UniversesDiffer) -> None
-          end
+        let () =
+          if opt.with_types then
+            try (* Ensure we call conversion on terms of the same type *)
+              let tyM = get_type_of curenv ~lax:true sigma m1 in
+              let tyN = get_type_of curenv ~lax:true sigma n1 in
+              check_compatibility_nounivs curenv flags substn tyM tyN
+            with RetypeError _ ->
+              (* Renounce, maybe metas/evars prevents typing *) ()
+          else ()
+        in
+        match infer_conv ~pb ~ts:convflags curenv sigma m1 n1 with
+        | Some sigma -> Some (push_sigma sigma substn)
         | None ->
           if is_ground_term sigma m1 && is_ground_term sigma n1 then
             error_cannot_unify curenv sigma (cM,cN)
@@ -2139,6 +2154,7 @@ let get_rigid_evars sigma c =
   | _ -> EConstr.fold sigma aux vars c in
   aux Id.Set.empty c
 
+(* XXX should we lose section variable status in the push newdecl cases? *)
 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
@@ -2153,13 +2169,12 @@ let make_abstraction_core name (test,out) env sigma c ty occs check_occs concl =
   in
   let likefirst = clause_with_generic_occurrences occs in
   let mkvarid () = EConstr.mkVar id in
-  let compute_dependency _ d (remvars,sign,depdecls) =
-    let d = EConstr.of_named_decl d in
+  let compute_dependency _ status d (remvars,sign,depdecls) =
     let hyp = NamedDecl.get_id d in
     if Id.Set.is_empty remvars then
     match occurrences_of_hyp hyp occs with
     | NoOccurrences, InHyp ->
-        (remvars,push_named_context_val d sign,depdecls)
+        (remvars,push_named_context_val status d sign,depdecls)
     | (AllOccurrences | AtLeastOneOccurrence), InHyp as occ ->
         let occ = if likefirst then LikeFirst else AtOccs occ in
         let newdecl = replace_term_occ_decl_modulo env sigma occ test mkvarid d in
@@ -2168,17 +2183,17 @@ let make_abstraction_core name (test,out) env sigma c ty occs check_occs concl =
         then
           if check_occs && not (in_every_hyp occs)
           then raise (PretypeError (env,sigma,NoOccurrenceFound (c,Some hyp)))
-          else (remvars,push_named_context_val d sign, depdecls)
+          else (remvars,push_named_context_val status d sign, depdecls)
         else
-          (remvars,push_named_context_val newdecl sign, newdecl :: depdecls)
+          (remvars,push_named_context_val status newdecl sign, newdecl :: depdecls)
     | occ ->
         (* There are specific occurrences, hence not like first *)
         let newdecl = replace_term_occ_decl_modulo env sigma (AtOccs occ) test mkvarid d in
-        (remvars,push_named_context_val newdecl sign, newdecl :: depdecls)
+        (remvars,push_named_context_val status newdecl sign, newdecl :: depdecls)
     else
       (* Skip declarations if all rigid variables have not been introduced *)
       let remvars = Id.Set.remove hyp remvars in
-      (remvars,push_named_context_val d sign,depdecls)
+      (remvars,push_named_context_val status d sign,depdecls)
   in
   let vars = get_rigid_evars sigma c in
   try
@@ -2252,14 +2267,20 @@ type 'aconstr akind =
   | ACast of 'aconstr (* only the main term *)
   | AOther of 'aconstr array
 
+type atyp =
+| ATySort
+| ATyProd
+| ATyOther
+
 module AConstr :
 sig
   type t
   val proj : t -> EConstr.t
   val make : evar_map -> EConstr.t -> t
   val kind : t -> t akind
-  val mkApp : t * t array -> t
+  val mkApp : atyp -> t * t array -> t
   val closed0 : t -> bool
+  val atyp : t -> atyp
 end =
 struct
 
@@ -2267,6 +2288,8 @@ type t = {
   proj : EConstr.t;
   self : t akind;
   data : int;
+  atyp : atyp;
+  (** Shape of the type of [proj], assuming its well-typedness *)
 }
 
 let proj c = c.proj
@@ -2282,13 +2305,13 @@ let data v = v.data
 
 let kind v = v.self
 
-let mkApp (c, al) =
+let mkApp atyp (c, al) =
   if Array.is_empty al then c
   else match kind c with
   | AApp (c0, al0) ->
-    { proj = mkApp (c.proj, Array.map proj al); self = AApp (c0, Array.append al0 al); data = max c.data (max_array data al) }
+    { proj = mkApp (c.proj, Array.map proj al); self = AApp (c0, Array.append al0 al); data = max c.data (max_array data al); atyp }
   | _ ->
-    { proj = mkApp (c.proj, Array.map proj al); self = AApp (c, al); data = max c.data (max_array data al) }
+    { proj = mkApp (c.proj, Array.map proj al); self = AApp (c, al); data = max c.data (max_array data al); atyp }
 
 let get_max_rel sigma c =
   let rec aux n accu c = match EConstr.kind sigma c with
@@ -2301,37 +2324,41 @@ let get_max_rel_array sigma v = Array.fold_left (fun accu c -> max accu (get_max
 
 let anorec = AOther [||]
 
-let rec make sigma c0 = match EConstr.kind sigma c0 with
+let rec make0 atyp sigma c0 = match EConstr.kind sigma c0 with
 | (Meta _ | Var _ | Sort _ | Const _ | Ind _ | Construct _ | Int _ | Float _ | String _) ->
-  { proj = c0; self = anorec; data = 0 }
+  { proj = c0; self = anorec; data = 0; atyp }
 | Rel n ->
-  { proj = c0; self = anorec; data = n }
+  { proj = c0; self = anorec; data = n; atyp }
 | Cast (c, k, t) ->
   let c = make sigma c in
   (* unification doesn't recurse in the type *)
   let td = get_max_rel sigma t in
-  { proj = c0; self = ACast c; data = max c.data td }
-| Lambda (na, t, c) | Prod (na, t, c) ->
-  let t = make sigma t in
+  { proj = c0; self = ACast c; data = max c.data td; atyp }
+| Lambda (na, t, c) ->
+  let t = make0 ATySort sigma t in
   let c = make sigma c in
-  { proj = c0; self = AOther [|t; c|]; data = max t.data (lift c.data) }
+  { proj = c0; self = AOther [|t; c|]; data = max t.data (lift c.data); atyp }
+| Prod (na, t, c) ->
+  let t = make0 ATySort sigma t in
+  let c = make0 ATySort sigma c in
+  { proj = c0; self = AOther [|t; c|]; data = max t.data (lift c.data); atyp }
 | LetIn (na, b, t, c) ->
   let b = make sigma b in
   (* unification doesn't recurse in the type *)
   let td = get_max_rel sigma t in
   let c = make sigma c in
-  { proj = c0; self = AOther [|b; c|]; data = max b.data (max td (lift c.data)) }
+  { proj = c0; self = AOther [|b; c|]; data = max b.data (max td (lift c.data)); atyp }
 | App (c, al) ->
-  let c = make sigma c in
+  let c = make0 ATyProd sigma c in
   let ald, al = make_array sigma al in
-  { proj = c0; self = AApp (c, al); data = max c.data ald }
+  { proj = c0; self = AApp (c, al); data = max c.data ald; atyp }
 | Proj (p, _, t) ->
   let t = make sigma t in
-  { proj = c0; self = AOther [|t|]; data = t.data }
+  { proj = c0; self = AOther [|t|]; data = t.data; atyp }
 | Evar (e, al) ->
   (* Unification doesn't recurse on the subterms in evar instances *)
   let data = SList.Skip.fold (fun accu v -> max accu (get_max_rel sigma v)) 0 al in
-  { proj = c0; self = AOther [||]; data }
+  { proj = c0; self = AOther [||]; data; atyp }
 | Case (ci, u, pms, (p,_), iv, c, bl) ->
   let pmsd = get_max_rel_array sigma pms in
   let pd =
@@ -2351,18 +2378,18 @@ let rec make sigma c0 = match EConstr.kind sigma c0 with
   let bld, bl = Array.fold_left_map fold 0 bl in
   let data = max pmsd @@ max pd @@ max ivd @@ max c.data bld in
   (* Unification only recurses on the discriminee and the branches *)
-  { proj = c0; self = AOther (Array.append [|c|] bl); data }
+  { proj = c0; self = AOther (Array.append [|c|] bl); data; atyp }
 | Fix (_, (_, tl, bl)) | CoFix(_,(_,tl,bl)) ->
   let tld, tl = make_array sigma tl in
   let bld, bl = make_array sigma bl in
   let data = max tld (liftn (Array.length tl) bld) in
-  { proj = c0; self = AOther (Array.append tl bl); data }
+  { proj = c0; self = AOther (Array.append tl bl); data; atyp }
 | Array(u,t,def,ty) ->
   let td, t = make_array sigma t in
   let def = make sigma def in
   let ty = make sigma ty in
   let data = max td (max def.data ty.data) in
-  { proj = c0; self = AOther (Array.append [|def;ty|] t); data }
+  { proj = c0; self = AOther (Array.append [|def;ty|] t); data; atyp }
 
 and make_array sigma v =
   let fold accu c =
@@ -2371,6 +2398,11 @@ and make_array sigma v =
   in
   Array.fold_left_map fold 0 v
 
+and make sigma c =
+  make0 ATyOther sigma c
+
+let atyp c = c.atyp
+
 end
 
 type head_kind =
@@ -2413,10 +2445,16 @@ let fast_head_check sigma knd c = match EConstr.kind sigma c, knd with
   end
 | _ -> true
 
+let fast_atyp_check knd atyp = match knd, atyp with
+| HeadInd, (ATyProd | ATySort)
+| HeadSort, ATyProd
+| HeadProd, ATySort -> false
+| _ -> true
+
 (* Tries to find an instance of term [cl] in term [op].
    Unifies [cl] to every subterm of [op] until it finds a match.
    Fails if no match is found *)
-let w_unify_to_subterm ~metas env evd ?(flags=default_unify_flags ()) (op,cl) =
+let w_unify_to_subterm ~metas env evd ?where ?(flags=default_unify_flags ()) (op,cl) =
   let bestexn = ref None in
   let kop = Keys.constr_key env (fun c -> EConstr.kind evd c) op in
   let opgnd = if occur_meta_or_undefined_evar evd op then NotGround else Ground in
@@ -2429,8 +2467,9 @@ let w_unify_to_subterm ~metas env evd ?(flags=default_unify_flags ()) (op,cl) =
     let cl = strip_outer_cast cl in
     let ans =
       let is_closed = AConstr.closed0 cl in
+      let atyp = AConstr.atyp cl in
       let cl = AConstr.proj cl in
-      if is_closed && not (isEvar evd cl) && keyed_unify env evd kop cl && fast_head_check evd knd cl then
+      if is_closed && not (isEvar evd cl) && keyed_unify env evd kop cl && fast_head_check evd knd cl && fast_atyp_check knd atyp then
         try
           if is_keyed_unification () then
             let f1, l1 = decompose_app evd op in
@@ -2460,7 +2499,8 @@ let w_unify_to_subterm ~metas env evd ?(flags=default_unify_flags ()) (op,cl) =
         | HeadProd | HeadOther ->
           let n = Array.length args in
           let () = assert (n > 0) in
-          let c1 = AConstr.mkApp (f,Array.sub args 0 (n-1)) in
+          (* [c1] has necessarily a product type here because it is applied to [c2] *)
+          let c1 = AConstr.mkApp ATyProd (f,Array.sub args 0 (n-1)) in
           let c2 = args.(n-1) in
           begin match matchrec c1 with
           | Some _ as ans -> ans
@@ -2478,7 +2518,7 @@ let w_unify_to_subterm ~metas env evd ?(flags=default_unify_flags ()) (op,cl) =
   | Some ans -> ans
   | None ->
     match !bestexn with
-    | None -> raise (PretypeError (env,evd,NoOccurrenceFound (op, None)))
+    | None -> raise (PretypeError (env,evd,NoOccurrenceFound (op, where)))
     | Some e -> raise e
 
 (* Tries to find all instances of term [cl] in term [op].
@@ -2606,8 +2646,8 @@ let w_unify_to_subterm_list ~metas env evd flags hdmeta oplist t =
     oplist
     (metas,evd,[])
 
-let w_unify_to_subterm env sigma ?flags (c, t) =
-  w_unify_to_subterm env sigma ?flags (c, AConstr.make sigma t)
+let w_unify_to_subterm env sigma ?where ?flags (c, t) =
+  w_unify_to_subterm env sigma ?where ?flags (c, AConstr.make sigma t)
 
 let secondOrderAbstraction ~metas env evd flags typ (p, oplist) =
   (* Remove delta when looking for a subterm *)
@@ -2703,8 +2743,8 @@ let w_unify ~metas env evd cv_pb ?(flags=default_unify_flags ()) ty1 ty2 =
 let w_unify ?(metas = Metamap.empty) env evd cv_pb ?(flags=default_unify_flags ()) ty1 ty2 =
   w_unify ~metas env evd cv_pb ~flags ty1 ty2
 
-let w_unify_to_subterm ?(metas = Metamap.empty) env evd ?flags arg =
-  w_unify_to_subterm ~metas env evd ?flags arg
+let w_unify_to_subterm ?(metas = Metamap.empty) env evd ?where ?flags arg =
+  w_unify_to_subterm ~metas env evd ?where ?flags arg
 
 let w_unify_to_subterm_all ?(metas = Metamap.empty) env evd ?flags arg =
   w_unify_to_subterm_all ~metas env evd ?flags arg
diff --git a/pretyping/unification.mli b/pretyping/unification.mli
index 77b8c10557bf..105b92326817 100644
--- a/pretyping/unification.mli
+++ b/pretyping/unification.mli
@@ -108,7 +108,7 @@ val w_unify :
    subterm of [t] is also returned. *)
 val w_unify_to_subterm :
   ?metas:Meta.t ->
-  env -> evar_map -> ?flags:unify_flags -> constr * constr -> (Meta.t * evar_map) * constr
+  env -> evar_map -> ?where:Id.t -> ?flags:unify_flags -> constr * constr -> (Meta.t * evar_map) * constr
 
 val w_unify_to_subterm_all :
   ?metas:Meta.t ->
diff --git a/pretyping/vnorm.ml b/pretyping/vnorm.ml
index 4899028760d4..12cefb981803 100644
--- a/pretyping/vnorm.ml
+++ b/pretyping/vnorm.ml
@@ -130,6 +130,7 @@ let build_branches_type env sigma (mind,_ as _ind) mib mip u params (pctx, p) =
     in
     let decl_with_letin = List.firstn mip.mind_consnrealdecls.(i) (fst cty) in
     let nas = get_case_annot decl_with_letin in
+    let nas = Array.map (Context.map_annot_relevance (UVars.subst_instance_relevance u)) nas in
     let rec get_lift decls = match decls with
     | [] -> Esubst.el_id
     | LocalDef _ :: decls -> Esubst.el_shft 1 (get_lift decls)
@@ -287,6 +288,7 @@ and nf_stk ?from:(from=0) env sigma c t stk  =
       let params,realargs = Util.Array.chop nparams allargs in
       let pctx =
         let realdecls, _ = List.chop mip.mind_nrealdecls mip.mind_arity_ctxt in
+        (* NB expand_arity doesn't look at the relevances in nas *)
         let nas = List.rev_map RelDecl.get_annot realdecls @ [nameR (Id.of_string "c")] in
         expand_arity (mib, mip) (ind, u) params (Array.of_list nas)
       in
@@ -305,8 +307,8 @@ and nf_stk ?from:(from=0) env sigma c t stk  =
       let branchs = Array.mapi mkbranch bsw in
       let tcase = build_case_type (pctx, p) realargs c in
       let p = (get_case_annot pctx, p) in
-      let ci = Inductiveops.make_case_info env ind RegularStyle in
-      let iv = if Typeops.should_invert_case env relevance ci then
+      let ci = Inductiveops.make_case_info env ind MatchStyle in
+      let iv = if Inductiveops.Internal.should_invert_case env sigma relevance ci then
           CaseInvert {indices=realargs}
         else NoInvert
       in
diff --git a/printing/dune b/printing/dune
index 5b0c6c2cc43c..d0d256893b4d 100644
--- a/printing/dune
+++ b/printing/dune
@@ -4,7 +4,3 @@
  (public_name rocq-runtime.printing)
  (wrapped false)
  (libraries parsing proofs))
-
-(deprecated_library_name
- (old_public_name coq-core.printing)
- (new_public_name rocq-runtime.printing))
diff --git a/printing/genprint.ml b/printing/genprint.ml
index 6f6027300ba7..30c6218535d2 100644
--- a/printing/genprint.ml
+++ b/printing/genprint.ml
@@ -111,9 +111,11 @@ let _ =
 type ('raw, 'glb, 'top) genprinter = {
   raw : 'raw -> printer_result;
   glb : 'glb -> printer_result;
-  top : 'top -> top_printer_result;
 }
 
+let basic_default name =
+  PrinterBasic (fun env sigma -> str "")
+
 module PrintObj =
 struct
   type ('raw, 'glb, 'top) obj = ('raw, 'glb, 'top) genprinter
@@ -123,7 +125,6 @@ struct
     let printer = {
       raw = (fun _ -> PrinterBasic (fun env sigma -> str ""));
       glb = (fun _ -> PrinterBasic (fun env sigma -> str ""));
-      top = (fun _ -> TopPrinterBasic (fun () -> str ""));
     } in
     Some printer
 end
@@ -131,7 +132,7 @@ end
 module Print = Register (PrintObj)
 
 let register_print0 wit raw glb top =
-  let printer = { raw; glb; top; } in
+  let printer = { raw; glb; } 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' ->
@@ -141,20 +142,34 @@ let register_print0 wit raw glb top =
      ()
 
 let register_noval_print0 wit raw glb =
-  let top = Util.Empty.abort in
-  let printer = { raw; glb; top; } in
+  let printer = { raw; glb; } in
   Print.register0 wit printer
 
 let register_vernac_print0 wit raw =
   let glb = Util.Empty.abort in
-  let top = Util.Empty.abort in
-  let printer = { raw; glb; top; } in
+  let printer = { raw; glb; } in
   Print.register0 wit printer
 
 let raw_print wit v = (Print.obj wit).raw v
 let glb_print wit v = (Print.obj wit).glb v
-let top_print wit v = (Print.obj wit).top v
 
 let generic_raw_print (GenArg (Rawwit w, v)) = raw_print w v
 let generic_glb_print (GenArg (Glbwit w, v)) = glb_print w v
-let generic_top_print (GenArg (Topwit w, v)) = top_print w v
+
+module CPrintObj = struct
+  type ('raw, 'glb) t = ('raw -> printer_result) * ('glb -> printer_result)
+end
+
+module CPrint = GenConstr.Register(CPrintObj)
+
+let register_constr_print tag raw glb = CPrint.register tag (raw, glb)
+
+let raw_print_constr (GenConstr.Raw (tag, v)) =
+  match CPrint.find_opt tag with
+  | None -> basic_default (GenConstr.repr tag)
+  | Some (ppraw, _) -> ppraw v
+
+let glb_print_constr (GenConstr.Glb (tag, v)) =
+  match CPrint.find_opt tag with
+  | None -> basic_default (GenConstr.repr tag)
+  | Some (_, ppglb) -> ppglb v
diff --git a/printing/genprint.mli b/printing/genprint.mli
index f77cd3553d11..ffb92ab93589 100644
--- a/printing/genprint.mli
+++ b/printing/genprint.mli
@@ -38,9 +38,6 @@ val raw_print : ('raw, 'glb, 'top) genarg_type -> 'raw printer
 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 top_printer
-(** Printer for top level generic arguments. *)
-
 val register_print0 : ('raw, 'glb, 'top) genarg_type ->
   'raw printer -> 'glb printer -> 'top top_printer -> unit
 (** The genarg must be registered in [Geninterp.register_val0] *)
@@ -54,5 +51,13 @@ val register_vernac_print0 : 'raw vernac_genarg_type ->
 
 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
+
+(* For terms *)
+(* XXX do we need the full complexity of [printer]? especially since
+   ppconstr currently doesn't pass a level *)
+val register_constr_print : ('raw, 'glb) GenConstr.tag ->
+  'raw printer -> 'glb printer -> unit
+
+val raw_print_constr : GenConstr.raw printer
+val glb_print_constr : GenConstr.glb printer
diff --git a/printing/ppconstr.ml b/printing/ppconstr.ml
index cccb54a7323a..f286f29b82af 100644
--- a/printing/ppconstr.ml
+++ b/printing/ppconstr.ml
@@ -184,7 +184,7 @@ let pr_generalization bk c =
   str "`" ++ str hd ++ c ++ str tl
 
 let pr_com_at n =
-  if !Flags.beautify && not (Int.equal n 0) then comment (Pputils.extract_comments n)
+  if 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)
@@ -213,27 +213,24 @@ let pr_univ l =
   | UAnonymous {rigid=UnivRigid} -> tag_type (str "Type")
   | UAnonymous {rigid=UnivFlexible _} -> tag_type (str "_")
 
-let pr_qvar_expr = function
+let pr_quality_expr = function
   | CQAnon _ -> tag_type (str "_")
   | CQVar qid -> tag_type (pr_qualid qid)
-  | CRawQVar q -> tag_type (Sorts.QVar.raw_pr q)
+  | CRawQuality q -> tag_type (Sorts.Quality.raw_pr q)
+  | CQConstant q -> tag_type (Sorts.Quality.Constants.pr q)
 
 let pr_relevance = function
   | CRelevant -> str "Relevant"
   | CIrrelevant -> str "Irrelevant"
-  | CRelevanceVar q -> pr_qvar_expr q
+  | CRelevanceVar q -> pr_quality_expr q
 
 let pr_relevance_info = function
   | None -> mt()
   | Some r -> str "(* " ++ pr_relevance r ++ str " *) "
 
-let pr_quality_expr q = match q with
-  | CQConstant q -> tag_type (Sorts.Quality.Constants.pr q)
-  | CQualVar q -> pr_qvar_expr q
-
 let pr_quality_univ (q, l) = match q with
   | None -> pr_univ l
-  | Some q ->  pr_qvar_expr q ++ spc() ++ str ";" ++ spc () ++ pr_univ l
+  | Some q ->  pr_quality_expr q ++ spc() ++ str ";" ++ spc () ++ pr_univ l
 
 let pr_univ_annot pr x = str "@{" ++ pr x ++ str "}"
 
@@ -623,28 +620,25 @@ let pr_cast = let open Constr in function
     | None -> str ":>"
 
 type raw_or_glob_genarg =
-  | Rawarg of Genarg.raw_generic_argument
-  | Globarg of Genarg.glob_generic_argument
+  | Rawarg of GenConstr.raw
+  | Globarg of GenConstr.glb
 
 let pr_genarg return arg =
   (* In principle this may use the env/sigma, in practice not sure if it
      does except through pr_constr_expr in beautify mode. *)
   let env = Global.env() in
   let sigma = Evd.from_env env in
-  let name, parg = let open Genarg in
+  let name, parg =
     match arg with
-    | Globarg arg ->
-      let GenArg (Glbwit tag, _) = arg in
-      begin match tag with
-      | ExtraArg tag -> ArgT.repr tag, Pputils.pr_glb_generic env sigma arg
-      | _ -> assert false
-      end
-    | Rawarg arg ->
-      let GenArg (Rawwit tag, _) = arg in
-      begin match tag with
-      | ExtraArg tag -> ArgT.repr tag, Pputils.pr_raw_generic env sigma arg
-      | _ -> assert false
-      end
+    | Globarg (Glb (tag, _) as arg) ->
+      GenConstr.repr tag, Genprint.glb_print_constr arg
+    | Rawarg (Raw (tag, _) as arg) ->
+      GenConstr.repr tag, Genprint.raw_print_constr arg
+  in
+  let parg = match parg with
+    | PrinterBasic pp -> pp env sigma
+    | PrinterNeedsLevel { default_already_surrounded = level; printer } ->
+      printer env sigma level
   in
   let name =
     (* cheat the name system
@@ -832,15 +826,8 @@ let pr ~flags lev_after prec = function
   | { CAst.v = CAppExpl ((f,us),[]) } -> str "@" ++ pr_cref f us
   | c -> pr ~flags lev_after prec c
 
-let transf env sigma c =
-  if !Flags.beautify_file then
-    let r = Constrintern.intern_gen ~strict_check:false WithoutTypeConstraint env sigma c in
-    let eenv = Constrextern.extern_env env sigma ~flags:(PrintingFlags.Extern.current()) in
-    Constrextern.extern_glob_constr eenv r
-  else c
-
 let pr_expr ~flags env sigma lev_after prec c =
-  pr ~flags lev_after prec (transf env sigma c)
+  pr ~flags lev_after prec c
 
 let pr_simpleconstr_env ~flags env sigma c = pr_expr ~flags env sigma no_after lsimpleconstr c
 let pr_top_env ~flags env sigma = pr_expr ~flags env sigma no_after ltop
@@ -868,3 +855,46 @@ let pr_lconstr_pattern_expr ~flags env sigma c : Pp.t = !term_pr.pr_lconstr_patt
 let pr_cases_pattern_expr ~flags c : Pp.t = pr_patt ~flags (pr ~flags no_after ltop) no_after ltop c
 
 let pr_binders ~flags env sigma l : Pp.t = pr_undelimited_binders ~flags spc true (pr_expr ~flags env sigma no_after ltop) l
+
+module CompactedDecl = struct
+  type t =
+    | LocalAssum of (Environ.var_status option * Id.t EConstr.binder_annot) list * EConstr.types
+    | LocalDef of (Environ.var_status option * Id.t EConstr.binder_annot) list * EConstr.constr * EConstr.types
+
+  let of_named_decl status = function
+    | Context.Named.Declaration.LocalAssum (id,t) ->
+      LocalAssum ([status,id], t)
+    | Context.Named.Declaration.LocalDef (id,v,t) ->
+      LocalDef ([status,id], v, t)
+
+  let to_tuple = function
+    | LocalAssum (ids, t) -> List.map snd ids, None, t
+    | LocalDef (ids, b, t) -> List.map snd ids, Some b, t
+end
+
+let compact_named_context sigma sign =
+  let module NamedDecl = Context.Named.Declaration in
+  let compact l status decl =
+    match decl, l with
+    | NamedDecl.LocalAssum (i,t), [] ->
+      [CompactedDecl.LocalAssum ([Some status,i],t)]
+    | NamedDecl.LocalDef (i,c,t), [] ->
+      [CompactedDecl.LocalDef ([Some status,i],c,t)]
+    | NamedDecl.LocalAssum (i1,t1), CompactedDecl.LocalAssum (li,t2) :: q ->
+      if EConstr.eq_constr sigma t1 t2
+      then CompactedDecl.LocalAssum ((Some status, i1)::li, t2) :: q
+      else CompactedDecl.LocalAssum ([Some status, i1],t1) :: CompactedDecl.LocalAssum (li,t2) :: q
+    | NamedDecl.LocalDef (i1,c1,t1), CompactedDecl.LocalDef (li,c2,t2) :: q ->
+      if EConstr.eq_constr sigma c1 c2 && EConstr.eq_constr sigma t1 t2
+      then CompactedDecl.LocalDef ((Some status, i1)::li, c2, t2) :: q
+      else CompactedDecl.LocalDef ([Some status, i1],c1,t1) :: CompactedDecl.LocalDef (li,c2,t2) :: q
+    | NamedDecl.LocalAssum (i,t), q ->
+      CompactedDecl.LocalAssum ([Some status,i],t) :: q
+    | NamedDecl.LocalDef (i,c,t), q ->
+      CompactedDecl.LocalDef ([Some status,i],c,t) :: q
+  in
+  let ctx = EConstr.fold_named_context_val (fun _ status d acc -> compact acc status d) sign ~init:[] in
+  List.map (function
+      | CompactedDecl.LocalAssum (ids, t) -> CompactedDecl.LocalAssum (List.rev ids, t)
+      | CompactedDecl.LocalDef (ids, a, b) -> CompactedDecl.LocalDef (List.rev ids, a, b))
+    ctx
diff --git a/printing/ppconstr.mli b/printing/ppconstr.mli
index c1921f57fa3f..7735b7ff1856 100644
--- a/printing/ppconstr.mli
+++ b/printing/ppconstr.mli
@@ -96,3 +96,18 @@ val modular_constr_pr :
   flags:flags ->
   ((unit->Pp.t) -> int option -> entry_relative_level -> constr_expr -> Pp.t) ->
   (unit->Pp.t) -> int option -> entry_relative_level -> constr_expr -> Pp.t
+
+module CompactedDecl : sig
+  type t =
+    | LocalAssum of (Environ.var_status option * Id.t EConstr.binder_annot) list * EConstr.types
+    | LocalDef of (Environ.var_status option * Id.t EConstr.binder_annot) list * EConstr.constr * EConstr.types
+
+  val of_named_decl : Environ.var_status option -> EConstr.named_declaration -> t
+
+  val to_tuple : t ->
+    Id.t EConstr.binder_annot list *
+    EConstr.constr option *
+    EConstr.types
+end
+
+val compact_named_context : Evd.evar_map -> Environ.named_context_val -> CompactedDecl.t list
diff --git a/printing/pputils.ml b/printing/pputils.ml
index d4ff84b4aa9b..e692e3a4ee9d 100644
--- a/printing/pputils.ml
+++ b/printing/pputils.ml
@@ -15,19 +15,17 @@ open Locus
 
 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 extract_comments pos =
+  (* Take all comments that terminates before pos, or begin exactly
+     at pos (used to print comments attached after an expression) *)
+  let is_before ((b,e),_) = e <= pos || Int.equal pos b in
+  let before, after = List.partition is_before !beautify_comments in
+  beautify_comments := after;
+  List.rev_map snd before
 
 let pr_located pr (loc, x) =
   match loc with
-  | Some loc when !Flags.beautify ->
+  | Some loc ->
     let (b, e) = Loc.unloc loc in
     (* Side-effect: order matters *)
     let before = Pp.comment (extract_comments b) in
diff --git a/printing/printer.ml b/printing/printer.ml
index 228bc269085f..1021090fa7c4 100644
--- a/printing/printer.ml
+++ b/printing/printer.ml
@@ -22,7 +22,7 @@ open Declarations
 
 module RelDecl = Context.Rel.Declaration
 module NamedDecl = Context.Named.Declaration
-module CompactedDecl = Context.Compacted.Declaration
+module CompactedDecl = Ppconstr.CompactedDecl
 
 (* This is set on by proofgeneral proof-tree mode. But may be used for
    other purposes *)
@@ -227,70 +227,53 @@ let q_ident = Id.of_string "α"
 
 let u_ident = Id.of_string "u"
 
-let universe_binders_with_opt_names orig names =
-  let open Univ in
-  let {UVars.quals = qorig; UVars.univs = uorig} = UVars.AbstractContext.names orig in
-  let qorig, uorig as orig = Array.to_list qorig, Array.to_list uorig in
-  let qdecl, udecl = match names with
-  | None -> orig
+(** Replace the names in [uctx] with either:
+    - the exact names in [user_names];
+    - the existing names in [uctx], eventually freshened; or
+    - fresh names generated from the default id *)
+let fill_names ?user_names uctx =
+  let open UVars in
+  let { quals; univs } = AbstractContext.names uctx in
+  let user_qnames, user_unames = match user_names with
+  | None -> Array.map (fun _ -> Anonymous) quals, Array.map (fun _ -> Anonymous) univs
   | Some (gref, (qdecl, udecl)) ->
-    try
-      let qs =
-        List.map2 (fun orig {CAst.v = na} ->
-            match na with
-            | Anonymous -> orig
-            | Name id -> Name id) qorig qdecl
-      in
-      let us =
-        List.map2 (fun orig {CAst.v = na} ->
-            match na with
-            | Anonymous -> orig
-            | Name id -> Name id) uorig udecl
-      in
-      qs, us
-    with Invalid_argument _ ->
+    let quals = Array.map_of_list (fun lname -> lname.CAst.v) qdecl in
+    let univs = Array.map_of_list (fun lname -> lname.CAst.v) udecl in
+    let user_size = Array.length quals, Array.length univs in
+    if not (eq_sizes (AbstractContext.size uctx) user_size) then
       let open UnivGen in
       raise (UniverseLengthMismatch {
           gref;
-          actual = List.length qorig, List.length uorig;
-          expect = List.length qdecl, List.length udecl;
+          actual = AbstractContext.size uctx;
+          expect = Array.length quals, Array.length univs;
         })
+    else quals, univs
   in
-  let fold_qnamed i ((qbind,ubind),(revqbind,revubind) as o) = function
-    | Name id -> let ui = Sorts.QVar.make_var i in
-      (Id.Map.add id ui qbind, ubind), (Sorts.QVar.Map.add ui id revqbind, revubind)
-    | Anonymous -> o
-  in
-  let fold_unamed i ((qbind,ubind),(revqbind,revubind) as o) = function
-    | Name id -> let ui = Level.var i in
-      (qbind, Id.Map.add id ui ubind), (revqbind, Level.Map.add ui id revubind)
-    | Anonymous -> o
-  in
-  let names = List.fold_left_i fold_qnamed 0 UnivNames.(empty_binders,empty_rev_binders) qdecl in
-  let names = List.fold_left_i fold_unamed 0 names udecl in
-  let fold_qanons i (u_ident, ((qbind,ubind), (revqbind,revubind)) as o) = function
-    | Name _ -> o
-    | Anonymous ->
-      let ui = Sorts.QVar.make_var i in
-      let id = Namegen.next_ident_away_from u_ident (fun id -> Id.Map.mem id qbind) in
-      (id, ((Id.Map.add id ui qbind, ubind), (Sorts.QVar.Map.add ui id revqbind, revubind)))
+  let add_id bounds = function Anonymous -> bounds | Name id -> Id.Set.add id bounds in
+  let boundqs = Array.fold_left add_id Id.Set.empty user_qnames in
+  let boundus = Array.fold_left add_id Id.Set.empty user_unames in
+  let freshen_name bounds user_name name = match user_name, name with
+  | Name id, _ -> bounds, Name id
+  | Anonymous, Anonymous -> bounds, Anonymous
+  | Anonymous, Name id ->
+    let id = Namegen.next_ident_away_from id (fun id -> Id.Set.mem id bounds) in
+    Id.Set.add id bounds, Name id
   in
-  let fold_uanons i (u_ident, ((qbind,ubind), (revqbind,revubind)) as o) = function
-    | Name _ -> o
-    | Anonymous ->
-      let ui = Level.var i in
-      let id = Namegen.next_ident_away_from u_ident (fun id -> Id.Map.mem id ubind) in
-      (id, ((qbind,Id.Map.add id ui ubind), (revqbind,Level.Map.add ui id revubind)))
+  let boundqs, quals = Array.fold_left2_map freshen_name boundqs user_qnames quals in
+  let boundus, univs = Array.fold_left2_map freshen_name boundus user_unames univs in
+  let gen_name (uid, bounds as acc) = function
+  | Name id -> acc, Name id
+  | Anonymous ->
+    let uid = Namegen.next_ident_away_from uid (fun id -> Id.Set.mem id bounds) in
+    (uid, Id.Set.add uid bounds), Name uid
   in
-  let (_, names) = List.fold_left_i fold_qanons 0 (q_ident, names) qdecl in
-  let (_, names) = List.fold_left_i fold_uanons 0 (u_ident, names) udecl in
-  names
+  let _, quals = Array.fold_left_map gen_name (q_ident, boundqs) quals in
+  let _, univs = Array.fold_left_map gen_name (u_ident, boundus) univs in
+  AbstractContext.refine_names { quals; univs } uctx
 
 let pr_sort_context_set sigma c =
   if !PrintingFlags.print_universes && not (UnivGen.is_empty_sort_context c) then
-    let prl = Termops.pr_evd_level sigma in
-    let prv = Termops.pr_evd_qvar sigma in
-    let ctx = UnivGen.pr_sort_context prv prl c in
+    let ctx = UnivGen.pr_sort_context (Evd.sort_printer sigma) c in
     fnl() ++ pr_in_comment (v 0 ctx)
   else
     mt()
@@ -300,8 +283,7 @@ let pr_universe_ctx sigma ?variance c =
     fnl()++
     pr_in_comment
       (v 0
-         (UVars.UContext.pr (Termops.pr_evd_qvar sigma) (Termops.pr_evd_level sigma)
-            ?variance c))
+         (UVars.UContext.pr (Evd.sort_printer sigma) ?variance c))
   else
     mt()
 
@@ -309,9 +291,8 @@ let pr_abstract_universe_ctx sigma ?variance ?priv c =
   let priv = Option.default Univ.ContextSet.empty priv in
   let has_priv = not (Univ.ContextSet.is_empty priv) in
   if !PrintingFlags.print_universes && (not (UVars.AbstractContext.is_empty c) || has_priv) then
-    let prqvar u = Termops.pr_evd_qvar sigma u in
     let prlev u = Termops.pr_evd_level sigma u in
-    let pub = (if has_priv then str "Public universes:" ++ fnl() else mt()) ++ v 0 (UVars.AbstractContext.pr prqvar prlev ?variance c) in
+    let pub = (if has_priv then str "Public universes:" ++ fnl() else mt()) ++ v 0 (UVars.AbstractContext.pr (Evd.sort_printer sigma) ?variance c) in
     let priv = if has_priv then fnl() ++ str "Private universes:" ++ fnl() ++ v 0 (Univ.ContextSet.pr prlev priv) else mt() in
     fnl()++pr_in_comment (pub ++ priv)
   else
@@ -329,7 +310,6 @@ let pr_global = pr_global_env Id.Set.empty
 
 let pr_universe_instance_binder evd inst csts =
   let open Univ in
-  let prqvar = Termops.pr_evd_qvar evd in
   let prlev = Termops.pr_evd_level evd in
   let pcsts = if UnivConstraints.is_empty csts then mt()
     else strbrk " | " ++
@@ -337,12 +317,10 @@ let pr_universe_instance_binder evd inst csts =
            (fun (u,d,v) -> hov 0 (prlev u ++ UnivConstraint.pr_kind d ++ prlev v))
            (UnivConstraints.elements csts)
   in
-  str"@{" ++ UVars.Instance.pr prqvar prlev inst ++ pcsts ++ str"}"
+  str"@{" ++ UVars.Instance.pr (Evd.sort_printer evd) inst ++ pcsts ++ str"}"
 
 let pr_universe_instance evd inst =
-  let prqvar = Termops.pr_evd_qvar evd in
-  let prlev = Termops.pr_evd_level evd in
-  str "@{" ++ UVars.Instance.pr prqvar prlev inst ++ str "}"
+  str "@{" ++ UVars.Instance.pr (Evd.sort_printer evd) inst ++ str "}"
 
 let pr_puniverses f env sigma (c,u) =
   if !PrintingFlags.print_universes
@@ -381,37 +359,42 @@ let pr_pattern t = pr_pattern_env (Global.env()) empty_names_context t*)
 
 (* 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 { Goptions.get = get_compact_context } =
+  Goptions.declare_bool_option_and_ref ~key:["Printing";"Compact";"Contexts"] ~value:false ()
+
+let { Goptions.get = print_var_status } =
+  Goptions.declare_bool_option_and_ref ~key:["Printing";"Variables";"Status"] ~value:false ()
 
-let pr_compacted_decl ?flags env sigma decl =
+let pr_ecompacted_decl ?flags env sigma decl =
   let ids, pbody, typ = match decl with
     | CompactedDecl.LocalAssum (ids, typ) ->
-       ids, None, typ
-    | CompactedDecl.LocalDef (ids,c,typ) ->
-       (* Force evaluation *)
-       let pb = pr_lconstr_env ?flags ~inctx:true env sigma c in
-       let pb = if isCast c then surround pb else pb in
-       ids, Some pb, typ in
+      ids, None, typ
+    | CompactedDecl.LocalDef (ids, c, typ) ->
+      (* Force evaluation *)
+      let pb = pr_leconstr_env ?flags ~inctx:true env sigma c in
+      let pb = if EConstr.isCast sigma c then surround pb else pb in
+      ids, Some pb, typ in
+  let pp_status status =
+    if print_var_status() then
+      match status with
+      | None -> mt()
+      | Some SecVar -> spc() ++ pr_in_comment (str "section variable")
+      | Some ProofVar -> spc() ++ pr_in_comment (str "hypothesis")
+    else mt()
+  in
   let pids =
-    hov 0 (prlist_with_sep pr_comma (fun id -> pr_id id.binder_name) ids) in
-  let pt = pr_ltype_env ?flags env sigma typ in
+    hov 0 (prlist_with_sep pr_comma (fun (status, id) -> pr_id id.binder_name ++ pp_status status) ids) in
+  let pt = pr_letype_env ?flags env sigma typ in
   match pbody with
   | None -> hov 2 (pids ++ str" :" ++ spc () ++ pt)
   | Some pbody ->
-     hov 2 (pids ++ str" :=" ++ spc () ++ pbody ++ spc () ++ str": " ++ pt)
+    hov 2 (pids ++ str" :=" ++ spc () ++ pbody ++ spc () ++ str": " ++ pt)
 
-let pr_ecompacted_decl ?flags env sigma (decl:EConstr.compacted_declaration) =
-  let Refl = EConstr.Unsafe.eq in
-  pr_compacted_decl ?flags env sigma decl
-
-let pr_named_decl ?flags env sigma decl =
-  decl |> CompactedDecl.of_named_decl |> pr_compacted_decl ?flags env sigma
+let pr_enamed_decl ?flags env sigma status decl =
+  decl |> CompactedDecl.of_named_decl status |> pr_ecompacted_decl ?flags env sigma
 
-let pr_enamed_decl ?flags env sigma (decl:EConstr.named_declaration) =
-  let Refl = EConstr.Unsafe.eq in
-  pr_named_decl ?flags env sigma decl
+let pr_named_decl ?flags env sigma status (decl:Constr.named_declaration) =
+  pr_enamed_decl ?flags env sigma status (EConstr.of_named_decl decl)
 
 let pr_rel_decl ?flags env sigma decl =
   let na = RelDecl.get_name decl in
@@ -439,19 +422,18 @@ let pr_erel_decl ?flags env sigma (decl:EConstr.rel_declaration) =
  * It's printed out from outermost to innermost, so it's readable. *)
 
 (* Prints a signature, all declarations on the same line if possible *)
+
+let pr_named_context ?flags env sigma ctx =
+  hv 0 (prlist_with_sep (fun () -> ws 2) (fun d -> pr_named_decl ?flags env sigma None d) ctx)
+
 let pr_named_context_of ?flags env sigma =
-  let make_decl_list env d pps = pr_named_decl ?flags env sigma d :: pps in
+  let make_decl_list env status d pps = pr_named_decl ?flags env sigma (Some status) 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 ?flags env sigma decl =
   hov 0 (pr_ecompacted_decl ?flags env sigma decl)
 
-let pr_named_context ?flags env sigma ne_context =
-  hv 0 (Context.Named.fold_outside
-          (fun d pps -> pps ++ ws 2 ++ pr_named_decl ?flags env sigma d)
-          ne_context ~init:(mt ()))
-
 let pr_rel_context ?(flags=current_combined()) env sigma rel_context =
   let ppflags = Ppconstr.of_printing_flags flags in
   let rel_context = EConstr.of_rel_context rel_context in
@@ -463,11 +445,11 @@ let pr_rel_context_of ?flags env sigma =
 (* Prints an env (variables and de Bruijn). Separator: newline *)
 let pr_context_unlimited ?flags env sigma =
   let sign_env =
-    Context.Compacted.fold
+    List.fold_right
       (fun d pps ->
          let pidt =  pr_ecompacted_decl ?flags env sigma d in
          (pps ++ fnl () ++ pidt))
-      (Termops.compact_named_context sigma (EConstr.named_context env)) ~init:(mt ())
+      (compact_named_context sigma (Environ.named_context_val env)) (mt ())
   in
   let db_env =
     fold_rel_context
@@ -496,7 +478,7 @@ let should_compact env sigma typ =
 let rec bld_sign_env ?flags env sigma ctxt pps =
   match ctxt with
   | [] -> pps
-  | CompactedDecl.LocalAssum (ids,typ)::ctxt' when should_compact env sigma typ ->
+  | CompactedDecl.LocalAssum (_,typ)::ctxt' when should_compact env sigma typ ->
     let pps',ctxt' = bld_sign_env_id ?flags env sigma ctxt (mt ()) true in
     (* putting simple hyps in a more horizontal flavor *)
     bld_sign_env ?flags env sigma ctxt' (pps ++ brk (0,0) ++ hov 0 pps')
@@ -507,7 +489,7 @@ let rec bld_sign_env ?flags env sigma ctxt pps =
 and bld_sign_env_id ?flags env sigma ctxt pps is_start =
   match ctxt with
   | [] -> pps,ctxt
- | CompactedDecl.LocalAssum(ids,typ) as d :: ctxt' when should_compact env sigma typ ->
+ | CompactedDecl.LocalAssum(_,typ) as d :: ctxt' when should_compact env sigma typ ->
     let pidt = pr_var_list_decl ?flags env sigma d in
     let pps' = pps ++ (if not is_start then brk (3,0) else (mt ())) ++ pidt in
     bld_sign_env_id ?flags env sigma ctxt' pps' false
@@ -517,8 +499,8 @@ and bld_sign_env_id ?flags env sigma ctxt pps is_start =
 (* compact printing an env (variables and de Bruijn). Separator: three
    spaces between simple hyps, and newline otherwise *)
 let pr_context_limit_compact ?n ?flags env sigma =
-  let ctxt = EConstr.named_context env in
-  let ctxt = Termops.compact_named_context sigma ctxt in
+  let ctxt = Environ.named_context_val env in
+  let ctxt = compact_named_context sigma ctxt in
   let lgth = List.length ctxt in
   let n_capped =
     match n with
@@ -543,9 +525,9 @@ let { Goptions.get = print_hyps_limit } =
     ~value:None
     ()
 
-let pr_context_of ?flags env sigma = match print_hyps_limit () with
-  | None -> hv 0 (pr_context_limit_compact ?flags env sigma)
-  | Some n -> hv 0 (pr_context_limit_compact ~n ?flags env sigma)
+let pr_context_of ?flags env sigma =
+  let n = print_hyps_limit () in
+  hv 0 (pr_context_limit_compact ?n ?flags env sigma)
 
 (* display goal parts (Proof mode) *)
 
@@ -1098,6 +1080,7 @@ type axiom =
   | Guarded of GlobRef.t
   | TypeInType of GlobRef.t
   | UIP of MutInd.t
+  | IndicesNotMattering of MutInd.t
 
 type context_object =
   | Variable of Id.t (* A section variable or a Let definition *)
@@ -1115,7 +1098,8 @@ struct
     | Constant k1 , Constant k2 ->
       Constant.UserOrd.compare k1 k2
     | Positive m1 , Positive m2
-    | UIP m1, UIP m2 ->
+    | UIP m1, UIP m2
+    | IndicesNotMattering m1, IndicesNotMattering m2 ->
       MutInd.UserOrd.compare m1 m2
     | Guarded k1 , Guarded k2
     | TypeInType k1, TypeInType k2 ->
@@ -1128,6 +1112,8 @@ struct
     | _, Guarded _ -> 1
     | TypeInType _, _ -> -1
     | _, TypeInType _ -> 1
+    | UIP _, _ -> -1
+    | _, UIP _ -> 1
 
   let compare x y =
     match x , y with
@@ -1192,6 +1178,8 @@ let pr_assumptionset ?(flags=current_combined()) env sigma s =
           hov 2 (safe_pr_global env gr ++ spc () ++ strbrk"relies on an unsafe hierarchy.")
       | UIP mind ->
           hov 2 (safe_pr_inductive env mind ++ spc () ++ strbrk"relies on definitional UIP.")
+      | IndicesNotMattering mind ->
+          hov 2 (safe_pr_inductive env mind ++ spc () ++ strbrk"relies on indices not mattering.")
     in
     let fold t typ accu =
       let (v, a, o, tr) = accu in
diff --git a/printing/printer.mli b/printing/printer.mli
index 7925a1a286ec..7413d617f289 100644
--- a/printing/printer.mli
+++ b/printing/printer.mli
@@ -153,17 +153,15 @@ val pr_universes  : evar_map ->
   ?variance:UVars.Variance.t array -> ?priv:Univ.ContextSet.t ->
   Declarations.universes -> Pp.t
 
-(** [universe_binders_with_opt_names ref l]
-
-    If [l] is [Some univs] return the universe binders naming the
-   bound levels of [ref] by [univs] (generating names for Anonymous).
-   May error if the lengths mismatch.
-
-    Otherwise return the bound universe names registered for [ref].
+(** [fill_names ref l]
 
+    Generates names for Anonymous entries in [ref].
+    If [l] is [Some univs], use first the names in [univs],
+    then those in [ref] and finally generated names.
+    Can raise [UniverseLengthMismatch].
     Inefficient on large contexts due to name generation. *)
-val universe_binders_with_opt_names : UVars.AbstractContext.t ->
-  (GlobRef.t * UnivNames.full_name_list) option -> UnivNames.universe_binders * UnivNames.rev_binders
+val fill_names : ?user_names:(GlobRef.t * UnivNames.univ_name_list) ->
+  UVars.AbstractContext.t -> UVars.AbstractContext.t
 
 (** Printing global references using names as short as possible *)
 
@@ -185,24 +183,18 @@ val pr_notation_interpretation_env : env -> evar_map -> glob_constr -> 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 : ?flags:PrintingFlags.t -> env -> evar_map -> Pp.t
 val pr_ne_context_of : Pp.t -> ?flags:PrintingFlags.t -> env -> evar_map -> Pp.t
 
 val pr_named_decl : ?flags:PrintingFlags.t ->
-  env -> evar_map -> Constr.named_declaration -> Pp.t
-val pr_compacted_decl : ?flags:PrintingFlags.t ->
-  env -> evar_map -> Constr.compacted_declaration -> Pp.t
+  env -> evar_map -> var_status option -> Constr.named_declaration -> Pp.t
 val pr_rel_decl : ?flags:PrintingFlags.t ->
   env -> evar_map -> Constr.rel_declaration -> Pp.t
 
 val pr_enamed_decl : ?flags:PrintingFlags.t ->
-  env -> evar_map -> EConstr.named_declaration -> Pp.t
+  env -> evar_map -> var_status option -> EConstr.named_declaration -> Pp.t
 val pr_ecompacted_decl : ?flags:PrintingFlags.t ->
-  env -> evar_map -> EConstr.compacted_declaration -> Pp.t
+  env -> evar_map -> Ppconstr.CompactedDecl.t -> Pp.t
 val pr_erel_decl : ?flags:PrintingFlags.t ->
   env -> evar_map -> EConstr.rel_declaration -> Pp.t
 
@@ -251,6 +243,7 @@ type axiom =
   | Guarded of GlobRef.t (* a constant whose (co)fixpoints have been assumed to be guarded *)
   | TypeInType of GlobRef.t (* a constant which relies on type in type *)
   | UIP of MutInd.t (* An inductive using the special reduction rule. *)
+  | IndicesNotMattering of MutInd.t (* An inductive relying on indices not mattering. *)
 
 type context_object =
   | Variable of Id.t (* A section variable or a Let definition *)
diff --git a/printing/proof_diffs.ml b/printing/proof_diffs.ml
index bf6dd6fd68fe..12eec5366745 100644
--- a/printing/proof_diffs.ml
+++ b/printing/proof_diffs.ml
@@ -233,13 +233,6 @@ type goal = { ty: EConstr.t; env : Environ.env; sigma : Evd.evar_map; }
 
 (* XXX: Port to proofview, one day. *)
 (* open Proofview *)
-module CDC = Context.Compacted.Declaration
-
-let to_tuple : EConstr.compacted_declaration -> (Names.Id.t EConstr.binder_annot list * 'pc option * 'pc) =
-  let open CDC in function
-    | LocalAssum(idl, tm)   -> (idl, None, tm)
-    | LocalDef(idl,tdef,tm) -> (idl, Some tdef, tm)
-
 let make_goal env sigma g =
   let evi = Evd.find_undefined sigma g in
   let env = Evd.evar_filtered_env env evi in
@@ -297,7 +290,7 @@ let goal_info ~flags goal =
   let map = ref CString.Map.empty in
   let line_idents = ref [] in
   let build_hyp_info env sigma hyp =
-    let (names, body, ty) = to_tuple hyp in
+    let (names, body, ty) = Ppconstr.CompactedDecl.to_tuple hyp in
     let open Pp in
     let idents = List.map (fun x -> Names.Id.to_string x.Context.binder_name) names in
 
@@ -318,7 +311,7 @@ let goal_info ~flags goal =
   try
     let { ty=ty; env=env; sigma } = goal in
     (* compaction is usually desired [eg for better display] *)
-    let hyps = Termops.compact_named_context sigma (EConstr.named_context env) in
+    let hyps = Ppconstr.compact_named_context sigma (Environ.named_context_val env) in
     let () = List.iter (build_hyp_info env sigma) (List.rev hyps) in
     let concl_pp = pp_of_type ~flags env sigma ty in
     ( List.rev !line_idents, !map, concl_pp )
@@ -346,7 +339,7 @@ let diff_goal ?(short=false) ?og_s ~flags ng =
 
 module GoalMap = Evar.Map
 
-let goal_to_evar g sigma = Names.Id.to_string (Termops.evar_suggested_name (Global.env ()) sigma g)
+let goal_to_evar g sigma = Termops.evar_string (Global.env ()) sigma g
 
 open Evar.Set
 
diff --git a/proofs/clenv.ml b/proofs/clenv.ml
index dcb09c2197a2..34fedfef151e 100644
--- a/proofs/clenv.ml
+++ b/proofs/clenv.ml
@@ -991,7 +991,7 @@ let build_case_analysis env sigma (ind, u) params pred indices indarg dep knd =
 
   match projs with
   | None ->
-    let ci = make_case_info env ind RegularStyle in
+    let ci = make_case_info env ind MatchStyle in
     let pbody =
       mkApp
         (pred,
@@ -1029,7 +1029,7 @@ let case_pf ?(with_evars=false) ~dep (indarg, typ) =
   let () = if Inductive.is_private (mib, mip) then
     user_err Pp.(str "case analysis on a private type is not allowed.") in
   (* check dep elim *)
-  let () = if dep && not (Inductiveops.has_dependent_elim (mib, mip)) then
+  let () = if dep && not (Inductiveops.has_dependent_elim sigma (mib, mip) u) then
     raise (Pretype_errors.error_not_allowed_dependent_elimination env sigma true ind) in
   (* check elim *)
   let sigma =
diff --git a/proofs/dune b/proofs/dune
index 3d1781f67cb9..30deacb40443 100644
--- a/proofs/dune
+++ b/proofs/dune
@@ -5,7 +5,3 @@
  (wrapped false)
  (modules_without_implementation tactypes)
  (libraries pretyping))
-
-(deprecated_library_name
- (old_public_name coq-core.proofs)
- (new_public_name rocq-runtime.proofs))
diff --git a/proofs/logic.ml b/proofs/logic.ml
index b46b1631a1e5..4b088b58e402 100644
--- a/proofs/logic.ml
+++ b/proofs/logic.ml
@@ -82,28 +82,30 @@ let reorder_context env sigma sign ord =
     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 sigma h d then
-            user_err
-              (str "Cannot move declaration " ++ Id.print top ++ spc() ++
-              str "before " ++
-              pr_sequence Id.print
-                (Id.Set.elements (Id.Set.inter h
-                  (global_vars_set_of_decl env sigma d))) ++ str ".");
-          step ord' expected ctxt_head mh (d::ctxt_tail)
-      | _ ->
-          (match ctxt_head with
-            | [] -> error_no_such_hypothesis env sigma (List.hd ord)
-            | d :: ctxt ->
-                let x = NamedDecl.get_id d in
-                if Id.Set.mem x expected then
-                  step ord (Id.Set.remove x expected)
-                    ctxt (push_item x d moved_hyps) ctxt_tail
-                else
-                  step ord expected
-                    ctxt (push_val x moved_hyps) (d::ctxt_tail)) in
+    | [] ->
+      List.fold_left (fun accu (status,decl) -> EConstr.push_named_context_val status decl accu)
+        ctxt_head ctxt_tail
+    | top::ord' when mem_q top moved_hyps ->
+      let (((status,d),h),mh) = find_q top moved_hyps in
+      if occur_vars_in_decl env sigma h d then
+        user_err
+          (str "Cannot move declaration " ++ Id.print top ++ spc() ++
+           str "before " ++
+           pr_sequence Id.print
+             (Id.Set.elements (Id.Set.inter h (global_vars_set_of_decl env sigma d))) ++
+           str ".");
+      step ord' expected ctxt_head mh ((status,d)::ctxt_tail)
+    | _ ->
+      (match EConstr.match_named_context_val ctxt_head with
+       | None -> error_no_such_hypothesis env sigma (List.hd ord)
+       | Some (status, d, ctxt) ->
+         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 (status, d) moved_hyps) ctxt_tail
+         else
+           step ord expected
+             ctxt (push_val x moved_hyps) ((status,d)::ctxt_tail)) in
   step ord ords sign mt_q []
 
 let reorder_val_context env sigma sign ord =
@@ -112,8 +114,7 @@ match ord with
   (* Single variable-free definitions need not be reordered *)
   sign
 | _ :: _ :: _ ->
-  let open EConstr in
-  val_of_named_context (reorder_context env sigma (named_context_of_val sign) ord)
+  reorder_context env sigma sign ord
 
 let check_decl_position env sigma sign d =
   let open EConstr in
@@ -151,16 +152,16 @@ let move_location_eq m1 m2 = match m1, m2 with
 | MoveFirst, MoveFirst -> true
 | _ -> false
 
-let mem_id_context id ctx = Id.Map.mem id ctx.Environ.env_named_map
+let mem_id_context id ctx = Environ.mem_named_ctxt id ctx
 
 let split_sign env sigma hfrom l =
   let () = if not (mem_id_context hfrom l) then error_no_such_hypothesis env sigma hfrom in
   let rec splitrec left sign = match EConstr.match_named_context_val sign with
   | None -> assert false
-  | Some (d, right) ->
+  | Some (status, d, right) ->
     let hyp = NamedDecl.get_id d in
-    if Id.equal hyp hfrom then (left, right, d)
-    else splitrec (d :: left) right
+    if Id.equal hyp hfrom then (left, right, (status, d))
+    else splitrec ((status, d) :: left) right
   in
   splitrec [] l
 
@@ -178,21 +179,26 @@ let () = CErrors.register_handler (function
 
 let move_hyp env sigma toleft (left,declfrom,right) hto =
   let open EConstr in
-  let push prefix sign = List.fold_right push_named_context_val prefix sign in
-  let push_rev prefix sign = List.fold_left (fun accu d -> push_named_context_val d accu) sign prefix in
+  let idfrom = NamedDecl.get_id (snd declfrom) in
+  let push prefix sign =
+    List.fold_right (fun (status,d) sign -> push_named_context_val status d sign) prefix sign
+  in
+  let push_rev prefix sign =
+    List.fold_left (fun accu (status,d) -> push_named_context_val status d accu) sign prefix
+  in
   let rec moverec_toleft ans first middle midvars = function
     | [] -> push middle @@ push first ans
-    | d :: _ as right when move_location_eq hto (MoveBefore (NamedDecl.get_id d)) ->
+    | (_, d) :: _ as right when move_location_eq hto (MoveBefore (NamedDecl.get_id d)) ->
       push_rev right @@ push middle @@ push first ans
-    | d :: right ->
+    | (status, d) :: right ->
         let hyp = NamedDecl.get_id d in
         let (first', middle', midvars') =
           if occur_vars_in_decl env sigma midvars d then
             if not (move_location_eq hto (MoveAfter hyp)) then
-              (first, d :: middle, Id.Set.add hyp midvars)
-            else raise (CannotMoveHyp {from = NamedDecl.get_id declfrom; hto; hyp})
+              (first, (status, d) :: middle, Id.Set.add hyp midvars)
+            else raise (CannotMoveHyp {from = idfrom; hto; hyp})
           else
-            (d::first, middle, midvars)
+            ((status,d)::first, middle, midvars)
         in
         if move_location_eq hto (MoveAfter hyp) then
           push_rev right @@ push middle' @@ push first' ans
@@ -201,19 +207,19 @@ let move_hyp env sigma toleft (left,declfrom,right) hto =
   in
   let rec moverec_toright first middle depvars right = match EConstr.match_named_context_val right with
     | None -> push_rev first @@ push_rev middle right
-    | Some (d, _) when move_location_eq hto (MoveBefore (NamedDecl.get_id d)) ->
+    | Some (status, d, _) when move_location_eq hto (MoveBefore (NamedDecl.get_id d)) ->
         push_rev first @@ push_rev middle @@ right
-    | Some (d, right) ->
+    | Some (status, d, right) ->
         let hyp = NamedDecl.get_id d in
         let (first', middle', depvars') =
           if Id.Set.mem hyp depvars then
             if not (move_location_eq hto (MoveAfter hyp)) then
               let vars = global_vars_set_of_decl env sigma d in
               let depvars = Id.Set.union vars depvars in
-              (first, d::middle, depvars)
-            else raise (CannotMoveHyp {from = NamedDecl.get_id declfrom; hto; hyp})
+              (first, (status, d)::middle, depvars)
+            else raise (CannotMoveHyp {from = idfrom; hto; hyp})
           else
-            (d::first, middle, depvars)
+            ((status,d)::first, middle, depvars)
         in
         if move_location_eq hto (MoveAfter hyp) then
           push_rev first' @@ push_rev middle' @@ right
@@ -221,10 +227,9 @@ let move_hyp env sigma toleft (left,declfrom,right) hto =
           moverec_toright first' middle' depvars' right
   in
   if toleft then
-    let id = NamedDecl.get_id declfrom in
-    moverec_toleft right [] [declfrom] (Id.Set.singleton id) left
+    moverec_toleft right [] [declfrom] (Id.Set.singleton idfrom) left
   else
-    let depvars = global_vars_set_of_decl env sigma declfrom in
+    let depvars = global_vars_set_of_decl env sigma (snd declfrom) in
     let right = moverec_toright [] [declfrom] depvars right in
     push_rev left @@ right
 
@@ -259,6 +264,6 @@ let convert_hyp ~check ~reorder env sigma d =
     if check && not (Option.equal (is_conv env sigma) b c) then
       user_err
         (str "Incorrect change of the body of "++ Id.print id ++ str ".");
-    let sign' = apply_to_hyp sign id (fun _ _ _ -> EConstr.Unsafe.to_named_decl d) in
+    let sign' = apply_to_hyp sign id (fun _ status _ _ -> status, EConstr.Unsafe.to_named_decl d) in
     if reorder then reorder_val_context env sigma sign' (check_decl_position env sigma sign d)
     else sign'
diff --git a/proofs/logic.mli b/proofs/logic.mli
index 1983c8b6f49f..32a3f92c8b34 100644
--- a/proofs/logic.mli
+++ b/proofs/logic.mli
@@ -61,5 +61,5 @@ val move_hyp_in_named_context : Environ.env -> Evd.evar_map -> Id.t -> Id.t move
   Environ.named_context_val -> Environ.named_context_val
 
 val insert_decl_in_named_context : Environ.env -> Evd.evar_map ->
-  EConstr.named_declaration -> Id.t move_location ->
+  Environ.var_status * EConstr.named_declaration -> Id.t move_location ->
   Environ.named_context_val -> Environ.named_context_val
diff --git a/proofs/refine.ml b/proofs/refine.ml
index 1068d0d94dbd..d7f378482404 100644
--- a/proofs/refine.ml
+++ b/proofs/refine.ml
@@ -17,30 +17,38 @@ module NamedDecl = Context.Named.Declaration
 let extract_prefix env info =
   let ctx1 = List.rev (EConstr.named_context env) in
   let ctx2 = List.rev (Evd.evar_context info) in
-  let rec share l1 l2 accu = match l1, l2 with
+  let rec share l1 l2 = match l1, l2 with
   | d1 :: l1, d2 :: l2 ->
-    if d1 == d2 then share l1 l2 (d1 :: accu)
-    else (accu, d2 :: l2)
-  | _ -> (accu, l2)
+    if d1 == d2 then share l1 l2
+    else 1 + List.length l2
+  | _ -> List.length l2
   in
-  share ctx1 ctx2 []
+  share ctx1 ctx2
+
+let rec recheck_hyps n env sigma sign =
+  if n = 0 then sigma
+  else match EConstr.match_named_context_val sign with
+    | None -> assert false
+    | Some (_, decl, sign') ->
+      let sigma = recheck_hyps (n-1) env sigma sign' in
+      let env = Environ.reset_with_named_context sign' env in
+      let t = NamedDecl.get_type decl in
+      let sigma, _ = Typing.sort_of env sigma t in
+      let sigma = match decl with
+        | LocalAssum _ -> sigma
+        | LocalDef (_,body,_) -> Typing.check env sigma body t
+      in
+      sigma
 
 let typecheck_evar ev env sigma =
   let info = Evd.find_undefined sigma ev in
+  (* optim: avoid checking unchanged hyps *)
+  let changed = extract_prefix env info in
   (* Typecheck the hypotheses. *)
-  let type_hyp (sigma, env) decl =
-    let t = NamedDecl.get_type decl in
-    let sigma, _ = Typing.sort_of env sigma t in
-    let sigma = match decl with
-    | LocalAssum _ -> sigma
-    | LocalDef (_,body,_) -> Typing.check env sigma body t
-    in
-    (sigma, EConstr.push_named decl env)
-  in
-  let (common, changed) = extract_prefix env info in
-  let env = Environ.reset_with_named_context (EConstr.val_of_named_context common) env in
-  let (sigma, env) = List.fold_left type_hyp (sigma, env) changed in
+  let sign = Evd.evar_hyps info in
+  let sigma = recheck_hyps changed env sigma sign in
   (* Typecheck the conclusion *)
+  let env = Environ.reset_with_named_context sign env in
   let sigma, _ = Typing.sort_of env sigma (Evd.evar_concl info) in
   sigma
 
diff --git a/proofs/subproof.ml b/proofs/subproof.ml
index 4bb33de3a997..ca1f9b1b24b7 100644
--- a/proofs/subproof.ml
+++ b/proofs/subproof.ml
@@ -16,7 +16,7 @@ module NamedDecl = Context.Named.Declaration
 (**********************************************************************)
 (* Shortcut to build a term using tactics *)
 
-let refine_by_tactic ~name ~poly env sigma ty tac =
+let refine_by_tactic ~name ~poly ?(inline = false) env sigma ty tac =
   (* Save the initial side-effects to restore them afterwards. *)
   let eff = Evd.eval_side_effects sigma in
   let old_len = Safe_typing.length_private @@ Evd.seff_private eff in
@@ -39,25 +39,31 @@ let refine_by_tactic ~name ~poly env sigma ty tac =
   | _ -> assert false
   in
   let ans = EConstr.to_constr ~abort_on_undefined_evars:false sigma ans in
-  (* [neff] contains the freshly generated side-effects *)
-  let neff = Evd.seff_private @@ Evd.eval_side_effects sigma in
-  let new_len = Safe_typing.length_private neff in
-  let neff, _ = Safe_typing.pop_private neff (new_len - old_len) in
-  (* Reset the old side-effects *)
-  let sigma = Evd.set_side_effects eff sigma in
+  let sigma, ans =
+    if inline then
+      (* [neff] contains the freshly generated side-effects *)
+      let neff = Evd.seff_private @@ Evd.eval_side_effects sigma in
+      let new_len = Safe_typing.length_private neff in
+      let neff, _ = Safe_typing.pop_private neff (new_len - old_len) 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
+        those goals rely on effects that are not present anymore. Hopefully,
+        this hack will work in most cases. *)
+      let (ans, uctx) = Safe_typing.inline_private_constants env ((ans, Univ.ContextSet.empty), neff) in
+      (* Reset the old side-effects *)
+      let sigma = Evd.set_side_effects eff sigma in
+      let sigma = Evd.merge_universe_context_set ~sideff:true UState.UnivRigid sigma uctx in
+      sigma, ans
+    else
+      sigma, ans
+  in
   (* Restore former goals *)
   let _goals, sigma = Evd.pop_future_goals sigma 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 *)
   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
-     those goals rely on effects that are not present anymore. Hopefully,
-     this hack will work in most cases. *)
-  let (ans, uctx) = Safe_typing.inline_private_constants env ((ans, Univ.ContextSet.empty), neff) in
-  let sigma = Evd.merge_universe_context_set ~sideff:true UState.UnivRigid sigma uctx in
   EConstr.of_constr ans, sigma
 
 (* Abstract internals *)
@@ -128,14 +134,16 @@ let build_constant_by_tactic ~name ~sigma ~env ~sign ~poly typ tac =
   in
   (* FIXME: return the locally introduced effects *)
   let { Proof.sigma } = Proof.data proof in
-  let sigma = Evd.set_universe_context sigma output_ustate in
+  let sigma = Evd.set_ustate sigma output_ustate in
   (univs, body, typ), status, sigma
 
 let build_by_tactic env ~uctx ~poly ~typ tac =
   let name = Id.of_string "temporary_proof" in
-  let sign = Environ.(val_of_named_context (named_context env)) in
-  let sigma = Evd.from_ctx uctx in
-  let (univs, body, typ), status, sigma = build_constant_by_tactic ~name ~env ~sigma ~sign ~poly typ tac in
+  let sign = Environ.named_context_val env in
+  let sigma = Evd.from_ustate uctx in
+  (* status doesn't matter: any given up evars can't be in the body/typ
+     (we would get OpenProof exception) and we drop the evar part of the evar map *)
+  let (univs, body, typ), _status, sigma = build_constant_by_tactic ~name ~env ~sigma ~sign ~poly typ tac in
   let uctx = Evd.ustate sigma in
   (* ignore side effect universes:
      we don't reset the global env in this code path so the side effects are still present
@@ -143,8 +151,8 @@ let build_by_tactic env ~uctx ~poly ~typ tac =
      (but due to #13324 we still want to inline them) *)
   let effs = Evd.seff_private @@ Evd.eval_side_effects sigma in
   let body, ctx = Safe_typing.inline_private_constants env ((body, Univ.ContextSet.empty), effs) in
-  let _uctx = UState.merge_universe_context ~sideff:true Evd.univ_rigid uctx ctx in
-  body, typ, univs, status, uctx
+  let uctx = UState.merge_universe_context_set ~sideff:true Evd.univ_rigid uctx ctx in
+  body, typ, univs, uctx
 
 let build_by_tactic_opt env ~uctx ~poly ~typ tac =
   try Some (build_by_tactic env ~uctx ~poly ~typ tac)
@@ -157,6 +165,8 @@ let extract_monomorphic = function
 
 let declare_abstract ~name ~poly ~sign ~secsign ~opaque ~solve_tac env sigma concl =
   let (const, safe, sigma') =
+    (* Prevents the nested call to generate the now reserved [name] *)
+    let sigma = Evd.avoid_side_effect_label name sigma in
     try build_constant_by_tactic ~name ~poly ~env ~sigma ~sign:secsign concl solve_tac
     with Logic_monad.TacticFailure e as src ->
     (* if the tactic [tac] fails, it reports a [TacticFailure e],
diff --git a/proofs/subproof.mli b/proofs/subproof.mli
index e15fe359ec77..092a77f4fed4 100644
--- a/proofs/subproof.mli
+++ b/proofs/subproof.mli
@@ -11,23 +11,25 @@
 val refine_by_tactic
   :  name:Names.Id.t
   -> poly:PolyFlags.t
+  -> ?inline:bool
   -> Environ.env
   -> Evd.evar_map
   -> EConstr.types
   -> unit Proofview.tactic
   -> EConstr.constr * Evd.evar_map
 (** A variant of {!Proof.solve} that handles open terms as well.
-    Caveat: all effects are purged in the returned term at the end, but other
-    evars solved by side-effects are NOT purged, so that unexpected failures may
-    occur. Ideally all code using this function should be rewritten in the
-    monad. *)
+
+    Caveat: when the [inline] flag is set all effects are purged in the returned
+    term at the end, but other evars solved by side-effects are NOT purged, so
+    that unexpected failures may occur. As a result it should not be set in
+    newly written code. *)
 
 val build_by_tactic :
   Environ.env ->
   uctx:UState.t -> poly:PolyFlags.t ->
   typ:EConstr.types ->
   unit Proofview.tactic ->
-  Constr.constr * Constr.types * UState.named_universes_entry * bool * UState.t
+  Constr.constr * Constr.types * UState.named_universes_entry * UState.t
 (** Semantics of this function is a bit dubious, use with care *)
 
 val build_by_tactic_opt :
@@ -35,7 +37,7 @@ val build_by_tactic_opt :
   uctx:UState.t -> poly:PolyFlags.t ->
   typ:EConstr.types ->
   unit Proofview.tactic ->
-  (Constr.constr * Constr.types * UState.named_universes_entry * bool * UState.t) option
+  (Constr.constr * Constr.types * UState.named_universes_entry * UState.t) option
 (** Same as above but returns None rather than an exception if the proof is not finished *)
 
 val declare_abstract :
diff --git a/proofs/tacmach.ml b/proofs/tacmach.ml
index 95f62ab1e9c0..a1da48783ef7 100644
--- a/proofs/tacmach.ml
+++ b/proofs/tacmach.ml
@@ -15,7 +15,6 @@ open Reductionops
 open Typing
 open Tacred
 open Logic
-open Context.Named.Declaration
 
 module NamedDecl = Context.Named.Declaration
 
@@ -63,10 +62,8 @@ let pf_get_hyp_typ id gl =
 
 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.Context.binder_name, EConstr.of_constr x)
-            sign
+  let sign = EConstr.named_context env in
+  List.map (fun d -> NamedDecl.get_id d, NamedDecl.get_type d) sign
 
 let pf_last_hyp gl =
   let hyps = Proofview.Goal.hyps gl in
diff --git a/rocq-runtime.opam b/rocq-runtime.opam
index d8ae5ec85902..ba96b3e45246 100644
--- a/rocq-runtime.opam
+++ b/rocq-runtime.opam
@@ -36,7 +36,11 @@ depends: [
   "conf-linux-libc-dev" {os = "linux"}
   "odoc" {with-doc}
 ]
-depopts: ["rocq-native" "memprof-limits" "memtrace"]
+depopts: [
+  "rocq-native"
+  "memprof-limits" {>= "0.3.0"}
+  "memtrace"
+]
 conflicts: [
   "coq" {< "8.17"}
   "coq-core" {< "8.21"}
diff --git a/stm/asyncTaskQueue.ml b/stm/asyncTaskQueue.ml
index 872c21e03e1f..4cde9f54961e 100644
--- a/stm/asyncTaskQueue.ml
+++ b/stm/asyncTaskQueue.ml
@@ -230,7 +230,7 @@ module Make(T : Task) () = struct
     active : Pool.pool;
     queue : (T.task * cancel_switch) TQueue.t;
     cleaner : Thread.t option;
-  }
+  } [@@warning "-unused-field"] (* cleaner unused, not sure if can be removed *)
 
   let create ~spawn_args size priority =
     let cleaner queue =
diff --git a/stm/dune b/stm/dune
index c9890b853097..5645e2c73d73 100644
--- a/stm/dune
+++ b/stm/dune
@@ -6,7 +6,3 @@
  ; until ocaml/dune#4892 fixed
  ; (private_modules dag proofBlockDelimiter tQueue vcs workerPool)
  (libraries sysinit coqworkmgrApi))
-
-(deprecated_library_name
- (old_public_name coq-core.stm)
- (new_public_name rocq-runtime.stm))
diff --git a/stm/partac.ml b/stm/partac.ml
index 48d4439b9308..43f833b42d86 100644
--- a/stm/partac.ml
+++ b/stm/partac.ml
@@ -158,7 +158,7 @@ let assign_tac ~abstract res : unit Proofview.tactic =
     let open Notations in
     let push_state ctx =
       Proofview.tclEVARMAP >>= fun sigma ->
-      Proofview.Unsafe.tclEVARS (Evd.merge_universe_context sigma ctx)
+      Proofview.Unsafe.tclEVARS (Evd.merge_ustate sigma ctx)
     in
     (if abstract then Abstract.tclABSTRACT None else (fun x -> x))
       (push_state uc <*> Tactics.exact_no_check (EConstr.of_constr pt))
diff --git a/stm/workerPool.ml b/stm/workerPool.ml
index 7c2bf2a54cc4..2b223d59acba 100644
--- a/stm/workerPool.ml
+++ b/stm/workerPool.ml
@@ -34,7 +34,7 @@ type worker = {
   cancel : bool ref;
   manager : Thread.t;
   process : Model.process;
-}
+} [@@warning "-unused-field"] (* manager & process unused, not sure if can be removed *)
 
 type pre_pool = {
   workers : worker list ref;
diff --git a/sysinit/coqargs.ml b/sysinit/coqargs.ml
index e5126f8cd871..cfdbe0cf6161 100644
--- a/sysinit/coqargs.ml
+++ b/sysinit/coqargs.ml
@@ -41,6 +41,7 @@ type require_injection = { lib: string; prefix: string option; export: export_fl
 type injection_command =
   | OptionInjection of (string list * option_command)
   | RequireInjection of require_injection
+  | WarnNoBytecode
   | WarnNoNative of string
   | WarnNativeDeprecated
 
@@ -64,7 +65,6 @@ type coqargs_config = {
   native_include_dirs : CUnix.physical_path list;
   output_directory : CUnix.physical_path option;
   exclude_dirs : CUnix.physical_path list;
-  beautify : bool;
   quiet : bool;
   time : time_config option;
   test_mode : bool;
@@ -86,7 +86,7 @@ type coqargs_pre = {
   ml_includes : string list;
   vo_includes : vo_path list;
 
-  load_vernacular_list : (string * bool) list;
+  load_vernacular_list : string list;
   injections  : injection_command list;
 }
 
@@ -107,8 +107,6 @@ type t = {
 
 let default_toplevel = "Top"
 
-let default_native = Coq_config.native_compiler
-
 let default_logic_config = {
   impredicative_set = false;
   indices_matter = false;
@@ -121,13 +119,12 @@ let default_config = {
   logic        = default_logic_config;
   rcfile       = None;
   coqlib       = None;
-  enable_VM    = true;
-  native_compiler = default_native;
+  enable_VM    = Coq_config.bytecode_compiler;
+  native_compiler = Coq_config.native_compiler;
   native_output_dir = ".coq-native";
   native_include_dirs = [];
   output_directory = None;
   exclude_dirs = [];
-  beautify = false;
   quiet = false;
   time = None;
   test_mode = false;
@@ -173,8 +170,8 @@ let add_vo_include opts unix_path rocq_path implicit =
 let add_vo_require opts d ?(allow_failure=false) p export =
   { opts with pre = { opts.pre with injections = RequireInjection {lib=d; prefix=p; export; allow_failure} :: opts.pre.injections }}
 
-let add_load_vernacular opts verb s =
-    { opts with pre = { opts.pre with load_vernacular_list = (CUnix.make_suffix s ".v",verb) :: opts.pre.load_vernacular_list }}
+let add_load_vernacular opts s =
+    { opts with pre = { opts.pre with load_vernacular_list = (CUnix.make_suffix s ".v") :: opts.pre.load_vernacular_list }}
 
 let add_set_option opts opt_name value =
   { opts with pre = { opts.pre with injections = OptionInjection (opt_name, value) :: opts.pre.injections }}
@@ -231,6 +228,10 @@ let parse_option_set opt =
     let v = String.sub opt (eqi+1) (len - eqi - 1) in
     to_opt_key (String.sub opt 0 eqi), Some v
 
+let get_bytecode_compiler_warns b =
+  if b && not Coq_config.bytecode_compiler then [WarnNoBytecode]
+  else []
+
 let get_native_compiler s =
   (* We use two boolean flags because the four states make sense, even if
      only three are accessible to the user at the moment. The selection of the
@@ -301,10 +302,7 @@ let parse_args ~init arglist : t * string list =
       { oval with config = { oval.config with rcfile = Some (next ()); }}
 
     |"-load-vernac-source"|"-l" ->
-      add_load_vernacular oval false (next ())
-
-    |"-load-vernac-source-verbose"|"-lv" ->
-      add_load_vernacular oval true (next ())
+      add_load_vernacular oval (next ())
 
     |"-mangle-names" ->
       let oval = add_set_option oval ["Mangle"; "Names"] (OptionSet None) in
@@ -350,7 +348,10 @@ let parse_args ~init arglist : t * string list =
     |"-w" | "-W" -> add_set_warnings oval (next())
 
     |"-bytecode-compiler" ->
-      { oval with config = { oval.config with enable_VM = get_bool ~opt (next ()) }}
+      let b = get_bool ~opt (next ()) in
+      let warn = get_bytecode_compiler_warns b in
+      { oval with config = { oval.config with enable_VM = b };
+                  pre = { oval.pre with injections = warn @ oval.pre.injections }}
 
     |"-native-compiler" ->
       let native_compiler, warn = get_native_compiler (next ()) in
@@ -379,7 +380,6 @@ let parse_args ~init arglist : t * string list =
 
     (* Options with zero arg *)
     |"-test-mode" -> { oval with config = { oval.config with test_mode = true } }
-    |"-beautify" -> { oval with config = { oval.config with beautify = true } }
     |"-config"|"--config" -> set_query oval PrintConfig
 
     |"-bt" -> add_set_debug oval "backtrace"
diff --git a/sysinit/coqargs.mli b/sysinit/coqargs.mli
index 908524ebf584..2c5436f04c2f 100644
--- a/sysinit/coqargs.mli
+++ b/sysinit/coqargs.mli
@@ -30,6 +30,7 @@ type injection_command =
   | RequireInjection of require_injection
   (** Require libraries before the initial state is
       ready. *)
+  | WarnNoBytecode
   | WarnNoNative of string
   (** Used so that "-w -native-compiler-disabled -native-compiler yes"
      does not cause a warning. The native option must be processed
@@ -59,7 +60,6 @@ type coqargs_config = {
   native_include_dirs : CUnix.physical_path list;
   output_directory : CUnix.physical_path option;
   exclude_dirs : CUnix.physical_path list;
-  beautify : bool;
   quiet : bool;
   time : time_config option;
   test_mode : bool;
@@ -81,7 +81,7 @@ type coqargs_pre = {
   ml_includes : CUnix.physical_path list;
   vo_includes : vo_path list;
 
-  load_vernacular_list : (string * bool) list;
+  load_vernacular_list : string list;
   injections  : injection_command list;
 }
 
diff --git a/sysinit/coqinit.ml b/sysinit/coqinit.ml
index 963820a1755d..d6f777fbb8de 100644
--- a/sysinit/coqinit.ml
+++ b/sysinit/coqinit.ml
@@ -192,12 +192,6 @@ let init_document opts =
   (* Test mode *)
   Flags.test_mode := opts.config.test_mode;
 
-  (* beautify *)
-  if opts.config.beautify then begin
-    Flags.beautify := true;
-    CLexer.record_comments := true;
-  end;
-
   if opts.config.quiet then begin
     Flags.quiet := true;
   end;
@@ -225,6 +219,11 @@ let require_file ~intern ~prefix ~lib ~export ~allow_failure =
   with (Synterp.UnmappedLibrary _ | Synterp.NotFoundLibrary _) when allow_failure ->
     warn_require_not_found (mfrom, mp)
 
+let warn_no_bytecode =
+  CWarnings.create ~name:"bytecode-compiler-disabled" ~category:CWarnings.CoreCategories.bytecode_compiler
+    Pp.(fun () -> str "Bytecode compiler is disabled," ++ spc() ++
+                  str "-bytecode-compiler option ignored.")
+
 let warn_no_native_compiler =
   CWarnings.create_in Nativeconv.w_native_disabled
     Pp.(fun s -> strbrk "Native compiler is disabled," ++
@@ -259,6 +258,7 @@ let handle_injection ~intern = let open Coqargs in function
   | RequireInjection {lib;prefix;export;allow_failure} ->
     require_file ~intern ~lib ~prefix ~export ~allow_failure
   | OptionInjection o -> set_option o
+  | WarnNoBytecode -> warn_no_bytecode ()
   | WarnNoNative s -> warn_no_native_compiler s
   | WarnNativeDeprecated -> warn_deprecated_native_compiler ()
 
diff --git a/sysinit/dune b/sysinit/dune
index 94e345959d6e..1cb33e730902 100644
--- a/sysinit/dune
+++ b/sysinit/dune
@@ -7,10 +7,6 @@
  ; don't depend on rocq-runtime.lib -> impossible to imperatively set random flags
  (libraries rocq-runtime.config rocq-runtime.boot rocq-runtime.clib))
 
-(deprecated_library_name
- (old_public_name coq-core.coqargs)
- (new_public_name rocq-runtime.coqargs))
-
 (library
  (name sysinit)
  (public_name rocq-runtime.sysinit)
@@ -18,7 +14,3 @@
  (wrapped false)
  (modules :standard \ coqargs)
  (libraries rocq-runtime.boot rocq-runtime.vernac coqargs findlib))
-
-(deprecated_library_name
- (old_public_name coq-core.sysinit)
- (new_public_name rocq-runtime.sysinit))
diff --git a/tactics/abstract.ml b/tactics/abstract.ml
index 6f4267210dad..417c60dd35ad 100644
--- a/tactics/abstract.ml
+++ b/tactics/abstract.ml
@@ -9,7 +9,6 @@
 (************************************************************************)
 
 open Util
-open Termops
 open EConstr
 
 module NamedDecl = Context.Named.Declaration
@@ -18,23 +17,6 @@ module NamedDecl = Context.Named.Declaration
    the current goal, abstracted with respect to the local signature,
    is solved by tac *)
 
-(** d1 is the section variable in the global context, d2 in the goal context *)
-let interpretable_as_section_decl env sigma 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
-        let _sigma = Evd.add_constraints sigma cstr in
-        true
-      with UGraph.UniverseInconsistency _ | UState.UniversesDiffer -> false
-  in
-  match d2, d1 with
-  | LocalDef _, LocalAssum _ -> false
-  | LocalDef (_,b1,t1), LocalDef (_,b2,t2) ->
-    e_eq_constr_univs sigma b1 b2 && e_eq_constr_univs sigma t1 t2
-  | LocalAssum (_,t1), d2 -> e_eq_constr_univs sigma t1 (NamedDecl.get_type d2)
-
 let name_op_to_name ~name_op ~name suffix =
   match name_op with
   | Some s -> s
@@ -56,11 +38,9 @@ let cache_term_by_tactic_then ~opaque ~name_op ?(goal_type=None) tac tacK =
     let sign,secsign =
       List.fold_right
         (fun d (s1,s2) ->
-           let id = NamedDecl.get_id d in
-           if mem_named_context_val id section_sign &&
-              interpretable_as_section_decl env sigma (lookup_named_val id section_sign) d
-           then (s1,push_named_context_val d s2)
-           else (Context.Named.add d s1,s2))
+           match Environ.var_status (NamedDecl.get_id d) env with
+           | SecVar -> (s1,push_named_context_val SecVar d s2)
+           | ProofVar -> (Context.Named.add d s1,s2))
         goal_sign (Context.Named.empty, Environ.empty_named_context_val)
     in
     let bad id = match lookup_named_val id section_sign with
@@ -106,3 +86,10 @@ let abstract_subproof ~opaque tac =
 
 let tclABSTRACT ?(opaque=true) name_op tac =
   abstract_subproof ~opaque ~name_op tac
+
+let { Goptions.get = get_inline_abstract_subproof } =
+  Goptions.declare_bool_option_and_ref
+    ~depr:(Deprecation.make ~since:"9.3" ())
+    ~key:["Inline"; "Abstract"; "Subproof"]
+    ~value:false
+    ()
diff --git a/tactics/abstract.mli b/tactics/abstract.mli
index 89738db5148a..fc8653048933 100644
--- a/tactics/abstract.mli
+++ b/tactics/abstract.mli
@@ -20,3 +20,5 @@ val cache_term_by_tactic_then
   -> unit Proofview.tactic
 
 val tclABSTRACT : ?opaque:bool -> Id.t option -> unit Proofview.tactic -> unit Proofview.tactic
+
+val get_inline_abstract_subproof : unit -> bool
diff --git a/tactics/allScheme.ml b/tactics/allScheme.ml
index f2d0fe70d40a..679eba999525 100644
--- a/tactics/allScheme.ml
+++ b/tactics/allScheme.ml
@@ -19,7 +19,7 @@ open Reduction
 open Context.Rel.Declaration
 
 (** Generalize parameters for template and univ poly, and split uniform and non-uniform parameters *)
-let split_uparans_nuparams mib params =
+let split_uparams_nuparams mib params =
   let (uparams, nuparams) = Context.Rel.chop_nhyps mib.mind_nparams_rec (List.rev params) in
   (List.rev uparams, List.rev nuparams)
 
@@ -44,9 +44,8 @@ let init_value env uparams =
       | Some _ ->
           aux (push_rel decl env) tel
       | None   ->
-          let ty = Reduction.whd_all env (get_type decl) in
           let (env, init_value) = aux (push_rel decl env) tel in
-          (env, Term.isArity ty :: init_value)
+          (env, Reduction.is_arity env (get_type decl) :: init_value)
     in
     aux env (List.rev uparams)
 
@@ -77,15 +76,29 @@ let check_strpos_context env uparams default cxt =
         aux (push_rel decl env) (List.map2 (&&) strpos_decl strpos) tel
   in aux env default (List.rev cxt)
 
+let get_inductive_sort (mib, mip) u = match mib.mind_template with
+| None -> UVars.subst_instance_sort u mip.mind_sort
+| Some templ ->
+  let () = assert (UVars.Instance.is_empty u) in
+  UVars.subst_instance_sort templ.template_defaults mip.mind_sort
+
+module Cache =
+struct
+
+type t = { mutable uniform : bool list Mindmap_env.t }
+
+let empty () = { uniform = Mindmap_env.empty }
+
+end
+
 (** Computes which uniform parameters are strictly positive in an argument *)
-let rec compute_params_rec_strpos_arg compute_params_rec_strpos env kn uparams
-          nparams_rec nparams init_value (arg : constr) : bool list =
+let rec compute_params_rec_strpos_arg cache env kn uparams nparams_rec nparams init_value arg =
   (* strictly positive uniform parameters do not appear on the left of an arrow *)
   let (local_vars, hd) = Reduction.whd_decompose_prod_decls env arg in
   let (env, strpos_local) = check_strpos_context env uparams init_value local_vars in
   (* check the head *)
   let (hd, inst_args) = decompose_app hd in
-  let srpos_hd =
+  let strpos_hd =
     match kind hd with
     | Rel k ->
         (* Check if it is the inductive *)
@@ -107,8 +120,9 @@ let rec compute_params_rec_strpos_arg compute_params_rec_strpos env kn uparams
         (* For nested arguments, they should: *)
         else begin
           let mib_nested = lookup_mind kn_nested env in
-          let mib_nested_strpos = compute_params_rec_strpos env kn_nested mib_nested in
-          let (inst_uparams, inst_nuparams_indices) = Array.chop mib_nested.mind_nparams_rec inst_args in
+          let mib_nested_strpos = compute_params_rec_strpos cache env kn_nested mib_nested in
+          let (inst_uparams, inst_nuparams_indices) =
+            Array.chop mib_nested.mind_nparams_rec inst_args in
           let uparams_nested = List.rev @@ fst @@
                 Context.Rel.chop_nhyps mib_nested.mind_nparams_rec @@
                 List.rev mib_nested.mind_params_ctxt in
@@ -118,20 +132,24 @@ let rec compute_params_rec_strpos_arg compute_params_rec_strpos env kn uparams
              - not appear in uniform parameters that are not strictly postive *)
           let strpos_inst_uparams = Array.fold_right_i (fun i x acc ->
             if List.nth mib_nested_strpos i
-            then List.map2 (&&) acc @@ compute_params_rec_strpos_arg compute_params_rec_strpos
-                                          env kn uparams nparams_rec nparams init_value x
+            then List.map2 (&&) acc @@ compute_params_rec_strpos_arg cache env kn uparams nparams_rec nparams init_value x
             else List.map2 (&&) acc @@ check_strpos env uparams x
             ) inst_uparams init_value  in
           (* - not appear in the instantiation of the non-uniform parameters and indices *)
           let strpos_inst_nuparams_indices = andl_array (check_strpos env uparams) init_value inst_nuparams_indices in
           List.map2 (&&) strpos_inst_uparams strpos_inst_nuparams_indices
         end
+    | Const (c, _) ->
+      if is_array_type env c then
+        andl_array (compute_params_rec_strpos_arg cache env kn uparams nparams_rec nparams init_value) init_value inst_args
+      else
+        check_strpos env uparams hd
     | _ -> check_strpos env uparams hd
   in
-  List.map2 (&&) strpos_local srpos_hd
+  List.map2 (&&) strpos_local strpos_hd
 
 (** Computes which uniform parameters are strictly positive in a constructor *)
-let compute_params_rec_strpos_ctor compute_params_rec_strpos env kn uparams nparams_rec nparams init_value (args, hd) =
+and compute_params_rec_strpos_ctor cache env kn uparams nparams_rec nparams init_value (args, hd) =
   (* They must not appear on the left of an arrow in each argument *)
   let (env, strpos_args) =
     List.fold_right (
@@ -139,8 +157,7 @@ let compute_params_rec_strpos_ctor compute_params_rec_strpos env kn uparams npar
         if Option.has_some @@ get_value arg then
           push_rel arg env, acc
         else
-          let strpos_arg = compute_params_rec_strpos_arg compute_params_rec_strpos
-                            env kn uparams nparams_rec nparams init_value (get_type arg) in
+          let strpos_arg = compute_params_rec_strpos_arg cache env kn uparams nparams_rec nparams init_value (get_type arg) in
           (push_rel arg env, List.map2 (&&) acc strpos_arg)
       ) args (env, init_value)
   in
@@ -152,12 +169,11 @@ let compute_params_rec_strpos_ctor compute_params_rec_strpos env kn uparams npar
   res_ctor
 
 (** Computes which uniform parameters are strictly positive in an inductive block *)
-let compute_params_rec_strpos_ind compute_params_rec_strpos env kn uparams nparams_rec nparams init_value (indices, ctors) =
+and compute_params_rec_strpos_ind cache env kn uparams nparams_rec nparams init_value (indices, ctors) =
   (* They must not appear in indices *)
   let (_, strpos_indices) = check_strpos_context env uparams init_value indices in
   (* They must be strictly positive in each constructor *)
-  let strpos_ctors = andl_array (compute_params_rec_strpos_ctor compute_params_rec_strpos
-        env kn uparams nparams_rec nparams init_value) init_value ctors in
+  let strpos_ctors = andl_array (compute_params_rec_strpos_ctor cache env kn uparams nparams_rec nparams init_value) init_value ctors in
   let res_ind = List.map2 (&&) strpos_indices strpos_ctors in
   res_ind
 
@@ -167,20 +183,21 @@ let compute_params_rec_strpos_ind compute_params_rec_strpos env kn uparams npara
     This function can be used whether the inductive is refered using [Rel] or [Ind].
     This particular data representation is the one of indtypes.
     *)
-let compute_params_rec_strpos_aux compute_params_rec_strpos env kn uparams nuparams nparams_rec nparams inds : bool list =
+and compute_params_rec_strpos_aux cache env kn uparams nuparams nparams_rec nparams inds =
   if nparams_rec = 0 then [] else
   (* They must be arities [forall ..., sort X] *)
   let (env, init_value) = init_value env uparams in
   (* They must not appear in non-uniform parameters *)
   let (env, strpos_nuparams) = check_strpos_context env uparams init_value nuparams in
   (* They must be strictly positive in each inductive block *)
-  let strpos_inds = andl_array (compute_params_rec_strpos_ind compute_params_rec_strpos
-        env kn uparams nparams_rec nparams init_value) init_value inds in
+  let strpos_inds = andl_array (compute_params_rec_strpos_ind cache env kn uparams nparams_rec nparams init_value) init_value inds in
   let res = List.map2 (&&) strpos_nuparams strpos_inds in
   dbg_strpos Pp.(fun () -> MutInd.print kn ++ str ": Final Result = " ++ pp_strpos res);
   res
 
-let rec compute_params_rec_strpos env kn (mib : mutual_inductive_body) : bool list =
+and compute_params_rec_strpos cache env kn mib =
+  match Mindmap_env.find_opt kn cache.Cache.uniform with
+| None ->
   (* reset the context *)
   let env = set_rel_context_val empty_rel_context_val env in
   (* compute the data expected *)
@@ -196,10 +213,12 @@ let rec compute_params_rec_strpos env kn (mib : mutual_inductive_body) : bool li
   in
   let (uparams, nuparams) = map_pair List.rev @@ Context.Rel.chop_nhyps mib.mind_nparams_rec @@
                             List.rev mib.mind_params_ctxt in
-  compute_params_rec_strpos_aux compute_params_rec_strpos env kn uparams nuparams mib.mind_nparams_rec mib.mind_nparams inds
+  let ans = compute_params_rec_strpos_aux cache env kn uparams nuparams mib.mind_nparams_rec mib.mind_nparams inds in
+  let () = cache.Cache.uniform <- Mindmap_env.add kn ans cache.Cache.uniform in
+  ans
+| Some unf -> unf
 
-
-  (** {6 Lookup All Predicate and its Theorem } *)
+(** {6 Lookup All Predicate and its Theorem } *)
 
 (** Suffix and register key for the [all] predicate and its theorem  *)
 let default_suffix = (("_all", "_all_forall"), ("All", "AllForall"))
@@ -238,7 +257,7 @@ let rec compute_user_strpos_aux user_names allowed_uparams strpos =
 
 let compute_user_strpos mib user_id default_strpos =
   let user_names = List.map (fun i -> Name i) user_id in
-  let uparams = fst @@ split_uparans_nuparams mib mib.mind_params_ctxt in
+  let uparams = fst @@ split_uparams_nuparams mib mib.mind_params_ctxt in
   let uparams_decl = List.filter is_local_assum uparams in
   let uparams_decl_name = List.map get_name uparams_decl in
   let allowed_uparams = List.map (fun (name, i) -> if i then name else Anonymous)
@@ -246,6 +265,10 @@ let compute_user_strpos mib user_id default_strpos =
   let strpos = List.map (fun _ -> false) uparams_decl in
   compute_user_strpos_aux user_names allowed_uparams strpos
 
+let compute_params_rec_strpos env kn mib =
+  let cache = Cache.empty () in
+  compute_params_rec_strpos cache env kn mib
+
 (** Compute the default positivity of the uniform parameters, and generates the suffix
     for naming the [all] predicate, and its theorem, as well as the key for registering.
     If a positivity specification is given by users [bool list option], it is
@@ -263,57 +286,65 @@ let compute_positive_uparams_and_suffix env kn mib user_id =
 (** Warning for looking up the [all] predicate and its theorem  *)
 let warn_lookup_not_found =
   CWarnings.create ~name:"register-all" ~category:CWarnings.CoreCategories.automation
-  Pp.(fun (key, ind, ind_nested) ->
+  Pp.(fun (key, ind, nested_container) ->
+      let generic_message =
          Nametab.XRefs.pr (TrueGlobal (IndRef ind))
       ++ strbrk " is nested using "
-      ++ Nametab.XRefs.pr (TrueGlobal (IndRef ind_nested))
+      ++ Nametab.XRefs.pr (TrueGlobal nested_container)
       ++ strbrk ". "
       ++ strbrk "No scheme for "
-      ++ Nametab.XRefs.pr (TrueGlobal (IndRef ind_nested))
+      ++ Nametab.XRefs.pr (TrueGlobal nested_container)
       ++ strbrk " is registered as "
-      ++ strbrk key ++  str "."
+      ++ strbrk key ++  strbrk ". " in
+      let inductive_message =
+      strbrk "It can be generated using command \"Scheme All\" e.g. \"Scheme All for "
+      ++ Nametab.XRefs.pr (TrueGlobal nested_container)
+      ++ str ".\"." in
+      match nested_container with
+      | GlobRef.IndRef _ -> generic_message ++ inductive_message
+      | _ -> generic_message
     )
 
-(** Lookup the partial [all] predicate for [ind_nested] for [args_are_nested].
+(** Lookup the partial [all] predicate for [nested_container] for [args_are_nested].
     If they are not found, lookup the general [all] predicate.
     Returns if the partial [all] was found, and the global references.
     Raise a warning if none is found. *)
-let lookup_all ind ind_nested args_are_nested =
+let lookup_all ind nested_container args_are_nested =
     let (_, (pred, _)) = partial_suffix args_are_nested in
-    match DeclareScheme.lookup_scheme_opt  pred ind_nested with
+    match DeclareScheme.lookup_scheme_opt pred nested_container with
     | Some ref_pred ->
         Some (true, ref_pred)
     | None ->
         let (_, (pred, _)) = default_suffix in
-        match DeclareScheme.lookup_scheme_opt  pred ind_nested with
+        match DeclareScheme.lookup_scheme_opt pred nested_container with
         | Some ref_pred -> Some (false, ref_pred)
-        | None -> warn_lookup_not_found (pred, ind, ind_nested); None
+        | None -> warn_lookup_not_found (pred, ind, nested_container); None
 
 (** Lookup the [all] predicate, and its theorem *)
-let lookup_all_theorem_aux ind ind_nested =
+let lookup_all_theorem_aux ind nested_container =
   let (_, (pred, thm)) = default_suffix in
-  match DeclareScheme.lookup_scheme_opt pred ind_nested with
-  | None -> warn_lookup_not_found (pred, ind, ind_nested); None
+  match DeclareScheme.lookup_scheme_opt pred nested_container with
+  | None -> warn_lookup_not_found (pred, ind, nested_container); None
   | Some ref_pred ->
-      match DeclareScheme.lookup_scheme_opt thm ind_nested with
-      | None -> warn_lookup_not_found (thm, ind, ind_nested); None
+      match DeclareScheme.lookup_scheme_opt thm nested_container with
+      | None -> warn_lookup_not_found (thm, ind, nested_container); None
       | Some ref_thm -> Some (false, ref_pred, ref_thm)
 
-(** Lookup the partial [all] predicate and its theorem for [ind_nested] for [args_are_nested].
+(** Lookup the partial [all] predicate and its theorem for [nested_container] for [args_are_nested].
     If they are not found, lookup the general [all] predicate and its theorem.
     Returns if the partial [all] was found, and the global references.
     Raise a warning if none is found. *)
-let lookup_all_theorem ind ind_nested args_are_nested =
+let lookup_all_theorem ind nested_container args_are_nested =
   let (_, (pred, thm)) = partial_suffix args_are_nested in
-  match DeclareScheme.lookup_scheme_opt pred ind_nested with
-  | None -> lookup_all_theorem_aux ind ind_nested
+  match DeclareScheme.lookup_scheme_opt pred nested_container with
+  | None -> lookup_all_theorem_aux ind nested_container
   | Some ref_pred ->
-      match DeclareScheme.lookup_scheme_opt  thm ind_nested with
+      match DeclareScheme.lookup_scheme_opt thm nested_container with
       | Some ref_thm ->
           Some (true, ref_pred, ref_thm)
       | None ->
-          warn_lookup_not_found (thm, ind,ind_nested);
-          lookup_all_theorem_aux ind ind_nested
+          warn_lookup_not_found (thm, ind,nested_container);
+          lookup_all_theorem_aux ind nested_container
 
 
   (** {6 Instantiate the All Predicate and its Theorem } *)
@@ -416,13 +447,13 @@ let make_all_theorem ~partial_nesting ref_all_thm strpos inst_uparams inst_preds
 
 type head_argument =
   | ArgIsSPUparam of int * constr array
-  (** constant context, position of the uniform parameter, args *)
+  (** position of the uniform parameter, args *)
   | ArgIsInd of int * constr array * constr array
-  (** constant context, position of the one_inductive body, inst_nuparams inst_indices *)
-  | ArgIsNested of MutInd.t * int * mutual_inductive_body * bool list
-                    * one_inductive_body * constr array * constr array
-  (** constant context, ind_nested, mutual and one body, strictly positivity of its uniform parameters,
-      instantiation uniform paramerters, and of both non_uniform parameters and indices *)
+  (** position of the one_inductive body, inst_nuparams, inst_indices *)
+  | ArgIsNested of GlobRef.t * bool list
+                    * rel_context * constr array * constr array
+  (** nested_container, strict positivity of its uniform parameters,
+      uniform parameters, their instantiation, and that of both non_uniform parameters and indices *)
   | ArgIsCst
 
 (** View to decompose arguments as [forall locs, X] where [X] is further decomposed
@@ -432,6 +463,7 @@ type argument = rel_context * head_argument
 (** Decompose the argument in [it_Prod_or_LetIn local, X] where [X] is a uniform parameter, Ind, nested or a constant *)
 let view_argument kn mib key_uparams strpos t =
   let* (cxt, hd) = whd_decompose_prod_decls t in
+  let@ _ = add_context Old naming_id cxt in
   let* (hd, iargs) = decompose_app hd in
   let* sigma = get_sigma in
   match kind sigma hd with
@@ -447,7 +479,7 @@ let view_argument kn mib key_uparams strpos t =
           else
             return @@ (cxt, ArgIsCst)
     end
-  | Ind ((kn_ind, pos_ind), _) ->
+  | Ind ((kn_ind, pos_ind as ind), _) ->
     (* If it is the inductive *)
     if kn = kn_ind then
       let (_, local_nuparams_indices) = Array.chop mib.mind_nparams_rec iargs in
@@ -459,15 +491,26 @@ let view_argument kn mib key_uparams strpos t =
     else
       (* If it may be nested *)
       let* env = get_env in
-      let (mib_nested, ind_nested) = lookup_mind_specif env (kn_ind, pos_ind) in
+      let (mib_nested, ind_nested) = lookup_mind_specif env ind in
       let mib_nested_strpos = compute_params_rec_strpos env kn_ind mib_nested in
       (* Check if at least one parameter can be nested upon *)
       if List.exists (fun a -> a) mib_nested_strpos then
+        let uparams_nested = of_rel_context @@ fst @@
+              split_uparams_nuparams mib_nested mib_nested.mind_params_ctxt in
         let (inst_uparams, inst_nuparams_indices) = Array.chop mib_nested.mind_nparams_rec iargs in
-        return @@ (cxt, ArgIsNested (kn_ind, pos_ind, mib_nested, mib_nested_strpos,
-                          ind_nested, inst_uparams, inst_nuparams_indices))
+        return @@ (cxt, ArgIsNested (GlobRef.IndRef ind, mib_nested_strpos,
+                          uparams_nested, inst_uparams, inst_nuparams_indices))
       else
         return @@ (cxt, ArgIsCst)
+  | Const (c, _) ->
+      let* env = get_env in
+      if is_array_type env c then
+        let uparam_annot = Context.make_annot (Name (Id.of_string "A")) ERelevance.relevant in
+        let uparam_type =  mkType (Univ.Universe.make (Univ.Level.var 0)) in
+        assert (Array.length iargs = 1);
+        return @@ (cxt, ArgIsNested (GlobRef.ConstRef c, [true],
+                          [LocalAssum (uparam_annot, uparam_type)], iargs, [||]))
+      else return @@ (cxt, ArgIsCst)
   | _ -> return @@ (cxt, ArgIsCst)
 
 
@@ -483,7 +526,7 @@ let view_argument kn mib key_uparams strpos t =
 
 let get_params_sep sigma mib u =
   let (sigma, params, sub_temp) = Inductiveops.paramdecls_fresh_template sigma (mib, u) in
-  let (uparams, nuparams) = split_uparans_nuparams mib params in
+  let (uparams, nuparams) = split_uparams_nuparams mib params in
   (sigma, uparams, nuparams, sub_temp)
 
 (** Closure of non-uniform parameters if [b], forgetting letins  *)
@@ -512,7 +555,7 @@ let create_fresh_sorts strpos =
   let init = List.make nb_sorts 0 in
   list_mapi (fun _ _ ->
       let* (q,l) = fresh_sort_ql ~sort_rigid:true UnivRigid in
-      return @@ ESorts.make @@ Sorts.qsort q l
+      return @@ ESorts.make @@ Sorts.vsort q l
     ) init
 
 
@@ -526,9 +569,7 @@ let rec is_nested_arg_nested kn mib key_uparams strpos arg : bool t =
   let* (locs, hd) = view_argument kn mib key_uparams strpos arg in
   let@ _ = add_context Old naming_id locs in
   match hd with
-  | ArgIsNested (_, _, mib_nested, _, _, inst_uparams, _) ->
-      let uparams_nested = of_rel_context @@ fst @@
-            split_uparans_nuparams mib_nested mib_nested.mind_params_ctxt in
+  | ArgIsNested (_, _, uparams_nested, inst_uparams, _) ->
       let* inst_uparams = eta_expand_instantiation inst_uparams uparams_nested in
       let is_nested_arg_nested arg =
         let* (loc, hd) = decompose_lambda_decls arg in
@@ -544,9 +585,7 @@ let is_nested_arg kn mib key_uparams strpos arg =
   let* (locs, hd) = view_argument kn mib key_uparams strpos arg in
   let@ _ = add_context Old naming_id locs in
   match hd with
-  | ArgIsNested (kn_nested, _, mib_nested, _, _, inst_uparams, _) ->
-      let uparams_nested = of_rel_context @@ fst @@
-            split_uparans_nuparams mib_nested mib_nested.mind_params_ctxt in
+  | ArgIsNested (_, _, uparams_nested, inst_uparams, _) ->
       let* inst_uparams = eta_expand_instantiation inst_uparams uparams_nested in
       let is_nested_arg_nested arg =
         let* (loc, hd) = decompose_lambda_decls arg in
@@ -588,7 +627,7 @@ let compute_one_return_sort mib ind is_nested u sub_temp fresh_sorts_ql =
   (* Recover the sort of the original inductive type *)
   let* sigma = get_sigma in
   let u = EInstance.kind sigma u in
-  let ind_sort = UVars.subst_instance_sort u ind.mind_sort in
+  let ind_sort = get_inductive_sort (mib, ind) u in
   let ind_sort =
     match sub_temp, mib.mind_template with
     | Some sub_temp, Some temp -> Template.template_subst_sort sub_temp temp.template_concl
@@ -609,12 +648,10 @@ let compute_one_return_sort mib ind is_nested u sub_temp fresh_sorts_ql =
       return (Some (mkSort u_alg), mkSort u_return_sort)
   in
   (* Compute the new sort, preserving impredicativity *)
-  match ind_sort with
-  | SProp -> return (None, mkSort @@ ESorts.make sprop)
-  | Prop  -> return (None, mkSort @@ ESorts.make prop)
-  | Set -> sort_if_nested is_nested sort_of_univ Univ.Universe.type0
-  | Type u -> sort_if_nested is_nested sort_of_univ u
-  | QSort (q,u) -> sort_if_nested is_nested (qsort q) u
+  let* env = get_env in
+  if Environ.is_impredicative_sort env ind_sort then
+    return (None, mkSort @@ ESorts.make ind_sort)
+  else sort_if_nested is_nested (Sorts.make (Sorts.quality ind_sort)) (univ_of_sort ind_sort)
 
 (** Compute the return sort of each [one_inductive_body], and a a fresh sort to
     handle algebraic constrains if the [one_inductive_body] is nested *)
@@ -802,27 +839,25 @@ let rec make_rec_call_hyp kn pos_ind mib rep_inds ((key_uparams, key_preds, key_
       | IndIsKn (kn_all, u_all) ->
           return @@ Some (mkApp (mkIndU ((kn_all, pos_ind), u_all), ind_args))
     end
-  | ArgIsNested (kn_nested, pos_nested, mib_nested, mib_nested_strpos, ind_nested,
-                  inst_uparams, inst_nuparams_indices) ->
+  | ArgIsNested (nested_container, nested_strpos,
+                  uparams_nested, inst_uparams, inst_nuparams_indices) ->
       (* eta expand arguments *)
-      let uparams_nested = of_rel_context @@ fst @@
-            split_uparans_nuparams mib_nested mib_nested.mind_params_ctxt in
       let* inst_uparams = eta_expand_instantiation inst_uparams uparams_nested in
       (* Compute the recursive predicates *)
       let compute_pred i x b = compute_pred_eta b
             (make_rec_call_hyp kn pos_ind mib rep_inds key_up strpos ualg) i x in
-      let* rec_preds = array_map2i compute_pred inst_uparams (Array.of_list mib_nested_strpos) in
+      let* rec_preds = array_map2i compute_pred inst_uparams (Array.of_list nested_strpos) in
       (* If at least one argument is nested, lookup the sparse parametricity *)
       let args_are_nested = Array.map Option.has_some rec_preds in
       if Array.for_all not args_are_nested then
         return None
       else begin
-        match lookup_all (kn, pos_ind) (kn_nested, pos_nested) (Array.to_list args_are_nested) with
+        match lookup_all (kn, pos_ind) nested_container (Array.to_list args_are_nested) with
         | None ->
             return None
         | Some (partial_nesting, ref_pred) ->
             (* Create: all A0 PA0 ... An PAn B0 ... Bm i0 ... il (arg a0 ... an) *)
-            let* rec_hyp = make_all_predicate ~partial_nesting ref_pred mib_nested_strpos
+            let* rec_hyp = make_all_predicate ~partial_nesting ref_pred nested_strpos
                             inst_uparams rec_preds inst_nuparams_indices inst_arg in
             (* Add constrains with return sort *)
             match ualg with
@@ -899,7 +934,7 @@ let generate_all_aux suffix kn u sub_temp mib uparams strpos nuparams =
   (* create fresh sorts, and return types *)
   let* fresh_sorts_ql = create_fresh_sorts_ql strpos in
   let* return_sorts = compute_return_sort kn u sub_temp mib uparams nuparams strpos fresh_sorts_ql in
-  let fresh_sorts = List.map (fun (a,b) -> ESorts.make @@ Sorts.qsort a b) fresh_sorts_ql in
+  let fresh_sorts = List.map (fun (a,b) -> ESorts.make @@ Sorts.vsort a b) fresh_sorts_ql in
   (*uparams + preds, nuparams and recover the context of parameters *)
   let@ key_inds = add_inductive kn u mib (Array.map snd return_sorts) uparams strpos fresh_sorts nuparams in
   let@ key_up = context_uparams_preds uparams strpos fresh_sorts in
@@ -942,7 +977,7 @@ let generate_all_aux suffix kn u sub_temp mib uparams strpos nuparams =
   in
   (* DEBUG FUNCTIONS *)
   let* env = get_env in
-  let sigma = Evd.set_universe_context sigma uctx in
+  let sigma = Evd.set_ustate sigma uctx in
   let () = dbg Pp.(fun () ->
     let params = EConstr.of_rel_context mie.mind_entry_params in
     let ind = List.hd @@ mie.mind_entry_inds in
@@ -1011,27 +1046,25 @@ let rec make_rec_call_proof kn knu pos_ind mib ((key_uparams, _, _) as key_up) k
       (* Fi B0 ... Bm i0 ... il (x a0 ... an) *)
       let* fix = geti_term key_fixs pos_ind_block in
       return @@ Some (mkApp (fix, Array.concat [inst_nuparams; inst_indices; [|inst_arg|]]))
-  | ArgIsNested (kn_nested, pos_nested, mib_nested, mib_nested_strpos, ind_nested,
-                  inst_uparams, inst_nuparams_indices) ->
+  | ArgIsNested (nested_container, nested_strpos,
+                  uparams_nested, inst_uparams, inst_nuparams_indices) ->
       (* eta expand arguments *)
-      let uparams_nested = of_rel_context @@ fst @@
-        split_uparans_nuparams mib_nested mib_nested.mind_params_ctxt in
       let* inst_uparams = eta_expand_instantiation inst_uparams uparams_nested in
       (* Compute the recursive predicates, and their proofs *)
       let compute_pred_preds i x b = compute_pred_eta b (make_rec_call_hyp kn pos_ind mib (IndIsKn knu) key_up strpos None) i x in
-      let* rec_preds = array_map2i compute_pred_preds inst_uparams (Array.of_list mib_nested_strpos) in
+      let* rec_preds = array_map2i compute_pred_preds inst_uparams (Array.of_list nested_strpos) in
       let compute_pred_holds i x b = compute_pred_eta b (make_rec_call_proof kn knu pos_ind mib key_up key_preds_hold key_fixs strpos) i x in
-      let* rec_preds_hold = array_map2i compute_pred_holds inst_uparams (Array.of_list mib_nested_strpos) in
+      let* rec_preds_hold = array_map2i compute_pred_holds inst_uparams (Array.of_list nested_strpos) in
       (* If at least one argument is nested, lookup the local fundamental theorem *)
       let args_are_nested = Array.map Option.has_some rec_preds_hold in
       if Array.for_all not args_are_nested then
         return None
       else begin
-        match lookup_all_theorem (kn, pos_ind) (kn_nested, pos_nested) (Array.to_list args_are_nested) with
+        match lookup_all_theorem (kn, pos_ind) nested_container (Array.to_list args_are_nested) with
         | None ->
             return None
         | Some (partial_nesting, _, ref_thm) ->
-            let* rec_hyp_proof = make_all_theorem ~partial_nesting ref_thm mib_nested_strpos inst_uparams
+            let* rec_hyp_proof = make_all_theorem ~partial_nesting ref_thm nested_strpos inst_uparams
                             rec_preds rec_preds_hold inst_nuparams_indices inst_arg in
             return @@ Some rec_hyp_proof
       end
@@ -1060,7 +1093,8 @@ let generate_all_theorem_aux kn kn_nested focus u mib uparams strpos nuparams :
     closure_uparams_preds_hold_gen ~mk_pred_hold:true (build_binder fid Lambda) uparams strpos fresh_sorts in
   (* Evd.ustate 2. Fixpoint *)
   let* u_all = array_mapi (fun pos_ind _ -> fresh_inductive_instance (kn_nested, pos_ind)) mib.mind_packets in
-  let relevance_ind ind = Vars.subst_instance_relevance u @@ relevance_of_sort @@ ESorts.make ind.mind_sort in
+  let* sigma = get_sigma in
+  let relevance_ind ind = relevance_of_sort @@ ESorts.make (get_inductive_sort (mib, ind) (EInstance.kind sigma u)) in
   let fix_name pos_ind ind = make_annot (Name (Id.of_string "F")) (relevance_ind ind) in
   let fix_type pos_ind ind = return_type kn kn_nested pos_ind u u_all.(pos_ind) mib key_uparams key_uparams_preds nuparams in
   let fix_rarg pos_ind ind = (mib.mind_nparams - mib.mind_nparams_rec) + ind.mind_nrealargs in
diff --git a/tactics/allScheme.mli b/tactics/allScheme.mli
index 42e71877529c..b6e46713ae78 100644
--- a/tactics/allScheme.mli
+++ b/tactics/allScheme.mli
@@ -26,7 +26,7 @@ val compute_positive_uparams_and_suffix : env -> MutInd.t -> mutual_inductive_bo
     If they are not found, lookup the general [all] predicate and its theorem.
     Returns if the partial [all] was found, and the global references.
     Raise a warning if none is found. *)
-val lookup_all_theorem : inductive -> inductive -> bool list -> (bool * GlobRef.t * GlobRef.t) option
+val lookup_all_theorem : inductive -> GlobRef.t -> bool list -> (bool * GlobRef.t * GlobRef.t) option
 
   (** {6 Instantiate the All Predicate and its Theorem } *)
 
@@ -58,13 +58,13 @@ val make_all_theorem : partial_nesting:bool -> GlobRef.t ->  bool list -> constr
 
 type head_argument =
   | ArgIsSPUparam of int * constr array
-  (** constant context, position of the uniform parameter, args *)
+  (** position of the uniform parameter, args *)
   | ArgIsInd of int * constr array * constr array
-  (** constant context, position of the one_inductive body, inst_nuparams inst_indices *)
-  | ArgIsNested of MutInd.t * int * mutual_inductive_body * bool list
-                    * one_inductive_body * constr array * constr array
-  (** constant context, ind_nested, mutual and one body, strictly positivity of its uniform parameters,
-      instantiation uniform paramerters, and of both non_uniform parameters and indices *)
+  (** position of the one_inductive body, inst_nuparams, inst_indices *)
+  | ArgIsNested of GlobRef.t * bool list
+                    * rel_context * constr array * constr array
+  (** nested_container, strict positivity of its uniform parameters,
+      uniform parameters, their instantiation, and instantiation of both non_uniform parameters and indices *)
   | ArgIsCst
 
 (** View to decompose arguments as [forall locs, X] where [X] is further decomposed
diff --git a/tactics/auto.ml b/tactics/auto.ml
index 0cf97a2563f9..a5089f9bfb4b 100644
--- a/tactics/auto.ml
+++ b/tactics/auto.ml
@@ -25,8 +25,8 @@ open Hints
 (**************************************************************************)
 
 let compute_secvars gl =
-  let hyps = Proofview.Goal.hyps gl in
-  secvars_of_hyps hyps
+  let env = Proofview.Goal.env gl in
+  secvars_of_hyps (Environ.named_context_val env)
 
 (* Tell auto not to reuse already instantiated metas in unification (for
    compatibility, since otherwise, apply succeeds more often). *)
@@ -335,6 +335,22 @@ and tac_of_hint dbg db_list local_db concl =
   in
   fun h -> tclLOG dbg (pr_hint h) (FullHint.run h tactic)
 
+let warn_non_reference_hint_using =
+  CWarnings.create ~name:"non-reference-hint-using" ~category:CWarnings.CoreCategories.automation
+    Pp.(fun (env, sigma, c) -> str "Use of the non-reference term " ++ Printer.pr_leconstr_env env sigma c ++ str " in \"using\" clauses is ignored.")
+
+let get_reference_hints env sigma lems =
+  let map lem =
+    let evd, lem = lem env sigma in
+    let lem0 = drop_extra_implicit_args evd lem in
+    match EConstr.destRef evd lem0 with
+    | (gr, _) -> Some gr
+    | exception Constr.DestKO ->
+      let () = warn_non_reference_hint_using (env, evd, lem) in
+      None
+  in
+  List.map_filter map lems
+
 (** The use of the "core" database can be de-activated by passing
     "nocore" amongst the databases. *)
 
@@ -342,6 +358,7 @@ let gen_trivial ?(debug=Off) lems dbnames =
   Proofview.Goal.enter begin fun gl ->
     let env = Proofview.Goal.env gl in
     let sigma = Proofview.Goal.sigma gl in
+    let lems = get_reference_hints env sigma lems in
     let db_list =
       match dbnames with
       | Some dbnames -> make_db_list dbnames
@@ -408,6 +425,9 @@ let default_search_depth = 5
 
 let gen_auto ?(debug=Off) n lems dbnames =
   Proofview.Goal.enter begin fun gl ->
+    let env = Proofview.Goal.env gl in
+    let sigma = Proofview.Goal.sigma gl in
+    let lems = get_reference_hints env sigma lems in
     let n = match n with None -> default_search_depth | Some n -> n in
     let db_list =
       match dbnames with
diff --git a/tactics/auto.mli b/tactics/auto.mli
index dc5e7ef4f3cf..f621b81193bf 100644
--- a/tactics/auto.mli
+++ b/tactics/auto.mli
@@ -18,6 +18,8 @@ open Tactypes
 
 val compute_secvars : Proofview.Goal.t -> Id.Pred.t
 
+val get_reference_hints : Environ.env -> Evd.evar_map -> delayed_open_constr list -> GlobRef.t list
+
 (** Default maximum search depth used by [auto] and [trivial]. *)
 val default_search_depth : int
 
diff --git a/tactics/cbn.ml b/tactics/cbn.ml
index 77ac9bd20506..d63ab933cb3a 100644
--- a/tactics/cbn.ml
+++ b/tactics/cbn.ml
@@ -215,7 +215,7 @@ struct
       | Cst_const (c, u) ->
         if UVars.Instance.is_empty u then Constant.debug_print c
         else str"(" ++ Constant.debug_print c ++ str ", " ++
-          UVars.Instance.pr Sorts.QVar.raw_pr Univ.Level.raw_pr u ++ str")"
+          UVars.Instance.pr Sorts.raw_printer u ++ str")"
       | Cst_proj (p,r) ->
         str".(" ++ Projection.debug_print p ++ str")"
 
@@ -462,7 +462,8 @@ let magically_constant_of_fixbody env sigma (reference, params) bd = function
                     let get u = match u with
                     | Sorts.SProp | Sorts.Prop -> assert false
                     | Sorts.Set -> Level.set
-                    | Sorts.Type u | Sorts.QSort (_, u) -> Option.get (Universe.level u)
+                    | Sorts.Type u | Sorts.GSort (_, u)
+                    | Sorts.VSort (_, u) -> Option.get (Universe.level u)
                     in
                     addus (get u) (get v) acc)
                 csts UVars.empty_sort_subst
@@ -708,7 +709,7 @@ let rec whd_state_gen ?csts flags env sigma =
     | Evar _ | Meta _ -> fold ()
     | Const (c,u as const) ->
       Reductionops.reduction_effect_hook env sigma c
-         (lazy (EConstr.to_constr sigma (Stack.zip sigma (x,fst (Stack.strip_app stack)))));
+         (lazy (Stack.zip sigma (x,fst (Stack.strip_app stack))));
       if RedFlags.red_set flags (RedFlags.fCONST c) then
        let u' = EInstance.kind sigma u in
        match constant_value_in env sigma (c, u) with
diff --git a/tactics/class_tactics.ml b/tactics/class_tactics.ml
index 9400410dcec6..e90fe12f0ef3 100644
--- a/tactics/class_tactics.ml
+++ b/tactics/class_tactics.ml
@@ -263,19 +263,16 @@ and e_my_find_search db_list local_db secvars hdc complete env sigma concl0 =
   let prods, concl = EConstr.decompose_prod_decls sigma concl0 in
   let nprods = List.length prods in
   let allowed_evars =
-    let all = Evarsolve.AllowedEvars.all in
     match hdc with
     | Some (hd,_) ->
       begin match Typeclasses.class_info env hd with
-      | Some cl ->
-        if cl.cl_strict then
+      | Some cl when cl.cl_strict ->
           let undefined = lazy (Evarutil.undefined_evars_of_term sigma concl) in
           let allowed evk = not (Evar.Set.mem evk (Lazy.force undefined)) in
-          Evarsolve.AllowedEvars.from_pred allowed
-        else all
-      | None -> all
+          Some (Evarsolve.AllowedEvars.from_pred allowed)
+      | _ -> None
       end
-    | _ -> all
+    | _ -> None
   in
   let tac_of_hint (flags,h) =
     let name = FullHint.name h in
@@ -328,6 +325,15 @@ and e_my_find_search db_list local_db secvars hdc complete env sigma concl0 =
     let hintl =
       CList.map
         (fun (db, m, tacs) ->
+           let all = Evarsolve.AllowedEvars.all in
+           let allowed_evars = match allowed_evars, m with
+             | _, NoMode -> Option.default all allowed_evars
+             (* [allowed_evars] from [Strict Resolution] take precedence over
+                the (necessarily less restrictive) set of allowed evars from
+                [Hint Mode =] *)
+             | Some allowed_evars, WithMode _ -> allowed_evars
+             | None, WithMode evars -> evars
+           in
           let flags = auto_unif_flags ~allowed_evars (Hint_db.transparent_state db) in
           m, List.map (fun x -> tac_of_hint (flags, x)) tacs)
         hintl
@@ -436,12 +442,13 @@ let make_resolve_hyp env sigma st only_classes decl db =
       push_resolves env sigma id db
     else db
 
-let make_hints env sigma (modes,st) only_classes sign =
+let make_hints env sigma (modes,st) only_classes =
   let db = Hint_db.add_modes modes @@ Hint_db.empty st true in
-  List.fold_right
-    (fun hyp hints ->
+  EConstr.fold_named_context
+    (fun _ status hyp hints ->
       let consider =
         not only_classes ||
+        not (status = SecVar) ||
         try let t = hyp |> NamedDecl.get_id |> Global.lookup_named |> NamedDecl.get_type in
             (* Section variable, reindex only if the type changed *)
             not (EConstr.eq_constr sigma (EConstr.of_constr t) (NamedDecl.get_type hyp))
@@ -450,7 +457,7 @@ let make_hints env sigma (modes,st) only_classes sign =
       if consider then
         make_resolve_hyp env sigma st only_classes hyp hints
       else hints)
-    sign db
+    env ~init:db
 
 module Intpart = Unionfind.Make(Evar.Set)(Evar.Map)
 
@@ -468,7 +475,6 @@ type solver = { solver :
 module Search = struct
   type autoinfo =
     { search_depth : int list;
-      last_tac : Pp.t Lazy.t;
       search_dep : bool;
       search_only_classes : bool;
       search_cut : hints_path;
@@ -493,13 +499,13 @@ module Search = struct
                cached_modes == modes
     then cached_hints
     else
-      let hints = make_hints env sigma mst only_classes sign in
+      let hints = make_hints env sigma mst only_classes in
       autogoal_cache := (cwd, only_classes, sign, modes, hints, qvars); hints
 
   let make_autogoal env sigma mst only_classes dep cut best_effort i =
     let hints = make_autogoal_hints env sigma only_classes mst in
     { search_hints = hints;
-      search_depth = [i]; last_tac = lazy (str"none");
+      search_depth = [i];
       search_dep = dep;
       search_only_classes = only_classes;
       search_cut = cut;
@@ -765,7 +771,6 @@ module Search = struct
         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;
             search_dep = dep';
             search_only_classes = info.search_only_classes;
             search_hints = hints';
@@ -838,9 +843,14 @@ module Search = struct
       in
       if path_matches_epsilon derivs then aux e tl
       else
+        let i = !idx in
+        let () = if hint_extern then ppdebug 0 (fun () ->
+            pr_depth (i :: info.search_depth) ++ str": running " ++ Lazy.force pp
+            ++ str" on" ++ spc () ++ pr_ev sigma (Proofview.Goal.goal gl))
+        in
         ortac
              (with_shelf tac >>= fun s ->
-              let i = !idx in incr idx; result s i None)
+              incr idx; result s i None)
              (fun e' ->
                 (pr_error e'; aux (merge_exceptions e e') tl))
     and aux e = function
@@ -884,7 +894,7 @@ module Search = struct
       make_resolve_hyp env sigma (Hint_db.transparent_state info.search_hints)
                        info.search_only_classes decl info.search_hints in
     let info' =
-      { info with search_hints = ldb; last_tac = lazy (str"intro");
+      { info with search_hints = ldb;
         search_depth = 1 :: 1 :: info.search_depth }
     in
     kont info'
diff --git a/tactics/declareScheme.ml b/tactics/declareScheme.ml
index 12ac5582cda1..99ba09ada932 100644
--- a/tactics/declareScheme.ml
+++ b/tactics/declareScheme.ml
@@ -10,10 +10,10 @@
 
 open Names
 
-let scheme_map = Summary.ref Indmap_env.empty ~name:"Schemes"
+let scheme_map = Summary.ref GlobRef.Map_env.empty ~name:"Schemes"
 
-let cache_one_scheme kind (ind,const) =
-  scheme_map := Indmap_env.update ind (function
+let cache_one_scheme kind (gr,const) =
+  scheme_map := GlobRef.Map_env.update gr (function
       | None -> Some (CString.Map.singleton kind const)
       | Some map -> Some (CString.Map.add kind const map))
       !scheme_map
@@ -21,26 +21,34 @@ let cache_one_scheme kind (ind,const) =
 let cache_scheme (kind,l) =
   cache_one_scheme kind l
 
-let subst_one_scheme subst (ind,const) =
-  (* Remark: const is a def: the result of substitution is a constant *)
-  (Mod_subst.subst_ind subst ind, Globnames.subst_global_reference subst const)
+let subst_one_scheme subst (gr,const) =
+  (Globnames.subst_global_reference subst gr, Globnames.subst_global_reference subst const)
 
 let subst_scheme (subst,(kind,l)) =
   (kind, subst_one_scheme subst l)
 
-let inScheme : Libobject.locality * (string * (inductive * GlobRef.t)) -> Libobject.obj =
+let inScheme : Libobject.locality * (string * (GlobRef.t * GlobRef.t)) -> Libobject.obj =
   let open Libobject in
   declare_object @@ object_with_locality "SCHEME"
     ~cache:cache_scheme
     ~subst:(Some subst_scheme)
     ~discharge:(fun x -> x)
 
-let declare_scheme local kind indcl =
-  Lib.add_leaf (inScheme (local,(kind,indcl)))
-
-let lookup_scheme kind ind = CString.Map.find kind (Indmap_env.find ind !scheme_map)
-
-let lookup_scheme_opt kind ind =
-  try Some (lookup_scheme kind ind) with Not_found -> None
+let declare_scheme local kind (gr, _ as grcl) =
+  let () = match local, gr with
+  | (Libobject.Export | Libobject.SuperGlobal), GlobRef.VarRef id ->
+    if Global.is_in_section gr then
+      CErrors.user_err
+        Pp.(str "Cannot register a non-local scheme for section variable "
+            ++ Names.Id.print id
+            ++ str "; use the #[local] attribute.")
+  | _, _ -> ()
+  in
+  Lib.add_leaf (inScheme (local,(kind,grcl)))
+
+let lookup_scheme kind gr = CString.Map.find kind (GlobRef.Map_env.find gr !scheme_map)
+
+let lookup_scheme_opt kind gr =
+  try Some (lookup_scheme kind gr) with Not_found -> None
 
 let all_schemes () = !scheme_map
diff --git a/tactics/declareScheme.mli b/tactics/declareScheme.mli
index 0e385596f599..28ee5cffcb5f 100644
--- a/tactics/declareScheme.mli
+++ b/tactics/declareScheme.mli
@@ -10,7 +10,7 @@
 
 open Names
 
-val declare_scheme : Libobject.locality -> string -> (inductive * GlobRef.t) -> unit
-val lookup_scheme : string -> inductive -> GlobRef.t
-val lookup_scheme_opt : string -> inductive -> GlobRef.t option
-val all_schemes : unit -> GlobRef.t CString.Map.t Indmap_env.t
+val declare_scheme : Libobject.locality -> string -> (GlobRef.t * GlobRef.t) -> unit
+val lookup_scheme : string -> GlobRef.t -> GlobRef.t
+val lookup_scheme_opt : string -> GlobRef.t -> GlobRef.t option
+val all_schemes : unit -> GlobRef.t CString.Map.t GlobRef.Map_env.t
diff --git a/tactics/dune b/tactics/dune
index 328605853f13..1011e4be27ed 100644
--- a/tactics/dune
+++ b/tactics/dune
@@ -7,7 +7,3 @@
  ; until ocaml/dune#4892 fixed
  ; (private_modules btermdn dn)
  (libraries printing))
-
-(deprecated_library_name
- (old_public_name coq-core.tactics)
- (new_public_name rocq-runtime.tactics))
diff --git a/tactics/eClause.ml b/tactics/eClause.ml
index 35a457dce869..6c735ca93b03 100644
--- a/tactics/eClause.ml
+++ b/tactics/eClause.ml
@@ -80,8 +80,7 @@ let make_evar_clause env sigma ?len t =
       let inst, ctx, args, subst = match inst with
       | None ->
         (* Dummy type *)
-        let hypnaming = VarSet.variables (Global.env ()) in
-        let ctx, _, args, subst = push_rel_context_to_named_context ~hypnaming env sigma mkProp in
+        let ctx, _, args, subst = push_rel_context_to_named_context env sigma mkProp in
         Some (ctx, args, subst), ctx, args, subst
       | Some (ctx, args, subst) -> inst, ctx, args, subst
       in
diff --git a/tactics/eauto.ml b/tactics/eauto.ml
index 89249b4e7a0e..9ac982f17467 100644
--- a/tactics/eauto.ml
+++ b/tactics/eauto.ml
@@ -210,7 +210,7 @@ module Search = struct
     let concl = Proofview.Goal.concl gl in
     let hyps = EConstr.named_context env in
     let db = db env sigma in
-    let secvars = secvars_of_hyps hyps in
+    let secvars = secvars_of_hyps (Environ.named_context_val env) in
     let assumption_tacs =
       let mkdb env sigma = assert false in (* no goal can be generated *)
       let map_assum id = (false, mkdb, e_give_exact (mkVar id), lazy (str "exact" ++ spc () ++ Id.print id)) in
@@ -355,7 +355,10 @@ let make_initial_state evk dbg n localdb =
 
 let e_search_auto ?(debug = Off) ?depth lems db_list =
   Proofview.Goal.enter begin fun gl ->
+  let env = Proofview.Goal.env gl in
+  let sigma = Proofview.Goal.sigma gl in
   let p = Option.default default_search_depth depth in
+  let lems = Auto.get_reference_hints env sigma lems in
   let local_db env sigma = make_local_hint_db env sigma ~ts:TransparentState.full true lems in
   let d = mk_eauto_dbg debug in
   let debug = match d with Debug -> true | Info | Off -> false in
@@ -411,7 +414,7 @@ let autounfold db cls =
       with Not_found -> raise (UnknownDatabase dbname)
     in
     let (db_ids, db_csts, db_prjs) = Hint_db.unfolds db in
-    (Id.Set.fold cons db_ids ids, Cset.fold cons db_csts csts, PRset.fold cons db_prjs prjs)) ([], [], []) db
+    (Id.Set.fold cons db_ids ids, Cset_env.fold cons db_csts csts, PRset_env.fold cons db_prjs prjs)) ([], [], []) db
   with
   | (ids, csts, prjs) -> Proofview.Goal.enter begin fun gl ->
       let cls = concrete_clause_of (fun () -> Tacmach.pf_ids_of_hyps gl) cls in
@@ -431,10 +434,10 @@ let autounfold_tac db cls =
   in
   autounfold dbs cls
 
-let transparent_constant csts prjs c =
+let transparent_constant env csts prjs c =
   match Structures.PrimitiveProjections.find_opt c with
-  | None -> Cset.mem c csts
-  | Some p -> PRset.mem p prjs
+  | None -> Cset_env.mem (Environ.QConstant.canonize env c) csts
+  | Some p -> PRset_env.mem (Environ.QProjection.Repr.canonize env p) prjs
 
 let unfold_head env sigma (ids, csts, prjs) c =
   (* TODO use prjs *)
@@ -444,7 +447,7 @@ let unfold_head env sigma (ids, csts, prjs) c =
         (match Environ.named_body id env with
         | Some b -> true, EConstr.of_constr b
         | None -> false, c)
-    | Const (cst, u) when transparent_constant csts prjs cst ->
+    | Const (cst, u) when transparent_constant env csts prjs cst ->
         let u = EInstance.kind sigma u in
         true, EConstr.of_constr (Environ.constant_value_in env (cst, u))
     | App (f, args) ->
@@ -481,7 +484,7 @@ let autounfold_one db cl =
         with Not_found -> user_err (str "Unknown database " ++ str dbname ++ str ".")
       in
       let (ids, csts, prjs) = Hint_db.unfolds db in
-        (Id.Set.union ids i, Cset.union csts c, PRset.union prjs p)) (Id.Set.empty, Cset.empty, PRset.empty) db
+        (Id.Set.union ids i, Cset_env.union csts c, PRset_env.union prjs p)) (Id.Set.empty, Cset_env.empty, PRset_env.empty) db
   in
   let did, c' = unfold_head env sigma st
     (match cl with Some (id, _) -> Tacmach.pf_get_hyp_typ id gl | None -> concl)
diff --git a/tactics/elim.ml b/tactics/elim.ml
index a2e538b168bd..8ac6bcf3a9c4 100644
--- a/tactics/elim.ml
+++ b/tactics/elim.ml
@@ -28,7 +28,7 @@ let general_elim_using mk_elim (ind, u, args) id = match mk_elim with
   Proofview.Goal.enter begin fun gl ->
     let env = Proofview.Goal.env gl in
     let sigma = Proofview.Goal.sigma gl in
-    let sort = Retyping.get_sort_quality_of env sigma (Proofview.Goal.concl gl) in
+    let sort = Retyping.get_sort_quality_or_set_of env sigma (Proofview.Goal.concl gl) in
     let flags = Unification.elim_flags () in
     let gr = Elimschemes.lookup_eliminator env ind sort in
     let sigma, elim = Evd.fresh_global env sigma gr in
diff --git a/tactics/elimschemes.ml b/tactics/elimschemes.ml
index 1575616ff39e..51dbc3d6a368 100644
--- a/tactics/elimschemes.ml
+++ b/tactics/elimschemes.ml
@@ -45,7 +45,7 @@ let pseudo_sort_quality_for_elim ind mip =
 
 let default_case_analysis_dependence env ind =
   let _, mip as specif = Inductive.lookup_mind_specif env ind in
-  Inductiveops.has_dependent_elim specif
+  Inductiveops.always_dependent_elim specif
   && (not (Sorts.is_prop mip.mind_sort) || is_prop_but_default_dependent_elim ind)
 
 
@@ -104,6 +104,8 @@ let elim_scheme ~dep ~to_kind =
        | QConstant QSProp -> sind_nodep
        | QConstant QProp -> ind_nodep
        | QConstant QType | QVar _ -> rect_nodep
+       | QGlobal _ ->
+         CErrors.user_err Pp.(str "Cannot automatically lookup elimination scheme for global sort.")
      end
   | Set -> if dep then rec_dep else rec_nodep
 
@@ -115,6 +117,8 @@ let elimination_suffix =
   | Qual (QConstant QProp) -> "_ind"
   | Qual (QConstant QType) | Qual (QVar _) -> "_rect"
   | Set -> "_rec"
+  | Qual (QGlobal _) ->
+    CErrors.user_err Pp.(str "Cannot automatically lookup elimination scheme for global sort.")
 
 let make_elimination_ident id s = Nameops.add_suffix id (elimination_suffix s)
 
@@ -143,11 +147,12 @@ let lookup_eliminator_by_name env ind_sp s =
         Pp.(strbrk "Cannot find the elimination combinator " ++
             Id.print id ++ strbrk ", the elimination of the inductive definition " ++
             Nametab.pr_global_env Id.Set.empty (GlobRef.IndRef ind_sp) ++
-            strbrk " on sort " ++ UnivGen.QualityOrSet.pr Sorts.QVar.raw_pr s ++
+            strbrk " on sort " ++
+            UnivGen.QualityOrSet.pr (UnivNames.quality_printer UnivNames.empty_binders) s ++
             strbrk " is probably not allowed.")
 
 let deprecated_lookup_by_name =
-  CWarnings.create ~name:"deprecated-lookup-elim-by-name" ~category:Deprecation.Version.v9_1
+  CWarnings.create ~name:"deprecated-lookup-elim-by-name" ~category:Deprecation.Version.v9_2
     Pp.(fun (env,ind,to_kind,r) ->
         let pp_scheme () s = str (scheme_kind_name s) in
         fmt "Found unregistered eliminator %t for %t by name.@ \
@@ -206,3 +211,11 @@ let casep_dep =
 let casep_nodep =
   declare_individual_scheme_object "casep_nodep"
     (fun env _ x -> build_case_analysis_scheme_in_type env false QualityOrSet.prop x)
+
+let scase_dep =
+  declare_individual_scheme_object "scase_dep"
+    (fun env _ x -> build_case_analysis_scheme_in_type env true QualityOrSet.sprop x)
+
+let scase_nodep =
+  declare_individual_scheme_object "scase_nodep"
+    (fun env _ x -> build_case_analysis_scheme_in_type env false QualityOrSet.sprop x)
diff --git a/tactics/elimschemes.mli b/tactics/elimschemes.mli
index 311c4aedc0f2..8e1660124bac 100644
--- a/tactics/elimschemes.mli
+++ b/tactics/elimschemes.mli
@@ -37,6 +37,8 @@ val case_dep : individual scheme_kind
 val case_nodep : individual scheme_kind
 val casep_dep : individual scheme_kind
 val casep_nodep : individual scheme_kind
+val scase_dep : individual scheme_kind
+val scase_nodep : individual scheme_kind
 
 (** Recursor names utilities *)
 
diff --git a/tactics/eqdecide.ml b/tactics/eqdecide.ml
index 25b12b6cc2c5..e62722330df8 100644
--- a/tactics/eqdecide.ml
+++ b/tactics/eqdecide.ml
@@ -203,7 +203,7 @@ let elim_type dty rectype a1 a2 =
   let sigma = Proofview.Goal.sigma gl in
   let concl = Proofview.Goal.concl gl in
   let (ind, _) = Tacred.reduce_to_atomic_ind env sigma dty.op in
-  let s = Retyping.get_sort_quality_of env sigma concl in
+  let s = Retyping.get_sort_quality_or_set_of env sigma concl in
   let elimc = Elimschemes.lookup_eliminator env (fst ind) s in
   (* Eliminator type is expected to have (potentially non-dependent) shape
       [forall A B (P : I A B -> Type), P _ -> P _ -> forall (s : I A B), P s ] *)
diff --git a/tactics/eqschemes.ml b/tactics/eqschemes.ml
index bcfdee3a8557..fadfbaa2f3c8 100644
--- a/tactics/eqschemes.ml
+++ b/tactics/eqschemes.ml
@@ -70,7 +70,7 @@ let xid = Id.of_string "X"
 
 let default_id_of_sort = let open Sorts.Quality in function
   | QConstant QSProp | QConstant QProp -> hid
-  | QConstant QType | QVar _ -> xid
+  | QConstant QType | QVar _ | QGlobal _ -> xid
 
 let default_id_of_ind ind mip =
   default_id_of_sort (Elimschemes.pseudo_sort_quality_for_elim ind mip)
@@ -82,7 +82,7 @@ let with_context_set ctx (b, ctx') =
   (b, UnivGen.sort_context_union ctx ctx')
 
 let of_context_set env ctx =
-  UState.merge_sort_context ~sideff:false ~src:UState.Internal UnivRigid (UState.from_env env) ctx
+  UState.merge_sort_context_set ~sideff:false ~src:UState.Internal UnivRigid (UState.from_env env) ctx
 
 let build_dependent_inductive ind (mib,mip) =
   let realargs,_ = List.chop mip.mind_nrealdecls mip.mind_arity_ctxt in
@@ -91,6 +91,12 @@ let build_dependent_inductive ind (mib,mip) =
        Context.Rel.instance_list mkRel mip.mind_nrealdecls mib.mind_params_ctxt
        @ Context.Rel.instance_list mkRel 0 realargs)
 
+let maybe_template_instance (mib, mip) u = match mib.mind_template with
+| None -> u
+| Some templ ->
+  let () = assert (UVars.Instance.is_empty u) in
+  templ.template_defaults
+
 let named_hd env t na = named_hd env (Evd.from_env env) (EConstr.of_constr t) na
 let name_assumption env = function
 | LocalAssum (na,t) -> LocalAssum (map_annot (named_hd env t) na, t)
@@ -139,6 +145,7 @@ 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
+  let u = maybe_template_instance specif u in
   if not (Int.equal (Array.length mib.mind_packets) 1) ||
     not (Int.equal (Array.length mip.mind_nf_lc) 1) then
     error "Not an inductive type with a single constructor.";
@@ -174,6 +181,7 @@ let get_sym_eq_data env (ind,u) =
 
 let get_non_sym_eq_data env (ind,u) =
   let (mib,mip as specif) = lookup_mind_specif env ind in
+  let u = maybe_template_instance specif u in
   if not (Int.equal (Array.length mib.mind_packets) 1) ||
     not (Int.equal (Array.length mip.mind_nf_lc) 1) then
     error "Not an inductive type with a single constructor.";
@@ -216,7 +224,7 @@ let build_sym_scheme env _handle ind =
   let realsign_ind =
     name_context env ((LocalAssum (make_annot (Name varH) indr,applied_ind))::realsign) in
   let rci = Sorts.Relevant in (* TODO relevance *)
-  let ci = make_case_info env ind RegularStyle in
+  let ci = make_case_info env ind MatchStyle in
   let p =
     my_it_mkLambda_or_LetIn_name env
       (lift_rel_context (nrealargs+1) realsign_ind)
@@ -281,7 +289,7 @@ let build_sym_involutive_scheme env handle ind =
   let realsign_ind =
     name_context env ((LocalAssum (make_annot (Name varH) indr,applied_ind))::realsign) in
   let rci = Sorts.Relevant in (* TODO relevance *)
-  let ci = make_case_info env ind RegularStyle in
+  let ci = make_case_info env ind MatchStyle in
   let c =
     (my_it_mkLambda_or_LetIn paramsctxt
      (my_it_mkLambda_or_LetIn_name env realsign_ind
@@ -419,8 +427,8 @@ let build_l2r_rew_scheme dep env handle ind kind =
   let ctx = UnivGen.sort_context_union ctx ctx' in
   let s = mkSort s in
   let rci = Sorts.Relevant in (* TODO relevance *)
-  let ci = make_case_info env ind RegularStyle in
-  let cieq = make_case_info env (fst (destInd eq)) RegularStyle in
+  let ci = make_case_info env ind MatchStyle in
+  let cieq = make_case_info env (fst (destInd eq)) MatchStyle in
   let applied_PC =
     mkApp (mkVar varP,Array.append (Context.Rel.instance mkRel 1 realsign)
            (if dep then [|cstr (2*nrealargs+1) 1|] else [||])) in
@@ -527,7 +535,7 @@ let build_l2r_forward_rew_scheme dep env ind kind =
   let ctx = UnivGen.sort_context_union ctx ctx' in
   let s = mkSort s in
   let rci = Sorts.Relevant in
-  let ci = make_case_info env ind RegularStyle in
+  let ci = make_case_info env ind MatchStyle in
   let applied_PC =
     mkApp (mkVar varP,Array.append
            (rel_vect (nrealargs*2+3) nrealargs)
@@ -608,7 +616,7 @@ let build_r2l_forward_rew_scheme dep env ind kind =
   let sr = Sorts.relevance_of_sort s in
   let ctx = UnivGen.sort_context_union ctx ctx' in
   let s = mkSort s in
-  let ci = make_case_info env ind RegularStyle in
+  let ci = make_case_info env ind MatchStyle in
   let iv =
     (* XXX is Evd.from_env correct? *)
     if Inductiveops.Internal.should_invert_case env (Evd.from_env env) sr ci
@@ -802,6 +810,7 @@ let build_congr env (eq,refl,ctx) ind =
   let (ind,u as indu), ctx = with_context_set ctx
     (UnivGen.fresh_inductive_instance env ind) in
   let (mib,mip) = lookup_mind_specif env ind in
+  let u = maybe_template_instance (mib, mip) u in
   if not (Int.equal (Array.length mib.mind_packets) 1) || not (Int.equal (Array.length mip.mind_nf_lc) 1) then
     error "Not an inductive type with a single constructor.";
   if not (Int.equal mip.mind_nrealargs 1) then
@@ -826,7 +835,7 @@ let build_congr env (eq,refl,ctx) ind =
   let varH,avoid = fresh env (Id.of_string "H") avoid in
   let varf,avoid = fresh env (Id.of_string "f") avoid in
   let rci = Sorts.Relevant in (* TODO relevance *)
-  let ci = make_case_info env ind RegularStyle in
+  let ci = make_case_info env ind MatchStyle in
   let lvl = UnivGen.fresh_level () in
   let uni = Univ.Universe.make lvl in
   let ctx =
diff --git a/tactics/equality.ml b/tactics/equality.ml
index fd5bc18014be..885a1889dff8 100644
--- a/tactics/equality.ml
+++ b/tactics/equality.ml
@@ -300,7 +300,7 @@ let general_elim_clause with_evars frzevars tac cls c (ctx, eqn, args) l l2r eli
     | AllMatches ->
       let flags = make_flags frzevars sigma rewrite_unif_flags (lazy Evar.Set.empty) in
       let cs = instantiate_lemma_all env flags eqclause l2r typ in
-      tclMAP try_clause cs
+      tclMAP (fun x -> tclTRY (try_clause x)) cs
   end
 
 (* The next function decides in particular whether to try a regular
@@ -316,15 +316,15 @@ let (forward_general_setoid_rewrite_clause, general_setoid_rewrite_clause) = Hoo
 let scheme_name dep lft2rgt inccl =
   match dep, lft2rgt, inccl with
     (* Non dependent case *)
-    | false, Some true, true -> rew_l2r_scheme_kind
-    | false, Some true, false -> rew_r2l_scheme_kind
-    | false, _, false -> rew_l2r_scheme_kind
-    | false, _, true -> rew_r2l_scheme_kind
+    | false, true, true -> rew_l2r_scheme_kind
+    | false, true, false -> rew_r2l_scheme_kind
+    | false, false, false -> rew_l2r_scheme_kind
+    | false, false, true -> rew_r2l_scheme_kind
     (* Dependent case *)
-    | true, Some true, true -> rew_l2r_dep_scheme_kind
-    | true, Some true, false -> rew_l2r_forward_dep_scheme_kind
-    | true, _, true -> rew_r2l_dep_scheme_kind
-    | true, _, false -> rew_r2l_forward_dep_scheme_kind
+    | true, true, true -> rew_l2r_dep_scheme_kind
+    | true, true, false -> rew_l2r_forward_dep_scheme_kind
+    | true, false, true -> rew_r2l_dep_scheme_kind
+    | true, false, false -> rew_r2l_forward_dep_scheme_kind
 
 let lib_ref_opt_pos name pos =
   match Rocqlib.lib_ref_opt name with
@@ -336,27 +336,27 @@ let lib_ref_opt_pos name pos =
 let eq_scheme_pattern dep lft2rgt inccl target is_set = let open Sorts.Quality in
   match dep, lft2rgt, inccl, target , is_set with
     (* Non dependent case *)
-    | false, Some true, true , QConstant QType , false -> Some ("rect_r")
-    | false, Some true, true , QConstant QType , true -> Some ("rec_r")
-    | false, Some true, true , QConstant QProp , _ -> Some ("ind_r")
-    | false, Some true, true , QConstant QSProp , _ -> Some ("sind_r")
-    | false, Some true, false , QConstant QType , false -> Some ("rect")
-    | false, Some true, false , QConstant QType , true -> Some ("rec")
-    | false, Some true, false , QConstant QProp , _ -> Some ("ind")
-    | false, Some true, false , QConstant QSProp , _ -> Some ("sind")
-    | false, _ , false , QConstant QType , false -> Some ("rect_r")
-    | false, _ , false , QConstant QType , true -> Some ("rec_r")
-    | false, _ , false , QConstant QProp , _ -> Some ("ind_r")
-    | false, _ , false , QConstant QSProp , _ -> Some ("sind_r")
-    | false, _ , true , QConstant QProp , _ -> Some ("ind")
-    | false, _ , true , QConstant QSProp , _ -> Some ("sind")
-    | false, _ , true , QConstant QType , false -> Some ("rect")
-    | false, _ , true , QConstant QType , true -> Some ("rec")
+    | false, true, true , QConstant QType , false -> Some ("rect_r")
+    | false, true, true , QConstant QType , true -> Some ("rec_r")
+    | false, true, true , QConstant QProp , _ -> Some ("ind_r")
+    | false, true, true , QConstant QSProp , _ -> Some ("sind_r")
+    | false, true, false , QConstant QType , false -> Some ("rect")
+    | false, true, false , QConstant QType , true -> Some ("rec")
+    | false, true, false , QConstant QProp , _ -> Some ("ind")
+    | false, true, false , QConstant QSProp , _ -> Some ("sind")
+    | false, false, false , QConstant QType , false -> Some ("rect_r")
+    | false, false, false , QConstant QType , true -> Some ("rec_r")
+    | false, false, false , QConstant QProp , _ -> Some ("ind_r")
+    | false, false, false , QConstant QSProp , _ -> Some ("sind_r")
+    | false, false, true , QConstant QProp , _ -> Some ("ind")
+    | false, false, true , QConstant QSProp , _ -> Some ("sind")
+    | false, false, true , QConstant QType , false -> Some ("rect")
+    | false, false, true , QConstant QType , true -> Some ("rec")
     (* Dependent case *)
-    | true, Some true, true , QConstant QType , _ -> Some ("rect_r_dep")
-    | true, Some true, true , QConstant QProp , _ -> Some ("ind_r_dep")
-    | true, _ , true , QConstant QType , _  -> Some ("rect_dep")
-    | true, _ , true , QConstant QProp , _  -> Some ("ind_dep")
+    | true, true, true , QConstant QType , _ -> Some ("rect_r_dep")
+    | true, true, true , QConstant QProp , _ -> Some ("ind_r_dep")
+    | true, false, true , QConstant QType , _  -> Some ("rect_dep")
+    | true, false, true , QConstant QProp , _  -> Some ("ind_dep")
     | _ , _, _ , _ , _ -> None
 
 let eq_scheme_name name dep lft2rgt inccl target is_set =
@@ -368,15 +368,15 @@ let eq_scheme_name name dep lft2rgt inccl target is_set =
 let has_J_ref dep lft2rgt inccl =
   match dep, lft2rgt, inccl with
     (* Non dependent case *)
-    | false, Some true, true -> Rocqlib.lib_ref "core.Has_Leibniz_r" , AtPosition 5
-    | false, Some true, false -> Rocqlib.lib_ref "core.Has_Leibniz" , AtPosition 5
-    | false, _, false -> Rocqlib.lib_ref "core.Has_Leibniz_r" , AtPosition 5
-    | false, _, true -> Rocqlib.lib_ref "core.Has_Leibniz" , AtPosition 5
+    | false, true, true -> Rocqlib.lib_ref "core.Has_Leibniz_r" , AtPosition 5
+    | false, true, false -> Rocqlib.lib_ref "core.Has_Leibniz" , AtPosition 5
+    | false, false, false -> Rocqlib.lib_ref "core.Has_Leibniz_r" , AtPosition 5
+    | false, false, true -> Rocqlib.lib_ref "core.Has_Leibniz" , AtPosition 5
     (* Dependent case *)
-    | true, Some true, true -> Rocqlib.lib_ref "core.Has_J_r" , AtPosition 5
-    | true, Some true, false -> Rocqlib.lib_ref "core.Has_J_r_forward" , AtPosition 4
-    | true, _, true -> Rocqlib.lib_ref "core.Has_J" , AtPosition 5
-    | true, _, false -> Rocqlib.lib_ref "core.Has_J_forward" , AtPosition 4
+    | true, true, true -> Rocqlib.lib_ref "core.Has_J_r" , AtPosition 5
+    | true, true, false -> Rocqlib.lib_ref "core.Has_J_r_forward" , AtPosition 4
+    | true, false, true -> Rocqlib.lib_ref "core.Has_J" , AtPosition 5
+    | true, false, false -> Rocqlib.lib_ref "core.Has_J_forward" , AtPosition 4
 
 let level_init l sigma =
   let rec aux l sigma =
@@ -388,7 +388,7 @@ let level_init l sigma =
       sigma , new_level :: r
   in aux l sigma
 
-let lookup_eq_eliminator env sigma eq ~dep ~inccl ~l2r ~e_sort ~c_sort ~p_sort =
+let lookup_eq_eliminator env sigma eq het_eq ~dep ~inccl ~l2r ~e_sort ~c_sort ~p_sort =
   let has_elim_ref , indarg = has_J_ref dep l2r inccl in
   let has_refl_ref = Rocqlib.lib_ref "core.Has_refl" in
   let c_quality = ESorts.quality sigma c_sort in
@@ -400,12 +400,22 @@ let lookup_eq_eliminator env sigma eq ~dep ~inccl ~l2r ~e_sort ~c_sort ~p_sort =
   let p_level = Sorts.univ_of_sort (ESorts.kind sigma p_sort) in
   let sigma , univs = level_init [ c_level; e_level; p_level ] sigma in
   let names = EInstance.make @@ UVars.Instance.of_array (Array.of_list qs, Array.of_list univs) in
+  (* eta-expansion for equality fun A => eq A *)
   let eta_expand name typ f =
       let body = EConstr.mkApp (Vars.lift 1 f , [| mkRel 1 |] ) in
       EConstr.mkLambda (EConstr.nameR name, typ , body) in
+  (* Special eta-expansion for heterogeneous equality fun A x => JMeq A x A *)
+  let eta_expand_het_eq name namevar typ f =
+      let body = EConstr.mkApp (Vars.lift 2 f , [| mkRel 2 |] ) in
+      let body = EConstr.mkApp (body , [| mkRel 1 |] ) in
+      let body = EConstr.mkApp (body , [| mkRel 2 |] ) in
+      let body = EConstr.mkLambda (EConstr.nameR namevar, mkRel 1 , body) in
+      EConstr.mkLambda (EConstr.nameR name, typ , body) in
   (* This patch is to handle template poly equality with carrier in Prop, because of cumulatitivty of Prop into Type *)
   let c_type = EConstr.mkSort (ESorts.make (Sorts.make c_quality (Univ.Universe.make (List.hd univs)))) in
-  let eq = eta_expand (Id.of_string "A") c_type eq in
+  let eq = if het_eq
+    then eta_expand_het_eq (Id.of_string "A") (Id.of_string "x") c_type eq
+    else eta_expand (Id.of_string "A") c_type eq in
   let sigma , has_J_class = Evd.fresh_global ~names env sigma has_elim_ref in
   if dep then
     let has_refl_names =
@@ -419,8 +429,8 @@ let lookup_eq_eliminator env sigma eq ~dep ~inccl ~l2r ~e_sort ~c_sort ~p_sort =
     let sigma , app = Typing.checked_appvect env sigma has_J_class [| eq |] in
     (sigma , (app, indarg))
 
-let lookup_eq_eliminator_tc env sigma eq ~dep ~inccl ~l2r ~c_sort ~e_sort ~p_sort =
-  let sigma, (query,indarg) = lookup_eq_eliminator env sigma eq
+let lookup_eq_eliminator_tc env sigma eq het_eq ~dep ~inccl ~l2r ~c_sort ~e_sort ~p_sort =
+  let sigma, (query,indarg) = lookup_eq_eliminator env sigma eq het_eq
       ~dep ~inccl ~l2r ~c_sort ~e_sort ~p_sort in
   let db = Hints.searchtable_map rewrite_db in
   let (sigma , c) = Class_tactics.resolve_one_typeclass ~db env sigma query in
@@ -435,7 +445,7 @@ let which_equality_opt env sigma c =
     | None -> None in
   Option.List.flatten @@ List.map (find_eq env sigma c) ["eq";"identity"]
 
-let lookup_eq_eliminator_with_error env sigma eq ~dep ~inccl ~l2r ~c_sort ~e_sort ~p_sort =
+let lookup_eq_eliminator_with_error ?(het_eq=false) env sigma eq ~dep ~inccl ~l2r ~c_sort ~e_sort ~p_sort =
   let which_eq = which_equality_opt env sigma eq in
   let eq_scheme = Option.List.flatten @@ List.map (fun name -> eq_scheme_name name dep l2r inccl (ESorts.quality sigma p_sort) (ESorts.is_set sigma p_sort)) which_eq in
   match eq_scheme with
@@ -445,14 +455,14 @@ let lookup_eq_eliminator_with_error env sigma eq ~dep ~inccl ~l2r ~c_sort ~e_sor
     (sigma , mkConstU (c,u)), indarg
   | _ ->
     try
-      lookup_eq_eliminator_tc env sigma eq ~dep ~inccl ~l2r ~c_sort ~e_sort ~p_sort
+      lookup_eq_eliminator_tc env sigma eq het_eq ~dep ~inccl ~l2r ~c_sort ~e_sort ~p_sort
     with Not_found -> user_err Pp.(
       str "Eliminator not found for query for equality carrier: " ++ Sorts.raw_pr (ESorts.kind sigma e_sort) ++
       str " carrier quality: " ++ Sorts.raw_pr (ESorts.kind sigma c_sort) ++
       str " target quality: " ++ Sorts.raw_pr (ESorts.kind sigma p_sort))
 
-let lookup_eq_eliminator_opt env sigma eq ~dep ~inccl l2r ~c_sort ~e_sort ~p_sort =
-  try Some (lookup_eq_eliminator_with_error env sigma eq ~dep ~inccl ~l2r ~e_sort ~c_sort ~p_sort)
+let lookup_eq_eliminator_opt env sigma eq ~dep het_eq ~inccl l2r ~c_sort ~e_sort ~p_sort =
+  try Some (lookup_eq_eliminator_with_error ~het_eq env sigma eq ~dep ~inccl ~l2r ~e_sort ~c_sort ~p_sort)
   with _ -> None
 
 type eq_scheme_kind = Minimality of UnivGen.QualityOrSet.t | Rewriting | Equality
@@ -470,17 +480,28 @@ let warn_missing_scheme = CWarnings.create ~name:"missing-scheme" ~category:Depr
         hv 0 @@ fmt "Autogenerated \"%s\" scheme for %t.@ Use \"%t\" to explicitly generate it.@ This will become an error in the future."
           name (const ind) cmd)
 
+let warn_missing_scheme = function
+  | None -> Proofview.tclUNIT()
+  | Some warn ->
+    Proofview.tclUNIT() >>= fun () ->
+    try warn_missing_scheme warn; Proofview.tclUNIT()
+    with e when CErrors.noncritical e ->
+      let e, info = Exninfo.capture e in
+      Proofview.tclZERO ~info e
+
 (* find_elim determines which elimination principle is necessary to
    eliminate lbeq on sort_of_gl. *)
 let find_scheme kind scheme_name ind =
   find_scheme scheme_name ind >>= function
-    | Some s -> Proofview.tclUNIT s
+    | Some s -> Proofview.tclUNIT (s,None)
     | None ->
-      match warn_missing_scheme (kind, Ind_tables.scheme_kind_name scheme_name, ind) with
-      | () -> force_find_scheme scheme_name ind
-      | exception e when CErrors.noncritical e ->
-        let e, info = Exninfo.capture e in
-        Proofview.tclZERO ~info e
+      force_find_scheme scheme_name ind >>= fun s ->
+      (* We delay the warning to avoid printing it if the rewrite
+         fails (compatible with the future behaviour where the missing
+         scheme is always error). Typically for [rewrite ?lem] where
+         [lem] is sometimes a proof of equality and sometimes not
+         rewriteable. *)
+      Proofview.tclUNIT (s, Some (kind, Ind_tables.scheme_kind_name scheme_name, ind))
 
 let find_elim lft2rgt dep inccl type_of_cls (ctx, hdcncl, args) =
   Proofview.Goal.enter_one begin fun gl ->
@@ -489,22 +510,25 @@ let find_elim lft2rgt dep inccl type_of_cls (ctx, hdcncl, args) =
   let gen_elim () =
      match EConstr.kind sigma hdcncl with
     | Ind (ind,u) ->
-      find_scheme Rewriting (scheme_name dep lft2rgt inccl) ind >>= fun elim ->
+      find_scheme Rewriting (scheme_name dep lft2rgt inccl) ind >>= fun (elim,warn) ->
       Proofview.tclEVARMAP >>= fun sigma ->
       let (sigma, gref) = Evd.fresh_global env sigma elim in
-      Proofview.Unsafe.tclEVARS sigma <*> Proofview.tclUNIT (gref, UnknownPosition)
+      Proofview.Unsafe.tclEVARS sigma <*> Proofview.tclUNIT (gref, UnknownPosition, warn)
     | _ -> assert false
   in
-  if List.length args = 3
+  let nb_args = List.length args in
+  let maybe_eq = nb_args == 3 in
+  let maybe_het_eq = nb_args == 4 in
+  if maybe_eq || maybe_het_eq
   then
     let env' = EConstr.push_rel_context ctx env in
     let args = Array.of_list args in
     let e_sort = Retyping.get_sort_of env' sigma (mkApp (hdcncl, args)) in
     let c_sort = Retyping.get_sort_of env' sigma args.(0) in
     let p_sort = Retyping.get_sort_of env sigma type_of_cls in
-    match lookup_eq_eliminator_opt env sigma hdcncl ~dep ~inccl lft2rgt ~c_sort ~e_sort ~p_sort with
+    match lookup_eq_eliminator_opt env sigma hdcncl maybe_het_eq ~dep ~inccl lft2rgt ~c_sort ~e_sort ~p_sort with
     | Some ((sigma, c),indarg) ->
-        Proofview.Unsafe.tclEVARS sigma <*> Proofview.tclUNIT (c,indarg)
+        Proofview.Unsafe.tclEVARS sigma <*> Proofview.tclUNIT (c, indarg, None)
     | None -> gen_elim ()
   else
     gen_elim ()
@@ -518,9 +542,10 @@ let leibniz_rewrite_ebindings_clause cls lft2rgt tac c ((_, hdcncl, _) as t) l w
   | Some id -> Tacmach.pf_get_hyp_typ id gl in
   let dep = dep_proof_ok && dependent_no_evar evd c type_of_cls in
   let inccl = Option.is_empty cls in
-  find_elim lft2rgt dep inccl type_of_cls t >>= fun (elim, indarg) ->
+  find_elim lft2rgt dep inccl type_of_cls t >>= fun (elim, indarg, warn) ->
       general_elim_clause with_evars frzevars tac cls c t l
-      (match lft2rgt with None -> false | Some b -> b) elim indarg
+        lft2rgt elim indarg >>= fun () ->
+      warn_missing_scheme warn
   end
 
 let adjust_rewriting_direction args lft2rgt =
@@ -530,10 +555,10 @@ let adjust_rewriting_direction args lft2rgt =
     (* more natural to see -> as the rewriting to the constant *)
     if not lft2rgt then
       user_err Pp.(str "Rewriting non-symmetric equality not allowed from right-to-left.");
-    None
+    false
   | _ ->
     (* other equality *)
-    Some lft2rgt
+    lft2rgt
 
 let rewrite_side_tac tac sidetac = side_tac tac (Option.map fst sidetac)
 
@@ -873,7 +898,7 @@ let set_keep_equality = KeepEqualitiesTable.set
 
 let keep_head_inductive sigma c =
   (* Note that we do not weak-head normalize c before checking it is an
-     applied inductive, because [get_sort_sort_of] did not use to either.
+     applied inductive, because [get_sort_of] did not use to either.
      As a matter of fact, if it reduces to an applied template inductive
      type but is not syntactically equal to it, it will fail to project. *)
   let _, hd = EConstr.decompose_prod sigma c in
@@ -883,14 +908,15 @@ let keep_head_inductive sigma c =
   | _ -> false
 
 let find_positions env sigma ~keep_proofs ~no_discr ~eqsort ~goalsort t1 t2 =
-  let project env posn t1 t2 =
+  let project env posn allowed_elim t1 t2 =
     let ty1 = get_type_of env sigma t1 in
     let keep =
       if keep_head_inductive sigma ty1 then true
       else
         let s = get_sort_quality_of env sigma ty1 in
-        (keep_proofs || not (UnivGen.QualityOrSet.equal s UnivGen.QualityOrSet.prop)) &&
-        not (UnivGen.QualityOrSet.equal s UnivGen.QualityOrSet.sprop)
+        (keep_proofs || not (Sorts.Quality.equal s Sorts.Quality.qprop)) &&
+        not (Sorts.Quality.equal s Sorts.Quality.qsprop) &&
+        allowed_elim
     in
     if keep then [(List.rev posn,t1,t2)] else []
   in
@@ -898,36 +924,39 @@ let find_positions env sigma ~keep_proofs ~no_discr ~eqsort ~goalsort t1 t2 =
   let eqqual = Sorts.quality (ESorts.kind sigma eqsort) in
   let goalsort = ESorts.kind sigma goalsort in
   let false_inst = UVars.Instance.(of_array ([|eqqual|], [||])) in
-  let rec findrec posn t1 t2 =
+  let rec findrec posn s t1 t2 =
     let hd1,args1 = whd_all_stack env sigma t1 in
     let hd2,args2 = whd_all_stack env sigma t2 in
+    let ty1 = get_type_of env sigma t1 in
+    let s1 = get_sort_quality_of env sigma ty1 in
+    let g = Environ.qualities env in
+    let allowed_elim_on_sort = eliminates_to g s s1 in
     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 sp1)
             ->
-          let mind_specif = lookup_mind_specif env ind1 in
+          let (mib,mip) as mind_specif = lookup_mind_specif env ind1 in
           let false_mind_specif = lookup_mind_specif env false_ref in
           let ind_allowed_elim = Inductive.is_allowed_elimination env (mind_specif, EInstance.kind sigma u1) Sorts.type1 in
           let eq_allowed_elim = Inductive.is_allowed_elimination env (false_mind_specif, false_inst) goalsort in
              (* both sides are fully applied constructors, so either we descend,
              or we can discriminate here. *)
-          if Environ.QConstruct.equal env sp1 sp2 then
+          if Environ.QConstruct.equal env sp1 sp2 && allowed_elim_on_sort then
             let nparams = inductive_nparams env ind1 in
             let params1,rargs1 = List.chop nparams args1 in
             let _,rargs2 = List.chop nparams args2 in
-            let (mib,mip) = lookup_mind_specif env ind1 in
             let ctxt = (get_constructor ((ind1,u1),mib,mip,params1) i1).cs_args in
             let adjust i = CVars.adjust_rel_to_rel_context ctxt (i+1) - 1 in
             List.flatten
-              (List.map2_i (fun i -> findrec ((sp1,adjust i)::posn))
+              (List.map2_i (fun i -> findrec ((sp1,adjust i)::posn) s1)
                 0 rargs1 rargs2)
-          else if (ind_allowed_elim && eq_allowed_elim) && not no_discr
+          else if (ind_allowed_elim && eq_allowed_elim && allowed_elim_on_sort) && not no_discr
           then (* see build_discriminator *)
             raise (DiscrFound (List.rev posn, DConstruct (sp1, sp2)))
           else
           (* if we cannot eliminate to Type, we cannot discriminate but we
              may still try to project *)
-          project env posn (applist (hd1,args1)) (applist (hd2,args2))
+          project env posn allowed_elim_on_sort (applist (hd1,args1)) (applist (hd2,args2))
       | Int i1, Int i2 ->
         if Uint63.equal i1 i2 then []
         else raise (DiscrFound (List.rev posn, DInt (i1, i2)))
@@ -943,10 +972,12 @@ let find_positions env sigma ~keep_proofs ~no_discr ~eqsort ~goalsort t1 t2 =
           if is_conv env sigma t1_0 t2_0 then
             []
           else
-            project env posn t1_0 t2_0
+            project env posn allowed_elim_on_sort t1_0 t2_0
   in
   try
-    Inr (findrec [] t1 t2)
+    let ty1 = get_type_of env sigma t1 in
+    let s = get_sort_quality_of env sigma ty1 in
+    Inr (findrec [] s t1 t2)
   with DiscrFound (path, d) ->
     Inl (path, d)
 
@@ -1044,7 +1075,7 @@ let descend_then env sigma head dirn =
         List.map build_branch
           (List.interval 1 (Array.length mip.mind_consnames)) in
       let rci = ERelevance.relevant in (* TODO relevance *)
-      let ci = make_case_info env ind RegularStyle in
+      let ci = make_case_info env ind MatchStyle in
       Inductiveops.make_case_or_project env sigma indt ci (p, rci) head (Array.of_list brl)))
 
 (* Now we need to construct the discriminator, given a discriminable
@@ -1137,7 +1168,7 @@ let discrimination_pf e (eq,_,s,(t,t1,t2)) discriminator p_sort =
     let env = Proofview.Goal.env gl in
     let sigma = Proofview.Goal.sigma gl in
     let ((sigma, c),_) = lookup_eq_eliminator_with_error env sigma eq
-      ~dep:false ~inccl:true ~l2r:(Some false)
+      ~dep:false ~inccl:true ~l2r:false
       ~e_sort:s
       ~c_sort:(Retyping.get_sort_of env sigma t)
       ~p_sort in
@@ -1167,7 +1198,7 @@ let discr_positions env sigma { eq_data = (_, _ , s, (t, _, _)) as eq_data; eq_t
   let false_ty = Retyping.get_type_of env sigma false_0 in
   let false_kind = Retyping.get_sort_of env sigma false_0 in
   let e = next_ident_away eq_baseid (vars_of_env env) in
-  let e_env = push_named (Context.Named.Declaration.LocalAssum (make_annot e ERelevance.relevant,t)) env in
+  let e_env = push_named ProofVar (LocalAssum (make_annot e ERelevance.relevant,t)) env in
 
   let discriminator =
     try
@@ -1364,7 +1395,7 @@ let inject_if_homogenous_dependent_pair ty =
       | Some v -> v
     in
     let new_eq_args = [|Retyping.get_type_of env sigma ar1.(3);ar1.(3);ar2.(3)|] in
-    find_scheme Equality (!eq_dec_scheme_kind_name()) ind >>= fun c ->
+    find_scheme Equality (!eq_dec_scheme_kind_name()) ind >>= fun (c, warn) ->
     let sigma, c = fresh_global env sigma c in
     (* cut with the good equality and prove the requested goal *)
     tclTHENLIST
@@ -1377,7 +1408,8 @@ let inject_if_homogenous_dependent_pair ty =
            Tacticals.pf_constr_of_global inj2 >>= fun inj2 ->
            Tactics.exact_check
              (mkApp(inj2,[|ar1.(0);c;ar1.(1);ar1.(2);ar1.(3);ar2.(3);hyp|]))
-          ])]
+          ]);
+       warn_missing_scheme warn]
   with Exit ->
     Proofview.tclUNIT ()
   end
@@ -1396,7 +1428,7 @@ let simplify_args env sigma t =
 let inject_at_positions env sigma l2r eq posns tac =
   let { eq_data = (eq, congr, s, (t,t1,t2)); eq_term = v; eq_evar = evs } = eq in
   let e = next_ident_away eq_baseid (vars_of_env env) in
-  let e_env = push_named (LocalAssum (make_annot e ERelevance.relevant,t)) env in
+  let e_env = push_named ProofVar (LocalAssum (make_annot e ERelevance.relevant,t)) env in
   let evdref = ref sigma in
   let filter (cpath, t1', t2') =
     try
@@ -1830,7 +1862,7 @@ let subst_one_var dep_proof_ok x =
             (str "Cannot find any non-recursive equality over " ++ Id.print x ++
                str".")
         with FoundHyp res -> res in
-      if is_section_variable (Global.env ()) x then
+      if is_section_variable_env env x then
         check_non_indirectly_dependent_section_variable gl x;
       subst_one dep_proof_ok x res
   end
diff --git a/tactics/equality.mli b/tactics/equality.mli
index fa3d56eeb6ad..8c3f1d75b7a6 100644
--- a/tactics/equality.mli
+++ b/tactics/equality.mli
@@ -27,8 +27,8 @@ type conditions =
   | FirstSolved (* Use the first match whose side-conditions are solved *)
   | AllMatches (* Rewrite all matches whose side-conditions are solved *)
 
-val lookup_eq_eliminator_with_error : Environ.env -> Evd.evar_map -> Evd.econstr ->
-  dep:orientation -> inccl:orientation -> l2r:orientation option ->
+val lookup_eq_eliminator_with_error : ?het_eq:bool -> Environ.env -> Evd.evar_map -> Evd.econstr ->
+  dep:bool -> inccl:bool -> l2r:orientation ->
   c_sort:ESorts.t ->
   e_sort:ESorts.t ->
   p_sort:ESorts.t ->
diff --git a/tactics/fixTactics.ml b/tactics/fixTactics.ml
index 4b44217c33eb..a2179cf62420 100644
--- a/tactics/fixTactics.ml
+++ b/tactics/fixTactics.ml
@@ -55,7 +55,7 @@ let mutual_fix f n others = Proofview.Goal.enter begin fun gl ->
     let ()  = check_mutind env sigma n ar in
     if mem_named_context_val f sign then
       TacticErrors.intro_already_declared f;
-    mk_sign (push_named_context_val (LocalAssum (make_annot f r, ar)) sign) oth
+    mk_sign (push_named_context_val ProofVar (LocalAssum (make_annot f r, ar)) sign) oth
   in
   let nenv = reset_with_named_context (mk_sign (named_context_val env) all) env in
   Refine.refine ~typecheck:false begin fun sigma ->
@@ -98,7 +98,7 @@ let mutual_cofix f others = Proofview.Goal.enter begin fun gl ->
     let open Context.Named.Declaration in
     if mem_named_context_val f sign then
       TacticErrors.already_used f;
-    mk_sign (push_named_context_val (LocalAssum (make_annot f r, ar)) sign) oth
+    mk_sign (push_named_context_val ProofVar (LocalAssum (make_annot f r, ar)) sign) oth
   in
   let nenv = reset_with_named_context (mk_sign (named_context_val env) all) env in
   Refine.refine ~typecheck:false begin fun sigma ->
diff --git a/tactics/generalize.ml b/tactics/generalize.ml
index 28a1d8003575..efabb5313b1d 100644
--- a/tactics/generalize.ml
+++ b/tactics/generalize.ml
@@ -36,18 +36,12 @@ exception AlreadyUsed of Id.t
 let error ?loc e =
   Loc.raise ?loc e
 
-exception Unhandled
-
-let wrap_unhandled f e =
-  try Some (f e)
-  with Unhandled -> None
-
 let tactic_interp_error_handler = function
   | AlreadyUsed id ->
-      Id.print id ++ str " is already used."
-  | _ -> raise Unhandled
+      Some (Id.print id ++ str " is already used.")
+  | _ -> None
 
-let _ = CErrors.register_handler (wrap_unhandled tactic_interp_error_handler)
+let () = CErrors.register_handler tactic_interp_error_handler
 
 let fresh_id_in_env avoid id env =
   let avoid' = ids_of_named_context_val (named_context_val env) in
@@ -158,7 +152,8 @@ let generalize_dep ?(with_let=false) c =
   let sigma = Proofview.Goal.sigma gl in
   let concl = Proofview.Goal.concl gl in
   let sign = named_context_val env in
-  let init_ids = ids_of_named_context (Global.named_context()) in
+  (* XXX avoid section variables still in env instead of all section variables? *)
+  let init_ids = Environ.ids_of_named_context_val (Global.named_context_val()) in
   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
@@ -167,10 +162,10 @@ let generalize_dep ?(with_let=false) c =
       toquant in
   let to_quantify = Context.Named.fold_outside seek (named_context_of_val sign) ~init:[] in
   let qhyps = List.map NamedDecl.get_id to_quantify in
-  let tothin = List.filter (fun id -> not (Id.List.mem id init_ids)) qhyps in
+  let tothin = List.filter (fun id -> not (Id.Set.mem id init_ids)) qhyps in
   let tothin' =
     match EConstr.kind sigma c with
-      | Var id when mem_named_context_val id sign && not (Id.List.mem id init_ids)
+      | Var id when mem_named_context_val id sign && not (Id.Set.mem id init_ids)
           -> tothin@[id]
       | _ -> tothin
   in
@@ -178,7 +173,7 @@ let generalize_dep ?(with_let=false) c =
   let is_var, body = match EConstr.kind sigma c with
   | Var id ->
     let body = NamedDecl.get_value (Tacmach.pf_get_hyp id gl) in
-    let is_var = Option.is_empty body && not (List.mem id init_ids) in
+    let is_var = Option.is_empty body && not (Id.Set.mem id init_ids) in
     if with_let then is_var, body else is_var, None
   | _ -> false, None
   in
@@ -257,8 +252,7 @@ let quantify lconstr =
 let rocq_eq env sigma       = Evd.fresh_global env sigma Rocqlib.(lib_ref "core.eq.type")
 let rocq_eq_refl env sigma  = Evd.fresh_global env sigma Rocqlib.(lib_ref "core.eq.refl")
 
-let rocq_heq_ref        = lazy (Rocqlib.lib_ref "core.JMeq.type")
-let rocq_heq env sigma      = Evd.fresh_global env sigma (Lazy.force rocq_heq_ref)
+let rocq_heq env sigma      = Evd.fresh_global env sigma (Rocqlib.lib_ref "core.JMeq.type")
 let rocq_heq_refl env sigma = Evd.fresh_global env sigma (Rocqlib.lib_ref "core.JMeq.refl")
 (* let rocq_heq_refl = lazy (glob (lib_ref "core.JMeq.refl")) *)
 
@@ -370,12 +364,17 @@ let hyps_of_vars env sigma sign nogen hyps =
     let (_,lh) =
       Context.Named.fold_inside
         (fun (hs,hl) d ->
+           (* hs: vars to generalize (set)
+              hl: vars to generalize that we have seen (list)
+
+              we should generalize d if it is not nogen and
+              either is in hs, or depends on some var in hs *)
           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 sigma d in
-              if not (Id.Set.is_empty (Id.Set.diff xvars hs)) then
+              if not (Id.Set.is_empty (Id.Set.inter xvars hs)) then
                 (Id.Set.add x hs, x :: hl)
               else (hs, hl))
         ~init:(hyps,[])
@@ -494,7 +493,6 @@ 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.enter begin fun gl ->
-  Rocqlib.(check_required_library jmeq_module_name);
   let sigma = Proofview.Goal.sigma gl in
   let (f, args, def, id, oldid) =
     let oldid = Tacmach.pf_get_new_id id gl in
diff --git a/tactics/gentactic.ml b/tactics/gentactic.ml
index b585212cfe9d..585a15eafd58 100644
--- a/tactics/gentactic.ml
+++ b/tactics/gentactic.ml
@@ -10,35 +10,129 @@
 
 open Names
 
-type raw_generic_tactic = Genarg.raw_generic_argument
+module TDyn = Dyn.Make()
 
-type glob_generic_tactic = Genarg.glob_generic_argument
+module Map(A:sig type (_,_) t end) = struct
+  module V = struct type _ t = V : ('raw,'glb) A.t -> ('raw * 'glb) t end
+  module Self = TDyn.Map(V)
 
-let of_raw_genarg x = x
+  type t = Self.t
 
-let to_raw_genarg x = x
+  let empty = Self.empty
 
-let of_glob_genarg x = x
+  let add tag x m = Self.add tag (V x) m
 
-let print_raw = Pputils.pr_raw_generic
+  let mem tag m = Self.mem tag m
 
-let print_glob = Pputils.pr_glb_generic
+  let find tag m = let V x = Self.find tag m in x
+end
 
-let subst = Gensubst.generic_substitute
+type ('raw, 'glb) tag = ('raw * 'glb) TDyn.tag
 
-let intern ?(strict=true) env ?(ltacvars=Id.Set.empty) v =
-  let ist = { (Genintern.empty_glob_sign ~strict env) with ltacvars } in
-  let _, v = Genintern.generic_intern ist v in
-  v
+type raw_generic_tactic = Raw : ('raw, _) tag * 'raw -> raw_generic_tactic
 
-let interp ?(lfun=Id.Map.empty) v =
-  let open Geninterp in
-  let open Proofview.Notations in
-  Proofview.tclProofInfo[@ocaml.warning"-3"] >>= fun (_name, poly) ->
-  let ist = { lfun; poly; extra = TacStore.empty } in
-  let Genarg.GenArg (Glbwit tag, v) = v in
-  let v = Geninterp.interp tag ist v in
-  Ftactic.run v (fun _ -> Proofview.tclUNIT ())
+type glob_generic_tactic = Glb : (_, 'glb) tag * 'glb -> glob_generic_tactic
+
+let repr = TDyn.repr
+
+type any_tag = Any : _ tag -> any_tag
+
+let equal = TDyn.eq
+
+let name s =
+  (* magic: all tags are at tuple types *)
+  TDyn.name s |> Option.map @@ fun (TDyn.Any t) -> Any (Obj.magic t)
+
+let make name : _ tag = TDyn.create name
+
+let empty = make "empty"
+
+let of_raw (type a) (tag:(a, _) tag) (x:a) : raw_generic_tactic =
+  Raw (tag, x)
+
+module Print = struct
+  type ('raw,'glb) t = Print of {
+      raw_print : 'raw Genprint.printer;
+      glb_print : 'glb Genprint.printer;
+    }
+end
+
+module PrintMap = Map(Print)
+
+let printers = ref PrintMap.empty
+
+let register_print tag raw_print glb_print =
+  assert (not @@ PrintMap.mem tag !printers);
+  printers := PrintMap.add tag (Print {raw_print; glb_print}) !printers
+
+let apply_printer env sigma level = function
+  | Genprint.PrinterBasic pp -> pp env sigma
+  | Genprint.PrinterNeedsLevel { default_already_surrounded; printer } ->
+    let level = Option.default default_already_surrounded level in
+    printer env sigma level
+
+let print_raw env sigma ?level (Raw (tag, v)) =
+  let Print {raw_print} = PrintMap.find tag !printers in
+  apply_printer env sigma level (raw_print v)
+
+let print_glob env sigma ?level (Glb (tag, v)) =
+  let Print {glb_print} = PrintMap.find tag !printers in
+  apply_printer env sigma level (glb_print v)
+
+module Subst = struct
+  type _ t = Subst : 'glb Gensubst.subst_fun -> (_ * 'glb) t
+end
+
+module SubstMap = TDyn.Map(Subst)
+
+let substs = ref SubstMap.empty
+
+let register_subst tag subst =
+  assert (not @@ SubstMap.mem tag !substs);
+  substs := SubstMap.add tag (Subst subst) !substs
+
+let subst subst (Glb (tag, v)) =
+  let Subst f = SubstMap.find tag !substs in
+  Glb (tag, f subst v)
+
+module Intern = struct
+  (* XXX change type to match how it's called instead of reusing Genintern.intern_fun *)
+  type _ t = Intern : ('raw, 'glb) Genintern.intern_fun -> ('raw * 'glb) t
+end
+
+module InternMap = TDyn.Map(Intern)
+
+let interns = ref InternMap.empty
+
+let register_intern tag intern =
+  assert (not @@ InternMap.mem tag !interns);
+  interns := InternMap.add tag (Intern intern) !interns
+
+let intern ?(strict=true) env ?(ltacvars=Id.Set.empty) (Raw (tag, v)) =
+  let Intern intern = InternMap.find tag !interns in
+  let ist = Genintern.empty_glob_sign ~strict env UnivNames.empty_binders in
+  let ist = { ist with ltacvars } in
+  let _, v = intern ist v in
+  Glb (tag, v)
+
+type 'glb interp_fun = Geninterp.Val.t Id.Map.t -> 'glb -> unit Proofview.tactic
+
+module Interp =
+struct
+  type _ t = Interp : 'glb interp_fun -> (_ * 'glb) t
+end
+
+module InterpMap = TDyn.Map(Interp)
+
+let interps = ref InterpMap.empty
+
+let register_interp tag interp =
+  assert (not @@ InterpMap.mem tag !interps);
+  interps := InterpMap.add tag (Interp interp) !interps
+
+let interp ?(lfun=Id.Map.empty) (Glb (tag, v)) =
+  let Interp interp = InterpMap.find tag !interps in
+  interp lfun v
 
 let wit_generic_tactic = Genarg.make0 "generic_tactic"
 
diff --git a/tactics/gentactic.mli b/tactics/gentactic.mli
index 529b0b57867c..ef93af6a0ec2 100644
--- a/tactics/gentactic.mli
+++ b/tactics/gentactic.mli
@@ -8,21 +8,35 @@
 (*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
+open Util
 open Names
 
-(** Generic tactic expressions.
-    Internally implemented using [Genarg]. *)
+(** Generic tactic expressions. *)
 
-type raw_generic_tactic
+type ('raw, 'glob) tag
 
-type glob_generic_tactic
+val equal : ('raw1, 'glob1) tag -> ('raw2, 'glob2) tag ->
+  ('raw1 * 'glob1, 'raw2 * 'glob2) Util.eq option
 
-val of_raw_genarg : Genarg.raw_generic_argument -> raw_generic_tactic
-(** The genarg must have registrations for all the following APIs. *)
+val repr : _ tag -> string
 
-val of_glob_genarg : Genarg.glob_generic_argument -> glob_generic_tactic
-(** The genarg must have registrations for all the following APIs
-    except those operating at the "raw" level. *)
+type any_tag = Any : _ tag -> any_tag
+
+val name : string -> any_tag option
+
+type raw_generic_tactic = Raw : ('raw, _) tag * 'raw -> raw_generic_tactic
+
+type glob_generic_tactic = Glb : (_, 'glb) tag * 'glb -> glob_generic_tactic
+
+val make : string -> ('raw, 'glb) tag
+(** Each declared tag must be registered using all the following [register] functions
+    (except when the callback cannot be called ie when the value type at that level is empty). *)
+
+val empty : (Empty.t, Empty.t) tag
+
+val of_raw : ('raw,_) tag -> 'raw -> raw_generic_tactic
+
+val register_print : ('raw, 'glb) tag -> 'raw Genprint.printer -> 'glb Genprint.printer -> unit
 
 val print_raw : Environ.env -> Evd.evar_map -> ?level:Constrexpr.entry_relative_level ->
   raw_generic_tactic -> Pp.t
@@ -30,14 +44,26 @@ val print_raw : Environ.env -> Evd.evar_map -> ?level:Constrexpr.entry_relative_
 val print_glob : Environ.env -> Evd.evar_map -> ?level:Constrexpr.entry_relative_level ->
   glob_generic_tactic -> Pp.t
 
+val register_subst : (_, 'glb) tag -> 'glb Gensubst.subst_fun -> unit
+
 val subst : Mod_subst.substitution -> glob_generic_tactic -> glob_generic_tactic
 
+val register_intern : ('raw, 'glb) tag -> ('raw, 'glb) Genintern.intern_fun -> unit
+
 val intern : ?strict:bool -> Environ.env -> ?ltacvars:Id.Set.t -> raw_generic_tactic -> glob_generic_tactic
 (** [strict] is default true *)
 
+val register_interp : (_, 'glb) tag -> (Geninterp.Val.t Id.Map.t -> 'glb -> unit Proofview.tactic) -> unit
+
 val interp : ?lfun:Geninterp.Val.t Id.Map.t -> glob_generic_tactic -> unit Proofview.tactic
 
 val wit_generic_tactic : raw_generic_tactic Genarg.vernac_genarg_type
 
-val to_raw_genarg : raw_generic_tactic -> Genarg.raw_generic_argument
-(** For serlib *)
+module Map(A:sig type (_,_) t end) : sig
+  type t
+
+  val empty : t
+  val add : ('raw,'glb) tag -> ('raw,'glb) A.t -> t -> t
+  val find : ('raw,'glb) tag -> t -> ('raw,'glb) A.t
+  val mem : _ tag -> t -> bool
+end
diff --git a/tactics/hints.ml b/tactics/hints.ml
index f4082bcc6f9f..698af4e61d68 100644
--- a/tactics/hints.ml
+++ b/tactics/hints.ml
@@ -16,12 +16,10 @@ open Constr
 open Context
 open Evd
 open EConstr
-open Vars
 open Environ
 open Mod_subst
 open Globnames
 open Libobject
-open Namegen
 open Libnames
 open Termops
 open Inductiveops
@@ -31,8 +29,6 @@ open Patternops
 open Tacred
 open Printer
 
-module NamedDecl = Context.Named.Declaration
-
 (****************************************)
 (* General functions                    *)
 (****************************************)
@@ -81,14 +77,13 @@ let secvars_of_hyps hyps =
   let open Context.Named.Declaration in
   let pred, all =
     List.fold_left (fun (pred,all) decl ->
-        try let _ = Context.Named.lookup (get_id decl) hyps in
-          (* Approximation, it might be an hypothesis reintroduced with same name and unconvertible types,
-             we must allow it currently, as comparing the declarations for syntactic equality is too
-             strong a check (e.g. an unfold in a section variable would make it unusable). *)
+        if Termops.is_section_variable_sign ~check:false hyps (get_id decl) then
           (Id.Pred.add (get_id decl) pred, all)
-        with Not_found -> (pred, false))
+        else (pred, false))
       (Id.Pred.empty,true) secctx
   in
+  (* NB: this is not just [forall is_secvar hyps] because we need to
+     know if secvars have been cleaned *)
   if all then Id.Pred.full (* If the whole section context is available *)
   else pred
 
@@ -99,6 +94,9 @@ let empty_hint_info =
 (*           The Type of Constructions Autotactic Hints                 *)
 (************************************************************************)
 
+module Internal =
+struct
+
 type 'a hint_ast =
   | Res_pf     of 'a (* Hint Apply *)
   | ERes_pf    of 'a (* Hint EApply *)
@@ -107,6 +105,9 @@ type 'a hint_ast =
   | Unfold_nth of Evaluable.t (* Hint Unfold *)
   | Extern of Pattern.constr_pattern option * Gentactic.glob_generic_tactic (* Hint Extern *)
 
+end
+
+open Internal
 
 type 'a hints_path_atom_gen =
   | PathHints of 'a list
@@ -126,24 +127,20 @@ type 'a hints_path_gen =
 type pre_hints_path = Libnames.qualid hints_path_gen
 type hints_path = GlobRef.t hints_path_gen
 
-type hint_term =
-  | IsGlobRef of GlobRef.t
-  | IsConstr of constr * UnivGen.sort_context_set option (* None if monomorphic *)
-
 type 'a with_uid = {
   obj : 'a;
   uid : KerName.t;
 }
 
 type raw_hint = {
-  rhint_term : constr;
+  rhint_term : GlobRef.t puniverses;
   rhint_type : types;
   rhint_uctx : UnivGen.sort_context_set option;
   rhint_arty : int; (* Number of goals generated by the intended tactic *)
 }
 
 type hint = {
-  hint_term : constr;
+  hint_term : GlobRef.t puniverses;
   hint_type : types;
   hint_uctx : UnivGen.sort_context_set option; (* None if monomorphic *)
   hint_clnv : Clenv.clausenv;
@@ -180,14 +177,15 @@ type hint_entry = GlobRef.t option *
 
 type hint_mode =
   | ModeInput (* No evars *)
+  | ModeFrozen (* evars are allowed but will never be instantiated by hints *)
   | ModeNoHeadEvar (* No evar at the head *)
   | ModeOutput (* Anything *)
 
 module Modes =
 struct
-  type t = hint_mode array list GlobRef.Map.t
-  let empty = GlobRef.Map.empty
-  let union m1 m2 = GlobRef.Map.union (fun _ m1 m2 -> Some (m1@m2)) m1 m2
+  type t = { modes : hint_mode array list GlobRef.Map_env.t }
+  let empty = { modes = GlobRef.Map_env.empty }
+  let union m1 m2 = { modes = GlobRef.Map_env.union (fun _ m1 m2 -> Some (m1@m2)) m1.modes m2.modes }
 end
 
 type 'a hints_transparency_target =
@@ -196,7 +194,7 @@ type 'a hints_transparency_target =
   | HintsProjections
   | HintsReferences of 'a list
 
-let hint_as_term h = (h.hint_uctx, h.hint_term)
+let hint_as_term h = (h.hint_uctx, mkRef h.hint_term)
 
 let fresh_key =
   let id = Summary.ref ~name:"HINT-COUNTER" 0 in
@@ -393,7 +391,7 @@ let merge_context_set_opt sigma ctx = match ctx with
 let instantiate_hint env sigma p =
   let mk_clenv { rhint_term = c; rhint_type = cty; rhint_uctx = ctx; rhint_arty = ar } =
     let sigma = merge_context_set_opt sigma ctx in
-    let cl = Clenv.mk_clenv_from env sigma (c,cty) in
+    let cl = Clenv.mk_clenv_from env sigma (mkRef c, cty) in
     let cl = Clenv.clenv_strip_proj_params cl in
     { hint_term = c; hint_type = cty; hint_uctx = ctx; hint_clnv = cl; hint_arty = ar }
   in
@@ -409,9 +407,10 @@ let instantiate_hint env sigma p =
 
 let hint_mode_eq m1 m2 = match m1, m2 with
   | ModeInput, ModeInput -> true
+  | ModeFrozen, ModeFrozen -> true
   | ModeNoHeadEvar, ModeNoHeadEvar -> true
   | ModeOutput, ModeOutput -> true
-  | (ModeInput | ModeNoHeadEvar | ModeOutput), _ -> false
+  | (ModeInput | ModeFrozen | ModeNoHeadEvar | ModeOutput), _ -> false
 
 let hints_path_atom_eq env h1 h2 = match h1, h2 with
 | PathHints l1, PathHints l2 -> List.equal (fun gr1 gr2 -> QGlobRef.equal env gr1 gr2) l1 l2
@@ -588,7 +587,7 @@ let rec subst_hints_path subst hp =
 
 type mode_match =
   | NoMode
-  | WithMode of hint_mode array
+  | WithMode of Evarsolve.AllowedEvars.t
 
 type 'a with_mode =
   | ModeMatch of mode_match * 'a
@@ -599,7 +598,7 @@ sig
 type t
 val empty : ?name:hint_db_name -> TransparentState.t -> bool -> t
 val map_none : secvars:Id.Pred.t -> t -> full_hint list
-val map_all : secvars:Id.Pred.t -> GlobRef.t -> t -> full_hint list
+val map_all : Environ.env -> secvars:Id.Pred.t -> GlobRef.t -> t -> full_hint list
 val map_eauto : Environ.env -> evar_map -> secvars:Id.Pred.t ->
                 (GlobRef.t * constr array) -> constr -> t -> full_hint list with_mode
 val map_auto : Environ.env -> evar_map -> secvars:Id.Pred.t ->
@@ -612,11 +611,11 @@ val use_dn : t -> bool
 val transparent_state : t -> TransparentState.t
 val set_transparent_state : t -> TransparentState.t -> t
 val add_cut : Environ.env -> hints_path -> t -> t
-val add_mode : GlobRef.t -> hint_mode array -> t -> t
+val add_mode : Environ.env -> GlobRef.t -> hint_mode array -> t -> t
 val cut : t -> hints_path
-val unfolds : t -> Id.Set.t * Cset.t * PRset.t
-val add_modes : hint_mode array list GlobRef.Map.t -> t -> t
-val modes : t -> hint_mode array list GlobRef.Map.t
+val unfolds : t -> Id.Set.t * Cset_env.t * PRset_env.t
+val add_modes : Modes.t -> t -> t
+val modes : t -> Modes.t
 val find_mode : env -> GlobRef.t -> t -> hint_mode array list
 val fold : (GlobRef.t option -> hint_mode array list -> full_hint list -> 'a -> 'a) ->
   t -> 'a -> 'a
@@ -626,10 +625,10 @@ struct
   type t = {
     hintdb_state : TransparentState.t;
     hintdb_cut : hints_path;
-    hintdb_unfolds : Id.Set.t * Cset.t * PRset.t;
+    hintdb_unfolds : Id.Set.t * Cset_env.t * PRset_env.t;
     hintdb_max_id : int;
     use_dn : bool;
-    hintdb_map : search_entry GlobRef.Map.t;
+    hintdb_map : search_entry GlobRef.Map_env.t;
     (* A list of unindexed entries with no associated pattern. *)
     hintdb_nopat : stored_data list;
     hintdb_name : string option;
@@ -641,19 +640,24 @@ struct
 
   let empty ?name st use_dn = { hintdb_state = st;
                           hintdb_cut = PathEmpty;
-                          hintdb_unfolds = (Id.Set.empty, Cset.empty, PRset.empty);
+                          hintdb_unfolds = (Id.Set.empty, Cset_env.empty, PRset_env.empty);
                           hintdb_max_id = 0;
                           use_dn = use_dn;
-                          hintdb_map = GlobRef.Map.empty;
+                          hintdb_map = GlobRef.Map_env.empty;
                           hintdb_nopat = [];
                           hintdb_name = name; }
 
   let dn_ts db = if db.use_dn then (Some db.hintdb_state) else None
 
-  let find key db =
-    try GlobRef.Map.find key db.hintdb_map
+  let find0 key db =
+    (* We assume here that key is canonical at this point. *)
+    try GlobRef.Map_env.find key db.hintdb_map
     with Not_found -> empty_se (dn_ts db)
 
+  let find env key db =
+    let key = QGlobRef.canonize env key in
+    find0 key db
+
   let realize_tac secvars (id,tac) =
     if Id.Pred.subset tac.secvars secvars then Some tac
     else
@@ -674,10 +678,30 @@ struct
     | ModeInput -> not (occur_existential sigma arg)
     | ModeNoHeadEvar -> has_no_head_evar sigma arg
     | ModeOutput -> true
+    | _ -> assert false
 
   let matches_mode sigma args mode =
-    if Array.length mode == Array.length args &&
-        Array.for_all2 (match_mode sigma) mode args then Some mode
+    if Array.length mode == Array.length args then
+      (* we don't need to compute evar sets if there's no ModeInput *)
+      if Array.exists (fun m -> m = ModeFrozen) mode then
+        let exception Mismatch in
+        begin try
+          (* forbid all evars appearing in arguments with [ModeFrozen],
+             unconditionally, even when they appear in other arguments. *)
+          let f forbid m arg =
+            match m with
+            | ModeNoHeadEvar when not (has_no_head_evar sigma arg) -> raise Mismatch
+            | ModeInput when occur_existential sigma arg -> raise Mismatch
+            | ModeFrozen -> Evar.Set.union forbid (Evd.evars_of_term sigma arg)
+            | ModeNoHeadEvar | ModeInput | ModeOutput -> forbid
+          in
+          let forbid = Array.fold_left2 f Evar.Set.empty mode args in
+          Some (Evarsolve.AllowedEvars.except forbid)
+        with Mismatch -> None
+        end
+      else if Array.for_all2 (match_mode sigma) mode args
+      then Some Evarsolve.AllowedEvars.all
+      else None
     else None
 
   let matches_modes sigma args modes =
@@ -694,8 +718,8 @@ struct
   let map_none ~secvars db =
     merge_entry secvars db [] []
 
-  let map_all ~secvars k db =
-    let se = find k db in
+  let map_all env ~secvars k db =
+    let se = find env k db in
     let h = List.sort pri_order_int db.hintdb_nopat in
     let h = merge_set (StoredData.elements se.sentry_nopat) h in
     let h = merge_set (StoredData.elements se.sentry_pat) h in
@@ -703,13 +727,13 @@ struct
 
   (* Precondition: concl has no existentials *)
   let map_auto env sigma ~secvars (k,args) concl db =
-    let se = find k db in
+    let se = find env k db in
     let pat = lookup_tacs env sigma concl se in
     merge_entry secvars db [] pat
 
   (* [c] contains an existential *)
   let map_eauto env sigma ~secvars (k,args) concl db =
-    let se = find k db in
+    let se = find env k db in
       match matches_modes sigma args se.sentry_mode with
       | Some m ->
         let pat = lookup_tacs env sigma concl se in
@@ -720,6 +744,7 @@ struct
     | Give_exact _ -> true
     | _ -> false
 
+  (* gr must be canonical *)
   let addkv gr id v db =
     let idv = id, { v with db = db.hintdb_name } in
       match gr with
@@ -734,12 +759,12 @@ struct
           if not db.use_dn && is_exact v.code.obj then None
           else v.pat
         in
-          let oval = find gr db in
-            { db with hintdb_map = GlobRef.Map.add gr (add_tac pat idv oval) db.hintdb_map }
+          let oval = find0 gr db in
+            { db with hintdb_map = GlobRef.Map_env.add gr (add_tac pat idv oval) db.hintdb_map }
 
   let rebuild_db st' db =
     let db' =
-      { db with hintdb_map = GlobRef.Map.map (rebuild_dn (Some st')) db.hintdb_map;
+      { db with hintdb_map = GlobRef.Map_env.map (rebuild_dn (Some st')) db.hintdb_map;
         hintdb_state = st'; hintdb_nopat = [] }
     in
       List.fold_left (fun db (id, v) -> addkv None id v db) db' db.hintdb_nopat
@@ -755,22 +780,25 @@ struct
       | Evaluable.EvalVarRef id ->
         { ts with tr_var = Id.Pred.add id ts.tr_var }, (Id.Set.add id ids, csts, prjs)
       | Evaluable.EvalConstRef cst ->
-        { ts with tr_cst = Cpred.add cst ts.tr_cst }, (ids, Cset.add cst csts, prjs)
+        (* TODO: do we really want to canonize? *)
+        let cst = QConstant.canonize env cst in
+        { ts with tr_cst = Cpred.add cst ts.tr_cst }, (ids, Cset_env.add cst csts, prjs)
       | Evaluable.EvalProjectionRef p ->
-        { ts with tr_prj = PRpred.add p ts.tr_prj }, (ids, csts, PRset.add p prjs)
+        (* TODO: do we really want to canonize? *)
+        let p = QProjection.Repr.canonize env p in
+        { ts with tr_prj = PRpred.add p ts.tr_prj }, (ids, csts, PRset_env.add p prjs)
       in
       let db = { db with hintdb_unfolds = unfs } in
       if db.use_dn then rebuild_db state db else db
     | _ -> db
     in
     let db, id = next_hint_id db in
+    let k = Option.map (fun gr -> QGlobRef.canonize env gr) k in
     addkv k id v db
 
   let add_list env sigma l db = List.fold_left (fun db k -> add_one env sigma k db) db l
 
   let remove env st grs se =
-    let fold accu gr = GlobRef.Set_env.add (Environ.QGlobRef.canonize env gr) accu in
-    let grs = List.fold_left fold GlobRef.Set_env.empty grs in
     let nopat = StoredData.remove env grs se.sentry_nopat in
     let pat = StoredData.remove env grs se.sentry_pat in
     if pat == se.sentry_pat && nopat == se.sentry_nopat then se
@@ -779,10 +807,11 @@ struct
       rebuild_dn st se
 
   let remove_list env grs db =
-    let eq gr1 gr2 = QGlobRef.equal env gr1 gr2 in
+    let fold accu gr = GlobRef.Set_env.add (Environ.QGlobRef.canonize env gr) accu in
+    let grs = List.fold_left fold GlobRef.Set_env.empty grs in
     let filter (_, h) =
-      match h.name with Some gr -> not (List.mem_f eq gr grs) | None -> true in
-    let hintmap = GlobRef.Map.map (fun e -> remove env (dn_ts db) grs e) db.hintdb_map in
+      match h.name with Some gr -> not (GlobRef.Set_env.mem gr grs) | None -> true in
+    let hintmap = GlobRef.Map_env.map (fun e -> remove env (dn_ts db) grs e) db.hintdb_map in
     let hintnopat = List.filter filter db.hintdb_nopat in
       { db with hintdb_map = hintmap; hintdb_nopat = hintnopat }
 
@@ -795,11 +824,11 @@ struct
   let iter f db =
     let iter_se k se = f (Some k) se.sentry_mode (get_entry se) in
     f None [] (List.map snd db.hintdb_nopat);
-    GlobRef.Map.iter iter_se db.hintdb_map
+    GlobRef.Map_env.iter iter_se db.hintdb_map
 
   let fold f db accu =
     let accu = f None [] (List.map snd db.hintdb_nopat) accu in
-    GlobRef.Map.fold (fun k se -> f (Some k) se.sentry_mode (get_entry se)) db.hintdb_map accu
+    GlobRef.Map_env.fold (fun k se -> f (Some k) se.sentry_mode (get_entry se)) db.hintdb_map accu
 
   let transparent_state db = db.hintdb_state
 
@@ -810,10 +839,10 @@ struct
   let add_cut env path db =
     { db with hintdb_cut = normalize_path env (PathOr (db.hintdb_cut, path)) }
 
-  let add_mode gr m db =
-    let se = find gr db in
+  let add_mode env gr m db =
+    let se = find env gr db in
     let se = { se with sentry_mode = m :: List.remove (Array.equal hint_mode_eq) m se.sentry_mode } in
-    { db with hintdb_map = GlobRef.Map.add gr se db.hintdb_map }
+    { db with hintdb_map = GlobRef.Map_env.add gr se db.hintdb_map }
 
   let cut db = db.hintdb_cut
 
@@ -823,12 +852,12 @@ struct
     let f gr e me =
       Some { e with sentry_mode = me.sentry_mode @ e.sentry_mode }
     in
-    let mode_entries = GlobRef.Map.map (fun m -> { (empty_se (dn_ts db)) with sentry_mode = m }) modes in
-    { db with hintdb_map = GlobRef.Map.union f db.hintdb_map mode_entries }
+    let mode_entries = GlobRef.Map_env.map (fun m -> { (empty_se (dn_ts db)) with sentry_mode = m }) modes.Modes.modes in
+    { db with hintdb_map = GlobRef.Map_env.union f db.hintdb_map mode_entries }
 
-  let modes db = GlobRef.Map.map (fun se -> se.sentry_mode) db.hintdb_map
+  let modes db = { Modes.modes = GlobRef.Map_env.map (fun se -> se.sentry_mode) db.hintdb_map }
 
-  let find_mode _env gr db = (GlobRef.Map.find gr db.hintdb_map).sentry_mode
+  let find_mode _env gr db = (GlobRef.Map_env.find gr db.hintdb_map).sentry_mode
 
   let use_dn db = db.use_dn
 
@@ -865,20 +894,28 @@ let error_no_such_hint_database x =
 
 let with_uid c = { obj = c; uid = fresh_key () }
 
-let secvars_of_idset s =
+(* if [x] is a local variable sharing a name with a cleared section
+   variable, [secvars_of_global _ (VarRef x)] should return the empty set *)
+let secvars_of_idset env s =
   Id.Set.fold (fun id p ->
-      if is_section_variable (Global.env ()) id then
+      if is_section_variable_env env id then
         Id.Pred.add id p
       else p) s Id.Pred.empty
 
-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 env gr)
+  secvars_of_idset env (vars_of_global env gr)
+
+let fresh_global_hint env sigma gr =
+  let (c, ctx) = UnivGen.fresh_global_instance env gr in
+  let _, u = Constr.destRef c in
+  let u = EInstance.make u in
+  let ctx = if Environ.is_polymorphic env gr then Some ctx else None in
+  let cty = Retyping.get_type_of env sigma (mkRef (gr, u)) in
+  ((gr, u), cty, ctx)
 
-let make_exact_entry env sigma info ?name (c, cty, ctx) =
-  let secvars = secvars_of_constr env sigma c in
+let make_exact_entry env sigma info gr =
+  let (c, cty, ctx) = fresh_global_hint env sigma gr in
+  let secvars = secvars_of_global env gr in
   let cty = strip_outer_cast sigma cty in
     match EConstr.kind sigma cty with
     | Prod _ -> failwith "make_exact_entry"
@@ -894,28 +931,25 @@ let make_exact_entry env sigma info ?name (c, cty, ctx) =
         in
         let h = { rhint_term = c; rhint_type = cty; rhint_uctx = ctx; rhint_arty = 0 } in
         (Some hd,
-         { pri; pat = Some pat; name;
+         { pri; pat = Some pat; name = Some gr;
            db = (); secvars;
            code = with_uid (Give_exact h); })
 
-let name_of_hint = function
-| IsGlobRef gr -> Some gr
-| IsConstr _ -> None
-
-let make_apply_entry env sigma hnf info ?name (c, cty, ctx) =
+let make_apply_entry env sigma hnf info gr =
+  let (c, cty, ctx) = fresh_global_hint env sigma gr in
   let cty = if hnf then hnf_constr0 env sigma cty else cty in
   match EConstr.kind sigma cty with
   | Prod _ ->
     let cty = if hnf then Reductionops.nf_betaiota env sigma cty else cty in
     let sigma' = merge_context_set_opt sigma ctx in
-    let ce = Clenv.mk_clenv_from env sigma' (c,cty) in
+    let ce = Clenv.mk_clenv_from env sigma' (mkRef c, cty) in
     let c' = Clenv.clenv_type (* ~reduce:false *) ce in
     let hd =
       try head_bound (Clenv.clenv_evd ce) c'
       with Bound -> failwith "make_apply_entry" in
     let miss, hyps = Clenv.clenv_missing ce in
     let nmiss = List.length miss in
-    let secvars = secvars_of_constr env sigma c in
+    let secvars = secvars_of_global env (fst c) in
     let pri = match info.hint_priority with None -> hyps + nmiss | Some p -> p in
     let pat = match info.hint_pattern with
     | Some p -> ConstrPattern (snd p)
@@ -924,13 +958,13 @@ let make_apply_entry env sigma hnf info ?name (c, cty, ctx) =
     let h = { rhint_term = c; rhint_type = cty; rhint_uctx = ctx; rhint_arty = hyps; } in
     if Int.equal nmiss 0 then
       (Some hd,
-       { pri; pat = Some pat; name;
+       { pri; pat = Some pat; name = Some gr;
          db = ();
          secvars;
          code = with_uid (Res_pf h); })
     else
       (Some hd,
-       { pri; pat = Some pat; name;
+       { pri; pat = Some pat; name = Some gr;
          db = (); secvars;
          code = with_uid (ERes_pf h); })
   | _ -> failwith "make_apply_entry"
@@ -939,44 +973,30 @@ let make_apply_entry env sigma hnf info ?name (c, cty, ctx) =
    c is a constr
    cty is the type of constr *)
 
-let fresh_global_or_constr env sigma cr = match cr with
-| IsGlobRef gr ->
-  let (c, ctx) = UnivGen.fresh_global_instance env gr in
-  let ctx = if Environ.is_polymorphic env gr then Some ctx else None in
-  (EConstr.of_constr c, ctx)
-| IsConstr (c, ctx) -> (c, ctx)
-
 let make_resolves env sigma (eapply, hnf) info ~check cr =
-  let name = name_of_hint cr in
-  let c, ctx = fresh_global_or_constr env sigma cr in
-  let cty = Retyping.get_type_of env sigma c in
   let try_apply f =
     try
-      let (_, hint) as ans = f (c, cty, ctx) in
+      let (_, hint) as ans = f cr in
       match hint.code.obj with
       | ERes_pf _ -> if not eapply then None else Some ans
       | _ -> Some ans
     with Failure _ -> None
   in
   let ents = List.map_filter try_apply
-                             [make_exact_entry env sigma info ?name;
-                              make_apply_entry env sigma hnf info ?name]
+                             [make_exact_entry env sigma info;
+                              make_apply_entry env sigma hnf info]
   in
   if check && List.is_empty ents then
     user_err
-      (pr_leconstr_env env sigma c ++ spc() ++
+      (Printer.pr_global cr ++ spc() ++
         (if eapply 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 hname =
-  let decl = EConstr.lookup_named hname env in
-  let c = mkVar hname in
   try
-    [make_apply_entry env sigma true empty_hint_info
-       ~name:(GlobRef.VarRef hname)
-       (c, NamedDecl.get_type decl, None)]
+    [make_apply_entry env sigma true empty_hint_info (GlobRef.VarRef hname)]
   with
     | Failure _ -> []
     | e when noncritical e -> anomaly (Pp.str "make_resolve_hyp.")
@@ -1023,18 +1043,17 @@ let make_mode ref m =
     else m'
 
 let make_trivial env sigma r =
-  let name = Some r in
-  let c,ctx = fresh_global_or_constr env sigma (IsGlobRef r) in
+  let c, cty, ctx = fresh_global_hint env sigma r in
   let sigma = merge_context_set_opt sigma ctx in
-  let t = hnf_constr env sigma (Retyping.get_type_of env sigma c) in
+  let t = hnf_constr env sigma cty in
   let hd = head_constr sigma t in
   let h = { rhint_term = c; rhint_type = t; rhint_uctx = ctx; rhint_arty = 0 } in
   (Some hd,
    { pri=1;
      pat = Some DefaultPattern;
-     name = name;
+     name = Some r;
      db = ();
-     secvars = secvars_of_constr env sigma c;
+     secvars = secvars_of_global env r;
      code= with_uid (Res_pf_THEN_trivial_fail h) })
 
 
@@ -1088,9 +1107,9 @@ let add_cut dbname path =
   let db' = Hint_db.add_cut env path db in
   searchtable_add (dbname, db')
 
-let add_mode dbname l m =
+let add_mode env dbname l m =
   let db = get_db dbname in
-  let db' = Hint_db.add_mode l m db in
+  let db' = Hint_db.add_mode env l m db in
   searchtable_add (dbname, db')
 
 type db_obj = {
@@ -1184,7 +1203,7 @@ let load_autohint _ h =
   | AddCut paths ->
     if superglobal then add_cut name paths
   | AddMode { gref; mode } ->
-    if superglobal then add_mode name gref mode
+    if superglobal then add_mode (Global.env ()) name gref mode
 
 let open_autohint h =
   let superglobal = superglobal h in
@@ -1198,7 +1217,7 @@ let open_autohint h =
   | RemoveHints hints ->
     if not superglobal then remove_hint h.hint_name hints
   | AddMode { gref; mode } ->
-    if not superglobal then add_mode h.hint_name gref mode
+    if not superglobal then add_mode (Global.env ()) h.hint_name gref mode
 
 let cache_autohint o =
   load_autohint 1 o; open_autohint o
@@ -1213,10 +1232,10 @@ let subst_autohint (subst, obj) =
        with Bound -> gr')
   in
   let subst_mps subst c = EConstr.of_constr (subst_mps subst (EConstr.Unsafe.to_constr c)) in
-  let subst_aux ({ rhint_term = c; rhint_type = t; rhint_uctx = ctx; rhint_arty = ar } as h) =
-    let c' = subst_mps subst c in
+  let subst_aux ({ rhint_term = (gr, u); rhint_type = t; rhint_uctx = ctx; rhint_arty = ar } as h) =
+    let gr' = subst_global_reference subst gr in
     let t' = subst_mps subst t in
-    if c==c' && t'==t then h else { rhint_term = c'; rhint_type = t'; rhint_uctx = ctx; rhint_arty = ar }
+    if gr==gr' && t'==t then h else { rhint_term = (gr', u); rhint_type = t'; rhint_uctx = ctx; rhint_arty = ar }
   in
   let subst_hint (k,data as hint) =
     let k' = Option.Smart.map subst_key k in
@@ -1384,20 +1403,20 @@ let add_resolves env sigma clist ~locality dbnames =
     (fun dbname ->
       let r =
         List.flatten (List.map (fun (pri, hnf, gr) ->
-          make_resolves env sigma (true, hnf) pri ~check:true (IsGlobRef gr)) clist)
+          make_resolves env sigma (true, hnf) pri ~check:true gr) clist)
       in
       let check (_, hint) = match hint.code.obj with
       | ERes_pf { rhint_term = c; rhint_type = cty; rhint_uctx = ctx } ->
         let sigma' = merge_context_set_opt sigma ctx in
-        let ce = Clenv.mk_clenv_from env sigma' (c,cty) in
+        let ce = Clenv.mk_clenv_from env sigma' (mkRef c, cty) in
         let miss, _ = Clenv.clenv_missing ce in
         let nmiss = List.length miss in
         let variables = str (CString.plural nmiss "variable") in
         Feedback.msg_info (
           strbrk "The hint " ++
-          pr_leconstr_env env sigma' c ++
+          pr_global (fst c) ++
           strbrk " will only be used by eauto, because applying " ++
-          pr_leconstr_env env sigma' c ++
+          pr_global (fst c) ++
           strbrk " would leave " ++ variables ++ Pp.spc () ++
           Pp.prlist_with_sep Pp.pr_comma Name.print miss ++
           strbrk " as unresolved existential " ++ variables ++ str "."
@@ -1471,42 +1490,6 @@ type hints_entry =
   | HintsModeEntry of GlobRef.t * hint_mode list
   | HintsExternEntry of hint_info * Gentactic.glob_generic_tactic
 
-let default_prepare_hint_ident = Id.of_string "H"
-
-exception Found of constr * types
-
-let prepare_hint env init (sigma,c) =
-  let sigma = Typeclasses.resolve_typeclasses ~fail:false env sigma in
-  (* We re-abstract over uninstantiated evars and universes.
-     It is actually a bit stupid to generalize over evars since the first
-     thing make_resolves will do is to re-instantiate the products *)
-  let c = 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 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 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 *)
-        user_err Pp.(str "Not clever enough to deal with evars dependent in other evars.");
-      raise (Found (c,t))
-    | _ -> 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 sigma (make_annot id ERelevance.relevant) t (iter (replace_term sigma evar (mkVar id) c)) in
-  let c' = iter c in
-    let diff = UnivGen.diff_sort_context (Evd.sort_context_set sigma) (Evd.sort_context_set init) in
-    (c', diff)
-
 let warn_non_local_section_hint =
   CWarnings.create ~name:"non-local-section-hint" ~category:CWarnings.CoreCategories.automation
     (fun () -> strbrk "This hint is not local but depends on a section variable. It will disappear when the section is closed.")
@@ -1547,26 +1530,15 @@ let add_hints ~locality dbnames h =
   | HintsExternEntry (info, tacexp) ->
       add_externs info tacexp ~locality dbnames
 
-let warn_non_reference_hint_using =
-  CWarnings.create ~name:"non-reference-hint-using" ~category:CWarnings.CoreCategories.deprecated
-    Pp.(fun (env, sigma, c) -> str "Use of the non-reference term " ++ pr_leconstr_env env sigma c ++ str " in \"using\" clauses is deprecated")
-
 let expand_constructor_hints env sigma lems =
   List.map_append (fun lem ->
-    let evd, lem = lem env sigma in
-    let lem0 = drop_extra_implicit_args evd lem in
-    match EConstr.kind evd lem0 with
-    | Ind (ind,u) ->
+    match lem with
+    | GlobRef.IndRef ind ->
         List.init (nconstructors env ind)
-                  (fun i -> IsGlobRef (GlobRef.ConstructRef ((ind,i+1))))
-    | Const (cst, _) -> [IsGlobRef (GlobRef.ConstRef cst)]
-    | Var id -> [IsGlobRef (GlobRef.VarRef id)]
-    | Construct (cstr, _) -> [IsGlobRef (GlobRef.ConstructRef cstr)]
-    | _ ->
-      let () = warn_non_reference_hint_using (env, evd, lem) in
-      let (c, ctx) = prepare_hint env sigma (evd,lem) in
-      let ctx = if UnivGen.is_empty_sort_context ctx then None else Some ctx in
-      [IsConstr (c, ctx)]) lems
+                  (fun i -> GlobRef.ConstructRef ((ind,i+1)))
+    | GlobRef.ConstRef cst -> [GlobRef.ConstRef cst]
+    | GlobRef.VarRef id -> [GlobRef.VarRef id]
+    | GlobRef.ConstructRef cstr -> [GlobRef.ConstructRef cstr]) lems
 (* builds a hint database from a constr signature *)
 (* typically used with (lid, ltyp) = pf_hyps_types  *)
 
@@ -1608,7 +1580,7 @@ let make_db_list dbnames =
   List.map lookup dbnames
 
 let push_resolves env sigma hint db =
-  let entries = make_resolves env sigma (true, false) empty_hint_info ~check:false (IsGlobRef hint) in
+  let entries = make_resolves env sigma (true, false) empty_hint_info ~check:false hint in
   Hint_db.add_list env sigma entries db
 
 let push_resolve_hyp env sigma decl db =
@@ -1619,7 +1591,7 @@ let push_resolve_hyp env sigma decl db =
 (*                    Functions for printing the hints                    *)
 (**************************************************************************)
 
-let pr_hint_elt env sigma h = pr_econstr_env env sigma h.hint_term
+let pr_hint_elt env sigma h = pr_global (fst h.hint_term)
 
 let pr_hint env sigma h = match h.obj with
   | Res_pf c -> (str"simple apply " ++ pr_hint_elt env sigma c)
@@ -1663,7 +1635,7 @@ let pr_hints_db env sigma (name,db,hintlist) =
 let pr_hint_list_for_head env sigma c =
   let dbs = current_db () in
   let validate (name, db) =
-    let hints = List.map (fun v -> 0, v) (Hint_db.map_all ~secvars:Id.Pred.full c db) in
+    let hints = List.map (fun v -> 0, v) (Hint_db.map_all env ~secvars:Id.Pred.full c db) in
     (name, db, hints)
   in
   let valid_dbs = List.map validate dbs in
@@ -1714,6 +1686,7 @@ let pr_applicable_hint pf =
 let parse_mode s =
   match s with
   | "+" -> ModeInput
+  | "=" -> ModeFrozen
   | "-" -> ModeOutput
   | "!" -> ModeNoHeadEvar
   | _ -> CErrors.user_err Pp.(str"Unrecognized hint mode " ++ str s)
@@ -1724,6 +1697,7 @@ let parse_modes s =
 
 let string_of_mode = function
   | ModeInput -> "+"
+  | ModeFrozen -> "="
   | ModeOutput -> "-"
   | ModeNoHeadEvar -> "!"
 
@@ -1789,6 +1763,22 @@ let pr_searchtable env sigma =
   in
   Hintdbmap.fold fold !searchtable (mt ())
 
+type hint_ast =
+  | Res_pf     of hint (* Hint Apply *)
+  | ERes_pf    of hint (* Hint EApply *)
+  | Give_exact of hint
+  | Res_pf_THEN_trivial_fail of hint (* Hint Immediate *)
+  | Unfold_nth of Evaluable.t (* Hint Unfold *)
+  | Extern of Pattern.constr_pattern option * Gentactic.glob_generic_tactic (* Hint Extern *)
+
+let to_user_ast = function
+| Internal.Res_pf h -> Res_pf h
+| Internal.ERes_pf h -> ERes_pf h
+| Internal.Give_exact h -> Give_exact h
+| Internal.Res_pf_THEN_trivial_fail h -> Res_pf_THEN_trivial_fail h
+| Internal.Unfold_nth h -> Unfold_nth h
+| Internal.Extern (pat, tac) -> Extern (pat, tac)
+
 module FullHint =
 struct
   type t = full_hint
@@ -1798,7 +1788,7 @@ struct
   | None -> None
   | Some (ConstrPattern p | SyntacticPattern p) -> Some p
   | Some DefaultPattern -> None
-  let run (h : t) k = k h.code.obj
+  let run (h : t) k = k (to_user_ast h.code.obj)
   let print env sigma (h : t) = pr_hint env sigma h.code
   let name (h : t) = h.name
 
@@ -1807,7 +1797,7 @@ struct
   | Unfold_nth _ -> Some 1
   | Extern _ -> None
 
-  let repr (h : t) = h.code.obj
+  let repr (h : t) = to_user_ast h.code.obj
 end
 
 let connect_hint_clenv h gl =
@@ -1822,11 +1812,11 @@ let connect_hint_clenv h gl =
 let fresh_hint env sigma h =
   let { hint_term = c; hint_uctx = ctx } = h in
   match h.hint_uctx with
-  | None -> sigma, c
+  | None -> sigma, mkRef c
   | Some ctx ->
     (* Refresh the instance of the hint *)
     let (subst, ctx) = UnivGen.fresh_sort_context_instance ctx in
-    let c = Vars.subst_univs_level_constr subst c in
+    let c = Vars.subst_univs_level_constr subst (mkRef c) in
     let sigma = Evd.merge_sort_context_set Evd.univ_flexible ~src:UState.Internal sigma ctx in
     sigma, c
 
diff --git a/tactics/hints.mli b/tactics/hints.mli
index 19dc0bae1f3e..da7bdae78c6b 100644
--- a/tactics/hints.mli
+++ b/tactics/hints.mli
@@ -13,7 +13,6 @@ open Names
 open EConstr
 open Environ
 open Evd
-open Tactypes
 open Typeclasses
 
 (** {6 General functions. } *)
@@ -24,7 +23,7 @@ val decompose_app_bound : evar_map -> constr -> GlobRef.t * constr array
 
 type debug = Debug | Info | Off
 
-val secvars_of_hyps : ('c, 't,'r) Context.Named.pt -> Id.Pred.t
+val secvars_of_hyps : Environ.named_context_val -> Id.Pred.t
 
 val empty_hint_info : 'a Typeclasses.hint_info_gen
 
@@ -32,16 +31,16 @@ val hint_cat : Libobject.category
 
 (** Pre-created hint databases *)
 
-type 'a hint_ast =
-  | Res_pf     of 'a (* Hint Apply *)
-  | ERes_pf    of 'a (* Hint EApply *)
-  | Give_exact of 'a
-  | Res_pf_THEN_trivial_fail of 'a (* Hint Immediate *)
+type hint
+
+type hint_ast =
+  | Res_pf     of hint (* Hint Apply *)
+  | ERes_pf    of hint (* Hint EApply *)
+  | Give_exact of hint
+  | Res_pf_THEN_trivial_fail of hint (* Hint Immediate *)
   | Unfold_nth of Evaluable.t (* Hint Unfold *)
   | Extern of Pattern.constr_pattern option * Gentactic.glob_generic_tactic (* Hint Extern *)
 
-type hint
-
 val hint_as_term : hint -> UnivGen.sort_context_set option * constr
 
 type 'a hints_path_atom_gen =
@@ -58,20 +57,21 @@ sig
   val priority : t -> int
   val pattern : t -> Pattern.constr_pattern option
   val database : t -> string option
-  val run : t -> (hint hint_ast -> 'r Proofview.tactic) -> 'r Proofview.tactic
+  val run : t -> (hint_ast -> 'r Proofview.tactic) -> 'r Proofview.tactic
   val name : t -> GlobRef.t option
   val print : env -> evar_map -> t -> Pp.t
   val subgoals : t -> int option
 
   (** This function is for backward compatibility only, not to use in newly
     written code. *)
-  val repr : t -> hint hint_ast
+  val repr : t -> hint_ast
 end
 
 (** The head may not be bound. *)
 
 type hint_mode =
   | ModeInput (* No evars *)
+  | ModeFrozen (* evars are allowed but will never be instantiated by hints *)
   | ModeNoHeadEvar (* No evar at the head *)
   | ModeOutput (* Anything *)
 
@@ -104,7 +104,7 @@ val glob_hints_path : pre_hints_path -> hints_path
 
 type mode_match =
   | NoMode
-  | WithMode of hint_mode array
+  | WithMode of Evarsolve.AllowedEvars.t
 
 type 'a with_mode =
   | ModeMatch of mode_match * 'a
@@ -128,7 +128,7 @@ module Hint_db :
     val map_none : secvars:Id.Pred.t -> t -> FullHint.t list
 
     (** All hints associated to the reference *)
-    val map_all : secvars:Id.Pred.t -> GlobRef.t -> t -> FullHint.t list
+    val map_all : env -> secvars:Id.Pred.t -> GlobRef.t -> t -> FullHint.t list
 
     (** All hints associated to the reference, respecting modes if evars appear in the
         arguments and using the discrimination net.
@@ -155,7 +155,7 @@ module Hint_db :
     val add_cut : env -> hints_path -> t -> t
     val cut : t -> hints_path
 
-    val unfolds : t -> Id.Set.t * Cset.t * PRset.t
+    val unfolds : t -> Id.Set.t * Cset_env.t * PRset_env.t
 
     val add_modes : Modes.t -> t -> t
     val modes : t -> Modes.t
@@ -218,7 +218,7 @@ val push_resolve_hyp :
    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:TransparentState.t -> bool -> delayed_open_constr list -> hint_db
+val make_local_hint_db : env -> evar_map -> ?ts:TransparentState.t -> bool -> GlobRef.t list -> hint_db
 
 val make_db_list : hint_db_name list -> hint_db list
 
diff --git a/tactics/hipattern.ml b/tactics/hipattern.ml
index 049bb3eb2b4f..20c8ae2cebd7 100644
--- a/tactics/hipattern.ml
+++ b/tactics/hipattern.ml
@@ -530,11 +530,11 @@ let match_eqdec env sigma t =
   | _ -> anomaly (Pp.str "Unexpected pattern.")
 
 (* Patterns "~ ?" and "? -> False" *)
-let rocq_not_pattern = lazy (mkPAppRef "core.not.type" [mkPHole])
-let rocq_imp_False_pattern = lazy (mkPArrow mkPHole (mkPRef "core.False.type"))
+let rocq_not_pattern () = mkPAppRef "core.not.type" [mkPHole]
+let rocq_imp_False_pattern () = mkPArrow mkPHole (mkPRef "core.False.type")
 
-let is_matching_not env sigma t = is_matching env sigma (Lazy.force rocq_not_pattern) t
-let is_matching_imp_False env sigma t = is_matching env sigma (Lazy.force rocq_imp_False_pattern) t
+let is_matching_not env sigma t = is_matching env sigma (rocq_not_pattern()) t
+let is_matching_imp_False env sigma t = is_matching env sigma (rocq_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/ind_tables.ml b/tactics/ind_tables.ml
index 4a9120f745c3..eed2ef3b0ed6 100644
--- a/tactics/ind_tables.ml
+++ b/tactics/ind_tables.ml
@@ -104,7 +104,7 @@ let register_definition_scheme = ref (fun ~internal ~name ~const ~univs ?loc ()
   CErrors.anomaly (Pp.str "scheme registering not registered"))
 
 let lookup_scheme kind ind =
-  try Some (DeclareScheme.lookup_scheme kind ind) with Not_found -> None
+  try Some (DeclareScheme.lookup_scheme kind (GlobRef.IndRef ind)) with Not_found -> None
 
 type schemes = {
   sch_eff : Evd.side_effects;
@@ -120,11 +120,11 @@ let redeclare_schemes { sch_eff = eff } =
   let fold c role accu = match role with
   | Evd.Schema (ind, kind) ->
     try
-      let _ = DeclareScheme.lookup_scheme kind ind in
+      let _ = DeclareScheme.lookup_scheme kind (GlobRef.IndRef ind) in
       accu
     with Not_found ->
       let old = try String.Map.find kind accu with Not_found -> [] in
-      String.Map.add kind ((ind, GlobRef.ConstRef c) :: old) accu
+      String.Map.add kind ((GlobRef.IndRef ind, GlobRef.ConstRef c) :: old) accu
   in
   let schemes = Cmap_env.fold fold (Evd.seff_roles eff) String.Map.empty in
   let iter kind defs = List.iter (DeclareScheme.declare_scheme SuperGlobal kind) defs in
diff --git a/tactics/indrec.ml b/tactics/indrec.ml
index c12096eeeaf1..69666db34651 100644
--- a/tactics/indrec.ml
+++ b/tactics/indrec.ml
@@ -173,24 +173,22 @@ let rec make_rec_call_hyp kn pos_ind mib ind_bodies key_preds key_arg arg_type =
           let* rec_hyp = make_pred true key_preds pred_pos pred_dep inst_nuparams inst_indices inst_arg in
           return (Some (rec_hyp))
     end
-  | ArgIsNested (kn_nested, pos_nested, mib_nested, mib_nested_strpos, ind_nested,
-                  inst_uparams, inst_nuparams_indices) ->
+  | ArgIsNested (nested_container, nested_strpos,
+                  uparams_nested, inst_uparams, inst_nuparams_indices) ->
       (* eta expand arguments *)
-      let uparams_nested = of_rel_context @@ fst @@
-                split_uparans_nuparams mib_nested mib_nested.mind_params_ctxt in
       let* inst_uparams = eta_expand_instantiation inst_uparams uparams_nested in
       (* Compute the recursive predicates *)
       let compute_pred i x b = compute_pred_eta b (make_rec_call_hyp kn pos_ind mib ind_bodies key_preds) i x in
-      let* rec_preds = array_map2i compute_pred inst_uparams (Array.of_list mib_nested_strpos) in
+      let* rec_preds = array_map2i compute_pred inst_uparams (Array.of_list nested_strpos) in
       (* If at least one argument is nested, lookup the sparse parametricity *)
       let args_are_nested = Array.map Option.has_some rec_preds in
       if Array.for_all not args_are_nested then
         return None
       else begin
-        match lookup_all_theorem (kn, pos_ind) (kn_nested, pos_nested) (Array.to_list args_are_nested) with
+        match lookup_all_theorem (kn, pos_ind) nested_container (Array.to_list args_are_nested) with
         | None -> return None
         | Some (partial_nesting, ref_pred, _) ->
-          let* rec_hyp = make_all_predicate ~partial_nesting ref_pred mib_nested_strpos
+          let* rec_hyp = make_all_predicate ~partial_nesting ref_pred nested_strpos
                           inst_uparams rec_preds inst_nuparams_indices inst_arg in
           (* return *)
           return (Some (rec_hyp))
@@ -327,26 +325,24 @@ let rec make_rec_call_proof kn pos_ind mib ind_bodies key_preds key_fixs key_arg
         let* fix = geti_term key_fixs pred_pos in
         return @@ Some (mkApp (fix, Array.concat [inst_nuparams; inst_indices; [|inst_arg|]]))
     end
-  | ArgIsNested (kn_nested, pos_nested, mib_nested, mib_nested_strpos, ind_nested,
-                  inst_uparams, inst_nuparams_indices) ->
+  | ArgIsNested (nested_container, nested_strpos,
+                  uparams_nested, inst_uparams, inst_nuparams_indices) ->
       (* eta expand arguments *)
-      let uparams_nested = of_rel_context @@ fst @@
-              split_uparans_nuparams mib_nested mib_nested.mind_params_ctxt in
       let* inst_uparams = eta_expand_instantiation inst_uparams uparams_nested in
       (* Compute the recursive predicates, and their proofs *)
       let compute_pred_preds i x b = compute_pred_eta b (make_rec_call_hyp kn pos_ind mib ind_bodies key_preds) i x in
-      let* rec_preds = array_map2i compute_pred_preds inst_uparams (Array.of_list mib_nested_strpos) in
+      let* rec_preds = array_map2i compute_pred_preds inst_uparams (Array.of_list nested_strpos) in
       let compute_pred_holds i x b = compute_pred_eta b (make_rec_call_proof kn pos_ind mib ind_bodies key_preds key_fixs) i x in
-      let* rec_preds_hold = array_map2i compute_pred_holds inst_uparams (Array.of_list mib_nested_strpos) in
+      let* rec_preds_hold = array_map2i compute_pred_holds inst_uparams (Array.of_list nested_strpos) in
       (* If at least one argument is nested, lookup the local fundamental theorem *)
       let args_are_nested = Array.map Option.has_some rec_preds_hold in
       if Array.for_all not args_are_nested then
         return None
       else begin
-        match lookup_all_theorem (kn, pos_ind) (kn_nested, pos_nested) (Array.to_list args_are_nested) with
+        match lookup_all_theorem (kn, pos_ind) nested_container (Array.to_list args_are_nested) with
         | None -> return None
         | Some (partial_nesting, _, ref_thm) ->
-          let* rec_hyp = make_all_theorem ~partial_nesting ref_thm mib_nested_strpos inst_uparams
+          let* rec_hyp = make_all_theorem ~partial_nesting ref_thm nested_strpos inst_uparams
                           rec_preds rec_preds_hold inst_nuparams_indices inst_arg in
           return @@ Some rec_hyp
       end
@@ -383,6 +379,7 @@ let gen_elim_term print_constr rec_hyp kn u mib uparams nuparams ind_bodies focu
   let is_rec =
     let (_, ind, _, _) = List.hd ind_bodies in
     List.length ind_bodies > 1 || (rec_hyp && Inductiveops.mis_is_recursive ind) in
+  (* dbg Pp.(fun () -> str "isrec:=" ++ bool is_rec); *)
   let@ (key_fixs, pos_list, (pos_ind, ind, dep, sort)) =
     (* Doe not create a fix if it is not-recursive and only has one inductive body *)
     if is_rec
@@ -455,7 +452,7 @@ let check_valid_elimination env sigma (kn, n) mib u lrecspec rec_hyp =
     let () = if not @@ Inductiveops.is_allowed_elimination sigma ((mib,mib.mind_packets.(ni)),u) s then
         raise (Pretype_errors.error_not_allowed_elimination env sigma rec_hyp s ((kn, ni), u)) in
     (* Check if dep elim is allowed: rec (co)ind records with prim proj can not be eliminated dependently *)
-    if dep && not (Inductiveops.has_dependent_elim (mib, mib.mind_packets.(ni))) then
+    if dep && not (Inductiveops.has_dependent_elim sigma (mib, mib.mind_packets.(ni)) u) then
       raise (Pretype_errors.error_not_allowed_dependent_elimination env sigma rec_hyp (kni, ni))
   ) lrecspec
 
diff --git a/tactics/induction.ml b/tactics/induction.ml
index 1fd67fc6ab18..191708085726 100644
--- a/tactics/induction.ml
+++ b/tactics/induction.ml
@@ -107,7 +107,7 @@ let tactic_interp_error_handler = function
       str "Don't know where to find some argument."
   | MultipleAsAndUsingClauseOnlyList ->
       str "'as' clause with multiple arguments and 'using' clause can only occur last."
-  | _ -> raise Unhandled
+  | _ -> raise_notrace Unhandled
 
 let _ = CErrors.register_handler (wrap_unhandled tactic_interp_error_handler)
 
@@ -216,10 +216,10 @@ let insert_before decls lasthyp env =
   | None -> push_named_context decls env
   | Some id ->
   Environ.fold_named_context
-    (fun _ d env ->
+    (fun _ status d env ->
       let d = EConstr.of_named_decl 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)
+      push_named status d env)
     ~init:(reset_context env) env
 
 let mk_eq_name env id {CAst.loc;v=ido} =
@@ -237,8 +237,8 @@ let mkletin_goal env sigma with_eq dep (id,lastlhyp,ccl,c) ty =
   let open Context.Named.Declaration in
   let t = match ty with Some t -> t | _ -> typ_of env sigma c in
   let r = Retyping.relevance_of_type env sigma t in
-  let decl = if dep then LocalDef (make_annot id r,c,t)
-             else LocalAssum (make_annot id r,t)
+  let decl = if dep then LocalDef (make_annot id r, c, t)
+    else LocalAssum (make_annot id r, t)
   in
   match with_eq with
   | Some (lr,heq) ->
@@ -251,13 +251,13 @@ let mkletin_goal env sigma with_eq dep (id,lastlhyp,ccl,c) ty =
       let sigma, eq = Typing.checked_applist env sigma eq [t] in
       let eq = applist (eq,args) in
       let refl = applist (refl, [t;mkVar id]) in
-      let newenv = insert_before [LocalAssum (make_annot heq ERelevance.relevant,eq); decl] lastlhyp env in
+      let newenv = insert_before [ProofVar, LocalAssum (make_annot heq ERelevance.relevant,eq); ProofVar, decl] lastlhyp env in
       let (sigma, x) = new_evar newenv sigma ccl in
       (sigma, mkNamedLetIn sigma (make_annot id r) c t
          (mkNamedLetIn sigma (make_annot heq ERelevance.relevant) refl eq x),
       Some (fst @@ destEvar sigma x))
   | None ->
-      let newenv = insert_before [decl] lastlhyp env in
+      let newenv = insert_before [ProofVar, decl] lastlhyp env in
       let (sigma, x) = new_evar newenv sigma ccl in
       (sigma, mkNamedLetIn sigma (make_annot id r) c t x, Some (fst @@ destEvar sigma x))
 
@@ -589,8 +589,7 @@ let cook_sign hyp0_opt inhyps indvars env sigma =
   let lstatus = ref [] in
   let before = ref true in
   let maindep = ref false in
-  let seek_deps env decl rhyp =
-    let decl = EConstr.of_named_decl decl in
+  let seek_deps env _ decl rhyp =
     let hyp = NamedDecl.get_id decl in
     if (match hyp0_opt with Some hyp0 -> Id.equal hyp hyp0 | _ -> false)
     then begin
@@ -1095,7 +1094,7 @@ let apply_induction_in_context with_evars inhyps elim indvars names =
     in
     let statuslists,lhyp0,toclear,deps,avoid,dep_in_hyps = cook_sign hyp0 inhyps indvars env sigma in
     let tmpcl = it_mkNamedProd_or_LetIn sigma concl deps in
-    let s = Retyping.get_sort_quality_of env sigma tmpcl in
+    let s = Retyping.get_sort_quality_or_set_of env sigma tmpcl in
     let deps_cstr =
       List.fold_left
         (fun a decl -> if NamedDecl.is_local_assum decl then (mkVar (NamedDecl.get_id decl))::a else a) [] deps in
@@ -1398,7 +1397,7 @@ let induction_gen ~clear_flag ~isrec ~with_evars elim
   let cls = Option.default allHypsAndConcl cls in
   let t = typ_of env evd c in
   let is_arg_pure_hyp =
-    isVar evd c && not (mem_named_context_val (destVar evd c) (Global.named_context_val ()))
+    isVar evd c && not (is_section_variable_env env (destVar evd c))
     && lbind == NoBindings && not with_evars && Option.is_empty eqname
     && clear_flag == None
     && has_generic_occurrences_but_goal cls (destVar evd c) env evd ccl in
@@ -1446,28 +1445,27 @@ let induction_gen_l isrec with_evars elim names lc =
     match l with
       | [] -> Proofview.tclUNIT ()
       | c::l' ->
-          Proofview.tclEVARMAP >>= fun sigma ->
+        Proofview.Goal.enter begin fun gl ->
+          let env = Proofview.Goal.env gl in
+          let sigma = Proofview.Goal.sigma gl in
           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 begin fun gl ->
-                let env = Proofview.Goal.env gl in
-                let sigma = Proofview.Goal.sigma gl in
-                let sigma, t = Typing.type_of env sigma c in
-                let x = id_of_name_using_hdchar env sigma t Anonymous 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.tclTHENLIST [
-                  tclEVARS sigma;
-                  Tactics.letin_tac None (Name id) c None allHypsAndConcl;
-                  atomize_list newl';
-                ]
-                end in
+          | Var id when not (is_section_variable_env env id)
+                     && not with_evars ->
+            let () = newlc:= id::!newlc in
+            atomize_list l'
+
+          | _ ->
+            let sigma, t = Typing.type_of env sigma c in
+            let x = id_of_name_using_hdchar env sigma t Anonymous 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.tclTHENLIST [
+              tclEVARS sigma;
+              Tactics.letin_tac None (Name id) c None allHypsAndConcl;
+              atomize_list newl';
+            ]
+        end in
   Tacticals.tclTHENLIST
     [
       (atomize_list lc);
diff --git a/tactics/inv.ml b/tactics/inv.ml
index b35550f68130..88f8cc9411c7 100644
--- a/tactics/inv.ml
+++ b/tactics/inv.ml
@@ -96,7 +96,7 @@ let make_inv_predicate env evd indf realargs id status concl =
             match dflt_concl with
               | Some concl -> concl (*assumed it's some [x1..xn,H:I(x1..xn)]C*)
               | None ->
-                let sort = get_sort_quality_of env !evd concl in
+                let sort = get_sort_quality_or_set_of env !evd concl in
                 let sort = evd_comb1 Evd.fresh_sort_in_quality evd sort in
                 let p = make_arity env !evd true indf sort in
                 let evd',(p,ptyp) = Unification.abstract_list_all env
diff --git a/tactics/inv.mli b/tactics/inv.mli
index d3db23bd5b5d..6b072e27efef 100644
--- a/tactics/inv.mli
+++ b/tactics/inv.mli
@@ -23,9 +23,6 @@ val inv_clause :
   inversion_kind -> or_and_intro_pattern option -> Id.t list ->
     quantified_hypothesis -> unit Proofview.tactic
 
-val inv : inversion_kind -> or_and_intro_pattern option ->
-  quantified_hypothesis -> unit Proofview.tactic
-
 val dinv : inversion_kind -> constr option ->
   or_and_intro_pattern option -> quantified_hypothesis -> unit Proofview.tactic
 
diff --git a/tactics/redexpr.ml b/tactics/redexpr.ml
index 67a7b8ebe07e..a6a5c184f65d 100644
--- a/tactics/redexpr.ml
+++ b/tactics/redexpr.ml
@@ -478,7 +478,7 @@ module Intern = struct
       in
       if not is_proof_variable then Dumpglob.add_glob ?loc r
     in
-    Tacred.soft_evaluable_of_global_reference ?loc r
+    Tacred.evaluable_of_global_reference ?loc r
 
   type ('constr,'ref,'pat) intern_env = {
     strict_check : bool;
@@ -645,7 +645,7 @@ module Interp = struct
     | Lazy f -> sigma , Lazy (interp_flag ist env sigma f)
     | Pattern l ->
       let (sigma,l_interp) =
-        Evd.MonadR.List.map_right
+        Evd.Monad.List.map_right
           (fun c sigma -> interp_constr_with_occurrences ist env sigma c) l sigma
       in
       sigma , Pattern l_interp
diff --git a/tactics/rewrite.ml b/tactics/rewrite.ml
index 627601d6917c..972b6777e177 100644
--- a/tactics/rewrite.ml
+++ b/tactics/rewrite.ml
@@ -39,17 +39,14 @@ let { Goptions.get = do_rewrite_output_constraints } =
 
 (** Constants used by the tactic. *)
 
-let bind_global_ref lib s =
-  let gr = lazy (Rocqlib.lib_ref (lib ^ "." ^ s)) in
-  fun () -> Lazy.force gr
+let bind_global_ref lib s =  fun () -> Rocqlib.lib_ref (lib ^ "." ^ s)
 
 type evars = evar_map * Evar.Set.t (* goal evars, constraint evars *)
 
-let bind_global lib s =
-  let gr = lazy (Rocqlib.lib_ref (lib ^ "." ^ s)) in
-    fun env (evd,cstrs) ->
-      let (evd, c) = Evd.fresh_global env evd (Lazy.force gr) in
-        (evd, cstrs), c
+let bind_global lib s env (evd,cstrs) =
+  let gr = Rocqlib.lib_ref (lib ^ "." ^ s) in
+  let (evd, c) = Evd.fresh_global env evd gr in
+  (evd, cstrs), c
 
 (** Utility for dealing with polymorphic applications *)
 
@@ -242,13 +239,13 @@ end) = struct
 
   let rewrite_relation_class = bind_rewrite "RewriteRelation"
 
-  let proper_class =
-    let r = lazy (bind_rewrite_ref "Proper" ()) in
-    fun () -> Option.get (TC.class_info (Global.env ()) (Lazy.force r))
+  let proper_class () =
+    let r = bind_rewrite_ref "Proper" () in
+    Option.get (TC.class_info (Global.env ()) r)
 
-  let proper_proxy_class =
-    let r = lazy (bind_rewrite_ref "ProperProxy" ()) in
-    fun () -> Option.get (TC.class_info (Global.env ()) (Lazy.force r))
+  let proper_proxy_class () =
+    let r = bind_rewrite_ref "ProperProxy" () in
+    Option.get (TC.class_info (Global.env ()) r)
 
   let proper_proj () = bind_rewrite_ref "proper_prf" ()
 
@@ -653,7 +650,7 @@ type rewrite_proof =
   | RewCast of cast_kind
   (** A proof of convertibility (with casts) *)
 
-type rewrite_result_info = {
+type internal_rewrite_result_info = {
   rew_car : constr ;
   (** A type *)
   rew_from : constr ;
@@ -665,11 +662,39 @@ type rewrite_result_info = {
   rew_evars : evars;
 }
 
+type rewrite_result_info =
+  { rew_rel: constr; rew_to : constr; rew_prf : constr }
+
 type rewrite_result =
 | Fail
 | Identity
 | Success of rewrite_result_info
 
+type internal_rewrite_result =
+| Fail
+| Identity
+| Success of internal_rewrite_result_info
+
+let apply_subst sigma vars x =
+  let rec substrec n c = match kind sigma c with
+    | Var x ->
+       begin match vars x with
+       | var -> EConstr.Vars.lift n var
+       | exception Not_found -> c
+       end
+    | _ -> EConstr.map_with_binders sigma succ substrec n c
+  in
+  substrec 0 x
+
+let subst_rewrite_result sigma subst (r : rewrite_result) =
+  match r with
+  | Fail | Identity -> r
+  | Success {rew_rel; rew_to; rew_prf} ->
+     let rew_rel = apply_subst sigma subst rew_rel in
+     let rew_to = apply_subst sigma subst rew_to in
+     let rew_prf = apply_subst sigma subst rew_prf in
+     Success {rew_rel; rew_to; rew_prf}
+
 type 'a strategy_input = { state : 'a ; (* a parameter: for instance, a state *)
                            env : Environ.env ;
                            unfresh : Id.Set.t; (* Unfresh names *)
@@ -680,7 +705,7 @@ type 'a strategy_input = { state : 'a ; (* a parameter: for instance, a state *)
 
 type 'a pure_strategy = { strategy :
   'a strategy_input ->
-  'a * rewrite_result (* the updated state and the "result" *) }
+  'a * internal_rewrite_result (* the updated state and the "result" *) }
 
 type strategy = unit pure_strategy
 
@@ -725,7 +750,7 @@ let unify_eqn { car; rel; prf; c1; c2; holes; sort } l2r flags env (sigma, cstrs
   with
   | e when noncritical e -> None
 
-let unify_abs (car, rel, prf, c1, c2) l2r sort env (sigma, cstrs) t =
+let unify_abs (car, rel, c1, c2) l2r sort env (sigma, cstrs) t =
   try
     let left = if l2r then c1 else c2 in
     (* The pattern is already instantiated, so the next w_unify is
@@ -734,7 +759,7 @@ let unify_abs (car, rel, prf, c1, c2) l2r sort env (sigma, cstrs) t =
        solved this evars *)
     let _, sigma = Unification.w_unify ~flags:rewrite_unif_flags env sigma CONV left t in
     let rew_evars = sigma, cstrs in
-    let rew_prf = RewPrf (rel, prf) in
+    let rew_prf = RewPrf (rel, mkRel 1) in
     let rew = { rew_car = car; rew_from = c1; rew_to = c2; rew_prf; rew_evars; } in
     let rew = if l2r then rew else symmetry env sort rew in
     Some rew
@@ -756,7 +781,7 @@ let make_eq env sigma =
 let make_eq_refl env sigma =
   new_global env sigma Rocqlib.(lib_ref "core.eq.refl")
 
-let get_rew_prf env evars r = match r.rew_prf with
+let get_rew_prf env evars (r : internal_rewrite_result_info) = match r.rew_prf with
   | RewPrf (rel, prf) -> evars, (rel, prf)
   | RewCast c ->
     let evars, eq = make_eq env evars in
@@ -810,7 +835,7 @@ let resolve_morphism env m args args' (b,cstr) evars =
     let _, dosub = app_poly_sort b env evars dosub [||] in
     let _, appsub = app_poly_nocheck env evars appsub [||] in
     let dosub_id = Id.of_string "do_subrelation" in
-    let env' = EConstr.push_named (LocalDef (make_annot dosub_id ERelevance.relevant, dosub, appsub)) env in
+    let env' = EConstr.push_named ProofVar (LocalDef (make_annot dosub_id ERelevance.relevant, dosub, appsub)) env in
     let evars, morph = new_cstr_evar evars env' app in
     (* Replace the free [dosub_id] in the evar by the global reference *)
     let morph = Vars.replace_vars (fst evars) [dosub_id , dosub] morph in
@@ -940,8 +965,8 @@ let fold_match ?(force=false) env sigma c =
     in
     let sk =
       (* not sure how correct this is *)
-      if UnivGen.QualityOrSet.is_prop sortp then
-        if UnivGen.QualityOrSet.is_prop sortc then
+      if Sorts.Quality.is_qprop sortp then
+        if Sorts.Quality.is_qprop sortc then
           if dep then case_dep
           else case_nodep
         else (
@@ -1018,7 +1043,7 @@ let subterm all flags (s : 'a pure_strategy) : 'a pure_strategy =
                   if Array.exists
                     (function
                       | None -> false
-                      | Some r -> not (is_rew_cast r.rew_prf)) args'
+                      | Some (r : internal_rewrite_result_info) -> not (is_rew_cast r.rew_prf)) args'
                   then
                     let evars', prf, car, rel, c2 =
                       resolve_morphism env m args args' (prop, cstr') evars'
@@ -1031,7 +1056,7 @@ let subterm all flags (s : 'a pure_strategy) : 'a pure_strategy =
                     let args' = Array.map2
                       (fun aorig anew ->
                         match anew with None -> aorig
-                        | Some r -> r.rew_to) args args'
+                        | Some (r : internal_rewrite_result_info) -> r.rew_to) args args'
                     in
                     let res = { rew_car = ty; rew_from = t;
                                 rew_to = mkApp (m, args'); rew_prf = RewCast DEFAULTcast;
@@ -1258,8 +1283,8 @@ let subterm all flags (s : 'a pure_strategy) : 'a pure_strategy =
 (** Requires transitivity of the rewrite step, if not a reduction.
     Not tail-recursive. *)
 
-let transitivity state env unfresh cstr (res : rewrite_result_info) (next : 'a pure_strategy) :
-    'a * rewrite_result =
+let transitivity state env unfresh cstr (res : internal_rewrite_result_info) (next : 'a pure_strategy) :
+    'a * internal_rewrite_result =
   let cstr = match cstr with
     | _, Some _ -> cstr
     | prop, None -> prop, get_opt_rew_rel res.rew_prf
@@ -1417,6 +1442,77 @@ module Strategies =
           choice tac (apply_lemma l2r rewrite_unif_flags c by AllOccurrences)
         ) fail cs
 
+    let matches p : unit pure_strategy =
+      let strategy ({ env = env ; term1 = t ; ty1 = ty ; cstr = cstr ; evars = evars } as state) =
+        if Constr_matching.is_matching env (goalevars evars) p t then
+          state.state, Identity
+        else state.state, Fail
+      in
+      { strategy }
+
+    (* Produces the type [existsT (R : relation carrier), R lhs ?rhs] *)
+    let make_tactic_goal env evars prop cstr carrier lhs =
+      let open EConstr in
+      let evars, rhs = new_cstr_evar evars env carrier in
+      let evars, rev =
+        match cstr with
+        | Some rel -> evars, rel
+        | None ->
+           let mkr = if prop then PropGlobal.mk_relation else TypeGlobal.mk_relation in
+           let evars, rty = mkr env evars carrier in
+           new_cstr_evar evars env rty
+      in
+      evars, rev, rhs, applistc rev [lhs; rhs]
+
+    let extract_proof env sigma rel prf =
+      let open EConstr in
+      let hd, args = decompose_app sigma prf in
+      if is_lib_ref env sigma "core.eq.refl" hd then RewCast DEFAULTcast
+      else RewPrf (rel, prf)
+
+    let ltac1_tactic_call (tac : unit Proofview.tactic) : 'a pure_strategy =
+      let strategy ({ env = env ; term1 = t ; ty1 = ty ; cstr = (prop, cstr) ; evars = evars } as state) =
+        let evars, rev, rhsev, goalty = make_tactic_goal env evars prop cstr ty t in
+        let entry, pv = Proofview.init (goalevars evars) [env, goalty] in
+        let res =
+          try Some (Proofview.apply ~name:(Id.of_string "rewrite")
+                      ~poly:PolyFlags.default env tac pv)
+          with Logic_monad.TacticFailure _ -> None in
+        match res with
+        | None -> state.state, Fail
+        | Some (res, pv, _, _, _) ->
+           let sigma = Proofview.return pv in
+           let prf =
+             match Proofview.partial_proof entry pv with
+             | [c] -> extract_proof env sigma rev c
+             | _ -> assert false
+           in
+           let rinfo = { rew_car = ty; rew_from = t; rew_to = rhsev;
+                         rew_prf = prf; rew_evars = (sigma, cstrevars evars) } in
+           state.state, Success rinfo
+      in
+      { strategy }
+
+    let tactic_call (tac : env:Environ.env -> carrier:constr -> lhs:constr -> rel:constr option -> rewrite_result Proofview.tactic) : 'a pure_strategy =
+      let strategy ({ env = env ; term1 = t ; ty1 = ty ; cstr = (prop, cstr) ; evars = evars } as state) =
+        let sigma = goalevars evars in
+        let entry, pv = Proofview.init sigma [] in
+        let secenv = reset_with_named_context (Global.named_context_val ()) env in
+        let (res, pv, _, _, _) =
+          Proofview.apply ~name:(Id.of_string "rewrite")
+                ~poly:PolyFlags.default secenv (tac ~env:env ~carrier:ty ~lhs:t ~rel:cstr) pv in
+        match res with
+        | Identity -> state.state, Identity
+        | Fail -> state.state, Fail
+        | Success { rew_to; rew_prf; rew_rel } ->
+           let sigma = Proofview.return pv in
+           let rew_prf = extract_proof env sigma rew_rel rew_prf in
+           let rinfo = { rew_car = ty; rew_from = t; rew_to; rew_prf;
+                         rew_evars = (sigma, cstrevars evars) } in
+           state.state, Success rinfo
+      in
+      { strategy }
+
     let inj_open hint = (); fun _env sigma ->
       let (ctx, lemma) = Autorewrite.RewRule.rew_lemma hint in
       let subst, ctx = UnivGen.fresh_sort_context_instance ctx in
@@ -1458,7 +1554,7 @@ module Strategies =
                                rew_evars = sigma, cstrevars evars }
                                                            }
 
-    let run_fold_in env evars c term typ : rewrite_result =
+    let run_fold_in env evars c term typ : internal_rewrite_result =
       let unfolded = match Tacred.red_product env (goalevars evars) c with
         | None -> user_err Pp.(str "fold: the term is not unfoldable!")
         | Some c -> c
@@ -1480,6 +1576,11 @@ module Strategies =
             let sigma, c = Pretyping.understand_tcc env (goalevars evars) c in
             state, run_fold_in env (sigma, cstrevars evars) c t ty
       }
+
+    let with_env f =
+      { strategy = fun ({ state = (); env; evars } as input) ->
+            let sigma, s = f env (goalevars evars) in
+            s.strategy { input with evars = (sigma, cstrevars evars) } }
 end
 
 (** The strategy for a single rewrite, dealing with occurrences. *)
@@ -1519,9 +1620,6 @@ let solve_constraints env (evars,cstrs) =
   let evars' = TC.resolve_typeclasses env ~filter:TC.all_evars ~fail:true evars' in
   Evd.set_typeclass_evars evars' oldtcs
 
-let nf_zeta =
-  Reductionops.clos_norm_flags (RedFlags.mkflags [RedFlags.fZETA])
-
 exception RewriteFailure of Environ.env * Evd.evar_map * pretype_error
 
 type result = (evar_map * constr option * types) option option
@@ -1535,7 +1633,7 @@ let () = CErrors.register_handler begin function
 | _ -> None
 end
 
-let cl_rewrite_clause_aux ?(abs=None) strat env avoid sigma concl is_hyp : result =
+let cl_rewrite_clause_aux abs strat env sigma concl is_hyp : result =
   let sigma, sort = Typing.sort_of env sigma concl in
   let evdref = ref sigma in
   let evars = (!evdref, Evar.Set.empty) in
@@ -1550,7 +1648,7 @@ let cl_rewrite_clause_aux ?(abs=None) strat env avoid sigma concl is_hyp : resul
       evars, (prop, t)
     | Some _ -> evars, (prop, arrow)
   in
-  let eq = apply_strategy strat env avoid concl cstr evars in
+  let eq = apply_strategy strat env Id.Set.empty concl cstr evars in
   match eq with
   | Fail -> None
   | Identity -> Some None
@@ -1563,7 +1661,7 @@ let cl_rewrite_clause_aux ?(abs=None) strat env avoid sigma concl is_hyp : resul
     let res = match res.rew_prf with
       | RewCast c -> None
       | RewPrf (rel, p) ->
-        let p = nf_zeta env evars p in
+        (* if abs is Some (_, T), [p] lives in an extended rel context Γ, x : T *)
         let term =
           match abs with
           | None -> p
@@ -1586,7 +1684,7 @@ let newfail n s =
   let info = Exninfo.reify () in
   Proofview.tclZERO ~info (Tacticals.FailError (n, lazy s))
 
-let cl_rewrite_clause_newtac ?abs ?origsigma ~progress strat clause =
+let cl_rewrite_clause_newtac ?origsigma ~progress abs strat clause =
   let open Proofview.Notations in
   (* For compatibility *)
   let beta = Tactics.reduct_in_concl ~cast:false ~check:false
@@ -1644,15 +1742,13 @@ let cl_rewrite_clause_newtac ?abs ?origsigma ~progress strat clause =
     | None -> env
     | Some id ->
       (* Only consider variables not depending on [id] *)
-      let ctx = named_context env in
-      let filter decl = not (occur_var_in_decl env sigma id decl) in
+      let ctx = named_context_of_val_with_status @@ named_context_val 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 (val_of_named_context nctx) env
     in
     try
-      let res =
-        cl_rewrite_clause_aux ?abs strat env Id.Set.empty sigma ty clause
-      in
+      let res = cl_rewrite_clause_aux abs strat env sigma ty clause in
       let sigma = match origsigma with None -> sigma | Some sigma -> sigma in
       treat sigma res state <*>
       (* For compatibility *)
@@ -1677,7 +1773,7 @@ let cl_rewrite_clause_strat progress strat clause =
   tactic_init_rewrite () <*>
   (if progress then Proofview.tclPROGRESS else fun x -> x)
    (Proofview.tclOR
-      (cl_rewrite_clause_newtac ~progress strat clause)
+      (cl_rewrite_clause_newtac ~progress None strat clause)
       (fun (e, info) -> match e with
        | Tacticals.FailError (n, pp) ->
          tclFAILn ~info n (str"setoid rewrite failed: " ++ Lazy.force pp)
@@ -1693,135 +1789,6 @@ let cl_rewrite_clause l left2right occs clause =
 let cl_rewrite_clause_strat strat clause =
   cl_rewrite_clause_strat false strat clause
 
-(* Syntax for rewriting with strategies *)
-
-type unary_strategy =
-    Subterms | Subterm | Innermost | Outermost
-  | Bottomup | Topdown | Progress | Try | Any | Repeat
-
-type binary_strategy =
-  | Compose
-
-type nary_strategy = Choice
-
-type ('constr,'redexpr,'id) strategy_ast =
-  | StratId | StratFail | StratRefl
-  | StratUnary of unary_strategy * ('constr,'redexpr,'id) strategy_ast
-  | StratBinary of
-      binary_strategy * ('constr,'redexpr,'id) strategy_ast * ('constr,'redexpr,'id) strategy_ast
-  | StratNAry of nary_strategy * ('constr,'redexpr,'id) strategy_ast list
-  | StratConstr of 'constr * bool
-  | StratTerms of 'constr list
-  | StratHints of bool * string
-  | StratEval of 'redexpr
-  | StratFold of 'constr
-  | StratVar of 'id
-  | StratFix of 'id * ('constr,'redexpr,'id) strategy_ast
-
-let rec map_strategy f g h = function
-  | StratId | StratFail | StratRefl as s -> s
-  | StratUnary (s, str) -> StratUnary (s, map_strategy f g h str)
-  | StratBinary (s, str, str') -> StratBinary (s, map_strategy f g h str, map_strategy f g h str')
-  | StratNAry (s, strs) -> StratNAry (s, List.map (map_strategy f g h) strs)
-  | StratConstr (c, b) -> StratConstr (f c, b)
-  | StratTerms l -> StratTerms (List.map f l)
-  | StratHints (b, id) -> StratHints (b, id)
-  | StratEval r -> StratEval (g r)
-  | StratFold c -> StratFold (f c)
-  | StratVar id -> StratVar (h id)
-  | StratFix (id, s) -> StratFix (h id, map_strategy f g h s)
-
-let pr_ustrategy = function
-| Subterms -> str "subterms"
-| Subterm -> str "subterm"
-| Innermost -> str "innermost"
-| Outermost -> str "outermost"
-| Bottomup -> str "bottomup"
-| Topdown -> str "topdown"
-| Progress -> str "progress"
-| Try -> str "try"
-| Any -> str "any"
-| Repeat -> str "repeat"
-
-let paren p = str "(" ++ p ++ str ")"
-
-let rec pr_strategy0 prc prr prid = function
-| StratId -> str "id"
-| StratFail -> str "fail"
-| StratRefl -> str "refl"
-| str -> paren (pr_strategy prc prr prid str)
-
-and pr_strategy1 prc prr prid = function
-| StratUnary (s, str) ->
-  pr_ustrategy s ++ spc () ++ pr_strategy1 prc prr prid str
-| StratNAry (Choice, strs) ->
-  str "choice" ++ brk (1,2) ++ prlist_with_sep spc (fun str -> hov 0 (pr_strategy0 prc prr prid str)) strs
-| StratConstr (c, true) -> prc c
-| StratConstr (c, false) -> str "<-" ++ spc () ++ prc c
-| StratVar id -> prid id
-| StratTerms cl -> str "terms" ++ spc () ++ pr_sequence prc cl
-| StratHints (old, id) ->
-  let cmd = if old then "old_hints" else "hints" in
-  str cmd ++ spc () ++ str id
-| StratEval r -> str "eval" ++ spc () ++ prr r
-| StratFold c -> str "fold" ++ spc () ++ prc c
-| str -> pr_strategy0 prc prr prid str
-
-and pr_strategy2 prc prr prid = function
-| StratBinary (Compose, str1, str2) ->
-  pr_strategy2 prc prr prid str1 ++ str ";" ++ spc () ++ hov 0 (pr_strategy1 prc prr prid str2)
-| str -> hov 0 (pr_strategy1 prc prr prid str)
-
-and pr_strategy prc prr prid = function
-| StratFix (id,s) -> str "fix" ++ spc() ++ prid id ++ spc() ++ str ":=" ++ spc() ++ hov 0 (pr_strategy1 prc prr prid s)
-| str -> pr_strategy2 prc prr prid str
-
-let rec strategy_of_ast bindings = function
-  | StratId -> Strategies.id
-  | StratFail -> Strategies.fail
-  | StratRefl -> Strategies.refl
-  | StratUnary (f, s) ->
-    let s' = strategy_of_ast bindings s in
-    let f' = match f with
-      | Subterms -> Strategies.all_subterms
-      | Subterm -> Strategies.one_subterm
-      | Innermost -> Strategies.innermost
-      | Outermost -> Strategies.outermost
-      | Bottomup -> Strategies.bottomup
-      | Topdown -> Strategies.topdown
-      | Progress -> Strategies.progress
-      | Try -> Strategies.try_
-      | Any -> Strategies.any
-      | Repeat -> Strategies.repeat
-    in f' s'
-  | StratBinary (f, s, t) ->
-    let s' = strategy_of_ast bindings s in
-    let t' = strategy_of_ast bindings t in
-    let f' = match f with
-      | Compose -> Strategies.seq
-    in f' s' t'
-  | StratNAry (Choice, strs) ->
-    let strs = List.map (strategy_of_ast bindings) strs in
-    begin match strs with
-      | [] -> assert false
-      | s::strs -> List.fold_left Strategies.choice s strs
-    end
-  | StratConstr ((_, c), b) -> Strategies.one_lemma c b None AllOccurrences
-  | StratHints (old, id) -> if old then Strategies.old_hints id else Strategies.hints id
-  | StratTerms l -> Strategies.lemmas (List.map (fun (_, c) -> (c, true, None)) l)
-  | StratEval r -> { strategy =
-    (fun ({ state = () ; env ; evars } as input) ->
-     let (sigma, r_interp) = r env (goalevars evars) in
-     (Strategies.reduce r_interp).strategy { input with
-                                             evars = (sigma,cstrevars evars) }) }
-  | StratFold c -> Strategies.fold_glob (fst c)
-
-  | StratVar id -> Id.Map.get id bindings
-
-  | StratFix (id, s) -> Strategies.fix (fun self -> strategy_of_ast (Id.Map.add id self bindings) s)
-
-let strategy_of_ast s = strategy_of_ast Id.Map.empty s
-
 let proper_projection env sigma r ty =
   let rel_vect n m = Array.init m (fun i -> mkRel(n+m-i)) in
   let ctx, inst = decompose_prod_decls sigma ty in
@@ -1834,7 +1801,7 @@ let proper_projection env sigma r ty =
 
 let build_morphism_signature env sigma m =
   let m,ctx = Constrintern.interp_constr env sigma m in
-  let sigma = Evd.from_ctx ctx in
+  let sigma = Evd.from_ustate ctx in
   let t = Retyping.get_type_of env sigma m in
   let cstrs =
     let rec aux t =
@@ -1873,20 +1840,20 @@ let default_morphism env sigma sign m =
 (** Bind to "rewrite" too *)
 
 (* Find a subterm which matches the pattern to rewrite for "rewrite" *)
-let unification_rewrite l2r c1 c2 sigma prf car rel but env =
+let unification_rewrite l2r c1 c2 sigma prf car rel where but env =
   let ((_, sigma), c') =
     try
       (* ~flags:(false,true) to allow to mark occurrences that must not be
          rewritten simply by replacing them with let-defined definitions
          in the context *)
-      Unification.w_unify_to_subterm
+      Unification.w_unify_to_subterm ?where
        ~flags:rewrite_unif_flags
         env sigma ((if l2r then c1 else c2),but)
     with
     | ex when Pretype_errors.precatchable_exception ex ->
         (* ~flags:(true,true) to make Ring work (since it really
            exploits conversion) *)
-      Unification.w_unify_to_subterm
+      Unification.w_unify_to_subterm ?where
         ~flags:rewrite_conv_unif_flags
         env sigma ((if l2r then c1 else c2),but)
   in
@@ -1898,8 +1865,7 @@ let unification_rewrite l2r c1 c2 sigma prf car rel but env =
   let prfty = nf (Retyping.get_type_of env sigma prf) in
   let sort = sort_of_rel env sigma but in
   let abs = prf, prfty in
-  let prf = mkRel 1 in
-  let res = (car, rel, prf, c1, c2) in
+  let res = (car, rel, c1, c2) in
   abs, sigma, res, Sorts.is_prop sort
 
 let get_hyp gl (c,l) clause l2r =
@@ -1911,7 +1877,7 @@ let get_hyp gl (c,l) clause l2r =
     | Some id -> Tacmach.pf_get_hyp_typ id gl
     | None -> Reductionops.nf_evar sigma concl
   in
-  unification_rewrite l2r hi.c1 hi.c2 sigma hi.prf hi.car hi.rel but env
+  unification_rewrite l2r hi.c1 hi.c2 sigma hi.prf hi.car hi.rel clause but env
 
 let general_rewrite_flags = { under_lambdas = false; on_morphisms = true }
 
@@ -1935,7 +1901,7 @@ let general_s_rewrite cl l2r occs (c,l) ~new_goals =
       (tclPROGRESS
         (tclTHEN
            (Proofview.Unsafe.tclEVARS evd)
-            (cl_rewrite_clause_newtac ~progress:true ~abs:(Some abs) ~origsigma strat cl)))
+            (cl_rewrite_clause_newtac ~progress:true (Some abs) ~origsigma strat cl)))
     (fun (e, info) -> match e with
     | e -> Proofview.tclZERO ~info e)
   end
diff --git a/tactics/rewrite.mli b/tactics/rewrite.mli
index 652c0e5dbcd4..15df4e0bbd54 100644
--- a/tactics/rewrite.mli
+++ b/tactics/rewrite.mli
@@ -18,57 +18,19 @@ open Tactypes
 
 exception RewriteFailure of Environ.env * Evd.evar_map * Pretype_errors.pretype_error
 
-type unary_strategy =
-    Subterms | Subterm | Innermost | Outermost
-  | Bottomup | Topdown | Progress | Try | Any | Repeat
-
-type binary_strategy =
-  | Compose
-
-type nary_strategy = Choice
-
-type ('constr,'redexpr,'id) strategy_ast =
-  | StratId | StratFail | StratRefl
-  | StratUnary of unary_strategy * ('constr,'redexpr,'id) strategy_ast
-  | StratBinary of
-      binary_strategy * ('constr,'redexpr,'id) strategy_ast * ('constr,'redexpr,'id) strategy_ast
-  | StratNAry of nary_strategy * ('constr,'redexpr,'id) strategy_ast list
-  | StratConstr of 'constr * bool
-  | StratTerms of 'constr list
-  | StratHints of bool * string
-  | StratEval of 'redexpr
-  | StratFold of 'constr
-  | StratVar of 'id
-  | StratFix of 'id * ('constr,'redexpr,'id) strategy_ast
-
-type rewrite_proof =
-  | RewPrf of constr * constr
-  | RewCast of Constr.cast_kind
-
 type evars = evar_map * Evar.Set.t (* goal evars, constraint evars *)
 
-type rewrite_result_info = {
-  rew_car : constr;
-  rew_from : constr;
-  rew_to : constr;
-  rew_prf : rewrite_proof;
-  rew_evars : evars;
-}
+type rewrite_result_info =
+  { rew_rel: constr; rew_to : constr; rew_prf : constr }
 
 type rewrite_result =
 | Fail
 | Identity
 | Success of rewrite_result_info
 
-type strategy
-
-val strategy_of_ast : (Glob_term.glob_constr * constr delayed_open, Redexpr.red_expr delayed_open, Id.t) strategy_ast -> strategy
+val subst_rewrite_result : Evd.evar_map -> (Id.t -> constr) -> rewrite_result -> rewrite_result
 
-val map_strategy : ('a -> 'b) -> ('c -> 'd) -> ('e -> 'f) ->
-  ('a, 'c, 'e) strategy_ast -> ('b, 'd, 'f) strategy_ast
-
-val pr_strategy : ('a -> Pp.t) -> ('b -> Pp.t) -> ('c -> Pp.t) ->
-  ('a, 'b, 'c) strategy_ast -> Pp.t
+type strategy
 
 (** Entry point for user-level "rewrite_strat" *)
 val cl_rewrite_clause_strat : strategy -> Id.t option -> unit Proofview.tactic
@@ -95,15 +57,6 @@ val setoid_reflexivity : unit Proofview.tactic
 
 val setoid_transitivity : constr option -> unit Proofview.tactic
 
-
-val apply_strategy :
-  strategy ->
-  Environ.env ->
-  Names.Id.Set.t ->
-  constr ->
-  bool * constr ->
-  evars -> rewrite_result
-
 module Strategies :
 sig
   val fail : strategy
@@ -137,6 +90,14 @@ sig
 
   val fold : Evd.econstr -> strategy
   val fold_glob : Glob_term.glob_constr -> strategy
+
+  val with_env : (Environ.env -> Evd.evar_map -> Evd.evar_map * strategy) -> strategy
+
+  val matches : Pattern.constr_pattern -> strategy
+
+  val ltac1_tactic_call : unit Proofview.tactic -> strategy
+
+  val tactic_call : (env:Environ.env -> carrier:constr -> lhs:constr -> rel:constr option -> rewrite_result Proofview.tactic) -> strategy
 end
 
 module Internal :
diff --git a/tactics/stdarg.mli b/tactics/stdarg.mli
index 3e23a1af792c..8f5a1e1867db 100644
--- a/tactics/stdarg.mli
+++ b/tactics/stdarg.mli
@@ -39,7 +39,7 @@ val wit_nat_or_var : (int or_var, int or_var, int) genarg_type
 
 val wit_ident : Id.t uniform_genarg_type
 
-val wit_identref : (lident, lident, Id.t) genarg_type
+val wit_identref : lident vernac_genarg_type
 
 val wit_hyp : (lident, lident, Id.t) genarg_type
 
diff --git a/tactics/tacticErrors.ml b/tactics/tacticErrors.ml
index ef3448ae4ffd..f179cb56941e 100644
--- a/tactics/tacticErrors.ml
+++ b/tactics/tacticErrors.ml
@@ -193,7 +193,7 @@ let tactic_interp_error_handler = function
       str "Applied theorem does not have enough premises."
   | NeedDependentProduct ->
       str "Needs a non-dependent product."
-  | _ -> raise Unhandled
+  | _ -> raise_notrace Unhandled
 
 let wrap_unhandled f e =
   try Some (f e)
diff --git a/tactics/tacticals.ml b/tactics/tacticals.ml
index 6f957f4ac8a4..575dfdfa1434 100644
--- a/tactics/tacticals.ml
+++ b/tactics/tacticals.ml
@@ -109,27 +109,28 @@ let compute_induction_names check_and branchletsigns = function
       let names = fix_empty_or_and_pattern (Array.length branchletsigns) names in
       get_and_check_or_and_pattern_gen check_and ?loc names branchletsigns
 
-let is_recursive_argument env self recarg = match Declareops.dest_recarg recarg with
+let is_recursive_argument env self ra st = match Rtree.Automaton.data ra st with
 | Norec | Mrec (RecArgPrim _)  -> false
 | Mrec (RecArgInd ind) -> Environ.QInd.equal env self ind
 
 (* Compute the let-in signature of case analysis or standard induction scheme *)
 let compute_constructor_signatures env ~rec_flag ((_,k as ity),u) =
+  let (mib, mip) = Inductive.lookup_mind_specif env ity in
+  let ra = mip.mind_automaton in
   let rec analrec c recargs =
     match c, recargs with
     | RelDecl.LocalAssum _ :: c, recarg::rest ->
       let rest = analrec c rest in
-      if rec_flag && is_recursive_argument env ity recarg then true :: true :: rest
+      if rec_flag && is_recursive_argument env ity ra recarg then true :: true :: rest
       else true :: rest
     | RelDecl.LocalDef _ :: c, rest -> false :: analrec c rest
     | [], [] -> []
     | _ -> anomaly (Pp.str "compute_constructor_signatures.")
   in
-  let (mib,mip) = Inductive.lookup_mind_specif env ity in
   let map (ctx, _) = List.skipn (Context.Rel.length mib.mind_params_ctxt) (List.rev ctx) in
   let lc = Array.map map mip.mind_nf_lc in
-  let lrecargs = Declareops.dest_subterms mip.mind_recargs in
-  Array.map2 analrec lc lrecargs
+  let lrecargs = Rtree.Automaton.transitions ra (Rtree.Automaton.initial ra) in
+  Array.map2 (fun c args -> analrec c (Array.to_list args)) lc lrecargs
 
 let tclIDTAC = tclUNIT ()
 
@@ -585,13 +586,13 @@ let elimination_sort_of_goal gl =
   let env = Proofview.Goal.env gl in
   let sigma = Proofview.Goal.sigma gl in
   let c = Proofview.Goal.concl gl in
-  Retyping.get_sort_quality_of env sigma c
+  Retyping.get_sort_quality_or_set_of env sigma c
 
 let elimination_sort_of_hyp id gl =
   let env = Proofview.Goal.env gl in
   let sigma = Proofview.Goal.sigma gl in
   let c = Tacmach.pf_get_hyp_typ id gl in
-  Retyping.get_sort_quality_of env sigma c
+  Retyping.get_sort_quality_or_set_of env sigma c
 
 let elimination_sort_of_clause id gl = match id with
 | None -> elimination_sort_of_goal gl
diff --git a/tactics/tactics.ml b/tactics/tactics.ml
index 822b614689eb..0ad37135dc2e 100644
--- a/tactics/tactics.ml
+++ b/tactics/tactics.ml
@@ -81,8 +81,8 @@ let () =
 let unsafe_intro env decl ~relevance b =
   Refine.refine_with_principal ~typecheck:false begin fun sigma ->
     let ctx = named_context_val env in
-    let nctx = push_named_context_val decl ctx in
-    let inst = EConstr.identity_subst_val (named_context_val env) in
+    let nctx = push_named_context_val ProofVar decl ctx in
+    let inst = EConstr.identity_subst_val ctx in
     let ninst = SList.cons (mkRel 1) inst in
     let nb = subst1 (mkVar (NamedDecl.get_id decl)) b in
     let (sigma, ev) = new_pure_evar nctx sigma ~relevance nb in
@@ -156,15 +156,25 @@ end
 let convert x y = convert_gen Conversion.CONV x y
 let convert_leq x y = convert_gen Conversion.CUMUL x y
 
+(* this should be an error but random code relies on it, eg
+   "match goal with H : _ |- _ => destruct H; clear H end" *)
+let warn_clear_nohyp = CWarnings.create ~name:"clear-no-such-hyp" ~category:CWarnings.CoreCategories.tactics
+    Pp.(fun id -> fmt "No such hypothesis: %t." (fun () -> Id.print id))
+
 let clear_gen fail = function
 | [] -> Proofview.tclUNIT ()
 | ids ->
   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 env = Proofview.Goal.env gl in
     let sigma = Proofview.Goal.sigma gl in
     let concl = Proofview.Goal.concl gl in
+    let add id acc =
+      if Environ.mem_named id env then Id.Set.add id acc
+      else
+        let () = warn_clear_nohyp id in
+        acc
+    in
+    let ids = List.fold_right add ids Id.Set.empty in
     let (sigma, hyps, concl) =
       try clear_hyps_in_evi env sigma (named_context_val env) concl ids
       with Evarutil.ClearDependencyError (id,err,inglobal) -> fail env sigma id err inglobal
@@ -217,6 +227,74 @@ let move_hyp id dest =
     end
   end
 
+let error_renaming_implicit_dependency ?loc env where ids gr =
+  CErrors.user_err ?loc @@
+  fmt "Cannot rename section variable %t@ because it is used implicitly through %t@ in %t."
+    (fun () -> Id.print (Id.Set.choose ids))
+    (fun () -> pr_global_env env gr)
+    (fun () -> match where with
+       | None -> str "the conclusion"
+       | Some h -> fmt "hypothesis %t" (fun () -> Id.print h))
+
+let check_renaming ~src ~dst env sigma concl =
+  let sign = named_context_val env in
+  (* Check that we do not mess variables *)
+  let vars = ids_of_named_context_val sign in
+  let () =
+    if not (Id.Set.subset src vars) then
+      let hyp = Id.Set.choose (Id.Set.diff src vars) in
+      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
+      TacticErrors.already_used elt
+    with Not_found -> ()
+  in
+  let secvars =
+    Id.Set.filter (fun id ->
+        match var_status id env with
+        | SecVar -> true
+        | ProofVar -> false)
+      src
+  in
+  let checked = ref GlobRef.Set_env.empty in
+  let check_constr where c =
+    let rec aux c =
+      match EConstr.destRef sigma c with
+      | VarRef _, _ ->
+        (* we only refuse implicit dependencies, because they can't be substituted *)
+        ()
+      | gr, _ ->
+        if GlobRef.Set_env.mem gr !checked then ()
+        else begin
+          let deps = Evarutil.vars_of_global env sigma gr in
+          let bad = Id.Set.inter deps secvars in
+          let () =
+            if not @@ Id.Set.is_empty bad then
+              error_renaming_implicit_dependency env where bad gr
+          in
+          checked := GlobRef.Set_env.add gr !checked
+        end
+      | exception DestKO -> EConstr.iter sigma aux c
+    in
+    aux c
+  in
+  let () =
+    if Id.Set.is_empty secvars then
+      (* not renaming any secvars -> no problem *)
+      ()
+    else
+      let () = check_constr None concl in
+      let () =
+        List.iter (fun d -> NamedDecl.iter_constr (check_constr (Some (NamedDecl.get_id d))) d)
+          (named_context env)
+      in
+      ()
+  in
+  ()
+
 let rename_hyp repl =
   let fold accu (src, dst) = match accu with
   | None -> None
@@ -238,34 +316,24 @@ let rename_hyp repl =
     Proofview.Goal.enter begin fun gl ->
       let concl = Proofview.Goal.concl gl in
       let env = Proofview.Goal.env gl in
-      let sign = named_context_val env in
       let sigma = Proofview.Goal.sigma gl in
       let relevance = Proofview.Goal.relevance gl in
-      (* Check that we do not mess variables *)
-      let vars = ids_of_named_context_val sign in
-      let () =
-        if not (Id.Set.subset src vars) then
-          let hyp = Id.Set.choose (Id.Set.diff src vars) in
-          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
-          TacticErrors.already_used elt
-        with Not_found -> ()
-      in
+      let () = check_renaming ~src ~dst env sigma concl in
       (* All is well *)
       let make_subst (src, dst) = (src, mkVar dst) in
       let subst = List.map make_subst repl in
       let subst c = Vars.replace_vars sigma subst c in
-      let replace id = try List.assoc_f Id.equal id repl with Not_found -> id in
-      let map decl = decl |> NamedDecl.map_id replace |> NamedDecl.map_constr subst in
-      let ohyps = named_context_of_val sign in
+      let map (status, decl) =
+        let decl = NamedDecl.map_constr subst decl in
+        match List.assoc_f_opt Id.equal (NamedDecl.get_id decl) repl with
+        | None -> status, decl
+        | Some id -> ProofVar, NamedDecl.set_id id decl
+      in
+      let ohyps = EConstr.named_context_of_val_with_status @@ Environ.named_context_val env in
       let nhyps = List.map map ohyps in
       let nconcl = subst concl in
       let nctx = val_of_named_context nhyps in
-      let fold odecl ndecl accu =
+      let fold (_,odecl) (_,ndecl) accu =
         if Id.equal (NamedDecl.get_id odecl) (NamedDecl.get_id ndecl) then
           SList.default accu
         else
@@ -295,7 +363,9 @@ let id_of_name_with_default id = function
   | Name id   -> id
 
 let default_id_of_sort sigma s =
-  if ESorts.is_small sigma s then default_small_ident else default_type_ident
+  match ESorts.kind sigma s with
+  | SProp | Prop | Set -> default_small_ident
+  | Type _ | GSort _ | VSort _ -> default_type_ident
 
 let default_id env sigma decl =
   let open Context.Rel.Declaration in
@@ -377,12 +447,12 @@ let internal_cut ?(check=true) replace id t =
       if replace then
         let nexthyp = get_next_hyp_position env sigma id (named_context_of_val sign) in
         let sigma,sign',t,concl = clear_hyps2 env sigma (Id.Set.singleton id) sign t concl in
-        let sign' = insert_decl_in_named_context env sigma (LocalAssum (make_annot id r,t)) nexthyp sign' in
+        let sign' = insert_decl_in_named_context env sigma (ProofVar,LocalAssum (make_annot id r,t)) nexthyp sign' in
         Environ.reset_with_named_context sign' env,t,concl,sigma
       else
         (if check && mem_named_context_val id sign then
           TacticErrors.intro_already_declared id;
-         push_named (LocalAssum (make_annot id r,t)) env,t,concl,sigma) in
+         push_named ProofVar (LocalAssum (make_annot id r,t)) env,t,concl,sigma) in
     let nf_t = nf_betaiota env sigma t in
     Proofview.tclTHEN
       (Proofview.Unsafe.tclEVARS sigma)
@@ -441,6 +511,7 @@ let[@ocaml.inline] (let*) m f = match m with
 | NoChange -> NoChange
 | Changed v -> f v
 
+(* should secvar status change when Changed? *)
 let e_pf_change_decl (redfun : bool -> Tacred.change_function) where env sigma decl =
   let open Context.Named.Declaration in
   match decl with
@@ -529,7 +600,7 @@ let e_change_in_hyps ~check ~reorder f args = match args with
       in
       let reds = List.fold_left fold Id.Map.empty args in
       let evdref = ref sigma in
-      let map d =
+      let map status d =
         let id = NamedDecl.get_id d in
         match Id.Map.find id reds with
         | reds ->
@@ -540,8 +611,8 @@ let e_change_in_hyps ~check ~reorder f args = match args with
           in
           let (sigma, d) = List.fold_right fold reds (sigma, d) in
           let () = evdref := sigma in
-          EConstr.Unsafe.to_named_decl d
-        | exception Not_found -> d
+          status, EConstr.Unsafe.to_named_decl d
+        | exception Not_found -> status, d
       in
       let sign = Environ.map_named_val map (Environ.named_context_val env) in
       let env = reset_with_named_context sign env in
@@ -945,7 +1016,7 @@ let intro_forthcoming_last_then_gen avoid dep_flag bound n tac =
     if List.is_empty ids then tac []
     else Refine.refine_with_principal ~typecheck:false begin fun sigma ->
       let ctx = named_context_val env in
-      let nctx = List.fold_right push_named_context_val ndecls ctx in
+      let nctx = List.fold_right (fun d ctx -> push_named_context_val ProofVar d ctx) ndecls ctx in
       let inst = SList.defaultn (List.length @@ Environ.named_context env) SList.empty in
       let rels = List.init (List.length decls) (fun i -> mkRel (i + 1)) in
       let ninst = List.fold_right (fun c accu -> SList.cons c accu) rels inst in
@@ -1430,7 +1501,7 @@ let default_elim with_evars clear_flag (c,_ as cx) =
       let (ind,u) = eval_to_quantified_ind env sigma t in
       if is_nonrec env ind then raise IsNonrec;
       let sigma, elim = find_ind_eliminator env sigma ind
-                          (Retyping.get_sort_quality_of env sigma concl) in
+                          (Retyping.get_sort_quality_or_set_of env sigma concl) in
       Proofview.tclTHEN (Proofview.Unsafe.tclEVARS sigma)
       (general_elim with_evars clear_flag cx (ElimConstant (mkConstU elim, UnknownPosition)))
     end)
@@ -1495,12 +1566,11 @@ let make_projection env sigma params cstr sign elim i n c (ind, u) =
       then
         let (_, mip) as specif = Inductive.lookup_mind_specif env ind in
         let t = lift (i + 1 - n) t in
-        let ksort = Retyping.get_sort_quality_of (push_rel_context sign env) sigma t in
-        if UnivGen.QualityOrSet.eliminates_to
-             (UnivGen.QualityOrSet.of_quality @@ Inductiveops.elim_sort specif) ksort then
+        let ksort = Retyping.get_sort_quality_or_set_of (push_rel_context sign env) sigma t in
+        if UnivGen.QualityOrSet.eliminates_to (Inductiveops.elim_sort specif) ksort then
           let arity = List.firstn mip.mind_nrealdecls mip.mind_arity_ctxt in
           let mknas ctx = Array.of_list (List.rev_map get_annot ctx) in
-          let ci = Inductiveops.make_case_info env ind RegularStyle in
+          let ci = Inductiveops.make_case_info env ind MatchStyle in
           let br = [| mknas cs_args, b |] in
           let args = Context.Rel.instance mkRel 0 sign in
           let indr = ERelevance.make @@
@@ -1915,7 +1985,7 @@ let clear_body idl =
     let env = Proofview.Goal.env gl in
     let concl = Proofview.Goal.concl gl in
     let sigma = Proofview.Goal.sigma gl in
-    let ctx = named_context env in
+    let ctx = named_context_of_val_with_status (named_context_val env) in
     let ids = Id.Set.of_list idl in
     let () =
       match Id.Set.find_first_opt (fun v -> not (mem_named v env)) ids with
@@ -1931,7 +2001,7 @@ let clear_body idl =
       else
         match ctx with
         | [] -> assert false
-        | decl :: ctx ->
+        | (status, decl) :: ctx ->
           let decl, ids, found =
             match decl with
             | LocalAssum (id,t) ->
@@ -1949,9 +2019,9 @@ let clear_body idl =
           if Id.Set.exists (fun id -> occur_var_in_decl env sigma id decl) ids then
             let sigma = check_decl env sigma idl ids decl in (* can sigma really change? *)
             let ids = Id.Set.add (get_id decl) ids in
-            push_named decl env, sigma, Id.Set.add (get_id decl) ids
+            push_named status decl env, sigma, Id.Set.add (get_id decl) ids
           else
-            push_named decl env, sigma, if found then Id.Set.add (get_id decl) ids else ids
+            push_named status decl env, sigma, if found then Id.Set.add (get_id decl) ids else ids
     in
     try
       let env, sigma, ids = fold ids ctx in
@@ -2533,7 +2603,7 @@ let pose_tac na c =
     Proofview.Unsafe.tclEVARS sigma <*>
     Refine.refine ~typecheck:false begin fun sigma ->
       let id = make_annot id rel in
-      let nhyps = EConstr.push_named_context_val (NamedDecl.LocalDef (id, c, t)) hyps in
+      let nhyps = EConstr.push_named_context_val ProofVar (NamedDecl.LocalDef (id, c, t)) hyps in
       let (sigma, ev) = Evarutil.new_pure_evar nhyps sigma ~relevance concl in
       let inst = EConstr.identity_subst_val hyps in
       let body = mkEvar (ev, SList.cons (mkRel 1) inst) in
@@ -2843,7 +2913,8 @@ let unfold_body x =
 let dest_intro_patterns with_evars avoid thin dest pat tac =
   intro_patterns_core with_evars avoid [] thin dest None 0 tac pat
 
-let rocq_heq_ref        = lazy (Rocqlib.lib_ref "core.JMeq.type")
+(* XXX share with generalize.ml? *)
+let rocq_heq_ref () = Rocqlib.lib_ref "core.JMeq.type"
 
 let compare_upto_variables sigma x y =
   let rec compare x y =
@@ -2876,7 +2947,7 @@ let specialize_eqs id =
               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 isRefX env !evars (Lazy.force rocq_heq_ref) heq ->
+        | App (heq, [| eqty; x; eqty'; y |]) when isRefX env !evars (rocq_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
@@ -2926,7 +2997,7 @@ let exfalso =
     let sigma = Proofview.Goal.sigma gl in
     let (sigma, f) = Evd.fresh_global env sigma (Rocqlib.lib_ref "core.False.type") in
     let (ind, _) = reduce_to_atomic_ind env sigma f in
-    let s = Retyping.get_sort_quality_of env sigma (Proofview.Goal.concl gl) in
+    let s = Retyping.get_sort_quality_or_set_of env sigma (Proofview.Goal.concl gl) in
     let sigma, elimc = find_ind_eliminator env sigma (fst ind) s in
     let elimc = mkConstU elimc in
     let elimt = Retyping.get_type_of env sigma elimc in
@@ -3198,38 +3269,6 @@ let evarconv_unify ?(state=TransparentState.full) ?(with_ho=true) x y =
     Proofview.tclZERO ~info (PretypeError (env, sigma, CannotUnify (x, y, None)))
   end
 
-(** [tclWRAPFINALLY before tac finally] runs [before] before each
-    entry-point of [tac] and passes the result of [before] to
-    [finally], which is then run at each exit-point of [tac],
-    regardless of whether it succeeds or fails.  Said another way, if
-    [tac] succeeds, then it behaves as [before >>= fun v -> tac >>= fun
-    ret -> finally v <*> tclUNIT ret]; otherwise, if [tac] fails with
-    [e], it behaves as [before >>= fun v -> finally v <*> tclZERO
-    e].  Note that if [tac] succeeds [n] times before finally failing,
-    [before] and [finally] are both run [n+1] times (once around each
-    succuess, and once more around the final failure). *)
-(* We should probably export this somewhere, but it's not clear
-   where. As per
-   https://github.com/rocq-prover/rocq/pull/12197#discussion_r418480525 and
-   https://gitter.im/coq/coq?at=5ead5c35347bd616304e83ef, we don't
-   export it from Proofview, because it seems somehow not primitive
-   enough.  We don't export it from this file because it is more of a
-   tactical than a tactic.  But we also don't export it from Tacticals
-   because all of the non-New tacticals there operate on `tactic`, not
-   `Proofview.tactic`, and all of the `New` tacticals that deal with
-   multi-success things are focussing, i.e., apply their arguments on
-   each goal separately (and it even says so in the comment on `New`),
-   whereas it's important that `tclWRAPFINALLY` doesn't introduce
-   extra focussing. *)
-let rec tclWRAPFINALLY before tac finally =
-  let open Proofview in
-  let open Proofview.Notations in
-  before >>= fun v -> tclCASE tac >>= function
-  | Fail (e, info) -> finally v >>= fun () -> tclZERO ~info e
-  | Next (ret, tac') -> tclOR
-                          (finally v >>= fun () -> tclUNIT ret)
-                          (fun e -> tclWRAPFINALLY before (tac' e) finally)
-
 let with_set_strategy lvl_ql k =
   let glob_key r =
     match r with
@@ -3253,17 +3292,15 @@ let with_set_strategy lvl_ql k =
     Environ.set_oracle env ts
   in
   let kl = List.concat (List.map (fun (lvl, ql) -> List.map (fun q -> (lvl, glob_key q)) ql) lvl_ql) in
-  tclWRAPFINALLY
-    (Proofview.tclENV >>= fun env ->
-     let orig_kl = get_strategy env kl in
-     let env = set_strategy env kl in
-     Proofview.Unsafe.tclSETENV env <*>
-     Proofview.tclUNIT orig_kl)
-    k
-    (fun orig_kl ->
-       Proofview.tclENV >>= fun env ->
-       let env = set_strategy env orig_kl in
-       Proofview.Unsafe.tclSETENV env)
+  Proofview.tclENV >>= fun env ->
+  let orig_kl = get_strategy env kl in
+  let env = set_strategy env kl in
+  Proofview.Unsafe.tclSETENV env <*>
+  k >>= fun res ->
+  Proofview.tclENV >>= fun env ->
+  let env = set_strategy env orig_kl in
+  Proofview.Unsafe.tclSETENV env <*>
+  Proofview.tclUNIT res
 
 module Simple = struct
   (** Simplified version of some of the above tactics *)
diff --git a/test-suite/Makefile b/test-suite/Makefile
index 08118e3f1874..5a32d329cf49 100644
--- a/test-suite/Makefile
+++ b/test-suite/Makefile
@@ -527,6 +527,10 @@ approve-coqdoc: coqdoc
 	  cp "Coqdoc.$${f%.out}" "$$f"; \
 	  echo "Updated $$f!"; \
 	fi; done; \
+	for f in *.myst.out; do if [ -f "$$f" ]; then \
+	  cp "Coqdoc.$${f%.out}" "$$f"; \
+	  echo "Updated $$f!"; \
+	fi; done; \
 	for f in *.tex.out; do if [ -f "$$f" ]; then \
 	  cat "Coqdoc.$${f%.out}" | grep -v "^%%" > "$$f"; \
 	  echo "Updated $$f!"; \
@@ -767,7 +771,9 @@ $(addsuffix .log,$(wildcard coqdoc/*.v)): %.v.log: %.v %.html.out %.tex.out $(PR
 	  f=`basename $*`; \
 	  $(coqdoc) -utf8 -R . Coqdoc -coqlib_url http://coq.inria.fr/stdlib --html $$f.v 2>&1; \
 	  $(coqdoc) -utf8 -R . Coqdoc -coqlib_url http://coq.inria.fr/stdlib --latex $$f.v 2>&1; \
+	  $(coqdoc) -utf8 -R . Coqdoc -coqlib_url http://coq.inria.fr/stdlib --alectryon $$f.v 2>&1; \
 	  diff -u --strip-trailing-cr $$f.html.out Coqdoc.$$f.html 2>&1; R=$$?; times; \
+	  diff -u --strip-trailing-cr $$f.myst.out Coqdoc.$$f.myst 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); \
diff --git a/test-suite/_CoqProject b/test-suite/_CoqProject
index dc121311d075..8ced86c9c028 100644
--- a/test-suite/_CoqProject
+++ b/test-suite/_CoqProject
@@ -1 +1 @@
--Q prerequisite TestSuite
+-R prerequisite TestSuite
diff --git a/test-suite/bugs/bug_11487.v b/test-suite/bugs/bug_11487.v
new file mode 100644
index 000000000000..886009670efc
--- /dev/null
+++ b/test-suite/bugs/bug_11487.v
@@ -0,0 +1,16 @@
+Parameter parameters: Type.
+Parameter mem: parameters -> Type.
+Parameter rel: forall {p: parameters}, mem p -> mem p -> Prop.
+
+Section Foo.
+  Context (p: parameters).
+
+  Lemma Proper_load: forall (m: mem p), rel m m. Admitted.
+
+  Goal forall (p: parameters) (m: mem p), rel m m.
+  Proof.
+    clear p.
+    intros p m.
+    Fail Check Proper_load.
+  Abort.
+End Foo.
diff --git a/test-suite/bugs/bug_11576.v b/test-suite/bugs/bug_11576.v
index b534bfda679f..5fcba06f0414 100644
--- a/test-suite/bugs/bug_11576.v
+++ b/test-suite/bugs/bug_11576.v
@@ -25,12 +25,11 @@ Existing Class rep.
 Fixpoint translate_func' (pv:=_) {t} (e : @expr ltype t)
   : for_each_lhs_of_arrow ltype t -> @cmd pv :=
   match e with
-  | Abs base d f =>
-    fun (args : _ * for_each_lhs_of_arrow _ d) =>
+  | Abs f =>
+    fun (args : _ * for_each_lhs_of_arrow _ _) =>
       translate_func' (f (fst args)) (snd args)
-  | Var base v =>
+  | Var v =>
     fun _ => translate_cmd (Var v)
-  | _ => fun _ => admit
   end.
 (* Used to be: File "./bug_01.v", line 30, characters 30-31:
 Error: Cannot infer this placeholder of type "parameters" (no type class
diff --git a/test-suite/bugs/bug_12304.v b/test-suite/bugs/bug_12304.v
new file mode 100644
index 000000000000..2f2740ffe607
--- /dev/null
+++ b/test-suite/bugs/bug_12304.v
@@ -0,0 +1,11 @@
+Section S.
+Variable a:nat.
+Definition b:=a.
+Goal b=b.
+Proof.
+  Fail rename a into c.
+  generalize b. intros b.
+  rename a into c.
+  Fail unfold b.
+Abort.
+End S.
diff --git a/test-suite/bugs/bug_12467.v b/test-suite/bugs/bug_12467.v
index 4f1b35719699..91619bd96cff 100644
--- a/test-suite/bugs/bug_12467.v
+++ b/test-suite/bugs/bug_12467.v
@@ -4,7 +4,7 @@ Notation "'WITH' ( x1 : t1 ) , x2t2 , .. , xntn  'PRE'  [ ] P 'POST' [ ] Q" :=
   ((fun x1 : t1 => (fun x2t2 => .. (fun xntn => (pair .. (pair x1 x2t2) .. xntn)) .. )),
    (fun x1 : t1 => (fun x2t2 => .. (fun xntn => P) .. )),
    (fun x1 : t1 => (fun x2t2 => .. (fun xntn => Q) .. )))
-    (at level 200, x1 at level 0, x2t2 closed binder, P at level 100, Q at level 100, only parsing).
+    (at level 10, x1 at level 0, x2t2 closed binder, P at level 100, Q at level 100, only parsing).
 Check WITH (x : nat) , (y : nat) , (z : nat) PRE [] (x, y, z) POST [] (z, y, x).
 
 End ClosedBinder.
@@ -26,7 +26,7 @@ Notation "'WITH' ( x1 : t1 ) , x2t2 , .. , xntn  'PRE'  [ ] P 'POST' [ ] Q" :=
   ((fun x1 : t1 => (fun x2t2 => .. (fun xntn => (pair .. (pair x1 x2t2) .. xntn)) .. )),
    (fun x1 : t1 => (fun x2t2 => .. (fun xntn => P) .. )),
    (fun x1 : t1 => (fun x2t2 => .. (fun xntn => Q) .. )))
-    (at level 200, x1 at level 0, x2t2, P at level 100, Q at level 100, only parsing).
+    (at level 10, x1 at level 0, x2t2, P at level 100, Q at level 100, only parsing).
 (* Fail because, constr used for binder defaults to name *)
 Fail Check WITH (x : nat) , (y : nat) , (z : nat) PRE [] (x, y, z) POST [] (z, y, x).
 
@@ -38,7 +38,7 @@ Notation "'WITH' ( x1 : t1 ) , x2t2 , .. , xntn  'PRE'  [ ] P 'POST' [ ] Q" :=
   ((fun x1 : t1 => (fun x2t2 => .. (fun xntn => (pair .. (pair x1 x2t2) .. xntn)) .. )),
    (fun x1 : t1 => (fun x2t2 => .. (fun xntn => P) .. )),
    (fun x1 : t1 => (fun x2t2 => .. (fun xntn => Q) .. )))
-    (at level 200, x1 at level 0, x2t2 constr as pattern, P at level 100, Q at level 100, only parsing).
+    (at level 10, x1 at level 0, x2t2 constr as pattern, P at level 100, Q at level 100, only parsing).
 Check WITH (x : nat) , (y : nat) , (z : nat) PRE [] (x, y, z) POST [] (z, y, x).
 
 End ConstrAsPattern.
@@ -49,7 +49,7 @@ Notation "'WITH' ( x1 : t1 ) , x2t2 , .. , xntn  'PRE'  [ ] P 'POST' [ ] Q" :=
   ((fun x1 : t1 => (fun x2t2 => .. (fun xntn => (pair .. (pair x1 x2t2) .. xntn)) .. )),
    (fun x1 : t1 => (fun x2t2 => .. (fun xntn => P) .. )),
    (fun x1 : t1 => (fun x2t2 => .. (fun xntn => Q) .. )))
-    (at level 200, x1 at level 0, x2t2 pattern, P at level 100, Q at level 100, only parsing).
+    (at level 10, x1 at level 0, x2t2 pattern, P at level 100, Q at level 100, only parsing).
 Check WITH (x : nat) , (y : nat) , (z : nat) PRE [] (x, y, z) POST [] (z, y, x).
 
 End Pattern.
@@ -57,7 +57,7 @@ End Pattern.
 Module OnlyRecursiveBinderPartOfIssue17904.
 
 Notation "∀ x .. y , P" := (forall x , .. (forall y , P) .. )
-  (at level 200, x constr at level 8 as pattern, right associativity,
+  (at level 10, x constr at level 8 as pattern, P at level 200,
       format "'[  ' '[  ' ∀  x  ..  y ']' ,  '/' P ']'") : type_scope.
 Check ∀ a b, a + b = 0.
 
diff --git a/test-suite/bugs/bug_14221.v b/test-suite/bugs/bug_14221.v
index f72e55f870f2..8922fa6283cd 100644
--- a/test-suite/bugs/bug_14221.v
+++ b/test-suite/bugs/bug_14221.v
@@ -10,7 +10,7 @@ Require Setoid.
 Require Export Corelib.Classes.CMorphisms.
 
 Notation "∀  x .. y , P" := (forall x, .. (forall y, P) ..)
-  (at level 200, x binder, y binder, right associativity).
+  (at level 10, x binder, y binder, P at level 200).
 
 Class Setoid A := {
   equiv : crelation A;
diff --git a/test-suite/bugs/bug_14822.v b/test-suite/bugs/bug_14822.v
new file mode 100644
index 000000000000..b5cb62a034d3
--- /dev/null
+++ b/test-suite/bugs/bug_14822.v
@@ -0,0 +1,43 @@
+Module Type S.
+Fail Primitive float := #float64_type.
+Fail Register bool as kernel.ind_bool.
+
+Module M.
+Fail Primitive float := #float64_type.
+Fail Register bool as kernel.ind_bool.
+End M.
+
+End S.
+
+Module Type T.
+End T.
+
+Module F(X : T).
+Fail Primitive float := #float64_type.
+Fail Register bool as kernel.ind_bool.
+End F.
+
+Module Type G(X : T).
+Fail Primitive float := #float64_type.
+Fail Register bool as kernel.ind_bool.
+End G.
+
+Module M.
+
+Primitive string := #string_type.
+Register bool as kernel.ind_bool.
+
+End M.
+
+(* The commands below work but create an alias, so no double-registration *)
+
+Module N1 := M.
+Module N2.
+Include M.
+End N2.
+
+Module Type U.
+Include M.
+End U.
+
+Declare Module N3 : U.
diff --git a/test-suite/bugs/bug_16024.v b/test-suite/bugs/bug_16024.v
new file mode 100644
index 000000000000..0ab91f98d369
--- /dev/null
+++ b/test-suite/bugs/bug_16024.v
@@ -0,0 +1,7 @@
+Module Type T. End T.
+
+Module F (E : T) := E.
+
+Module Type FT (X:T). End FT.
+
+Module M := F <+ FT.
diff --git a/test-suite/bugs/bug_16204.v b/test-suite/bugs/bug_16204.v
deleted file mode 100644
index 8906f4044196..000000000000
--- a/test-suite/bugs/bug_16204.v
+++ /dev/null
@@ -1,25 +0,0 @@
-Set Implicit Arguments.
-Set Universe Polymorphism.
-Unset Universe Checking.
-
-Class IsProp (A : Type) : Prop :=
-  irrel (x y : A) : x = y.
-
-Class IsProofIrrel : Prop :=
-  proof_irrel (A : Prop) :: IsProp A.
-
-Class IsPropExt : Prop :=
-  prop_ext (A B : Prop) (a : A <-> B) : A = B.
-
-Class IsTypeExt : Prop :=
-  type_ext (A B : Type) (f : A -> B) (g : B -> A)
-  (r : forall x : A, g (f x) = x) (s : forall y : B, f (g y) = y) :
-  A = B.
-
-Local Instance anomaly
-  `{IsProofIrrel} `{IsTypeExt} : IsPropExt.
-Proof.
-  intros A B [f g]. eapply (type_ext f g).
-  - intros x. apply irrel.
-  - intros y. apply irrel.
-Qed.
diff --git a/test-suite/bugs/bug_16975.v b/test-suite/bugs/bug_16975.v
index 04c9717c9199..721223bd4543 100644
--- a/test-suite/bugs/bug_16975.v
+++ b/test-suite/bugs/bug_16975.v
@@ -1,9 +1,9 @@
 
 Notation "'∏'  x .. y , P" := (forall x, .. (forall y, P) ..)
-  (at level 200, x binder, y binder, right associativity) : type_scope.
+  (at level 10, x binder, y binder, P at level 200) : type_scope.
 
 Notation "'λ' x .. y , t" := (fun x => .. (fun y => t) ..)
-  (at level 200, x binder, y binder, right associativity).
+  (at level 10, x binder, y binder, t at level 200).
 
 Reserved Notation "X ≃ Y" (at level 80, no associativity).
 
@@ -20,7 +20,7 @@ Arguments pr1 {_ _} _.
 Arguments pr2 {_ _} _.
 
 Notation "'∑'  x .. y , P" := (total2 (λ x, .. (total2 (λ y, P)) ..))
-  (at level 200, x binder, y binder, right associativity) : type_scope.
+  (at level 10, x binder, y binder, P at level 200) : type_scope.
 
 
 
diff --git a/test-suite/bugs/bug_16995_2.v b/test-suite/bugs/bug_16995_2.v
index 845667db1e97..6a96f63b8618 100644
--- a/test-suite/bugs/bug_16995_2.v
+++ b/test-suite/bugs/bug_16995_2.v
@@ -7,7 +7,7 @@ Declare Scope category_theory_scope.
 Open Scope category_theory_scope.
 
 Notation "∀  x .. y , P" := (forall x, .. (forall y, P) ..)
-  (at level 200, x binder, y binder, right associativity) :
+  (at level 10, x binder, y binder, P at level 200) :
   category_theory_scope.
 
 Notation "x → y" := (x -> y)
@@ -18,7 +18,7 @@ Notation "x ↔ y" := (iffT x y)
 Infix "∧" := prod (at level 80, right associativity) : category_theory_scope.
 
 Notation "'λ'  x .. y , t" := (fun x => .. (fun y => t) ..)
-  (at level 200, x binder, y binder, right associativity) :
+  (at level 10, x binder, y binder, t at level 200) :
   category_theory_scope.
 Set Universe Polymorphism.
 
diff --git a/test-suite/bugs/bug_17860.v b/test-suite/bugs/bug_17860.v
index 81b8907842a0..985de8d11c21 100644
--- a/test-suite/bugs/bug_17860.v
+++ b/test-suite/bugs/bug_17860.v
@@ -1,7 +1,7 @@
 Axiom Reduction_sum : forall {A}, nat -> nat -> nat -> (nat -> A) -> A.
 #[local] Notation "'einsum_partλ0' s => body"
   := (fun s => Reduction_sum 0 s 1 (fun s => body))
-       (at level 200, s binder, only parsing).
+       (at level 10, s binder, body at level 200, only parsing).
 #[local] Notation "'einsum_partλ' s1 .. sn => body"
   := (einsum_partλ0 s1 => .. (einsum_partλ0 sn => body) .. )
-       (at level 200, s1 binder, sn binder, only parsing).
+       (at level 10, s1 binder, sn binder, body at level 200, only parsing).
diff --git a/test-suite/bugs/bug_18259.v b/test-suite/bugs/bug_18259.v
new file mode 100644
index 000000000000..7cf356a35d67
--- /dev/null
+++ b/test-suite/bugs/bug_18259.v
@@ -0,0 +1,10 @@
+Require Import PrimArray.
+Require Import PrimInt63.
+Goal True.
+  let x := open_constr:(get (@make (unit * unit) 1%uint63 (tt,?[u])) 0) in
+  let result := eval lazy in x in
+  assert_succeeds (idtac; unify x result);
+  assert_succeeds (idtac; unify x (tt,tt));
+  assert_succeeds (idtac; let t := open_constr:(eq_refl : (x = result)) in idtac);
+  assert_succeeds (idtac; let t := open_constr:(eq_refl : (x = (tt,tt))) in idtac).
+Abort.
diff --git a/test-suite/bugs/bug_18503.v b/test-suite/bugs/bug_18503.v
deleted file mode 100644
index 4d6a10027d27..000000000000
--- a/test-suite/bugs/bug_18503.v
+++ /dev/null
@@ -1,41 +0,0 @@
-Require Import PrimInt63.
-Open Scope int63_scope.
-
-Module Type T.
-  Primitive bar := #int63_sub.
-
-  Axiom bar_land : bar = land.
-End T.
-
-Module F(X:T).
-  Definition foo : X.bar 1 1 = 0 := eq_refl.
-End F.
-
-Module M.
-  Definition bar := land.
-  Definition bar_land : bar = land := eq_refl.
-End M.
-
-Fail Module N : T := M.
-
-(*
-Module A := F N.
-
-Lemma bad : False.
-Proof.
-  pose (f := fun x => eqb x 1).
-  assert (H:f 1 = f 0).
-  { f_equal. change 1 with (land 1 1).
-    rewrite <-N.bar_land.
-    exact A.foo. }
-  change (true = false) in H.
-  inversion H.
-Qed.
-
-Print Assumptions bad.
-(* Axioms:
-land : int -> int -> int
-int : Set
-eqb : int -> int -> bool
-*)
-*)
diff --git a/test-suite/bugs/bug_18858.v b/test-suite/bugs/bug_18858.v
new file mode 100644
index 000000000000..a2f6b4df79a0
--- /dev/null
+++ b/test-suite/bugs/bug_18858.v
@@ -0,0 +1,9 @@
+Section Test.
+ Context (H : True).
+ Goal True /\ True -> True.
+ Proof.
+   intros H'. rename H into H0. rename H' into H.
+   repeat match goal with [ H : _ /\ _ |- _ ] => destruct H end. (* fails with timeout because [H] is not cleared by [destruct] *)
+   trivial.
+ Qed.
+End Test.
diff --git a/test-suite/bugs/bug_19482.v b/test-suite/bugs/bug_19482.v
new file mode 100644
index 000000000000..70a3c7c73cd6
--- /dev/null
+++ b/test-suite/bugs/bug_19482.v
@@ -0,0 +1,8 @@
+Definition foo := nat.
+#[global]Typeclasses Opaque foo.
+#[global] Opaque foo. (* both succeed happily *)
+
+Definition bar := nat.
+#[global] Opaque bar.
+#[global] Typeclasses Opaque bar. (* Cannot coerce bar to an evaluable reference. *)
+(* I would expect it to succeed, with the same behaviour as for `foo`. *)
diff --git a/test-suite/bugs/bug_19971.v b/test-suite/bugs/bug_19971.v
new file mode 100644
index 000000000000..6a4f6100df2e
--- /dev/null
+++ b/test-suite/bugs/bug_19971.v
@@ -0,0 +1,3 @@
+Definition typ := Type.
+
+Fail #[universes(template)] Inductive bla : typ := .
diff --git a/test-suite/bugs/bug_19994.v b/test-suite/bugs/bug_19994.v
new file mode 100644
index 000000000000..61b7a0cbaea6
--- /dev/null
+++ b/test-suite/bugs/bug_19994.v
@@ -0,0 +1,28 @@
+Module Type WRAP.
+  Parameter t : Set.
+End WRAP.
+
+Module Type PARAMS.
+  Declare Module Arg : WRAP.
+End PARAMS.
+
+Module Type JOKER. (* also breaks if you remove `Type` *)
+End JOKER.
+
+Module Type COMBINED := PARAMS <+ JOKER. (* Fix 1: Remove `<+ JOKER` *)
+
+Module Inst <: WRAP.
+  Inductive t_ := Q | R. (* Fix 2: Move this definition away *)
+  Definition t := t_.
+End Inst.
+
+Module Type RECOMBINED := COMBINED with Module Arg := Inst.
+
+Module Type LOCK_DEFS(Mod : RECOMBINED). (* also breaks if you remove `Type` *)
+  Goal Mod.Arg.t -> True.
+    intros.
+    (* Fix 3: run `destruct (H : Inst.t)` instead *)
+    destruct H. (* Error: Anomaly "Uncaught exception Not_found." Please report at http://coq.inria.fr/bugs/. *)
+    all: constructor.
+  Qed.
+End LOCK_DEFS.
diff --git a/test-suite/bugs/bug_20155.v b/test-suite/bugs/bug_20155.v
new file mode 100644
index 000000000000..dc422e6c0ead
--- /dev/null
+++ b/test-suite/bugs/bug_20155.v
@@ -0,0 +1,19 @@
+Require Import PrimArray.
+Require Import PrimInt63.
+Axiom F : unit -> unit.
+
+Goal forall g1, exists st, get (make 1 (F g1)) 0 = F st.
+Proof.
+  intros.
+  eexists _.
+  Succeed lazy [make]; reflexivity.
+  Succeed lazy [make]; refine eq_refl.
+Abort.
+
+Goal forall g1, exists st, get (make 1 (F g1)) 0 = F st.
+Proof.
+  intros.
+  eexists _.
+  Succeed reflexivity.
+  Succeed refine eq_refl.
+Abort.
diff --git a/test-suite/bugs/bug_20254.v b/test-suite/bugs/bug_20254.v
new file mode 100644
index 000000000000..4e2439c24bce
--- /dev/null
+++ b/test-suite/bugs/bug_20254.v
@@ -0,0 +1,32 @@
+Module Type A.
+  Parameter t: Type.
+  Parameter len : t -> nat.
+  Parameter len2 : t -> nat.
+End A.
+
+Module A_impl.
+  Definition t : Type := list nat.
+  (* Adding incr to A fixes the anomaly *)
+  Definition incr (n: nat) := S n.
+  Definition len (m: t) := incr (length m).
+  Definition len2 (m: t) := length m.
+End A_impl.
+
+Module Type B.
+  Declare Module M : A.
+End B.
+
+Module Type Bp.
+  Include B.
+End Bp.
+
+Module Bp_inst.
+  (* Using instead "Include B with Module M := A_impl" also fixes the anomaly *)
+  Include Bp with Module M := A_impl.
+End Bp_inst.
+
+(* This Print works *)
+Print Bp_inst.M.len2.
+
+(* This Print raises an anomaly *)
+Print Bp_inst.M.len.
diff --git a/test-suite/bugs/bug_20667.v b/test-suite/bugs/bug_20667.v
new file mode 100644
index 000000000000..12a77ee32975
--- /dev/null
+++ b/test-suite/bugs/bug_20667.v
@@ -0,0 +1,5 @@
+Inductive SFalse : SProp := .
+
+Unset Universe Checking.
+
+Definition f g := (g tt : SFalse).
diff --git a/test-suite/bugs/bug_20847_1.v b/test-suite/bugs/bug_20847_1.v
new file mode 100644
index 000000000000..0937bed6a388
--- /dev/null
+++ b/test-suite/bugs/bug_20847_1.v
@@ -0,0 +1,18 @@
+(* #20847 is about secvars not getting renamed when pushing rel to
+   named.
+
+   This test checks that clearing a secvar and renaming some other var
+   to reuse the secvar name is correctly handled (which seems
+   necessary to handle renaming secvars in the future). *)
+Section C.
+  Variable n : nat.
+
+  Definition d : n = n := eq_refl.
+
+  Lemma l : n = n.
+  Proof.
+    revert n; intros []; [ reflexivity | ].
+    apply eq_S. Fail apply d.
+  Fail Qed.
+  Abort.
+End C.
diff --git a/test-suite/bugs/bug_20902_1.v b/test-suite/bugs/bug_20902_1.v
index 805746465308..a7272764056f 100644
--- a/test-suite/bugs/bug_20902_1.v
+++ b/test-suite/bugs/bug_20902_1.v
@@ -6,7 +6,7 @@
    Expected coqc runtime on this file: 0.159 sec *)
 Declare Scope type_scope.
 Reserved Notation "'exists' x .. y , p"
-  (at level 200, x binder, right associativity,
+  (at level 10, x binder, p at level 200,
    format "'[' 'exists'  '/  ' x  ..  y ,  '/  ' p ']'").
 
 Reserved Notation "x -> y" (at level 99, right associativity, y at level 200).
@@ -28,9 +28,9 @@ Delimit Scope trunc_scope with trunc.
 Global Open Scope trunc_scope.
 Global Open Scope type_scope.
 
-Declare ML Module "ltac_plugin:coq-core.plugins.ltac".
+Declare ML Module "rocq-runtime.plugins.ltac".
 
-Declare ML Module "number_string_notation_plugin:coq-core.plugins.number_string_notation".
+Declare ML Module "rocq-runtime.plugins.number_string_notation".
 
 Global Set Default Proof Mode "Classic".
 
diff --git a/test-suite/bugs/bug_21096.v b/test-suite/bugs/bug_21096.v
new file mode 100644
index 000000000000..842481f4c184
--- /dev/null
+++ b/test-suite/bugs/bug_21096.v
@@ -0,0 +1,6 @@
+#[projections(primitive)]
+Record T := { a : Set }.
+
+Goal forall x, x.(a) = x.(a).
+  unfold a at 2. (* anomaly *)
+Abort.
diff --git a/test-suite/bugs/bug_21513.v b/test-suite/bugs/bug_21513.v
new file mode 100644
index 000000000000..8cba1029e3ed
--- /dev/null
+++ b/test-suite/bugs/bug_21513.v
@@ -0,0 +1,21 @@
+
+From Corelib Require Extraction.
+Declare ML Module "rocq-runtime.plugins.funind".
+
+Open Scope list_scope.
+
+Notation "[ ]" := nil (format "[ ]") : list_scope.
+Notation "[ x ]" := (cons x nil) : list_scope.
+Notation "[ x ; y ; .. ; z ]" :=  (cons x (cons y .. (cons z nil) ..))
+  (format "[ '[' x ;  '/' y ;  '/' .. ;  '/' z ']' ]") : list_scope.
+
+Set Warnings "+funind".
+
+Function foo (x:nat) :=
+  match x with
+  | 0 => Some []
+  | S _ => Some [0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0]
+  end.
+(* error cannot define graph for foo *)
+
+Check R_foo_correct.
diff --git a/test-suite/bugs/bug_21524.v b/test-suite/bugs/bug_21524.v
new file mode 100644
index 000000000000..bb6cf39c98d0
--- /dev/null
+++ b/test-suite/bugs/bug_21524.v
@@ -0,0 +1,8 @@
+(* this would create a module that could only be imported when univ poly is on *)
+
+Module M.
+  #[local] Set Universe Polymorphism.
+  #[export] Set Polymorphic Inductive Cumulativity.
+End M.
+
+Import M.
diff --git a/test-suite/bugs/bug_21544.v b/test-suite/bugs/bug_21544.v
new file mode 100644
index 000000000000..e20cffb7ad8a
--- /dev/null
+++ b/test-suite/bugs/bug_21544.v
@@ -0,0 +1,5 @@
+Set Primitive Projections.
+Record prod A B := pair { pr1: A; pr2: B }.
+
+Definition f {A B} (p : prod A B) : nat := let '(pair _ _ a b) := p in 0.
+Definition g {A B} '(pair _ _ a b : prod A B) : nat := 0.
diff --git a/test-suite/bugs/bug_21552.v b/test-suite/bugs/bug_21552.v
new file mode 100644
index 000000000000..f0fb0917bafa
--- /dev/null
+++ b/test-suite/bugs/bug_21552.v
@@ -0,0 +1,3 @@
+Require Import Program.Wf.
+
+Fail Program Fixpoint f n {measure n} := g n with g n {measure n} := f n.
diff --git a/test-suite/bugs/bug_21596.v b/test-suite/bugs/bug_21596.v
new file mode 100644
index 000000000000..ac66d20a2506
--- /dev/null
+++ b/test-suite/bugs/bug_21596.v
@@ -0,0 +1,6 @@
+Axiom coe : nat -> bool.
+Coercion coe : nat >-> bool.
+
+Abbreviation foo := (fun x => true = x /\ x = 0 :> nat).
+
+Check @foo : nat -> Prop.
diff --git a/test-suite/bugs/bug_21601.v b/test-suite/bugs/bug_21601.v
new file mode 100644
index 000000000000..397cb673a0b5
--- /dev/null
+++ b/test-suite/bugs/bug_21601.v
@@ -0,0 +1,21 @@
+Require Import TestSuite.jmeq.
+
+(* in stdlib this is a consequence of axiom in Eqdep *)
+Axiom JMeq_eq : forall (A:Type) (x y:A), JMeq x y -> x = y.
+
+Abbreviation JMeq' := (fun A x => @JMeq A x A).
+
+Polymorphic Lemma JMeq_ind_r@{s;+} : forall (A:Type) (x:A) (P:A -> Type@{s;_}),
+   P x -> forall y, JMeq' A y x -> P y.
+Proof.
+intros A x P H y H'. destruct (JMeq_eq _ _ _ H'). assumption.
+Qed.
+
+Polymorphic Definition JMeq_leibniz_r@{s;u v w} : Has_Leibniz_r@{Type Prop s;u v w} JMeq' := JMeq_ind_r.
+
+Hint Resolve JMeq_leibniz_r : rewrite_instances.
+
+Goal forall A (x y : A), JMeq x y -> x = y.
+intros A x y H.
+rewrite H.
+Abort.
diff --git a/test-suite/bugs/bug_21614.v b/test-suite/bugs/bug_21614.v
new file mode 100644
index 000000000000..02d1b73c28a0
--- /dev/null
+++ b/test-suite/bugs/bug_21614.v
@@ -0,0 +1,23 @@
+Inductive test : Type := test_intro : (exists x : nat, True) -> test.
+
+Lemma test_lemma (x y : nat) :
+test_intro (ex_intro _ x I) = test_intro (ex_intro _ y I) ->
+    (ex_intro _ x I) = (ex_intro _ y I).
+Proof.
+  intros [=].
+Abort.
+
+Inductive squash A : Prop := sq (x : A).
+
+Goal sq _ true = sq _ false -> False.
+Proof.
+  intros [=].
+Abort.
+
+Set Keep Proof Equalities.
+
+Lemma test_lemma x y :
+test_intro x = test_intro y -> x = y.
+Proof.
+  intros [=]. assumption.
+Abort.
diff --git a/test-suite/bugs/bug_21616.v b/test-suite/bugs/bug_21616.v
new file mode 100644
index 000000000000..7b368635f605
--- /dev/null
+++ b/test-suite/bugs/bug_21616.v
@@ -0,0 +1,6 @@
+Fail Ltac doit := exact Type@{u}.
+
+(* also in ltac2 *)
+Require Import Ltac2.Ltac2.
+
+Fail Ltac2 doit () := exact Type@{u}.
diff --git a/test-suite/bugs/bug_21633.v b/test-suite/bugs/bug_21633.v
new file mode 100644
index 000000000000..a25fcab6cb83
--- /dev/null
+++ b/test-suite/bugs/bug_21633.v
@@ -0,0 +1,4 @@
+
+Eval vm_compute in ((fun (A: Type) (o: option A) => False_rect A _) _ None).
+
+Eval native_compute in ((fun (A: Type) (o: option A) => False_rect A _) _ None).
diff --git a/test-suite/bugs/bug_21637.v b/test-suite/bugs/bug_21637.v
new file mode 100644
index 000000000000..862e9b0a8e01
--- /dev/null
+++ b/test-suite/bugs/bug_21637.v
@@ -0,0 +1,13 @@
+Set Generate Goal Names.
+
+Goal forall a b c : bool, True.
+Proof.
+  intros.
+  destruct a.
+  [true]: {
+    refine _.
+    destruct b, c.
+    all: exact I.
+  }
+  [false]: exact I.
+Qed.
diff --git a/test-suite/bugs/bug_21664.v b/test-suite/bugs/bug_21664.v
new file mode 100644
index 000000000000..00e73bec1bb4
--- /dev/null
+++ b/test-suite/bugs/bug_21664.v
@@ -0,0 +1,12 @@
+Sort s.
+
+Inductive Ind1 : Type@{s; _} := C.
+(* Universe inconsistency. Cannot enforce Prop <= Type@{s | Set}. *)
+
+Fail #[universes(template)] Inductive ofTy A : Type@{s; _} := OfTy (_:A).
+(* not yet implemented *)
+
+Inductive ofTy A : Type@{s;_} := OfTy (_:A).
+
+(* parameter A was inferred to be in sort s *)
+Check ofTy Ind1.
diff --git a/test-suite/bugs/bug_21671_1.v b/test-suite/bugs/bug_21671_1.v
new file mode 100644
index 000000000000..acb728c80938
--- /dev/null
+++ b/test-suite/bugs/bug_21671_1.v
@@ -0,0 +1,22 @@
+(* this tests a backwards compat hack, remove when the hack is removed *)
+
+Declare Scope category_theory_scope.
+
+Fail #[warning="+at-level-200-changed"]
+Notation "'exists' x .. y , p" := (sigT (fun x => .. (sigT (fun y => p)) ..))
+  (at level 200, x binder, right associativity,
+   format "'[' 'exists'  '/  ' x  ..  y ,  '/  ' p ']'") :
+  category_theory_scope.
+
+Notation "'exists' x .. y , p" := (sigT (fun x => .. (sigT (fun y => p)) ..))
+  (at level 200, x binder, right associativity,
+   format "'[' 'exists'  '/  ' x  ..  y ,  '/  ' p ']'") :
+  category_theory_scope.
+
+Notation "'mif' b 'then' t 'else' u" :=
+  (b * (t + u))
+    (at level 200) : category_theory_scope.
+
+Notation "'mif' b 'then' t 'else' u" :=
+  (b * (t + u))
+    (at level 200) : tactic_scope.
diff --git a/test-suite/bugs/bug_21671_2.v b/test-suite/bugs/bug_21671_2.v
new file mode 100644
index 000000000000..f0ac36d80044
--- /dev/null
+++ b/test-suite/bugs/bug_21671_2.v
@@ -0,0 +1,7 @@
+
+Reserved Notation "T x = A ; b" (at level 200, b at level 200, format "T  x  =  A ; '//' b").
+
+Axiom LetIn : forall {tx:nat} (a b : nat), nat.
+
+Notation "T x = A ; b" := (LetIn (tx:=T) A (fun x => b)).
+(* fails to parse *)
diff --git a/test-suite/bugs/bug_21672.v b/test-suite/bugs/bug_21672.v
new file mode 100644
index 000000000000..e6e42c32479a
--- /dev/null
+++ b/test-suite/bugs/bug_21672.v
@@ -0,0 +1,8 @@
+Require Import Corelib.Array.PrimArray.
+Axiom P : forall A t i (a:A), get t i = a.
+Axiom Q : forall A a i, @length@{length.u0} A a = i.
+Lemma test : forall A a i, @length@{P.u0} A a = i.
+Proof.
+  intros A a i.
+  Succeed refine (Q _ _ _).
+Abort.
diff --git a/test-suite/bugs/bug_21674.v b/test-suite/bugs/bug_21674.v
new file mode 100644
index 000000000000..8a7019ec0370
--- /dev/null
+++ b/test-suite/bugs/bug_21674.v
@@ -0,0 +1,28 @@
+Polymorphic Axiom foo@{u} : nat -> Prop.
+
+Axiom bar : forall n, foo n.
+
+Goal foo 0.
+  Succeed simple apply bar.
+  apply bar.
+Qed.
+
+
+Require Import Corelib.Array.PrimArray.
+
+
+Axiom P : forall A t i (a:A), get t i = a.
+Axiom Q : forall A a i, @length@{length.u0} A a = i.
+
+Lemma test : forall A a i, @length@{P.u0} A a = i.
+Proof.
+  intros A a i.
+  Succeed refine (Q _ _ _).
+  Succeed simple eapply Q.
+  eapply Q.
+Qed.
+
+(* future work: make this succeed *)
+Fail Definition should_work@{u v|} : length@{u} [| | 0 |] = length@{v} [| | 0 |]
+  := eq_refl.
+(* Universe constraints are not implied by the ones declared: u = v *)
diff --git a/test-suite/bugs/bug_21676_1.v b/test-suite/bugs/bug_21676_1.v
new file mode 100644
index 000000000000..5f63fc49c3c5
--- /dev/null
+++ b/test-suite/bugs/bug_21676_1.v
@@ -0,0 +1 @@
+Definition bar := ltac:(abstract exact ltac:(abstract exact Type)).
diff --git a/test-suite/bugs/bug_21676_2.v b/test-suite/bugs/bug_21676_2.v
new file mode 100644
index 000000000000..3ea2809a6e70
--- /dev/null
+++ b/test-suite/bugs/bug_21676_2.v
@@ -0,0 +1 @@
+Check ltac:(abstract exact Type).
diff --git a/test-suite/bugs/bug_21682.v b/test-suite/bugs/bug_21682.v
new file mode 100644
index 000000000000..2fdb64a81ba5
--- /dev/null
+++ b/test-suite/bugs/bug_21682.v
@@ -0,0 +1,41 @@
+Fail Fixpoint F (n : nat) : nat :=
+  match n with
+  | O => O
+  | S k =>
+    (fix f (p : nat) (m : nat) {struct m} :=
+       match m with O => p | S m' => g (S p) m' end
+     with g (q : nat) (m : nat) {struct m} :=
+       match m with O => F q | S m' => f q m' end
+     for f) k k
+  end.
+
+(*
+Lemma F_S k:
+  F (S k) =
+    (fix f (p : nat) (m : nat) {struct m} :=
+       match m with O => p | S m' => g (S p) m' end
+     with g (q : nat) (m : nat) {struct m} :=
+       match m with O => S (F q) | S m' => f q m' end
+     for f) k k.
+Proof.
+  reflexivity.
+Qed.
+
+Lemma F_S':
+  F 2 = S (F 2).
+Proof.
+  etransitivity.
+  1: rewrite F_S.
+  all: reflexivity.
+Qed.
+
+Goal False.
+Proof.
+  pose proof F_S'.
+  remember (F 2).
+  clear Heqn.
+  induction n.
+  - congruence.
+  - inversion H; subst; tauto.
+Qed.
+*)
diff --git a/test-suite/bugs/bug_21683.v b/test-suite/bugs/bug_21683.v
new file mode 100644
index 000000000000..b8c70de69a5b
--- /dev/null
+++ b/test-suite/bugs/bug_21683.v
@@ -0,0 +1,21 @@
+Fixpoint iterate_to_neg (f : nat -> Type) (n : nat) (seed : nat) : Type :=
+    match n with
+    | O => f seed -> False
+    | S m => iterate_to_neg f m seed
+    end.
+
+Fail Fixpoint russell (n : nat) : Type :=
+    match n with
+    | O => True
+    | S m => iterate_to_neg russell 1 (S m)
+    end.
+
+(*
+Definition delta (x : russell 1) : False := x x.
+Definition omega : False := delta delta.
+
+Print Assumptions omega.
+*)
+
+Fail Fixpoint F (n : unit) : False :=
+  (fix G F (n : unit) {struct n} : False := F tt) F n.
diff --git a/test-suite/bugs/bug_21689.v b/test-suite/bugs/bug_21689.v
new file mode 100644
index 000000000000..1aaeb76e9e16
--- /dev/null
+++ b/test-suite/bugs/bug_21689.v
@@ -0,0 +1,7 @@
+Set Universe Polymorphism.
+Definition X@{u} := nat.
+Cumulative Inductive bla@{u} : let x := X@{u} in x -> Prop := .
+
+Definition bli@{a b} A (b:bla@{b} A)
+  := eq_refl : match b in bla x y return y=y with end = match b in bla x y return id y=y with end.
+(* Error: Anomaly "Uncaught exception Invalid_argument("index out of bounds")." *)
diff --git a/test-suite/bugs/bug_21690.v b/test-suite/bugs/bug_21690.v
new file mode 100644
index 000000000000..907392a8cb95
--- /dev/null
+++ b/test-suite/bugs/bug_21690.v
@@ -0,0 +1,28 @@
+Inductive sFalse : SProp := .
+
+Definition f (x:sFalse) := match x return nat -> nat with end.
+
+Fail Definition bli : (fun x : sFalse => f x 0) = (fun x : sFalse => f x 1)
+  := eq_refl.
+
+(* use unsafe tac to ensure it's not just fixed in the higher layers *)
+Definition bli : (fun x : sFalse => f x 0) = (fun x : sFalse => f x 1).
+Proof.
+  match goal with |- ?l = _ => exact_no_check (eq_refl l) end.
+  Fail Qed.
+Abort.
+
+(* definitional uip version *)
+Set Definitional UIP.
+Inductive seq {A} (a:A) : A -> SProp :=
+  srefl : seq a a.
+
+Definition F {x y:nat} (e:seq x y) := match e return nat -> nat with srefl _ => fun x => x end.
+
+Fail Definition bli (x y:nat) (e:seq x y) : F e 0 = F e 1 := eq_refl.
+
+Definition bli (x y:nat) (e:seq x y) : F e 0 = F e 1.
+Proof.
+  match goal with |- ?l = _ => exact_no_check (eq_refl l) end.
+  Fail Qed.
+Abort.
diff --git a/test-suite/bugs/bug_21691.v b/test-suite/bugs/bug_21691.v
new file mode 100644
index 000000000000..542bf239b097
--- /dev/null
+++ b/test-suite/bugs/bug_21691.v
@@ -0,0 +1,8 @@
+Set Universe Polymorphism.
+
+Axiom A@{s;} : Type@{s;Set}.
+
+Definition prod@{s;} := A@{s;} -> Prop.
+
+Definition foo@{s s';} := Eval lazy head in prod@{s';}.
+(*  Binder (_ : "A") has relevance mark set to a variable β0 but was expected to be a variable β1 *)
diff --git a/test-suite/bugs/bug_21692.v b/test-suite/bugs/bug_21692.v
new file mode 100644
index 000000000000..99d04724cb15
--- /dev/null
+++ b/test-suite/bugs/bug_21692.v
@@ -0,0 +1,8 @@
+Require Import PrimArray.
+
+Set Universe Polymorphism.
+
+Definition foo@{u} := [| | nat |]@{u}.
+
+Definition bar@{u v} := Eval lazy head in foo@{v}.
+(* The term "Set" has type "Type@{Set+1}" while it is expected to have type "Type@{Var(0)}". *)
diff --git a/test-suite/bugs/bug_21694.v b/test-suite/bugs/bug_21694.v
new file mode 100644
index 000000000000..288b19be527b
--- /dev/null
+++ b/test-suite/bugs/bug_21694.v
@@ -0,0 +1,27 @@
+Set Universe Polymorphism.
+
+Section S.
+  Sort s.
+
+  Inductive foo@{s1 s2;u} (A:Type@{s2;u}) : Type@{s1;u} := X (_:A).
+
+  Inductive bar (A:Type@{s;Set}) : Prop := Y (_:A).
+End S.
+
+Fail Definition bla (A:Type) (x:foo@{SProp Prop Type;_} A) : A := match x with X _ v => v end.
+
+(* From Stdlib Require Import Hurkens. *)
+
+(* Lemma bad : False. *)
+(* Proof. *)
+(*   unshelve eapply NoRetractFromSmallPropositionToProp.paradox. *)
+(*   - exact (foo Prop). *)
+(*   - apply X. *)
+(*   - apply bla. *)
+(*   - simpl. trivial. *)
+(*   - simpl. trivial. *)
+(* Qed. *)
+
+
+Definition bla (A:Prop) (x:bar A) : A := match x with Y _ v => v end.
+(* Anomaly "Quality γfoo.s undefined." *)
diff --git a/test-suite/bugs/bug_21695.v b/test-suite/bugs/bug_21695.v
new file mode 100644
index 000000000000..873705f6fd35
--- /dev/null
+++ b/test-suite/bugs/bug_21695.v
@@ -0,0 +1,23 @@
+Module Type T. Parameter n : bool. End T.
+Module M_true.  Definition n := true.  End M_true.
+Module M_false. Definition n := false. End M_false.
+
+Module A. Module B. Module F (E : T).
+  Module Inner. Definition x := E.n. End Inner.
+  Module Alias := Inner.
+End F. End B. End A.
+
+Module A' := A.
+Module B' := A'.B.
+Module R  := B'.F M_true.
+Module R' := B'.F M_false.
+
+Fail Check (eq_refl : R.Alias.x = R'.Alias.x).
+
+(*
+Lemma boom : False.
+Proof.
+  assert (H : R.Alias.x = R'.Alias.x) by reflexivity.
+  lazy in H. discriminate H.
+Qed.
+*)
diff --git a/test-suite/bugs/bug_21701.v b/test-suite/bugs/bug_21701.v
new file mode 100644
index 000000000000..653ac52743dc
--- /dev/null
+++ b/test-suite/bugs/bug_21701.v
@@ -0,0 +1,42 @@
+Section A. Variable (F_let : nat -> nat).
+Fixpoint f (p : nat) (m : nat) {struct m} :=
+ match m with
+ | O => S p
+ | S m' =>
+   let h := g in
+   h (S p) m'
+ end
+with g (q : nat) (m : nat) {struct m} :=
+ match m with
+ | O => S (F_let q)
+ | S m' => f q m'
+ end.
+End A.
+
+Fail Fixpoint F_let (n : nat) : nat :=
+  let r :=
+  match n with
+  | O => O
+  | S k =>
+    f F_let k n
+  end in r.
+
+(*
+Theorem false n : n = F_let 1 -> match F_let 1 with 0 => False | S n' => n = n' end.
+  intro e.
+  cbn [F_let].
+  lazy delta [f].
+  lazy beta iota zeta head.
+  apply e.
+Qed.
+
+Theorem no_cycle n : match n with 0 => False | S n' => n = n' end -> False.
+Proof. induction n; eauto. intros e. rewrite <- e in IHn. auto. Qed.
+
+Theorem real_false : False.
+Proof.
+  eapply no_cycle.
+  apply false.
+  reflexivity.
+Qed.
+*)
diff --git a/test-suite/bugs/bug_21702.v b/test-suite/bugs/bug_21702.v
new file mode 100644
index 000000000000..08bd1cceb11b
--- /dev/null
+++ b/test-suite/bugs/bug_21702.v
@@ -0,0 +1,31 @@
+(* Regression test for check_with_def universe constraint dropping bug.
+   Bug: mod_typing.ml stored with Definition result using the WITH body's
+   (weaker) universe constraints instead of the spec's (stronger) constraints.
+   This allowed creating a coerce function Type@{u} -> Type@{v} with no
+   constraint between u and v, leading to a proof of False via Girard's paradox. *)
+
+Set Universe Polymorphism.
+
+Module Type SIG.
+  Section S.
+    Universe u v.
+    Constraint u <= v.
+    Parameter coerce@{} : Type@{u} -> Type@{v}.
+  End S.
+End SIG.
+
+(* The identity function satisfies coerce's type only when u <= v.
+   The bug dropped this constraint from the result. *)
+Module Type SIG2 := SIG with Definition coerce@{u v} := fun (x : Type@{u}) => x.
+Declare Module M : SIG2.
+
+(* After the fix, M.coerce should retain the Type@{u} -> Type@{u} type.
+   Therefore, using it to push Type@{u} into a smaller universe should fail. *)
+Section Test.
+  Universe big small.
+  Constraint small < big.
+
+  (* This should fail: M.coerce@{big+1, small} would require big+1 <= small,
+     but we have small < big, contradiction. *)
+  Fail Definition A : Type@{small} := M.coerce Type@{big}.
+End Test.
diff --git a/test-suite/bugs/bug_21707.v b/test-suite/bugs/bug_21707.v
new file mode 100644
index 000000000000..5419adea4941
--- /dev/null
+++ b/test-suite/bugs/bug_21707.v
@@ -0,0 +1,16 @@
+Module Type T.
+  Parameter t : Type.
+End T.
+
+Module F(X:T with Definition t := nat).
+End F.
+
+Module N.
+  Definition t : Type := nat.
+End N.
+
+(** Check that the type of [X:T with Definition t := nat] is
+    the largest type rather than the smallest type, i.e. it
+    has field [Definition t : Type := nat] rather than
+    [Definition t : Set := nat.] *)
+Module FN := F N.
diff --git a/test-suite/bugs/bug_21717.v b/test-suite/bugs/bug_21717.v
new file mode 100644
index 000000000000..0e83113f61a8
--- /dev/null
+++ b/test-suite/bugs/bug_21717.v
@@ -0,0 +1,11 @@
+Module M.
+  Sort s.
+  Fail Sort s.
+End M.
+Module N.
+  Sort s.
+End N.
+Sort s.
+
+Check fun A:Type@{M.s;Set} => A:Type@{M.s;Set}.
+Fail Check fun A:Type@{M.s;Set} => A:Type@{N.s;Set}.
diff --git a/test-suite/bugs/bug_21730.v b/test-suite/bugs/bug_21730.v
new file mode 100644
index 000000000000..9a4aec5bc289
--- /dev/null
+++ b/test-suite/bugs/bug_21730.v
@@ -0,0 +1,17 @@
+(* Regression test for bug #21730 *)
+(* Scheme Elimination for an included inductive should not cause a universe anomaly *)
+
+Definition binary (A : Type) := A -> A -> Prop.
+
+Module Export SLF_DOT_LibContainer_WRAPPED.
+Module Export LibContainer.
+Class BagDisjoint T := { disjoint : binary T }.
+End LibContainer.
+
+Module Export SLF.
+Module Export LibContainer.
+Include SLF_DOT_LibContainer_WRAPPED.LibContainer.
+Scheme SLF_LibContainer_BagDisjoint_caset := Elimination for SLF.LibContainer.BagDisjoint Sort Type.
+End LibContainer.
+End SLF.
+End SLF_DOT_LibContainer_WRAPPED.
diff --git a/test-suite/bugs/bug_21736.v b/test-suite/bugs/bug_21736.v
new file mode 100644
index 000000000000..966c090ddf4a
--- /dev/null
+++ b/test-suite/bugs/bug_21736.v
@@ -0,0 +1,21 @@
+Set Universe Polymorphism.
+
+Definition foo@{u v} : Type@{v} := Type@{u}.
+Register Inline foo.
+
+(* if [typ] is inlined (in the source) the checker rejects bar, I guess because it
+   doesn't use the Register Inline hint when doing its own compilation
+   but does reuse the compilation of [typ] which did the incorrect inlining. *)
+Definition typ@{v u k} := Type@{v} = foo@{u v} :> Type@{k}.
+
+Lemma bar@{v u k|u < v, v < k} : typ@{v u k}.
+Proof.
+  vm_cast_no_check (@eq_refl Type@{k} Type@{v}).
+  Fail Qed.
+Abort.
+
+Lemma bar@{v u k|u < v, v < k} : typ@{v u k}.
+Proof.
+  native_cast_no_check (@eq_refl Type@{k} Type@{v}).
+  Fail Qed.
+Abort.
diff --git a/test-suite/bugs/bug_21750.v b/test-suite/bugs/bug_21750.v
new file mode 100644
index 000000000000..a4cd370ed69b
--- /dev/null
+++ b/test-suite/bugs/bug_21750.v
@@ -0,0 +1,19 @@
+Set Universe Polymorphism.
+Inductive Box@{s; u} (A : Type@{u}) : Type@{s; u} := box (x : A).
+
+Module Type M.
+  Parameter T@{s; u} : forall A, Box@{s; u} A -> Box@{Type; u} A.
+  Parameter T_correct@{s; u} : forall (A : Type@{u}) x, T@{s; u} A (box@{s; u} _ x) = box@{Type; u} _ x.
+End M.
+
+Module M2.
+  Definition T@{s; u|s -> Type} := fun A (x : Box@{s; u} A) => match x with box _ y => box@{Type;u} _ y end.
+  Definition T_correct@{s; u|s -> Type} : forall (A : Type@{u}) x, T@{s; u} A (box@{s; u} _ x) = box@{Type; u} _ x := fun A x => eq_refl.
+End M2.
+
+Fail Module M3 : M := M2.
+
+Unset Universe Polymorphism.
+Inductive squash (A : Type) : SProp := sq (x : A).
+Fail Definition unbox A (x : squash A) : A :=
+  match M2.T A (match x return Box@{SProp; _} _ with sq _ y => box _ y end) with box _ y => y end.
diff --git a/test-suite/bugs/bug_21751.v b/test-suite/bugs/bug_21751.v
new file mode 100644
index 000000000000..8a106aa1e157
--- /dev/null
+++ b/test-suite/bugs/bug_21751.v
@@ -0,0 +1,8 @@
+Set Universe Polymorphism.
+
+Inductive T@{α;} : Type@{α; Set} := C.
+
+#[universes(polymorphic=no)]
+Sort Test.
+
+Fail Goal match C@{Test;} return _ with C => tt end = tt.
diff --git a/test-suite/bugs/bug_21754.v b/test-suite/bugs/bug_21754.v
new file mode 100644
index 000000000000..9c3e12a50824
--- /dev/null
+++ b/test-suite/bugs/bug_21754.v
@@ -0,0 +1,19 @@
+
+Module Type CmpType.
+  Parameter t : Type.
+End CmpType.
+
+Module Type MAP.
+  Declare Module K: CmpType.
+End MAP.
+
+Module Mmake (K':CmpType).
+  Module K := K'.
+End Mmake.
+
+Module Tagged(C:CmpType).
+  Module Mt : MAP with Definition K.t := C.t := Mmake C.
+End Tagged.
+
+Require Extraction.
+Extraction Tagged.
diff --git a/test-suite/bugs/bug_21777.v b/test-suite/bugs/bug_21777.v
new file mode 100644
index 000000000000..846f279abf1a
--- /dev/null
+++ b/test-suite/bugs/bug_21777.v
@@ -0,0 +1,23 @@
+Set Universe Polymorphism.
+Cumulative Inductive foo@{u} : Type@{u} := .
+
+Unset Universe Polymorphism.
+Universes u v.
+Constraint u < v.
+
+Type eq_refl foo : foo@{u} = foo@{v}.
+(* succeeds *)
+
+Type eq_refl foo <: foo@{u} = foo@{v}.
+(* fails *)
+
+Type eq_refl foo <<: foo@{u} = foo@{v}.
+(* fails *)
+
+Polymorphic Cumulative Inductive bar@{u} := B (_:Type@{u}).
+
+Definition cast@{u v|u < v} (x:bar@{u}) := (x : bar@{v}).
+Definition vmcast@{u v|u < v} (x:bar@{u}) := (x <: bar@{v}).
+
+(* fix #21808 to stop failing *)
+Fail Definition nativecast@{u v|u < v} (x:bar@{u}) := (x <<: bar@{v}).
diff --git a/test-suite/bugs/bug_21788.v b/test-suite/bugs/bug_21788.v
new file mode 100644
index 000000000000..439125e55a05
--- /dev/null
+++ b/test-suite/bugs/bug_21788.v
@@ -0,0 +1,16 @@
+Inductive sTrue : SProp := stt.
+Set Primitive Projections.
+
+Inductive baz := { p : baz }.
+Goal forall x, x = {| p := x.(p) |}.
+Proof.
+  intros x.
+  Fail destruct x.
+Abort.
+
+Record foo := { bar : sTrue }.
+Goal forall x y : foo, x = y.
+Proof.
+  intros x y.
+  Fail destruct x, y.
+Abort.
diff --git a/test-suite/bugs/bug_21789.v b/test-suite/bugs/bug_21789.v
new file mode 100644
index 000000000000..a415b118e3a3
--- /dev/null
+++ b/test-suite/bugs/bug_21789.v
@@ -0,0 +1,12 @@
+Inductive sTrue : SProp := stt.
+Set Primitive Projections.
+Set Nonrecursive Elimination Schemes.
+Record foo := { bar : sTrue }.
+(* Error:
+In environment
+P : foo -> Type
+Build_foo : forall bar : sTrue, P (Build_foo bar)
+f : foo
+The term "let f0 : foo := f in let bar := test.bar f0 in Build_foo bar"
+has type "P (test.Build_foo (test.bar f))" while it is expected to have type
+ "P f".*)
diff --git a/test-suite/bugs/bug_21795.v b/test-suite/bugs/bug_21795.v
new file mode 100644
index 000000000000..8da41a6e88df
--- /dev/null
+++ b/test-suite/bugs/bug_21795.v
@@ -0,0 +1,8 @@
+CoInductive strm := mk { s : strm }.
+
+CoFixpoint f1 := mk f1.
+Definition f2 := cofix f2 := f1.
+
+Fixpoint bli (n:nat) :=
+  match f2 with mk _ => fun _ => n end bli.
+(* Anomaly "File "kernel/inductive.ml", line 1526, characters 65-71: Assertion failed." *)
diff --git a/test-suite/bugs/bug_21797.v b/test-suite/bugs/bug_21797.v
new file mode 100644
index 000000000000..684a806ddfaa
--- /dev/null
+++ b/test-suite/bugs/bug_21797.v
@@ -0,0 +1,62 @@
+(* The function Inductive.find_uniform_parameters did not recurse
+   into arguments of Rel applications.
+   A self-call hidden inside a regular function application was invisible
+   to the uniform parameter analysis, causing over-counting. *)
+Fail Fixpoint naughty (n : nat) : nat :=
+  match n with
+  | 0 => 0
+  | S n' =>
+    (fix G (a : nat) (f : nat -> nat -> nat) (m : nat) {struct m} : nat :=
+      match m with
+      | 0 => S (naughty a)
+      | S m' => f (G n f m') m'
+      end) n' (fun x _ => x) n'
+  end.
+
+(*
+Lemma naughty_loop : naughty 2 = S (naughty 2).
+Proof.
+remember 0 as n.
+set (v := naughty (S (S n))) at 2.
+remember v as ans; unfold v in *; clearbody v.
+cbn.
+set (n₀ := n) at 3.
+replace n₀ with 0.
+f_equal.
+now symmetry.
+Qed.
+
+Theorem inconsistency : False.
+Proof.
+  assert (Hn : forall n, n <> S n).
+  { induction n; discriminate + (intro H; apply IHn; now injection H). }
+  exact (Hn _ naughty_loop).
+Qed.
+
+Print Assumptions inconsistency.
+*)
+
+(** Another variant of the same issue *)
+
+Fixpoint iter_fg {A} f g (a : A) n :=
+  match n with
+  | 0 => a | S n' => f (iter_fg f g (g a) n')
+  end.
+
+Fail Fixpoint F (n : nat) :=
+  iter_fg S F n 1.
+
+(*
+Theorem wrong : F 0 = S (F 0).
+Proof.
+  unfold F at 1. change (fix F (n : nat) := _) with F.
+  cbn -[F]. reflexivity.
+Qed.
+
+Corollary false : False.
+Proof.
+  assert (H : forall n, n <> S n).
+  { induction n; eauto. }
+  eapply H, wrong.
+Qed.
+*)
diff --git a/test-suite/bugs/bug_21799.v b/test-suite/bugs/bug_21799.v
new file mode 100644
index 000000000000..286f572301b8
--- /dev/null
+++ b/test-suite/bugs/bug_21799.v
@@ -0,0 +1,29 @@
+Module SP.
+  Inductive sTrue : SProp := sI.
+  Class Foo (x : SProp) : SProp := foo : x.
+  Definition Bar := Foo sTrue.
+  Identity Coercion Bar_to_Foo : Bar >-> Foo.
+(* Binder (x : "Bar") has relevance mark set to relevant but was expected to be irrelevant
+(maybe a bugged tactic). *)
+End SP.
+
+Module Poly.
+  Set Universe Polymorphism.
+  Unset Collapse Sorts ToType.
+
+  Inductive pTrue : Type := pI.
+
+  (* sanity check instance length *)
+  Check pTrue@{_;_}.
+
+  Class Foo (x : Type) : Type := foo : x.
+  Definition Bar := Foo pTrue.
+
+  (* sanity check instance length *)
+  Check Bar@{_;_}.
+
+  Identity Coercion Bar_to_Foo : Bar >-> Foo.
+
+  Type Bar_to_Foo@{SProp;_} : Bar@{SProp;_} -> Foo@{SProp;_} pTrue@{SProp;_}.
+  Type Bar_to_Foo@{Type;_} : Bar@{Type;_} -> Foo@{Type;_} pTrue@{Type;_}.
+End Poly.
diff --git a/test-suite/bugs/bug_21839.v b/test-suite/bugs/bug_21839.v
new file mode 100644
index 000000000000..0172615e93a5
--- /dev/null
+++ b/test-suite/bugs/bug_21839.v
@@ -0,0 +1,5 @@
+Fail Definition oops : False :=
+  (fix rec (x : unit) : False :=
+  let f (b : False) := match b return False with end in
+  let g x := x in
+  rec ((ltac:(fix rec' 1; exact g) :> unit -> unit) x)) tt.
diff --git a/test-suite/bugs/bug_21862.v b/test-suite/bugs/bug_21862.v
new file mode 100644
index 000000000000..408a84ffbdf5
--- /dev/null
+++ b/test-suite/bugs/bug_21862.v
@@ -0,0 +1,30 @@
+Class Subst := subst_instance : unit.
+Arguments subst_instance _ : clear implicits.
+
+Module Type Term.
+  Parameter Inline subst_local : Subst.
+End Term.
+
+Module Environment (T : Term).
+#[global] Existing Instance T.subst_local.
+End Environment.
+
+#[global] Declare Instance subst_global : Subst.
+
+Module TemplateTerm.
+Definition subst_local := subst_instance _.
+End TemplateTerm.
+
+Module Env := Environment TemplateTerm.
+
+(* Check that the TC instance does not produce the inlined version but
+   produces instead the reference from the module. *)
+
+Lemma test : subst_instance _ = tt.
+Proof.
+match goal with
+[ |- @subst_instance TemplateTerm.subst_local = tt ] =>
+  idtac
+end.
+(* We used to have [@subst_instance (@subst_instance subst_global) = tt] *)
+Abort.
diff --git a/test-suite/bugs/bug_21871.v b/test-suite/bugs/bug_21871.v
new file mode 100644
index 000000000000..f4ba5a17dd3a
--- /dev/null
+++ b/test-suite/bugs/bug_21871.v
@@ -0,0 +1,40 @@
+Module Br.
+  Set Universe Polymorphism.
+  Inductive Box@{s;u} (A : Type@{s;u}) : Type@{s;u} := box : A -> Box A.
+  Axiom wrap : forall (x : nat), Box nat.
+  Section Bug.
+    Variable x : nat.
+    Lemma vmbug : (match wrap x with box _ v => v end) = (match wrap x with box _ v => v end).
+    Proof.
+      vm_compute.
+      reflexivity.
+    Defined.
+    (* Error: Undeclared quality: β0 (maybe a bugged tactic). *)
+
+    Lemma nativebug : (match wrap x with box _ v => v end) = (match wrap x with box _ v => v end).
+    Proof.
+      native_compute.
+      reflexivity.
+    Defined.
+    (* Error: Undeclared quality: β0 (maybe a bugged tactic). *)
+  End Bug.
+End Br.
+
+Module Index.
+  (* checks that relevances in indices and "as" for the return predicate are correctly substituted
+     (was not broken in the past AFAIK) *)
+  Polymorphic Inductive sTrue@{s;} : Type@{s;Set} := sI.
+  Polymorphic Inductive sFalse@{s;} : sTrue@{s;} -> Type@{s;Set} := .
+  Inductive seq {A:SProp} (a:A) : A -> Prop := srefl : seq a a.
+
+  Lemma vmfoo (x:sFalse sI) : match x return seq x x with  end = srefl _.
+  Proof.
+    vm_compute.
+    destruct x.
+  Defined.
+  Lemma nativefoo (x:sFalse sI) : match x return seq x x with  end = srefl _.
+  Proof.
+    native_compute.
+    destruct x.
+  Defined.
+End Index.
diff --git a/test-suite/bugs/bug_21892.v b/test-suite/bugs/bug_21892.v
new file mode 100644
index 000000000000..a9d4905db602
--- /dev/null
+++ b/test-suite/bugs/bug_21892.v
@@ -0,0 +1,7 @@
+Inductive RT := RTC (l : list RT).
+
+#[warnings="-non-full-mutual"]
+Fixpoint on_RT (rt : RT) : unit :=
+  match rt with RTC l => on_list l end
+with on_list (l : list RT) : unit :=
+  tt.
diff --git a/test-suite/bugs/bug_21902.v b/test-suite/bugs/bug_21902.v
new file mode 100644
index 000000000000..04d7ba7f9bc1
--- /dev/null
+++ b/test-suite/bugs/bug_21902.v
@@ -0,0 +1,27 @@
+(* Check that with Module clauses perform the correct equality check for nested modules *)
+
+Module Type Inner.
+  Parameter t : Type.
+End Inner.
+
+Module ConcreteInner : Inner.
+  Definition t := True.
+End ConcreteInner.
+
+Module ConcreteInner2 : Inner.
+  Definition t := False.
+End ConcreteInner2.
+
+Module Wrapper.
+  Module Sub := ConcreteInner.
+End Wrapper.
+
+Module Type MT.
+  Module A := Wrapper.
+End MT.
+
+(* This should fail because A.Sub = Wrapper.Sub = ConcreteInner != ConcreteInner2 *)
+Fail Module Type Bad := MT with Module A.Sub := ConcreteInner2.
+
+(* But this should succeed. *)
+Module Type Good := MT with Module A.Sub := ConcreteInner.
diff --git a/test-suite/bugs/bug_21970.v b/test-suite/bugs/bug_21970.v
new file mode 100644
index 000000000000..6fae48460a1f
--- /dev/null
+++ b/test-suite/bugs/bug_21970.v
@@ -0,0 +1,8 @@
+Set Universe Polymorphism.
+Definition X@{u} := tt.
+Inductive bla@{u} : Set := C (x : unit := X@{u}).
+
+Definition bli@{a b}
+  := eq_refl : match C@{b} with C x => x end = tt.
+
+(* Error: Anomaly "Uncaught exception Invalid_argument("index out of bounds")." *)
diff --git a/test-suite/bugs/bug_21987_1.v b/test-suite/bugs/bug_21987_1.v
new file mode 100644
index 000000000000..c67a26644c26
--- /dev/null
+++ b/test-suite/bugs/bug_21987_1.v
@@ -0,0 +1,16 @@
+
+Axiom t : Type -> Type.
+
+Section S.
+  Variable elt : Type.
+
+  Lemma t_ind :
+   forall P : t elt -> Type,
+   forall m, P m.
+  Proof.
+  Admitted.
+
+  Goal forall m : t elt, m = m.
+    induction m using t_ind.
+  Qed.
+End S.
diff --git a/test-suite/bugs/bug_21987_2.v b/test-suite/bugs/bug_21987_2.v
new file mode 100644
index 000000000000..557bef096d3d
--- /dev/null
+++ b/test-suite/bugs/bug_21987_2.v
@@ -0,0 +1,8 @@
+Goal True /\ True -> True.
+Proof.
+  intros H.
+  match goal with
+  | H : _ /\ _ |- _ =>
+     destruct H as [H1 H2]; try clear H
+  end.
+Abort.
diff --git a/test-suite/bugs/bug_22000.v b/test-suite/bugs/bug_22000.v
new file mode 100644
index 000000000000..ba6c346b65a7
--- /dev/null
+++ b/test-suite/bugs/bug_22000.v
@@ -0,0 +1,12 @@
+Section S.
+  Variable rename : nat -> nat.
+  Variable rename_inj : rename 0 = 0.
+
+  Goal forall x y, x = S y -> False.
+  Proof.
+    intros x y H.
+    generalize_eqs_vars H.
+    Check rename_inj.
+    Fail Check y.
+  Abort.
+End S.
diff --git a/test-suite/bugs/bug_22021.v b/test-suite/bugs/bug_22021.v
new file mode 100644
index 000000000000..33ed44308196
--- /dev/null
+++ b/test-suite/bugs/bug_22021.v
@@ -0,0 +1,10 @@
+#[refine]
+Fixpoint err (x : unit) :=
+  let b := true in
+  let f : unit -> unit -> unit := _ in
+  unit.
+Proof.
+  fix rec 2.
+  exact (fun (arg : if b then unit else err tt) (y : unit) => tt).
+Fail Defined.
+Abort.
diff --git a/test-suite/bugs/bug_22058.v b/test-suite/bugs/bug_22058.v
new file mode 100644
index 000000000000..eaee52498801
--- /dev/null
+++ b/test-suite/bugs/bug_22058.v
@@ -0,0 +1,27 @@
+(* Test for bug #22058: contract_case anomaly on evar-backed Case branches *)
+From Ltac2 Require Import Ltac2 Constr.
+
+Ltac2 make_evar_backed_branch () : constr :=
+  Constr.in_context @a constr:(nat) (fun () =>
+    let inner :=
+      Constr.in_context @b constr:(nat) (fun () =>
+        let a := Control.hyp @a in
+        let b := Control.hyp @b in
+        Control.refine (fun () => constr:(Nat.add $a $b))) in
+    Control.refine (fun () => inner)).
+
+Goal True.
+  let template := constr:(fun (p : nat * nat) => let '(a, b) := p in a + b) in
+  match Unsafe.kind template with
+  | Unsafe.Lambda _ body =>
+    match Unsafe.kind body with
+    | Unsafe.Case ci retrel iv scrut _branches =>
+      let new_branch := make_evar_backed_branch () in
+      let branches := Array.make 1 new_branch in
+      let _ := Constr.Unsafe.make (Unsafe.Case ci retrel iv scrut branches) in
+      ()
+    | _ => ()
+    end
+  | _ => ()
+  end.
+Abort.
diff --git a/test-suite/bugs/bug_2995.v b/test-suite/bugs/bug_2995.v
index 1a4d7e5040b8..dc8eed0d3905 100644
--- a/test-suite/bugs/bug_2995.v
+++ b/test-suite/bugs/bug_2995.v
@@ -5,9 +5,24 @@ End Interface.
 Module Implementation <: Interface.
   Definition t := bool.
   Definition error: t := false.
-Fail End Implementation.
+  Fail End Implementation.
 (* A UserError here is expected, not an uncaught Not_found *)
 
  Reset error.
  Definition error := 0.
 End Implementation.
+
+
+Module Implementation2 <: Interface.
+  Definition t := bool.
+  Inductive x := X with y := Y.
+  Definition error := X.
+  Fail End Implementation2.
+
+  Reset error.
+  Definition error := Y.
+  Fail End Implementation2.
+
+  Reset error.
+  Definition error := 0.
+End Implementation2.
diff --git a/test-suite/bugs/bug_3045.v b/test-suite/bugs/bug_3045.v
index 90aa5ee9fd25..5c6f1ba55b7d 100644
--- a/test-suite/bugs/bug_3045.v
+++ b/test-suite/bugs/bug_3045.v
@@ -19,14 +19,14 @@ Inductive ReifiedMorphism : forall objC (C : SpecializedCategory objC), C -> C -
 
 Fixpoint ReifiedMorphismDenote objC C s d (m : @ReifiedMorphism objC C s d) : Morphism C s d :=
   match m in @ReifiedMorphism objC C s d return Morphism C s d with
-    | ReifiedComposedMorphism _ _ _ _ _ m1 m2 => Compose (@ReifiedMorphismDenote _ _ _ _ m1)
+    | ReifiedComposedMorphism m1 m2 => Compose (@ReifiedMorphismDenote _ _ _ _ m1)
                                                          (@ReifiedMorphismDenote _ _ _ _ m2)
   end.
 
 Fixpoint ReifiedMorphismSimplifyWithProof objC C s d (m : @ReifiedMorphism objC C s d)
 : { m' : ReifiedMorphism C s d | ReifiedMorphismDenote m = ReifiedMorphismDenote m' }.
 refine match m with
-         | ReifiedComposedMorphism _ _ s0 d0 d0' m1 m2 => _
+         | ReifiedComposedMorphism m1 m2 => _
        end; clear m.
 (* This fails with an error rather than an anomaly, but morally
    it should work, if destruct were able to do the good generalization
diff --git a/test-suite/bugs/bug_3262.v b/test-suite/bugs/bug_3262.v
index 64d3388f284c..01b2d5457498 100644
--- a/test-suite/bugs/bug_3262.v
+++ b/test-suite/bugs/bug_3262.v
@@ -21,7 +21,7 @@ Section hlist.
                                  | l :: _ => F l
                                end with
       | Hnil => tt
-      | Hcons _ _ x _ => x
+      | Hcons x _ => x
     end.
 
   Definition hlist_tl {a b} (hl : hlist (a :: b)) : hlist b :=
@@ -30,7 +30,7 @@ Section hlist.
                                  | _ :: ls => hlist ls
                                end with
       | Hnil => tt
-      | Hcons _ _ _ x => x
+      | Hcons _ x => x
     end.
 
   Lemma hlist_eta : forall ls (h : hlist ls),
diff --git a/test-suite/bugs/bug_3732.v b/test-suite/bugs/bug_3732.v
index 76035606ba79..e851bd18a148 100644
--- a/test-suite/bugs/bug_3732.v
+++ b/test-suite/bugs/bug_3732.v
@@ -34,8 +34,8 @@ Section machine.
 
   Fixpoint subst G (p : propX G) : (last G -> PropX) -> propX (eatLast G) :=
     match p with
-      | Inj _ P => fun _ => Inj P
-      | ExistsX G A p1 => fun p' =>
+      | Inj P => fun _ => Inj P
+      | @ExistsX G A p1 => fun p' =>
                             match G return propX (A :: G) -> propX (eatLast (A :: G)) -> propX (eatLast G) with
                               | nil => fun p1 _ => ExistsX p1
                               | cons _ _ => fun _ rc => ExistsX rc
diff --git a/test-suite/bugs/bug_4001.v b/test-suite/bugs/bug_4001.v
index ed05f0d41e4c..775c8c8dad5f 100644
--- a/test-suite/bugs/bug_4001.v
+++ b/test-suite/bugs/bug_4001.v
@@ -14,5 +14,5 @@ Inductive t : list A -> Type :=
 Definition car (x:A) (lx : list A) (s: t (x::lx)) : typ x :=
   match s in t l'  with
   | snil => False
-  | scons _ e _ _ => e
+  | scons e _ => e
   end.
diff --git a/test-suite/bugs/bug_4403.v b/test-suite/bugs/bug_4403.v
deleted file mode 100644
index a80f38fe2a66..000000000000
--- a/test-suite/bugs/bug_4403.v
+++ /dev/null
@@ -1,3 +0,0 @@
-(* -*- coq-prog-args: ("-type-in-type"); -*- *)
-
-Definition some_prop : Prop := Type.
diff --git a/test-suite/bugs/bug_4780.v b/test-suite/bugs/bug_4780.v
index 54f1d68b0fa3..b232128cd8a3 100644
--- a/test-suite/bugs/bug_4780.v
+++ b/test-suite/bugs/bug_4780.v
@@ -7,7 +7,7 @@ Tactic Notation "admit" := abstract case proof_admitted.
 Global Set Universe Polymorphism.
 Global Set Asymmetric Patterns.
 Notation "'exists' x .. y , p" := (sigT (fun x => .. (sigT (fun y => p)) ..))
-  (at level 200, x binder, right associativity,
+  (at level 10, x binder, p at level 200,
    format "'[' 'exists'  '/  ' x  ..  y ,  '/  ' p ']'")
   : type_scope.
 Definition relation (A : Type) := A -> A -> Type.
diff --git a/test-suite/bugs/bug_4955.v b/test-suite/bugs/bug_4955.v
index 74353a7eb210..611566aad2ba 100644
--- a/test-suite/bugs/bug_4955.v
+++ b/test-suite/bugs/bug_4955.v
@@ -32,7 +32,7 @@ Record Functor (C D : PreCategory) :=
 Arguments object_of {C%_category D%_category} f%_functor c%_object : rename, simpl
 nomatch.
 Arguments morphism_of [C%_category] [D%_category] f%_functor [s%_object d%_object]
-m%morphism : rename, simpl nomatch.
+m%_morphism : rename, simpl nomatch.
 Section path_functor.
   Variable C : PreCategory.
   Variable D : PreCategory.
diff --git a/test-suite/bugs/bug_4966.v b/test-suite/bugs/bug_4966.v
index 16dc0d113efc..05e93431c59b 100644
--- a/test-suite/bugs/bug_4966.v
+++ b/test-suite/bugs/bug_4966.v
@@ -1,7 +1,7 @@
 (* Interpretation of auto as an argument of an ltac function (i.e. as an ident) was wrongly "auto with *" *)
 
 Axiom proof_admitted : False.
-#[export] Hint Extern 0 => case proof_admitted : unused.
+#[export] Hint Extern 0 => (case proof_admitted) : unused.
 Ltac do_tac tac := tac.
 
 Goal False.
diff --git a/test-suite/bugs/bug_4976.v b/test-suite/bugs/bug_4976.v
new file mode 100644
index 000000000000..18e6b8d476d4
--- /dev/null
+++ b/test-suite/bugs/bug_4976.v
@@ -0,0 +1,18 @@
+Require Import Coq.Setoids.Setoid.
+Definition silly (n : nat) := True.
+Ltac silly :=
+  lazymatch goal with
+  | [ |- silly 1 ] => constructor
+  end.
+Axiom sillyL : forall x, silly x -> x = 0 + 0.
+Hint Rewrite sillyL using solve [ silly ] : silly.
+Goal 1 + 0 = 0.
+Proof.
+  progress autorewrite* with silly.
+  reflexivity.
+Qed.
+Goal 1 + 0 = 0.
+Proof.
+  rewrite* sillyL by silly.
+  reflexivity.
+Qed.
diff --git a/test-suite/bugs/bug_5522.v b/test-suite/bugs/bug_5522.v
index 0fae9ede4235..8a1fe4c9f435 100644
--- a/test-suite/bugs/bug_5522.v
+++ b/test-suite/bugs/bug_5522.v
@@ -2,6 +2,6 @@
    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).
+  (at level 10, 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/bug_5608.v b/test-suite/bugs/bug_5608.v
index 2830146e1b49..04e60e432c5d 100644
--- a/test-suite/bugs/bug_5608.v
+++ b/test-suite/bugs/bug_5608.v
@@ -1,5 +1,5 @@
 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").
+  (at level 10, 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 )").
 
diff --git a/test-suite/bugs/bug_5679.v b/test-suite/bugs/bug_5679.v
new file mode 100644
index 000000000000..edc201ad7a49
--- /dev/null
+++ b/test-suite/bugs/bug_5679.v
@@ -0,0 +1,11 @@
+Goal False -> True.
+Proof.
+  intros H.
+  Fail elim H using nat. (** Anomaly "last_arg." Please report at http://coq.inria.fr/bugs/. *)
+  Fail elim H using True_ind.
+  Fail elim H using 0.
+  Fail induction H using nat.
+  Fail induction H using True_ind.
+  Fail induction H using 0.
+  elim H using False_ind.
+Qed.
diff --git a/test-suite/bugs/bug_5696.v b/test-suite/bugs/bug_5696.v
index 4ff8ffdb8449..5ce233ac756f 100644
--- a/test-suite/bugs/bug_5696.v
+++ b/test-suite/bugs/bug_5696.v
@@ -1,14 +1,14 @@
 (* Slightly improving interpretation of Ltac subterms in notations *)
 
 Notation "'var2' x .. y = z ; e" := (ltac:(exact z), (fun x => .. (fun y => e)
-..)) (at level 200, x binder, y binder, e at level 220).
+..)) (at level 10, x binder, y binder, e at level 220).
 Check (var2 a = 1; a).
 
 Require Import Ltac2.Ltac2.
 
 Notation "'var3' x .. y = z ; e" := (ltac2:(exact $preterm:z), (fun x => .. (fun y => e)
-..)) (at level 200, x binder, y binder, e at level 220).
+..)) (at level 10, x binder, y binder, e at level 220).
 Check (var3 a = 1; a).
 
 Fail Notation "'var4' x .. y = z ; e" := (ltac2:(let _ := x in exact 0), (fun x => .. (fun y => e)
-..)) (at level 200, x binder, y binder, e at level 220).
+..)) (at level 10, x binder, y binder, e at level 220).
diff --git a/test-suite/bugs/bug_6661.v b/test-suite/bugs/bug_6661.v
index 1b0396e5a275..359c73c345c7 100644
--- a/test-suite/bugs/bug_6661.v
+++ b/test-suite/bugs/bug_6661.v
@@ -9,9 +9,9 @@
 Require Export Corelib.Init.Notations.
 Require Export Corelib.Init.Ltac.
 Notation "'∏'  x .. y , P" := (forall x, .. (forall y, P) ..)
-  (at level 200, x binder, y binder, right associativity) : type_scope.
+  (at level 10, x binder, y binder, P at level 200) : type_scope.
 Notation "'λ' x .. y , t" := (fun x => .. (fun y => t) ..)
-  (at level 200, x binder, y binder, right associativity).
+  (at level 10, x binder, y binder, t at level 200).
 Notation "A -> B" := (forall (_ : A), B) : type_scope.
 Reserved Notation "p @ q" (at level 60, right associativity).
 Reserved Notation "! p " (at level 50).
@@ -47,7 +47,7 @@ Arguments pr1 {_ _} _.
 Arguments pr2 {_ _} _.
 
 Notation "'∑'  x .. y , P" := (total2 (λ x, .. (total2 (λ y, P)) ..))
-  (at level 200, x binder, y binder, right associativity) : type_scope.
+  (at level 10, x binder, y binder, P at level 200) : type_scope.
 
 Definition foo (X:Type) (xy : @total2 X (λ _, X)) : X.
   induction xy as [x y].
diff --git a/test-suite/bugs/bug_6773.v b/test-suite/bugs/bug_6773.v
new file mode 100644
index 000000000000..4a8f0dc8095b
--- /dev/null
+++ b/test-suite/bugs/bug_6773.v
@@ -0,0 +1,14 @@
+Section BuggySection.
+
+  Variable B: nat.
+
+  Axiom F: False. (* To replace admits, allowing QED in bug*)
+
+  Lemma BUG (i: nat) : False.
+  Proof.
+    induction i in B.
+    assert (B = B) by abstract reflexivity.
+    all: now destruct F. (* No more subgoals. *)
+  Qed. (* fails *)
+
+End BuggySection.
diff --git a/test-suite/bugs/bug_7059.v b/test-suite/bugs/bug_7059.v
index 821e524ec4c7..92e5d8ad5bd1 100644
--- a/test-suite/bugs/bug_7059.v
+++ b/test-suite/bugs/bug_7059.v
@@ -18,10 +18,10 @@ Notation "x .1" := (@projT1 _ _ x) : core_scope.
 Notation "x .2" := (@projT2 _ _ x) : core_scope.
 Notation "'exists' x .. y , P"
   := (sigT (fun x => .. (sigT (fun y => P)) ..))
-       (at level 200, x binder, y binder, right associativity) : type_scope.
+       (at level 10, P at level 200, x binder, y binder, right associativity) : type_scope.
 Notation "∃ x .. y , P"
   := (sigT (fun x => .. (sigT (fun y => P)) ..))
-       (at level 200, x binder, y binder, right associativity) : type_scope.
+       (at level 10, P at level 200, x binder, y binder, right associativity) : type_scope.
 
 Definition prod A B := sigT (fun _ : A => B).
 Notation "A * B" := (prod A B) (at level 40, left associativity) : type_scope.
diff --git a/test-suite/bugs/bug_7672.v b/test-suite/bugs/bug_7672.v
new file mode 100644
index 000000000000..c9506627d21d
--- /dev/null
+++ b/test-suite/bugs/bug_7672.v
@@ -0,0 +1,82 @@
+From Corelib Require Import BinNums IntDef NatDef.
+Open Scope Z_scope.
+
+Module First.
+Lemma foo: forall (a b: nat),
+    b < a ->
+    a - b + b = a.
+Admitted.
+
+Axiom leb_spec : forall x y, (Nat.leb (S x) y) = true -> x < y.
+Ltac solve_leb :=
+  match goal with
+  | [ |- ?x < ?y ] => apply leb_spec; exact eq_refl
+  end.
+Hint Rewrite foo using solve_leb : foo_db.
+
+Goal (4 - 5 + 5) + (3 - 2 + 2) + (1 - 3 + 3) + 1 = (6 - 4 + 4) + (5 - 6 + 6).
+Proof.
+  (* I want to simplify (3 - 2 + 2) and (6 - 4 + 4), and leave the rest unchanged. *)
+
+  (* This does not work because rewrite does not backtrack: *)
+  repeat rewrite foo by solve_leb.
+  match goal with
+  | [ |-  4 - 5 + 5 + 3 + (1 - 3 + 3) + 1 = 6 + (5 - 6 + 6) ] => fail
+  | _ => idtac
+  end.
+
+  (* This works! (but "rewrite*" is not documented) *)
+  repeat rewrite* foo by solve_leb.
+  match goal with
+  | [ |-  4 - 5 + 5 + 3 + (1 - 3 + 3) + 1 = 6 + (5 - 6 + 6) ] => idtac
+  end.
+
+  Restart.
+
+  (* autorewrite does not work: *)
+  autorewrite with foo_db.
+  match goal with
+  | [ |-  4 - 5 + 5 + 3 + (1 - 3 + 3) + 1 = 6 + (5 - 6 + 6) ] => fail
+  | _ => idtac
+  end.
+  Restart.
+
+  (* Analogously, autorewrite* should work, but it does not!
+     FEATURE REQUEST: Make this work *)
+  autorewrite* with foo_db.
+  match goal with
+  | [ |-  4 - 5 + 5 + 3 + (1 - 3 + 3) + 1 = 6 + (5 - 6 + 6) ] => idtac
+  end.
+  Restart.
+
+  (* For the record, a verbose workaround: *)
+  repeat match goal with
+  | |- context [?a - ?b + ?b] => rewrite (foo a b) by solve_leb
+         end.
+  match goal with
+  | [ |-  4 - 5 + 5 + 3 + (1 - 3 + 3) + 1 = 6 + (5 - 6 + 6) ] => idtac
+  end.
+  reflexivity.
+Qed.
+End First.
+Module Second.
+Axiom cond : Z -> Prop.
+Axiom rewrite : forall z, cond z -> z = Z0.
+
+Global Hint Rewrite
+  rewrite
+  using assumption
+: max.
+
+Axiom have_cond: forall j, cond j.
+
+Goal forall i j, cond i -> Z.max i j = Z.max i Z0.
+Proof.
+  intros.
+  autorewrite with max.  (* works as expected    *)
+  autorewrite* with max.  (* works as expected    *)
+  pose proof (have_cond j).
+  autorewrite* with max.
+  reflexivity.
+Qed.
+End Second.
diff --git a/test-suite/bugs/bug_7916.v b/test-suite/bugs/bug_7916.v
index 53861dc303a4..d3bb1ed0cf9f 100644
--- a/test-suite/bugs/bug_7916.v
+++ b/test-suite/bugs/bug_7916.v
@@ -53,7 +53,7 @@ Module MathComp.
    Local Coercion sort : type >-> Sortclass.
    Variables (T : Type) (cT : type).
 
-   Definition class := let: Pack _ c := cT return class_of cT in c.
+   Definition class := let: Pack c := cT return class_of cT in c.
 
    End ClassDef.
    Coercion sort : type >-> Sortclass.
diff --git a/test-suite/bugs/bug_8739.v b/test-suite/bugs/bug_8739.v
index dfd1c9ab4ee6..1b4ed4b6e222 100644
--- a/test-suite/bugs/bug_8739.v
+++ b/test-suite/bugs/bug_8739.v
@@ -8,7 +8,7 @@ Open Scope category_theory_scope.
 Export Corelib.Classes.CMorphisms.
 
 Notation "∀  x .. y , P" := (forall x, .. (forall y, P) ..)
-  (at level 200, x binder, y binder, right associativity) :
+  (at level 10, x binder, y binder, P at level 200) :
   category_theory_scope.
 
 Notation "x → y" := (x -> y)
diff --git a/test-suite/bugs/bug_9640.v b/test-suite/bugs/bug_9640.v
index 5ed6c4a6da99..dfd87f7fa05d 100644
--- a/test-suite/bugs/bug_9640.v
+++ b/test-suite/bugs/bug_9640.v
@@ -4,7 +4,7 @@ Declare Custom Entry expr.
 Module A.
 
 Notation "p" := (p) (in custom expr at level 150, p constr, right associativity).
-Notation "** X" := (X) (at level 200, X custom expr at level 150).
+Notation "** X" := (X) (at level 10, X custom expr at level 150).
 Lemma t : ** True.
 Abort.
 
@@ -15,7 +15,7 @@ End A.
 Module B.
 
 Notation "p" := (p) (in custom expr at level 100, p constr (* at level 200 *)).
-Notation "** X" := (X) (at level 200, X custom expr at level 150).
+Notation "** X" := (X) (at level 10, X custom expr at level 150).
 Lemma t : ** True.
 Abort.
 
diff --git a/test-suite/bugs/bug_9714.v b/test-suite/bugs/bug_9714.v
new file mode 100644
index 000000000000..453658a7266c
--- /dev/null
+++ b/test-suite/bugs/bug_9714.v
@@ -0,0 +1,27 @@
+Local Open Scope list_scope.
+
+Definition combine :=
+fun A B : Type =>
+fix combine (l : list A) (l' : list B) {struct l} : list (A * B) :=
+  match l with
+  | nil => nil
+  | x :: tl => match l' with
+               | nil => nil
+               | y :: tl' => (x, y) :: combine tl tl'
+               end
+  end.
+
+Fail Check (forall A B xs ys,
+          @combine A B xs ys
+          = (@list_rect
+               _ _
+               nil
+               (fun x xs combine_xs ys
+                => match ys with
+                   | nil => nil
+                   | y :: ys => (x, y) :: combine_xs ys
+                   end)
+               xs
+               ys)).
+(* Error: Anomaly "File "pretyping/cases.ml", line 1694, characters 27-33: Assertion failed."
+Please report at http://coq.inria.fr/bugs/. *)
diff --git a/test-suite/bugs/ssrew_poly.v b/test-suite/bugs/ssrew_poly.v
new file mode 100644
index 000000000000..1c93259a4773
--- /dev/null
+++ b/test-suite/bugs/ssrew_poly.v
@@ -0,0 +1,21 @@
+From Corelib Require Import ssreflect.
+Set Universe Polymorphism.
+Axiom foo@{i} : unit.
+Set Printing Universes.
+
+Axiom lemma@{i} : foo@{i} = tt.
+
+Monomorphic Universes i j.
+Monomorphic Constraint i < j.
+
+Lemma works : foo@{i} = foo@{j}.
+Proof.
+  (* This separately rewrites each foo@{_} call, no issue *)
+  rewrite !{1}lemma. reflexivity.
+Qed.
+Lemma test : foo@{i} = foo@{j}.
+Proof.
+  (* This can only capture a single foo@{_} call *)
+  rewrite lemma.
+  Fail reflexivity.
+Abort.
diff --git a/test-suite/coq-makefile/expand-directories/a/g.mli b/test-suite/coq-makefile/expand-directories/a/g.mli
new file mode 100644
index 000000000000..e69de29bb2d1
diff --git a/test-suite/coq-makefile/expand-directories/run.sh b/test-suite/coq-makefile/expand-directories/run.sh
index ed5299681ca4..ac103cc1d961 100644
--- a/test-suite/coq-makefile/expand-directories/run.sh
+++ b/test-suite/coq-makefile/expand-directories/run.sh
@@ -8,11 +8,18 @@ find . -maxdepth 1 -not -name . -not -name _test -exec cp -r '{}' -t _test ';'
 
 cd _test || exit 1
 
-# includes 6 file extensions, ignores others such as .c, .vo
 # recursive expansion
 # explicit non-existent file included
-actual=`rocq makefile -sources-of -o CoqMakefile . nonexistent.v`
-expected="a/b/g.v a/g.mlg a/g.mllib a/g.mlpack g.ml g.mli nonexistent.v"
+actual=`rocq makefile -sources-of .v -o CoqMakefile . nonexistent.v`
+expected="a/b/g.v nonexistent.v"
+if [ "$actual" != "$expected" ]; then
+  echo actual: $actual
+  echo expected: $expected
+  exit 1
+fi
+
+actual=`rocq makefile -sources-of .mli -o CoqMakefile . nonexistent.v`
+expected="a/g.mli g.mli"
 if [ "$actual" != "$expected" ]; then
   echo actual: $actual
   echo expected: $expected
@@ -20,8 +27,8 @@ if [ "$actual" != "$expected" ]; then
 fi
 
 # expands specific directory, not ., gets the right subset
-actual=`rocq makefile -sources-of -o CoqMakefile a`
-expected="a/b/g.v a/g.mlg a/g.mllib a/g.mlpack"
+actual=`rocq makefile -sources-of .mli -o CoqMakefile a`
+expected="a/g.mli"
 if [ "$actual" != "$expected" ]; then
   echo actual: $actual
   echo expected: $expected
diff --git a/test-suite/coq-makefile/expand-directories2/run.sh b/test-suite/coq-makefile/expand-directories2/run.sh
index d6ab06fb1dbe..eacc8fdacd99 100644
--- a/test-suite/coq-makefile/expand-directories2/run.sh
+++ b/test-suite/coq-makefile/expand-directories2/run.sh
@@ -10,7 +10,7 @@ cd _test || exit 1
 
 # check cmd line arg is included in coqdep
 # preserves order of args (cmd line args last)
-actual=$(rocq makefile -sources-of -f _CoqProject -o CoqMakefile b.v)
+actual=$(rocq makefile -sources-of .v -f _CoqProject -o CoqMakefile b.v)
 expected="x/a.v b.v"
 if [ "$actual" != "$expected" ]; then
   echo actual: $actual
diff --git a/test-suite/coq-makefile/findlib-local/META.rocq-runtime b/test-suite/coq-makefile/findlib-local/META.rocq-runtime
index e44a1fd8d173..3519ea3c5347 100644
--- a/test-suite/coq-makefile/findlib-local/META.rocq-runtime
+++ b/test-suite/coq-makefile/findlib-local/META.rocq-runtime
@@ -10,3 +10,13 @@ plugin(byte) = "fake.cma"
 plugin(native) = "fake.cmxs"
 )
 )
+package "toplevel" (
+  directory = "toplevel"
+  version = "dev"
+  description = "Rocq's Interactive Shell [terminal-based]"
+  requires = "zarith"
+  archive(byte) = "toplevel.cma"
+  archive(native) = "toplevel.cmxa"
+  plugin(byte) = "toplevel.cma"
+  plugin(native) = "toplevel.cmxs"
+)
diff --git a/test-suite/coqdoc/Context.myst.out b/test-suite/coqdoc/Context.myst.out
new file mode 100644
index 000000000000..6092bb9cbef5
--- /dev/null
+++ b/test-suite/coqdoc/Context.myst.out
@@ -0,0 +1,6 @@
+```{coq}
+Section Sec.
+Context (foo : nat).
+Check foo.
+End Sec.
+```
diff --git a/test-suite/coqdoc/Record.myst.out b/test-suite/coqdoc/Record.myst.out
new file mode 100644
index 000000000000..2072836ab368
--- /dev/null
+++ b/test-suite/coqdoc/Record.myst.out
@@ -0,0 +1,4 @@
+```{coq}
+Record a := { b : nat ; c : bool }.
+Definition d := {| b := 0 ; c := true |}.
+```
diff --git a/test-suite/coqdoc/binder.myst.out b/test-suite/coqdoc/binder.myst.out
new file mode 100644
index 000000000000..0c84fa3ebd7d
--- /dev/null
+++ b/test-suite/coqdoc/binder.myst.out
@@ -0,0 +1,7 @@
+```{coq}
+```
+Link binders 
+```{coq}
+
+Definition foo alpha beta := alpha + beta.
+```
diff --git a/test-suite/coqdoc/bug11194.myst.out b/test-suite/coqdoc/bug11194.myst.out
new file mode 100644
index 000000000000..c8bc768a5422
--- /dev/null
+++ b/test-suite/coqdoc/bug11194.myst.out
@@ -0,0 +1,7 @@
+```{coq}
+Record a_struct := { anum : nat }.
+Canonical Structure a_struct_0 := {| anum := 0|}.
+Definition rename_a_s_0 := a_struct_0.
+Coercion some_nat := (@Some nat).
+Definition rename_some_nat := some_nat.
+```
diff --git a/test-suite/coqdoc/bug11353.myst.out b/test-suite/coqdoc/bug11353.myst.out
new file mode 100644
index 000000000000..b9d689ced8e3
--- /dev/null
+++ b/test-suite/coqdoc/bug11353.myst.out
@@ -0,0 +1,8 @@
+```{coq}
+Definition a := 0. #[   universes( template) ]
+Inductive mysum (A B:Type) : Type :=
+  | myinl : A -> mysum A B
+  | myinr : B -> mysum A B.
+
+#[local]Definition b := 1.
+```
diff --git a/test-suite/coqdoc/bug12742.myst.out b/test-suite/coqdoc/bug12742.myst.out
new file mode 100644
index 000000000000..0646be67f1fd
--- /dev/null
+++ b/test-suite/coqdoc/bug12742.myst.out
@@ -0,0 +1,26 @@
+```{coq}
+```
+Xxx xxxx xx xxxxx xxxxxxx xxxxx xxx xxxxxxxx xxxxxxx xxx xxx xxxx
+     xxxxxxxxxxxxxx: XX xxx xxxx xxxx xxxxxxxxx xxxxxxxxxxxxx xx xxxxx.
+     Xxx xx xxxxx xxx xxxx xxx xxxxxxxxxxx xx xxxxxxxx xxxxx xxx
+     xxxxxxx xxxxxxxxx xxxxxx xx xxxxxxx xxxxxxxxxxxx.  Xxxxx xxxxx
+     xxxx xxxx xxx xxxxx xxxxxxxxxx:
+
+
+- _Xxxxxxxxx xxxxxxx xxxxxxx_ xxxxxxx "xxxx-xxxxxx" xxxxxxxxx:
+          xxx xxxx xxxx x xxxxxxxxxxx xxx xxxx xxxxxx xxxxxx _xxxx_ xx
+          _xxxxx_ (xx, xxxxxxxxx, _xxx'x xxxx: xxx xxx xx xxxx_).
+          Xxxxxxxx xxxxx xxxxxxxxxxxx xxx xxxxx xxxxxxx xx xxxxxxxx
+          xxxxxxx, xxxx xxxx xxxxxxx xxxxxxxxxxxx xx xxxxxx xxxxx xxx
+          xxx xxxx xxx xx x xxxxxxxxx xx xxxxxxxx.  Xxxxxxxx xx xxxx
+          xxxxx xxxxxxx XXX xxxxxxx, XXX xxxxxxx, xxx xxxxx xxxxxxxx.
+
+
+- _Xxxxx xxxxxxxxxx_ xxx xxxxxx xxxxx xxxx xxxxxxxx xxx xxxx
+          xxxxxxx xxxxxxx xx xxxxxxxx xxxxxx xxxxx xxxxxxxxx xx xxxxx
+          xxxxxxxx xxx xxxx xxxxxxxxx xxxxxxx.  Xxxxxx xxxx xxxxx
+          xxxxxxxxxx xxxxxxx Xxxxxxxx, Xxxx, Xxxxx, XXXx, XXX, xxx Xxx,
+          xxxxx xxxx xxxxxx.
+
+```{coq}
+```
diff --git a/test-suite/coqdoc/bug5648.myst.out b/test-suite/coqdoc/bug5648.myst.out
new file mode 100644
index 000000000000..b674363f5a28
--- /dev/null
+++ b/test-suite/coqdoc/bug5648.myst.out
@@ -0,0 +1,21 @@
+```{coq}
+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.myst.out b/test-suite/coqdoc/bug5700.myst.out
new file mode 100644
index 000000000000..8c5d33f2a685
--- /dev/null
+++ b/test-suite/coqdoc/bug5700.myst.out
@@ -0,0 +1,11 @@
+```{coq}
+```
+` foo (* {bar_bar} *) ` 
+```{coq}
+Definition const1 := 1.
+
+```
+` more (* nested (* comments *) within verbatim *) ` 
+```{coq}
+Definition const2 := 2.
+```
diff --git a/test-suite/coqdoc/details.myst.out b/test-suite/coqdoc/details.myst.out
new file mode 100644
index 000000000000..b403a1200a23
--- /dev/null
+++ b/test-suite/coqdoc/details.myst.out
@@ -0,0 +1,23 @@
+```{coq}
+```
+:::{dropdown}
+```{coq}
+Definition foo : nat := 3.
+```
+
+:::
+```{coq}
+
+```
+:::{dropdown} Foo bar 
+```{coq}
+Fixpoint idnat (x : nat) : nat :=
+  match x with
+  | S x => S (idnat x)
+  | 0 => 0
+  end.
+```
+
+:::
+```{coq}
+```
diff --git a/test-suite/coqdoc/links.myst.out b/test-suite/coqdoc/links.myst.out
new file mode 100644
index 000000000000..64bfe3921993
--- /dev/null
+++ b/test-suite/coqdoc/links.myst.out
@@ -0,0 +1,106 @@
+```{coq}
+```
+Various checks for coqdoc
+
+
+- symbols should not be inlined in string g
+- links to both kinds of notations in a' should work to the right notation
+- with utf8 option, forall must be unicode
+- splitting between symbols and ident should be correct in a' and c
+- ".." should be rendered correctly
+
+```{coq}
+
+Definition a (b: nat) := b.
+
+Definition f := forall C:Prop, C.
+
+Notation "n ++ m" := (plus n m).
+
+Notation "n ++ m" := (mult n m). 
+Notation "n ** m" := (plus n m) (at level 60).
+
+Notation "n ▵ m" := (plus n m) (at level 60).
+
+Notation "n '_' ++ 'x' m" := (plus n m) (at level 3).
+
+Inductive eq (A:Type) (x:A) : A -> Prop := eq_refl : x = x :>A
+
+where "x = y :> A" := (@eq A x y) : type_scope.
+
+Definition eq0 := 0 = 0 :> nat.
+
+Notation "( x # y ; .. ; z )" := (pair .. (pair x y) .. z).
+
+Definition b_α := ((0#0;0) , (0 ** 0)).
+
+Notation h := a.
+
+  Section test.
+
+    Variables b' b2: nat.
+
+    Notation "n + m" := (n ▵ m) : my_scope.
+
+    Delimit Scope my_scope with my.
+
+    Notation l := 0.
+
+    Definition α := (0 + l)%my.
+
+    Definition a' b := b'++0++b2 _ ++x b.
+
+    Definition c := {True}+{True}.
+
+    Definition d := (1+2)%nat.
+
+    Lemma e : nat + nat.
+    Admitted.
+
+  End test.
+
+  Section test2.
+
+    Variables b': nat.
+
+    Section test.
+
+      Variables b2: nat.
+
+      Definition a'' b := b' ++ O ++ b2 _ ++ x b + h 0.
+
+    End test.
+
+  End test2.
+
+```
+skip 
+
+ skip 
+
+ skip 
+
+ skip 
+
+ skip 
+
+ skip 
+
+ skip 
+
+ skip 
+
+ skip 
+
+ skip 
+
+ skip 
+
+ skip 
+
+ skip 
+
+ skip 
+```{coq}
+
+```
diff --git a/test-suite/coqdoc/multiple_links.myst.out b/test-suite/coqdoc/multiple_links.myst.out
new file mode 100644
index 000000000000..a346612b746a
--- /dev/null
+++ b/test-suite/coqdoc/multiple_links.myst.out
@@ -0,0 +1,5 @@
+```{coq}
+Inductive t := X | T : t -> t.
+Check X.
+Check t.
+Check t_ind. ```
diff --git a/test-suite/coqdoc/reference.html.out b/test-suite/coqdoc/reference.html.out
new file mode 100644
index 000000000000..dc3e158dbb84
--- /dev/null
+++ b/test-suite/coqdoc/reference.html.out
@@ -0,0 +1,140 @@
+
+
+
+
+
+Coqdoc.reference
+
+
+
+
+

+
+
+
+

+
+
Library Coqdoc.reference

+
+

+

+
+

+This is a reference file that tests most of rocq doc's features. 
+
 

+
+
Here's a heading

+
+
+
 

+
+    The number of asterisks in front of the heading determine the level of the
+    heading. For example: 
+
 

+
+
Here's a subheading

+
Here's a subsubheading

+
Here's the lowest possible heading

+
+
 

+
+ Rocq doc comments are placed between (**  and *) . Contrary to regular
+    comments, the comment starts with two asterisks instead of one.
+
+
 

+
+    Above, we have used angle brackets to present verbatim material. Verbatim material
+    can also take multiple lines:
+
+    let rec fact n =
+      if n <= 1 then 1 else n * fact (n - 1)
+

+
+
 

+
+ Rocq material can be quoted inline using square brackets, as follows: ∀ n : nat, fact n ≥ n.
+    For vernacular material, we double the square brackets, and place them on separate lines, like so:
+    

+    From Stdlib Require Import Lia.

+    
+
 

+
+
+
 

+
+ Let's implement the fact OCaml function in Rocq! 
+

+

+
+

+Fixpoint fact (n : nat) : nat :=

+  match n with

+  | 0 ⇒ 1

+  | S n' ⇒

+      

+      n × fact n'

+  end.

+
+

+

+
+

+Here's the rest of the formatting rules:
+
    
+
  •  To emphasize text, place it between underscores, like so.
+
+
    • 
+
  •  To insert LaTeX math:
+
      
+
    •  Use dollar signs for LaTeX in math mode: 
+
+
      • 
+
    •  Use percent signs for other LaTeX materials: 
+
+
      • 
+
    
+
+
    • 
+

+
+
 

+
+    To create (nested) lists, use bullets, as we have done above! 
+
 

+
+

+ 
+
 

+
+ Finally, some parts of the code can be hidden from the output, or placed in a dropdown. 
+

+

+
+

+
+

+

+

+Definition this_definition_is_in_a_dropdown : unit := tt.

+

+

+
+

+

+
Some summary 

+Definition this_definition_is_in_a_dropdown_with_a_summary : unit := tt.

+

+

+

+

+
+
+
+

+
+
+
\ No newline at end of file
diff --git a/test-suite/coqdoc/reference.myst.out b/test-suite/coqdoc/reference.myst.out
new file mode 100644
index 000000000000..3ed84af219f6
--- /dev/null
+++ b/test-suite/coqdoc/reference.myst.out
@@ -0,0 +1,84 @@
+```{coq}
+```
+This is a reference file that tests most of rocq doc's features. 
+
+# Here's a heading
+
+
+
+    The number of asterisks in front of the heading determine the level of the
+    heading. For example: 
+
+## Here's a subheading
+### Here's a subsubheading
+#### Here's the lowest possible heading
+
+
+ Rocq doc comments are placed between `(** ` and `*) `. Contrary to regular
+    comments, the comment starts with two asterisks instead of one.
+
+
+    Above, we have used angle brackets to present verbatim material. Verbatim material
+    can also take multiple lines:
+```
+    let rec fact n =
+      if n <= 1 then 1 else n * fact (n - 1)
+```
+
+
+ Rocq material can be quoted inline using square brackets, as follows: `forall` `n` `:` `nat,` `fact` `n` `>=` `n`.
+    For vernacular material, we double the square brackets, and place them on separate lines, like so:
+    
+```coq
+    From Stdlib Require Import Lia.
+    
+
+```
+
+ Let's implement the `fact` OCaml function in Rocq! 
+```{coq}
+
+Fixpoint fact (n : nat) : nat :=
+  match n with
+  | 0 => 1
+  | S n' =>
+      
+      n * fact n'
+  end.
+
+```
+Here's the rest of the formatting rules:
+- To emphasize text, place it between underscores, _like so_.
+- To insert LaTeX math:
+  * Use dollar signs for LaTeX in math mode: {math}`e = mc^2`
+  * Use percent signs for other LaTeX materials: \usepackage{coqdoc}
+
+
+    To create (nested) lists, use bullets, as we have done above! 
+
+
+---
+ 
+
+ Finally, some parts of the code can be hidden from the output, or placed in a dropdown. 
+```{coq}
+
+
+```
+:::{dropdown}
+```{coq}
+Definition this_definition_is_in_a_dropdown : unit := tt.
+```
+
+:::
+```{coq}
+
+```
+:::{dropdown} Some summary 
+```{coq}
+Definition this_definition_is_in_a_dropdown_with_a_summary : unit := tt.
+```
+
+:::
+```{coq}
+```
diff --git a/test-suite/coqdoc/reference.tex.out b/test-suite/coqdoc/reference.tex.out
new file mode 100644
index 000000000000..c7804d7233ce
--- /dev/null
+++ b/test-suite/coqdoc/reference.tex.out
@@ -0,0 +1,125 @@
+\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.reference}{Library }{Coqdoc.reference}
+
+\begin{coqdoccode}
+\end{coqdoccode}
+This is a reference file that tests most of rocq doc's features. 
+
+\section{Here's a heading}
+
+
+
+
+    The number of asterisks in front of the heading determine the level of the
+    heading. For example: 
+
+\subsection{Here's a subheading}
+
+\subsubsection{Here's a subsubheading}
+
+\paragraph{Here's the lowest possible heading}
+
+
+
+ Rocq doc comments are placed between \texttt{(** } and \texttt{*) }. Contrary to regular
+    comments, the comment starts with two asterisks instead of one.
+
+
+    Above, we have used angle brackets to present verbatim material. Verbatim material
+    can also take multiple lines:
+\begin{verbatim}
+    let rec fact n =
+      if n <= 1 then 1 else n * fact (n - 1)
+\end{verbatim}
+
+
+ Rocq material can be quoted inline using square brackets, as follows: \coqdockw{\ensuremath{\forall}} \coqdocvar{n} : \coqdocvar{nat}, \coqdocvar{fact} \coqdocvar{n} \ensuremath{\ge} \coqdocvar{n}.
+    For vernacular material, we double the square brackets, and place them on separate lines, like so:
+    \coqdoceol
+\coqdocemptyline
+\coqdocindent{2.00em}
+\coqdockw{From} \coqdocvar{Stdlib} \coqdockw{Require} \coqdockw{Import} \coqdocvar{Lia}.\coqdoceol
+\coqdocindent{2.00em}
+
+
+\coqdocemptyline
+
+
+ Let's implement the \coqdocvar{fact} OCaml function in Rocq! 
+\begin{coqdoccode}
+\coqdocemptyline
+\coqdocnoindent
+\coqdockw{Fixpoint} \coqdef{Coqdoc.reference.fact}{fact}{\coqdocdefinition{fact}} (\coqdef{Coqdoc.reference.n:1}{n}{\coqdocbinder{n}} : \coqexternalref{nat}{http://coq.inria.fr/stdlib/Corelib.Init.Datatypes}{\coqdocinductive{nat}}) : \coqexternalref{nat}{http://coq.inria.fr/stdlib/Corelib.Init.Datatypes}{\coqdocinductive{nat}} :=\coqdoceol
+\coqdocindent{1.00em}
+\coqdockw{match} \coqref{Coqdoc.reference.n:1}{\coqdocvariable{n}} \coqdockw{with}\coqdoceol
+\coqdocindent{1.00em}
+\ensuremath{|} 0 \ensuremath{\Rightarrow} 1\coqdoceol
+\coqdocindent{1.00em}
+\ensuremath{|} \coqexternalref{S}{http://coq.inria.fr/stdlib/Corelib.Init.Datatypes}{\coqdocconstructor{S}} \coqdocvar{n'} \ensuremath{\Rightarrow}\coqdoceol
+\coqdocindent{3.00em}
+\coqdoceol
+\coqdocindent{3.00em}
+\coqref{Coqdoc.reference.n:1}{\coqdocvariable{n}} \coqexternalref{::nat scope:x '*' x}{http://coq.inria.fr/stdlib/Corelib.Init.Peano}{\coqdocnotation{\ensuremath{\times}}} \coqref{Coqdoc.reference.fact:2}{\coqdocdefinition{fact}} \coqdocvar{n'}\coqdoceol
+\coqdocindent{1.00em}
+\coqdockw{end}.\coqdoceol
+\coqdocemptyline
+\end{coqdoccode}
+Here's the rest of the formatting rules:
+
+\begin{itemize}
+\item  To emphasize text, place it between underscores, \textit{like so}.
+
+\item  To insert LaTeX math:
+
+\begin{itemize}
+\item  Use dollar signs for LaTeX in math mode: $e = mc^2$
+
+\item  Use percent signs for other LaTeX materials: \usepackage{coqdoc}
+
+\end{itemize}
+
+\end{itemize}
+
+
+    To create (nested) lists, use bullets, as we have done above! 
+
+\par
+\noindent\hrulefill\par
+\noindent{} 
+
+ Finally, some parts of the code can be hidden from the output, or placed in a dropdown. 
+\begin{coqdoccode}
+\coqdocemptyline
+\coqdocemptyline
+\end{coqdoccode}
+\begin{coqdoccode}
+\coqdocnoindent
+\coqdockw{Definition} \coqdef{Coqdoc.reference.this definition is in a dropdown}{this\_definition\_is\_in\_a\_dropdown}{\coqdocdefinition{this\_definition\_is\_in\_a\_dropdown}} : \coqexternalref{unit}{http://coq.inria.fr/stdlib/Corelib.Init.Datatypes}{\coqdocinductive{unit}} := \coqexternalref{tt}{http://coq.inria.fr/stdlib/Corelib.Init.Datatypes}{\coqdocconstructor{tt}}.\coqdoceol
+\end{coqdoccode}
+\begin{coqdoccode}
+\coqdocemptyline
+\end{coqdoccode}
+\begin{coqdoccode}
+\coqdocnoindent
+\coqdockw{Definition} \coqdef{Coqdoc.reference.this definition is in a dropdown with a summary}{this\_definition\_is\_in\_a\_dropdown\_with\_a\_summary}{\coqdocdefinition{this\_definition\_is\_in\_a\_dropdown\_with\_a\_summary}} : \coqexternalref{unit}{http://coq.inria.fr/stdlib/Corelib.Init.Datatypes}{\coqdocinductive{unit}} := \coqexternalref{tt}{http://coq.inria.fr/stdlib/Corelib.Init.Datatypes}{\coqdocconstructor{tt}}.\coqdoceol
+\end{coqdoccode}
+\begin{coqdoccode}
+\end{coqdoccode}
+\end{document}
diff --git a/test-suite/coqdoc/reference.v b/test-suite/coqdoc/reference.v
new file mode 100644
index 000000000000..33a67491f4ca
--- /dev/null
+++ b/test-suite/coqdoc/reference.v
@@ -0,0 +1,62 @@
+(** This is a reference file that tests most of rocq doc's features. *)
+
+(** * Here's a heading
+
+    The number of asterisks in front of the heading determine the level of the
+    heading. For example: *)
+
+(** ** Here's a subheading *)
+(** *** Here's a subsubheading *)
+(** **** Here's the lowest possible heading *)
+
+(** Rocq doc comments are placed between << (** >> and << *) >>. Contrary to regular
+    comments, the comment starts with two asterisks instead of one.
+
+    Above, we have used angle brackets to present verbatim material. Verbatim material
+    can also take multiple lines:
+<<
+    let rec fact n =
+      if n <= 1 then 1 else n * fact (n - 1)
+>>
+*)
+
+(** Rocq material can be quoted inline using square brackets, as follows: [forall n : nat, fact n >= n].
+    For vernacular material, we double the square brackets, and place them on separate lines, like so:
+    [[
+    From Stdlib Require Import Lia.
+    ]]
+*)
+
+(** Let's implement the [fact] OCaml function in Rocq! *)
+
+Fixpoint fact (n : nat) : nat :=
+  match n with
+  | 0 => 1
+  | S n' =>
+      (* This is a regular comment. *)
+      n * fact n'
+  end.
+
+(** Here's the rest of the formatting rules:
+    - To emphasize text, place it between underscores, _like so_.
+    - To insert LaTeX math:
+      - Use dollar signs for LaTeX in math mode: $e = mc^2$
+      - Use percent signs for other LaTeX materials: %\usepackage{coqdoc}%
+
+    To create (nested) lists, use bullets, as we have done above! *)
+
+(** ---- *)
+
+(** Finally, some parts of the code can be hidden from the output, or placed in a dropdown. *)
+
+(* begin hide *)
+Definition this_definition_will_not_appear : unit := tt.
+(* end hide *)
+
+(* begin details *)
+Definition this_definition_is_in_a_dropdown : unit := tt.
+(* end details *)
+
+(* begin details : Some summary *)
+Definition this_definition_is_in_a_dropdown_with_a_summary : unit := tt.
+(* end details *)
diff --git a/test-suite/coqdoc/typeclasses.myst.out b/test-suite/coqdoc/typeclasses.myst.out
new file mode 100644
index 000000000000..fc57577e67d0
--- /dev/null
+++ b/test-suite/coqdoc/typeclasses.myst.out
@@ -0,0 +1,13 @@
+```{coq}
+Class EqDec T := { eqb : T -> T -> bool }.
+
+Section TC.
+
+#[local] Instance unit_EqDec : EqDec unit := { eqb := fun _ _ => true }.
+
+End TC.
+
+#[local] Existing Instance unit_EqDec.
+
+Existing Class EqDec.
+```
diff --git a/test-suite/coqdoc/verbatim.myst.out b/test-suite/coqdoc/verbatim.myst.out
new file mode 100644
index 000000000000..81506490f7b3
--- /dev/null
+++ b/test-suite/coqdoc/verbatim.myst.out
@@ -0,0 +1,52 @@
+```{coq}
+```
+
+
+```
+uint32_t shift_right( uint32_t a, uint32_t shift )
+{
+    return a >> shift;
+}
+```
+
+
+This line and the following shows `verbatim ` text:
+
+
+` A stand-alone inline verbatim `
+
+
+` A non-ended inline verbatim to test line location
+`
+
+
+- item 1
+- item 2 is `verbatim`
+- item 3 is `verbatim` too
+
+```coq
+A coq block : forall n, n = 0
+
+```- `verbatim` again, and a formula `` `True` `->` `False` ``
+-
+```
+multiline
+verbatim
+```
+- last item
+
+
+```
+Γ ⊢ A
+----
+Γ ⊢ A ∨ B
+```
+
+
+```
+A non-ended block verbatim to test line location
+
+*)
+```
+```{coq}
+```
diff --git a/test-suite/coqwc/tactic-named-proof.out b/test-suite/coqwc/tactic-named-proof.out
new file mode 100644
index 000000000000..c49a6cdaa7a4
--- /dev/null
+++ b/test-suite/coqwc/tactic-named-proof.out
@@ -0,0 +1,2 @@
+     spec    proof comments
+        2       10        2 coqwc/tactic-named-proof.v
diff --git a/test-suite/coqwc/tactic-named-proof.v b/test-suite/coqwc/tactic-named-proof.v
new file mode 100644
index 000000000000..39c0acab239c
--- /dev/null
+++ b/test-suite/coqwc/tactic-named-proof.v
@@ -0,0 +1,14 @@
+  Lemma inv_acc_strong E N P :
+    ↑N ⊆ E → inv N P ={E,E∖↑N}=∗ ▷ P ∗ ∀ E', ▷ P ={E',↑N ∪ E'}=∗ True.
+  Proof.
+    iIntros (?) "Hinv".
+    (* `rocq wc` got confused by tactics like these, ending in "Proof" *)
+    iPoseProof (inv_acc (↑ N) N with "Hinv") as "H"; first done.
+    rewrite difference_diag_L.
+    iPoseProof (fupd_mask_frame_r _ _ (E ∖ ↑ N) with "H") as "H"; first set_solver.
+    rewrite left_id_L -union_difference_L //. iMod "H" as "[$ H]"; iModIntro.
+    iIntros (E') "HP".
+    (* also works with non-ascii names: *)
+    iPoseΔProof (fupd_mask_frame_r _ _ E' with "(H HP)") as "H"; first set_solver.
+    by rewrite left_id_L.
+  Qed.
diff --git a/test-suite/dune b/test-suite/dune
index d6bd66718e93..eacf93cb714c 100644
--- a/test-suite/dune
+++ b/test-suite/dune
@@ -9,7 +9,8 @@
 
 (rule
  (targets test_suite_config.inc)
- (action (with-stdout-to %{targets} (run tools/coq_config_to_make.exe %{bin:coqc}))))
+ (mode (promote (until-clean)))
+ (action (with-stdout-to %{targets} (run tools/coq_config_to_make.exe %{bin:rocq}))))
 
 (rule
  (targets summary.log)
diff --git a/test-suite/ide/reopen1.fake b/test-suite/ide/reopen1.fake
index b0618c770ad7..4ba3cc25b6e8 100644
--- a/test-suite/ide/reopen1.fake
+++ b/test-suite/ide/reopen1.fake
@@ -14,7 +14,7 @@ EDIT_AT here
 ADD here2 { Proof. }
 ADD here3 { Qed. }
 WAIT
-EDIT_AT here2
+EDIT_AT here
 # Fixing the proof
 ADD { Proof. }
 ADD { trivial. }
diff --git a/test-suite/ltac2/operator_notations.v b/test-suite/ltac2/operator_notations.v
new file mode 100644
index 000000000000..093d138cd511
--- /dev/null
+++ b/test-suite/ltac2/operator_notations.v
@@ -0,0 +1,85 @@
+Require Import Ltac2.Ltac2.
+
+(* Associativity *)
+Ltac2 Type a.
+Ltac2 Type b.
+Ltac2 Type rec c := { p : c }.
+Ltac2 Type ('x,'y) h := { h : 'y -> 'x }.
+
+(** Associativity *)
+
+(* Sanity check: the term does not typecheck when wrongly associated. *)
+Fail Ltac2 test_app_assoc_fail (f : b -> a) (g : c -> b) (c : c) :=
+  (f @@ g) c.
+Succeed Ltac2 test_app_assoc_1 (f : b -> a) (g : c -> b) (c : c) :=
+  f @@ g c.
+Succeed Ltac2 test_app_assoc_2 (f : b -> a) (g : c -> b) (c : c) :=
+  f @@ (g c).
+Succeed Ltac2 test_app_assoc_3 (f : b -> a) (g : c -> b) (c : c) :=
+  f @@ g @@ c.
+Succeed Ltac2 test_app_assoc_4 (f : b -> a) (g : c -> b) (c : c) :=
+  f @@ (g @@ c).
+
+(* Sanity check: the term does not typecheck when wrongly associated. *)
+Fail Ltac2 test_pipe_assoc_fail (f : b -> a) (g : c -> b) (c : c) :=
+  c |> (g |> f).
+Succeed Ltac2 test_pipe_assoc_1 (f : b -> a) (g : c -> b) (c : c) :=
+  c |> g |> f.
+Succeed Ltac2 test_pipe_assoc_2 (f : b -> a) (g : c -> b) (c : c) :=
+  (c |> g) |> f.
+
+(** Precedence *)
+(* Sanity check: the term does not typecheck when the notation level is wrong
+   w.r.t. the level of projections. *)
+Fail Ltac2 test_app_prec_fail (f : b -> a) (g : c -> b) (c : c) :=
+  (f @@ g @@ c).(p).
+Ltac2 test_app_prec_1 (f : b -> a) (g : c -> b) (c : c) :=
+  f @@ g @@ c.(p).
+Ltac2 test_app_prec_2 (f : (a,b) h) (g : c -> b) (c : c) :=
+  f.(h) @@ g @@ c.
+Ltac2 test_app_prec_3 (f : b -> a) (g : (b,c) h) (c : c) :=
+  f @@ g.(h) @@ c.
+
+Ltac2 test_app_prec_if (g : c -> b) (c : c) :=
+  if true then g @@ c else g @@ c.
+
+(* Sanity check: the term does not typecheck when the notation level is wrong
+   w.r.t. the level of projections. *)
+Fail Ltac2 test_pip_prec_fail (f : (a,b) h) (g : c -> b) (c : c) :=
+  (c |> g |> f).(h).
+Ltac2 test_pip_prec_1 (f : (a,b) h) (g : c -> b) (c : c) :=
+  c |> g |> f.(h).
+Ltac2 test_pipe_prec_2 (f : b -> a) (g : (b,c) h) (c : c) :=
+  c |> g.(h) |> f.
+Ltac2 test_pipe_prec_3 (f : (a,b) h) (g : (b,c) h) (c : c) :=
+  c |> g.(h) |> f.(h).
+Ltac2 test_pipe_prec_4 (f : (a,b) h) (g : (b,c) h) (c : c) :=
+  c.(p) |> g.(h) |> f.(h).
+
+Ltac2 test_pipe_prec_if (g : c -> b) (c : c) :=
+  if true then c |> g else c |> g.
+
+Ltac2 test_app_pipe_2 (f : b -> a) (g : c -> b) (c : c) :=
+  g @@ c |> f.
+
+Fail Ltac2 test_app_pipe_fail (f : b -> a) (g : c -> b) (c : c) :=
+  f @@ c |> g.
+
+Ltac2 test_pipe_app_1 (t : b -> c -> a) (b : b) (c : c) :=
+  c |> t @@ b.
+
+(** Relation to other operators at levels 2 and 3 *)
+
+Ltac2 test_app_comma_left (g : c -> b) (c : c) (a : a) : b * a := g @@ c, a.
+Ltac2 test_app_comma_right (g : c -> b) (c : c) (a : a) : a * b := a, g @@ c.
+
+Ltac2 test_pipe_comma_left (g : c -> b) (c : c) (a : a) : b * a := c |> g, a.
+(* [test_pipe_comma_right] is accepted by OCaml. *)
+Fail Ltac2 test_pipe_comma_right (g : c -> b) (c : c) (a : a) : a * b := a, c |> g.
+
+Ltac2 test_app_cons_left (g : c list -> b) (c : c) : b := g @@ c :: [].
+(* [test_app_cons_right] is not accepted by OCaml without parentheses around [g @@ c]. *)
+Ltac2 test_app_cons_right (g : c -> b list) (b : b) (c : c) : b list := b :: g @@ c.
+
+Fail Ltac2 test_pipe_cons_left (g : c list -> b) (c : c) : b := c |> g :: [].
+Ltac2 test_pipe_cons_right (g : c list -> b) (cs : c list) (c : c) : b := c :: cs |> g.
diff --git a/test-suite/ltac2/reorder_goals.v b/test-suite/ltac2/reorder_goals.v
new file mode 100644
index 000000000000..4740f2595c9c
--- /dev/null
+++ b/test-suite/ltac2/reorder_goals.v
@@ -0,0 +1,21 @@
+Require Import Ltac2.Ltac2.
+
+Axiom P : nat -> Prop.
+Axiom p : forall n, P n.
+
+Goal P 1 /\ P 2 /\ P 3 /\ P 4.
+Proof.
+  repeat split.
+  Fail 1:exact (p 3). (* sanity check: "exact (p n)" assert that the goal was originally goal n *)
+  all:Control.reorder_goals [1;3;4;2].
+  4: exact (p 2).
+  Fail all:Control.reorder_goals [1;2]. (* missing goal 3 *)
+  Fail all:Control.reorder_goals [1;2;3;3]. (* duplicated goal 3 *)
+  Fail all:Control.reorder_goals [1;4;3]. (* non existing goal 4 *)
+  all:Control.reorder_goals [3;2;1];
+    Control.dispatch [
+        (fun () => exact (p 4));
+        (fun () => exact (p 3));
+        (fun () => exact (p 1))
+      ].
+Qed.
diff --git a/test-suite/ltac2/rewrite_strat.v b/test-suite/ltac2/rewrite_strat.v
index 7efa9d69b395..2e8a30a16efa 100644
--- a/test-suite/ltac2/rewrite_strat.v
+++ b/test-suite/ltac2/rewrite_strat.v
@@ -156,3 +156,113 @@ Goal (forall x, S x = 0) -> 1 = 0.
 intro H.
 my_rewrite_strat H.
 Abort.
+
+From Ltac2 Require Import Ltac2 Rewrite.
+From Ltac2 Require Import Message.
+Ltac2 msg x := print (of_string x).
+
+Module StratLtac2Matches.
+
+  Import Strategy.
+
+  (* Heavy computation if unfolded at any point during unification *)
+  Definition foo (n : nat) :=
+    Nat.pow 2 n.
+
+  Ltac2 rew_match carrier lhs _rel :=
+   let rhs := Std.eval (Std.Red.vm None) lhs in
+   Success {rel := '(@eq $carrier); rhs; prf := '(@eq_refl $carrier $rhs) }.
+
+  Goal foo (200 + 200) = foo 400.
+  Proof.
+    rewrite_strat (bottomup (seq (matches pat:(Nat.add _ _)) (tactic rew_match))) None.
+    match! goal with
+    | [ |- foo 400 = foo 400 ] => id
+    end.
+    reflexivity.
+  Qed.
+End StratLtac2Matches.
+
+Module StratLtac2Tactic.
+  Import Strategy.
+
+  Ltac2 is_closed_add t :=
+    match! t with
+    | Nat.add _ _ => true
+    | _ => false
+    end.
+
+  Ltac2 reduce_fo_ind_value carrier lhs _rel :=
+    if Constr.equal carrier '(nat) then
+      if is_closed_add lhs then
+        let ty := Constr.type lhs in
+        let rhs := Std.eval (Std.Red.cbv RedFlags.all) lhs in
+        Rewrite.Strategy.Success { rel := '(@eq $ty); rhs := rhs; prf := '(@eq_refl $ty $rhs) }
+      else Fail
+    else Fail.
+
+  (* Heavy computation if unfolded at any point during unification *)
+  Definition foo (n : nat) :=
+    Nat.pow 2 n.
+
+  Ltac2 reduce_fo_ind cl :=
+    rewrite_strat (fix_ (fun s => choice (tactic reduce_fo_ind_value) (subterm s))) cl.
+
+  Lemma heavy : foo (2000 + 2000) = foo 4000.
+  Proof.
+    reduce_fo_ind None.
+    reflexivity.
+  Qed.
+
+  Axiom add_comm : forall (x y : nat), x + y = y + x.
+
+  (* We use a flag to rewrite with a lemma only once *)
+  Ltac2 Type flag := { mutable used : bool }.
+  Import List.
+  Ltac2 message_of_list f l :=
+    List.fold_right (fun x acc => Message.concat (f x) acc) l Message.empty.
+
+  Ltac2 of_hyps h :=
+    message_of_list
+      (fun (na, _, ty) =>
+         Message.concat Message.space
+           (Message.concat (of_ident na) (Message.concat (of_string " : ") (of_constr ty)))) h.
+
+  Import Printf.
+
+  Ltac2 rw_lemma fl lhs :=
+    if fl.(used) then Fail else
+      (let h := Control.hyps () in
+       let concl := Control.goal () in
+       printf "lhs = %t, goal = %m |- %t" lhs (of_hyps h) concl;
+    match! lhs with
+    | Nat.add ?l ?r =>
+        fl.(used) := true;
+        Strategy.Success { rel := '(@eq nat); rhs := '(Nat.add $r $l); prf := '(add_comm $l $r) }
+    | _ => Fail
+    end).
+
+  Ltac2 use_lemma_once () :=
+    let flag := { used := false } in
+    fun _carrier lhs _rel => rw_lemma flag lhs.
+
+  (* This example goes under binders to apply a rewrite only once *)
+  Lemma with_env (b : bool) : forall (v : nat), (v + 2) = S (S v).
+  Proof.
+    rewrite_strat (topdown (tactic (use_lemma_once ()))) None.
+    match! goal with
+    | [ |- forall v, (2 + v) = (S (S v)) ] => id
+    end.
+    now reflexivity.
+  Qed.
+
+  Ltac2 failing () :=
+    fun _carrier lhs _rel => exact tt; Strategy.Identity.
+
+  (* This example goes under binders to apply a rewrite only once *)
+  Lemma failure_test (b : bool) : forall (v : nat), (v + 2) = S (S v).
+  Proof.
+    Fail rewrite_strat (topdown (tactic (failing ()))) None.
+  Abort.
+
+End StratLtac2Tactic.
diff --git a/test-suite/ltac2/scheme_lookup.v b/test-suite/ltac2/scheme_lookup.v
new file mode 100644
index 000000000000..083732453fae
--- /dev/null
+++ b/test-suite/ltac2/scheme_lookup.v
@@ -0,0 +1,39 @@
+Require Import Ltac2.Ltac2.
+Require Import Ltac2.Option.
+
+(** Test Scheme.lookup *)
+
+Ltac2 Eval
+  let nat := Option.get (Env.get [@Corelib; @Init; @Datatypes; @nat]) in
+  (* nat should have a rect_dep scheme (i.e., nat_rect) *)
+  match Scheme.lookup Scheme.rect_dep nat with
+  | Some _ => ()
+  | None => Control.throw Not_found
+  end.
+
+Ltac2 Eval
+  let nat := Option.get (Env.get [@Corelib; @Init; @Datatypes; @nat]) in
+  (* nat should have an ind_dep scheme (i.e., nat_ind) *)
+  match Scheme.lookup Scheme.ind_dep nat with
+  | Some _ => ()
+  | None => Control.throw Not_found
+  end.
+
+Scheme nat_scase := Elimination for nat Sort SProp.
+Scheme nat_scase_nodep := Case for nat Sort SProp.
+
+Ltac2 Eval
+  let nat := Option.get (Env.get [@Corelib; @Init; @Datatypes; @nat]) in
+  (* nat should have an scase_dep scheme after explicit declaration *)
+  match Scheme.lookup Scheme.scase_dep nat with
+  | Some _ => ()
+  | None => Control.throw Not_found
+  end.
+
+Ltac2 Eval
+  let nat := Option.get (Env.get [@Corelib; @Init; @Datatypes; @nat]) in
+  (* nat should have an scase_nodep scheme after explicit declaration *)
+  match Scheme.lookup Scheme.scase_nodep nat with
+  | Some _ => ()
+  | None => Control.throw Not_found
+  end.
diff --git a/test-suite/ltac2/scoped_notations.v b/test-suite/ltac2/scoped_notations.v
new file mode 100644
index 000000000000..e09c53570ebf
--- /dev/null
+++ b/test-suite/ltac2/scoped_notations.v
@@ -0,0 +1,78 @@
+Require Import Ltac2.Ltac2.
+
+Ltac2 Declare Scope sc1.
+Ltac2 Declare Scope sc2.
+
+Ltac2 Notation "foo" x(constr) % sc1 := x.
+Ltac2 Notation "foo" y(open_constr) % sc2 := y.
+
+Ltac2 Notation "foo'" % sc1 := 0.
+Ltac2 Notation "foo'" % sc2 := 1.
+
+Fail Ltac2 testbad () := foo tt.
+Fail Ltac2 testbad' () := foo'.
+(* scopes not open *)
+
+Ltac2 Open Scope sc1.
+Ltac2 test1 () := foo _.
+Ltac2 test1' := foo'.
+
+Ltac2 Open Scope sc2.
+Ltac2 test2 () := foo _.
+Ltac2 test2' := foo'.
+
+Fail Ltac2 Eval test1().
+(* _ interpreted as constr *)
+
+Ltac2 Eval Control.assert_true (Int.equal test1' 0).
+
+Ltac2 Eval test2().
+
+Ltac2 Eval Control.assert_true (Int.equal test2' 1).
+
+Ltac2 Notation "bar" := foo _.
+
+Ltac2 Abbreviation bar' := foo'.
+
+Ltac2 Close Scope sc2.
+
+Fail Ltac2 Eval test1().
+Ltac2 Eval test2().
+Ltac2 Eval bar.
+
+(* interp of foo' in bar' was decided at time of declaration of bar', when sc2 was open *)
+Ltac2 Eval Control.assert_true (Int.equal bar' 1).
+
+(* another scope closing test *)
+Ltac2 Close Scope sc1.
+Fail Ltac2 Eval foo tt.
+
+(* we can also close the default scope *)
+Ltac2 Close Scope core.
+Fail Ltac2 Eval intros _.
+Ltac2 Open Scope core.
+
+(* constr delimiters are also controlled by scopes *)
+Ltac2 Notation "myconstr" x(constr(type)) % sc1 := x.
+Ltac2 Notation "myconstr" x(constr(nat)) % sc2 := x.
+
+Ltac2 Open Scope sc1.
+
+Ltac2 Eval myconstr (nat * nat).
+Fail Ltac2 Eval myconstr (0 * 0).
+
+Ltac2 Open Scope sc2.
+
+Fail Ltac2 Eval myconstr (nat * nat).
+Ltac2 Eval myconstr (0 * 0).
+
+(* notations with identical parsing in different custom entries don't interfere *)
+Ltac2 Custom Entry custom.
+
+Ltac2 Notation "custest" x(tactic(0)) := (Int.equal x 1).
+
+Ltac2 Eval Control.assert_true (custest 1).
+
+Ltac2 Notation "custest" x(tactic(0)) : custom(0) := (Int.equal x 2).
+
+Ltac2 Eval Control.assert_true (custest 1).
diff --git a/test-suite/ltac2/seq_notation.v b/test-suite/ltac2/seq_notation.v
new file mode 100644
index 000000000000..cd0a00411d4f
--- /dev/null
+++ b/test-suite/ltac2/seq_notation.v
@@ -0,0 +1,7 @@
+Require Import Ltac2.Ltac2.
+
+(* tests that the seq subterms are parsed in the right order, and
+   tupled in the right order. *)
+Ltac2 Notation "foo" x(seq(constr,ident,thunk(tactic(0)))) y(ident) := (x,y).
+
+Ltac2 bar () : (constr * ident * (unit -> unit)) * ident := foo 0 x intros z.
diff --git a/test-suite/ltac2/with_strategy.v b/test-suite/ltac2/with_strategy.v
new file mode 100644
index 000000000000..84a4c0a96c05
--- /dev/null
+++ b/test-suite/ltac2/with_strategy.v
@@ -0,0 +1,50 @@
+Require Import Ltac2.Ltac2.
+
+Definition myid {A} (x : A) := x.
+
+Ltac2 myid_ref () :=
+  match Env.expand [@myid] with
+  | r :: _ => r
+  | [] => Control.throw (Invalid_argument (Some (Message.of_string "myid not found")))
+  end.
+
+Ltac2 unfold_myid () :=
+  Std.unfold [(myid_ref (), Std.AllOccurrences)]
+    {Std.on_hyps := None; Std.on_concl := Std.AllOccurrences}.
+
+(* Test with_strategy Expand allows unfolding an opaque constant *)
+Opaque myid.
+Goal myid 0 = 0.
+  TransparentState.with_strategy TransparentState.Expand [myid_ref ()]
+    (fun () => unfold_myid ()).
+  reflexivity.
+Qed.
+
+(* Test that strategy is restored after the tactic *)
+Goal myid 0 = 0.
+  TransparentState.with_strategy TransparentState.Expand [myid_ref ()]
+    (fun () => ()).
+  (* unfold should fail since myid is opaque again *)
+  Fail unfold myid.
+  reflexivity.
+Qed.
+
+(* Test with Level 0 = transparent *)
+Goal myid 0 = 0.
+  TransparentState.with_strategy (TransparentState.Level 0) [myid_ref ()]
+    (fun () => unfold_myid ()).
+  reflexivity.
+Qed.
+
+(* Test Opaque: making a transparent constant temporarily opaque *)
+Transparent myid.
+Goal myid 0 = 0.
+  TransparentState.with_strategy TransparentState.Opaque [myid_ref ()]
+    (fun () => ()).
+  (* myid should be transparent again after with_strategy *)
+  unfold_myid ().
+  reflexivity.
+Qed.
+
+(* test that returning non unit works *)
+Ltac2 Eval TransparentState.with_strategy TransparentState.Expand [] (fun () => Some 1).
diff --git a/test-suite/misc/attributes.sh b/test-suite/misc/attributes.sh
new file mode 100755
index 000000000000..e2663a2722ff
--- /dev/null
+++ b/test-suite/misc/attributes.sh
@@ -0,0 +1,22 @@
+#!/usr/bin/env bash
+
+set -e
+
+export COQBIN=$BIN
+export PATH=$COQBIN:$PATH
+
+cd misc/attributes/
+
+rm -rf _test
+mkdir _test
+find . -maxdepth 1 -not -name . -not -name _test -exec cp -r '{}' -t _test ';'
+cd _test
+
+rocq makefile -f _CoqProject -o Makefile
+
+make
+
+if ! [ -e theories/attr.vo ]; then
+  >&2 echo Missing attr.vo after successful compilation
+  exit 1
+fi
diff --git a/test-suite/misc/attributes/_CoqProject b/test-suite/misc/attributes/_CoqProject
new file mode 100644
index 000000000000..bacac33e683c
--- /dev/null
+++ b/test-suite/misc/attributes/_CoqProject
@@ -0,0 +1,7 @@
+src/META.rocq-test-suite.plugins.attribute_plugin
+-Q theories Attributes
+-I src
+
+src/attribute.ml
+src/attribute_plugin.mlpack
+theories/attr.v
diff --git a/test-suite/misc/attributes/src/META.rocq-test-suite b/test-suite/misc/attributes/src/META.rocq-test-suite
new file mode 100644
index 000000000000..2c4c2bb86c4c
--- /dev/null
+++ b/test-suite/misc/attributes/src/META.rocq-test-suite
@@ -0,0 +1,11 @@
+package "attribute" (
+    directory = "."
+    version = "dev"
+    description = "A test plugin"
+    requires = ""
+    archive(byte) = "attribute_plugin.cma"
+    archive(native) = "attribute_plugin.cmxa"
+    plugin(byte) = "attribute_plugin.cma"
+    plugin(native) = "attribute_plugin.cmxs"
+)
+directory = "."
diff --git a/test-suite/misc/attributes/src/attribute.ml b/test-suite/misc/attributes/src/attribute.ml
new file mode 100644
index 000000000000..75e51a82eb9b
--- /dev/null
+++ b/test-suite/misc/attributes/src/attribute.ml
@@ -0,0 +1,31 @@
+open Names
+
+let print_hook =
+  let attr : Declare.Hook.t list Attributes.attribute =
+    let hook = Declare.Hook.make @@ fun data ->
+      Feedback.msg_info Pp.(str "generated " ++ GlobRef.print data.dref ++ str "\n")
+    in
+    let open Attributes in
+    let open Attributes.Notations in
+    map (Option.default []) @@ attribute_of_list [("print", fun ?loc _ _ -> [hook])]
+  in
+  Vernacentries.DefAttributes.Observer.register ~name:"print-afterwards" attr
+
+
+let error_hook =
+  let attr : Declare.Hook.t list Attributes.attribute =
+    let hook loc = Declare.Hook.make @@ fun data ->
+      Feedback.msg_info Pp.(str "failing attribute") ;
+      CErrors.user_err ?loc Pp.(str "attribute error!")
+    in
+    let open Attributes in
+    let open Attributes.Notations in
+    map (Option.default []) @@ attribute_of_list [("error", fun ?loc _ _ -> [hook loc])]
+  in
+  Vernacentries.DefAttributes.Observer.register ~name:"error" attr
+
+let () =
+  Mltop.(declare_cache_obj_full @@ interp_only_obj @@ fun () ->
+         Vernacentries.DefAttributes.Observer.activate print_hook;
+         Vernacentries.DefAttributes.Observer.activate error_hook)
+    "rocq-test-suite.attribute"
diff --git a/test-suite/misc/attributes/src/attribute_plugin.mlpack b/test-suite/misc/attributes/src/attribute_plugin.mlpack
new file mode 100644
index 000000000000..c705521b01f4
--- /dev/null
+++ b/test-suite/misc/attributes/src/attribute_plugin.mlpack
@@ -0,0 +1 @@
+Attribute
diff --git a/test-suite/misc/attributes/theories/attr.v b/test-suite/misc/attributes/theories/attr.v
new file mode 100644
index 000000000000..8e501f4f32af
--- /dev/null
+++ b/test-suite/misc/attributes/theories/attr.v
@@ -0,0 +1,45 @@
+Declare ML Module "rocq-test-suite.attribute".
+
+#[print]
+Definition foo : True := I.
+
+#[print]
+Definition bar : False -> False := fun x => x.
+
+Fail #[error]
+Definition baz : False -> False := fun x => x.
+
+(* Programmable-attribute hooks must also fire when a Lemma/Theorem is
+   completed (at Qed/Defined), not only for Definition. *)
+#[print]
+Lemma lem : True.
+Proof. exact I. Qed.
+
+#[print]
+Theorem thm : True.
+Proof. exact I. Defined.
+
+(* Mutual proofs: the #[print] hook fires once per declared constant. *)
+Inductive even : nat -> Prop :=
+| even_O : even 0
+| even_S : forall n, odd n -> even (S n)
+with odd : nat -> Prop :=
+| odd_S : forall n, even n -> odd (S n).
+
+#[print]
+Lemma even_triv : forall n, even n -> True
+with odd_triv : forall n, odd n -> True.
+Proof. - intros; exact I. - intros; exact I. Qed.
+
+(* The error hook fires at completion time, so it is Qed that must fail. *)
+#[error]
+Lemma lem_err : True.
+Proof. exact I. Fail Qed.
+Abort.
+
+(* par marshals th summary, enforcing that it doesn't contain closures *)
+Lemma parfoo : True /\ True.
+Proof.
+  split.
+  par: exact I.
+Defined.
diff --git a/test-suite/misc/bench-render/result.html b/test-suite/misc/bench-render/result.html
index 9dbac771eb27..d9db8f02cd5a 100644
--- a/test-suite/misc/bench-render/result.html
+++ b/test-suite/misc/bench-render/result.html
@@ -2,22 +2,26 @@
 
 foo.v
 # **)
+Module SsrIsSyntax.
 
-Require Import ssrmatching.
-Declare ML Module "rocq-runtime.plugins.ssreflect".
+(** Declare Ssr keywords: "is" "isn't". **)
+Reserved Notation "(******* x 'is' y 'isn't' *******)".
 
-(**
- 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.
-           nonPropType == an interface for non-Prop Types: a nonPropType coerces
-                          to a Type, and only types that do _not_ have sort
-                          Prop are canonical nonPropType instances. This is
-                          useful for applied views (see mid-file comment).
-             notProp T == the nonPropType instance for type T.
-           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). Rocq 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.
-
-         #[#elaborate x#]# == triggers Rocq elaboration to fill the holes of the term x
-                          The main use case is to trigger typeclass inference in
-                          the body of a ssreflect have := #[#elaborate body#]#.
-
-  Additionally we provide default intro pattern ltac views:
-  - top of the stack actions:
-    => /#[#apply#]#     := => hyp {}/hyp
-    => /#[#swap#]#      := => x y; move: y x
-                      (also swap and preserves let bindings)
-    => /#[#dup#]#       := => x; have copy := x; move: copy x
-                      (also copies and preserves let bindings)
-  - calling rewrite from an intro pattern, use with parsimony:
-    => /#[#1! rules#]#  := rewrite rules
-    => /#[#! rules#]#   := rewrite !rules
-
- 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" "isn't" "of" "//" "/=" and "//=". **)
-
-Reserved Notation "(* x 'is' y 'of' z 'isn't' // /= //= *)".
+End SsrIsSyntax.
 
-(** Enable SSR features **)
-#[export] Set SSR Loaded.
+Export SsrIsSyntax.
 
-Reserved Notation "" (at level 0, n at level 0,
-  format "").
-#[warning="-postfix-notation-not-level-1"]
-Reserved Notation "T (* n *)" (at level 200, format "T  (* n *)").
-
-End SsrSyntax.
-
-Export SsrMatchingSyntax.
-Export SsrSyntax.
+(** Signal that we have ssreflect version of rewrite (meaning
+ "rewrite a" must be printed "rewrite -> a" for compatibility). **)
+#[export] Set SSRRewriteLoaded.
 
 (** Save primitive notation that will be overloaded. **)
-Local Abbreviation RocqGenericIf c vT vF := (if c then vT else vF) (only parsing).
+Local Abbreviation RocqGenericIf c vT vF :=
+  (if c then vT else vF) (only parsing).
 Local Abbreviation RocqGenericDependentIf c x R vT vF :=
   (if c as x return R then vT else vF) (only parsing).
 
-(** Reserve notation that introduced in this file. **)
-Reserved Notation "'if' c 'then' vT 'else' vF" (at level 200,
+(** Reserve notations that are introduced in this file. **)
+Reserved Notation "'if' c 'then' vT 'else' vF" (at level 10,
   c, vT, vF at level 200).
-Reserved Notation "'if' c 'return' R 'then' vT 'else' vF" (at level 200,
+Reserved Notation "'if' c 'return' R 'then' vT 'else' vF" (at level 10,
   c, R, vT, vF at level 200).
-Reserved Notation "'if' c 'as' x 'return' R 'then' vT 'else' vF" (at level 200,
+Reserved Notation "'if' c 'as' x 'return' R 'then' vT 'else' vF" (at level 10,
   c, R, vT, vF at level 200, x name).
 
-Reserved Notation "[ 'the' sT 'of' v 'by' f ]" (at level 0,
-  format "[ 'the'  sT  'of'  v  'by'  f ]").
-Reserved Notation "[ 'the' sT 'of' v ]" (at level 0,
-  format "[ 'the'  sT  'of'  v ]").
-Reserved Notation "{ 'type' 'of' c 'for' s }" (at level 0,
-  format "{ 'type'  'of'  c  'for'  s }").
-
-Reserved Notation "=^~ r" (at level 100, format "=^~  r").
-
-Reserved Notation "[ 'unlockable' 'of' C ]" (at level 0,
-  format "[ 'unlockable'  'of'  C ]").
-Reserved Notation "[ 'unlockable' 'fun' C ]" (at level 0,
-  format "[ 'unlockable'  'fun'  C ]").
-
-Reserved Notation "[ 'elaborate' x ]" (at level 0).
-
-(**
- To define notations for tactic in intro patterns.
- When "=> /t" is parsed, "t:%ssripat" is actually interpreted. **)
-Declare Scope ssripat_scope.
-Delimit Scope ssripat_scope with ssripat.
-
 (**
  Make the general "if" into a notation, so that we can override it below.
  The notations are "only parsing" because the Rocq decompiler will not
@@ -168,523 +72,10 @@ Notation "'if' c 'as' x 'return' R 'then' vT 'else' vF" :=
 
 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 Rocq
- Lists library) should be loaded before ssreflect so that their notations
- do not mask all ssreflect forms.                                            **)
-Declare Scope form_scope.
-Delimit Scope form_scope with FORM.
-Open Scope form_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.
-
-Declare Scope ssr_scope.
-Notation "" := (abstract _ n _) : ssr_scope.
-Notation "T (* n *)" := (abstract T n abstract_key) : ssr_scope.
-Open Scope ssr_scope.
-
-Register abstract_lock as plugins.ssreflect.abstract_lock.
-Register abstract_key as plugins.ssreflect.abstract_key.
-Register abstract as plugins.ssreflect.abstract.
-
-(**  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 Rocq 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.
-
-Variant put vT sT (v1 v2 : vT) (s : sT) : Prop := 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 _))
-  (only parsing) : form_scope.
-
-Notation "[ 'the' sT 'of' v ]" := (get ((fun s : sT => Put v (*coerce*) s s) _))
-  (only parsing) : form_scope.
-
-(**
- The following are "format only" versions of the above notations.
- 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 "[ 'the' sT 'of' v 'by' f ]" := (@get_by _ sT f v _ _)
-  (only printing) : form_scope.
-
-Notation "[ 'the' sT 'of' v ]" := (@get _ sT v _ _)
-  (only printing) : form_scope.
-
-(**
- We would like to recognize
-Notation " #[# 'the' sT 'of' v : 'Type' #]#" := (@get Type sT v _ _)
-  (at level 0, format " #[# 'the'  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 Rocq'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 Structure "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) : 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 Rocq 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.                                           **)
-
-Variant phantom T (p : T) : Prop := Phantom.
-Arguments phantom : clear implicits.
-Arguments Phantom : clear implicits.
-Variant phant (p : Type) : Prop := Phant.
-
-(**  Internal tagging used by the implementation of the ssreflect elim.  **)
-
-Definition protect_term (A : Type) (x : A) : A := x.
-
-Register protect_term as plugins.ssreflect.protect_term.
-
-(**
- The ssreflect idiom for a non-keyed pattern:
-  - unkeyed t will 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 a and b, respectively, 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).        **)
-
+(* This abbreviation is only parsing in Prelude *)
 Abbreviation 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) : 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 Rocq kernel,
-    which treats all terms of the form locked t as equal and compares 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.   **)
-
-Abbreviation 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.
-
-Register master_key as plugins.ssreflect.master_key.
-Register locked as plugins.ssreflect.locked.
-
-Lemma lock A x : x = locked x :> A. Proof. unlock; reflexivity. Qed.
-
-(**  The basic closing tactic "done".  **)
-Ltac done :=
-  trivial; hnf; intros; solve
-   [ do ![solve [trivial | simple refine (@sym_equal _ _ _ _); trivial]
-         | discriminate | contradiction | split]
-   | 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 ]
-   | match goal with H : ~ _ |- _ => solve [case H; trivial] end ].
-
-(**  To unlock opaque constants.  **)
-#[universes(template)]
-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 _)) : form_scope.
-
-Notation "[ 'unlockable' 'fun' C ]" :=
-  (@Unlockable _ (fun _ => _) C (unlock _)) : 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.
-
-(**  Abbreviation to trigger Rocq elaboration to fill the holes **)
-Notation "[ 'elaborate' x ]" := (ltac:(refine x)) (only parsing).
-
-(**  The internal lemmas for the have tactics.  **)
-
-Lemma ssr_have
-  (Plemma : Prop)  (Pgoal : Prop)
-  (step : Plemma) (rest : Plemma -> Pgoal) : Pgoal.
-Proof. exact: rest step. Qed.
-
-Register ssr_have as plugins.ssreflect.ssr_have.
-
-Polymorphic Lemma ssr_have_upoly@{s1 s2;u1 u2}
-  (Plemma : Type@{s1;u1})  (Pgoal : Type@{s2;u2})
-  (step : Plemma) (rest : Plemma -> Pgoal) : Pgoal.
-Proof. exact: rest step. Qed.
-
-Register ssr_have_upoly as plugins.ssreflect.ssr_have_upoly.
-
-(**  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.
-
-Register nary_congruence as plugins.ssreflect.nary_congruence.
-Register ssr_congr_arrow as plugins.ssreflect.ssr_congr_arrow.
-
-(**  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 occurring 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.
-
-(*****************************************************************************)
-(* Material for under/over (to rewrite under binders using "context lemmas") *)
-
-Require Export ssrunder.
-
-#[global]
-Hint Extern 0 (@Under_rel.Over_rel _ _ _ _) =>
-  solve [ apply: Under_rel.over_rel_done ] : core.
-#[global]
-Hint Resolve Under_rel.over_rel_done : core.
-
-Register Under_rel.Under_rel as plugins.ssreflect.Under_rel.
-Register Under_rel.Under_rel_from_rel as plugins.ssreflect.Under_rel_from_rel.
-
-(** Closing rewrite rule *)
-Definition over := over_rel.
-
-(** Closing tactic *)
-Ltac over :=
-  by [ apply: Under_rel.under_rel_done
-     | rewrite over
-     ].
-
-(** Convenience rewrite rule to unprotect evars, e.g., to instantiate
-    them in another way than with reflexivity. *)
-Definition UnderE := Under_relE.
-
-(*****************************************************************************)
-
-(** An interface for non-Prop types; used to avoid improper instantiation
-    of polymorphic lemmas with on-demand implicits when they are used as views.
-    For example: Some_inj {T} : forall x y : T, Some x = Some y -> x = y.
-    Using move/Some_inj on a goal of the form Some n = Some 0 will fail:
-    SSReflect will interpret the view as @Some_inj ?T _top_assumption_
-    since this is the well-typed application of the view with the minimal
-    number of inserted evars (taking ?T := Some n = Some 0), and then will
-    later complain that it cannot erase _top_assumption_ after having
-    abstracted the viewed assumption. Making x and y maximal implicits
-    would avoid this and force the intended @Some_inj nat x y _top_assumption_
-    interpretation, but is undesirable as it makes it harder to use Some_inj
-    with the many SSReflect and MathComp lemmas that have an injectivity
-    premise. Specifying {T : nonPropType} solves this more elegantly, as then
-    (?T : Type) no longer unifies with (Some n = Some 0), which has sort Prop.
- **)
-
-Module NonPropType.
-
-(** Implementation notes:
- We rely on three interface Structures:
-  - test_of r, the middle structure, performs the actual check: it has two
-    canonical instances whose 'condition' projection are maybeProj (?P : Prop)
-    and tt, and which set r := true and r := false, respectively. Unifying
-    condition (?t : test_of ?r) with maybeProj T will thus set ?r to true if
-    T is in Prop as the test_Prop T instance will apply, and otherwise simplify
-    maybeProp T to tt and use the test_negative instance and set ?r to false.
-  - call_of c r sets up a call to test_of on condition c with expected result r.
-    It has a default instance for its 'callee' projection to Type, which
-    sets c := maybeProj T and r := false when unifying with a type T.
-  - type is a telescope on call_of c r, which checks that unifying test_of ?r1
-    with c indeed sets ?r1 := r; the type structure bundles the 'test' instance
-    and its 'result' value along with its call_of c r projection. The default
-    instance essentially provides eta-expansion for 'type'. This is only
-    essential for the first 'result' projection to bool; using the instance
-    for other projection merely avoids spurious delta expansions that would
-    spoil the notProp T notation.
- In detail, unifying T =~= ?S with ?S : nonPropType, i.e.,
-  (1)  T =~= @callee (@condition (result ?S) (test ?S)) (result ?S) (frame ?S)
- first uses the default call instance with ?T := T to reduce (1) to
-  (2a) @condition (result ?S) (test ?S) =~= maybeProp T
-  (3)                         result ?S =~= false
-  (4)                          frame ?S =~= call T
- along with some trivial universe-related checks which are irrelevant here.
-   Then the unification tries to use the test_Prop instance to reduce (2a) to
-  (6a)                        result ?S =~= true
-  (7a)                               ?P =~= T with ?P : Prop
-  (8a)                          test ?S =~= test_Prop ?P
- Now the default 'check' instance with ?result := true resolves (6a) as
-  (9a)                               ?S := @check true ?test ?frame
- Then (7a) can be solved precisely if T has sort at most (hence exactly) Prop,
- and then (8a) is solved by the check instance, yielding ?test := test_Prop T,
- and completing the solution of (2a), and _committing_ to it. But now (3) is
- inconsistent with (9a), and this makes the entire problem (1) fails.
-   If on the other hand T does not have sort Prop then (7a) fails and the
- unification resorts to delta expanding (2a), which gives
-  (2b) @condition (result ?S) (test ?S) =~= tt
- which is then reduced, using the test_negative instance, to
-  (6b)                        result ?S =~= false
-  (8b)                          test ?S =~= test_negative
- Both are solved using the check default instance, as in the (2a) branch, giving
-  (9b)                               ?S := @check false test_negative ?frame
- Then (3) and (4) are similarly solved using check, giving the final assignment
-  (9)                                ?S := notProp T
- Observe that we _must_ perform the actual test unification on the arguments
- of the initial canonical instance, and not on the instance itself as we do
- in mathcomp/matrix and mathcomp/vector, because we want the unification to
- fail when T has sort Prop. If both the test_of _and_ the result check
- unifications were done as part of the structure telescope then the latter
- would be a sub-problem of the former, and thus failing the check would merely
- make the test_of unification backtrack and delta-expand and we would not get
- failure.
- **)
-
-Structure call_of (condition : unit) (result : bool) := Call {callee : Type}.
-Definition maybeProp (T : Type) := tt.
-Definition call T := Call (maybeProp T) false T.
-
-Structure test_of (result : bool) := Test {condition :> unit}.
-Definition test_Prop (P : Prop) := Test true (maybeProp P).
-Definition test_negative := Test false tt.
-
-Structure type :=
-  Check {result : bool; test : test_of result; frame : call_of test result}.
-Definition check result test frame := @Check result test frame.
-
-Module Exports.
-Canonical call.
-Canonical test_Prop.
-Canonical test_negative.
-Canonical check.
-Abbreviation nonPropType := type.
-Coercion callee : call_of >-> Sortclass.
-Coercion frame : type >-> call_of.
-Abbreviation notProp T := (@check false test_negative (call T)).
-End Exports.
-
-End NonPropType.
-Export NonPropType.Exports.
-
-Module Export ipat.
-
-Notation "'[' 'apply' ']'" := (ltac:(let f := fresh "_top_" in move=> f {}/f))
-  (at level 0, only parsing) : ssripat_scope.
-
-(* we try to preserve the naming by matching the names from the goal *)
-(* we do move to perform a hnf before trying to match                *)
-Notation "'[' 'swap' ']'" := (ltac:(move;
-  let x := lazymatch goal with
-    | |- forall (x : _), _ => fresh x | |- let x := _ in _ => fresh x | _ => fresh "_top_"
-  end in intro x; move;
-  let y := lazymatch goal with
-    | |- forall (y : _), _ => fresh y | |- let y := _ in _ => fresh y | _ => fresh "_top_"
-  end in intro y; revert x; revert y))
-  (at level 0, only parsing) : ssripat_scope.
-
-
-(* we try to preserve the naming by matching the names from the goal *)
-(* we do move to perform a hnf before trying to match                *)
-Notation "'[' 'dup' ']'" := (ltac:(move;
-  lazymatch goal with
-  | |- forall (x : _), _ =>
-    let x := fresh x in intro x;
-    let copy := fresh x in have copy := x; revert x; revert copy
-  | |- let x := _ in _ =>
-    let x := fresh x in intro x;
-    let copy := fresh x in pose copy := x;
-    do [unfold x in (value of copy)]; revert x; revert copy
-  | |- _ =>
-    let x := fresh "_top_" in move=> x;
-    let copy := fresh "_top" in have copy := x; revert x; revert copy
-  end))
-  (at level 0, only parsing) : ssripat_scope.
-
-Notation "'[' '1' '!' rules ']'"     := (ltac:(rewrite rules))
-  (at level 0, rules at level 200, only parsing) : ssripat_scope.
-Notation "'[' '!' rules ']'"         := (ltac:(rewrite !rules))
-  (at level 0, rules at level 200, only parsing) : ssripat_scope.
-
-End ipat.
-
-(* A class to trigger reduction by rewriting.                           *)
-(* Usage: rewrite [pattern]vm_compute.                                  *)
-(* Alternatively one may redefine a lemma as in algebra/rat.v :         *)
-(* Lemma rat_vm_compute n (x : rat) : vm_compute_eq n%:Q x -> n%:Q = x. *)
-(* Proof. exact. Qed.                                                   *)
-
-Class vm_compute_eq {T : Type} (x y : T) := vm_compute : x = y.
-
-#[global]
-Hint Extern 0 (@vm_compute_eq _ _ _) =>
-       vm_compute; reflexivity : typeclass_instances.
+Abbreviation phant := ssreflect_rw.phant.
+Abbreviation Phant := ssreflect_rw.Phant.
+Abbreviation phantom := ssreflect_rw.phantom.
+Abbreviation Phantom := ssreflect_rw.Phantom.
diff --git a/theories/Corelib/ssr/ssreflect_rw.v b/theories/Corelib/ssr/ssreflect_rw.v
new file mode 100644
index 000000000000..810e127f30ce
--- /dev/null
+++ b/theories/Corelib/ssr/ssreflect_rw.v
@@ -0,0 +1,643 @@
+(************************************************************************)
+(*         *      The Rocq Prover / The Rocq Development Team           *)
+(*  v      *         Copyright INRIA, CNRS and contributors             *)
+(*  .doc { font-family: monospace; white-space: pre; } # **)
+
+Require Import ssrmatching.
+Declare ML Module "rocq-runtime.plugins.ssreflect".
+
+(**
+ 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.
+           nonPropType == an interface for non-Prop Types: a nonPropType coerces
+                          to a Type, and only types that do _not_ have sort
+                          Prop are canonical nonPropType instances. This is
+                          useful for applied views (see mid-file comment).
+             notProp T == the nonPropType instance for type T.
+           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). Rocq 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
+     rw unlock to expose big_foo_expression.
+
+         #[#elaborate x#]# == triggers Rocq elaboration to fill the holes of the term x
+                          The main use case is to trigger typeclass inference in
+                          the body of a ssreflect have := #[#elaborate body#]#.
+
+  Additionally we provide default intro pattern ltac views:
+  - top of the stack actions:
+    => /#[#apply#]#     := => hyp {}/hyp
+    => /#[#swap#]#      := => x y; move: y x
+                      (also swap and preserves let bindings)
+    => /#[#dup#]#       := => x; have copy := x; move: copy x
+                      (also copies and preserves let bindings)
+  - calling rw from an intro pattern, use with parsimony:
+    => /#[#1! rules#]#  := rw rules
+    => /#[#! rules#]#   := rw !rules
+
+ 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: "//" "/=" and "//=". **)
+Reserved Notation "(******* // /= //= *******)".
+
+Reserved Notation "" (at level 0, n at level 0, only printing,
+  format "").
+#[warning="-postfix-notation-not-level-1"]
+Reserved Notation "T (* n *)"
+  (at level 200, only printing, format "T  (* n *)").
+
+End SsrSyntax.
+
+Export SsrMatchingSyntax.
+Export SsrSyntax.
+
+(** Reserve notations that are introduced in this file. **)
+Reserved Notation "[ 'the' sT 'of' v 'by' f ]" (at level 0,
+  format "[ 'the'  sT  'of'  v  'by'  f ]").
+
+Reserved Notation "[ 'the' sT 'of' v ]" (at level 0,
+  format "[ 'the'  sT  'of'  v ]").
+Reserved Notation "{ 'type' 'of' c 'for' s }" (at level 0,
+  format "{ 'type'  'of'  c  'for'  s }").
+
+Reserved Notation "[ 'unlockable' 'of' C ]" (at level 0,
+  format "[ 'unlockable'  'of'  C ]").
+
+Reserved Notation "=^~ r" (at level 100, format "=^~  r").
+
+Reserved Notation "[ 'unlockable' 'fun' C ]" (at level 0,
+  format "[ 'unlockable'  'fun'  C ]").
+
+Reserved Notation "[ 'elaborate' x ]" (at level 0).
+
+(**
+ To define notations for tactic in intro patterns.
+ When "=> /t" is parsed, "t:%ssripat" is actually interpreted. **)
+Declare Scope ssripat_scope.
+Delimit Scope ssripat_scope with ssripat.
+
+(**
+ To allow a wider variety of notations without reserving a large number
+ 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 Rocq
+ Lists library) should be loaded before ssreflect so that their notations
+ do not mask all ssreflect forms.                                            **)
+Declare Scope form_scope.
+Delimit Scope form_scope with FORM.
+Open Scope form_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.
+
+Declare Scope ssr_scope.
+Notation "" := (abstract _ n _) (only printing) : ssr_scope.
+Notation "T (* n *)" := (abstract T n abstract_key) (only printing) : ssr_scope.
+Open Scope ssr_scope.
+
+Register abstract_lock as plugins.ssreflect.abstract_lock.
+Register abstract_key as plugins.ssreflect.abstract_key.
+Register abstract as plugins.ssreflect.abstract.
+
+(**  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 Rocq 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.
+
+Variant put vT sT (v1 v2 : vT) (s : sT) : Prop := Put.
+
+Definition get vT sT v s (p : @put vT sT v v s) := let: Put _ _ _ := p in s.
+
+Definition get_by vT sT & 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 _))
+  (only parsing) : form_scope.
+
+Notation "[ 'the' sT 'of' v ]" := (get ((fun s : sT => Put v (*coerce*) s s) _))
+  (only parsing) : form_scope.
+
+(**
+ The following are "format only" versions of the above notations.
+ 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 "[ 'the' sT 'of' v 'by' f ]" := (@get_by _ sT f v _ _)
+  (only printing) : form_scope.
+
+Notation "[ 'the' sT 'of' v ]" := (@get _ sT v _ _)
+  (only printing) : form_scope.
+
+(**
+ We would like to recognize
+Notation " #[# 'the' sT 'of' v : 'Type' #]#" := (@get Type sT v _ _)
+  (at level 0, format " #[# 'the'  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 Rocq'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 Structure "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) : 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 Rocq 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.                                           **)
+
+Variant phantom T (p : T) : Prop := Phantom.
+Arguments phantom : clear implicits.
+Arguments Phantom : clear implicits.
+Variant phant (p : Type) : Prop := Phant.
+
+(**  Internal tagging used by the implementation of the ssreflect elim.  **)
+
+Definition protect_term (A : Type) (x : A) : A := x.
+
+Register protect_term as plugins.ssreflect.protect_term.
+
+(**
+ The ssreflect idiom for a non-keyed pattern:
+  - unkeyed t will 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 a and b, respectively, 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).        **)
+
+Abbreviation unkeyed x := (let flex := x in flex) (only parsing).
+
+(**  Ssreflect converse rewrite rule rule idiom.  **)
+Definition ssr_converse R (r : R) := (Logic.I, r).
+Notation "=^~ r" := (ssr_converse r) : 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 rw /foo will replace
+    foo by bar, and rw -/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 Rocq kernel,
+    which treats all terms of the form locked t as equal and compares 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.   **)
+
+Abbreviation 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.
+
+Register master_key as plugins.ssreflect.master_key.
+Register locked as plugins.ssreflect.locked.
+
+Lemma lock A x : x = locked x :> A. Proof. unlock; reflexivity. Qed.
+
+(**  The basic closing tactic "done".  **)
+Ltac done :=
+  trivial; hnf; intros; solve
+   [ do ![solve [trivial | simple refine (@sym_equal _ _ _ _); trivial]
+         | discriminate | contradiction | split]
+   | 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 ]
+   | match goal with H : ~ _ |- _ => solve [case H; trivial] end ].
+
+(**  To unlock opaque constants.  **)
+#[universes(template)]
+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 _)) : form_scope.
+
+Notation "[ 'unlockable' 'fun' C ]" :=
+  (@Unlockable _ (fun _ => _) C (unlock _)) : 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.
+
+(**  Abbreviation to trigger Rocq elaboration to fill the holes **)
+Notation "[ 'elaborate' x ]" := (ltac:(refine x)) (only parsing).
+
+(**  The internal lemmas for the have tactics.  **)
+
+Lemma ssr_have
+  (Plemma : Prop)  (Pgoal : Prop)
+  (step : Plemma) (rest : Plemma -> Pgoal) : Pgoal.
+Proof. exact: rest step. Qed.
+
+Register ssr_have as plugins.ssreflect.ssr_have.
+
+Polymorphic Lemma ssr_have_upoly@{s1 s2;u1 u2}
+  (Plemma : Type@{s1;u1})  (Pgoal : Type@{s2;u2})
+  (step : Plemma) (rest : Plemma -> Pgoal) : Pgoal.
+Proof. exact: rest step. Qed.
+
+Register ssr_have_upoly as plugins.ssreflect.ssr_have_upoly.
+
+(**  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 _ _ := _; rw {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.
+
+Register nary_congruence as plugins.ssreflect.nary_congruence.
+Register ssr_congr_arrow as plugins.ssreflect.ssr_congr_arrow.
+
+(**  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; rw {}defG {G}.
+ Note that vm_cast are not stored in the proof term
+ for reductions occurring 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.
+
+(*****************************************************************************)
+(* Material for under/over (to rewrite under binders using "context lemmas") *)
+
+Require Export ssrunder.
+
+#[global]
+Hint Extern 0 (@Under_rel.Over_rel _ _ _ _) =>
+  solve [ apply: Under_rel.over_rel_done ] : core.
+#[global]
+Hint Resolve Under_rel.over_rel_done : core.
+
+Register Under_rel.Under_rel as plugins.ssreflect.Under_rel.
+Register Under_rel.Under_rel_from_rel as plugins.ssreflect.Under_rel_from_rel.
+
+(** Closing rewrite rule *)
+Definition over := over_rel.
+
+(** Closing tactic *)
+Ltac over :=
+  by [ apply: Under_rel.under_rel_done
+     | rw over
+     ].
+
+(** Convenience rewrite rule to unprotect evars, e.g., to instantiate
+    them in another way than with reflexivity. *)
+Definition UnderE := Under_relE.
+
+(*****************************************************************************)
+
+(** An interface for non-Prop types; used to avoid improper instantiation
+    of polymorphic lemmas with on-demand implicits when they are used as views.
+    For example: Some_inj {T} : forall x y : T, Some x = Some y -> x = y.
+    Using move/Some_inj on a goal of the form Some n = Some 0 will fail:
+    SSReflect will interpret the view as @Some_inj ?T _top_assumption_
+    since this is the well-typed application of the view with the minimal
+    number of inserted evars (taking ?T := Some n = Some 0), and then will
+    later complain that it cannot erase _top_assumption_ after having
+    abstracted the viewed assumption. Making x and y maximal implicits
+    would avoid this and force the intended @Some_inj nat x y _top_assumption_
+    interpretation, but is undesirable as it makes it harder to use Some_inj
+    with the many SSReflect and MathComp lemmas that have an injectivity
+    premise. Specifying {T : nonPropType} solves this more elegantly, as then
+    (?T : Type) no longer unifies with (Some n = Some 0), which has sort Prop.
+ **)
+
+Module NonPropType.
+
+(** Implementation notes:
+ We rely on three interface Structures:
+  - test_of r, the middle structure, performs the actual check: it has two
+    canonical instances whose 'condition' projection are maybeProj (?P : Prop)
+    and tt, and which set r := true and r := false, respectively. Unifying
+    condition (?t : test_of ?r) with maybeProj T will thus set ?r to true if
+    T is in Prop as the test_Prop T instance will apply, and otherwise simplify
+    maybeProp T to tt and use the test_negative instance and set ?r to false.
+  - call_of c r sets up a call to test_of on condition c with expected result r.
+    It has a default instance for its 'callee' projection to Type, which
+    sets c := maybeProj T and r := false when unifying with a type T.
+  - type is a telescope on call_of c r, which checks that unifying test_of ?r1
+    with c indeed sets ?r1 := r; the type structure bundles the 'test' instance
+    and its 'result' value along with its call_of c r projection. The default
+    instance essentially provides eta-expansion for 'type'. This is only
+    essential for the first 'result' projection to bool; using the instance
+    for other projection merely avoids spurious delta expansions that would
+    spoil the notProp T notation.
+ In detail, unifying T =~= ?S with ?S : nonPropType, i.e.,
+  (1)  T =~= @callee (@condition (result ?S) (test ?S)) (result ?S) (frame ?S)
+ first uses the default call instance with ?T := T to reduce (1) to
+  (2a) @condition (result ?S) (test ?S) =~= maybeProp T
+  (3)                         result ?S =~= false
+  (4)                          frame ?S =~= call T
+ along with some trivial universe-related checks which are irrelevant here.
+   Then the unification tries to use the test_Prop instance to reduce (2a) to
+  (6a)                        result ?S =~= true
+  (7a)                               ?P =~= T with ?P : Prop
+  (8a)                          test ?S =~= test_Prop ?P
+ Now the default 'check' instance with ?result := true resolves (6a) as
+  (9a)                               ?S := @check true ?test ?frame
+ Then (7a) can be solved precisely if T has sort at most (hence exactly) Prop,
+ and then (8a) is solved by the check instance, yielding ?test := test_Prop T,
+ and completing the solution of (2a), and _committing_ to it. But now (3) is
+ inconsistent with (9a), and this makes the entire problem (1) fails.
+   If on the other hand T does not have sort Prop then (7a) fails and the
+ unification resorts to delta expanding (2a), which gives
+  (2b) @condition (result ?S) (test ?S) =~= tt
+ which is then reduced, using the test_negative instance, to
+  (6b)                        result ?S =~= false
+  (8b)                          test ?S =~= test_negative
+ Both are solved using the check default instance, as in the (2a) branch, giving
+  (9b)                               ?S := @check false test_negative ?frame
+ Then (3) and (4) are similarly solved using check, giving the final assignment
+  (9)                                ?S := notProp T
+ Observe that we _must_ perform the actual test unification on the arguments
+ of the initial canonical instance, and not on the instance itself as we do
+ in mathcomp/matrix and mathcomp/vector, because we want the unification to
+ fail when T has sort Prop. If both the test_of _and_ the result check
+ unifications were done as part of the structure telescope then the latter
+ would be a sub-problem of the former, and thus failing the check would merely
+ make the test_of unification backtrack and delta-expand and we would not get
+ failure.
+ **)
+
+Structure call_of (condition : unit) (result : bool) := Call {callee : Type}.
+Definition maybeProp (T : Type) := tt.
+Definition call T := Call (maybeProp T) false T.
+
+Structure test_of (result : bool) := Test {condition :> unit}.
+Definition test_Prop (P : Prop) := Test true (maybeProp P).
+Definition test_negative := Test false tt.
+
+Structure type :=
+  Check {result : bool; test : test_of result; frame : call_of test result}.
+Definition check result test frame := @Check result test frame.
+
+Module Exports.
+Canonical call.
+Canonical test_Prop.
+Canonical test_negative.
+Canonical check.
+Abbreviation nonPropType := type.
+Coercion callee : call_of >-> Sortclass.
+Coercion frame : type >-> call_of.
+Abbreviation notProp T := (@check false test_negative (call T)).
+End Exports.
+
+End NonPropType.
+Export NonPropType.Exports.
+
+Module Export ipat.
+
+Notation "'[' 'apply' ']'" := (ltac:(let f := fresh "_top_" in move=> f {}/f))
+  (at level 0, only parsing) : ssripat_scope.
+
+(* we try to preserve the naming by matching the names from the goal *)
+(* we do move to perform a hnf before trying to match                *)
+Notation "'[' 'swap' ']'" := (ltac:(move;
+  let x := lazymatch goal with
+    | |- forall (x : _), _ => fresh x | |- let x := _ in _ => fresh x | _ => fresh "_top_"
+  end in intro x; move;
+  let y := lazymatch goal with
+    | |- forall (y : _), _ => fresh y | |- let y := _ in _ => fresh y | _ => fresh "_top_"
+  end in intro y; revert x; revert y))
+  (at level 0, only parsing) : ssripat_scope.
+
+
+(* we try to preserve the naming by matching the names from the goal *)
+(* we do move to perform a hnf before trying to match                *)
+Notation "'[' 'dup' ']'" := (ltac:(move;
+  lazymatch goal with
+  | |- forall (x : _), _ =>
+    let x := fresh x in intro x;
+    let copy := fresh x in have copy := x; revert x; revert copy
+  | |- let x := _ in _ =>
+    let x := fresh x in intro x;
+    let copy := fresh x in pose copy := x;
+    do [unfold x in (value of copy)]; revert x; revert copy
+  | |- _ =>
+    let x := fresh "_top_" in move=> x;
+    let copy := fresh "_top" in have copy := x; revert x; revert copy
+  end))
+  (at level 0, only parsing) : ssripat_scope.
+
+Notation "'[' '1' '!' rules ']'"     := (ltac:(rw rules))
+  (at level 0, rules at level 200, only parsing) : ssripat_scope.
+Notation "'[' '!' rules ']'"         := (ltac:(rw !rules))
+  (at level 0, rules at level 200, only parsing) : ssripat_scope.
+
+End ipat.
+
+(* A class to trigger reduction by rewriting.                           *)
+(* Usage: rw [pattern]vm_compute.                                       *)
+(* Alternatively one may redefine a lemma as in algebra/rat.v :         *)
+(* Lemma rat_vm_compute n (x : rat) : vm_compute_eq n%:Q x -> n%:Q = x. *)
+(* Proof. exact. Qed.                                                   *)
+
+Class vm_compute_eq {T : Type} (x y : T) := vm_compute : x = y.
+
+#[global]
+Hint Extern 0 (@vm_compute_eq _ _ _) =>
+       vm_compute; reflexivity : typeclass_instances.
diff --git a/theories/Corelib/ssr/ssrfun.v b/theories/Corelib/ssr/ssrfun.v
index 2a1809c8718d..fa714ce2f55c 100644
--- a/theories/Corelib/ssr/ssrfun.v
+++ b/theories/Corelib/ssr/ssrfun.v
@@ -232,7 +232,7 @@ Reserved Notation "f ^~ y" (at level 10, y at level 8, no associativity,
 Reserved Notation "@^~ x" (at level 10, x at level 8, no associativity,
   format "@^~  x").
 Reserved Notation "[ 'eta' f ]" (at level 0, format "[ 'eta'  f ]").
-Reserved Notation "'fun' => E" (at level 200, format "'fun' =>  E").
+Reserved Notation "'fun' => E" (at level 10, E at level 200, format "'fun' =>  E").
 
 Reserved Notation "[ 'fun' : T => E ]" (at level 0,
   format "'[hv' [ 'fun' :  T  => '/ '  E ] ']'").
@@ -445,7 +445,7 @@ 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.
+Proof. by move=> eq_fg eq_gh x; rw eq_fg. Qed.
 
 Lemma rrefl r : eqrel r r. Proof. by []. Qed.
 
@@ -470,7 +470,7 @@ Definition catcomp g f := comp f g.
 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 /comp eq_gg' eq_ff'. Qed.
+Proof. by move=> eq_ff' eq_gg' x; rw /comp eq_gg' eq_ff'. Qed.
 
 End Composition.
 
@@ -509,7 +509,7 @@ Proof. by []. Qed.
 Lemma omap_id (x : option rT) : omap id x = x. Proof. by case: x. Qed.
 
 Lemma eq_omap (h : aT -> rT) : f =1 h -> omap f =1 omap h.
-Proof. by move=> Ef [?|] //=; rewrite Ef. Qed.
+Proof. by move=> Ef [?|] //=; rw Ef. Qed.
 
 Lemma omapEapp : omap f = oapp (olift f) None.
 Proof. by []. Qed.
@@ -680,7 +680,7 @@ 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.
+Proof. by move=> fK x y /(congr1 g); rw !fK => [[]]. Qed.
 
 Lemma can_inj g : cancel g -> injective.
 Proof. by move/can_pcan; apply: pcan_inj. Qed.
@@ -707,7 +707,7 @@ Proof. by move=> injf [?|] [?|] //= [/injf->]. Qed.
 
 Lemma omapK {aT rT : Type} (f : aT -> rT) (g : rT -> aT) :
   cancel f g -> cancel (omap f) (omap g).
-Proof. by move=> fK [?|] //=; rewrite fK. Qed.
+Proof. by move=> fK [?|] //=; rw fK. Qed.
 
 Lemma of_voidK T : pcancel (of_void T) [fun _ => None].
 Proof. by case. Qed.
@@ -736,28 +736,28 @@ Lemma inj_compr : injective (f \o h) -> injective h.
 Proof. by move=> injfh x y /(congr1 f) /injfh. 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.
+Proof. by move=> fK hK x; rw /= 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.
+Proof. by move=> fK hK x; rw /pcomp fK /= hK. Qed.
 
 Lemma ocan_comp [fo : B -> option A] [ho : C -> option B]
     [f' : A -> B] [h' : B -> C] :
   ocancel fo f' -> ocancel ho h' -> ocancel (obind fo \o ho) (h' \o f').
 Proof.
-move=> fK hK c /=; rewrite -[RHS]hK/=; case hcE : (ho c) => [b|]//=.
-by rewrite -[b in RHS]fK; case: (fo b) => //=; have := hK c; rewrite hcE.
+move=> fK hK c /=; rw -[RHS]hK/=; case hcE : (ho c) => [b|]//=.
+by rw -[b in RHS]fK; case: (fo b) => //=; have := hK c; rw hcE.
 Qed.
 
 Lemma eq_inj : injective f -> f =1 g -> injective g.
-Proof. by move=> injf eqfg x y; rewrite -2!eqfg; apply: injf. Qed.
+Proof. by move=> injf eqfg x y; rw -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.
+Proof. by move=> fK eqfg eqfg' x; rw -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.
+Proof. by move=> fK injf' gK x; apply: injf'; rw fK. Qed.
 
 End InjectionsTheory.
 
@@ -775,7 +775,7 @@ 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.
+by case: bijf => h _ hK x; rw -[x]hK fK.
 Qed.
 
 Lemma bij_can_eq f' f'' : cancel f f' -> cancel f f'' -> f' =1 f''.
diff --git a/theories/Ltac2/Control.v b/theories/Ltac2/Control.v
index b818e30c0525..6d74219e0c0e 100644
--- a/theories/Ltac2/Control.v
+++ b/theories/Ltac2/Control.v
@@ -34,7 +34,11 @@ Ltac2 @ external case : (unit -> 'a) -> ('a * (exn -> 'a)) result := "rocq-runti
 - If [t ()] would fail with [e], [case t] returns [Err e].
 - If [t ()] would succeed and evaluate to [v] then [case t] returns [Val (v, h)],
   where [h] is the continuation to execute in case of subsequent failure.
-  [case] reifies a backtracking computation into an inspectable value, it allows the programmer to make explicit the effects which are normally implicit (i.e., they do not appear in the type system).
+  calling [h] resets the backtrackable state to its value when [case] was called.
+
+  [case] reifies a backtracking computation into an inspectable value,
+  it allows the programmer to make explicit the effects which are normally implicit
+  (i.e., they do not appear in the type system).
 *)
 
 Ltac2 once_plus (run : unit -> 'a) (handle : exn -> 'a) : 'a :=
@@ -88,6 +92,11 @@ Ltac2 @ external new_goal : evar -> unit := "rocq-runtime.plugins.ltac2" "new_go
     already defined in the current state, don't do anything. Panics if the
     evar is not in the current state. *)
 
+Ltac2 @external reorder_goals : int list -> unit := "rocq-runtime.plugins.ltac2" "reorder_goals".
+(** [reorder_goals l] reorders the goals according to (1-indexed) list [l]:
+    goal [i] after executing the tactic was goal [nth l (i-1)] before executing the tactic.
+    Throws if [l] is not a permutation of ints from [1] to [numgoals()]. *)
+
 Ltac2 @ external unshelve : (unit -> 'a) -> 'a := "rocq-runtime.plugins.ltac2" "unshelve".
 (** Runs the closure, then unshelves existential variables added to the
     shelf by its execution, prepending them to the current goal.
@@ -224,3 +233,31 @@ Ltac2 @ external timeout : int -> (unit -> 'a) -> 'a :=
 (** [timeoutf t thunk] calls [thunk ()] with a timeout of [t] seconds. *)
 Ltac2 @ external timeoutf : float -> (unit -> 'a) -> 'a :=
   "rocq-runtime.plugins.ltac2" "timeoutf".
+
+(** Error printing *)
+
+(** Print internal errors. *)
+Ltac2 @external print_err : err -> message
+  := "rocq-runtime.plugins.ltac2" "print_err".
+
+(** Print exceptions as errors. Used by the runtime when printing uncaught errors.
+    Extensible by mutation, see uses below.
+
+    IMPORTANT: when called for printing uncaught errors, it is run in an empty state
+    (no goals, empty evar map).
+
+    Also note that the "Internal" branch is not used when printing
+    uncaught errors as Internal exceptions are not considered as Ltac2
+    errors. *)
+Ltac2 mutable print_exn : exn -> message option := fun e =>
+  match e with
+  | Internal e => Some (print_err e)
+  | _ => None
+  end.
+
+#[global]
+Ltac2 Set print_exn as print_other := fun e =>
+  match e with
+  | Tactic_failure (Some msg) => Some msg
+  | _ => print_other e
+  end.
diff --git a/theories/Ltac2/Init.v b/theories/Ltac2/Init.v
index 43fa27cf6b73..2879e83ea115 100644
--- a/theories/Ltac2/Init.v
+++ b/theories/Ltac2/Init.v
@@ -15,6 +15,8 @@ Declare ML Module "rocq-runtime.plugins.ltac2_ltac1".
 
 #[export] Set Default Proof Mode "Ltac2".
 
+#[global] Ltac2 Open Scope core.
+
 (** Primitive types *)
 
 Ltac2 Type int.
diff --git a/theories/Ltac2/Ltac2.v b/theories/Ltac2/Ltac2.v
index 31ba9f0efcd2..e7a63a940297 100644
--- a/theories/Ltac2/Ltac2.v
+++ b/theories/Ltac2/Ltac2.v
@@ -36,6 +36,7 @@ Require Ltac2.Printf.
 Require Ltac2.Proj.
 Require Ltac2.RedFlags.
 Require Ltac2.Ref.
+Require Ltac2.Scheme.
 Require Ltac2.Std.
 Require Ltac2.String.
 Require Ltac2.Uint63.
diff --git a/theories/Ltac2/Notations.v b/theories/Ltac2/Notations.v
index 7399597ecd6b..5e21653a9121 100644
--- a/theories/Ltac2/Notations.v
+++ b/theories/Ltac2/Notations.v
@@ -640,3 +640,11 @@ Ltac2 Notation "now" t(thunk(tactic(6))) := now0 t.
 Ltac2 start_profiling () := ltac1:(start ltac profiling).
 Ltac2 stop_profiling () := ltac1:(stop ltac profiling).
 Ltac2 show_profile () := ltac1:(show ltac profile).
+
+(** General programming notations *)
+
+(* [f @@ g @@ h @@ x] is equivalent to [f (g (h x))] up to evaluation order of subterms. *)
+Ltac2 Notation f(self) "@@" x(self) : 2 := f x. (* right associative *)
+
+(* [x |> h |> g |> f] is equivalent to [f (g (h x))] up to evaluation order of subterms. *)
+Ltac2 Notation x(self) "|>" f(self) : 3 := f x. (* left associative *)
diff --git a/theories/Ltac2/Pattern.v b/theories/Ltac2/Pattern.v
index dbb3f159e367..2079606e2c96 100644
--- a/theories/Ltac2/Pattern.v
+++ b/theories/Ltac2/Pattern.v
@@ -77,47 +77,36 @@ Ltac2 @ external instantiate : context -> constr -> constr :=
 
 (** Implementation of Ltac matching over terms and goals *)
 
-Ltac2 Type 'a constr_matching := (match_kind * t * (context -> constr array -> 'a)) list.
-
-Ltac2 lazy_match0 t (pats:'a constr_matching) :=
+Ltac2 Type 'a one_constr_matching := match_kind * t * (context -> constr array -> 'a).
+Ltac2 Type 'a constr_matching := 'a one_constr_matching list.
+
+(** Returns a thunk so that we can differentiate between an error from
+    pattern matching and an error from the branch [f]. *)
+Ltac2 one_constr_match t (p:'a one_constr_matching) : unit -> 'a :=
+  let (knd, pat, f) := p in
+  match knd with
+  | MatchPattern =>
+      let context := empty_context in
+      let bind := matches_vect pat t in
+      fun () => f context bind
+  | MatchContext =>
+      let (context, bind) := matches_subterm_vect pat t in
+      fun () => f context bind
+  end.
+
+Ltac2 lazy_match0 t (pats:'a constr_matching) : 'a :=
   let rec interp m := match m with
   | [] => Control.zero Match_failure
   | p :: m =>
-    let next _ := interp m in
-    let (knd, pat, f) := p in
-    let p := match knd with
-    | MatchPattern =>
-      (fun _ =>
-        let context := empty_context in
-        let bind := matches_vect pat t in
-        fun _ => f context bind)
-    | MatchContext =>
-      (fun _ =>
-        let (context, bind) := matches_subterm_vect pat t in
-        fun _ => f context bind)
-    end in
-    Control.plus p next
+    Control.plus (fun () => one_constr_match t p) (fun _ => interp m)
   end in
   Control.once (fun () => interp pats) ().
 
-Ltac2 multi_match0 t (pats:'a constr_matching) :=
+Ltac2 multi_match0 t (pats:'a constr_matching) : 'a :=
   let rec interp e m := match m with
   | [] => Control.zero e
   | p :: m =>
-    let next e := interp e m in
-    let (knd, pat, f) := p in
-    let p := match knd with
-    | MatchPattern =>
-      (fun _ =>
-        let context := empty_context in
-        let bind := matches_vect pat t in
-        f context bind)
-    | MatchContext =>
-      (fun _ =>
-        let (context, bind) := matches_subterm_vect pat t in
-        f context bind)
-    end in
-    Control.plus p next
+    Control.plus (fun () => one_constr_match t p ()) (fun e => interp e m)
   end in
   interp Match_failure pats.
 
diff --git a/theories/Ltac2/Rewrite.v b/theories/Ltac2/Rewrite.v
index e8993255f07c..177eae0e32c2 100644
--- a/theories/Ltac2/Rewrite.v
+++ b/theories/Ltac2/Rewrite.v
@@ -120,6 +120,36 @@ Module Strategy.
   Ltac2 @external fix_ : (t -> t) -> t :=
     "rocq-runtime.plugins.ltac2" "rewstrat_fix".
 
+  (** The identity if the pattern matching succeeds, fails otherwise *)
+  Ltac2 @external matches : pattern -> t :=
+    "rocq-runtime.plugins.ltac2" "rewstrat_matches".
+
+  (** The rewrite success datatype, where [prf] should be of type [rel lhs rhs] *)
+  Ltac2 Type rewrite_success := { rel : constr; rhs : constr; prf : constr }.
+
+  (** A rewrite result can be any of a success, and identity step (no progress), or a failure *)
+  Ltac2 Type rewrite_result := [ Success (rewrite_success) | Identity | Fail ].
+
+  (** The [tactic f] strategy applies [f] to arguments [ty], [lhs] and [rel],
+      where [lhs] is the subterm being rewritten, of type [ty], and
+      an optional relation constraint [rel] is given.
+
+      The tactic is applied to a single goal of type [unit] whose context
+      corresponds to the context of the term to rewrite (i.e. the context of the
+      goal at the start of the [rewrite_strat] call extended with the binders
+      that were traversed to attain this subterm. The tactic should return a
+      [rewrite_result] indicating success, failure or no progress and should
+      *not* solve the goal. Solving the goal is an error that aborts the
+      [rewrite_strat] call. The success record contains the chosen relation
+      [rel], new right hand-side [rhs] and a proof [prf] of [rel t rhs].
+
+      If the proof [prf] is syntactically [eq_refl _], then the witness
+      of the rewriting is simply a *conversion* requiring no explicit
+      proof and no congruence lemmas for the context of the rewrite.
+   *)
+  Ltac2 @external tactic : (constr -> constr -> constr option -> rewrite_result) -> t :=
+    "rocq-runtime.plugins.ltac2" "rewstrat_tactic".
+
 End Strategy.
 
 (* Tactics *)
diff --git a/theories/Ltac2/Scheme.v b/theories/Ltac2/Scheme.v
new file mode 100644
index 000000000000..9899ae40e88b
--- /dev/null
+++ b/theories/Ltac2/Scheme.v
@@ -0,0 +1,138 @@
+(************************************************************************)
+(*         *      The Rocq Prover / The Rocq Development Team           *)
+(*  v      *         Copyright INRIA, CNRS and contributors             *)
+(*  Std.reference -> Std.reference option
+:= "rocq-runtime.plugins.ltac2" "scheme_lookup".
+(** [Scheme.lookup kind ref] looks up the scheme registered under [kind] for
+    the reference [ref]. Returns [None] if [ref] is not an inductive type or
+    if no such scheme is registered. *)
+
+(** {2 Elimination schemes} *)
+
+Ltac2 @ external rect_dep : kind
+:= "rocq-runtime.plugins.ltac2" "scheme_kind_rect_dep".
+(** Dependent recursion scheme for Type. *)
+
+Ltac2 @ external rec_dep : kind
+:= "rocq-runtime.plugins.ltac2" "scheme_kind_rec_dep".
+(** Dependent recursion scheme for Set. *)
+
+Ltac2 @ external ind_dep : kind
+:= "rocq-runtime.plugins.ltac2" "scheme_kind_ind_dep".
+(** Dependent induction scheme for Prop. *)
+
+Ltac2 @ external sind_dep : kind
+:= "rocq-runtime.plugins.ltac2" "scheme_kind_sind_dep".
+(** Dependent induction scheme for SProp. *)
+
+Ltac2 @ external rect_nodep : kind
+:= "rocq-runtime.plugins.ltac2" "scheme_kind_rect_nodep".
+(** Non-dependent recursion scheme for Type. *)
+
+Ltac2 @ external rec_nodep : kind
+:= "rocq-runtime.plugins.ltac2" "scheme_kind_rec_nodep".
+(** Non-dependent recursion scheme for Set. *)
+
+Ltac2 @ external ind_nodep : kind
+:= "rocq-runtime.plugins.ltac2" "scheme_kind_ind_nodep".
+(** Non-dependent induction scheme for Prop. *)
+
+Ltac2 @ external sind_nodep : kind
+:= "rocq-runtime.plugins.ltac2" "scheme_kind_sind_nodep".
+(** Non-dependent induction scheme for SProp. *)
+
+(** {2 Case analysis schemes} *)
+
+Ltac2 @ external case_dep : kind
+:= "rocq-runtime.plugins.ltac2" "scheme_kind_case_dep".
+(** Dependent case analysis scheme for Type. *)
+
+Ltac2 @ external case_nodep : kind
+:= "rocq-runtime.plugins.ltac2" "scheme_kind_case_nodep".
+(** Non-dependent case analysis scheme for Type. *)
+
+Ltac2 @ external casep_dep : kind
+:= "rocq-runtime.plugins.ltac2" "scheme_kind_casep_dep".
+(** Dependent case analysis scheme for Prop. *)
+
+Ltac2 @ external casep_nodep : kind
+:= "rocq-runtime.plugins.ltac2" "scheme_kind_casep_nodep".
+(** Non-dependent case analysis scheme for Prop. *)
+
+Ltac2 @ external scase_dep : kind
+:= "rocq-runtime.plugins.ltac2" "scheme_kind_scase_dep".
+(** Dependent case analysis scheme for SProp. *)
+
+Ltac2 @ external scase_nodep : kind
+:= "rocq-runtime.plugins.ltac2" "scheme_kind_scase_nodep".
+(** Non-dependent case analysis scheme for SProp. *)
+
+(** {2 Equality schemes} *)
+
+Ltac2 @ external sym : kind
+:= "rocq-runtime.plugins.ltac2" "scheme_kind_sym".
+(** Symmetry scheme. *)
+
+Ltac2 @ external sym_involutive : kind
+:= "rocq-runtime.plugins.ltac2" "scheme_kind_sym_involutive".
+(** Involutive symmetry scheme. *)
+
+Ltac2 @ external rew : kind
+:= "rocq-runtime.plugins.ltac2" "scheme_kind_rew".
+(** Right-to-left rewriting scheme. *)
+
+Ltac2 @ external rew_dep : kind
+:= "rocq-runtime.plugins.ltac2" "scheme_kind_rew_dep".
+(** Right-to-left dependent rewriting scheme. *)
+
+Ltac2 @ external rew_fwd_dep : kind
+:= "rocq-runtime.plugins.ltac2" "scheme_kind_rew_fwd_dep".
+(** Right-to-left forward dependent rewriting scheme. *)
+
+Ltac2 @ external rew_r : kind
+:= "rocq-runtime.plugins.ltac2" "scheme_kind_rew_r".
+(** Left-to-right rewriting scheme. *)
+
+Ltac2 @ external rew_r_dep : kind
+:= "rocq-runtime.plugins.ltac2" "scheme_kind_rew_r_dep".
+(** Left-to-right dependent rewriting scheme. *)
+
+Ltac2 @ external rew_fwd_r_dep : kind
+:= "rocq-runtime.plugins.ltac2" "scheme_kind_rew_fwd_r_dep".
+(** Left-to-right forward dependent rewriting scheme. *)
+
+Ltac2 @ external congr : kind
+:= "rocq-runtime.plugins.ltac2" "scheme_kind_congr".
+(** Congruence scheme. *)
+
+(** {2 Boolean equality and decidability schemes} *)
+
+Ltac2 @ external beq : kind
+:= "rocq-runtime.plugins.ltac2" "scheme_kind_beq".
+(** Boolean equality scheme. *)
+
+Ltac2 @ external dec_bl : kind
+:= "rocq-runtime.plugins.ltac2" "scheme_kind_dec_bl".
+(** Boolean to Leibniz equality scheme. *)
+
+Ltac2 @ external dec_lb : kind
+:= "rocq-runtime.plugins.ltac2" "scheme_kind_dec_lb".
+(** Leibniz to boolean equality scheme. *)
+
+Ltac2 @ external eq_dec : kind
+:= "rocq-runtime.plugins.ltac2" "scheme_kind_eq_dec".
+(** Decidable equality scheme. *)
diff --git a/theories/Ltac2/TransparentState.v b/theories/Ltac2/TransparentState.v
index 20cfdba2e8bd..420be95fe6e0 100644
--- a/theories/Ltac2/TransparentState.v
+++ b/theories/Ltac2/TransparentState.v
@@ -9,10 +9,23 @@
 (************************************************************************)
 
 Require Import Ltac2.Init.
+Require Import Ltac2.Std.
 
-(** Abstract type representing a transparency state. *)
+(** Abstract type representing a transparency state. A transparency state
+    is a set of variables, constants, and primitive projections.  *)
 Ltac2 Type t.
 
+(** Strategy levels used by [with_strategy].
+    [Expand] corresponds to the [-oo] level (always unfold),
+    [Opaque] corresponds to the [+oo] level (never unfold),
+    and [Level n] corresponds to integer level [n]
+    (where [Level 0] is [transparent]). *)
+Ltac2 Type strategy_level := [
+| Expand
+| Opaque
+| Level (int)
+].
+
 (** [empty] is the empty transparency state (all constants are opaque). *)
 Ltac2 @ external empty : t :=
   "rocq-runtime.plugins.ltac2" "empty_transparent_state".
@@ -25,3 +38,71 @@ Ltac2 @ external full : t :=
     by, e.g., the [Strategy] command, or the [with_strategy] Ltac tactic. *)
 Ltac2 @ external current : unit -> t :=
   "rocq-runtime.plugins.ltac2" "current_transparent_state".
+
+(** [union t1 t2] builds a transparency state containing all the variables,
+    constants, and primitive projections which are either in [t1] or in [t2]. *)
+Ltac2 @ external union : t -> t -> t :=
+  "rocq-runtime.plugins.ltac2" "union_transparent_state".
+
+(** [inter t1 t2] builds a transparency state containing all the variables,
+    constants, and primitive projections which are both in [t1] and in [t2]. *)
+Ltac2 @ external inter : t -> t -> t :=
+  "rocq-runtime.plugins.ltac2" "inter_transparent_state".
+
+(** [diff t1 t2] builds a transparency state containing all the variables,
+    constants, and primitive projections which are in [t1] but not in [t2]. *)
+Ltac2 @ external diff : t -> t -> t :=
+  "rocq-runtime.plugins.ltac2" "diff_transparent_state".
+
+(** [add_constant c t] adds the constant [c] to the transparency state [t].
+    Does nothing if the constant is already present. *)
+Ltac2 @ external add_constant : constant -> t -> t :=
+  "rocq-runtime.plugins.ltac2" "add_constant_transparent_state".
+
+(** [add_proj p t] adds the primitive projection [p] to the transparency
+    state [t]. Does nothing if the projection is already present. *)
+Ltac2 @ external add_proj : projection -> t -> t :=
+  "rocq-runtime.plugins.ltac2" "add_proj_transparent_state".
+
+(** [add_var p t] adds the local variable [v] to the transparency state [t].
+    Does nothing if the variable is already present. *)
+Ltac2 @ external add_var : ident -> t -> t :=
+  "rocq-runtime.plugins.ltac2" "add_var_transparent_state".
+
+(** [remove_constant c t] removes the constant [c] from the transparency
+    state [t]. Does nothing if the constant is not present. *)
+Ltac2 @ external remove_constant : constant -> t -> t :=
+  "rocq-runtime.plugins.ltac2" "remove_constant_transparent_state".
+
+(** [remove_proj p t] removes the primitive projection [p] from the
+    transparency state [t]. Does nothing if the projection is not present. *)
+Ltac2 @ external remove_proj : projection -> t -> t :=
+  "rocq-runtime.plugins.ltac2" "remove_proj_transparent_state".
+
+(** [remove_var p t] removes the local variable [v] from the transparency
+    state [t]. Does nothing if the variable is not present. *)
+Ltac2 @ external remove_var : ident -> t -> t :=
+  "rocq-runtime.plugins.ltac2" "remove_var_transparent_state".
+
+(** [mem_constant c t] checks whether the constant [c] is present in the
+    transparency state [t]. *)
+Ltac2 @ external mem_constant : constant -> t -> bool :=
+  "rocq-runtime.plugins.ltac2" "mem_constant_transparent_state".
+
+(** [mem_proj p t] checks whether the primitive projection [p] is present in the
+    transparency state [t]. *)
+Ltac2 @ external mem_proj : projection -> t -> bool :=
+  "rocq-runtime.plugins.ltac2" "mem_proj_transparent_state".
+
+(** [mem_var v t] checks whether the local variable [v] is present in the
+    transparency state [t]. *)
+Ltac2 @ external mem_var : ident -> t -> bool :=
+  "rocq-runtime.plugins.ltac2" "mem_var_transparent_state".
+
+(** [with_strategy lvl refs tac] temporarily sets the strategy level of
+    all references in [refs] to [lvl], executes [tac], and then restores
+    the original strategy levels. This is the Ltac2 analogue of the
+    [with_strategy] Ltac tactic and the [Strategy] vernacular command. *)
+Ltac2 @ external with_strategy :
+  strategy_level -> Std.reference list -> (unit -> 'a) -> 'a :=
+  "rocq-runtime.plugins.ltac2" "with_strategy".
diff --git a/tools/CoqMakefile.in b/tools/CoqMakefile.in
index 45da1177ae0e..44ac85b49f4b 100644
--- a/tools/CoqMakefile.in
+++ b/tools/CoqMakefile.in
@@ -784,9 +784,10 @@ define globvorule=
   $(1).vo $(1).glob &: $(1).v | $$(VDFILE)
 	$$(SHOW)ROCQ compile $(1).v
 	$$(HIDE)$$(TIMER) $$(ROCQ) compile $$(COQDEBUG) $$(TIMING_ARG) $$(PROFILE_ARG) $$(COQFLAGS) $$(COQLIBS) $(1).v
+	$$(HIDE)rm -f $(1).vos $(1).vok && touch $(1).vos $(1).vok # make empty vos and vok files
 	$$(HIDE)$$(PROFILE_ZIP)
 ifeq ($(COQDONATIVE), "yes")
-	$$(SHOW)COQNATIVE $(1).vo
+	$$(SHOW)ROCQ native-precompile $(1).vo
 	$$(HIDE)$$(call TIMER,$(1).vo.native) $$(COQNATIVE) $$(COQLIBS) $(1).vo
 endif
 
@@ -796,9 +797,10 @@ else
 $(VOFILES): %.vo: %.v | $(VDFILE)
 	$(SHOW)ROCQ compile $<
 	$(HIDE)$(TIMER) $(ROCQ) compile $(COQDEBUG) $(TIMING_ARG) $(PROFILE_ARG) $(COQFLAGS) $(COQLIBS) $<
+	$(HIDE)rm -f $@s $@k && touch $@s $@k # make empty vos and vok files
 	$(HIDE)$(PROFILE_ZIP)
 ifeq ($(COQDONATIVE), "yes")
-	$(SHOW)COQNATIVE $@
+	$(SHOW)ROCQ native-precompile $@
 	$(HIDE)$(call TIMER,$@.native) $(COQNATIVE) $(COQLIBS) $@
 endif
 
@@ -817,6 +819,7 @@ $(VFILES:.v=.vos): %.vos: %.v
 
 $(VFILES:.v=.vok): %.vok: %.v
 	$(SHOW)ROCQ compile -vok $<
+	$(HIDE)rm -f $@ && touch $@ # make empty vok file
 	$(HIDE)$(TIMER) $(ROCQ) compile -vok $(COQDEBUG) $(COQFLAGS) $(COQLIBS) $<
 
 $(addsuffix .timing.diff,$(VFILES)): %.timing.diff : %.before-timing %.after-timing
diff --git a/tools/configure/cmdArgs.ml b/tools/configure/cmdArgs.ml
index a6c6c78f98de..0852b886b768 100644
--- a/tools/configure/cmdArgs.ml
+++ b/tools/configure/cmdArgs.ml
@@ -116,9 +116,9 @@ let args_options = Arg.align [
   "-bytecode-compiler", arg_bool (fun p bytecodecompiler -> { p with bytecodecompiler }),
     "(yes|no) Enable Rocq's bytecode reduction machine (VM)";
   "-native-compiler", arg_native (fun p nativecompiler -> { p with nativecompiler }),
-    "(yes|no|ondemand) Compilation to native code for conversion and normalization
-     yes: -native-compiler option of coqc will default to 'yes', stdlib will be precompiled
-     no (default): no native compilation available at all
+    "(yes|no|ondemand) Compilation to native code for conversion and normalization\n\
+     yes: -native-compiler option of coqc will default to 'yes', stdlib will be precompiled\n\
+     no (default): no native compilation available at all\n\
      ondemand: -native-compiler option of coqc will default to 'ondemand', stdlib will not be precompiled";
   "-warn-error", arg_bool (fun p _warn_error -> warn_warn_error (); p),
     " Deprecated option: warnings are now adjusted in the corresponding build tool.";
diff --git a/tools/configure/configure.ml b/tools/configure/configure.ml
index a9329c1af616..cce117c34aeb 100644
--- a/tools/configure/configure.ml
+++ b/tools/configure/configure.ml
@@ -22,10 +22,30 @@ open CmdArgs.Prefs
 
 let (/) = Filename.concat
 
-let coq_version = "9.2+alpha"
-(* format: "%d%02d%d" major minor patch
-   for pre-release version (eg 9.2+alpha), use the previous minor, and patch = 99 *)
-let vo_magic = 90199
+type patch = Alpha | Rc of int | Release of int
+[@@warning "-unused-constructor"]
+
+let pr_patch = function
+  | Alpha -> "+alpha"
+  | Rc i -> "+rc" ^ string_of_int i
+  | Release i -> "." ^ string_of_int i
+
+let major = 9
+let minor = 3
+let patch = Alpha
+
+let coq_version = Printf.sprintf "%d.%d%s" major minor (pr_patch patch)
+
+let vo_magic =
+  let patch = match patch with
+    | Alpha -> -1
+    | Rc _ -> 0
+    | Release i -> i
+  in
+  major * 10_000 + minor * 100 + patch
+
+(* NB: not the same as checking patch = Release,
+   because post release commits still get patch = Release *)
 let is_a_released_version = false
 
 (** Default OCaml binaries *)
@@ -102,10 +122,15 @@ let resolve_caml () =
 let caml_version_nums { CamlConf.caml_version; _ } =
   generic_version_nums ~name:"the OCaml compiler" caml_version
 
+external native_available : unit -> bool = "rocq_native_available"
+
 let check_caml_version prefs caml_version caml_version_nums =
-  if caml_version_nums >= [5;0;0] && prefs.nativecompiler <> NativeNo then
+  if prefs.nativecompiler <> NativeNo && not (native_available ()) then
     let () = cprintf prefs "Your version of OCaml is %s." caml_version in
-    die "You have enabled Rocq's native compiler, however it is not compatible with OCaml >= 5.0.0"
+    if caml_version_nums >= [5;0;0] then
+      die "You have enabled Rocq's native compiler, however it is not compatible with OCaml >= 5.0.0 on this architecture"
+    else
+      die "You have enabled Rocq's native compiler, however it is not compatible with your OCaml compiler"
   else if caml_version_nums >= [4;14;0] then
     cprintf prefs "You have OCaml %s. Good!" caml_version
   else
@@ -137,8 +162,7 @@ let check_findlib_version prefs { CamlConf.findlib_version; _ } =
     70: ".ml file without .mli file" bogus warning when used generally
 *)
 
-(* Note, we list all warnings to be complete *)
-let coq_warnings = "-w -a+1..3-4+5..8-9+10..26-27+28..39-40-41-42+43-44-45+46..47-48+49..57-58+59..66-67-68+69-70"
+let coq_warnings = "-w +a-4-9-27-40..42-44-45-48-58-67-68-70"
 
 (* Flags used to compile Rocq and plugins (via coq_makefile) *)
 let caml_flags =
@@ -325,15 +349,24 @@ let cflags_dflt = "-Wall -Wno-unused -g -O2"
 let cflags_sse2 = "-msse2 -mfpmath=sse"
 
 (* cflags, sse2_math = *)
-let compute_cflags () =
-  let _, slurp =
-    (* Test SSE2_MATH support  *)
-    tryrun camlexec.find
-      ["ocamlc"; "-ccopt"; cflags_dflt ^ " -march=native -dM -E " ^ cflags_sse2;
-       "-c"; coqsrc/"dev/header.c"] in  (* any file *)
-  if List.exists (fun line -> starts_with line "#define __SSE2_MATH__ 1") slurp
-  then (cflags_dflt ^ " " ^ cflags_sse2, true)
-  else (cflags_dflt, false)
+let compute_cflags prefs =
+  let cflags = Buffer.create 17 in
+  Buffer.add_string cflags cflags_dflt;
+  let sse2_math =
+    let _, slurp =
+      (* Test SSE2_MATH support  *)
+      tryrun camlexec.find
+        ["ocamlc"; "-ccopt"; cflags_dflt ^ " -march=native -dM -E " ^ cflags_sse2;
+         "-c"; coqsrc/"dev/header.c"] in  (* any file *)
+    List.exists (fun line -> starts_with line "#define __SSE2_MATH__ 1") slurp in
+  if sse2_math then
+    begin
+      Buffer.add_char cflags ' ';
+      Buffer.add_string cflags cflags_sse2
+    end;
+  if prefs.nativecompiler = NativeNo then
+    Buffer.add_string cflags " -DNO_NATIVE_COMPUTE";
+  (Buffer.contents cflags, sse2_math)
 
 (** Test at configure time that no harmful double rounding seems to
     be performed with an intermediate 80-bit representation (x87).
@@ -430,7 +463,7 @@ let write_coq_config_ml install_prefix camlenv coqenv caml_flags caml_version_nu
   pr_s "wwwcoq" prefs.coqwebsite;
   pr_s "wwwbugtracker" (prefs.coqwebsite ^ "bugs/");
   pr_s "wwwrefman" (prefs.coqwebsite ^ "doc/V" ^ coq_version ^ "/refman/");
-  pr_s "wwwstdlib" (prefs.coqwebsite ^ "doc/V" ^ coq_version ^ "/stdlib/");
+  pr_s "wwwcorelib" (prefs.coqwebsite ^ "doc/V" ^ coq_version ^ "/corelib/");
   pr_b "bytecode_compiler" prefs.bytecodecompiler;
   pr "type native_compiler = NativeOff | NativeOn of { ondemand : bool }\n";
   pr "let native_compiler = %s\n"
@@ -516,7 +549,7 @@ let main () =
   let install_dirs = install_dirs prefs arch in
   let install_prefix = select "COQPREFIX" install_dirs |> fst in
   let coqenv = resolve_coqenv install_dirs in
-  let cflags, sse2_math = compute_cflags () in
+  let cflags, sse2_math = compute_cflags prefs in
   check_fmath sse2_math;
   if not prefs.quiet then
     print_summary prefs arch camlenv install_dirs browser;
diff --git a/tools/configure/dune b/tools/configure/dune
index 3e560be6e43d..d6a97c5dcd2c 100644
--- a/tools/configure/dune
+++ b/tools/configure/dune
@@ -1,7 +1,11 @@
 (library
  (name conf)
  (modules :standard \ configure)
- (libraries unix str))
+ (libraries unix str)
+ (foreign_stubs
+  (language c)
+  (names rocq_configure)
+  (flags :standard)))
 
 (executable
  (name configure)
diff --git a/tools/configure/rocq_configure.c b/tools/configure/rocq_configure.c
new file mode 100644
index 000000000000..05290dbf97e2
--- /dev/null
+++ b/tools/configure/rocq_configure.c
@@ -0,0 +1,17 @@
+#include 
+
+/* Keep in sync with rocq_values.c */
+
+#if defined(__GNUC__) && defined(__amd64__)
+#elif defined(__GNUC__) && defined(__i386__)
+#elif defined(NO_NAKED_POINTERS)
+#define no_native_compute
+#endif
+
+value rocq_native_available(value dummy) {
+#ifdef no_native_compute
+  return Val_int(0);
+#else
+  return Val_int(1);
+#endif
+}
diff --git a/tools/coqdep/lib/common.ml b/tools/coqdep/lib/common.ml
index 0edf791f2220..fd15ba00dc2c 100644
--- a/tools/coqdep/lib/common.ml
+++ b/tools/coqdep/lib/common.ml
@@ -12,7 +12,14 @@
     - first string is the full filename, with only its extension removed
     - second string is the absolute version of the previous (via getcwd)
 *)
-type vAccu = (string * string) list
+type vAccu = { acc : string list; map : string CString.Map.t }
+
+let add_vAccu (f, f') vAccu =
+  let acc = f :: vAccu.acc in
+  let map = CString.Map.add f' f vAccu.map in
+  { acc; map }
+
+let empty_vAccu = { acc = []; map = CString.Map.empty }
 
 let filename_concat ~separator_hack dir name =
   if separator_hack
@@ -24,13 +31,15 @@ let filename_concat ~separator_hack dir name =
    hack and we should remove it, and instead require users to follow
    the same naming convention *)
 let canonize ~separator_hack vAccu f =
+  let dir = Loadpath.Filename.dirname f in
+  let f = Loadpath.Filename.repr f in
   let f' = filename_concat ~separator_hack
-      (Loadpath.absolute_dir (Filename.dirname f))
+      dir
       (Filename.basename f)
   in
-  match List.filter (fun (_,full) -> f' = full) vAccu with
-    | (f,_) :: _ -> f
-    | _ -> f
+  match CString.Map.find_opt f' vAccu.map with
+  | None -> f
+  | Some f -> f
 
 type what = Library | External
 let str_of_what = function Library -> "library" | External -> "external file"
@@ -46,8 +55,12 @@ let warning_module_notfound =
   CWarnings.create ~name:"module-not-found"
     ~category:CWarnings.CoreCategories.filesystem warn
 
-let warn_if_clash ?(what=Library) exact file dir f1 = let open Format in function
+let warn_if_clash ?(what=Library) exact file dir f1 = function
   | f2::fl ->
+      let open Format in
+      let f1 = Loadpath.Filename.repr f1 in
+      let f2 = Loadpath.Filename.repr f2 in
+      let fl = List.map Loadpath.Filename.repr fl in
       let f =
         match what with
         | Library -> Filename.basename f1 ^ ".v"
@@ -83,19 +96,19 @@ let safe_assoc ?(warn_clashes=true) st ?(what=Library) from file k =
   | None -> None
   | Some (Loadpath.ExactMatches fs) ->
     let f = fs.Loadpath.point in
-    let l = Loadpath.FileSet.elements fs.files in
-    let l = List.map Loadpath.Filename.repr l in
-    let l = List.filter (fun f' -> not (String.equal f f')) l in
+    let l = Loadpath.FileSet.remove f fs.files in
+    let l = Loadpath.FileSet.elements l in
     if warn_clashes then warn_if_clash ~what true file k f l;
     Some [f]
   | Some (Loadpath.PartialMatchesInSameRoot (root, l)) ->
     let l = Loadpath.FileSet.elements l.files in
-    let l = List.map Loadpath.Filename.repr l in
-    (match List.sort String.compare l with [] -> assert false | f :: l as all ->
+    let sort f1 f2 = String.compare (Loadpath.Filename.repr f1) (Loadpath.Filename.repr f2) in
+    let all = List.sort sort l in
+    let f, l = match all with [] -> assert false | f :: l -> f, l in
     (* If several files match, it will fail at Require;
        To be "fair", in rocq dep, we add dependencies on all matching files *)
-    if warn_clashes then warn_if_clash ~what false file k f l;
-    Some all)
+    let () = if warn_clashes then warn_if_clash ~what false file k f l in
+    Some all
 
 let file_name ~separator_hack s = function
   | None     -> s
@@ -103,7 +116,10 @@ let file_name ~separator_hack s = function
 
 module VData = struct
   type t = string list option * string list
-  let compare = compare
+  let cmp_list l1 l2 = List.compare String.compare l1 l2
+  let compare (from1, str1) (from2, str2) =
+    let c = Option.compare cmp_list from1 from2 in
+    if Int.equal c 0 then cmp_list str1 str2 else c
 end
 
 module VCache = Set.Make(VData)
@@ -142,6 +158,16 @@ let with_in_channel ~fname f =
   in
   Util.try_finally f chan close_in chan
 
+let with_in_descr ~fname f =
+  let descr =
+    try Unix.openfile fname [O_RDONLY] 0o000
+    with Unix.Unix_error (_, _, msg) -> Error.cannot_open fname msg
+  in
+  Util.try_finally f descr Unix.close descr
+
+let lexbuf_from_descr ?with_positions ic =
+  Lexing.from_function ?with_positions (fun buf n -> Unix.read ic buf 0 n)
+
 module State = struct
   type t = {
     loadpath : Loadpath.State.t;
@@ -151,6 +177,8 @@ module State = struct
   let loadpath x = x.loadpath
 end
 
+exception SyntaxErrorInFile of string
+
 (* recursive because of Load *)
 let rec find_dependencies ({State.vAccu; separator_hack; loadpath} as st) basename =
   (* Visited marks *)
@@ -173,15 +201,21 @@ let rec find_dependencies ({State.vAccu; separator_hack; loadpath} as st) basena
 
   (* Reading file contents *)
   let f = basename ^ ".v" in
-  with_in_channel ~fname:f @@ fun chan ->
-  let buf = Lexing.from_channel chan in
+  with_in_descr ~fname:f @@ fun chan ->
+  (* For lexing efficiency purposes, we ignore the positions in this function.
+     This will force us to reparse the file in case of error to get a proper
+     location, but in practice such errors should be exceedingly rare with
+     rocqdep. This lexer is indeed basically able to handle random nonsense
+     thrown at it. *)
+  let buf = lexbuf_from_descr ~with_positions:false chan in
   let open Lexer in
   let rec loop () =
     match coq_action buf with
     | exception Fin_fichier ->
       DepSet.elements !dependencies
-    | exception Syntax_error (i,j) ->
-      Error.cannot_parse f (i,j)
+    | exception Syntax_error _ ->
+      (* The locations are garbage due to with_positions:false, ignore them *)
+      raise (SyntaxErrorInFile f)
     | tok ->  match tok with
       | Require (from, strl) ->
         let from, strl = coq_to_stdlib from strl in
@@ -228,12 +262,14 @@ let rec find_dependencies ({State.vAccu; separator_hack; loadpath} as st) basena
               if should_visit_v_and_mark None [str] then safe_assoc loadpath None f [str]
               else None
             else
-              Some [canonize ~separator_hack vAccu str]
+              let ans = canonize ~separator_hack vAccu (Loadpath.Filename.make str) in
+              Some [Loadpath.Filename.make ans]
         in
         (match canon with
          | None -> ()
          | Some l ->
            let decl canon =
+             let canon = Loadpath.Filename.repr canon in
              add_dep_other (Format.sprintf "%s.v" canon);
              let deps = find_dependencies st canon in
              List.iter add_dep deps
@@ -252,9 +288,28 @@ let rec find_dependencies ({State.vAccu; separator_hack; loadpath} as st) basena
   in
   loop ()
 
+(* Reparse the file to get the error location *)
+let get_parse_error f =
+  with_in_channel ~fname:f @@ fun chan ->
+  let buf = Lexing.from_channel chan in
+  let rec loop () = match Lexer.coq_action buf with
+  | _tok -> loop ()
+  | exception Lexer.Syntax_error (i, j) -> (i, j)
+  | exception Lexer.Fin_fichier ->
+    (* may technically happen due to race conditions, return a dummy value *)
+    (0, 0)
+  in
+  loop ()
+
+let find_dependencies st basename =
+  try find_dependencies st basename
+  with SyntaxErrorInFile f ->
+    let (i, j) = get_parse_error f in
+    Error.cannot_parse f (i, j)
+
 let compute_deps st =
-  let mk_dep (name, _orig_path) = Dep_info.make ~name ~deps:(find_dependencies st name) in
-  st.vAccu |> CList.rev_map mk_dep
+  let mk_dep name = Dep_info.make ~name ~deps:(find_dependencies st name) in
+  List.rev st.vAccu.acc |> List.to_seq |> Seq.map mk_dep
 
 let rec treat_file ~separator_hack vAccu old_dirname old_name =
   let name = Filename.basename old_name
@@ -289,7 +344,7 @@ let rec treat_file ~separator_hack vAccu old_dirname old_name =
        let name = file_name ~separator_hack base dirname in
        let filename_concat = filename_concat ~separator_hack in
        let absname = Loadpath.absolute_file_name ~filename_concat base dirname in
-       (name, absname) :: vAccu
+       add_vAccu (name, absname) vAccu
      | _ -> vAccu)
   | _ -> vAccu
 
@@ -323,7 +378,7 @@ let sort {State.vAccu; separator_hack; loadpath} =
         Format.printf "%s.v " file
     end
   in
-  List.iter (fun (name, _) -> loop name) vAccu
+  List.iter (fun name -> loop (Loadpath.Filename.make name)) vAccu.acc
 
 let add_include st (rc, r, ln) =
   if rc then
@@ -359,4 +414,4 @@ let init ~make_separator_hack args =
   findlib_init ml_path;
   List.iter (add_include loadpath) args.Args.vo_path;
   Makefile.set_dyndep args.Args.dyndep;
-  rocqenv, { State.vAccu = []; loadpath; separator_hack = make_separator_hack }
+  rocqenv, { State.vAccu = empty_vAccu; loadpath; separator_hack = make_separator_hack }
diff --git a/tools/coqdep/lib/common.mli b/tools/coqdep/lib/common.mli
index 3a8252c8fd67..383655510a5c 100644
--- a/tools/coqdep/lib/common.mli
+++ b/tools/coqdep/lib/common.mli
@@ -21,4 +21,4 @@ val treat_file_command_line : State.t -> string -> State.t
 
 val sort : State.t -> unit
 
-val compute_deps : State.t -> Dep_info.t list
+val compute_deps : State.t -> Dep_info.t Seq.t
diff --git a/tools/coqdep/lib/dune b/tools/coqdep/lib/dune
index 8c8fa56cff51..69c504f9f527 100644
--- a/tools/coqdep/lib/dune
+++ b/tools/coqdep/lib/dune
@@ -3,14 +3,8 @@
  (public_name rocq-runtime.coqdeplib)
  (libraries rocq-runtime.boot rocq-runtime.lib findlib.internal))
 
-(ocamllex lexer)
-
 (rule
- (targets static_toplevel_libs.ml)
- (deps %{workspace_root}/_build/install/%{context_name}/lib/rocq-runtime/META)
- (action
-  (with-stdout-to %{targets}
-   (run ocamlfind query -recursive -predicates native rocq-runtime.toplevel
-        -prefix "let static_toplevel_libs = [\n"
-        -format "\"%p\";"
-        -suffix "\n]\n"))))
+ (target lexer.ml)
+ (deps   lexer.mll)
+ (action (chdir %{workspace_root}
+          (run %{bin:ocamllex} -ml -q -o %{target} %{deps}))))
diff --git a/tools/coqdep/lib/fl.ml b/tools/coqdep/lib/fl.ml
index 01bfdeda5ce5..8de1d5ccf116 100644
--- a/tools/coqdep/lib/fl.ml
+++ b/tools/coqdep/lib/fl.ml
@@ -72,12 +72,16 @@ let findlib_resolve ~package =
   let cmxs_file = List.map relative_if_dune cmxss in
   (meta_file, cmxs_file)
 
-let static_libs = CString.Set.of_list Static_toplevel_libs.static_toplevel_libs
+let static_libs () =
+  let packages = Findlib.package_deep_ancestors coqc_predicates ["rocq-runtime.toplevel"] in
+  CString.Set.of_list packages
+
+let static_libs = Lazy.from_fun static_libs
 
 let findlib_deep_resolve ~package =
   let packages = Findlib.package_deep_ancestors coqc_predicates [package] in
   let packages = CList.filter (fun package ->
-      not (CString.Set.mem package static_libs))
+      not (CString.Set.mem package (Lazy.force static_libs)))
       packages
   in
   List.fold_left (fun (metas,cmxss) package ->
diff --git a/tools/coqdep/lib/lexer.mll b/tools/coqdep/lib/lexer.mll
index c4336d96730c..38b37428437b 100644
--- a/tools/coqdep/lib/lexer.mll
+++ b/tools/coqdep/lib/lexer.mll
@@ -51,6 +51,28 @@
     let s = Lexing.lexeme lexbuf in
     check_valid lexbuf (String.sub s 1 (String.length s - 1))
 
+  let fast_skip_to_dot lexbuf =
+    let open Lexing in
+    (* partial backtrack, we need to consider the character discarded by '_' *)
+    let () = lexbuf.lex_curr_pos <- lexbuf.lex_last_pos in
+    let rec ignore_to_dot curr len buf =
+      if len <= curr then curr
+      else match Bytes.unsafe_get buf curr with
+      | '.' -> curr
+      | '(' ->
+        if curr + 1 < len && Bytes.unsafe_get buf (curr + 1) != '*' then
+          ignore_to_dot (curr + 1) len buf
+        else
+          curr
+      | _ -> ignore_to_dot (curr + 1) len buf
+    in
+    let () = lexbuf.Lexing.lex_start_pos <- lexbuf.lex_curr_pos in
+    let pos = ignore_to_dot lexbuf.lex_curr_pos lexbuf.lex_buffer_len lexbuf.lex_buffer in
+    if pos > lexbuf.lex_curr_pos then
+      let () = lexbuf.lex_curr_pos <- pos in
+      let () = lexbuf.lex_last_pos <- pos - 1 in
+      ()
+
 }
 
 let space = [' ' '\t' '\n' '\r']
@@ -212,6 +234,12 @@ and require_file from = parse
       { syntax_error lexbuf }
 
 and skip_to_dot = parse
+  | eof
+      { syntax_error lexbuf }
+  | _
+      { fast_skip_to_dot lexbuf; slow_skip_to_dot lexbuf }
+
+and slow_skip_to_dot = parse
   | "(*"
       { comment lexbuf; skip_to_dot lexbuf }
   | dot { () }
diff --git a/tools/coqdep/lib/loadpath.ml b/tools/coqdep/lib/loadpath.ml
index c5a84bf79a22..067a9d3a85a6 100644
--- a/tools/coqdep/lib/loadpath.ml
+++ b/tools/coqdep/lib/loadpath.ml
@@ -75,36 +75,41 @@ let register_dir_logpath, find_dir_logpath =
     (see discussion at PR #14718)
 *)
 
+type 'a subdir =
+| SubEmpty
+| SubNode of 'a subdir * 'a subdir * 'a
+
+let rec iter_subdir f = function
+| SubEmpty -> ()
+| SubNode (hd, tl, cur) ->
+  let () = iter_subdir f hd in
+  let () = iter_subdir f tl in
+  List.iter f cur
+
 let add_directory recur add_file phys_dir log_dir =
   let root = (phys_dir, log_dir) in
-  let stack = ref [] in
-  let curdirfiles = ref [] in
-  let subdirfiles = ref [] in
   let rec aux phys_dir log_dir =
     if System.exists_dir phys_dir then
-      begin
-        register_dir_logpath phys_dir log_dir;
-        let f = function
-          | System.FileDir (phys_f,f) ->
-              if recur then begin
-                stack := (!curdirfiles, !subdirfiles) :: !stack;
-                curdirfiles := []; subdirfiles := [];
-                aux phys_f (log_dir @ [f]);
-                let curdirfiles', subdirfiles' = List.hd !stack in
-                subdirfiles := subdirfiles' @ !subdirfiles @ !curdirfiles;
-                curdirfiles := curdirfiles'; stack := List.tl !stack
-              end
-          | System.FileRegular f ->
-              curdirfiles := (phys_dir, log_dir, f) :: !curdirfiles
-        in
-        System.process_directory f phys_dir
-      end
+      let () = register_dir_logpath phys_dir log_dir in
+      let curdirfiles = ref [] in
+      let subdirfiles = ref SubEmpty in
+      let f = function
+      | System.FileDir (phys_f,f) ->
+        if recur then
+          let (ncurdirfiles, nsubdirfiles) = aux phys_f (log_dir @ [f]) in
+          subdirfiles := SubNode (!subdirfiles, nsubdirfiles, ncurdirfiles)
+      | System.FileRegular f ->
+        curdirfiles := (phys_dir, log_dir, f) :: !curdirfiles
+      in
+      let () = System.process_directory f phys_dir in
+      (!curdirfiles, !subdirfiles)
     else
-      System.warn_cannot_open_dir phys_dir
+      let () = System.warn_cannot_open_dir phys_dir in
+      ([], SubEmpty)
   in
-  aux phys_dir log_dir;
-  List.iter (fun (phys_dir, log_dir, f) -> add_file root phys_dir log_dir f) !subdirfiles;
-  List.iter (fun (phys_dir, log_dir, f) -> add_file root phys_dir log_dir f) !curdirfiles
+  let (curdirfiles, subdirfiles) = aux phys_dir log_dir in
+  iter_subdir (fun (phys_dir, log_dir, f) -> add_file root phys_dir log_dir f) subdirfiles;
+  List.iter (fun (phys_dir, log_dir, f) -> add_file root phys_dir log_dir f) curdirfiles
 
 (** [get_extension f l] checks whether [f] has one of the extensions
     listed in [l]. It returns [f] without its extension, alongside with
@@ -139,24 +144,30 @@ struct
 
 type t = {
   user : filename;
-  absolute : filename;
+  dir : string; (* absolute path, normalized through absolute_dir *)
+  basename : string;
 }
 
-let make s = {
-  user = s;
-  absolute = absolute_file_name ~filename_concat:Filename.concat (Filename.basename s) (Some (Filename.dirname s));
-}
+let make s =
+  let dir = absolute_dir (Filename.dirname s) in
+  (* See the proviso in {!absolute_file_name} *)
+  let basename = Filename.basename s in
+  { user = s; dir; basename }
 
-let compare f1 f2 = String.compare f1.absolute f2.absolute
+let compare f1 f2 =
+  let c = String.compare f1.basename f2.basename in
+  if c <> 0 then c else String.compare f1.dir f2.dir
 
 let repr f = f.user
 
+let dirname f = f.dir
+
 end
 
 module FileSet = Set.Make(Filename)
 
 type fileset = {
-  point : filename;
+  point : Filename.t;
   files : FileSet.t; (* guaranteed to contain [point] *)
 }
 
@@ -194,8 +205,10 @@ let get_worker_path st =
     st.worker <- Some w;
     w
 
-let singleton f = { point = f; files = FileSet.singleton (Filename.make f) }
-let add_set f l = { point = f; files = FileSet.add (Filename.make f) l.files }
+let singleton f =
+  { point = f; files = FileSet.singleton f }
+let add_set f l =
+  { point = f; files = FileSet.add f l.files }
 
 let insert_key root (full,f) m =
   (* An exact match takes precedence over non-exact matches *)
@@ -241,6 +254,7 @@ let add_paths recur root table phys_dir log_dir basename =
   let name = log_dir@[basename] in
   let file = System.(phys_dir // basename) in
   let paths = cuts recur name in
+  let file = Filename.make file in
   let iter n = safe_add table root (n, file) in
   List.iter iter paths
 
diff --git a/tools/coqdep/lib/loadpath.mli b/tools/coqdep/lib/loadpath.mli
index 8088f2efed80..2888d800675b 100644
--- a/tools/coqdep/lib/loadpath.mli
+++ b/tools/coqdep/lib/loadpath.mli
@@ -22,13 +22,16 @@ type root = filename * dirpath
 module Filename :
 sig
   type t
+  val make : filename -> t
   val repr : t -> filename
+  val dirname : t -> dirname
+  (** Guaranteed to be absolute, as if obtained through {!absolute_dir} *)
 end
 
 module FileSet : Set.S with type elt = Filename.t
 
 type fileset = private {
-  point : filename;
+  point : Filename.t;
   files : FileSet.t; (* guaranteed to contain [point] *)
 }
 
diff --git a/tools/coqdep/lib/makefile.ml b/tools/coqdep/lib/makefile.ml
index 9d65283d3a89..275fe8c71360 100644
--- a/tools/coqdep/lib/makefile.ml
+++ b/tools/coqdep/lib/makefile.ml
@@ -52,25 +52,36 @@ let set_dyndep = function
   | "var" -> option_dynlink := Variable
   | o -> CErrors.user_err Pp.(str "Incorrect -dyndep option: " ++ str o)
 
+type pp = { pp : formatter -> unit }
+
+let pp_of_string s = { pp = fun fmt -> pp_print_string fmt s }
+
 let mldep_to_make base =
   match !option_dynlink with
   | No -> []
-  | Byte -> [sprintf "%s.cma" base]
-  | Opt -> [sprintf "%s.cmxs" base]
+  | Byte -> [pp_of_string @@ sprintf "%s.cma" base]
+  | Opt -> [pp_of_string @@ sprintf "%s.cmxs" base]
   | Both ->
-    [sprintf "%s.cma" base; sprintf "%s.cmxs" base]
+    [pp_of_string @@ sprintf "%s.cma" base; pp_of_string @@ sprintf "%s.cmxs" base]
   | Variable ->
-    [sprintf "%s%s" base "$(DYNLIB)"]
+    [pp_of_string @@ sprintf "%s%s" base "$(DYNLIB)"]
 
 let string_of_dep ~suffix = let open Dep_info.Dep in
   function
-  | Require basename -> [escape basename ^ suffix]
-  | Ml base -> mldep_to_make (escape base)
-  | Other s -> [escape s]
+  | Require basename -> List.to_seq [{ pp = fun fmt -> fprintf fmt "%s%s" (escape basename) suffix }]
+  | Ml base -> List.to_seq @@ mldep_to_make (escape base)
+  | Other s -> List.to_seq @@ [pp_of_string @@ escape s]
+
+let pp_concat pp fmt s = match Seq.uncons s with
+| None -> ()
+| Some (hd, s) ->
+  let () = pp fmt hd in
+  Seq.iter (fun data -> fprintf fmt " %a" pp data) s
 
-let string_of_dependency_list ~suffix deps =
-  List.map (string_of_dep ~suffix) deps
-  |> List.concat |> String.concat " "
+let pp_dependency_list ~suffix fmt deps =
+  let deps = List.to_seq deps in
+  let deps = Seq.concat_map (fun dep -> string_of_dep ~suffix dep) deps in
+  pp_concat (fun fmt s -> s.pp fmt) fmt deps
 
 let option_noglob = ref false
 let option_write_vos = ref false
@@ -80,9 +91,9 @@ let set_write_vos vos = option_write_vos := vos
 let print_dep fmt { Dep_info.name; deps } =
   let ename = escape name in
     let glob = if !option_noglob then "" else ename^".glob " in
-  fprintf fmt "%s.vo %s%s.v.beautified %s.required_vo: %s.v %s\n" ename glob ename ename ename
-    (string_of_dependency_list ~suffix:".vo" deps);
+  fprintf fmt "%s.vo %s%s.v.beautified %s.required_vo: %s.v %a\n" ename glob ename ename ename
+    (pp_dependency_list ~suffix:".vo") deps;
   if !option_write_vos then
-    fprintf fmt "%s.vos %s.vok %s.required_vos: %s.v %s\n" ename ename ename ename
-      (string_of_dependency_list ~suffix:".vos" deps);
+    fprintf fmt "%s.vos %s.vok %s.required_vos: %s.v %a\n" ename ename ename ename
+      (pp_dependency_list ~suffix:".vos") deps;
   fprintf fmt "%!"
diff --git a/tools/coqdep/lib/rocqdep_main.ml b/tools/coqdep/lib/rocqdep_main.ml
index a9c522cc0f6f..4f2c04a698e1 100644
--- a/tools/coqdep/lib/rocqdep_main.ml
+++ b/tools/coqdep/lib/rocqdep_main.ml
@@ -50,7 +50,7 @@ let coqdep args =
   if args.Args.sort then
     sort st
   else
-    compute_deps st |> List.iter (Makefile.print_dep Format.std_formatter)
+    compute_deps st |> Seq.iter (Makefile.print_dep Format.std_formatter)
 
 let main args =
   try
diff --git a/tools/coqdoc/cmdArgs.ml b/tools/coqdoc/cmdArgs.ml
index 91a2504c1ac1..3a2b531e40e6 100644
--- a/tools/coqdoc/cmdArgs.ml
+++ b/tools/coqdoc/cmdArgs.ml
@@ -97,6 +97,8 @@ let args_options = Arg.align [
   " Produce a LaTeX document";
   "--texmacs",arg_set (fun p -> { p with targetlang = TeXmacs }),
   " Produce a TeXmacs document";
+  "--alectryon", arg_set (fun p -> { p with targetlang = AlectryonMarkdown }),
+  " Produce a Markdown document for Alectryon";
   "--raw", arg_set (fun p -> { p with targetlang = Raw }),
   " Produce a text document";
   "--dvi", arg_set (fun p -> { { p with targetlang = LaTeX }
@@ -184,8 +186,10 @@ let args_options = Arg.align [
   " No links to Rocq standard library";
   "--external", arg_url_path (fun url lp -> Index.add_external_library lp url),
   "   Set URL for external library ";
-  "--coqlib_url", arg_string (fun p u -> { p with coqlib_url = u }),
-  " Set URL for Rocq standard library (default: " ^ Coq_config.wwwstdlib ^ ")";
+  "--corelib_url", arg_string (fun p u -> { p with corelib_url = u }),
+  " Set URL for Rocq standard library (default: " ^ Coq_config.wwwcorelib ^ ")";
+  "--coqlib_url", arg_string (fun p u -> { p with corelib_url = u }),
+  " Set URL for Rocq standard library (default: " ^ Coq_config.wwwcorelib ^ ") (deprecated, use --corelib_url)";
   "--coqlib", arg_string (fun p d -> { p with coqlib = Some d }),
   " Set the path where Rocq files are installed";
   "-R", arg_path (fun p l -> { p with paths = l :: !prefs.paths }),
diff --git a/tools/coqdoc/common.ml b/tools/coqdoc/common.ml
index 090ddf093130..8dec42646ec4 100644
--- a/tools/coqdoc/common.ml
+++ b/tools/coqdoc/common.ml
@@ -9,7 +9,7 @@
 (************************************************************************)
 
 (* Misc types **********************************************************************)
-type target_language = LaTeX | HTML | TeXmacs | Raw
+type target_language = LaTeX | HTML | TeXmacs | AlectryonMarkdown | Raw
 type output_t = StdOut | MultFiles | File of string
 type coq_module = string
 type file_t = Vernac_file of string * coq_module | Latex_file of string
@@ -46,7 +46,7 @@ type t = {
   glob_source : glob_source_t;
   quiet : bool;
   externals : bool;
-  coqlib_url: string;
+  corelib_url: string;
   paths : (string * string) list;
   encoding : encoding_t;
   interpolate : bool;
@@ -81,7 +81,7 @@ let default : t = {
   glob_source = DotGlob;
   quiet = true;
   externals = true;
-  coqlib_url = Coq_config.wwwstdlib;
+  corelib_url = Coq_config.wwwcorelib;
   paths = [];
   encoding = {
     charset = "iso-8859-1";
diff --git a/tools/coqdoc/common.mli b/tools/coqdoc/common.mli
index 4bd49493a12d..2ddb86274c36 100644
--- a/tools/coqdoc/common.mli
+++ b/tools/coqdoc/common.mli
@@ -9,7 +9,7 @@
 (************************************************************************)
 
 (* Misc types **********************************************************************)
-type target_language = LaTeX | HTML | TeXmacs | Raw
+type target_language = LaTeX | HTML | TeXmacs | AlectryonMarkdown | Raw
 type output_t = StdOut | MultFiles | File of string
 type coq_module = string
 type file_t = Vernac_file of string * coq_module | Latex_file of string
@@ -51,7 +51,7 @@ type t = {
   glob_source : glob_source_t;
   quiet : bool;
   externals : bool;
-  coqlib_url : string;
+  corelib_url : string;
   paths : (string * string) list;
   encoding : encoding_t;
   interpolate : bool;
diff --git a/tools/coqdoc/index.ml b/tools/coqdoc/index.ml
index 941987e205e4..360d3a652094 100644
--- a/tools/coqdoc/index.ml
+++ b/tools/coqdoc/index.ml
@@ -120,7 +120,7 @@ let find_external_library logicalpath =
         else aux rest
   in aux !external_libraries
 
-let init_coqlib_library () = add_external_library "Corelib" !prefs.coqlib_url
+let init_coqlib_library () = add_external_library "Corelib" !prefs.corelib_url
 
 let find_module m =
   if Hashtbl.mem local_modules m then
diff --git a/tools/coqdoc/output.ml b/tools/coqdoc/output.ml
index 05df3ab1fb6f..b84c543adb8e 100644
--- a/tools/coqdoc/output.ml
+++ b/tools/coqdoc/output.ml
@@ -1119,6 +1119,122 @@ module TeXmacs = struct
 
 end
 
+(*s Alectryon Markdown output *)
+
+module AlectryonMarkdown = struct
+
+  let header () = ()
+
+  let trailer () = ()
+
+  let nbsp () = output_char ' '
+
+  let char = output_char
+
+  let latex_char = output_char
+  let latex_string = output_string
+
+  let html_char _ = ()
+  let html_string _ = ()
+
+  let raw_ident s =
+    for i = 0 to String.length s - 1 do char s.[i] done
+
+  let start_module () = ()
+
+  let start_latex_math () = output_string "{math}`"
+  let stop_latex_math () = output_string "`"
+
+  let start_verbatim inline =
+    if inline then output_char '`' else output_string "```\n"
+  let stop_verbatim inline =
+    if inline then output_char '`' else output_string "```\n"
+
+
+  let url addr name =
+    match name with
+    | Some n -> printf "[%s](%s)" n addr
+    | None -> printf "%s" addr
+
+  let start_quote () = printf "\""
+  let stop_quote () = printf "\""
+
+  let indentation n =
+      for _i = 1 to n do printf " " done
+
+  let keyword s loc = raw_ident s
+  let ident s loc = raw_ident s
+
+  let sublexer c l = char c
+  let sublexer_in_doc c = char c
+
+  let initialize () =
+    Tokens.token_tree := ref Tokens.empty_ttree;
+    Tokens.outfun := (fun _ _ _ _ -> failwith "Useless")
+
+  let proofbox () = Html.proofbox ()
+
+  let item n =
+    indentation ((n - 1) * 2);
+    if (n mod 2) = 1 then printf "-" else printf "*"
+  let stop_item () = ()
+  let reach_item_level _ = ()
+
+  let start_doc () = ()
+  let end_doc () = ()
+
+  let start_emph () = printf "_"
+  let stop_emph () = printf "_"
+
+  let start_details summary =
+    match summary with
+    | Some summary -> printf ":::{dropdown} %s\n" summary
+    | None -> output_string ":::{dropdown}\n"
+
+  let stop_details () = output_string "\n:::\n"
+
+  let start_comment () = printf "(*"
+  let end_comment () = printf "*)"
+
+  let start_coq () =
+    output_string "```{coq}\n"
+  let end_coq () =
+    output_string "```\n"
+
+  let section_kind =
+    function
+      | 1 -> "# "
+      | 2 -> "## "
+      | 3 -> "### "
+      | 4 -> "#### "
+      | _ -> assert false
+
+  let section lev f =
+    output_string (section_kind lev);
+    f ();
+    output_string "\n"
+
+  let rule () = printf "\n---\n"
+
+  let paragraph () = printf "\n\n"
+
+  let line_break () = printf "\n"
+
+  let empty_line_of_code () = printf "\n"
+
+  let start_inline_coq () = printf "`"
+  let end_inline_coq () = printf "`"
+
+  let start_inline_coq_block () =
+    (* Note: ```coq is different from ```{coq}
+       The former does not send its code to Alectryon. *)
+    line_break (); printf "```coq\n"
+  let end_inline_coq_block () = printf "```"
+
+  let make_multi_index () = ()
+  let make_index () = output_string "```{show-index}\n```"
+  let make_toc () = output_string ":::{toc}\n:context: page\n:::\n"
+end
 
 (*s Raw output *)
 
@@ -1227,96 +1343,100 @@ end
 
 (*s Generic output *)
 
-let select f1 f2 f3 f4 x =
-  match !prefs.targetlang with LaTeX -> f1 x | HTML -> f2 x | TeXmacs -> f3 x | Raw -> f4 x
+let select f1 f2 f3 f4 f5 x =
+  match !prefs.targetlang with
+  | LaTeX -> f1 x
+  | HTML -> f2 x
+  | TeXmacs -> f3 x
+  | AlectryonMarkdown -> f4 x
+  | Raw -> f5 x
 
 let push_in_preamble = Latex.push_in_preamble
 
-let header = select Latex.header Html.header TeXmacs.header Raw.header
-let trailer = select Latex.trailer Html.trailer TeXmacs.trailer Raw.trailer
+let header = select Latex.header Html.header TeXmacs.header AlectryonMarkdown.header Raw.header
+let trailer = select Latex.trailer Html.trailer TeXmacs.trailer AlectryonMarkdown.trailer Raw.trailer
 
 let start_module =
-  select Latex.start_module Html.start_module TeXmacs.start_module Raw.start_module
+  select Latex.start_module Html.start_module TeXmacs.start_module AlectryonMarkdown.start_module Raw.start_module
 
-let start_doc = select Latex.start_doc Html.start_doc TeXmacs.start_doc Raw.start_doc
-let end_doc = select Latex.end_doc Html.end_doc TeXmacs.end_doc Raw.end_doc
+let start_doc = select Latex.start_doc Html.start_doc TeXmacs.start_doc AlectryonMarkdown.start_doc Raw.start_doc
+let end_doc = select Latex.end_doc Html.end_doc TeXmacs.end_doc AlectryonMarkdown.end_doc Raw.end_doc
 
-let start_comment = select Latex.start_comment Html.start_comment TeXmacs.start_comment Raw.start_comment
-let end_comment = select Latex.end_comment Html.end_comment TeXmacs.end_comment Raw.end_comment
+let start_comment = select Latex.start_comment Html.start_comment TeXmacs.start_comment AlectryonMarkdown.start_comment Raw.start_comment
+let end_comment = select Latex.end_comment Html.end_comment TeXmacs.end_comment AlectryonMarkdown.end_comment Raw.end_comment
 
-let start_coq = select Latex.start_coq Html.start_coq TeXmacs.start_coq Raw.start_coq
-let end_coq = select Latex.end_coq Html.end_coq TeXmacs.end_coq Raw.end_coq
+let start_coq = select Latex.start_coq Html.start_coq TeXmacs.start_coq AlectryonMarkdown.start_coq Raw.start_coq
+let end_coq = select Latex.end_coq Html.end_coq TeXmacs.end_coq AlectryonMarkdown.end_coq Raw.end_coq
 
 let start_inline_coq =
-  select Latex.start_inline_coq Html.start_inline_coq TeXmacs.start_inline_coq Raw.start_inline_coq
+  select Latex.start_inline_coq Html.start_inline_coq TeXmacs.start_inline_coq AlectryonMarkdown.start_inline_coq Raw.start_inline_coq
 let end_inline_coq =
-  select Latex.end_inline_coq Html.end_inline_coq TeXmacs.end_inline_coq Raw.end_inline_coq
+  select Latex.end_inline_coq Html.end_inline_coq TeXmacs.end_inline_coq AlectryonMarkdown.end_inline_coq Raw.end_inline_coq
 
 let start_inline_coq_block =
   select Latex.start_inline_coq_block Html.start_inline_coq_block
-    TeXmacs.start_inline_coq_block Raw.start_inline_coq_block
+    TeXmacs.start_inline_coq_block AlectryonMarkdown.start_inline_coq_block Raw.start_inline_coq_block
 let end_inline_coq_block =
-  select Latex.end_inline_coq_block Html.end_inline_coq_block TeXmacs.end_inline_coq_block Raw.end_inline_coq_block
+  select Latex.end_inline_coq_block Html.end_inline_coq_block TeXmacs.end_inline_coq_block AlectryonMarkdown.end_inline_coq_block Raw.end_inline_coq_block
 
-let indentation = select Latex.indentation Html.indentation TeXmacs.indentation Raw.indentation
-let paragraph = select Latex.paragraph Html.paragraph TeXmacs.paragraph Raw.paragraph
-let line_break = select Latex.line_break Html.line_break TeXmacs.line_break Raw.line_break
+let indentation = select Latex.indentation Html.indentation TeXmacs.indentation AlectryonMarkdown.indentation Raw.indentation
+let paragraph = select Latex.paragraph Html.paragraph TeXmacs.paragraph AlectryonMarkdown.paragraph Raw.paragraph
+let line_break = select Latex.line_break Html.line_break TeXmacs.line_break AlectryonMarkdown.line_break Raw.line_break
 let empty_line_of_code = select
-  Latex.empty_line_of_code Html.empty_line_of_code TeXmacs.empty_line_of_code Raw.empty_line_of_code
+  Latex.empty_line_of_code Html.empty_line_of_code TeXmacs.empty_line_of_code AlectryonMarkdown.empty_line_of_code Raw.empty_line_of_code
 
-let section = select Latex.section Html.section TeXmacs.section Raw.section
-let item = select Latex.item Html.item TeXmacs.item Raw.item
-let stop_item = select Latex.stop_item Html.stop_item TeXmacs.stop_item Raw.stop_item
-let reach_item_level = select Latex.reach_item_level Html.reach_item_level TeXmacs.reach_item_level Raw.reach_item_level
-let rule = select Latex.rule Html.rule TeXmacs.rule Raw.rule
+let section = select Latex.section Html.section TeXmacs.section AlectryonMarkdown.section Raw.section
+let item = select Latex.item Html.item TeXmacs.item AlectryonMarkdown.item Raw.item
+let stop_item = select Latex.stop_item Html.stop_item TeXmacs.stop_item AlectryonMarkdown.stop_item Raw.stop_item
+let reach_item_level = select Latex.reach_item_level Html.reach_item_level TeXmacs.reach_item_level AlectryonMarkdown.reach_item_level Raw.reach_item_level
+let rule = select Latex.rule Html.rule TeXmacs.rule AlectryonMarkdown.rule Raw.rule
 
-let nbsp = select Latex.nbsp Html.nbsp TeXmacs.nbsp Raw.nbsp
-let char = select Latex.char Html.char TeXmacs.char Raw.char
-let keyword = select Latex.keyword Html.keyword TeXmacs.keyword Raw.keyword
-let ident = select Latex.ident Html.ident TeXmacs.ident Raw.ident
-let sublexer = select Latex.sublexer Html.sublexer TeXmacs.sublexer Raw.sublexer
-let sublexer_in_doc = select Latex.sublexer_in_doc Html.sublexer_in_doc TeXmacs.sublexer_in_doc Raw.sublexer_in_doc
-let initialize = select Latex.initialize Html.initialize TeXmacs.initialize Raw.initialize
+let nbsp = select Latex.nbsp Html.nbsp TeXmacs.nbsp AlectryonMarkdown.nbsp Raw.nbsp
+let char = select Latex.char Html.char TeXmacs.char AlectryonMarkdown.char Raw.char
+let keyword = select Latex.keyword Html.keyword TeXmacs.keyword AlectryonMarkdown.keyword Raw.keyword
+let ident = select Latex.ident Html.ident TeXmacs.ident AlectryonMarkdown.ident Raw.ident
+let sublexer = select Latex.sublexer Html.sublexer TeXmacs.sublexer AlectryonMarkdown.sublexer Raw.sublexer
+let sublexer_in_doc = select Latex.sublexer_in_doc Html.sublexer_in_doc TeXmacs.sublexer_in_doc AlectryonMarkdown.sublexer_in_doc Raw.sublexer_in_doc
+let initialize = select Latex.initialize Html.initialize TeXmacs.initialize AlectryonMarkdown.initialize Raw.initialize
 
-let proofbox = select Latex.proofbox Html.proofbox TeXmacs.proofbox Raw.proofbox
+let proofbox = select Latex.proofbox Html.proofbox TeXmacs.proofbox AlectryonMarkdown.proofbox Raw.proofbox
 
-let latex_char = select Latex.latex_char Html.latex_char TeXmacs.latex_char Raw.latex_char
+let latex_char = select Latex.latex_char Html.latex_char TeXmacs.latex_char AlectryonMarkdown.latex_char Raw.latex_char
 let latex_string =
-  select Latex.latex_string Html.latex_string TeXmacs.latex_string Raw.latex_string
-let html_char = select Latex.html_char Html.html_char TeXmacs.html_char Raw.html_char
-let html_string =
-  select Latex.html_string Html.html_string TeXmacs.html_string Raw.html_string
+  select Latex.latex_string Html.latex_string TeXmacs.latex_string AlectryonMarkdown.latex_string Raw.latex_string
+let html_char = select Latex.html_char Html.html_char TeXmacs.html_char AlectryonMarkdown.html_char Raw.html_char
+let html_string = select Latex.html_string Html.html_string TeXmacs.html_string AlectryonMarkdown.html_string Raw.html_string
 
 let start_emph =
-  select Latex.start_emph Html.start_emph TeXmacs.start_emph Raw.start_emph
+  select Latex.start_emph Html.start_emph TeXmacs.start_emph AlectryonMarkdown.start_emph Raw.start_emph
 let stop_emph =
-  select Latex.stop_emph Html.stop_emph TeXmacs.stop_emph Raw.stop_emph
+  select Latex.stop_emph Html.stop_emph TeXmacs.stop_emph AlectryonMarkdown.stop_emph Raw.stop_emph
 
 let start_details =
-  select Latex.start_details Html.start_details TeXmacs.start_details Raw.start_details
+  select Latex.start_details Html.start_details TeXmacs.start_details AlectryonMarkdown.start_details Raw.start_details
 let stop_details =
-  select Latex.stop_details Html.stop_details TeXmacs.stop_details Raw.stop_details
+  select Latex.stop_details Html.stop_details TeXmacs.stop_details AlectryonMarkdown.stop_details Raw.stop_details
 
 let start_latex_math =
-  select Latex.start_latex_math Html.start_latex_math TeXmacs.start_latex_math Raw.start_latex_math
+  select Latex.start_latex_math Html.start_latex_math TeXmacs.start_latex_math AlectryonMarkdown.start_latex_math Raw.start_latex_math
 let stop_latex_math =
-  select Latex.stop_latex_math Html.stop_latex_math TeXmacs.stop_latex_math Raw.stop_latex_math
+  select Latex.stop_latex_math Html.stop_latex_math TeXmacs.stop_latex_math AlectryonMarkdown.stop_latex_math Raw.stop_latex_math
 
 let start_verbatim =
-  select Latex.start_verbatim Html.start_verbatim TeXmacs.start_verbatim Raw.start_verbatim
+  select Latex.start_verbatim Html.start_verbatim TeXmacs.start_verbatim AlectryonMarkdown.start_verbatim Raw.start_verbatim
 let stop_verbatim =
-  select Latex.stop_verbatim Html.stop_verbatim TeXmacs.stop_verbatim Raw.stop_verbatim
+  select Latex.stop_verbatim Html.stop_verbatim TeXmacs.stop_verbatim AlectryonMarkdown.stop_verbatim Raw.stop_verbatim
 let verbatim_char inline =
-  select (if inline then Latex.char else output_char) Html.char TeXmacs.char Raw.char
+  select (if inline then Latex.char else output_char) Html.char TeXmacs.char AlectryonMarkdown.char Raw.char
 let hard_verbatim_char = output_char
 
 let url =
-  select Latex.url Html.url TeXmacs.url Raw.url
+  select Latex.url Html.url TeXmacs.url AlectryonMarkdown.url Raw.url
 
 let start_quote =
-  select Latex.start_quote Html.start_quote TeXmacs.start_quote Raw.start_quote
+  select Latex.start_quote Html.start_quote TeXmacs.start_quote AlectryonMarkdown.start_quote Raw.start_quote
 let stop_quote =
-  select Latex.stop_quote Html.stop_quote TeXmacs.stop_quote Raw.stop_quote
+  select Latex.stop_quote Html.stop_quote TeXmacs.stop_quote AlectryonMarkdown.stop_quote Raw.stop_quote
 
 let inf_rule_dumb assumptions (midsp,midln,midnm) conclusions =
   start_verbatim false;
@@ -1331,8 +1451,8 @@ let inf_rule_dumb assumptions (midsp,midln,midnm) conclusions =
      List.iter dumb_line conclusions);
   stop_verbatim false
 
-let inf_rule = select inf_rule_dumb Html.inf_rule inf_rule_dumb inf_rule_dumb
+let inf_rule = select inf_rule_dumb Html.inf_rule inf_rule_dumb inf_rule_dumb inf_rule_dumb
 
-let make_multi_index = select Latex.make_multi_index Html.make_multi_index TeXmacs.make_multi_index Raw.make_multi_index
-let make_index = select Latex.make_index Html.make_index TeXmacs.make_index Raw.make_index
-let make_toc = select Latex.make_toc Html.make_toc TeXmacs.make_toc Raw.make_toc
+let make_multi_index = select Latex.make_multi_index Html.make_multi_index TeXmacs.make_multi_index AlectryonMarkdown.make_multi_index Raw.make_multi_index
+let make_index = select Latex.make_index Html.make_index TeXmacs.make_index AlectryonMarkdown.make_index Raw.make_index
+let make_toc = select Latex.make_toc Html.make_toc TeXmacs.make_toc AlectryonMarkdown.make_toc Raw.make_toc
diff --git a/tools/coqdoc/rocqdoc_main.ml b/tools/coqdoc/rocqdoc_main.ml
index 0a5a5dfb67e2..044bd4c9aa96 100644
--- a/tools/coqdoc/rocqdoc_main.ml
+++ b/tools/coqdoc/rocqdoc_main.ml
@@ -23,8 +23,9 @@ let banner () =
 let target_full_name f =
   match !prefs.targetlang with
     | HTML -> f ^ ".html"
+    | AlectryonMarkdown -> f ^ ".myst"
     | Raw -> f ^ ".txt"
-    | _ -> f ^ ".tex"
+    | LaTeX | TeXmacs -> f ^ ".tex"
 
 (*s The following function produces the output. The default output is
     the \LaTeX\ document: in that case, we just call [Web.produce_document].
diff --git a/tools/coqworkmgr/dune b/tools/coqworkmgr/dune
index 18a05623ebb4..1867319862ab 100644
--- a/tools/coqworkmgr/dune
+++ b/tools/coqworkmgr/dune
@@ -5,10 +5,6 @@
  (wrapped false)
  (libraries str unix))
 
-(deprecated_library_name
- (old_public_name coq-core.coqworkmgrapi)
- (new_public_name rocq-runtime.coqworkmgrapi))
-
 (library
  (name rocqworkmgr)
  (modules rocqworkmgr)
diff --git a/tools/dune_rule_gen/coq_module.ml b/tools/dune_rule_gen/coq_module.ml
index f6a7bbc07a67..7102fab1a32f 100644
--- a/tools/dune_rule_gen/coq_module.ml
+++ b/tools/dune_rule_gen/coq_module.ml
@@ -45,7 +45,6 @@ let native_obj_files ~install ~tname { prefix; name; _ } =
 
 let base_obj_files coq_module =
   [ mod_to_obj coq_module ~ext:".glob"
-  ; mod_to_obj coq_module ~ext:".vos"
   ; mod_to_obj coq_module ~ext:".vo"
   ]
 
diff --git a/tools/dune_rule_gen/dep_info.ml b/tools/dune_rule_gen/dep_info.ml
index 9755280a28d1..b3df13ad4387 100644
--- a/tools/dune_rule_gen/dep_info.ml
+++ b/tools/dune_rule_gen/dep_info.ml
@@ -10,7 +10,7 @@ type t = CD.Dep_info.Dep.t list Dep_map.t
 
 (* What a pita OCaml's stdlib missing basic stuff ... *)
 let from_list l =
-  List.fold_left (fun map { CD.Dep_info.name; deps } ->
+  Seq.fold_left (fun map { CD.Dep_info.name; deps } ->
       let name = Path.make name in
       let path = Path.add_extension ~ext:".v" name in
       Dep_map.add path deps map) Dep_map.empty l
diff --git a/tools/rocqmakefile.ml b/tools/rocqmakefile.ml
index b7758e9bf465..cc6edf489099 100644
--- a/tools/rocqmakefile.ml
+++ b/tools/rocqmakefile.ml
@@ -245,21 +245,19 @@ let write_coqbin oc =
     endif\n\
     COQMKFILE ?= \"$(COQBIN)rocq\" makefile"
 
-let generate_conf_files oc p
-=
-  let module S = String in
-  let fout varname suffix =
-    fprintf oc "COQMF_%s := $(filter %%%s, $(COQMF_SOURCES))\n" varname suffix;
-  in
+let generate_conf_files oc p =
   section oc "Project files.";
 
   let cmdline_vfiles = p.cmd_line_files in
-  fprintf oc "COQMF_CMDLINE_VFILES := %s\n" (S.concat " " (map_sourced_list quote cmdline_vfiles));
+  fprintf oc "COQMF_CMDLINE_VFILES := %s\n" (String.concat " " (map_sourced_list quote cmdline_vfiles));
   let proj_arg = match p.project_file with
     | Some pfile -> Printf.sprintf "-f %s" pfile
     | None -> ""
   in
-  fprintf oc "COQMF_SOURCES := $(shell $(COQMKFILE) -sources-of %s $(COQMF_CMDLINE_VFILES))\n" proj_arg;
+  let fout varname suffix =
+    fprintf oc "COQMF_%s := $(shell $(COQMKFILE) -sources-of %s %s $(COQMF_CMDLINE_VFILES))\n"
+      varname suffix proj_arg;
+  in
   fout "VFILES" ".v";
   fout "MLIFILES" ".mli";
   fout "MLFILES" ".ml";
@@ -378,19 +376,19 @@ let chop_prefix p f =
 
 type extra_opts = {
   only_destination : string option;
-  only_sources : bool;
+  only_sources : string option;
   coqlib : string option;
 }
 
 let empty_extra = {
   only_destination = None;
-  only_sources = false;
+  only_sources = None;
   coqlib = None;
 }
 
 let parse_extra f r opts = match f, r with
   | "-destination-of", tgt :: r -> Some (r, { opts with only_destination = Some tgt })
-  | "-sources-of", r -> Some (r, { opts with only_sources = true })
+  | "-sources-of", suf :: r -> Some (r, { opts with only_sources = Some suf })
   | "-coqlib", v :: r -> Some (r, { opts with coqlib = Some v })
   | ("-h"|"--help"), _ -> usage_coq_makefile ~ok:true
   | ("-v"|"--version"), _ -> Boot.Usage.version (); exit 0
@@ -471,12 +469,17 @@ let main ~prog args =
     with Parsing_error s -> prerr_endline s; usage_coq_makefile ~ok:false in
 
   match only_destination, only_sources with
-  | None, false -> normal_mode ~coqlib project prog args
-  | Some dest, false ->
+  | None, None -> normal_mode ~coqlib project prog args
+  | Some dest, None ->
     destination_of project dest
-  | None, true ->
-    let paths = String.concat " " (List.map (fun i -> i.thing) project.files) in
+  | None, Some suf ->
+    let filter i =
+      let i = i.thing in
+      if String.equal (Filename.extension i) suf then Some i
+      else None
+    in
+    let paths = String.concat " " (List.filter_map filter project.files) in
     Printf.printf "%s" paths
-  | Some _, true ->
+  | Some _, Some _ ->
     prerr_endline "Cannot combine -destination-of and -sources-of";
     usage_coq_makefile ~ok:false
diff --git a/tools/rocqwc.mll b/tools/rocqwc.mll
index 48fdadca5a81..1790fbf52564 100644
--- a/tools/rocqwc.mll
+++ b/tools/rocqwc.mll
@@ -161,13 +161,28 @@ and proof = parse
   | "Proof" space* '.'
   | "Proof" space+ "with"
   | "Proof" space+ "using"
-           { seen_proof := true; proof lexbuf }
+           { seen_proof := true; started_proof lexbuf }
   | "Proof" space
            { proof_term lexbuf }
   | proof_end
            { seen_proof := true; spec lexbuf }
   | character | _
-           { seen_proof := true; proof lexbuf }
+           { seen_proof := true; started_proof lexbuf }
+  | eof    { () }
+
+(*s Scans the proof after the "Proof" keyword, without again giving special treatment to that keyword. See issue #21422. *)
+
+and started_proof = parse
+  | "(*"   { comment lexbuf; started_proof lexbuf }
+  | '"'    { let n = string lexbuf in plines := !plines + n;
+             seen_proof := true; started_proof lexbuf }
+  | space+ | stars
+           { started_proof lexbuf }
+  | '\n'   { newline (); started_proof lexbuf }
+  | proof_end
+           { seen_proof := true; spec lexbuf }
+  | character | _
+           { seen_proof := true; started_proof lexbuf }
   | eof    { () }
 
 and proof_term = parse
diff --git a/topbin/rocqnative.ml b/topbin/rocqnative.ml
index ffadfda23fa8..7ec16574ae02 100644
--- a/topbin/rocqnative.ml
+++ b/topbin/rocqnative.ml
@@ -78,6 +78,7 @@ end
 
 module Library =
 struct
+[@@@warning "-unused-field"] (* marshalled data *)
 
 type library_objects
 
diff --git a/toplevel/ccompile.ml b/toplevel/ccompile.ml
index 411e3dd7a141..6e36f71495e5 100644
--- a/toplevel/ccompile.ml
+++ b/toplevel/ccompile.ml
@@ -16,17 +16,13 @@ open Common_compile
 (* File Compilation                                                           *)
 (******************************************************************************)
 
-let create_empty_file filename =
-  let f = open_out filename in
-  close_out f
-
 let source ldir file = Loc.InFile {
     dirpath=Some (Names.DirPath.to_string ldir);
     file = file;
   }
 
 (* Compile a vernac file *)
-let compile opts stm_options injections copts ~echo ~f_in ~f_out =
+let compile opts stm_options injections copts ~f_in ~f_out =
   let open Vernac.State in
   let output_native_objects = match opts.config.native_compiler with
     | NativeOff -> false | NativeOn {ondemand} -> not ondemand
@@ -40,12 +36,8 @@ let compile opts stm_options injections copts ~echo ~f_in ~f_out =
   in
   let long_f_dot_in, long_f_dot_out =
     ensure_exists_with_prefix ~src:f_in ~tgt:f_out ~src_ext:ext_in ~tgt_ext:ext_out in
-  let dump_empty_vos () =
-    let long_f_dot_vos = (safe_chop_extension long_f_dot_out) ^ ".vos" in
-    create_empty_file long_f_dot_vos in
-  let dump_empty_vok () =
-    let long_f_dot_vok = (safe_chop_extension long_f_dot_out) ^ ".vok" in
-    create_empty_file long_f_dot_vok in
+  let beautify = copts.beautify in
+  let () = if beautify then CLexer.record_comments := true in
   match mode with
   | BuildVo | BuildVok ->
       let doc, sid = Topfmt.(in_phase ~phase:LoadingPrelude)
@@ -69,24 +61,20 @@ let compile opts stm_options injections copts ~echo ~f_in ~f_out =
       let wall_clock1 = Unix.gettimeofday () in
       let check = Stm.AsyncOpts.(stm_options.async_proofs_mode = APoff) in
       let source = source ldir long_f_dot_in in
-      let state = Vernac.load_vernac ~echo ~check ~state ~source long_f_dot_in in
+      let state = Vernac.load_vernac ~beautify ~check ~state ~source long_f_dot_in in
       let fullstate = Stm.finish ~doc:state.doc in
       ensure_no_pending_proofs ~filename:long_f_dot_in fullstate;
       let () = Stm.join ~doc:state.doc in
       let wall_clock2 = Unix.gettimeofday () in
       (* In .vo production, dump a complete .vo file. *)
-      if mode = BuildVo
-        then Library.save_library_to ~output_native_objects Library.ProofsTodoNone ldir long_f_dot_out;
-      Aux_file.record_in_aux_at "vo_compile_time"
-        (Printf.sprintf "%.3f" (wall_clock2 -. wall_clock1));
-      Aux_file.stop_aux_file ();
-      (* Additionally, dump an empty .vos file to make sure that
-        stale ones are never loaded *)
-      if mode = BuildVo then
-        dump_empty_vos();
-      (* In both .vo, and .vok production mode, dump an empty .vok file to
-         indicate that proofs are ok. *)
-      dump_empty_vok();
+      let () = if mode = BuildVo then
+          Library.save_library_to ~output_native_objects Library.ProofsTodoNone ldir long_f_dot_out
+      in
+      let () = Aux_file.record_in_aux_at "vo_compile_time"
+          (Printf.sprintf "%.3f" (wall_clock2 -. wall_clock1))
+      in
+      let () = Aux_file.stop_aux_file () in
+      ()
 
   | BuildVos ->
       let doc, sid = Topfmt.(in_phase ~phase:LoadingPrelude)
@@ -98,25 +86,21 @@ let compile opts stm_options injections copts ~echo ~f_in ~f_out =
       let state = Load.load_init_vernaculars opts ~state in
       let ldir = Stm.get_ldir ~doc:state.doc in
       let source = source ldir long_f_dot_in in
-      let state = Vernac.load_vernac ~echo ~check:false ~source ~state long_f_dot_in in
+      let state = Vernac.load_vernac ~beautify ~check:false ~source ~state long_f_dot_in in
       let state = Stm.finish ~doc:state.doc in
       ensure_no_pending_proofs state ~filename:long_f_dot_in;
       let () = Stm.snapshot_vos ~doc ~output_native_objects ldir long_f_dot_out in
       Stm.reset_task_queue ();
       ()
 
-let compile opts stm_opts copts injections ~echo ~f_in ~f_out =
+let compile opts stm_opts copts injections ~f_in ~f_out =
   ignore(CoqworkmgrApi.get 1);
-  compile opts stm_opts injections copts ~echo ~f_in ~f_out;
+  compile opts stm_opts injections copts ~f_in ~f_out;
   CoqworkmgrApi.giveback 1
 
-let compile_file opts stm_opts copts injections (f_in, echo) =
+let compile_file opts stm_opts copts injections f_in =
   let f_out = copts.compilation_output_name in
-  if !Flags.beautify then
-    Flags.with_option Flags.beautify_file
-      (fun f_in -> compile opts stm_opts copts injections ~echo ~f_in ~f_out) f_in
-  else
-    compile opts stm_opts copts injections ~echo ~f_in ~f_out
+  compile opts stm_opts copts injections ~f_in ~f_out
 
 let compile_file opts stm_opts copts injections =
   Option.iter (compile_file opts stm_opts copts injections) copts.compile_file
diff --git a/toplevel/coqcargs.ml b/toplevel/coqcargs.ml
index 9083c1d0d396..f0f7c46fb694 100644
--- a/toplevel/coqcargs.ml
+++ b/toplevel/coqcargs.ml
@@ -17,10 +17,10 @@ type glob_output =
 type t =
   { compilation_mode : compilation_mode
 
-  ; compile_file: (string * bool) option  (* bool is verbosity  *)
+  ; compile_file: string option
   ; compilation_output_name : string option
 
-  ; echo : bool
+  ; beautify : bool
 
   ; glob_out    : glob_output option
 
@@ -33,7 +33,7 @@ let default =
   ; compile_file = None
   ; compilation_output_name = None
 
-  ; echo = false
+  ; beautify = false
 
   ; glob_out = None
 
@@ -58,29 +58,27 @@ let arg_error msg = CErrors.user_err msg
 
 let is_dash_argument s = String.length s > 0 && s.[0] = '-'
 
-let add_compile ?echo copts s =
+let add_compile copts s =
   if is_dash_argument s then
     arg_error Pp.(str "Unknown option " ++ str s);
   (* make the file name explicit; needed not to break up Rocq loadpath stuff. *)
-  let echo = Option.default copts.echo echo in
   let s =
     let open Filename in
     if is_implicit s
     then concat current_dir_name s
     else s
   in
-  { copts with compile_file = Some (s,echo) }
+  { copts with compile_file = Some s }
 
-let add_compile ?echo copts v_file =
+let add_compile copts v_file =
   match copts.compile_file with
-  | Some (first,_) ->
+  | Some first ->
     arg_error Pp.(str "More than one file to compile: " ++ str first ++ spc() ++
                   str "and " ++ str v_file)
   | None ->
-    add_compile ?echo copts v_file
+    add_compile copts v_file
 
 let parse arglist : t =
-  let echo = ref false in
   let args = ref arglist in
   let extras = ref [] in
   let rec parse (oval : t) = match !args with
@@ -106,10 +104,7 @@ let parse arglist : t =
         (* Non deprecated options *)
         | "-output-context" ->
           { oval with output_context = true }
-        (* Verbose == echo mode *)
-        | "-verbose" ->
-          echo := true;
-          oval
+        |"-beautify" -> { oval with beautify = true }
         (* Output filename *)
         | "-o" ->
           { oval with compilation_output_name = Some (next ()) }
diff --git a/toplevel/coqcargs.mli b/toplevel/coqcargs.mli
index 0f4d83a26e33..21f7f2c27b4e 100644
--- a/toplevel/coqcargs.mli
+++ b/toplevel/coqcargs.mli
@@ -29,10 +29,10 @@ type glob_output =
 type t =
   { compilation_mode : compilation_mode
 
-  ; compile_file: (string * bool) option  (* bool is verbosity  *)
+  ; compile_file: string option  (* bool is verbosity  *)
   ; compilation_output_name : string option
 
-  ; echo : bool
+  ; beautify : bool
 
   ; glob_out    : glob_output option
 
diff --git a/toplevel/coqloop.ml b/toplevel/coqloop.ml
index 7bdbef6b79f4..75df0b43d308 100644
--- a/toplevel/coqloop.ml
+++ b/toplevel/coqloop.ml
@@ -511,6 +511,7 @@ let process_toplevel_command ~state stm =
 
 let read_and_execute ~state =
   try
+    resynch_buffer top_buffer;
     let input = top_buffer.tokens in
     match read_sentence ~state input with
     | Some stm ->
@@ -551,7 +552,6 @@ let loop ~state =
       top_stderr (fnl());
       let open Vernac.State in
       if !print_emacs then top_stderr (str (top_buffer.prompt state.doc));
-      resynch_buffer top_buffer;
       let new_running, new_state = read_and_execute ~state:state in
       if new_running then
         (aux [@ocaml.tailcall]) new_state
diff --git a/toplevel/coqrc.ml b/toplevel/coqrc.ml
index bbce570e702d..447522a3a1ee 100644
--- a/toplevel/coqrc.ml
+++ b/toplevel/coqrc.ml
@@ -17,29 +17,25 @@ let ( / ) s1 s2 = Filename.concat s1 s2
 let rcdefaultname = "coqrc"
 
 let load_rcfile ~rcfile ~state =
-    try
-      match rcfile with
-      | Some rcfile ->
-        if CUnix.file_readable_p rcfile then
-          Vernac.load_vernac ~echo:false ~check:true ~state rcfile
-        else raise (Sys_error ("Cannot read rcfile: "^ rcfile))
-      | None ->
-        try
-          let warn x = Feedback.msg_warning (Pp.str x) in
-          let inferedrc = List.find CUnix.file_readable_p [
-            Envars.xdg_config_home warn / rcdefaultname^"."^Coq_config.version;
-            Envars.xdg_config_home warn / rcdefaultname;
-            Envars.home ~warn / "."^rcdefaultname^"."^Coq_config.version;
-            Envars.home ~warn / "."^rcdefaultname
-          ] in
-          Vernac.load_vernac ~echo:false ~check:true ~state inferedrc
-        with Not_found -> state
-        (*
-        Flags.if_verbose
-          mSGNL (str ("No coqrc or coqrc."^Coq_config.version^
-                         " found. Skipping rcfile loading."))
-        *)
-    with reraise ->
-      let reraise = Exninfo.capture reraise in
-      let () = Feedback.msg_info (Pp.str"Load of rcfile failed.") in
-      Exninfo.iraise reraise
+  try
+    match rcfile with
+    | Some rcfile ->
+      if CUnix.file_readable_p rcfile then
+        Vernac.load_vernac ~check:true ~state rcfile
+      else raise (Sys_error ("Cannot read rcfile: "^ rcfile))
+    | None ->
+      let warn x = Feedback.msg_warning (Pp.str x) in
+      let inferedrc = List.find_opt CUnix.file_readable_p [
+          Envars.xdg_config_home warn / rcdefaultname^"."^Coq_config.version;
+          Envars.xdg_config_home warn / rcdefaultname;
+          Envars.home ~warn / "."^rcdefaultname^"."^Coq_config.version;
+          Envars.home ~warn / "."^rcdefaultname
+        ] in
+      match inferedrc with
+      | None -> state
+      | Some inferedrc ->
+        Vernac.load_vernac ~check:true ~state inferedrc
+  with reraise ->
+    let reraise = Exninfo.capture reraise in
+    let () = Feedback.msg_info (Pp.str"Load of rcfile failed.") in
+    Exninfo.iraise reraise
diff --git a/toplevel/dune b/toplevel/dune
index 80a9f2f840a3..61810cdf7cb1 100644
--- a/toplevel/dune
+++ b/toplevel/dune
@@ -10,10 +10,6 @@
    (memtrace -> memtrace_init.memtrace.ml)
    (!memtrace -> memtrace_init.default.ml))))
 
-(deprecated_library_name
- (old_public_name coq-core.toplevel)
- (new_public_name rocq-runtime.toplevel))
-
 ; Interp provides the `zarith` library to plugins, we could also use
 ; -linkall in the plugins file, to be discussed.
 
diff --git a/toplevel/load.ml b/toplevel/load.ml
index 4ad0d433d79d..9ebedc8152d7 100644
--- a/toplevel/load.ml
+++ b/toplevel/load.ml
@@ -26,13 +26,10 @@ let load_init_file opts ~state =
 
 let load_vernacular opts ~state =
   List.fold_left
-    (fun state (f_in, echo) ->
+    (fun state f_in ->
       let s = Loadpath.locate_file f_in in
-      (* Should make the beautify logic clearer *)
-      let load_vernac f = Vernac.load_vernac ~echo ~check:true ~state f in
-      if !Flags.beautify
-      then Flags.with_option Flags.beautify_file load_vernac f_in
-      else load_vernac s
+      let load_vernac f = Vernac.load_vernac ~check:true ~state f in
+      load_vernac s
     ) state opts.pre.load_vernacular_list
 
 let load_init_vernaculars opts ~state =
diff --git a/toplevel/vernac.ml b/toplevel/vernac.ml
index 392a667170da..643e68870401 100644
--- a/toplevel/vernac.ml
+++ b/toplevel/vernac.ml
@@ -24,15 +24,19 @@ let checknav { CAst.loc; v = { expr } }  =
   if is_navigation_vernac expr && not (is_reset expr) then
     CErrors.user_err ?loc (str "Navigation commands forbidden in files.")
 
-(* 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
-
+let vernac_beautify fmt ast comments =
+  try
+  Pputils.beautify_comments := comments;
+  let loc = Option.cata Loc.unloc (0,0) ast.CAst.loc in
+  let before = Pputils.extract_comments (fst loc) in
+  let before = if CList.is_empty before then mt() else comment before ++ fnl() in
+  let com = Ppvernac.pr_vernac ast ++ fnl() in
+  let after = comment (Pputils.extract_comments (snd loc)) in
+  Pp.pp_with fmt (hov 0 (before ++ com ++ after))
+  with e ->
+    let e, info = Exninfo.capture e in
+    let info = match ast.loc with None -> info | Some loc -> Loc.add_loc info loc  in
+    Exninfo.iraise (e,info)
 
 type time_output =
   | ToFeedback
@@ -94,19 +98,17 @@ let interp_vernac ~check ~state ({CAst.loc;_} as com) =
       Exninfo.iraise (reraise, info)
 
 (* Load a vernac file. CErrors are annotated with file and location *)
-let load_vernac_core ~echo ~check ~state ?source file =
+let load_vernac_core ~beautify ~check ~state ?source 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 input_cleanup () = close_in in_chan in
 
   let source = Option.default (Loc.InFile {dirpath=None; file}) source in
   let in_pa = Procq.Parsable.make ~loc:Loc.(initial source)
       (Gramlib.Stream.of_channel in_chan) in
   let open State in
 
-  (* ids = For beautify, list of parsed sids *)
-  let rec loop state ids =
+  let rec loop state =
     let tstart = System.get_time () in
     match
       NewProfile.profile "parse_command" (fun () ->
@@ -115,11 +117,17 @@ let load_vernac_core ~echo ~check ~state ?source file =
         ()
     with
     | None ->
+      let () = beautify |> Option.iter @@ fun beautify ->
+        (* print end of file comments if any *)
+        Pp.pp_with beautify (comment (List.map snd @@ Procq.Parsable.comments in_pa))
+      in
       input_cleanup ();
-      state, ids, Procq.Parsable.comments in_pa
+      state
     | Some ast ->
-      (* Printing of AST for -compile-verbose *)
-      Option.iter (vernac_echo ?loc:ast.CAst.loc) in_echo;
+      let () = beautify |> Option.iter @@ fun beautify ->
+        vernac_beautify beautify ast (Procq.Parsable.comments in_pa);
+        Procq.Parsable.drop_comments in_pa
+      in
 
       checknav ast;
 
@@ -145,9 +153,9 @@ let load_vernac_core ~echo ~check ~state ?source file =
           ()
       in
 
-      (loop [@ocaml.tailcall]) state (state.sid :: ids)
+      (loop [@ocaml.tailcall]) state
   in
-  try loop state []
+  try loop state
   with any ->   (* whatever the exception *)
     let (e, info) = Exninfo.capture any in
     input_cleanup ();
@@ -190,42 +198,22 @@ let set_formatter_translator ch =
   Format.pp_set_max_boxes ft max_int;
   ft
 
-let pr_new_syntax ?loc ft_beautify ocom =
-  let loc = Option.append loc (Option.bind ocom (fun x -> x.CAst.loc)) in
-  let loc = Option.cata Loc.unloc (0,0) loc in
-  let before = comment (Pputils.extract_comments (fst loc)) in
-  let com = Option.cata (fun com -> Ppvernac.pr_vernac com ++ fnl()) (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 -> pr_new_syntax ft_beautify (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 ()
+let open_beautify filename =
+  let chan_beautify = open_out (filename^beautify_suffix) in
+  let fmt = set_formatter_translator chan_beautify in
+  fmt, fun () -> Format.pp_print_flush fmt(); close_out chan_beautify
 
 (* Main driver for file loading. For now, we only do one beautify
    pass. *)
-let load_vernac ~echo ~check ~state ?source filename =
-  let ostate, ids, comments = load_vernac_core ~echo ~check ~state ?source filename in
-  (* Pass for beautify *)
-  if !Flags.beautify then beautify_pass ~doc:ostate.State.doc ~comments ~ids:(List.rev ids) ~filename;
-  (* End pass *)
+let load_vernac ?(beautify=false) ~check ~state ?source filename =
+  let beautify, close_beautify = if not beautify then None, Fun.id
+    else let fmt, close = open_beautify filename in Some fmt, close
+  in
+  let ostate =
+    Util.try_finally (fun () ->
+        load_vernac_core ~beautify ~check ~state ?source filename)
+      ()
+      close_beautify
+      ()
+  in
   ostate
diff --git a/toplevel/vernac.mli b/toplevel/vernac.mli
index b6ea3901b12c..5f9c56bf782f 100644
--- a/toplevel/vernac.mli
+++ b/toplevel/vernac.mli
@@ -30,8 +30,7 @@ end
     state. *)
 val process_expr : state:State.t -> Vernacexpr.vernac_control -> 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 : echo:bool -> check:bool ->
+(** [load_vernac sid file] Loads [file] on top of [sid].
+    Callers are expected to handle and print errors in form of exceptions. *)
+val load_vernac : ?beautify:bool -> check:bool ->
   state:State.t -> ?source:Loc.source -> string -> State.t
diff --git a/vernac/assumptions.ml b/vernac/assumptions.ml
index 8209d698a631..313a5014e715 100644
--- a/vernac/assumptions.ml
+++ b/vernac/assumptions.ml
@@ -268,6 +268,16 @@ and traverse_object access (curr, data, ax2ty) body obj =
       let contents,data,ax2ty =
         traverse access obj Context.Rel.empty
                  (GlobRef.Set_env.empty,data,ax2ty) body in
+      (* Also traverse the type of globals, which may mention unrelated
+         references depending on axioms even if they convert to something else. *)
+      let contents,data,ax2ty = match obj with
+        | GlobRef.ConstRef kn ->
+          let cb = lookup_constant kn in
+          let typ = cb.Declarations.const_type in
+          traverse access obj Context.Rel.empty
+                   (contents,data,ax2ty) typ
+        | _ -> (contents,data,ax2ty)
+      in
       GlobRef.Map_env.add obj (Some contents) data, ax2ty
   in
   (GlobRef.Set_env.add obj curr, data, ax2ty)
@@ -423,5 +433,12 @@ let assumptions ?(add_opaque=false) ?(add_transparent=false) access st grs =
           let l = try GlobRef.Map_env.find obj ax2ty with Not_found -> [] in
           ContextObjectMap.add (Axiom (UIP m, l)) Constr.mkProp accu
       in
+      let accu =
+        if not (Environ.indices_matter (Global.env ())) then accu
+        else if not (Array.exists (fun mip -> mip.mind_relies_on_indices_not_mattering) mind.mind_packets) then accu
+        else
+          let l = try GlobRef.Map_env.find obj ax2ty with Not_found -> [] in
+          ContextObjectMap.add (Axiom (IndicesNotMattering m, l)) Constr.mkProp accu
+      in
       accu
   in GlobRef.Map_env.fold fold graph ContextObjectMap.empty
diff --git a/vernac/attributes.ml b/vernac/attributes.ml
index e06c4c27e9ce..4e86dec2760e 100644
--- a/vernac/attributes.ml
+++ b/vernac/attributes.ml
@@ -294,45 +294,42 @@ let polymorphic =
   | Some b -> return b
   | None -> return (is_universe_polymorphism())
 
-let cumulative_inductive_option_name = ["Polymorphic"; "Inductive"; "Cumulativity"]
-let is_polymorphic_inductive_cumulativity =
-  let b = ref None in
-  let read () = match !b with None -> is_universe_polymorphism () | Some b -> b in
-  let write d =
-    if d && not (is_universe_polymorphism()) then
-      CErrors.user_err Pp.(str "Cannot set polymorphic inductive cumulativity status when not in universe polymorphism mode")
-    else b := Some d
-  in
-  let () = let open Goptions in
-    declare_bool_option
-      { optstage = Summary.Stage.Interp;
-        optdepr  = None;
-        optkey   = cumulative_inductive_option_name;
-        optread  = read;
-        optwrite = write }
-  in
-  read
+let { Goptions.get = is_polymorphic_inductive_cumulativity } =
+  Goptions.declare_bool_option_and_ref ~key:["Polymorphic"; "Inductive"; "Cumulativity"] ~value:false ()
+
+let { Goptions.get = should_collapse_sort_variables  } =
+  Goptions.declare_bool_option_and_ref ~key:["Collapse"; "Sorts"; "ToType"] ~value:true ()
+
+let collapse_sort_variables =
+  let name = "collapse_sort_variables" in
+  qualify_attribute ukey (bool_attribute ~name)
 
 let cumulative kind =
   match kind with
-  | PolyFlags.Inductive ->
-     begin
-       qualify_attribute ukey (bool_attribute ~name:"cumulative") >>= function
-       | Some b -> return b
-       | None -> return (is_polymorphic_inductive_cumulativity())
-     end
+  | PolyFlags.Inductive -> qualify_attribute ukey (bool_attribute ~name:"cumulative")
   | PolyFlags.Assumption | PolyFlags.Definition ->
      (* Not yet supported *)
-     return false
-
-let poly kind atts =
-  let atts, univ_poly = polymorphic atts in
-  if univ_poly then
-    let atts, cumulative =
-      cumulative kind atts
-    in
-    atts, PolyFlags.make ~univ_poly ~cumulative ~collapse_sort_variables:true
-  else atts, PolyFlags.default
+     return None
+
+let poly kind =
+  (polymorphic ++ cumulative kind ++ collapse_sort_variables) >>= fun ((univ_poly, cumulative), collapse_sort_variables) ->
+  let cumulative =
+    match cumulative with
+    | None -> if univ_poly then is_polymorphic_inductive_cumulativity() else false
+    | Some b ->
+      if b && not univ_poly then
+        CErrors.user_err Pp.(str "Cannot set polymorphic inductive cumulativity status when not in universe polymorphism mode.")
+      else b
+  in
+  let collapse_sort_variables =
+    match collapse_sort_variables with
+    | None -> if univ_poly then should_collapse_sort_variables () else true
+    | Some b ->
+      if not b && not univ_poly then
+        CErrors.user_err Pp.(str "Sort metavariables must be collapsed to Type in universe monomorphic constructions.")
+      else b
+  in
+  return (PolyFlags.make ~univ_poly ~cumulative ~collapse_sort_variables)
 
 let poly_def = poly PolyFlags.Definition
 
diff --git a/vernac/attributes.mli b/vernac/attributes.mli
index 76747cbe910f..ef5faff45334 100644
--- a/vernac/attributes.mli
+++ b/vernac/attributes.mli
@@ -52,6 +52,7 @@ end
 val raw_attributes : vernac_flags attribute
 
 val polymorphic : bool attribute
+val collapse_sort_variables : bool option attribute
 val poly : PolyFlags.construction_kind -> PolyFlags.t attribute
 (** Attributes supported by monomorphic or polymorphic constructions depending on their kind *)
 
diff --git a/vernac/auto_ind_decl.ml b/vernac/auto_ind_decl.ml
index 8798761caa1e..20e350e443ae 100644
--- a/vernac/auto_ind_decl.ml
+++ b/vernac/auto_ind_decl.ml
@@ -670,16 +670,14 @@ let build_beq_scheme env handle kn =
   let auctx = Declareops.universes_context mib.mind_universes in
   let u, ctx = UnivGen.fresh_instance_from auctx None in
   let uctx = UState.from_env env in
-  let uctx = UState.merge_sort_context ~sideff:false UState.univ_rigid ~src:UState.Internal uctx ctx in
+  let uctx = UState.merge_sort_context_set ~sideff:false UState.univ_rigid ~src:UState.Internal uctx ctx in
 
   (* number of inductives in the mutual *)
   let nb_ind = Array.length mib.mind_packets in
   let truly_recursive =
     let open Declarations in
-    let is_rec ra = match Declareops.dest_recarg ra with Mrec _ -> true | Norec -> false in
-    Array.exists
-      (fun mip -> Array.exists (List.exists is_rec) (Declareops.dest_subterms mip.mind_recargs))
-      mib.mind_packets in
+    Array.exists Inductiveops.mis_is_recursive mib.mind_packets
+  in
   (* params context divided *)
   let nonrecparams_ctx,recparams_ctx = Inductive.inductive_nonrec_rec_paramdecls (mib,u) in
   let params_ctx = nonrecparams_ctx @ recparams_ctx in
@@ -841,8 +839,12 @@ let build_beq_scheme env handle kn =
          let cores = Array.init nb_ind make_one_eq in
          Array.init nb_ind (fun i ->
             let kelim = Inductiveops.elim_sort (mib,mib.mind_packets.(i)) in
-            if not (Inductive.eliminates_to (Environ.qualities env) kelim Sorts.Quality.qtype) then
-              raise (NonSingletonProp (kn,i));
+            let () =
+              if not (Inductive.eliminates_to (Environ.qualities env)
+                        (UnivGen.QualityOrSet.quality kelim)
+                        Sorts.Quality.qtype)
+              then raise (NonSingletonProp (kn,i))
+            in
             let decrArg = Context.Rel.length nonrecparams_ctx_with_eqs in
             let fix = mkFix (((Array.make nb_ind decrArg),i),(names,types,cores)) in
             Term.it_mkLambda_or_LetIn fix recparams_ctx_with_eqs)
@@ -851,8 +853,12 @@ let build_beq_scheme env handle kn =
          (* If the inductive type is not recursive, the fixpoint is
              not used, so let's replace it with garbage *)
          let kelim = Inductiveops.elim_sort (mib,mib.mind_packets.(0)) in
-         if not (Inductive.eliminates_to (Environ.qualities env) kelim Sorts.Quality.qtype)
-         then raise (NonSingletonProp (kn,0));
+         let () =
+           if not (Inductive.eliminates_to (Environ.qualities env)
+                     (UnivGen.QualityOrSet.quality kelim)
+                     Sorts.Quality.qtype)
+           then raise (NonSingletonProp (kn,0))
+         in
          [|Term.it_mkLambda_or_LetIn (make_one_eq 0) recparams_ctx_with_eqs|]
   in
 
@@ -861,7 +867,7 @@ let build_beq_scheme env handle kn =
        For instance template poly inductive produces a univ monomorphic scheme
        which when applied needs to constrain the universe of its argument
     *)
-    let sigma = Evd.from_ctx uctx in
+    let sigma = Evd.from_ustate uctx in
     let sigma = Array.fold_left (fun sigma c ->
         fst @@ Typing.type_of env sigma (EConstr.of_constr c))
         sigma
@@ -1184,7 +1190,7 @@ let make_bl_scheme env handle mind =
   (* Setting universes *)
   let auctx = Declareops.universes_context mib.mind_universes in
   let u, uctx = UnivGen.fresh_instance_from auctx None in
-  let uctx = UState.merge_sort_context ~sideff:false UState.univ_rigid ~src:UState.Internal (UState.from_env env) uctx in
+  let uctx = UState.merge_sort_context_set ~sideff:false UState.univ_rigid ~src:UState.Internal (UState.from_env env) uctx in
 
   let ind = (mind,0) in
   let nparrec = mib.mind_nparams_rec in
@@ -1194,8 +1200,8 @@ let make_bl_scheme env handle mind =
   let bl_goal = EConstr.of_constr bl_goal in
   let univ_poly = Declareops.inductive_is_polymorphic mib in
   let poly = PolyFlags.of_univ_poly univ_poly in (* FIXME cumulativity not handled *)
-  let uctx = if univ_poly then Evd.ustate (fst (Typing.sort_of env (Evd.from_ctx uctx) bl_goal)) else uctx in
-  let (ans, _, _, _, uctx) = Subproof.build_by_tactic ~poly env ~uctx ~typ:bl_goal
+  let uctx = if univ_poly then Evd.ustate (fst (Typing.sort_of env (Evd.from_ustate uctx) bl_goal)) else uctx in
+  let (ans, _, _, uctx) = Subproof.build_by_tactic ~poly env ~uctx ~typ:bl_goal
     (compute_bl_tact handle (ind, EConstr.EInstance.make u) lnamesparrec nparrec)
   in
   ([|ans|], uctx)
@@ -1319,7 +1325,7 @@ let make_lb_scheme env handle mind =
   (* Setting universes *)
   let auctx = Declareops.universes_context mib.mind_universes in
   let u, uctx = UnivGen.fresh_instance_from auctx None in
-  let uctx = UState.merge_sort_context ~sideff:false UState.univ_rigid ~src:UState.Internal (UState.from_env env) uctx in
+  let uctx = UState.merge_sort_context_set ~sideff:false UState.univ_rigid ~src:UState.Internal (UState.from_env env) uctx in
 
   let nparrec = mib.mind_nparams_rec in
   let lnonparrec,lnamesparrec =
@@ -1327,9 +1333,9 @@ let make_lb_scheme env handle mind =
   let lb_goal = compute_lb_goal env handle (ind,u) lnamesparrec nparrec in
   let lb_goal = EConstr.of_constr lb_goal in
   let poly = Declareops.inductive_is_polymorphic mib in
-  let uctx = if poly then Evd.ustate (fst (Typing.sort_of env (Evd.from_ctx uctx) lb_goal)) else uctx in
+  let uctx = if poly then Evd.ustate (fst (Typing.sort_of env (Evd.from_ustate uctx) lb_goal)) else uctx in
   let poly = PolyFlags.of_univ_poly poly (* FIXME cumulativity not handled *) in
-  let (ans, _, _, _, ctx) = Subproof.build_by_tactic ~poly env ~uctx ~typ:lb_goal
+  let (ans, _, _, ctx) = Subproof.build_by_tactic ~poly env ~uctx ~typ:lb_goal
     (compute_lb_tact handle ind lnamesparrec nparrec)
   in
   ([|ans|], ctx)
@@ -1515,7 +1521,7 @@ let make_eq_decidability env handle mind =
   (* Setting universes *)
   let auctx = Declareops.universes_context mib.mind_universes in
   let u, uctx = UnivGen.fresh_instance_from auctx None in
-  let uctx = UState.merge_sort_context ~sideff:false UState.univ_rigid ~src:UState.Internal (UState.from_env env) uctx in
+  let uctx = UState.merge_sort_context_set ~sideff:false UState.univ_rigid ~src:UState.Internal (UState.from_env env) uctx in
 
   let lnonparrec,lnamesparrec =
     Inductive.inductive_nonrec_rec_paramdecls (mib,u) in
@@ -1523,8 +1529,8 @@ let make_eq_decidability env handle mind =
   let univ_poly = Declareops.inductive_is_polymorphic mib in
   (* FIXME: cumulativity not handled *)
   let poly = PolyFlags.of_univ_poly univ_poly in
-  let uctx = if univ_poly then Evd.ustate (fst (Typing.sort_of env (Evd.from_ctx uctx) dec_goal)) else uctx in
-  let (ans, _, _, _, ctx) = Subproof.build_by_tactic ~poly env ~uctx
+  let uctx = if univ_poly then Evd.ustate (fst (Typing.sort_of env (Evd.from_ustate uctx) dec_goal)) else uctx in
+  let (ans, _, _, ctx) = Subproof.build_by_tactic ~poly env ~uctx
       ~typ:dec_goal (compute_dec_tact handle (ind,u) lnamesparrec nparrec)
   in
   ([|ans|], ctx)
diff --git a/vernac/classes.ml b/vernac/classes.ml
index 4ce8f53a6c7d..c30aefd6dd02 100644
--- a/vernac/classes.ml
+++ b/vernac/classes.ml
@@ -41,7 +41,6 @@ let set_typeclass_transparency ?typeclasses_db ~locality c b =
 let set_typeclass_transparency_com ~locality refs b =
   let refs = List.map
       (fun x -> Tacred.evaluable_of_global_reference
-          (Global.env ())
           (Smartlocate.global_with_alias x))
       refs
   in
@@ -131,7 +130,7 @@ let instance_input : instance -> obj =
 
 module Event = struct
   type t =
-    | NewClass of typeclass
+    | NewClass of (Hints.hint_mode list option * typeclass)
     | NewInstance of instance
 end
 
@@ -255,9 +254,9 @@ let class_input : typeclass -> obj =
       subst_function = subst_class;
     }
 
-let add_class cl =
+let add_class ?mode cl =
   Lib.add_leaf (class_input cl);
-  observe (Event.NewClass cl)
+  observe (Event.NewClass (mode, cl))
 
 let intern_info {hint_priority;hint_pattern} =
   let env = Global.env() in
@@ -421,7 +420,7 @@ let do_instance_resolve_TC ~poly termtype sigma env =
   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 = Evd.minimize_universes sigma in
+  let sigma = Evd.minimize_universes ~poly sigma in
   (* Check that the type is free of evars now. *)
   Pretyping.check_evars env sigma termtype;
   termtype, sigma
diff --git a/vernac/classes.mli b/vernac/classes.mli
index 16187c932c8b..9311ac58a3a3 100644
--- a/vernac/classes.mli
+++ b/vernac/classes.mli
@@ -69,7 +69,7 @@ val declare_new_instance
   -> Vernacexpr.hint_info_expr
   -> unit
 
-val add_class : typeclass -> unit
+val add_class : ?mode:Hints.hint_mode list ->  typeclass -> unit
 
 type instance = {
   class_name : GlobRef.t;
@@ -80,7 +80,7 @@ type instance = {
 
 module Event : sig
   type t =
-    | NewClass of typeclass
+    | NewClass of (Hints.hint_mode list option * typeclass)
     | NewInstance of instance
 end
 
diff --git a/vernac/comArguments.ml b/vernac/comArguments.ml
index c5ade45e9083..34ed360b1e5e 100644
--- a/vernac/comArguments.ml
+++ b/vernac/comArguments.ml
@@ -59,6 +59,7 @@ let warn_arguments_assert =
 
 let warn_scope_delimiter_depth =
   CWarnings.create ~name:"argument-scope-delimiter" ~category:Deprecation.Version.v8_19
+    ~default:AsError
     Pp.(fun () ->
         strbrk "The '%' scope delimiter in 'Arguments' commands is deprecated, " ++
         strbrk "use '%_' instead (available since 8.19). The '%' syntax will be " ++
diff --git a/vernac/comAssumption.ml b/vernac/comAssumption.ml
index 45896964473c..22cb75d22d75 100644
--- a/vernac/comAssumption.ml
+++ b/vernac/comAssumption.ml
@@ -190,7 +190,7 @@ let interp_context_gen ~program_mode ~poly ~kind ~autoimp_enable ~coercions env
   let sigma, (ienv, ((env, ctx), impls, locs)) = interp_named_context_evars ~program_mode ~poly ~autoimp_enable env sigma l in
   (* Note, we must use the normalized evar from now on! *)
   let sigma = solve_remaining_evars all_and_fail_flags env ~initial sigma in
-  let sigma, ctx = Evarutil.finalize sigma @@ fun nf ->
+  let sigma, ctx = Evarutil.finalize ~poly sigma @@ fun nf ->
     List.map (NamedDecl.map_constr_het (fun x -> x) nf) ctx
   in
   (* reorder, evar-normalize and add implicit status *)
diff --git a/vernac/comCoercion.ml b/vernac/comCoercion.ml
index 9f2556d4822a..64e88797ccbf 100644
--- a/vernac/comCoercion.ml
+++ b/vernac/comCoercion.ml
@@ -15,7 +15,6 @@ open Names
 open Term
 open Constr
 open Context
-open Vars
 open Environ
 open Coercionops
 open Declare
@@ -174,32 +173,33 @@ let error_not_transparent source =
     (pr_class source ++ str " must be a transparent constant.")
 
 let build_id_coercion ?loc idf_opt source poly =
+  let open EConstr in
   let env = Global.env () in
   let sigma = Evd.from_env env in
   let sigma, vs = match source with
     | CL_CONST sp -> Evd.fresh_global env sigma (GlobRef.ConstRef sp)
     | _ -> error_not_transparent source in
-  let vs = EConstr.Unsafe.to_constr vs in
-  let c = match constant_opt_value_in env (destConst vs) with
+  let c = match constant_opt_value_in env (Constr.destConst (EConstr.Unsafe.to_constr vs)) with
     | Some c -> c
     | None -> error_not_transparent source in
-  let lams,t = decompose_lambda_decls c in
+  let c = EConstr.of_constr c in
+  let lams,t = decompose_lambda_decls sigma c in
+  let vs_app = applistc vs (Context.Rel.instance_list mkRel 0 lams) in
+  let r = Retyping.relevance_of_type (push_rel_context lams env) sigma vs_app in
   let val_f =
-    Term.it_mkLambda_or_LetIn
-      (mkLambda (make_annot (Name Namegen.default_dependent_ident) Sorts.Relevant,
-                 applistc vs (Context.Rel.instance_list mkRel 0 lams),
-                 mkRel 1))
+    it_mkLambda_or_LetIn
+      (mkLambda (make_annot (Name Namegen.default_dependent_ident) r, vs_app, mkRel 1))
        lams
   in
   let typ_f =
-    List.fold_left (fun d c -> Term.mkProd_wo_LetIn c d)
-      (mkProd (make_annot Anonymous Sorts.Relevant, applistc vs (Context.Rel.instance_list mkRel 0 lams), lift 1 t))
+    List.fold_left (fun d c -> mkProd_wo_LetIn c d)
+      (mkProd (make_annot Anonymous r, vs_app, EConstr.Vars.lift 1 t))
       lams
   in
   (* juste pour verification *)
-  let sigma, val_t = Typing.type_of env sigma (EConstr.of_constr val_f) in
+  let sigma, val_t = Typing.type_of env sigma val_f in
   let () =
-    if not (Reductionops.is_conv_leq env sigma val_t (EConstr.of_constr typ_f))
+    if not (Reductionops.is_conv_leq env sigma val_t typ_f)
     then
       user_err  (strbrk
         "Cannot be defined as coercion (maybe a bad number of arguments).")
@@ -208,15 +208,17 @@ let build_id_coercion ?loc idf_opt source poly =
     match idf_opt with
       | Some idf -> idf
       | None ->
-          let cl,u,_ = find_class_type env sigma (EConstr.of_constr t) in
+          let cl,u,_ = find_class_type env sigma t in
           Id.of_string ("Id_"^(ident_key_of_class source)^"_"^
                         (ident_key_of_class cl))
   in
   let univs = Evd.univ_entry ~poly sigma in
+  let val_f = EConstr.to_constr sigma val_f in
+  let typ_f = EConstr.to_constr sigma typ_f in
   let constr_entry = (* Cast is necessary to express [val_f] is identity *)
     DefinitionEntry
       (definition_entry ~types:typ_f ~univs
-         ~inline:true (mkCast (val_f, DEFAULTcast, typ_f)))
+         ~inline:true (Constr.mkCast (val_f, DEFAULTcast, typ_f)))
   in
   let kind = Decls.(IsDefinition IdentityCoercion) in
   let kn = declare_constant ?loc ~name ~kind constr_entry in
@@ -352,7 +354,7 @@ let try_add_new_identity_coercion {CAst.v=id; loc} ~local ~poly ~source ~target
 let try_add_new_coercion_with_source ref ~local ~reversible ~source =
   try_add_new_coercion_core ref ~local ~reversible (Some source) None false
 
-let add_coercion_hook reversible { Declare.Hook.S.scope; dref; _ } =
+let coercion_hook ~reversible = Declare.Hook.make @@ fun { scope; dref; _ } ->
   let open Locality in
   let local = match scope with
   | Discharge -> assert false (* Local Coercion in section behaves like Local Definition *)
@@ -363,10 +365,7 @@ let add_coercion_hook reversible { Declare.Hook.S.scope; dref; _ } =
   let msg = Nametab.pr_global_env Id.Set.empty dref ++ str " is now a coercion" in
   Flags.if_verbose Feedback.msg_info msg
 
-let add_coercion_hook ~reversible =
-  Declare.Hook.make (add_coercion_hook reversible)
-
-let add_subclass_hook ~poly { Declare.Hook.S.scope; dref; _ } =
+let subclass_hook ~poly ~reversible = Declare.Hook.make @@ fun { scope; dref; _ } ->
   let open Locality in
   let stre = match scope with
   | Discharge -> assert false (* Local Subclass in section behaves like Local Definition *)
@@ -375,12 +374,7 @@ let add_subclass_hook ~poly { Declare.Hook.S.scope; dref; _ } =
   in
   let cl = class_of_global dref in
   let loc = Nametab.cci_src_loc (TrueGlobal dref) in
-  try_add_new_coercion_subclass ?loc cl ~local:stre ~poly
-
-let nonuniform = Attributes.bool_attribute ~name:"nonuniform"
-
-let add_subclass_hook ~poly ~reversible =
-  Declare.Hook.make (add_subclass_hook ~poly ~reversible)
+  try_add_new_coercion_subclass ?loc cl ~local:stre ~poly ~reversible
 
 let warn_reverse_no_change =
   CWarnings.create ~name:"reversible-no-change" ~category:CWarnings.CoreCategories.coercions
diff --git a/vernac/comCoercion.mli b/vernac/comCoercion.mli
index 97a28abd2921..73c7200a3171 100644
--- a/vernac/comCoercion.mli
+++ b/vernac/comCoercion.mli
@@ -48,14 +48,10 @@ val try_add_new_identity_coercion
   -> local:bool
   -> poly:PolyFlags.t -> source:cl_typ -> target:cl_typ -> unit
 
-val add_coercion_hook : reversible:bool -> Declare.Hook.t
+val coercion_hook : reversible:bool -> Declare.Hook.t
 
-val add_subclass_hook : poly:PolyFlags.t -> reversible:bool -> Declare.Hook.t
+val subclass_hook : poly:PolyFlags.t -> reversible:bool -> Declare.Hook.t
 
 val class_of_global : GlobRef.t -> cl_typ
 
-(** Attribute to silence warning for coercions that don't satisfy
-   the uniform inheritance condition. (deprecated in 8.18) *)
-val nonuniform : bool option Attributes.attribute
-
 val change_reverse : GlobRef.t -> reversible:bool -> unit
diff --git a/vernac/comDefinition.ml b/vernac/comDefinition.ml
index 536272e5b40a..6f4c9d2dd56e 100644
--- a/vernac/comDefinition.ml
+++ b/vernac/comDefinition.ml
@@ -68,7 +68,7 @@ let protect_pattern_in_binder bl c ctypopt =
           evd, mkLambda (x,t,c)
         | LetIn (x,b,t,c) ->
           let evd,c = aux (push_rel (LocalDef (x,b,t)) env) evd c in
-          evd, mkLetIn (x,t,b,c)
+          evd, mkLetIn (x,b,t,c)
         | Case (ci,u,pms,p,iv,a,bl) ->
           let (ci, p, iv, a, bl) = EConstr.expand_case env evd (ci, u, pms, p, iv, a, bl) in
           let evd,bl = Array.fold_left_map (aux env) evd bl in
@@ -86,7 +86,7 @@ let interp_definition ~program_mode ~poly env evd impl_env bl red_option c ctypo
   let flags = Pretyping.{ all_no_fail_flags with program_mode; poly } in
   let (bl, c, ctypopt, apply_under_binders) = protect_pattern_in_binder bl c ctypopt in
   (* Build the parameters *)
-  let evd, (impls, ((env_bl, ctx), imps1, _locs)) = interp_context_evars ~program_mode ~impl_env env evd bl in
+  let evd, (impls, ((env_bl, ctx), imps1, _locs)) = interp_context_evars ~program_mode ~poly ~impl_env env evd bl in
   (* Build the type *)
   let evd, tyopt = Option.fold_left_map
       (interp_type_evars_impls ~flags ~impls env_bl)
@@ -143,7 +143,7 @@ let do_definition_program ?loc ?hook ~pm ~name ~scope ?clearbody ~poly ?typing_f
     interp_definition ~program_mode:true ~poly env evd empty_internalization_env bl red_option c ctypopt
   in
   let body, typ, uctx, _, obls = Declare.Obls.prepare_obligations ~name poly ~body ?types env evd in
-  Evd.check_univ_decl_early ~poly ~with_obls:true (Evd.from_ctx uctx) udecl [body; typ];
+  Evd.check_univ_decl_early ~poly ~with_obls:true (Evd.from_ustate uctx) udecl [body; typ];
   let cinfo = Declare.CInfo.make ?loc ~name ~typ ~impargs () in
   let info = Declare.Info.make ~udecl ~scope ?clearbody ~poly ~kind ?hook ?typing_flags ?user_warns () in
   Declare.Obls.add_definition ~pm ~info ~cinfo ~opaque:false ~body ~uctx ?using obls
@@ -157,7 +157,7 @@ let do_definition_interactive ?loc ~program_mode ?hook ~name ~scope ?clearbody ~
   let evd =
     let inference_hook = if program_mode then Some Declare.Obls.program_inference_hook else None in
     Pretyping.solve_remaining_evars ?hook:inference_hook flags env evd in
-  let evd = Evd.minimize_universes evd in
+  let evd = Evd.minimize_universes ~poly evd in
   Pretyping.check_evars_are_solved ~program_mode env evd;
   let typ = EConstr.to_constr evd typ in
   Evd.check_univ_decl_early ~poly ~with_obls:false evd udecl [typ];
diff --git a/vernac/comFixpoint.ml b/vernac/comFixpoint.ml
index 2073a4393f2b..6db2939a74c5 100644
--- a/vernac/comFixpoint.ml
+++ b/vernac/comFixpoint.ml
@@ -187,7 +187,7 @@ let encapsulate_Fix_sub env sigma recname ctx body ccl (extradecl, rel, relargty
     let sigma = Evd.set_obligation_evar sigma (fst (destEvar sigma wf_proof)) in
     let ccl_pred = mkLambda (make_annot (Name argname) ERelevance.relevant, tuple_type, tupled_ccl) in
     let def = mkApp (fix_sub_term, [| tuple_type ; rel_measure ; wf_proof ; ccl_pred |]) in
-    Typing.solve_evars env sigma def in
+    sigma, def in
   let arg = RelDecl.LocalAssum (make_annot (Name argname) ERelevance.relevant, tuple_type) in
   let argid' = Id.of_string (Id.to_string argname ^ "'") in
   let sigma, wfa =
@@ -228,8 +228,8 @@ let encapsulate_Fix_sub env sigma recname ctx body ccl (extradecl, rel, relargty
   let body_ctx = RelDecl.LocalDef (make_annot (Name recname) ERelevance.relevant, curryfier_body, curryfier_ty) :: fix_sub_F_sub_ctx in
   let intern_body_lam = it_mkLambda_or_LetIn body body_ctx in
   (* Instantiate the argument Fix_sub_F of Fix_sub with the body of the fixpoint *)
-  let sigma, fix_sub = Typing.solve_evars env sigma fix_sub in
-  sigma, tupled_ctx, tuple_value, mkApp (fix_sub, [|intern_body_lam|])
+  let sigma, fix_sub = Typing.solve_evars env sigma (mkApp (fix_sub, [|intern_body_lam|])) in
+  sigma, tupled_ctx, tuple_value, fix_sub
 
 let build_wellfounded env sigma poly udecl {CAst.v=recname; loc} ctx body ccl impls rel_measure =
   let len = Context.Rel.length ctx in
@@ -255,7 +255,7 @@ let build_wellfounded env sigma poly udecl {CAst.v=recname; loc} ctx body ccl im
   let hook, impls =
     if len > 1 then
       let hook { Declare.Hook.S.dref; uctx; obls; _ } =
-        let update c = CVars.replace_vars obls (evmap mkVar (Evarutil.nf_evar (Evd.from_ctx uctx) c)) in
+        let update c = CVars.replace_vars obls (evmap mkVar (Evarutil.nf_evar (Evd.from_ustate uctx) c)) in
         let tuple_value = update tuple_value in
         let ccl = update ccl in
         let ctx = Context.Rel.map_het (ERelevance.kind sigma) update ctx in
@@ -352,7 +352,7 @@ let interp_rec_annot ~program_mode ~function_mode env sigma fixl ctxl ccll rec_o
     | CUnknownRecOrder -> nowf (), RecLemmas.find_mutually_recursive_statements sigma ctxl ccll
 
 let interp_fix_context ~program_mode ~poly env sigma {Vernacexpr.binders} =
-  let sigma, (impl_env, ((env', ctx), imps, _locs)) = interp_context_evars ~program_mode env sigma binders in
+  let sigma, (impl_env, ((env', ctx), imps, _locs)) = interp_context_evars ~program_mode ~poly env sigma binders in
   sigma, (env', ctx, impl_env, imps)
 
 let interp_fix_ccl ~program_mode ~poly sigma impls env fix =
@@ -452,7 +452,7 @@ let interp_mutual_definition env ~program_mode ~poly ~function_mode rec_order fi
     List.fold_left4
       (fun (sigma, rec_sign) id r t (_,extradecl) ->
          let sigma, r, t = if program_mode && List.is_empty extradecl then encapsulate env sigma r t else sigma, r, t in
-         sigma, LocalAssum (Context.make_annot id r, t) :: rec_sign)
+         sigma, (Environ.ProofVar, LocalAssum (Context.make_annot id r, t)) :: rec_sign)
       (sigma, []) fixnames fixrs fixtypes fixextras
   in
   let fixrecimps = List.map3 (fun ctximps wfimps cclimps -> ctximps @ wfimps @ cclimps) fixctximps fixwfimps fixcclimps in
@@ -470,7 +470,7 @@ let interp_mutual_definition env ~program_mode ~poly ~function_mode rec_order fi
         (fun sigma fixctximpenv (after,extradecl) ctx body ccl ->
            let impls = Id.Map.fold Id.Map.add fixctximpenv impls in
            let env', ctx =
-             if after then env, List.map NamedDecl.to_rel_decl rec_sign @ ctx
+             if after then env, List.map (fun (_,d) -> NamedDecl.to_rel_decl d) rec_sign @ ctx
              else push_named_context rec_sign env, extradecl@ctx in
            interp_fix_body ~program_mode env' ctx sigma impls body (Vars.lift (Context.Rel.length extradecl) ccl))
         sigma fixctximpenvs fixextras fixctxs fixl fixccls)
@@ -529,7 +529,9 @@ let out_def = function
   | None -> CErrors.user_err Pp.(str "Program Fixpoint needs defined bodies.")
 
 let build_program_fixpoint env sigma rec_sign possible_guard fixnames fixrs fixdefs fixtypes fixwfs =
-  assert (List.for_all Option.is_empty fixwfs);
+  let () = if not @@ List.for_all Option.is_empty fixwfs then
+      CErrors.user_err Pp.(str "Well-founded fixpoints not allowed in mutually recursive blocks.")
+  in
   (* Get the interesting evars, those that were not instantiated *)
   let sigma = Typeclasses.resolve_typeclasses ~filter:Typeclasses.no_goals ~fail:true env sigma in
   (* Solve remaining evars *)
@@ -561,7 +563,7 @@ let finish_regular env sigma use_inference_hook fix =
   let sigma = Pretyping.(solve_remaining_evars ?hook:inference_hook all_no_fail_flags env sigma) in
   sigma, ground_fixpoint env sigma fix, [], None
 
-let do_mutually_recursive ?pm ~refine ~program_mode ?(use_inference_hook=false) ?scope ?clearbody ~kind ~poly ?typing_flags ?user_warns ?using (rec_order, fixl)
+let do_mutually_recursive ?pm ~refine ~program_mode ?(use_inference_hook=false) ?scope ?clearbody ~kind ?hook ~poly ?typing_flags ?user_warns ?using (rec_order, fixl)
   : Declare.OblState.t option * Declare.Proof.t option =
   let env = Global.env () in
   let env = Environ.update_typing_flags ?typing_flags env in
@@ -569,7 +571,7 @@ let do_mutually_recursive ?pm ~refine ~program_mode ?(use_inference_hook=false)
   check_recursive ~kind env sigma fix;
 
   if refine then
-    let info = Declare.Info.make ?scope ?clearbody ~kind ~poly ~udecl ?typing_flags ?user_warns ~ntns:fix.fixntns () in
+    let info = Declare.Info.make ?scope ?clearbody ~kind ~poly ~udecl ?hook ?typing_flags ?user_warns ~ntns:fix.fixntns () in
     let cinfo = build_recthms fix in
     let possible_guard = (possible_guard, fix.fixrs) in
     let lemma = Declare.Proof.start_mutual_definitions_refine ~info ~cinfo ~bodies:fix.fixdefs ~possible_guard ?using sigma in
@@ -578,12 +580,17 @@ let do_mutually_recursive ?pm ~refine ~program_mode ?(use_inference_hook=false)
 
   (* Instantiate evars and check all are resolved *)
   let sigma = Evarconv.solve_unif_constraints_with_heuristics env sigma in
-  let sigma = Evd.minimize_universes sigma in
+  let sigma = Evd.minimize_universes ~poly sigma in
 
-  let sigma, ({fixdefs=bodies;fixrs;fixtypes;fixwfs} as fix), obls, hook =
+  let sigma, ({fixdefs=bodies;fixrs;fixtypes;fixwfs} as fix), obls, wf_hook =
     match pm with
     | Some pm -> finish_obligations env sigma rec_sign possible_guard poly udecl fix
     | None -> finish_regular env sigma use_inference_hook fix in
+  (* Combine the internal well-founded/obligation hook with any external one. *)
+  let hook = match hook, wf_hook with
+    | None, h | h, None -> h
+    | Some h1, Some h2 ->
+      Some (Declare.Hook.make (fun st -> Declare.Hook.call ~hook:h2 st; Declare.Hook.call ~hook:h1 st)) in
   let info = Declare.Info.make ?scope ?clearbody ~kind ~poly ~udecl ?hook ?typing_flags ?user_warns ~ntns:fix.fixntns () in
   let cinfo = build_recthms fix in
   match pm with
diff --git a/vernac/comFixpoint.mli b/vernac/comFixpoint.mli
index 8cc01a6e731e..89e9b142a539 100644
--- a/vernac/comFixpoint.mli
+++ b/vernac/comFixpoint.mli
@@ -33,6 +33,8 @@ val do_mutually_recursive
      (* Hide body if in sections *)
   -> kind:Decls.logical_kind
      (* Logical kind: Theorem, Definition, Fixpoint, etc.*)
+  -> ?hook:Declare.Hook.t
+     (* Declaration hook run when the constants are completed *)
   -> poly:PolyFlags.t
      (* Use universe /sort polymorphism and cumulativity *)
   -> ?typing_flags:Declarations.typing_flags
diff --git a/vernac/comHints.ml b/vernac/comHints.ml
index 3e0b0659c8fc..b42fc2d25e7e 100644
--- a/vernac/comHints.ml
+++ b/vernac/comHints.ml
@@ -64,11 +64,6 @@ let project_hint ~poly pri l2r r =
   let info = {Typeclasses.hint_priority = pri; hint_pattern = None} in
   (info, true, GlobRef.ConstRef c)
 
-(* Only error when we have to (axioms may be instantiated if from functors)
-   XXX maybe error if not from a functor argument?
- *)
-let soft_evaluable = Tacred.soft_evaluable_of_global_reference
-
 (* Slightly more lenient global hint syntax for backwards compatibility *)
 let rectify_hint_constr h = match h with
 | Vernacexpr.HintsReference qid -> Some qid
@@ -86,7 +81,7 @@ let interp_hints ~poly h =
     Dumpglob.add_glob ?loc:r.CAst.loc gr;
     gr
   in
-  let fr r = soft_evaluable ?loc:r.CAst.loc (fref r) in
+  let fr r = Tacred.evaluable_of_global_reference ?loc:r.CAst.loc (fref r) in
   let fi c =
     match rectify_hint_constr c with
     | Some c ->
diff --git a/vernac/comInductive.ml b/vernac/comInductive.ml
index 9e7e64867e07..079881019fe9 100644
--- a/vernac/comInductive.ml
+++ b/vernac/comInductive.ml
@@ -211,10 +211,9 @@ let compute_constructor_levels env evd sign =
           (s :: lev, EConstr.push_rel d env))
     sign ([],env))
 
-let is_flexible_sort evd s = match ESorts.kind evd s with
-| Set | Prop | SProp -> false
-| Type u | QSort (_, u) ->
-  match Univ.Universe.level u with
+let is_flexible_sort evd s =
+  let s = ESorts.kind evd s in
+  match Univ.Universe.level (Sorts.univ_of_sort s) with
   | Some l -> Evd.is_flexible_level evd l
   | None -> false
 
@@ -242,8 +241,8 @@ let prop_lowering_candidates evd ~arities_explicit inds =
     List.for_all
       (List.for_all (fun s -> match ESorts.kind evd s with
            | SProp | Prop -> true
-           | Set -> false
-           | Type _ | QSort _ ->
+           | Set | GSort _ -> false
+           | Type _ | VSort _ ->
              not (Evd.check_leq evd ESorts.set s)
              && in_candidates s candidates))
       (Option.List.cons indices ctors)
@@ -273,7 +272,7 @@ let include_constructor_argument evd ~poly ~ctor_sort ~inductive_sort =
       match ESorts.kind evd s with
       | SProp | Prop -> None
       | Set -> Some Univ.Universe.type0
-      | Type u | QSort (_,u) -> Some u
+      | Type u | GSort (_, u) | VSort (_,u) -> Some u
     in
     match univ_of_sort ctor_sort, univ_of_sort inductive_sort with
     | _, None ->
@@ -286,7 +285,7 @@ let include_constructor_argument evd ~poly ~ctor_sort ~inductive_sort =
   else
     match ESorts.kind evd ctor_sort with
     | SProp | Prop -> evd
-    | Set | Type _ | QSort _ ->
+    | Set | Type _ | GSort _ | VSort _ ->
       Evd.set_leq_sort evd ctor_sort inductive_sort
 
 type default_dep_elim = DeclareInd.default_dep_elim = DefaultElim | PropButDepElim
@@ -320,7 +319,10 @@ let inductive_levels env evd ~poly ~indnames ~arities_explicit arities ctors =
       inds
   in
 
-  let candidates = prop_lowering_candidates evd ~arities_explicit inds in
+  (* Or should inductive_levels be cut off earlier, e.g. at L646 ? *)
+  let candidates = if not @@ PolyFlags.collapse_sort_variables poly then []
+                   else prop_lowering_candidates evd ~arities_explicit inds
+  in
   (* Do the lowering. We forget about the generated universe for the
      lowered inductive and rely on universe restriction to get rid of
      it.
@@ -372,31 +374,37 @@ let get_template_binding_arity sigma c =
   match EConstr.kind sigma c with
   | Sort s ->
     begin match ESorts.kind sigma s with
-    | Type u ->
+    | GSort (_, u) | Type u ->
+      if Univ.Universe.is_type0 u then None
+      else
       begin match Univ.Universe.level u with
       | Some l -> Some (decls, None, l)
       | None -> None
       end
-    | QSort (q,u) ->
+    | VSort (q,u) ->
       begin match Univ.Universe.level u with
       | Some l ->
         if Univ.Level.is_set l then None else Some (decls, Some q, l)
       | None -> None
       end
-    | _ -> None
+    | SProp | Prop | Set -> None
     end
   | _ -> None
 
 let non_template_levels sigma ~params ~arity ~constructors =
+  let (let+) x f = Result.map f x  in
   let ctx, u = EConstr.destArity sigma arity in
   (* locally making the conclusion qvar above_prop means its
      appearances in relevance marks aren't counted *)
-  let sigma = match ESorts.kind sigma u with
-    | QSort (q, _) -> Evd.set_above_prop sigma (QVar q)
-    | _ -> sigma
+  let+ sigma = match ESorts.kind sigma u with
+    | VSort (q, _) ->
+      if Sorts.QVar.is_unif q then Ok (Evd.set_above_prop sigma (QVar q))
+      else Error "Cannot handle template polymorphism when the conclusion is a global sort."
+    | GSort _ -> Error "Cannot handle template polymorphism when the conclusion is a global sort."
+    | _ -> Ok sigma
   in
   let add_levels c levels = EConstr.universes_of_constr sigma ~init:levels c in
-  let levels = Sorts.QVar.Set.empty, Univ.Level.Set.empty in
+  let levels = Sorts.Quality.Set.empty, Univ.Level.Set.empty in
   let fold_params levels = function
     | LocalDef (_, b, t) -> add_levels b (add_levels t levels)
     | LocalAssum (_, t) ->
@@ -416,7 +424,7 @@ let non_template_levels sigma ~params ~arity ~constructors =
   (* levels with nonzero increment in the conclusion may not be template
      (until constraint checking can handle arbitrary +k, cf #19230) *)
   let concl_univs = match ESorts.kind sigma u with
-    | QSort (_,u) | Sorts.Type u -> Univ.Universe.repr u
+    | VSort (_,u) | GSort (_, u) | Type u -> Univ.Universe.repr u
     | SProp | Prop | Set -> []
   in
   let ulevels =
@@ -437,8 +445,8 @@ let pseudo_sort_poly ~non_template_qvars ~template_univs sigma params arity =
     let ctx, s = destArity sigma arity in
     match ESorts.kind sigma s with
     | SProp | Prop | Set -> None
-    | QSort (q,u) ->
-      if not (Sorts.QVar.Set.mem q non_template_qvars)
+    | VSort (q,u) ->
+      if not (Sorts.Quality.Set.mem (QVar q) non_template_qvars)
       && Univ.Universe.for_all (fun (u,_) ->
              match Univ.Level.Map.find_opt u template_univs with
              | None | Some None -> false
@@ -446,7 +454,7 @@ let pseudo_sort_poly ~non_template_qvars ~template_univs sigma params arity =
            u
       then Some q
       else None
-    | Type u -> None
+    | GSort _ | Type _ -> None
 
 let unbounded_from_below u cstrs =
   let open Univ in
@@ -461,7 +469,8 @@ let unbounded_from_below u cstrs =
    (starting from the most recent and ignoring let-definitions) is not
    template or is Some u_k if its level is u_k and is template. *)
 let template_polymorphic_univs sigma ~params ~arity ~constructors =
-  let non_template_qvars, non_template_levels =
+  let (let+) x f = Result.map f x  in
+  let+ non_template_qvars, non_template_levels =
     non_template_levels sigma ~params ~arity ~constructors
   in
   let fold_params accu decl = match decl with
@@ -515,7 +524,7 @@ type should_template =
   | NotTemplate
 
 let nontemplate_univ_entry ~poly sigma udecl =
-  let sigma = Evd.collapse_sort_variables sigma in
+  let sigma = Evd.collapse_sort_variables ~only_above_prop:(not @@ PolyFlags.collapse_sort_variables poly) sigma in
   let uentry, _ as ubinders = Evd.check_univ_decl ~poly sigma udecl in
   let uentry, global = match uentry with
     | UState.Polymorphic_entry uctx -> Polymorphic_ind_entry uctx, Univ.ContextSet.empty
@@ -528,7 +537,7 @@ let template_univ_entry sigma udecl ~template_univs pseudo_sort_poly =
     | Some q -> QVar.Set.singleton q
     | None -> QVar.Set.empty
   in
-  let sigma = Evd.collapse_sort_variables ~except:template_qvars sigma in
+  let sigma = Evd.collapse_sort_variables ~except:template_qvars ~only_above_prop:false sigma in
   let sigma = QVar.Set.fold (fun q sigma -> Evd.set_above_prop sigma (QVar q))
       template_qvars sigma
   in
@@ -566,10 +575,7 @@ let inductive_univs sigma ~user_template ~poly udecl ~indnames ~ctx_params ~arit
   | MaybeTemplate { force_template; } ->
     let info = match List.combine3 arities constructors template_syntax with
     | [arity, (_cnames, constructors), SyntaxAllowsTemplatePoly] ->
-      let pseudo_sort_poly, template_univs =
-        template_polymorphic_univs sigma ~params:ctx_params ~arity ~constructors
-      in
-      Ok (template_univs, pseudo_sort_poly)
+      template_polymorphic_univs sigma ~params:ctx_params ~arity ~constructors
     | [_, _, SyntaxNoTemplatePoly] ->
       Error "Template polymorphism needs a syntactic sort for the inductive's conclusion."
     | _ :: _ :: _ -> Error "Template-polymorphism not allowed with mutual inductives."
@@ -579,7 +585,7 @@ let inductive_univs sigma ~user_template ~poly udecl ~indnames ~ctx_params ~arit
     | Error _, false ->
       nontemplate_univ_entry ~poly sigma udecl
     | Error msg, true -> CErrors.user_err Pp.(str msg)
-    | Ok (template_univs, pseudo_sort_poly), _ ->
+    | Ok (pseudo_sort_poly, template_univs), _ ->
       let has_template = not @@ Univ.Level.Set.is_empty template_univs in
       if force_template || should_auto_template (List.hd indnames) has_template then
         let () = if not has_template then warn_no_template_universe () in
@@ -600,7 +606,7 @@ let restrict_inductive_universes sigma ctx_params arities constructors =
   let uvars = List.fold_left (fun acc d -> Context.Rel.Declaration.fold_constr merge_universes_of_constr d acc) uvars ctx_params in
   let uvars = List.fold_right merge_universes_of_constr arities uvars in
   let uvars = List.fold_right (fun (_,ctypes) -> List.fold_right merge_universes_of_constr ctypes) constructors uvars in
-  Evd.restrict_universe_context sigma uvars
+  Evd.restrict_ustate sigma uvars
 
 let check_trivial_variances variances =
   Array.iter (function
@@ -644,7 +650,7 @@ let interp_mutual_inductive_constr ~sigma ~flags ~udecl ~variances ~ctx_params ~
 
      We also need to restrict to avoid seeing spurious bounds from below
      (ie v <= template_u with v getting restricted away). *)
-  let sigma = Evd.minimize_universes ~collapse_sort_variables:false sigma in
+  let sigma = Evd.minimize_universes_no_collapse sigma in
   let sigma = restrict_inductive_universes sigma ctx_params arities constructors in
 
   let sigma, univ_entry, ubinders, global_univs =
@@ -680,12 +686,12 @@ let interp_mutual_inductive_constr ~sigma ~flags ~udecl ~variances ~ctx_params ~
   in
   default_dep_elim, mind_ent, ubinders, global_univs
 
-let interp_params ~unconstrained_sorts env udecl uparamsl paramsl =
+let interp_params ~unconstrained_sorts ~poly env udecl uparamsl paramsl =
   let sigma, udecl, variances = interp_cumul_univ_decl_opt env udecl in
   let sigma, (uimpls, ((env_uparams, ctx_uparams), useruimpls, _locs)) =
-    interp_context_evars ~program_mode:false ~unconstrained_sorts env sigma uparamsl in
+    interp_context_evars ~program_mode:false ~unconstrained_sorts ~poly env sigma uparamsl in
   let sigma, (impls, ((env_params, ctx_params), userimpls, _locs)) =
-    interp_context_evars ~program_mode:false ~unconstrained_sorts ~impl_env:uimpls env_uparams sigma paramsl
+    interp_context_evars ~program_mode:false ~unconstrained_sorts ~poly ~impl_env:uimpls env_uparams sigma paramsl
   in
   (* Names of parameters as arguments of the inductive type (defs removed) *)
   sigma, env_params, (ctx_params, env_uparams, ctx_uparams,
@@ -732,7 +738,7 @@ let interp_mutual_inductive_gen env0 ~flags udecl (uparamsl,paramsl,indl) notati
   let unconstrained_sorts = not (PolyFlags.univ_poly flags.poly) in
 
   let sigma, env_params, (ctx_params, env_uparams, ctx_uparams, userimpls, useruimpls, impls, udecl, variances) =
-    interp_params ~unconstrained_sorts env0 udecl uparamsl paramsl
+    interp_params ~unconstrained_sorts ~poly:flags.poly env0 udecl uparamsl paramsl
   in
 
   (* Interpret the arities *)
diff --git a/vernac/comPrimitive.ml b/vernac/comPrimitive.ml
index fbcb2b90a931..e2274a0060af 100644
--- a/vernac/comPrimitive.ml
+++ b/vernac/comPrimitive.ml
@@ -17,8 +17,6 @@ let declare ?loc id entry =
   Flags.if_verbose Feedback.msg_info Pp.(Id.print id ++ str " is declared")
 
 let do_primitive id udecl prim typopt =
-  if Lib.sections_are_opened () then
-    CErrors.user_err Pp.(str "Declaring a primitive is not allowed in sections.");
   if Dumpglob.dump () then Dumpglob.dump_definition id false "ax";
   let loc = id.CAst.loc in
   let id = id.CAst.v in
@@ -48,7 +46,7 @@ let do_primitive id udecl prim typopt =
     Pretyping.check_evars_are_solved ~program_mode:false env evd;
     let evd = Evd.minimize_universes evd in
     let _qvars, uvars = EConstr.universes_of_constr evd typ in
-    let evd = Evd.restrict_universe_context evd uvars in
+    let evd = Evd.restrict_ustate evd uvars in
     let typ = EConstr.to_constr evd typ in
     let univ_poly = not (UVars.AbstractContext.is_empty auctx) in
     let poly = PolyFlags.of_univ_poly univ_poly in
diff --git a/vernac/comRewriteRule.ml b/vernac/comRewriteRule.ml
index 494ce61a5bf9..12e21b847a3c 100644
--- a/vernac/comRewriteRule.ml
+++ b/vernac/comRewriteRule.ml
@@ -40,14 +40,15 @@ let do_symbol ~poly ~unfold_fix udecl (id, typ) =
   let id = id.CAst.v in
   let env = Global.env () in
   let evd, udecl = Constrintern.interp_univ_decl_opt env udecl in
+  let flags = { Pretyping.all_no_fail_flags with poly } in
   let evd, (typ, impls) =
-    Constrintern.(interp_type_evars_impls ~impls:empty_internalization_env)
+    Constrintern.(interp_type_evars_impls ~flags ~impls:empty_internalization_env)
       env evd typ
   in
   Pretyping.check_evars_are_solved ~program_mode:false env evd;
-  let evd = Evd.minimize_universes evd in
+  let evd = Evd.minimize_universes ~poly evd in
   let _qvars, uvars = EConstr.universes_of_constr evd typ in
-  let evd = Evd.restrict_universe_context evd uvars in
+  let evd = Evd.restrict_ustate evd uvars in
   let typ = EConstr.to_constr evd typ in
   let univs = Evd.check_univ_decl ~poly evd udecl in
   let entry = Declare.symbol_entry ~univs ~unfold_fix typ in
@@ -104,17 +105,19 @@ let update_invtblq1 ~loc evd qold qvar (curvarq, tbl) =
     | Some k ->
         CErrors.user_err ?loc
           Pp.(str "Sort variable "
-            ++ Sorts.Quality.pr (Termops.pr_evd_qvar evd) qold
+            ++ Sorts.Quality.pr (Evd.quality_printer evd) qold
             ++ str" is bound multiple times in the pattern (holes number "
             ++ int k ++ str" and " ++ int curvarq ++ str").")
 
 let safe_quality_pattern_of_quality ~loc evd qsubst stateq q =
   match Sorts.Quality.(subst (subst_fn qsubst) q) with
   | QConstant qc -> stateq, PQConstant qc
+  | QGlobal qg -> stateq, PQGlobal qg
   | QVar qv ->
-    let qio = Sorts.QVar.var_index qv in
-    let stateq = Option.fold_right (update_invtblq1 ~loc evd q) qio stateq in
-    stateq, PQVar qio
+    match Sorts.QVar.repr qv with
+    | Var qi -> update_invtblq1 ~loc evd q qi stateq, PQVar (Some qi)
+    | Unif _ -> stateq, PQVar None
+    | Secvar _ -> CErrors.user_err ?loc Pp.(str "Section polymorphic sort not supported.")
 
 let update_invtblu ~loc evd (qsubst, usubst) (state, stateq, stateu : state) u : state * _ =
   let (q, u) = u |> UVars.Instance.to_array in
@@ -146,18 +149,29 @@ let safe_sort_pattern_of_sort ~loc evd (qsubst, usubst) (st, sq, su as state) s
   | SProp -> state, PSSProp
   | Prop -> state, PSProp
   | Set -> state, PSSet
-  | QSort (qold, u) ->
-      let sq, bq =
-        match Sorts.Quality.(var_index @@ subst_fn qsubst qold) with
-        | Some q -> update_invtblq1 ~loc evd (QVar qold) q sq, Some q
-        | None -> sq, None
-      in
-      let su, ba =
-        match universe_level_subst_var_index usubst u with
-        | Some (lvlold, lvl) -> update_invtblu1 ~loc evd lvlold lvl su, Some lvl
-        | None -> su, None
-      in
-      (st, sq, su), PSQSort (bq, ba)
+  | GSort (qg, u) ->
+    let su, ba =
+      match universe_level_subst_var_index usubst u with
+      | Some (lvlold, lvl) -> update_invtblu1 ~loc evd lvlold lvl su, Some lvl
+      | None -> su, None
+    in
+    (st, sq, su), PSGlobal (qg, ba)
+  | VSort (qold, u) ->
+    let su, ba =
+      match universe_level_subst_var_index usubst u with
+      | Some (lvlold, lvl) -> update_invtblu1 ~loc evd lvlold lvl su, Some lvl
+      | None -> su, None
+    in
+    match Sorts.Quality.subst_fn qsubst qold with
+    | QConstant _ -> assert false
+    | QGlobal qg -> (st, sq, su), PSGlobal (qg, ba)
+    | QVar qv ->
+    let sq, bq =
+      match Sorts.QVar.var_index qv with
+      | Some q -> update_invtblq1 ~loc evd (QVar qold) q sq, Some q
+      | None -> sq, None
+    in
+    (st, sq, su), PSQSort (bq, ba)
 
 
 let warn_irrelevant_pattern =
@@ -368,7 +382,7 @@ let warn_rewrite_rules_break_SR =
     Pp.(fun reason ->
         str "This rewrite rule breaks subject reduction" ++ spc() ++ reason)
 
-let interp_rule (udecl, lhs, rhs: Constrexpr.universe_decl_expr option * _ * _) =
+let interp_rule ~collapse_sort_variables (udecl, lhs, rhs: Constrexpr.universe_decl_expr option * _ * _) =
   let env = Global.env () in
   let evd = Evd.from_env env in
 
@@ -421,14 +435,14 @@ let interp_rule (udecl, lhs, rhs: Constrexpr.universe_decl_expr option * _ * _)
   let rhs_loc = rhs.CAst.loc in
 
   let lhs = Constrintern.(intern_gen WithoutTypeConstraint env evd lhs) in
-  let poly = PolyFlags.make ~univ_poly:true ~cumulative:false ~collapse_sort_variables:false in
+  let poly = PolyFlags.make ~univ_poly:true ~cumulative:false ~collapse_sort_variables in
   let flags = { Pretyping.no_classes_no_fail_inference_flags with
     undeclared_evars_rr = true; expand_evars = false;
     solve_unification_constraints = false; poly } in
   let evd, lhs, typ = Pretyping.understand_tcc_ty ~flags env evd lhs in
-  let evd = Evd.minimize_universes evd in
+  let evd = Evd.minimize_universes ~poly evd in
   let _qvars, uvars = EConstr.universes_of_constr evd lhs in
-  let evd = Evd.restrict_universe_context evd uvars in
+  let evd = Evd.restrict_ustate evd uvars in
   let uctx, uctx' = UState.check_univ_decl_rev (Evd.ustate evd) udecl in
 
   let usubst =
@@ -466,7 +480,7 @@ let interp_rule (udecl, lhs, rhs: Constrexpr.universe_decl_expr option * _ * _)
 
   (* 3. Read right hand side *)
   (* The udecl constraints (or, if none, the lhs constraints) must imply those of the rhs *)
-  let evd = Evd.set_universe_context evd uctx in
+  let evd = Evd.set_ustate evd uctx in
   let rhs = Constrintern.(intern_gen WithoutTypeConstraint env evd rhs) in
   let flags = { Pretyping.no_classes_no_fail_inference_flags with poly } in
   let evd', rhs =
@@ -476,10 +490,9 @@ let interp_rule (udecl, lhs, rhs: Constrexpr.universe_decl_expr option * _ * _)
         Pp.(surround (str "the replacement term doesn't have the type of the pattern") ++ str "." ++ fnl () ++ Himsg.explain_pretype_error env' evd' e);
       Pretyping.understand_tcc ~flags env evd rhs
   in
-
-  let evd' = Evd.minimize_universes evd' in
+  let evd' = Evd.minimize_universes ~poly evd' in
   let _qvars', uvars' = EConstr.universes_of_constr evd' rhs in
-  let evd' = Evd.restrict_universe_context evd' (Univ.Level.Set.union uvars uvars') in
+  let evd' = Evd.restrict_ustate evd' (Univ.Level.Set.union uvars uvars') in
   let fail pp = warn_rewrite_rules_break_SR ?loc:rhs_loc Pp.(surround (str "universe inconsistency") ++ str"." ++ spc() ++ str "Missing constraints: " ++ pp) in
   let () = UState.check_uctx_impl ~fail (Evd.ustate evd) (Evd.ustate evd') in
   let evd = evd' in
@@ -503,7 +516,11 @@ let interp_rule (udecl, lhs, rhs: Constrexpr.universe_decl_expr option * _ * _)
 
   let rhs = Vars.subst_univs_level_constr usubst rhs in
 
-  let test_qvar q =
+  let test_qvar (q:Sorts.Quality.t) =
+    match q with
+    | QGlobal _ -> ()
+    | QConstant _ -> assert false
+    | QVar q ->
     match Sorts.QVar.var_index q with
     | Some -1 ->
         CErrors.user_err ?loc:rhs_loc
@@ -536,14 +553,14 @@ let interp_rule (udecl, lhs, rhs: Constrexpr.universe_decl_expr option * _ * _)
 
   let () =
     let qs, us = Vars.sort_and_universes_of_constr rhs in
-    Sorts.QVar.Set.iter test_qvar qs;
+    Sorts.Quality.Set.iter test_qvar qs;
     Univ.Level.Set.iter test_level us
   in
 
   head_symbol, { nvars = (nvars' - 1, nvarqs', nvarus'); lhs_pat = head_umask, elims; rhs }
 
-let do_rules id rules =
+let do_rules ?(collapse_sort_variables = true) id rules =
   let env = Global.env () in
   if not @@ Environ.rewrite_rules_allowed env then raise Environ.(RewriteRulesNotAllowed Rule);
-  let body = { rewrules_rules = List.map interp_rule rules } in
+  let body = { rewrules_rules = List.map (interp_rule ~collapse_sort_variables) rules } in
   Global.add_rewrite_rules id body
diff --git a/vernac/comRewriteRule.mli b/vernac/comRewriteRule.mli
index 6ec456248bb3..1a939642414e 100644
--- a/vernac/comRewriteRule.mli
+++ b/vernac/comRewriteRule.mli
@@ -3,6 +3,7 @@ val do_symbols : poly:PolyFlags.t -> unfold_fix:bool ->
   -> unit
 
 val do_rules :
+  ?collapse_sort_variables:bool ->
   Names.Id.t ->
   (Constrexpr.universe_decl_expr option * Constrexpr.constr_expr * Constrexpr.constr_expr) list ->
   unit
diff --git a/vernac/comSearch.ml b/vernac/comSearch.ml
index 4d1ea506ae77..c6f648d3d0a5 100644
--- a/vernac/comSearch.ml
+++ b/vernac/comSearch.ml
@@ -56,7 +56,7 @@ let kind_searcher env = Decls.(function
   | IsDefinition Scheme ->
     let schemes = DeclareScheme.all_schemes () in
     let schemes = lazy begin
-      Indmap_env.fold (fun _ schemes acc ->
+      GlobRef.Map_env.fold (fun _ schemes acc ->
           CString.Map.fold (fun _ c acc ->
             GlobRef.Set_env.add c acc) schemes acc)
         schemes GlobRef.Set_env.empty
diff --git a/vernac/declare.ml b/vernac/declare.ml
index c9b5d22facce..a7fa69557df4 100644
--- a/vernac/declare.ml
+++ b/vernac/declare.ml
@@ -89,7 +89,6 @@ module Info = struct
 
   type t =
     { poly : PolyFlags.t
-    ; inline : bool
     ; kind : Decls.logical_kind
     ; udecl : UState.universe_decl
     ; scope : Locality.definition_scope
@@ -102,10 +101,10 @@ module Info = struct
 
   (** Note that [opaque] doesn't appear here as it is not known at the
      start of the proof in the interactive case. *)
-  let make ?(poly = PolyFlags.default) ?(inline=false) ?(kind=Decls.(IsDefinition Definition))
+  let make ?(poly = PolyFlags.default) ?(kind=Decls.(IsDefinition Definition))
       ?(udecl=UState.default_univ_decl) ?(scope=Locality.default_scope)
       ?(clearbody=false) ?hook ?typing_flags ?user_warns ?(ntns=[]) () =
-    { poly; inline; kind; udecl; scope; hook; typing_flags; clearbody; user_warns; ntns }
+    { poly; kind; udecl; scope; hook; typing_flags; clearbody; user_warns; ntns }
 end
 
 module SideEff :
@@ -414,7 +413,7 @@ let load_constant i ((sp,kn), obj) =
   let con = Global.constant_of_delta_kn kn in
   let gr = GlobRef.ConstRef con in
   Nametab.push ?user_warns:obj.cst_warn (Nametab.Until i) sp gr;
-  Dumpglob.add_constant_kind con obj.cst_kind;
+  Dumpglob.add_constant_kind (Global.env ()) con obj.cst_kind;
   obj.cst_loc |> Option.iter (fun loc -> Nametab.set_cci_src_loc (TrueGlobal gr) loc);
   begin match obj.cst_locl with
     | Locality.ImportNeedQualified -> local_csts := Cset_env.add con !local_csts
@@ -441,7 +440,7 @@ let cache_constant ((sp,kn), obj) =
   let kn = Global.constant_of_delta_kn kn in
   let gr = GlobRef.ConstRef kn in
   Nametab.push ?user_warns:obj.cst_warn (Nametab.Until 1) sp gr;
-  Dumpglob.add_constant_kind kn obj.cst_kind;
+  Dumpglob.add_constant_kind (Global.env ()) kn obj.cst_kind;
   obj.cst_loc |> Option.iter (fun loc -> Nametab.set_cci_src_loc (TrueGlobal gr) loc)
 
 let discharge_constant obj = Some obj
@@ -485,7 +484,7 @@ let register_side_effect (c, body, role, univs) =
   in
   match role with
   | None -> ()
-  | Some (Evd.Schema (ind, kind)) -> DeclareScheme.declare_scheme SuperGlobal kind (ind, GlobRef.ConstRef c)
+  | Some (Evd.Schema (ind, kind)) -> DeclareScheme.declare_scheme SuperGlobal kind (GlobRef.IndRef ind, GlobRef.ConstRef c)
 
 let get_roles export eff =
   let eff = SideEff.obj eff in
@@ -704,7 +703,7 @@ let declare_private_constant ?role ?ts ~name ~opaque de effs =
 
 let inline_private_constants ~uctx env (body, eff) =
   let body, ctx = Safe_typing.inline_private_constants env (body, SideEff.get eff) in
-  let uctx = UState.merge_universe_context ~sideff:true Evd.univ_rigid uctx ctx in
+  let uctx = UState.merge_universe_context_set ~sideff:true Evd.univ_rigid uctx ctx in
   body, uctx
 
 (** Declaration of section variables and local definitions *)
@@ -1019,7 +1018,7 @@ let declare_possibly_mutual_parameters ~info ~cinfo ?(mono_uctx_extra=UState.emp
       let typ = Vars.replace_vars subst typ in
       let pe = {
           parameter_entry_secctx = sec_vars;
-          parameter_entry_type = Evarutil.nf_evars_universes (Evd.from_ctx uctx) typ;
+          parameter_entry_type = Evarutil.nf_evars_universes (Evd.from_ustate uctx) typ;
           parameter_entry_universes = univs;
           parameter_entry_inline_code = None;
         } in
@@ -1028,13 +1027,20 @@ let declare_possibly_mutual_parameters ~info ~cinfo ?(mono_uctx_extra=UState.emp
       (i+1, (name, Constr.mkConstU (cst,inst))::subst, (cst, univs)::csts)
   ) (0, [], []) cinfo typs)
 
-let make_recursive_bodies ?elim_to env ~typing_flags ~possible_guard ~rec_declaration =
+let make_recursive_bodies ?sigma env ~typing_flags ~possible_guard ~rec_declaration =
   let env = Environ.update_typing_flags ?typing_flags env in
-  let indexes = Pretyping.search_guard ?elim_to env possible_guard rec_declaration in
+  (* We need sigma to check for elimination constraints. In most cases it's None, except for
+     [declare_mutual_definitions] where we get it from UState. *)
+  let sigma = Option.default (Evd.from_env env) sigma in
+  let res = Pretyping.search_guard env sigma possible_guard rec_declaration in
+  let sigma, indexes = match res with
+    | None -> sigma, None
+    | Some (sigma, indexes) -> sigma, Some indexes
+  in
   let mkbody i = match indexes with
   | Some indexes -> Constr.mkFix ((indexes,i), rec_declaration)
   | None -> Constr.mkCoFix (i, rec_declaration) in
-  List.map_i (fun i typ -> (mkbody i, typ)) 0 (Array.to_list (pi2 rec_declaration)), indexes
+  List.map_i (fun i typ -> (mkbody i, typ)) 0 (Array.to_list (pi2 rec_declaration)), sigma, indexes
 
 let prepare_recursive_declaration cinfo fixtypes fixrs fixdefs =
   let fixnames = List.map (fun CInfo.{name} -> name) cinfo in
@@ -1055,8 +1061,8 @@ let declare_mutual_definitions ~info ~cinfo ~opaque ~eff ~uctx ~bodies ~possible
   let possible_guard, fixrelevances = possible_guard in
   let fixtypes = List.map (fun CInfo.{typ} -> typ) cinfo in
   let rec_declaration = prepare_recursive_declaration cinfo fixtypes fixrelevances bodies in
-  let elim_to = Inductive.eliminates_to @@ UState.elim_graph uctx in
-  let bodies_types, indexes = make_recursive_bodies ~elim_to env ~typing_flags ~rec_declaration ~possible_guard in
+  let bodies_types, sigma, indexes = make_recursive_bodies ~sigma:(Evd.from_ustate uctx) env ~typing_flags ~rec_declaration ~possible_guard in
+  let uctx = Evd.ustate sigma in
   let entries = List.map (fun (body, typ) -> (body, Some typ)) bodies_types in
   let entries_for_using = List.map (fun (body, typ) -> (body, Some typ)) bodies_types in
   let using = interp_mutual_using env cinfo entries_for_using using in
@@ -1090,7 +1096,8 @@ let declare_definition ~info ~cinfo ~opaque ~obls ~body ?using sigma =
   let env = Global.env () in
   Option.iter (check_evars_are_solved env sigma) typ;
   check_evars_are_solved env sigma body;
-  let sigma = Evd.minimize_universes sigma in
+  let poly = info.Info.poly in
+  let sigma = Evd.minimize_universes ~poly sigma in
   let body = EConstr.to_constr sigma body in
   let typ = Option.map (EConstr.to_constr sigma) typ in
   let uctx = Evd.ustate sigma in
@@ -1107,7 +1114,7 @@ let prepare_obligations ~name poly ?types ~body env sigma =
     | Some t -> t
     | None -> Retyping.get_type_of env sigma body
   in
-  let sigma, (body, types) = Evarutil.finalize ~abort_on_undefined_evars:false
+  let sigma, (body, types) = Evarutil.finalize ~abort_on_undefined_evars:false ~poly
       sigma (fun nf -> nf body, nf types)
   in
   RetrieveObl.check_evars env sigma;
@@ -1119,7 +1126,7 @@ let prepare_obligations ~name poly ?types ~body env sigma =
 let prepare_parameter ~poly ~udecl ~types sigma =
   let env = Global.env () in
   Pretyping.check_evars_are_solved ~program_mode:false env sigma;
-  let sigma, typ = Evarutil.finalize ~abort_on_undefined_evars:true
+  let sigma, typ = Evarutil.finalize ~abort_on_undefined_evars:true ~poly
       sigma (fun nf -> nf types)
   in
   let univs = Evd.check_univ_decl ~poly sigma udecl in
@@ -1201,15 +1208,16 @@ module ProgramDecl = struct
         , b )
     in
     let prg_uctx =
-      if PolyFlags.univ_poly info.Info.poly then uctx
+      let poly = info.Info.poly in
+      if PolyFlags.univ_poly poly then uctx
       else
         (* declare global univs of the main constant before we do obligations *)
-        let uctx = UState.collapse_sort_variables uctx in
+        let uctx = UState.collapse_sort_variables ~only_above_prop:(not @@ PolyFlags.collapse_sort_variables poly) uctx in
         let ctx = UState.check_mono_sort_constraints uctx in
         let () = Global.push_context_set ctx in
         let cst = Constant.make2 (Lib.current_mp()) cinfo.CInfo.name in
         let () = DeclareUniv.declare_univ_binders (ConstRef cst)
-            (UState.univ_entry ~poly:info.Info.poly uctx)
+            (UState.univ_entry ~poly uctx)
         in
         UState.Internal.reboot (Global.env()) uctx
     in
@@ -1529,7 +1537,7 @@ let subst_prog subst prg =
 
 let declare_definition ~pm prg =
   let varsubst = obligation_substitution true prg in
-  let sigma = Evd.from_ctx prg.prg_uctx in
+  let sigma = Evd.from_ustate prg.prg_uctx in
   let body, types = subst_prog varsubst prg in
   let body, types = EConstr.(of_constr body, of_constr types) in
   let cinfo = { prg.prg_cinfo with CInfo.typ = Some types } in
@@ -1549,7 +1557,7 @@ let declare_mutual_definitions ~pm l =
   let defobl x =
     let oblsubst = obligation_substitution true x in
     let subs, typ = subst_prog oblsubst x in
-    let sigma = Evd.from_ctx x.prg_uctx in
+    let sigma = Evd.from_ustate x.prg_uctx in
     let term = EConstr.of_constr subs in
     let typ = EConstr.of_constr typ in
     let term = EConstr.to_constr sigma term in
@@ -1674,7 +1682,7 @@ let obligation_terminator ~pm ~entry ~eff ~uctx ~oinfo:{name; num; auto; check_f
   in
   (* TODO: we always inline effects here, maybe we could export them when transparent? *)
   let body, uctx = inline_private_constants ~uctx env (body, eff) in
-  let sigma = Evd.from_ctx uctx in
+  let sigma = Evd.from_ustate uctx in
   Inductiveops.control_only_guard (Global.env ()) sigma
     (EConstr.of_constr body);
   (* Declare the obligation ourselves and drop the hook *)
@@ -1775,9 +1783,13 @@ module Proof = struct
 type nonrec closed_proof_output = closed_proof_output
 type proof_object = Proof_object.t
 
+type late_init = Explicit | Implicit | NotRequired
+
 type t =
   { endline_tactic : Gentactic.glob_generic_tactic option
   ; using : Id.Set.t option
+  ; has_late_init : late_init option
+  (** Explicit if Proof was used, Implicit if we started modifying the proof before Proof was used *)
   ; proof : Proof.t
   ; initial_euctx : UState.t
   (** The initial universe context (for the statement) *)
@@ -1810,13 +1822,17 @@ let compact pf = map ~f:Proof.compact pf
 let set_endline_tactic tac ps =
   { ps with endline_tactic = Some tac }
 
+let finish_late_init ps explicit = { ps with has_late_init = Some explicit }
+
+let has_late_init ps = ps.has_late_init
+
 let initialize_named_context_for_proof () =
   let sign = Global.named_context () in
   List.fold_right
     (fun d signv ->
       let id = NamedDecl.get_id d in
       let d = if Decls.variable_opacity id then NamedDecl.drop_body d else d in
-      Environ.push_named_context_val d signv) sign Environ.empty_named_context_val
+      Environ.push_named_context_val SecVar d signv) sign Environ.empty_named_context_val
 
 let start_proof_core ~name ~pinfo ?using sigma goals =
   (* In ?sign, we remove the bodies of variables in the named context
@@ -1830,6 +1846,7 @@ let start_proof_core ~name ~pinfo ?using sigma goals =
   let proof = Proof.start ~name ~poly ?typing_flags sigma goals in
   let initial_euctx = Evd.ustate Proof.((data proof).sigma) in
   { proof
+  ; has_late_init = None
   ; endline_tactic = None
   ; using
   ; initial_euctx
@@ -1855,6 +1872,7 @@ let start_dependent ~info ~cinfo ~name ~proof_ending goals =
   let initial_euctx = Evd.ustate Proof.((data proof).sigma) in
   let pinfo = Proof_info.make ~info ~cinfo ~proof_ending () in
   { proof
+  ; has_late_init = None
   ; endline_tactic = None
   ; using = None
   ; initial_euctx
@@ -1901,7 +1919,7 @@ let start_mutual_definitions ~info ~cinfo ~bodies ~possible_guard ?using sigma =
     let sign =
       List.fold_left2 (fun sign CInfo.{name;typ} r ->
           let decl = Context.Named.Declaration.LocalAssum (Context.make_annot name r, typ) in
-          EConstr.push_named_context_val decl sign) (initialize_named_context_for_proof ()) cinfo' fixrs in
+          EConstr.push_named_context_val ProofVar decl sign) (initialize_named_context_for_proof ()) cinfo' fixrs in
     let using = Option.map (interp_proof_using_cinfo env sigma cinfo') using in
     let goals = List.map (function CInfo.{typ} -> (Some sign, typ)) thms in
     let lemma = start_proof_core ~name ~pinfo ?using sigma goals in
@@ -1911,7 +1929,9 @@ let start_mutual_definitions ~info ~cinfo ~bodies ~possible_guard ?using sigma =
       (* Temporary declaration of notations for the time of the proofs *)
       let ntn_env =
         (* We simulate the goal context in which the fixpoint bodies have to be proved (exact relevance does not matter) *)
-        let make_decl CInfo.{name; typ} = Context.Named.Declaration.LocalAssum (Context.annotR name, typ) in
+        let make_decl CInfo.{name; typ} =
+          Environ.ProofVar, Context.Named.Declaration.LocalAssum (Context.annotR name, typ)
+        in
         Environ.push_named_context (List.map make_decl cinfo) (Global.env()) in
       List.iter (Metasyntax.add_notation_interpretation ~local:(info.scope=Locality.Discharge) ntn_env) info.ntns in
     lemma
@@ -1937,7 +1957,7 @@ let start_mutual_definitions_refine ~info ~cinfo ~bodies ~possible_guard ?using
     let sign =
       List.fold_left2 (fun sign CInfo.{name;typ} r ->
           let decl = Context.Named.Declaration.LocalAssum (Context.make_annot name r, typ) in
-          EConstr.push_named_context_val decl sign) (initialize_named_context_for_proof ()) cinfo fixrs in
+          EConstr.push_named_context_val ProofVar decl sign) (initialize_named_context_for_proof ()) cinfo fixrs in
     let using = Option.map (interp_proof_using_cinfo env sigma cinfo) using in
     let goals = List.map (function CInfo.{typ} -> (Some sign, typ)) thms in
     let lemma = start_proof_core ~name ~pinfo ?using sigma goals in
@@ -1952,7 +1972,9 @@ let start_mutual_definitions_refine ~info ~cinfo ~bodies ~possible_guard ?using
       (* Temporary declaration of notations for the time of the proofs *)
       let ntn_env =
         (* We simulate the goal context in which the fixpoint bodies have to be proved (exact relevance does not matter) *)
-        let make_decl CInfo.{name; typ} = Context.Named.Declaration.LocalAssum (Context.annotR name, EConstr.Unsafe.to_constr typ) in
+        let make_decl CInfo.{name; typ} =
+          Environ.ProofVar, Context.Named.Declaration.LocalAssum (Context.annotR name, EConstr.Unsafe.to_constr typ)
+        in
         Environ.push_named_context (List.map make_decl cinfo) (Global.env()) in
       List.iter (Metasyntax.add_notation_interpretation ~local:(info.scope=Locality.Discharge) ntn_env) info.ntns in
     lemma
@@ -1968,7 +1990,7 @@ let set_used_variables ps ~using =
   let ctx_set =
     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 as orig) =
+  let aux env _status entry (ctx, all_safe as orig) =
     match entry with
     | LocalAssum ({Context.binder_name=x},_) ->
        if Id.Set.mem x all_safe then orig
@@ -2080,22 +2102,24 @@ let prepare_proof ?(warn_incomplete=true) { proof; pinfo; sideff } =
     Proof.unfocus_all proof
   in
   let eff = SideEff.make @@ Evd.eval_side_effects evd in
-  let evd = Evd.minimize_universes evd in
+  let evd = Evd.minimize_universes ~poly evd in
   let to_constr c =
     match EConstr.to_constr_opt evd c with
     | Some p -> p
     | None -> raise_non_ground_proof evd pid c
   in
   let proofs = List.map (fun (_, body, typ) -> (to_constr body, to_constr typ)) initial_goals in
-  let proofs = match pinfo.possible_guard with
-    | None -> proofs
+  let proofs, evd = match pinfo.possible_guard with
+    | None -> proofs, evd
     | Some (possible_guard, fixrelevances) ->
       let env = Safe_typing.push_private_constants (Global.env()) (SideEff.get eff) in
       let fixbodies, fixtypes = List.split proofs in
       let fixrelevances = List.map (EConstr.ERelevance.kind evd) fixrelevances in
       let rec_declaration = prepare_recursive_declaration pinfo.cinfo fixtypes fixrelevances fixbodies in
       let typing_flags = pinfo.info.typing_flags in
-      fst (make_recursive_bodies ~elim_to:(Inductive.eliminates_to (Evd.elim_graph evd)) env ~typing_flags ~possible_guard ~rec_declaration) in
+      let proofs, sigma, _ = (make_recursive_bodies ~sigma:evd env ~typing_flags ~possible_guard ~rec_declaration) in
+      proofs, evd
+  in
   let proofs = List.map (fun (body, typ) -> (body, Some typ)) proofs in
   let () = if warn_incomplete then check_incomplete_proof evd in
   { output_entries = proofs; output_ustate = Evd.ustate evd; output_sideff = SideEff.concat eff sideff }
@@ -2237,12 +2261,12 @@ let finish_admitted ~pm ~pinfo ~sec_vars typs =
 
 let save_admitted ~pm ~proof =
   let iproof = get proof in
-  let Proof.{ entry } = Proof.data iproof in
+  let Proof.{ entry; poly } = Proof.data iproof in
   let typs = List.map pi3 (Proofview.initial_goals entry) in
-  let sigma = Evd.from_ctx proof.initial_euctx in
+  let sigma = Evd.from_ustate proof.initial_euctx in
   List.iter (check_type_evars_solved (Global.env()) sigma) typs;
   let sec_vars = compute_proof_using_for_admitted proof.pinfo proof typs iproof in
-  let sigma = Evd.minimize_universes sigma in
+  let sigma = Evd.minimize_universes ~poly sigma in
   let uctx = Evd.ustate sigma in
   let typs = List.map (fun typ -> (EConstr.to_constr sigma typ, uctx)) typs in
   finish_admitted ~pm ~pinfo:proof.pinfo ~sec_vars typs
@@ -2467,15 +2491,14 @@ let solve_by_tac prg obls i tac =
   let uctx = Internal.get_uctx prg in
   let uctx = UState.update_sigma_univs uctx (Global.universes ()) in
   let poly = Internal.get_poly prg in
-  (* the status of [build_by_tactic] is dropped. *)
   try
     let env = Global.env () in
     let typ = EConstr.of_constr obl.obl_type in
     (* If the proof is open we absorb the error and leave the obligation open *)
     match Subproof.build_by_tactic_opt env ~uctx ~poly ~typ tac with
     | None -> None
-    | Some (body, types, _univs, _, uctx) ->
-      let () = Inductiveops.control_only_guard env (Evd.from_ctx uctx) (EConstr.of_constr body) in
+    | Some (body, types, _univs, uctx) ->
+      let () = Inductiveops.control_only_guard env (Evd.from_ustate uctx) (EConstr.of_constr body) in
       Some (body, types, uctx)
   with
   | Tacticals.FailError (_, s) as exn ->
@@ -2559,7 +2582,7 @@ let solve_obligation ?check_final prg num tac =
   in
   let obl = subst_deps_obl obls obl in
   let kind = kind_of_obligation (snd obl.obl_status) in
-  let evd = Evd.from_ctx (Internal.get_uctx prg) in
+  let evd = Evd.from_ustate (Internal.get_uctx prg) in
   let evd = Evd.update_sigma_univs (Global.universes ()) evd in
   let auto ~pm n oblset tac = fst (auto_solve_obligations ~pm n ~oblset tac) in
   let proof_ending =
@@ -2578,6 +2601,7 @@ let solve_obligation ?check_final prg num tac =
   let poly = Internal.get_poly prg in
   let info = Info.make ~kind ~poly () in
   let lemma = Proof.start_core ~cinfo ~info ~proof_ending ?using evd  in
+  let lemma = Proof.finish_late_init lemma NotRequired in
   let lemma = fst @@ Proof.by (Global.env ()) !default_tactic lemma in
   let lemma = Option.cata (fun tac -> Proof.set_endline_tactic tac lemma) lemma tac in
   lemma
diff --git a/vernac/declare.mli b/vernac/declare.mli
index 402c6b1ccc17..5fbf778a6368 100644
--- a/vernac/declare.mli
+++ b/vernac/declare.mli
@@ -101,7 +101,6 @@ module Info : sig
      start of the proof in the interactive case. *)
   val make
    : ?poly:PolyFlags.t
-    -> ?inline : bool
     -> ?kind : Decls.logical_kind
     (** Theorem, etc... *)
     -> ?udecl : UState.universe_decl
@@ -269,6 +268,13 @@ module Proof : sig
   (** Sets the tactic to be used when a tactic line is closed with [...] *)
   val set_endline_tactic : Gentactic.glob_generic_tactic -> t -> t
 
+  (** Explicit: explicit Proof command, Implicit: no Proof command,
+      NotRequired: opened by Next Obligation or similar *)
+  type late_init = Explicit | Implicit | NotRequired
+
+  val finish_late_init : t -> late_init -> t
+  val has_late_init : t -> late_init option
+
   val definition_scope : t -> Locality.definition_scope
 
   (** Sets the section variables assumed by the proof, returns its closure
diff --git a/vernac/declareUniv.ml b/vernac/declareUniv.ml
index d25d2f685bef..f06f95f63b5b 100644
--- a/vernac/declareUniv.ml
+++ b/vernac/declareUniv.ml
@@ -35,7 +35,7 @@ type sort_source =
 
 type sort_name_decl = {
   sdecl_src : sort_source; (* global sort introduced by some global value *)
-  sdecl_named : (Id.t * Sorts.QGlobal.t) list;
+  sdecl_named : (Id.t * Sorts.Quality.t) list;
 }
 
 let check_exists_universe sp =
@@ -214,31 +214,47 @@ let do_universe ~poly l =
     in
     Global.push_section_context ctx
 
-let do_sort ~poly l =
+let do_sort_mono l =
+  let l = List.map (fun {CAst.v=id} ->
+      let q = Global.new_global_sort () in
+      q, (id, Sorts.Quality.QGlobal q))
+      l
+  in
+  let src = UnqualifiedQuality in
+  input_sort_names (src, List.map snd l)
+
+let do_sort_poly l =
   let in_section = Lib.sections_are_opened () in
   let () =
-    if poly && not in_section then
+    if not in_section then
       CErrors.user_err
         (Pp.str"Cannot declare polymorphic sorts outside sections.")
   in
-  let l = List.map (fun {CAst.v=id} -> (id, UnivGen.new_sort_global id)) l in
-  let src = if poly then BoundQuality else UnqualifiedQuality in
-  let () = input_sort_names (src, l) in
-  match poly with
-  | false ->
-    let qs = List.fold_left  (fun qs (_, qv) -> Sorts.QVar.(Set.add (make_global qv) qs))
-      Sorts.QVar.Set.empty l
+  let new_sort =
+    let n = Section.section_qvar_count @@
+      Option.get @@ Safe_typing.sections_of_safe_env @@
+      Global.safe_env ()
     in
-    let rigid = false in (* No constraints, rigidity does not matter *)
-    Global.push_qualities ~rigid (qs, Sorts.ElimConstraints.empty) (* XXX *)
-  | true ->
-    let names = CArray.map_of_list (fun (na,_) -> Name na) l in
-    let qs = CArray.map_of_list (fun (_,sg) -> Sorts.Quality.global sg) l in
-    let ctx =
-      UVars.UContext.make {quals=names; univs=[||]}
-        (UVars.Instance.of_array (qs,[||]), PConstraints.empty)
-    in
-    Global.push_section_context ctx
+    let n = ref n in
+    fun _id ->
+      let x = !n in
+      let () = incr n in
+      let q = Sorts.QVar.make_secvar x in
+      Sorts.Quality.QVar q
+  in
+  let l = List.map (fun {CAst.v=id} -> (id, new_sort id)) l in
+  let src = BoundQuality in
+  let () = input_sort_names (src, l) in
+  let names = CArray.map_of_list (fun (na,_) -> Name na) l in
+  let qs = CArray.map_of_list snd l in
+  let ctx =
+    UVars.UContext.make {quals=names; univs=[||]}
+      (UVars.Instance.of_array (qs,[||]), PConstraints.empty)
+  in
+  Global.push_section_context ctx
+
+let do_sort ~poly l =
+  if poly then do_sort_poly l else do_sort_mono l
 
 let do_constraint ~poly l =
   let evd = Evd.from_env (Global.env ()) in
@@ -255,7 +271,7 @@ let do_constraint ~poly l =
   match poly with
   | false ->
     let qcst, ucst = constraints in
-    let () = Global.push_qualities ~rigid:true (Sorts.QVar.Set.empty, qcst) in (* XXX *)
+    let () = Global.merge_elim_constraints qcst in
     Global.push_context_set (Univ.Level.Set.empty, ucst)
   | true ->
     let uctx = UVars.UContext.make
diff --git a/vernac/declaremods.ml b/vernac/declaremods.ml
index 3909e3388f86..31780b8f57a4 100644
--- a/vernac/declaremods.ml
+++ b/vernac/declaremods.ml
@@ -39,7 +39,7 @@ type inline =
 let default_inline_level = 100
 
 let { Goptions.get = default_inline_level } =
-  Goptions.declare_int_option_and_ref ~key:["Inline";"Level"] ~value:default_inline_level ()
+  Goptions.declare_int_option_and_ref ~stage:Synterp ~key:["Inline";"Level"] ~value:default_inline_level ()
 
 let default_inline_level () = Some (default_inline_level())
 
@@ -106,7 +106,6 @@ let escape_objects id escape = match escape.escape_objects with
     for Synterp and Interp. *)
 module type ModActions = sig
 
-  type typexpr
   type env
 
   val stage : Summary.Stage.t
@@ -127,11 +126,9 @@ module type ModActions = sig
 
 end
 
-module SynterpActions : ModActions with
-  type env = unit with
-  type typexpr = Constrexpr.universe_decl_expr option * Constrexpr.constr_expr =
+module SynterpActions : ModActions
+  with type env = unit =
 struct
-  type typexpr = Constrexpr.universe_decl_expr option * Constrexpr.constr_expr
   type env = unit
   let stage = Summary.Stage.Synterp
   let substobjs_table_name = "MODULE-SYNTAX-SUBSTOBJS"
@@ -166,10 +163,8 @@ struct
 end
 
 module InterpActions : ModActions
-  with type env = Environ.env
-  with type typexpr = Constr.t * UVars.AbstractContext.t option =
+  with type env = Environ.env =
 struct
-  type typexpr = Constr.t * UVars.AbstractContext.t option
   type env = Environ.env
   let stage = Summary.Stage.Interp
   let substobjs_table_name = "MODULE-SUBSTOBJS"
@@ -224,10 +219,9 @@ type module_objects =
 (** The [StagedModS] abstraction describes module operations at a given stage. *)
 module type StagedModS = sig
 
-  type typexpr
   type env
 
-  val get_module_sobjs : bool -> env -> Entries.inline -> typexpr module_alg_expr -> substitutive_objects
+  val get_module_sobjs : bool -> env -> Entries.inline -> _ module_alg_expr -> substitutive_objects
 
   val load_keep : int -> full_path -> ModPath.t -> keep_objects -> unit
   val load_escape : int -> full_path -> ModPath.t -> escape_objects -> unit
@@ -239,7 +233,7 @@ module type StagedModS = sig
 
   val expand_aobjs : Libobject.algebraic_objects -> Libobject.t list
 
-  val get_applications : typexpr module_alg_expr -> ModPath.t * ModPath.t list
+  val get_applications : _ module_alg_expr -> ModPath.t * ModPath.t list
   val debug_print_modtab : unit -> Pp.t
 
   module ModObjs : sig val all : unit -> module_objects ModPath.Map.t end
@@ -296,7 +290,6 @@ and subst_objects subst seg =
   that is common to all stages. *)
 module StagedMod(Actions : ModActions) = struct
 
-type typexpr = Actions.typexpr
 type env = Actions.env
 
 (** ModSubstObjs : a cache of module substitutive objects
@@ -310,37 +303,62 @@ type env = Actions.env
    - A alias (i.e. a module path inside a Ref constructor) should
      never lead to another alias, but rather to a concrete Objs
      constructor.
-
-   We will plug later a handler dealing with missing entries in the
-   cache. Such missing entries may come from inner parts of module
-   types, which aren't registered by the standard libobject machinery.
 *)
 
 module ModSubstObjs :
  sig
    val set : ModPath.t -> substitutive_objects -> unit
    val get : ModPath.t -> substitutive_objects
-   val set_missing_handler : (ModPath.t -> substitutive_objects) -> unit
+   val expand_aobjs : algebraic_objects -> Libobject.t list
+   val expand_sobjs : substitutive_objects -> Libobject.t list
  end =
  struct
    let table =
      Summary.ref ~stage:Actions.stage (ModPath.Map.empty : substitutive_objects ModPath.Map.t)
        ~name:Actions.substobjs_table_name
-   let missing_handler = ref (fun mp -> assert false)
-   let set_missing_handler f = (missing_handler := f)
+
    let set mp objs = (table := ModPath.Map.add mp objs !table)
-   let get mp =
-     try ModPath.Map.find mp !table with Not_found -> !missing_handler mp
+
+   let rec get mp =
+     try ModPath.Map.find mp !table with Not_found ->
+       handle_missing_substobjs mp
+
+   and expand_aobjs = function
+     | Objs o -> o
+     | Ref (mp, sub) ->
+       match get mp with
+       | (_,Objs o) -> subst_objects sub o
+       | _ -> assert false (* Invariant : any alias points to concrete objs *)
+
+   and expand_sobjs (_,aobjs) = expand_aobjs aobjs
+
+   (** {6 Handler for missing entries in ModSubstObjs} *)
+
+   (** Since the inner of Module Types are not added by default to
+       the ModSubstObjs table, we compensate this by explicit traversal
+       of Module Types inner objects when needed. Quite a hack... *)
+
+   and register_mod_objs mp obj =
+     let mp_id mp id = MPdot (mp, id) in
+     match obj with
+     | ModuleObject (id,sobjs) -> set (mp_id mp id) sobjs
+     | ModuleTypeObject (id,sobjs) -> set (mp_id mp id) sobjs
+     | IncludeObject aobjs ->
+       List.iter (register_mod_objs mp) (expand_aobjs aobjs)
+     | _ -> ()
+
+   and handle_missing_substobjs mp = match mp with
+     | MPdot (mp',l) ->
+       let objs = expand_sobjs (get mp') in
+       List.iter (register_mod_objs mp') objs;
+       get mp
+     | _ ->
+       assert false (* Only inner parts of module types should be missing *)
  end
 
-let expand_aobjs = function
-  | Objs o -> o
-  | Ref (mp, sub) ->
-    match ModSubstObjs.get mp with
-      | (_,Objs o) -> subst_objects sub o
-      | _ -> assert false (* Invariant : any alias points to concrete objs *)
+let expand_aobjs = ModSubstObjs.expand_aobjs
 
-let expand_sobjs (_,aobjs) = expand_aobjs aobjs
+let expand_sobjs = ModSubstObjs.expand_sobjs
 
 module Expand =
 struct
@@ -663,33 +681,6 @@ let import_modules ~export mpl =
     let entry = ExportObject { mpl } in
     add_leaf_entry entry
 
-(** {6 Handler for missing entries in ModSubstObjs} *)
-
-(** Since the inner of Module Types are not added by default to
-    the ModSubstObjs table, we compensate this by explicit traversal
-    of Module Types inner objects when needed. Quite a hack... *)
-
-let mp_id mp id = MPdot (mp, id)
-
-let rec register_mod_objs mp obj = match obj with
-  | ModuleObject (id,sobjs) -> ModSubstObjs.set (mp_id mp id) sobjs
-  | ModuleTypeObject (id,sobjs) -> ModSubstObjs.set (mp_id mp id) sobjs
-  | IncludeObject aobjs ->
-    List.iter (register_mod_objs mp) (expand_aobjs aobjs)
-  | _ -> ()
-
-let handle_missing_substobjs mp = match mp with
-  | MPdot (mp',l) ->
-    let objs = expand_sobjs (ModSubstObjs.get mp') in
-    List.iter (register_mod_objs mp') objs;
-    ModSubstObjs.get mp
-  | _ ->
-    assert false (* Only inner parts of module types should be missing *)
-
-let () = ModSubstObjs.set_missing_handler handle_missing_substobjs
-
-
-
 (** {6 From module expression to substitutive objects} *)
 
 (** Turn a chain of [MSEapply] into the head ModPath.t and the
@@ -709,6 +700,8 @@ let get_applications mexpr =
 let rec replace_module_object idl mp0 objs0 mp1 objs1 =
   match idl, objs0 with
   | _,[] -> []
+  | idl, (IncludeObject aobjs) :: tail ->
+    replace_module_object idl mp0 (expand_aobjs aobjs @ tail) mp1 objs1
   | id::idl,(ModuleObject (id', sobjs))::tail when Id.equal id id' ->
     begin
       let mp_id = MPdot(mp0, id) in
@@ -772,12 +765,10 @@ end
 
 module SynterpVisitor : StagedModS
   with type env = SynterpActions.env
-  with type typexpr = Constrexpr.universe_decl_expr option * Constrexpr.constr_expr
   = StagedMod(SynterpActions)
 
 module InterpVisitor : StagedModS
   with type env = InterpActions.env
-  with type typexpr = Constr.t * UVars.AbstractContext.t option
  = StagedMod(InterpActions)
 
 (** {6 Modules : start, end, declare} *)
@@ -823,7 +814,7 @@ let openmod_syntax_info () = match !openmod_syntax_info with
 
 let vm_state =
   (* VM bytecode is not needed here *)
-  let vm_handler _ _ _ () = (), None in
+  let vm_handler _ _ _ () = (), Vmemitcodes.BCuncompiled in
   ((), { Mod_typing.vm_handler })
 
 module RawModOps = struct
@@ -1010,7 +1001,7 @@ let build_subtypes env mp args mtys =
       let state = ((Environ.universes env, Univ.UnivConstraints.empty), Reductionops.inferred_universes) in
       (* functor arguments are already part of the env, we compute the type
          and requantify over them *)
-      let mtb, (_, cst), _ = Mod_typing.translate_modtype state vm_state env mp inl ([], mte) in
+      let mtb, (_, cst), () = Mod_typing.translate_modtype state vm_state env mp inl ([], mte) in
       let fold (mbid, mtb, _, _) accu =
         MoreFunctor (mbid, mtb, accu)
       in
@@ -1443,7 +1434,7 @@ let declare_one_include_core (me,base,kind,inl) =
   let () = Global.add_univ_constraints cst in
   let () = assert (ModPath.equal cur_mp (Global.current_modpath ())) in
   (* Include Self support  *)
-  let mb = make_module_body (RawModOps.Interp.current_struct ()) (RawModOps.Interp.current_modresolver ()) [] in
+  let mb = make_module_body (RawModOps.Interp.current_struct ()) (RawModOps.Interp.current_modresolver ()) in
   let rec compute_sign sign =
     match sign with
     | MoreFunctor(mbid,mtb,str) ->
diff --git a/vernac/dune b/vernac/dune
index 816749decefb..a84e793c08ae 100644
--- a/vernac/dune
+++ b/vernac/dune
@@ -8,10 +8,6 @@
  ; (private_modules comProgramFixpoint egramcoq)
  (libraries tactics parsing findlib.dynload))
 
-(deprecated_library_name
- (old_public_name coq-core.vernac)
- (new_public_name rocq-runtime.vernac))
-
 (rule
  (targets g_proofs.ml)
  (deps (:mlg g_proofs.mlg))
diff --git a/vernac/egramrocq.ml b/vernac/egramrocq.ml
index 22eec17aac7c..562da2bed195 100644
--- a/vernac/egramrocq.ml
+++ b/vernac/egramrocq.ml
@@ -267,11 +267,11 @@ type (_, _) entry =
 | TTBigint : ('r, string) entry
 | TTBinder : bool -> ('self, kinded_cases_pattern_expr) entry
 | TTConstr : notation_entry * prod_info * 'r target -> ('r, 'r) entry
-| TTConstrList : notation_entry * prod_info * (bool * string) list * 'r target -> ('r, 'r list) entry
+| TTConstrList : notation_entry * prod_info * ty_pattern list * 'r target -> ('r, 'r list) entry
 | TTPattern : int -> ('self, cases_pattern_expr) entry
 | TTOpenBinderList : ('self, local_binder_expr list) entry
-| TTClosedBinderListPure : (bool * string) list -> ('self, local_binder_expr list list) entry
-| TTClosedBinderListOther : ('self, 'a) entry * (bool * string) list -> ('self, 'a list) entry
+| TTClosedBinderListPure : ty_pattern list -> ('self, local_binder_expr list list) entry
+| TTClosedBinderListOther : ('self, 'a) entry * ty_pattern list -> ('self, 'a list) entry
 
 type _ any_entry = TTAny : ('s, 'r) entry -> 's any_entry
 
@@ -310,21 +310,20 @@ let find_custom_entry s =
   with Not_found ->
     anomaly Pp.(str "Undeclared custom entry: " ++ CustomName.print s ++ str ".")
 
-(** This computes the name of the level where to add a new rule *)
-let interp_constr_entry_key : type r. _ -> r target -> r Entry.t * int option =
-  fun {notation_entry = custom; notation_level = level} forpat ->
+(** This computes the name of the entry where to add a new rule *)
+let interp_constr_entry_key : type r. _ -> r target -> r Entry.t =
+  fun custom forpat ->
   match custom with
   | InCustomEntry s ->
-     (let (entry_for_constr, entry_for_patttern) = find_custom_entry s in
-     match forpat with
-     | ForConstr -> entry_for_constr, Some level
-     | ForPattern -> entry_for_patttern, Some level)
+    let (entry_for_constr, entry_for_pattern) = find_custom_entry s in
+    begin match forpat with
+    | ForConstr -> entry_for_constr
+    | ForPattern -> entry_for_pattern
+    end
   | InConstrEntry ->
-  match forpat with
-  | ForConstr ->
-    if level = 200 then Constr.binder_constr, None
-    else Constr.term, Some level
-  | ForPattern -> Constr.pattern, Some level
+    match forpat with
+    | ForConstr -> Constr.term
+    | ForPattern -> Constr.pattern
 
 let target_entry : type s. notation_entry -> s target -> s Entry.t = function
 | InConstrEntry ->
@@ -349,65 +348,48 @@ let is_binder_level custom {notation_entry = custom'; notation_level = fromlev}
     custom = InConstrEntry && custom' = InConstrEntry && fromlev = 200
   | _ -> false
 
-let make_pattern (keyword,s) =
-   if keyword then TPattern (Tok.PKEYWORD s) else
-     match NumTok.Unsigned.parse_string s with
-     | Some n -> TPattern (Tok.PNUMBER (Some n))
-     | None ->
-     match String.unquote_coq_string s with
-     | Some s -> TPattern (Tok.PSTRING (Some s))
-     | None -> TPattern (Tok.PIDENT (Some s))
-
-let make_sep_rules tkl =
-  Procq.Symbol.tokens (List.map make_pattern tkl)
-
 type ('s, 'a) mayrec_symbol =
-| MayRecNo : ('s, Gramlib.Grammar.norec, 'a) Symbol.t -> ('s, 'a) mayrec_symbol
-| MayRecMay : ('s, Gramlib.Grammar.mayrec, 'a) Symbol.t -> ('s, 'a) mayrec_symbol
+| MayRec : ('s, _, 'a) Symbol.t -> ('s, 'a) mayrec_symbol
 
 let symbol_of_target : type s. _ -> _ -> _ -> _ -> s target -> (s, s) mayrec_symbol = fun custom p assoc from forpat ->
   if is_binder_level custom from p
   then
     (* Prevent self *)
-    MayRecNo (Procq.Symbol.nterml (target_entry custom forpat) "200")
-  else if is_self custom from p then MayRecMay Procq.Symbol.self
+    MayRec (Procq.Symbol.nterml (target_entry custom forpat) "200")
+  else if is_self custom from p then MayRec Procq.Symbol.self
   else
     let g = target_entry custom forpat in
     let lev = adjust_level custom assoc from p in
     begin match lev with
-    | DefaultLevel -> MayRecNo (Procq.Symbol.nterm g)
-    | NextLevel -> MayRecMay Procq.Symbol.next
-    | NumLevel lev -> MayRecNo (Procq.Symbol.nterml g (string_of_int lev))
+    | DefaultLevel -> MayRec (Procq.Symbol.nterm g)
+    | NextLevel -> MayRec Procq.Symbol.next
+    | NumLevel lev -> MayRec (Procq.Symbol.nterml g (string_of_int lev))
     end
 
 let rec symbol_of_entry : type s r. _ -> _ -> (s, r) entry -> (s, r) mayrec_symbol = fun assoc from typ -> match typ with
 | TTConstr (s, p, forpat) -> symbol_of_target s p assoc from forpat
 | TTConstrList (s, typ', [], forpat) ->
-  begin match symbol_of_target s typ' assoc from forpat with
-  | MayRecNo s -> MayRecNo (Procq.Symbol.list1 s)
-  | MayRecMay s -> MayRecMay (Procq.Symbol.list1 s) end
+  let MayRec s = symbol_of_target s typ' assoc from forpat in
+  MayRec (Procq.Symbol.list1 s)
 | TTConstrList (s, typ', tkl, forpat) ->
-  begin match symbol_of_target s typ' assoc from forpat with
-  | MayRecNo s -> MayRecNo (Procq.Symbol.list1sep s (make_sep_rules tkl))
-  | MayRecMay s -> MayRecMay (Procq.Symbol.list1sep s (make_sep_rules tkl)) end
-| TTPattern p -> MayRecNo (Procq.Symbol.nterml Constr.pattern (string_of_int p))
-| TTOpenBinderList -> MayRecNo (Procq.Symbol.nterm Constr.open_binders)
-| TTClosedBinderListPure [] -> MayRecNo (Procq.Symbol.list1 (Procq.Symbol.nterm Constr.binder))
-| TTClosedBinderListPure tkl -> MayRecNo (Procq.Symbol.list1sep (Procq.Symbol.nterm Constr.binder) (make_sep_rules tkl))
+  let MayRec s = symbol_of_target s typ' assoc from forpat in
+  MayRec (Procq.Symbol.list1sep s (Procq.Symbol.tokens tkl))
+| TTPattern p -> MayRec (Procq.Symbol.nterml Constr.pattern (string_of_int p))
+| TTOpenBinderList -> MayRec (Procq.Symbol.nterm Constr.open_binders)
+| TTClosedBinderListPure [] -> MayRec (Procq.Symbol.list1 (Procq.Symbol.nterm Constr.binder))
+| TTClosedBinderListPure tkl -> MayRec (Procq.Symbol.list1sep (Procq.Symbol.nterm Constr.binder) (Procq.Symbol.tokens tkl))
 | TTClosedBinderListOther (typ,[]) ->
-  begin match symbol_of_entry assoc from typ with
-  | MayRecNo s -> MayRecNo (Procq.Symbol.list1 s)
-  | MayRecMay s -> MayRecMay (Procq.Symbol.list1 s) end
+  let MayRec s = symbol_of_entry assoc from typ in
+  MayRec (Procq.Symbol.list1 s)
 | TTClosedBinderListOther (typ,tkl) ->
-  begin match symbol_of_entry assoc from typ with
-  | MayRecNo s -> MayRecNo (Procq.Symbol.list1sep s (make_sep_rules tkl))
-  | MayRecMay s -> MayRecMay (Procq.Symbol.list1sep s (make_sep_rules tkl)) end
-| TTIdent -> MayRecNo (Procq.Symbol.nterm Prim.identref)
-| TTName -> MayRecNo (Procq.Symbol.nterm Prim.name)
-| TTBinder true -> MayRecNo (Procq.Symbol.nterm Constr.one_open_binder)
-| TTBinder false -> MayRecNo (Procq.Symbol.nterm Constr.one_closed_binder)
-| TTBigint -> MayRecNo (Procq.Symbol.nterm Prim.bignat)
-| TTGlobal -> MayRecNo (Procq.Symbol.nterm Constr.global)
+  let MayRec s = symbol_of_entry assoc from typ in
+  MayRec (Procq.Symbol.list1sep s (Procq.Symbol.tokens tkl))
+| TTIdent -> MayRec (Procq.Symbol.nterm Prim.identref)
+| TTName -> MayRec (Procq.Symbol.nterm Prim.name)
+| TTBinder true -> MayRec (Procq.Symbol.nterm Constr.one_open_binder)
+| TTBinder false -> MayRec (Procq.Symbol.nterm Constr.one_closed_binder)
+| TTBigint -> MayRec (Procq.Symbol.nterm Prim.bignat)
+| TTGlobal -> MayRec (Procq.Symbol.nterm Constr.global)
 
 let rec interp_entry forpat e = match e with
 | ETProdIdent -> TTAny TTIdent
@@ -466,7 +448,7 @@ match e with
 
 type (_, _) ty_symbol =
 | TyTerm : 'a Tok.p -> ('s, 'a) ty_symbol
-| TyNonTerm : 's target * ('s, 'a) entry * ('s, 'a) mayrec_symbol * bool -> ('s, 'a) ty_symbol
+| TyNonTerm : 's target * ('s, 'a) entry * ('s, 'a) mayrec_symbol -> ('s, 'a) ty_symbol
 
 type ('self, _, 'r) ty_rule =
 | TyStop : ('self, 'r, 'r) ty_rule
@@ -480,9 +462,7 @@ let rec ty_eval : type s a. (s, a, Loc.t -> s) ty_rule -> s gen_eval -> s env ->
   fun f env loc -> f loc env
 | TyNext (rem, TyTerm _) ->
   fun f env _ -> ty_eval rem f env
-| TyNext (rem, TyNonTerm (_, _, _, false)) ->
-  fun f env _ -> ty_eval rem f env
-| TyNext (rem, TyNonTerm (forpat, e, _, true)) ->
+| TyNext (rem, TyNonTerm (forpat, e, _)) ->
   fun f env v ->
     ty_eval rem f (push_item forpat e env v)
 | TyMark (n, b, p, rem) ->
@@ -504,22 +484,17 @@ let rec ty_eval : type s a. (s, a, Loc.t -> s) ty_rule -> s gen_eval -> s env ->
     ty_eval rem f { env with constrs; constrlists; }
 
 type ('s, 'a, 'r) mayrec_rule =
-| MayRecRNo : ('s, Gramlib.Grammar.norec, 'a, 'r) Rule.t -> ('s, 'a, 'r) mayrec_rule
-| MayRecRMay : ('s, Gramlib.Grammar.mayrec, 'a, 'r) Rule.t -> ('s, 'a, 'r) mayrec_rule
+| MayRecR : ('s, _, 'a, 'r) Rule.t -> ('s, 'a, 'r) mayrec_rule
 
 let rec ty_erase : type s a r. (s, a, r) ty_rule -> (s, a, r) mayrec_rule = function
-| TyStop -> MayRecRNo Rule.stop
+| TyStop -> MayRecR Rule.stop
 | TyMark (_, _, _, r) -> ty_erase r
 | TyNext (rem, TyTerm tok) ->
-   begin match ty_erase rem with
-   | MayRecRNo rem -> MayRecRMay (Rule.next rem (Symbol.token tok))
-   | MayRecRMay rem -> MayRecRMay (Rule.next rem (Symbol.token tok)) end
-| TyNext (rem, TyNonTerm (_, _, s, _)) ->
-   begin match ty_erase rem, s with
-   | MayRecRNo rem, MayRecNo s -> MayRecRMay (Rule.next rem s)
-   | MayRecRNo rem, MayRecMay s -> MayRecRMay (Rule.next rem s)
-   | MayRecRMay rem, MayRecNo s -> MayRecRMay (Rule.next rem s)
-   | MayRecRMay rem, MayRecMay s -> MayRecRMay (Rule.next rem s) end
+   let MayRecR rem = ty_erase rem in
+   MayRecR (Rule.next rem (Symbol.token tok))
+| TyNext (rem, TyNonTerm (_, _, MayRec s)) ->
+   let MayRecR rem = ty_erase rem in
+   MayRecR (Rule.next rem s)
 
 type ('self, 'r) any_ty_rule =
 | AnyTyRule : ('self, 'act, Loc.t -> 'r) ty_rule -> ('self, 'r) any_ty_rule
@@ -527,16 +502,14 @@ type ('self, 'r) any_ty_rule =
 let make_ty_rule assoc from forpat prods =
   let rec make_ty_rule = function
   | [] -> AnyTyRule TyStop
-  | GramConstrTerminal (kw,s) :: rem ->
+  | GramConstrTerminal (TPattern tk) :: rem ->
     let AnyTyRule r = make_ty_rule rem in
-    let TPattern tk = make_pattern (kw,s) in
     AnyTyRule (TyNext (r, TyTerm tk))
-  | GramConstrNonTerminal (e, var) :: rem ->
+  | GramConstrNonTerminal e :: rem ->
     let AnyTyRule r = make_ty_rule rem in
     let TTAny e = interp_entry forpat e in
     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)))
+    AnyTyRule (TyNext (r, TyNonTerm (forpat, e, s)))
   | GramConstrListMark (n, b, p) :: rem ->
     let AnyTyRule r = make_ty_rule rem in
     AnyTyRule (TyMark (n, b, p, r))
@@ -559,22 +532,22 @@ let prepare_empty_levels forpat (where,(pos,p4assoc,name)) =
 let different_levels (custom,opt_level) (custom',string_level) =
   match opt_level with
   | None -> true
-  | Some level -> not (notation_entry_eq custom custom') || level <> int_of_string string_level
+  | Some level -> not (notation_entry_eq custom custom' && Int.equal level string_level)
 
 let rec pure_sublevels' assoc from forpat level = function
 | [] -> []
-| GramConstrNonTerminal (e,_) :: rem ->
+| GramConstrNonTerminal e :: rem ->
    let rem = pure_sublevels' assoc from forpat level rem in
    let push where p rem =
-     match symbol_of_target where p assoc from forpat with
-     | MayRecNo sym ->
-       (match Procq.level_of_nonterm sym with
-        | None -> rem
-        | Some i ->
-          if different_levels (from.notation_entry,level) (where,i) then
-            (where,int_of_string i) :: rem
-          else rem)
-     | _ -> rem in
+     let MayRec sym = symbol_of_target where p assoc from forpat in
+     match Procq.level_of_nonterm sym with
+     | None -> rem
+     | Some i ->
+       let i = int_of_string i in
+       if different_levels (from.notation_entry,level) (where,i) then
+         (where,i) :: rem
+       else rem
+   in
    (match e with
    | ETProdPattern i -> push InConstrEntry (NumLevel i,InternalProd) rem
    | ETProdConstr (s,p) -> push s p rem
@@ -589,23 +562,30 @@ let make_act : type r. r target -> _ -> r gen_eval = function
   let env = (env.constrs, env.constrlists, env.binders) in
   CAst.make ~loc @@ CPatNotation (None, notation, env, [])
 
-let extend_constr state forpat ng =
+let extend_constr (type r) state (forpat:r target) ng =
   let {notation_entry = custom; notation_level = _} as fromlev,_ = ng.notgram_level in
   let assoc = ng.notgram_assoc in
-  let (entry, level) = interp_constr_entry_key fromlev forpat in
+  let entry = interp_constr_entry_key fromlev.notation_entry forpat in
+  let level = fromlev.notation_level in
+  let hack = match forpat with
+    | ForConstr -> ng.notgram_needs_hack
+    | ForPattern -> false
+  in
+  let level = if hack then 10 else level in
+  let assoc = if hack then None else assoc in
   let fold (accu, state) pt =
     let AnyTyRule r = make_ty_rule assoc fromlev forpat pt in
-    let pure_sublevels = pure_sublevels' assoc fromlev forpat level pt in
+    let pure_sublevels = pure_sublevels' assoc fromlev forpat (Some level) pt in
     let isforpat = target_to_bool forpat in
     let needed_levels, state = register_empty_levels state isforpat pure_sublevels in
-    let (pos,p4assoc,name), state = find_position state custom isforpat assoc level in
+    let (pos,p4assoc,name), state = find_position state custom isforpat assoc (Some level) in
     let empty_rules = List.map (prepare_empty_levels forpat) needed_levels in
     let empty = { constrs = []; constrlists = []; binders = []; binderlists = [] } in
     let act = ty_eval r (make_act forpat ng.notgram_notation) empty in
     let rule =
-      let r = match ty_erase r with
-        | MayRecRNo symbs -> Procq.Production.make symbs act
-        | MayRecRMay symbs -> Procq.Production.make symbs act
+      let r =
+        let MayRecR symbs = ty_erase r in
+        Procq.Production.make symbs act
       in
       let rule = name, p4assoc, [r] in
       match pos with
diff --git a/vernac/g_proofs.mlg b/vernac/g_proofs.mlg
index 37629b860b34..360697ac9636 100644
--- a/vernac/g_proofs.mlg
+++ b/vernac/g_proofs.mlg
@@ -139,6 +139,7 @@ GRAMMAR EXTEND Gram
     ;
   mode:
     [ [ l = LIST1 [ "+" -> { ModeInput }
+                  | "=" -> { ModeFrozen }
                   | "!" -> { ModeNoHeadEvar }
                   | "-" -> { ModeOutput } ] -> { l } ] ]
   ;
diff --git a/vernac/g_vernac.mlg b/vernac/g_vernac.mlg
index f8c59c08a039..8aca1f2d9134 100644
--- a/vernac/g_vernac.mlg
+++ b/vernac/g_vernac.mlg
@@ -101,6 +101,8 @@ GRAMMAR EXTEND Gram
       | IDENT "Profile"; f = OPT STRING -> { CAst.make ~loc (ControlProfile f) }
       | IDENT "Redirect"; s = ne_string -> { CAst.make ~loc (ControlRedirect s) }
       | IDENT "Timeout"; n = natural -> { CAst.make ~loc (ControlTimeout n) }
+      | IDENT "AllocLimit"; n = natural; mult = [ IDENT "Mw" -> { 1000L } | IDENT "kw" -> { 1L } ] ->
+        { CAst.make ~loc (ControlAllocLimit { kilowords = Int64.(mul (of_int n) mult) }) }
       | IDENT "Fail" -> { CAst.make ~loc ControlFail }
       | IDENT "Succeed" -> { CAst.make ~loc ControlSucceed }
     ] ]
@@ -296,7 +298,7 @@ GRAMMAR EXTEND Gram
       | IDENT "Register"; g = global; "as"; quid = qualid ->
           { VernacRegister(g, RegisterCoqlib quid) }
       | IDENT "Register"; IDENT "Scheme"; g = global; "as"; qid = qualid; IDENT "for"; g' = global ->
-        { VernacRegister(g, RegisterScheme {inductive = g'; scheme_kind = qid}) }
+        { VernacRegister(g, RegisterScheme {ref = g'; scheme_kind = qid}) }
       | IDENT "Register"; IDENT "Inline"; g = global ->
           { VernacRegister(g, RegisterInline) }
       | IDENT "Primitive"; id = ident_decl; typopt = OPT [ ":"; typ = lconstr -> { typ } ]; ":="; r = register_token ->
@@ -639,9 +641,17 @@ GRAMMAR EXTEND Gram
         { (oc,(idl,c)) } ] ]
   ;
 
+  constructor_binders:
+    [ [ l1 = binders; l2 = OPT [ "of"; l = LIST1 term LEVEL "99" SEP "&" -> { l } ] ->
+        { let anon c =
+            let n = CAst.make ?loc:c.CAst.loc Anonymous in
+            CLocalAssum ([n], None, Default Explicit, c) in
+          l1 @ List.map anon (Option.default [] l2) } ] ]
+  ;
+
   constructor_type:
-    [[ l = binders;
-      t= [ coe = of_type_inst; c = lconstr ->
+    [[ l = constructor_binders;
+       t = [ coe = of_type_inst; c = lconstr ->
                     { fun l attr id -> ((attr, fst coe, snd coe),(id,mkProdCN ~loc l c)) }
             |  ->
                  { fun l attr id -> ((attr,NoCoercion,NoInstance),(id,mkProdCN ~loc l (CAst.make ~loc @@ CHole (None)))) } ]
@@ -1102,7 +1112,8 @@ GRAMMAR EXTEND Gram
 
       (* Printing (careful factorization of entries) *)
       | IDENT "Print"; p = printable -> { VernacSynPure (VernacPrint p) }
-      | IDENT "Print"; qid = smart_global; l = OPT univ_name_list -> { VernacSynPure (VernacPrint (PrintName (qid,l))) }
+      | IDENT "Print"; items = LIST1 [ qid = smart_global; l = OPT univ_name_list -> { (qid,l) } ] SEP "," ->
+          { VernacSynPure (VernacPrint (PrintName (items))) }
       | IDENT "Print"; IDENT "Module"; "Type"; qid = global ->
           { VernacSynPure (VernacPrint (PrintModuleType qid)) }
       | IDENT "Print"; IDENT "Module"; qid = global ->
@@ -1147,8 +1158,9 @@ GRAMMAR EXTEND Gram
       | IDENT "Check"; c = lconstr; "." ->
          { fun g -> VernacCheckMayEval (None, g, c) }
       (* Searching the environment *)
-      | IDENT "About"; qid = smart_global; l = OPT univ_name_list; "." ->
-         { fun g -> VernacPrint (PrintAbout (qid,l,g)) }
+      | IDENT "About";
+        items = LIST1 [ qid = smart_global; l = OPT univ_name_list -> { (qid,l) } ] SEP ","; "." ->
+         { fun g -> VernacPrint (PrintAbout (items, g)) }
       | 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; "." ->
@@ -1158,15 +1170,15 @@ GRAMMAR EXTEND Gram
       ] ]
   ;
   printable:
-    [ [ IDENT "Term"; qid = smart_global; l = OPT univ_name_list -> { PrintName (qid,l) }
+    [ [ IDENT "Term"; items = LIST1 [ qid = smart_global; l = OPT univ_name_list -> { (qid,l) } ] SEP "," -> { PrintName (items) }
       | IDENT "All" -> { PrintFullContext }
       | IDENT "Section"; s = global -> { PrintSectionContext s }
-      | IDENT "Grammar"; ents = LIST0 IDENT ->
+      | IDENT "Grammar"; tree = OPT [ IDENT "Tree" -> { () } ]; ent = LIST0 IDENT ->
           (* This should be in "syntax" section but is here for factorization*)
-          { PrintGrammar ents }
-      | IDENT "Custom"; IDENT "Grammar"; ent = qualid ->
+          { let flatten = Option.is_empty tree in PrintGrammar {flatten; ent} }
+      | IDENT "Custom"; IDENT "Grammar"; tree = OPT [ IDENT "Tree" -> { () } ]; ent = qualid ->
           (* Should also be in "syntax" section *)
-          { PrintCustomGrammar ent }
+          { let flatten = Option.is_empty tree in PrintCustomGrammar {flatten; ent} }
       | IDENT "Keywords" ->
           { PrintKeywords }
       | IDENT "LoadPath"; dir = OPT dirpath -> { PrintLoadPath dir }
@@ -1180,6 +1192,7 @@ GRAMMAR EXTEND Gram
       | IDENT "ML"; IDENT "Path" -> { PrintMLLoadPath }
       | IDENT "ML"; IDENT "Modules" -> { PrintMLModules }
       | IDENT "Debug"; IDENT "GC" -> { PrintDebugGC }
+      | IDENT "Debug"; IDENT "Delta"; qid = OPT qualid -> { PrintDebugDelta qid }
       | IDENT "Graph" -> { PrintGraph }
       | IDENT "Classes" -> {  PrintClasses }
       | IDENT "Typeclasses" -> { PrintTypeclasses }
@@ -1319,7 +1332,7 @@ GRAMMAR EXTEND Gram
       ] ]
   ;
   univ_name_list:
-    [ [  "@{" ; l = LIST0 name; "}" -> { [],l } ] ]
+    [ [  "@{" ; l = LIST0 name; l' = OPT [ ";" ; l = LIST0 name -> { l } ] ; "}" -> { match l' with None -> [], l | Some l' -> l, l' } ] ]
   ;
 END
 
diff --git a/vernac/himsg.ml b/vernac/himsg.ml
index 6878e4afbc6d..6e132ff6a603 100644
--- a/vernac/himsg.ml
+++ b/vernac/himsg.ml
@@ -230,9 +230,11 @@ 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 sigma id c =
-  pr_global c ++ strbrk " depends on the variable " ++ Id.print id ++
-  strbrk " which is not declared in the context."
+let explain_reference_variables env sigma id c =
+  pr_global c ++ strbrk " depends on the section variable " ++ Id.print id ++
+  if Environ.mem_named id env then
+    strbrk " but " ++ Id.print id ++ strbrk " in the current context does not refer to the section variable of the same name."
+  else strbrk " which is not declared in the current context."
 
 let explain_elim_arity env sigma ind c okinds =
   let open EConstr in
@@ -296,11 +298,12 @@ let explain_elim_arity env sigma ind c okinds =
           (str "Elimination of a sort polymorphic inductive object instantiated to sort Type" ++ spc() ++
            (* NB: this restriction is only for forward compat with possible future sort qualities *)
            str "is not allowed on a predicate in a variable sort quality.")
-      | SquashToQuality (QVar squashq) ->
+      | SquashToQuality (QVar _ | QGlobal _ as squashq) ->
         let ppt = ppt ~ppunivs:true () in
         hov 0
           (str "the return type has sort" ++ spc () ++ ppt ++ spc () ++
-           str "while it should be in a sort " ++ pr_evd_qvar sigma squashq ++ str " eliminates to.") ++
+           str "while it should be in a sort " ++
+           Sorts.Quality.pr (Evd.quality_printer sigma) squashq ++ str " eliminates to.") ++
         fnl () ++
         hov 0
           (str "Elimination of a sort polymorphic inductive object instantiated to a variable sort quality" ++ spc() ++
@@ -428,8 +431,7 @@ let explain_unification_error env sigma p1 p2 = function
      | UnifUnivInconsistency p ->
        [str "universe inconsistency: " ++
         UGraph.explain_universe_inconsistency
-          (Termops.pr_evd_qvar sigma)
-          (Termops.pr_evd_level sigma)
+          (Evd.sort_printer sigma)
           p]
      | CannotSolveConstraint ((pb,env,t,u),e) ->
         let env = make_all_name_different env sigma in
@@ -893,7 +895,7 @@ let explain_unsatisfied_poly_constraints env sigma (elim_csts,univ_csts) =
                  else spc() ++ Univ.UnivConstraints.pr (Termops.pr_evd_level sigma) univ_csts in
   let elim_str = if Sorts.ElimConstraints.is_empty elim_csts
                  then mt()
-                 else spc() ++ Sorts.ElimConstraints.pr (Termops.pr_evd_qvar sigma) elim_csts in
+                 else spc() ++ Sorts.ElimConstraints.pr (Evd.quality_printer sigma) elim_csts in
   strbrk "Unsatisfied constraints:" ++ univ_str ++ elim_str ++
     spc () ++ str "(maybe a bugged tactic)."
 
@@ -910,9 +912,9 @@ let explain_undeclared_universes env sigma l =
   spc () ++ str "(maybe a bugged tactic)."
 
 let explain_undeclared_qualities env sigma l =
-  let n = Sorts.QVar.Set.cardinal l in
+  let n = Sorts.Quality.Set.cardinal l in
   strbrk "Undeclared " ++ str (if n = 1 then "quality" else "qualities") ++ strbrk": " ++
-    prlist_with_sep spc (Termops.pr_evd_qvar sigma) (Sorts.QVar.Set.elements l) ++
+    prlist_with_sep spc (Termops.pr_evd_quality sigma) (Sorts.Quality.Set.elements l) ++
     spc () ++ str "(maybe a bugged tactic)."
 
 let explain_not_allowed_sprop () =
@@ -923,7 +925,7 @@ let explain_not_allowed_sprop () =
 let explain_not_allowed_dependent_eliminitation env isrec i =
   let open Pp in
   str "Dependent " ++ str (if isrec then "induction" else "case analysis") ++
-  strbrk " is not allowed for " ++ Termops.pr_global_env env (IndRef i) ++ str "." ++
+  strbrk " is not allowed for " ++ Termops.pr_global_env env (IndRef i) ++ str "." ++ spc() ++
   str "Primitive records must have eta conversion to allow dependent elimination."
 
 let pr_relevance sigma r =
@@ -1008,7 +1010,7 @@ let explain_type_error env sigma err =
   | BadAssumption c ->
       explain_bad_assumption env sigma c
   | ReferenceVariables (id,c) ->
-      explain_reference_variables sigma id c
+      explain_reference_variables env sigma id c
   | ElimArity (ind, c, okinds) ->
       explain_elim_arity env sigma ind (Some c) okinds
   | CaseNotInductive cj ->
@@ -1288,15 +1290,14 @@ let explain_not_match_error = function
     let t1, t2 = pr_explicit env sigma (EConstr.of_constr t1) (EConstr.of_constr t2) in
     str"the universe constraints are inconsistent:" ++ spc () ++
     UGraph.explain_universe_inconsistency
-      Sorts.QVar.raw_pr
-      UnivNames.pr_level_with_global_universes
+      (UnivNames.sort_printer UnivNames.empty_binders)
       err ++ spc () ++
     str "when comparing" ++ spc () ++ t1 ++ spc () ++
     str "and" ++ spc () ++ t2
   | IncompatibleQualities { err; env; t1; t2 } ->
     let sigma = Evd.from_env env in
     let t1, t2 = pr_explicit env sigma (EConstr.of_constr t1) (EConstr.of_constr t2) in
-    QGraph.explain_elimination_error Sorts.QVar.raw_pr err ++ spc () ++
+    QGraph.explain_elimination_error (UnivNames.quality_printer UnivNames.empty_binders) err ++ spc () ++
     str "when comparing" ++ spc () ++ t1 ++ spc () ++
     str "and" ++ spc () ++ t2
   | IncompatiblePolymorphism (env, t1, t2) ->
@@ -1305,14 +1306,11 @@ let explain_not_match_error = function
       quote t1 ++ spc () ++
       str "compared to " ++ spc () ++
       quote t2
-  | IncompatibleUnivConstraints { got; expect } ->
+  | IncompatibleUnivConstraints { env; got; expect } ->
     let open UVars in
     let pr_auctx auctx =
-      let sigma = Evd.from_ctx
-          (UState.of_names
-             (Printer.universe_binders_with_opt_names auctx None))
-      in
-      let uctx = AbstractContext.repr auctx in
+      let uctx = UVars.AbstractContext.repr auctx in
+      let sigma = Evd.from_auctx env (Printer.fill_names auctx) in
       Printer.pr_universe_instance_binder sigma
         (UContext.instance uctx)
         (UContext.univ_constraints uctx)
@@ -1754,7 +1752,7 @@ let explain_exn_default = function
   | Stack_overflow -> hov 0 (str "Stack overflow.")
   | Sys.Break -> hov 0 (str "User interrupt.")
   (* Otherwise, not handled here *)
-  | _ -> raise Unhandled
+  | _ -> raise_notrace Unhandled
 
 let _ = CErrors.register_handler (wrap_unhandled explain_exn_default)
 
@@ -1762,12 +1760,12 @@ let rec vernac_interp_error_handler = function
   | UGraph.UniverseInconsistency i ->
     str "Universe inconsistency." ++ spc() ++
     UGraph.explain_universe_inconsistency
-      UnivNames.pr_quality_with_global_universes
-      UnivNames.pr_level_with_global_universes
-                  i ++ str "."
+      (UnivNames.sort_printer UnivNames.empty_binders)
+      i ++ str "."
   | QGraph.EliminationError i ->
      QGraph.explain_elimination_error
-       UnivNames.pr_quality_with_global_universes i
+       (UnivNames.quality_printer UnivNames.empty_binders)
+       i
   | TypeError(env,te) ->
     let te = of_type_error te in
     explain_type_error env (Evd.from_env env) te
@@ -1823,7 +1821,7 @@ let rec vernac_interp_error_handler = function
   | Environ.RewriteRulesNotAllowed symb_or_rule ->
     error_not_allowed_rewrite_rules symb_or_rule
   | _ ->
-    raise Unhandled
+    raise_notrace Unhandled
 
 let _ = CErrors.register_handler (wrap_unhandled vernac_interp_error_handler)
 
diff --git a/vernac/indschemes.ml b/vernac/indschemes.ml
index 7390bfcf545c..b65d755cfe97 100644
--- a/vernac/indschemes.ml
+++ b/vernac/indschemes.ml
@@ -203,7 +203,7 @@ let declare_one_case_analysis_scheme ?loc ind =
   let kind = Elimschemes.pseudo_sort_quality_for_elim ind mip in
   let dep, suff =
     if Sorts.Quality.is_qprop kind then case_nodep, Some "case"
-    else if not (Inductiveops.has_dependent_elim specif) then
+    else if not (Inductiveops.always_dependent_elim specif) then
       case_nodep, None
     else case_dep, Some "case" in
   let id = match suff with
@@ -213,7 +213,7 @@ let declare_one_case_analysis_scheme ?loc ind =
       Some Names.(Id.of_string (Id.to_string mip.mind_typename ^ "_" ^ suff))
   in
   let kelim = Inductiveops.elim_sort (mib,mip) in
-  if Inductive.raw_eliminates_to kelim Sorts.Quality.qtype then
+  if Inductive.raw_eliminates_to (UnivGen.QualityOrSet.quality kelim) Sorts.Quality.qtype then
     define_individual_scheme ?loc dep id ind
 
 (* Induction/recursion schemes *)
@@ -222,7 +222,7 @@ let declare_one_induction_scheme ?loc ind =
   let (mib,mip) as specif = Global.lookup_inductive ind in
   let kind = Elimschemes.pseudo_sort_quality_for_elim ind mip in
   let from_prop = Sorts.Quality.is_qprop kind in
-  let depelim = Inductiveops.has_dependent_elim specif in
+  let depelim = Inductiveops.always_dependent_elim specif in
   let kelim mip = Inductiveops.constant_sorts_below
               @@ Inductiveops.elim_sort (mib,mip) in
   let kelim =
@@ -335,23 +335,24 @@ let sch_isrec = function
 (* Generate suffix for scheme given a target sort *)
 let scheme_suffix_gen {sch_type; sch_sort} sort =
   let open Quality in
-  (* The _ind/_rec_/case suffix *)
   let ind_suffix = match sch_isrec sch_type, sch_sort with
-    | true  , Qual (QConstant QSProp | QConstant QProp) -> "_ind"
-    | true  , _ -> "_rec"
-    | false , _ -> "_case" in
-  (* SProp and Type have an auxillary ending to the _ind suffix *)
-  let aux_suffix = match sch_sort with
-    | Qual (QConstant QSProp) -> "s"
-    | Qual (QConstant QType) -> "t"
-    | _ -> "" in
+    (* The elimination suffix _ind/_sind/_rec/_rect *)
+    | true  , Qual (QConstant QProp) -> "_ind"
+    | true  , Qual (QConstant QSProp) -> "_sind"
+    | true  , Qual (QConstant QType) -> "_rect"
+    | true  , Set -> "_rec"
+    (* The _case suffix *)
+    | false , Qual (QConstant QSProp) -> "_scase"
+    | false , Qual (QConstant QType) -> "_caset"
+    | false , _ -> "_case"
+    | _     , Qual (QVar _ | QGlobal _) -> assert false in
   (* Some schemes are deliminated with _dep or no_dep *)
   let dep_suffix = match sch_isdep sch_type , sort with
     | true  , QConstant QProp  -> "_dep"
     | false , QConstant QType
     | false , QConstant QSProp -> "_nodep"
     | _ , _                    -> "" in
-  ind_suffix ^ aux_suffix ^ dep_suffix
+  ind_suffix ^ dep_suffix
 
 let smart_ind qid =
   let ind = Smartlocate.smart_global_inductive qid in
@@ -414,7 +415,8 @@ let do_mutual_induction_scheme ~register ?(force_mutual=false) env ?(isrec=true)
       else match sort with
         | Qual (QConstant QType) -> Some (if dep then case_dep else case_nodep)
         | Qual (QConstant QProp) -> Some (if dep then casep_dep else casep_nodep)
-        | Set | Qual (QConstant QSProp | QVar _) ->
+        | Qual (QConstant QSProp) -> Some (if dep then scase_dep else scase_nodep)
+        | Set | Qual (QVar _ | QGlobal _) ->
           (* currently we don't have standard scheme kinds for this *)
           None
     in
@@ -422,7 +424,7 @@ let do_mutual_induction_scheme ~register ?(force_mutual=false) env ?(isrec=true)
     | None -> ()
     | Some kind ->
       (* TODO locality *)
-      DeclareScheme.declare_scheme SuperGlobal (Ind_tables.scheme_kind_name kind) (ind, cst)
+      DeclareScheme.declare_scheme SuperGlobal (Ind_tables.scheme_kind_name kind) (GlobRef.IndRef ind, cst)
   in
   let () = List.iter2 declare listdecl l in
   let lrecnames = List.map (fun ({CAst.v},_,_,_) -> v) l in
@@ -493,7 +495,7 @@ let build_combined_scheme env schemes =
   *)
   let inprop =
     let inprop (_,t) =
-      UnivGen.QualityOrSet.is_prop
+      Sorts.Quality.is_qprop
         (Retyping.get_sort_quality_of env sigma (EConstr.of_constr t))
     in
     List.for_all inprop defs
@@ -554,7 +556,7 @@ let do_scheme_all_predicate ?all_depth ~declare_mind kn mib strpos sAll keyAll =
   let kn_nested = declare_mind ?all_depth mentry univs in
   (* register it *)
   let () = Array.iteri (fun i _ -> DeclareScheme.declare_scheme
-              SuperGlobal keyAll ((kn,i), GlobRef.IndRef (kn_nested,i))
+              SuperGlobal keyAll (GlobRef.IndRef (kn,i), GlobRef.IndRef (kn_nested,i))
             ) mib.mind_packets in
   kn_nested
 
@@ -569,10 +571,10 @@ let do_scheme_all_theorem kn mib kn_nested focus strpos sAllThm keyAllThm =
   let uctx = UState.collapse_above_prop_sort_variables ~to_prop:true uctx in
   let uctx = UState.normalize_variables uctx in
   let uctx = UState.minimize uctx in
-  let sigma = Evd.set_universe_context sigma uctx in
+  let sigma = Evd.set_ustate sigma uctx in
   let thm = UState.nf_universes uctx (EConstr.to_constr sigma thm) in
   let uctx = UState.restrict uctx (Vars.universes_of_constr thm) in
-  let sigma = Evd.set_universe_context sigma uctx in
+  let sigma = Evd.set_ustate sigma uctx in
   (* declare it *)
   let poly_flag = PolyFlags.make ~univ_poly:true ~collapse_sort_variables:true ~cumulative:true in
   let info = Declare.Info.make ~poly:poly_flag () in
@@ -580,7 +582,7 @@ let do_scheme_all_theorem kn mib kn_nested focus strpos sAllThm keyAllThm =
   let cinfo = Declare.CInfo.make ~name:fth_name ~typ:(None : (Evd.econstr option)) () in
   let fth_ref = Declare.declare_definition ~info:info ~cinfo:cinfo ~opaque:false ~body:(EConstr.of_constr thm) sigma in
   (* register it *)
-  let () = DeclareScheme.declare_scheme SuperGlobal keyAllThm ((kn,focus), fth_ref) in
+  let () = DeclareScheme.declare_scheme SuperGlobal keyAllThm (GlobRef.IndRef (kn,focus), fth_ref) in
   ()
 
 let do_all_forall ?(user_call_scheme=false) ?all_depth ~declare_mind kn strpos =
@@ -617,8 +619,9 @@ let { Goptions.get = default_all_depth } =
   Goptions.declare_int_option_and_ref ~key:["Depth";"Scheme";"All"] ~value:0 ()
 
 let default_all_depth kn mib =
-  let mib = Global.lookup_mind kn in
-  if Inductiveops.mis_is_nested kn mib
+  let env = Global.env () in
+  let mib = Environ.lookup_mind kn env in
+  if Inductiveops.mis_is_nested env kn mib
   then default_all_depth () -1
   else default_all_depth ()
 
diff --git a/vernac/loadpath.ml b/vernac/loadpath.ml
index b2e608e34164..4b6ef278414c 100644
--- a/vernac/loadpath.ml
+++ b/vernac/loadpath.ml
@@ -31,7 +31,7 @@ let pp p =
   let installed = Pp.str (if p.path_installed then "i" else " ") in
   let dir = DP.print p.path_logical in
   let path = Pp.str (CUnix.escaped_string_of_physical_path p.path_physical) in
-  Pp.(hov 2 (installed ++ spc () ++ dir ++ spc () ++ path))
+  Pp.(h (installed ++ spc () ++ dir ++ spc () ++ path))
 
 let get_load_paths () = !load_paths
 
diff --git a/vernac/metasyntax.ml b/vernac/metasyntax.ml
index 26270701a65c..fc81b0761298 100644
--- a/vernac/metasyntax.ml
+++ b/vernac/metasyntax.ml
@@ -25,7 +25,6 @@ open Libobject
 open Constrintern
 open Libnames
 open Notation
-open Nameops
 open Globnames
 
 (** Intern custom entry names (with compat layer) *)
@@ -80,22 +79,22 @@ let intern_notation_entry = function
 
 let entry_buf = Buffer.create 64
 
-let pr_entry e =
+let pr_entry ~flatten e =
   let () = Buffer.clear entry_buf in
   let ft = Format.formatter_of_buffer entry_buf in
-  let () = Procq.Entry.print ft e in
+  let () = Procq.Entry.print ~flatten ft e in
   str (Buffer.contents entry_buf)
 
 let error_unknown_entry ?loc name =
   user_err ?loc Pp.(str "Unknown or unprintable grammar entry " ++ str name ++ str".")
 
-let pr_grammar_subset grammar =
+let pr_grammar_subset ~flatten grammar =
   let pp = String.Map.mapi (fun name l -> match l with
       | []  -> assert false
       | entries ->
         str "Entry " ++ str name ++ str " is" ++ fnl() ++
         prlist_with_sep (fun () -> str "or" ++ fnl())
-          (fun (Procq.Entry.Any e) -> pr_entry e)
+          (fun (Procq.Entry.Any e) -> pr_entry ~flatten e)
           entries)
       grammar
   in
@@ -103,10 +102,9 @@ let pr_grammar_subset grammar =
   prlist_with_sep fnl (fun (_,pp) -> pp) pp
 
 let is_known = let open Procq.Entry in function
-  | "constr" | "term" | "binder_constr" ->
+  | "constr" | "term" ->
     Some [ Any Procq.Constr.constr;
       Any Procq.Constr.lconstr;
-      Any Procq.Constr.binder_constr;
       Any Procq.Constr.term;
     ]
   | "vernac" ->
@@ -136,13 +134,13 @@ let full_grammar () =
 
 let same_entry (Procq.Entry.Any e) (Procq.Entry.Any e') = (Obj.magic e) == (Obj.magic e')
 
-let pr_grammar = function
+let pr_grammar ~flatten = function
   | [] ->
     let grammar = full_grammar () in
-    pr_grammar_subset grammar
+    pr_grammar_subset ~flatten grammar
   | ["Full"] ->
     let grammar = Procq.Entry.all_in () in
-    pr_grammar_subset grammar
+    pr_grammar_subset ~flatten grammar
   | names ->
     let known, other = List.fold_left (fun (known,other) name ->
         match is_known name with
@@ -168,7 +166,7 @@ let pr_grammar = function
           grammar)
         grammar known
     in
-    pr_grammar_subset grammar
+    pr_grammar_subset ~flatten grammar
 
 let custom_grammars = ref []
 
@@ -188,7 +186,7 @@ let get_custom_grammars name =
   | [] -> raise (UnknownCustomEntry name)
   | _ :: _ -> List.flatten entries
 
-let pr_custom_grammar name =
+let pr_custom_grammar ~flatten name =
   let entries = get_custom_grammars name in
   let add_entry map (Procq.Entry.Any e as any) =
     String.Map.update (Procq.Entry.name e)
@@ -196,7 +194,7 @@ let pr_custom_grammar name =
       map
   in
   let map = List.fold_left add_entry String.Map.empty entries in
-  pr_grammar_subset map
+  pr_grammar_subset ~flatten map
 
 let pr_keywords () =
   Pp.prlist_with_sep Pp.fnl Pp.str (CString.Set.elements (CLexer.keywords (Procq.get_keyword_state())))
@@ -738,15 +736,14 @@ let distribute a ll = List.map (fun l -> a @ l) ll
      t;sep;t;...;t;sep;t;...;t;sep;t;LIST1(t,sep) *)
 
 let expand_list_rule s typ tkl x n p ll =
-  let camlp5_message_name = Some (add_suffix x ("_"^string_of_int n)) in
-  let main = GramConstrNonTerminal (ETProdConstr (s,typ), camlp5_message_name) in
-  let tks = List.map (fun (kw,s) -> GramConstrTerminal (kw, s)) tkl in
+  let main = GramConstrNonTerminal (ETProdConstr (s,typ)) in
+  let tks = List.map (fun tk -> GramConstrTerminal tk) 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 (s, typ,tkl), Some x)] in
+      @	[GramConstrNonTerminal (ETProdConstrList (s, typ,tkl))] in
     distribute hds ll
   else
     distribute (GramConstrListMark (i+1,false,p) :: hds @ [main]) ll @
@@ -783,36 +780,42 @@ let prod_entry_type = function
   | ETConstr (s,_,p) -> ETProdConstr (s,p)
   | ETPattern (_,n) -> ETProdPattern (pattern_entry_level n)
 
-let keyword_needed need s =
+let terminal need_keyword s : Procq.ty_pattern =
   (* Ensure that IDENT articulation terminal symbols are keywords *)
   match CLexer.terminal s with
-  | Tok.PIDENT (Some k) ->
-    if need then
+  | Tok.PIDENT (Some k) as p ->
+    if need_keyword then begin
       Flags.if_verbose Feedback.msg_info (str "Identifier '" ++ str k ++ str "' now a keyword");
-    need
+      TPattern (PKEYWORD s)
+    end
+    else TPattern p
   | _ ->
   match NumTok.Unsigned.parse_string s with
   | Some n ->
-    if need then
+    if need_keyword then begin
       Flags.if_verbose Feedback.msg_info (str "Number '" ++ NumTok.Unsigned.print n ++ str "' now a keyword");
-    need
+      TPattern (PKEYWORD s)
+    end
+    else TPattern (PNUMBER (Some n))
   | None ->
   match String.unquote_coq_string s with
-  | Some _ ->
-    if need then
+  | Some s' ->
+    if need_keyword then begin
       Flags.if_verbose Feedback.msg_info (str "String '" ++ str s ++ str "' now a keyword");
-    need
-  | _ -> true
+      TPattern (PKEYWORD s)
+    end
+    else TPattern (PSTRING (Some s'))
+  | _ -> TPattern (PKEYWORD s)
 
 let make_production ({notation_level = lev}, _) etyps symbols =
   let rec aux need = function
     | [] -> [[]]
     | NonTerminal m :: l ->
         let typ = prod_entry_type (List.assoc m etyps) in
-        distribute [GramConstrNonTerminal (typ, Some m)] (aux (is_not_small_constr typ) l)
+        distribute [GramConstrNonTerminal typ] (aux (is_not_small_constr typ) l)
     | Terminal s :: l ->
-        let keyword = keyword_needed need s in
-        distribute [GramConstrTerminal (keyword,s)] (aux false l)
+        let terminal = terminal need s in
+        distribute [GramConstrTerminal terminal] (aux false l)
     | Break _ :: l ->
         aux need l
     | SProdList (x,sl) :: l ->
@@ -820,7 +823,7 @@ let make_production ({notation_level = lev}, _) etyps symbols =
           (List.map (function Terminal s -> [s]
             | Break _ -> []
             | _ -> anomaly (Pp.str "Found a non terminal token in recursive notation separator.")) sl) in
-        let tkl = List.map_i (fun i x -> let need = (i=0) in (keyword_needed need x, x)) 0 tkl in
+        let tkl = List.map_i (fun i x -> let need = (i=0) in (terminal need x)) 0 tkl in
         match List.assoc x etyps with
         | ETConstr (s,_,(lev,_ as typ)) ->
             let p,l' = include_possible_similar_trailing_pattern (s,lev) etyps sl l in
@@ -829,16 +832,16 @@ let make_production ({notation_level = lev}, _) etyps symbols =
             check_open_binder o sl x;
             let typ = if o then (assert (tkl = []); ETBinderOpen) else ETBinderClosed (None,tkl) in
             distribute
-              [GramConstrNonTerminal (ETProdBinderList typ, Some x)] (aux false l)
+              [GramConstrNonTerminal (ETProdBinderList typ)] (aux false l)
         | ETIdent ->
             distribute
-              [GramConstrNonTerminal (ETProdBinderList (ETBinderClosed (Some ETProdIdent,tkl)), Some x)] (aux false l)
+              [GramConstrNonTerminal (ETProdBinderList (ETBinderClosed (Some ETProdIdent,tkl)))] (aux false l)
         | ETName ->
             distribute
-              [GramConstrNonTerminal (ETProdBinderList (ETBinderClosed (Some ETProdName,tkl)), Some x)] (aux false l)
+              [GramConstrNonTerminal (ETProdBinderList (ETBinderClosed (Some ETProdName,tkl)))] (aux false l)
         | ETPattern (st,n) ->
             distribute
-              [GramConstrNonTerminal (ETProdBinderList (ETBinderClosed (Some (ETProdPattern (pattern_entry_level n)),tkl)), Some x)] (aux false l)
+              [GramConstrNonTerminal (ETProdBinderList (ETBinderClosed (Some (ETProdPattern (pattern_entry_level n)),tkl)))] (aux false l)
         | _ ->
            user_err Pp.(str "Components of recursive patterns in notation must be terms or binders.") in
   let need = (* a leading ident/number factorizes iff at level 0 *) lev <> 0 in
@@ -911,6 +914,7 @@ let warn_incompatible_format =
 
 type syntax_extension = {
   synext_level : level;
+  synext_hack_level : bool;
   synext_nottyps : constr_entry_key list;
   synext_notgram : notation_grammar option;
   synext_notprint : generic_notation_printing_rules option;
@@ -994,6 +998,12 @@ let check_prefix_incompatible_level ntn prec nottyps =
 
 let cache_one_syntax_extension (ntn,synext) =
   let prec = synext.synext_level in
+  let prec =
+    if synext.synext_hack_level then
+      (* binder_constr backwards compat hack *)
+      { notation_entry = InConstrEntry; notation_level = 10 }, snd prec
+    else prec
+  in
   (* Check and ensure that the level and the precomputed parsing rule is declared *)
   let oldparsing =
     try
@@ -1054,16 +1064,12 @@ type notation_modifier = {
   assoc         : Gramlib.Gramext.g_assoc option;
   level         : int option;
   etyps         : (Id.t * CustomName.t simple_constr_prod_entry_key) list;
-
-  (* common to syn_data below *)
-  format        : lstring option;
 }
 
 let default = {
   assoc         = None;
   level         = None;
   etyps         = [];
-  format        = None;
 }
 
 end
@@ -1502,6 +1508,7 @@ type syn_pa_data = {
     prec_for_grammar : level;
     typs_for_grammar : constr_entry_key list;
     need_squash : bool;
+    needs_hack : bool;
   }
 
 module SynData = struct
@@ -1604,12 +1611,21 @@ let compute_syntax_data ~local main_data notation_symbols ntn mods =
   if main_data.itemscopes <> [] then user_err (str "General notations don't support 'in scope'.");
   let {recvars;mainvars;symbols} = notation_symbols in
   let assoc = Option.append mods.assoc (Some Gramlib.Gramext.NonA) in
-  let _ = check_useless_entry_types recvars mainvars mods.etyps in
+  let () = check_useless_entry_types recvars mainvars mods.etyps in
 
   (* Notations for interp and grammar  *)
   let ntn_prefix = longest_common_prefix_level ntn in
   let level = default_prefix_level ntn_prefix mods.level in
   let msgs,n = find_precedence main_data.entry level mods.etyps symbols main_data.onlyprinting in
+  let ntn_prefix = if Int.equal n 200 then
+      ntn_prefix |> Option.map @@ fun (prefix,plevel,args) ->
+      (* binder_constr backwards compat hack: pretend that the prefix
+         was found at level 200 if this notation was declared at level 200
+         and the prefix was at level 10 (n = 200 only if mods.level = Some 200). *)
+      if Int.equal plevel 10 then prefix, 200, args
+      else prefix, plevel, args
+    else ntn_prefix
+  in
   let symbols_for_grammar =
     if main_data.entry = InConstrEntry then remove_curly_brackets symbols else symbols in
   let need_squash = not (List.equal Notation.symbol_eq symbols symbols_for_grammar) in
@@ -1628,11 +1644,18 @@ let compute_syntax_data ~local main_data notation_symbols ntn mods =
   check_locality_compatibility local main_data.entry sy_typs;
   let pa_sy_data = (sy_typs_for_grammar,symbols_for_grammar) in
   let pp_sy_data = (sy_typs,symbols) in
+  let needs_hack =
+    match main_data.entry, n, sy_typs_for_grammar with
+    | _, _, (_, ETConstr (InConstrEntry, _, (_, BorderProd (Left, _)))) :: _ -> false
+    | InConstrEntry, 200, _ -> true
+    | _ -> false
+  in
   let sy_fulldata = {
       ntn_for_grammar;
       prec_for_grammar = ({notation_entry = main_data.entry; notation_level = n}, prec_for_grammar);
       typs_for_grammar = List.map snd sy_typs_for_grammar;
-      need_squash
+      need_squash;
+      needs_hack;
     } in
 
   (* Return relevant data for interpretation and for parsing/printing *)
@@ -1758,6 +1781,7 @@ let recover_notation_syntax ntn =
     let pp_rule = try Some (find_generic_notation_printing_rule ntn) with Not_found -> None in
     {
       synext_level = prec;
+      synext_hack_level = false;
       synext_nottyps = pa_typs;
       synext_notgram = pa_rule;
       synext_notprint = pp_rule;
@@ -1775,11 +1799,12 @@ let recover_squash_syntax sy =
 (** Main entry point for building parsing and printing rules         **)
 
 let make_pa_rule (typs,symbols) parsing_data =
-  let { ntn_for_grammar; prec_for_grammar; typs_for_grammar; need_squash } = parsing_data in
+  let { ntn_for_grammar; prec_for_grammar; typs_for_grammar; need_squash; needs_hack } = parsing_data in
   let assoc = recompute_assoc typs in
   let prod = make_production prec_for_grammar typs symbols in
   let sy = {
     notgram_level = prec_for_grammar;
+    notgram_needs_hack = needs_hack;
     notgram_assoc = assoc;
     notgram_notation = ntn_for_grammar;
     notgram_prods = prod;
@@ -1848,6 +1873,7 @@ let make_syntax_rules reserved main_data ntn sd =
   let pp_rules = make_generic_printing_rules reserved main_data ntn sd in
   {
     synext_level    = sd.level;
+    synext_hack_level = sd.not_data.needs_hack;
     synext_nottyps = List.map snd sd.subentries;
     synext_notgram  = pa_rules;
     synext_notprint = pp_rules;
@@ -1928,6 +1954,19 @@ let make_notation_interpretation ~local main_data notation_symbols ntn syntax_ru
     notobj_specific_pp_rules = sy_pp_rules;
   }
 
+(* close #21670 once this hack is removed *)
+let warn_at_level_200 =
+  CWarnings.create ~name:"at-level-200-changed" ~category:Deprecation.Version.v9_3
+    Pp.(fun () ->
+        str "For backwards compatibility non left recursive notations declared at level 200" ++ spc() ++
+        str "are actually at level 10, with any right-recursion being at level 200." ++ spc() ++
+        str "In the future level 200 will be treated as a normal level." ++ spc() ++
+        str "To keep the current behaviour, use \"at level 10\"," ++ spc() ++
+        str "remove any \"right associativity\" annotation," ++ spc() ++
+        str "and if right recursive add \"x at level 200\" where \"x\" is the last argument.")
+
+let warn_at_level_200 synext = if synext.synext_hack_level then warn_at_level_200 ()
+
 (* Notations without interpretation (Reserved Notation) *)
 
 let add_reserved_notation ~local ~infix ({CAst.loc;v=df},mods) =
@@ -1939,6 +1978,7 @@ let add_reserved_notation ~local ~infix ({CAst.loc;v=df},mods) =
   if is_prim_token then user_err ?loc (str "Notations for numbers or strings are primitive and need not be reserved.");
   let sd = compute_syntax_data ~local main_data notation_symbols ntn mods in
   let synext = make_syntax_rules true main_data ntn sd in
+  let () = warn_at_level_200 synext in
   Lib.add_leaf (inSyntaxExtension(local,(ntn,synext)))
 
 type notation_interpretation_decl =
@@ -2010,7 +2050,9 @@ let add_notation_syntax ~local ~infix user_warns ntn_decl =
   (* Build or rebuild the syntax rules *)
   let main_data, notation_symbols, ntn, syntax_rules, c, df = build_notation_syntax ~local ~infix user_warns ntn_decl in
   (* Declare syntax *)
-  syntax_rules_iter (fun sy -> Lib.add_leaf (inSyntaxExtension (local,(ntn,sy)))) syntax_rules;
+  syntax_rules_iter (fun sy ->
+      warn_at_level_200 sy;
+      Lib.add_leaf (inSyntaxExtension (local,(ntn,sy)))) syntax_rules;
   let ntn_decl_string = CAst.make ?loc:ntn_decl.ntn_decl_string.CAst.loc df in
   let ntn_decl = { ntn_decl with ntn_decl_interp = c; ntn_decl_string } in
   ntn_decl, main_data, notation_symbols, ntn, syntax_rules
diff --git a/vernac/metasyntax.mli b/vernac/metasyntax.mli
index 56545f112892..82133b479b6f 100644
--- a/vernac/metasyntax.mli
+++ b/vernac/metasyntax.mli
@@ -68,8 +68,8 @@ val add_abbreviation : local:Libobject.locality -> Globnames.extended_global_ref
 
 (** Print the Camlp5 state of a grammar *)
 
-val pr_grammar : string list -> Pp.t
-val pr_custom_grammar : Libnames.qualid -> Pp.t
+val pr_grammar : flatten:bool -> string list -> Pp.t
+val pr_custom_grammar : flatten:bool -> Libnames.qualid -> Pp.t
 val pr_keywords : unit -> Pp.t
 
 (** Register a handler for Print Custom Grammar. The handler should
diff --git a/vernac/mltop.ml b/vernac/mltop.ml
index 9ab237a5bd89..02324ccbd5b9 100644
--- a/vernac/mltop.ml
+++ b/vernac/mltop.ml
@@ -81,9 +81,8 @@ module PluginSpec : sig
 
   type t
 
-  (* Main constructor, takes the format used in Declare ML Module.
-     With [usercode:true], warn instead of error on legacy syntax. *)
-  val of_package : ?usercode:bool -> string -> t
+  (* Main constructor, takes the format used in Declare ML Module. *)
+  val of_package : string -> t
 
   val to_package : t -> string
 
@@ -120,54 +119,7 @@ end = struct
   module Set = CSet.Make(Self)
   module Map = CMap.Make(Self)
 
-  module Errors = struct
-
-    let warn_legacy_loading =
-      CWarnings.create ~name:"legacy-loading-removed" ~category:Deprecation.Version.v9_0
-        Pp.(fun name ->
-            str "Legacy loading plugin method has been removed from Rocq, \
-                 and the `:` syntax is deprecated, and its first \
-                 argument ignored; please remove \"" ++
-            str name ++ str ":\" from your Declare ML")
-
-    let plugin_name_invalid_format m =
-      CErrors.user_err
-        Pp.(str Format.(asprintf "%s is not a valid plugin name." m) ++ spc () ++
-            str "It should be a public findlib name, e.g. package-name.foo." ++ spc () ++
-            str "Legacy names followed by a findlib public name, e.g. "++ spc () ++
-            str "legacy_plugin:package-name.plugin," ++ spc() ++
-            str "are not supported anymore.")
-
-    let warn_coq_core =
-      CWarnings.create ~name:"coq-core-plugin" ~category:Deprecation.Version.v9_0
-        Pp.(fun () -> str "\"coq-core\" has been renamed to \"rocq-runtime\".")
-
-  end
-
-  (* We would properly load the rocq-runtime cmxs because of the
-     virtual coq-core findlib package, but we would not initialize the plugin.
-     eg [Declare ML Module "coq-core.plugins.ltac". Ltac foo := idtac.] would fail
-     as the grammar for Ltac is not activated. *)
-  let compat_coq_core lib =
-    let old_prefix = "coq-core.plugins." in
-    if CString.is_prefix old_prefix lib
-    then begin
-      Errors.warn_coq_core ();
-      let old_len = String.length old_prefix in
-      "rocq-runtime.plugins." ^ (CString.sub lib old_len (String.length lib - old_len))
-    end
-    else lib
-
-  let of_package ?(usercode=false) m =
-    let lib = match String.split_on_char ':' m with
-      | [ lib ] -> lib
-      | [cmxs; lib] when usercode ->
-        Errors.warn_legacy_loading cmxs;
-        lib
-      | _ -> Errors.plugin_name_invalid_format m
-    in
-    let lib = if usercode then compat_coq_core lib else lib in
-    { lib }
+  let of_package lib = { lib }
 
   let to_package { lib } = lib
 
@@ -426,7 +378,8 @@ type ml_module_object =
   ; mnames : (bool * PluginSpec.t) list
   (* bool: if true then implicit dep
      XXX should we init_ml_object even for implicit deps? *)
-  ; mdigests : Digest.t list
+  ; _mdigests : Digest.t list
+  (* never read, it's only used to ensure the vo changes if deps change *)
   }
 
 let cache_ml_objects mnames =
@@ -463,12 +416,12 @@ let inMLModule : ml_module_object -> Libobject.obj =
       classify_function = classify_ml_objects }
 
 let declare_ml_modules local mnames =
-  let mnames = List.map (PluginSpec.of_package ~usercode:true) mnames in
+  let mnames = List.map PluginSpec.of_package mnames in
   if Lib.sections_are_opened()
   then CErrors.user_err Pp.(str "Cannot Declare ML Module while sections are opened.");
   let mnames = PluginSpec.add_deps mnames in
   let mdigests = CList.concat_map (fun (_,plugin) -> PluginSpec.digest plugin) mnames in
-  Lib.add_leaf (inMLModule {mlocal=local; mnames; mdigests});
+  Lib.add_leaf (inMLModule {mlocal=local; mnames; _mdigests = mdigests});
   (* We can't put this in cache_function: it may declare other
      objects, and when the current module is required we want to run
      the ML-MODULE object before them. *)
diff --git a/vernac/ppvernac.ml b/vernac/ppvernac.ml
index 37488709e4af..70d723e65527 100644
--- a/vernac/ppvernac.ml
+++ b/vernac/ppvernac.ml
@@ -192,9 +192,13 @@ let string_of_definition_object_kind = let open Decls in function
     | CanonicalStructure -> "Canonical Structure"
     | Instance -> "Instance"
     | Let -> "Let"
+    | Fixpoint -> "Fixpoint"
+    | CoFixpoint -> "CoFixpoint"
+    | Scheme -> "Scheme"
+    | StructureComponent -> "Field"
+    | Method -> "Method"
     | LetContext -> CErrors.anomaly (Pp.str "Bound to Context.")
-    | (StructureComponent|Scheme|CoFixpoint|Fixpoint|IdentityCoercion|Method) ->
-      CErrors.anomaly (Pp.str "Internal definition kind.")
+    | IdentityCoercion -> CErrors.anomaly (Pp.str "Internal definition kind.")
 
 let string_of_assumption_kind = let open Decls in function
     | Definitional -> "Parameter"
@@ -314,6 +318,7 @@ let pr_reference_or_constr pr_c = function
 
 let pr_hint_mode = let open Hints in function
   | ModeInput -> str"+"
+  | ModeFrozen -> str"="
   | ModeNoHeadEvar -> str"!"
   | ModeOutput -> str"-"
 
@@ -441,8 +446,10 @@ let pr_onescheme (idop, {sch_type; sch_qualid; sch_sort}) =
     | SchemeMinimality ->  keyword "Minimality for"
     | SchemeElimination ->  keyword "Elimination for"
     | SchemeCase -> keyword "Case for" in
-  hov 0 str_identifier ++ spc () ++ hov 0 (str_scheme ++ spc() ++ pr_smart_global sch_qualid)
-    ++ spc () ++ hov 0 (keyword "Sort" ++ spc() ++ UnivGen.QualityOrSet.pr Sorts.QVar.raw_pr sch_sort)
+  hov 0 str_identifier ++ spc () ++
+  hov 0 (str_scheme ++ spc() ++ pr_smart_global sch_qualid) ++ spc () ++
+  hov 0 (keyword "Sort" ++ spc() ++
+         UnivGen.QualityOrSet.pr Sorts.Quality.raw_printer sch_sort)
 
 let pr_equality_scheme_type sch id =
   let str_scheme = match sch with
@@ -535,7 +542,7 @@ let pr_notation_declaration ntn_decl =
       ntn_decl_modifiers = modifiers;
       ntn_decl_scope = scopt } = ntn_decl in
   qs ntn ++ spc () ++ str ":=" ++ spc ()
-  ++ Flags.without_option Flags.beautify pr_constr c
+  ++ pr_constr c
   ++ pr_syntax_modifiers modifiers
   ++ pr_opt (fun sc -> spc () ++ str ":" ++ spc () ++ str sc) scopt
 
@@ -543,11 +550,10 @@ let pr_where_notation decl_ntn =
   fnl () ++ keyword "where " ++ pr_notation_declaration decl_ntn
 
 let pr_rec_definition (rec_order, { fname; univs; binders; rtype; body_def; notations }) =
-  let pr_pure_lconstr c = Flags.without_option Flags.beautify pr_lconstr c in
   let annot = pr_guard_annot pr_lconstr_expr binders rec_order in
   pr_ident_decl (fname,univs) ++ pr_binders_arg binders ++ annot
   ++ pr_type_option (fun c -> spc() ++ pr_lconstr_expr c) rtype
-  ++ pr_opt (fun def -> str":=" ++ brk(1,2) ++ pr_pure_lconstr def) body_def
+  ++ pr_opt (fun def -> str":=" ++ brk(1,2) ++ pr_lconstr def) body_def
   ++ prlist pr_where_notation notations
 
 let pr_statement head (idpl,(bl,c)) =
@@ -561,8 +567,7 @@ let pr_rew_rule (ubinders, lhs, rhs) =
   | _ ->
     pr_universe_decl ubinders ++ spc() ++ str"|-"
   in
-  let pr_pure_lconstr c = Flags.without_option Flags.beautify pr_lconstr c in
-  binders ++ pr_pure_lconstr lhs ++ str"==>" ++ pr_pure_lconstr rhs
+  binders ++ pr_lconstr lhs ++ str"==>" ++ pr_lconstr rhs
 
 (**************************************)
 (* Pretty printer for vernac commands *)
@@ -616,11 +621,12 @@ let pr_printable = function
     keyword "Print All"
   | PrintSectionContext s ->
     keyword "Print Section" ++ spc() ++ Libnames.pr_qualid s
-  | PrintGrammar ent ->
-    keyword "Print Grammar" ++ spc() ++
+  | PrintGrammar {flatten; ent} ->
+    keyword "Print Grammar" ++ (if not flatten then str " Tree" else mt()) ++ spc() ++
     prlist_with_sep spc str ent
-  | PrintCustomGrammar ent ->
-    keyword "Print Custom Grammar" ++ spc() ++ pr_qualid ent
+  | PrintCustomGrammar {flatten; ent} ->
+    keyword "Print Custom Grammar" ++ (if not flatten then str " Tree" else mt()) ++ spc() ++
+    pr_qualid ent
   | PrintKeywords ->
     keyword "Print Keywords"
   | PrintLoadPath dir ->
@@ -633,6 +639,12 @@ let pr_printable = function
     keyword "Print ML Modules"
   | PrintDebugGC ->
     keyword "Print ML GC"
+  | PrintDebugDelta qid ->
+    let qid = match qid with
+    | None -> mt ()
+    | Some qid -> spc () ++ pr_qualid qid
+    in
+    keyword "Print Debug Delta" ++ qid
   | PrintGraph ->
     keyword "Print Graph"
   | PrintClasses ->
@@ -677,8 +689,9 @@ let pr_printable = function
     keyword cmd ++ pr_opt pr_subgraph g ++ pr_opt pr_with_src with_sources ++ pr_opt str fopt
   | PrintSorts ->
     keyword "Print Sorts"
-  | PrintName (qid,udecl) ->
-    keyword "Print" ++ spc()  ++ pr_smart_global qid ++ pr_full_univ_name_list udecl
+  | PrintName (items) ->
+    keyword "Print" ++ spc()  ++ prlist_with_sep pr_comma
+        ( fun (qid,udecl) -> pr_smart_global qid ++ pr_full_univ_name_list udecl) items
   | PrintModuleType qid ->
     keyword "Print Module Type" ++ spc() ++ pr_qualid qid
   | PrintModule qid ->
@@ -691,9 +704,12 @@ let pr_printable = function
     keyword "Print Scope" ++ spc() ++ str s
   | PrintVisibility s ->
     keyword "Print Visibility" ++ pr_opt str s
-  | PrintAbout (qid,l,gopt) ->
+  | PrintAbout (items, gopt) ->
     pr_opt (fun g -> Goal_select.pr_goal_selector g ++ str ":"++ spc()) gopt
-    ++ keyword "About" ++ spc()  ++ pr_smart_global qid ++ pr_full_univ_name_list l
+    ++ keyword "About" ++ spc()
+    ++ prlist_with_sep pr_comma
+         (fun (qid,l) -> pr_smart_global qid ++ pr_full_univ_name_list l)
+         items
   | PrintImplicit qid ->
     keyword "Print Implicit" ++ spc()  ++ pr_smart_global qid
   (* spiwack: command printing all the axioms and section variables used in a
@@ -920,7 +936,7 @@ let pr_synpure_vernac_expr v =
   | VernacInductive (f,l) ->
     let pr_constructor ((attr,coe,ins),(id,c)) =
       hov 2 (pr_vernac_attributes attr ++ pr_lident id ++ pr_oc coe ins ++
-             Flags.without_option Flags.beautify pr_spc_lconstr c)
+             pr_spc_lconstr c)
     in
     let pr_constructor_list l = match l with
       | Constructors [] -> mt()
@@ -1276,11 +1292,11 @@ let pr_synpure_vernac_expr v =
         (keyword "Register" ++ spc() ++ pr_qualid qid ++ spc () ++ str "as"
          ++ spc () ++ pr_qualid name)
     )
-  | VernacRegister (qid, RegisterScheme {inductive; scheme_kind}) ->
+  | VernacRegister (qid, RegisterScheme {ref; scheme_kind}) ->
     return (
       hov 2
         (keyword "Register" ++ spc() ++ keyword "Scheme" ++ spc() ++ pr_qualid qid ++ spc () ++ str "as"
-         ++ spc () ++ pr_qualid scheme_kind ++ spc() ++ str "for" ++ spc() ++ pr_qualid inductive)
+         ++ spc () ++ pr_qualid scheme_kind ++ spc() ++ str "for" ++ spc() ++ pr_qualid ref)
     )
   | VernacRegister (qid, RegisterInline) ->
     return (
@@ -1453,6 +1469,7 @@ let pr_control_flag (p : control_flag) =
     | ControlProfile f -> keyword "Profile" ++ pr_opt qstring f
     | ControlRedirect s -> keyword "Redirect" ++ spc() ++ qs s
     | ControlTimeout n -> keyword "Timeout " ++ int n
+    | ControlAllocLimit n -> keyword "AllocLimit " ++ int64 Int64.(div n.kilowords 1000L)
     | ControlFail -> keyword "Fail"
     | ControlSucceed -> keyword "Succeed"
   in
diff --git a/vernac/prettyp.ml b/vernac/prettyp.ml
index 463bc2395d82..b4e996be3ad6 100644
--- a/vernac/prettyp.ml
+++ b/vernac/prettyp.ml
@@ -57,8 +57,7 @@ let print_ref env reduce ref udecl =
   let typ, univs = Typeops.type_of_global_in_context env ref in
   let inst = UVars.make_abstract_instance univs in
   let udecl = Option.map (fun x -> ref, x) udecl in
-  let bl = Printer.universe_binders_with_opt_names (Environ.universes_of_global env ref) udecl in
-  let sigma = Evd.from_ctx (UState.of_names bl) in
+  let sigma = Evd.from_auctx env (Printer.fill_names ?user_names:udecl univs) in
   let typ =
     if reduce then
       let ctx,ccl = Reductionops.whd_decompose_prod_decls env sigma (EConstr.of_constr typ)
@@ -201,7 +200,7 @@ let template_poly_variables env ind =
   | None -> assert false
   | Some { template_defaults; template_concl } ->
     let pseudo_poly = match template_concl with
-      | QSort (q, _) when Option.has_some (Sorts.QVar.var_index q) -> true
+      | VSort (q, _) when Option.has_some (Sorts.QVar.var_index q) -> true
       | _ -> false
     in
     let _, vars = UVars.Instance.levels template_defaults in
@@ -237,8 +236,7 @@ let print_squash env ref udecl = match ref with
     | Some squash ->
       let univs = Environ.universes_of_global env ref in
       let udecl = Option.map (fun x -> ref, x) udecl in
-      let bl = Printer.universe_binders_with_opt_names univs udecl in
-      let sigma = Evd.from_ctx (UState.of_names bl) in
+      let sigma = Evd.from_auctx env (Printer.fill_names ?user_names:udecl univs) in
       let inst = if fst @@ UVars.AbstractContext.size univs = 0 then mt()
         else Printer.pr_universe_instance sigma (UVars.make_abstract_instance univs)
       in
@@ -248,7 +246,8 @@ let print_squash env ref udecl = match ref with
           | Prop -> str "SProp or Prop"
           | Set -> str "SProp, Prop or Set"
           | Type _ -> str "not in a variable sort quality"
-          | QSort (q,_) -> str "in sort quality " ++ Termops.pr_evd_qvar sigma q
+          | GSort (q,_) -> str "in sort quality " ++ Termops.pr_evd_qglobal sigma q
+          | VSort (q,_) -> str "in sort quality " ++ Termops.pr_evd_qvar sigma q
       in
       let unless = match squash with
         | AlwaysSquashed -> str "."
@@ -256,8 +255,9 @@ let print_squash env ref udecl = match ref with
           let target = match inds with
             | SProp | Prop | Set -> target
             | Type _ -> str "instantiated to constant qualities"
-            | QSort (q,_) ->
-              let ppq = Termops.pr_evd_qvar sigma q in
+            | VSort _ | GSort _ ->
+              let q = Sorts.quality inds in
+              let ppq = Sorts.Quality.pr (Evd.quality_printer sigma) q in
               str "equal to the instantiation of " ++ ppq ++ pr_comma() ++
               str "or to qualities smaller" ++ spc() ++
               str "(SProp <= Prop <= Type, and all variables <= Type)" ++ spc() ++
@@ -272,7 +272,7 @@ let print_squash env ref udecl = match ref with
              "quality Prop is equal to the instantiation of q" *)
           pr_comma () ++
           hov 0 (str "unless instantiated such that the " ++ str quality_s ++ str " " ++
-                 pr_enum (Sorts.Quality.pr (Termops.pr_evd_qvar sigma)) qs ++
+                 pr_enum (Sorts.Quality.pr (Evd.quality_printer sigma)) qs ++
                  spc() ++ str is_s ++ str " " ++ target ++ str ".")
       in
       [hv 2 (hov 1 (pr_global ref ++ inst) ++ str " may only be eliminated to produce values whose type is " ++
@@ -322,6 +322,7 @@ let print_primitive_record recflag mipv =
       | CoFinite | Finite -> str " without eta conversion"
       | BiFinite -> match has_eta with
                     | NoEta -> str " without eta conversion"
+                    | MaybeEta -> str " with eta conversion depending on sort instantiation"
                     | AlwaysEta -> str " with eta conversion"
     in
     [Id.print mip.mind_typename ++ str" has primitive projections" ++ eta ++ str"."]
@@ -575,11 +576,7 @@ let print_constant env ~with_values with_implicit cst udecl =
   let typ = cb.const_type in
   let univs = cb.const_universes in
   let udecl = Option.map (fun x -> GlobRef.ConstRef cst, x) udecl in
-  let uctx =
-    UState.of_names
-      (Printer.universe_binders_with_opt_names (Declareops.constant_polymorphic_context cb) udecl)
-  in
-  let sigma = Evd.from_ctx uctx in
+  let sigma = Evd.from_auctx env (Printer.fill_names ?user_names:udecl (Declareops.constant_polymorphic_context cb)) in
   let impargs = if with_implicit then select_stronger_impargs (implicits_of_global (ConstRef cst)) else [] in
   let impargs = List.map binding_kind_of_status impargs in
   let pptyp = pr_ltype_env env sigma ~impargs typ in
@@ -662,7 +659,10 @@ let print_abbreviation_body env kn (vars,c) =
         spc () ++ str ":=") ++
      spc () ++
      Vernacstate.System.protect (fun () ->
-         Abbreviation.toggle ~on:false ~use:ParsingAndPrinting kn;
+         (* if we disable parsing the abbrev is removed from the
+            nametab, which means some other global may be accessible
+            and printed using its name *)
+         Abbreviation.toggle ~on:false ~use:OnlyPrinting kn;
          pr_glob_constr_env env (Evd.from_env env) c) ())
 
 let print_abbreviation access env sigma kn =
diff --git a/vernac/prettyp.mli b/vernac/prettyp.mli
index 0ae97edbca35..06cb12b2a199 100644
--- a/vernac/prettyp.mli
+++ b/vernac/prettyp.mli
@@ -41,7 +41,7 @@ val print_safe_judgment : Safe_typing.judgment -> Pp.t
 
 val print_name : Global.indirect_accessor -> env -> Evd.evar_map
   -> qualid Constrexpr.or_by_notation
-  -> UnivNames.full_name_list option
+  -> UnivNames.univ_name_list option
   -> Pp.t
 val print_notation : env -> Evd.evar_map
   -> qualid Constrexpr.notation_entry_gen
@@ -51,7 +51,7 @@ val print_notation : env -> Evd.evar_map
 val print_abbreviation : Global.indirect_accessor -> env -> Evd.evar_map -> KerName.t -> Pp.t
 
 val print_about : env -> Evd.evar_map -> qualid Constrexpr.or_by_notation ->
-  UnivNames.full_name_list option -> Pp.t
+  UnivNames.univ_name_list option -> Pp.t
 val print_impargs : env -> GlobRef.t -> Pp.t
 
 (** Pretty-printing functions for classes and coercions *)
diff --git a/vernac/printmod.ml b/vernac/printmod.ml
index a9dcc8270a3d..d116aa4bc0e8 100644
--- a/vernac/printmod.ml
+++ b/vernac/printmod.ml
@@ -160,10 +160,8 @@ let pr_mutual_inductive_body env mind mib udecl =
        | PrimRecord l -> "Record"
   in
   let udecl = Option.map (fun x -> GlobRef.IndRef (mind,0), x) udecl in
-  let bl = Printer.universe_binders_with_opt_names
-      (Declareops.inductive_polymorphic_context mib) udecl
-  in
-  let sigma = Evd.from_ctx (UState.of_names bl) in
+  let auctx = Printer.fill_names ?user_names:udecl (Declareops.inductive_polymorphic_context mib) in
+  let sigma = Evd.from_auctx env auctx in
 
   hov 0 (def keyword ++ spc () ++
          prlist_with_sep (fun () -> fnl () ++ str"  with ")
@@ -269,25 +267,27 @@ let print_body is_impl extent env mp (l,body) =
     | SFBmodtype _ -> keyword "Module Type" ++ spc () ++ name
     | SFBrules _ -> keyword "Rewrite Rule" ++ spc () ++ name (* TODO: correct? *)
     | SFBconst cb ->
-       let ctx = Declareops.constant_polymorphic_context cb in
-      (match cb.const_body with
-        | Def _ -> def "Definition" ++ spc ()
-        | OpaqueDef _ when is_impl -> def "Theorem" ++ spc ()
-        | _ -> def "Parameter" ++ spc ()) ++ name ++
-      (match extent with
-         | OnlyNames -> mt ()
-         | WithContents ->
-            let bl = Printer.universe_binders_with_opt_names ctx None in
-            let sigma = Evd.from_ctx (UState.of_names bl) in
-            str " :" ++ spc () ++
-            hov 0 (Printer.pr_ltype_env env sigma cb.const_type) ++
-            (match cb.const_body with
-              | Def l when is_impl ->
-                spc () ++
-                hov 2 (str ":= " ++
-                       Printer.pr_lconstr_env env sigma l)
-              | _ -> mt ()) ++ str "." ++
-            Printer.pr_abstract_universe_ctx sigma ctx)
+      let auctx = Declareops.constant_polymorphic_context cb in
+      begin match cb.const_body with
+      | Def _ -> def "Definition" ++ spc ()
+      | OpaqueDef _ when is_impl -> def "Theorem" ++ spc ()
+      | _ -> def "Parameter" ++ spc ()
+      end ++ name ++
+      begin match extent with
+      | OnlyNames -> mt ()
+      | WithContents ->
+        let auctx = Printer.fill_names auctx in
+        let sigma = Evd.from_auctx env auctx in
+        str " :" ++ spc () ++
+        hov 0 (Printer.pr_ltype_env env sigma cb.const_type) ++
+        (match cb.const_body with
+          | Def l when is_impl ->
+            spc () ++
+            hov 2 (str ":= " ++
+                    Printer.pr_lconstr_env env sigma l)
+          | _ -> mt ()) ++ str "." ++
+        Printer.pr_abstract_universe_ctx sigma auctx
+      end
     | SFBmind mib ->
       match extent with
       | WithContents ->
diff --git a/vernac/printmod.mli b/vernac/printmod.mli
index 706e7d5b8af4..d53593366292 100644
--- a/vernac/printmod.mli
+++ b/vernac/printmod.mli
@@ -12,6 +12,6 @@ open Names
 
 val pr_mutual_inductive_body : Environ.env ->
   MutInd.t -> Declarations.mutual_inductive_body ->
-  UnivNames.full_name_list option -> Pp.t
+  UnivNames.univ_name_list option -> Pp.t
 val print_module : with_body:bool -> ModPath.t -> Pp.t
 val print_modtype : ModPath.t -> Pp.t
diff --git a/vernac/proof_using.ml b/vernac/proof_using.ml
index 40b70df96322..c9d0366ab786 100644
--- a/vernac/proof_using.ml
+++ b/vernac/proof_using.ml
@@ -109,7 +109,8 @@ let definition_using env evd ~fixnames ~using ~terms =
 let name_set id expr =
   if Id.equal id all_collection_id then err_redefine_all_collection ();
   if is_known_name id then warn_redefine_collection id;
-  if Termops.is_section_variable (Global.env ()) id then warn_variable_shadowing id;
+  (* but we won't warn if id gets declared as a section variable later *)
+  if Environ.mem_named id (Global.env ()) then warn_variable_shadowing id;
   known_names := (id,expr) :: !known_names
 
 let minimize_hyps env ids =
@@ -223,7 +224,7 @@ let using_from_string us = Procq.Entry.parse entry
 let proof_using_opt_name = ["Default";"Proof";"Using"]
 let () =
   Goptions.(declare_stringopt_option
-    { optstage = Summary.Stage.Interp;
+    { optstage = Summary.Stage.Synterp;
       optdepr  = None;
       optkey   = proof_using_opt_name;
       optread  = (fun () -> Option.map using_to_string !value);
diff --git a/vernac/pvernac.ml b/vernac/pvernac.ml
index 4e4c7ab178d3..3e5b3d6d185d 100644
--- a/vernac/pvernac.ml
+++ b/vernac/pvernac.ml
@@ -12,7 +12,7 @@ open Procq
 
 type proof_mode_entry = ProofMode : {
   command_entry : Vernacexpr.vernac_expr Entry.t;
-  wit_tactic_expr : ('raw,_,unit) Genarg.genarg_type;
+  wit_tactic_expr : ('raw,_) Gentactic.tag;
   tactic_expr_entry : 'raw Entry.t;
 } -> proof_mode_entry
 
@@ -47,7 +47,7 @@ let noedit_tactic_expr = Entry.make "noedit_tactic_expr"
 
 let noedit_mode_entry = ProofMode {
   command_entry = noedit_mode;
-  wit_tactic_expr = Stdarg.wit_unit;
+  wit_tactic_expr = Gentactic.empty;
   tactic_expr_entry = noedit_tactic_expr;
 }
 
@@ -103,7 +103,7 @@ module Vernac_ =
       let mode = get_default_proof_mode () in
       let ProofMode mode = find_proof_mode mode in
       let+ v = Procq.Entry.parse_token_stream mode.tactic_expr_entry strm in
-      Gentactic.of_raw_genarg Genarg.(in_gen (rawwit mode.wit_tactic_expr) v)
+      Gentactic.of_raw mode.wit_tactic_expr v
 
     let command_entry =
       Procq.Entry.(of_parser "command_entry"
diff --git a/vernac/pvernac.mli b/vernac/pvernac.mli
index db5df0aff551..176180cdee2c 100644
--- a/vernac/pvernac.mli
+++ b/vernac/pvernac.mli
@@ -53,7 +53,7 @@ val main_entry : proof_mode option -> vernac_control option Entry.t
 
 type proof_mode_entry = ProofMode : {
     command_entry : Vernacexpr.vernac_expr Entry.t;
-    wit_tactic_expr : ('raw,_,unit) Genarg.genarg_type;
+    wit_tactic_expr : ('raw,_) Gentactic.tag;
     tactic_expr_entry : 'raw Entry.t;
 } -> proof_mode_entry
 
diff --git a/vernac/record.ml b/vernac/record.ml
index dc76c5d34542..d55f5f1d5c58 100644
--- a/vernac/record.ml
+++ b/vernac/record.ml
@@ -46,7 +46,18 @@ let { Goptions.get = typeclasses_default_mode } =
     ~value:Hints.ModeOutput
     ()
 
-let interp_fields_evars ~poly env sigma ~ninds ~nparams impls_env nots l =
+let check_add_elim_constraint ~primitive_proj ~collapse_sort_variables env sigma record_quality fld_sort =
+  (* Only adding elimination constraints for primitive projections
+    if the sort poly flag is enabled, for now *)
+  if primitive_proj && not collapse_sort_variables then
+    let fld_quality = EConstr.ESorts.quality sigma fld_sort in
+    if QGraph.eliminates_to (Evd.elim_graph sigma) record_quality fld_quality then sigma
+    else Evd.set_elim_to sigma record_quality fld_quality
+  else
+    sigma
+
+let interp_fields_evars ~primitive_proj ~poly env sigma ~ninds ~nparams record_sort impls_env nots l =
+  let record_quality = EConstr.ESorts.quality sigma record_sort in
   let _, sigma, impls, locs, newfs, _ =
     List.fold_left2
       (fun (env, sigma, uimpls, locs, params, impls_env) no d ->
@@ -58,7 +69,9 @@ let interp_fields_evars ~poly env sigma ~ninds ~nparams impls_env nots l =
              let t = if bl = [] then t else mkCProdN bl t in
              let sigma, t, impl =
                ComAssumption.interp_assumption ~program_mode:false ~poly env sigma impls_env [] t in
-             sigma, (id, None, t), impl, loc
+            let fld_sort = Retyping.get_sort_of env sigma t in
+            let sigma = check_add_elim_constraint ~primitive_proj ~collapse_sort_variables:(PolyFlags.collapse_sort_variables poly) env sigma record_quality fld_sort in
+            sigma, (id, None, t), impl, loc
            | Vernacexpr.DefExpr({CAst.v=id; loc},bl,b,t) ->
              let sigma, (b, t), impl =
                ComDefinition.interp_definition ~program_mode:false ~poly env sigma impls_env bl None b t in
@@ -150,7 +163,7 @@ end
 let is_sort_variable sigma s =
   match EConstr.ESorts.kind sigma s with
   | SProp | Prop | Set -> None
-  | Type u | QSort (_, u) -> match Univ.Universe.level u with
+  | Type u | GSort (_, u) | VSort (_, u) -> match Univ.Universe.level u with
     | None -> None
     | Some l ->
       if Univ.Level.Set.mem l (fst (Evd.universe_context_set sigma))
@@ -250,9 +263,9 @@ let def_class_levels ~def ~env_ar_params sigma aritysorts ctors =
   else
     sigma, s, ctor
 
-let finalize_def_class env sigma ~params ~sort ~projtyp =
+let finalize_def_class ~poly env sigma ~params ~sort ~projtyp =
   let sigma, (params, sort, typ, projtyp) =
-    Evarutil.finalize ~abort_on_undefined_evars:false sigma (fun nf ->
+    Evarutil.finalize ~abort_on_undefined_evars:false ~poly sigma (fun nf ->
         let typ = EConstr.it_mkProd_or_LetIn (EConstr.mkSort sort) params in
         let typ = nf typ in
         (* we know the context is exactly the params because we built typ from mkSort *)
@@ -341,7 +354,7 @@ let typecheck_params_and_fields ~kind ~(flags:ComInductive.flags) ~primitive_pro
   let sigma, udecl, variances = Constrintern.interp_cumul_univ_decl_opt env0 udecl in
   let () = List.iter check_parameters_must_be_named params in
   let sigma, (impls_env, ((_env1,params), impls, _paramlocs)) =
-    Constrintern.interp_context_evars ~program_mode:false ~unconstrained_sorts env0 sigma params in
+    Constrintern.interp_context_evars ~program_mode:false ~unconstrained_sorts ~poly:flags.poly env0 sigma params in
   let sigma, typs =
     List.fold_left_map (build_type_telescope ~unconstrained_sorts params env0) sigma records in
   let typs, aritysorts = List.split typs in
@@ -357,10 +370,10 @@ let typecheck_params_and_fields ~kind ~(flags:ComInductive.flags) ~primitive_pro
   in
   let ninds = List.length arities in
   let nparams = List.length params in
-  let fold sigma { DataI.nots; fs; _ } =
-    interp_fields_evars ~poly:flags.poly env_ar_params sigma ~ninds ~nparams impls_env nots fs
+  let fold sigma { DataI.nots; fs; _ } record_sort =
+    interp_fields_evars ~primitive_proj ~poly:flags.poly env_ar_params sigma ~ninds ~nparams record_sort impls_env nots fs
   in
-  let (sigma, fields) = List.fold_left_map fold sigma records in
+  let (sigma, fields) = List.fold_left2_map fold sigma records aritysorts in
   let field_impls, locs, fields = List.split3 fields in
   let field_impls = List.map (List.map (adjust_field_implicits ~isclass (params,impls))) field_impls in
   let sigma =
@@ -372,7 +385,7 @@ let typecheck_params_and_fields ~kind ~(flags:ComInductive.flags) ~primitive_pro
       (* named and rel context in the env don't matter here
          (they will be replaced by the ones of the unsolved evars in the error message
          which is the env's only use) *)
-      finalize_def_class env_ar_params sigma ~params ~sort ~projtyp
+      finalize_def_class ~poly:flags.poly env_ar_params sigma ~params ~sort ~projtyp
     in
     let name, projname = match records with
       | [{name; fs=[AssumExpr (projname, _, _)]}] -> name, projname
@@ -469,7 +482,7 @@ let warning_or_error ?loc ~info flags indsp err =
       let err = match te with
         | ElimArity (_, _, Some s) ->
           error_elim_explain (Sorts.quality s)
-            (Inductiveops.elim_sort (Global.lookup_inductive indsp))
+            (UnivGen.QualityOrSet.quality @@ Inductiveops.elim_sort (Global.lookup_inductive indsp))
         | _ -> None
       in
         match err with
@@ -551,6 +564,51 @@ let declare_proj_coercion_instance ~flags ref from =
   in
   ()
 
+(* Collects elimination constraints from other projections that might be referenced
+ * in the type of the current projection being built.
+ * elim_cstrs_map keeps the mapping of (projection constant -> elim constraints) *)
+let collect_elim_cstrs elim_cstrs_map proj_type =
+  let open Sorts in
+  let rec aux_fold elim_cstrs c =
+    match Constr.kind c with
+    | Const (c, _) -> (
+        match Cmap_env.find_opt c elim_cstrs_map with
+        | None -> elim_cstrs
+        | Some c_elim_cstrs -> ElimConstraints.union elim_cstrs c_elim_cstrs)
+    | _ -> Constr.fold aux_fold elim_cstrs c
+  in
+  aux_fold ElimConstraints.empty proj_type
+
+(* Checks whether the record's quality can be eliminated into the projection's
+   quality. If not, then it adds the elimination constraint. *)
+let check_add_elimination_constraints ~primitive (entry, binders as univs) elim_cstrs_map record_quality proj_typ =
+  (* When the record has primitive projections, then the constraints are added to the record itself,
+   * not to the projections *)
+  if primitive then univs, None
+  else
+    let env = Global.env () in
+    let evd = Evd.from_env env in
+    let proj_quality = EConstr.ESorts.quality evd @@ Retyping.get_sort_of env evd @@ EConstr.of_constr proj_typ in
+    let open QGraph in
+    let qgraph = Environ.qualities env in
+    let qgraph = try add_quality record_quality qgraph with AlreadyDeclared -> qgraph in
+    let qgraph = try add_quality proj_quality qgraph with AlreadyDeclared -> qgraph in
+    if eliminates_to qgraph record_quality proj_quality then univs, None
+    else
+      let entry, new_field_elim_cstrs = match entry with
+        | UState.Polymorphic_entry uctx ->
+          let open Sorts in
+          let new_elim_cstr = record_quality, ElimConstraint.ElimTo, proj_quality in
+          let (elim_cstrs, univ_cstrs) = UVars.UContext.constraints uctx in
+          let related_elim_cstrs = collect_elim_cstrs elim_cstrs_map proj_typ in
+          let elim_cstrs' = ElimConstraints.add new_elim_cstr elim_cstrs in
+          let elim_cstrs' = ElimConstraints.union related_elim_cstrs elim_cstrs' in
+          let uctx' = UVars.UContext.make (UVars.UContext.names uctx) (UVars.UContext.instance uctx, (elim_cstrs', univ_cstrs)) in
+          UState.Polymorphic_entry uctx', Some elim_cstrs'
+        | _ -> entry, None
+      in
+      (entry, binders), new_field_elim_cstrs
+
 (* TODO: refactor the declaration part here; this requires some
    surgery as Evarutil.finalize is called too early in the path *)
 (** This builds and _declares_ a named projection, the code looks
@@ -559,7 +617,7 @@ let declare_proj_coercion_instance ~flags ref from =
    this could be refactored as noted above by moving to the
    higher-level declare constant API *)
 let build_named_proj ~primitive ~flags ~univs ~uinstance ~kind env paramdecls
-    paramargs decl impls {CAst.v=fid; loc} subst nfi ti i indsp mib lifted_fields x rp =
+    paramargs decl impls {CAst.v=fid; loc} subst nfi ti i indsp mib lifted_fields x rp record_quality elim_cstrs_map =
   let ccl = subst_projection fid subst ti in
   let body, p_opt = match decl with
     | LocalDef (_,ci,_) -> subst_projection fid subst ci, None
@@ -579,9 +637,17 @@ let build_named_proj ~primitive ~flags ~univs ~uinstance ~kind env paramdecls
            constant relevance *)
         mkCase (Inductive.contract_case env (ci, (p, rci), NoInvert, mkRel 1, [|branch|])), None
   in
-  let proj = it_mkLambda_or_LetIn (mkLambda (x,rp,body)) paramdecls in
-  let projtyp = it_mkProd_or_LetIn (mkProd (x,rp,ccl)) paramdecls in
-  let entry = Declare.definition_entry ~univs ~types:projtyp proj in
+  let proj = it_mkLambda_or_LetIn (mkLambda (x, rp, body)) paramdecls in
+  let proj_typ = it_mkProd_or_LetIn (mkProd (x, rp, ccl)) paramdecls in
+  let univs, new_field_elim_cstrs =
+    match decl with
+    (* A local def might need previous elim constraints but it doesn't introduce new ones *)
+    | LocalDef _ -> univs, None
+    | LocalAssum _ ->
+        check_add_elimination_constraints ~primitive univs elim_cstrs_map
+          record_quality proj_typ
+  in
+  let entry = Declare.definition_entry ~univs ~types:proj_typ proj in
   let kind = Decls.IsDefinition kind in
   let kn =
     (* XXX more precise loc *)
@@ -590,6 +656,10 @@ let build_named_proj ~primitive ~flags ~univs ~uinstance ~kind env paramdecls
       let _, info = Exninfo.capture exn in
       Exninfo.iraise (NotDefinable (BadTypedProj (fid,ctx,te)),info)
   in
+  let elim_cstrs_map = match new_field_elim_cstrs with
+    | None -> elim_cstrs_map
+    | Some elim_cstrs -> Cmap_env.add kn elim_cstrs elim_cstrs_map
+  in
   Declare.definition_message fid;
   let term = match p_opt with
     | Some (p,r) ->
@@ -605,29 +675,29 @@ let build_named_proj ~primitive ~flags ~univs ~uinstance ~kind env paramdecls
   Impargs.maybe_declare_manual_implicits false refi impls;
   declare_proj_coercion_instance ~flags refi (GlobRef.IndRef indsp);
   let i = if is_local_assum decl then i+1 else i in
-  (Some kn, i, Projection term::subst)
+  (elim_cstrs_map, Some kn, i, Projection term::subst)
 
 (** [build_proj] will build a projection for each field, or skip if
    the field is anonymous, i.e. [_ : t] *)
-let build_proj env mib indsp primitive x rp lifted_fields paramdecls paramargs ~uinstance ~kind ~univs
-    (nfi,i,kinds,subst) flags loc decl impls =
+let build_proj env mib indsp primitive x rp lifted_fields paramdecls paramargs record_quality ~uinstance ~kind ~univs
+    (elim_cstrs_map, nfi, i, kinds, subst) flags loc decl impls =
   let fi = RelDecl.get_name decl in
   let ti = RelDecl.get_type decl in
-  let (sp_proj,i,subst) =
+  let (elim_cstrs_map, sp_proj, i, subst) =
     match fi with
     | Anonymous ->
-      (None,i,NoProjection fi::subst)
+      (elim_cstrs_map, None, i, NoProjection fi::subst)
     | Name fid ->
       let fid = CAst.make ?loc fid in
       try build_named_proj
             ~primitive ~flags ~univs ~uinstance ~kind env paramdecls paramargs decl impls fid
-            subst nfi ti i indsp mib lifted_fields x rp
+            subst nfi ti i indsp mib lifted_fields x rp record_quality elim_cstrs_map
       with NotDefinable why as exn ->
         let _, info = Exninfo.capture exn in
         warning_or_error ?loc ~info flags indsp why;
-        (None,i,NoProjection fi::subst)
+        (elim_cstrs_map, None, i, NoProjection fi::subst)
   in
-  (nfi - 1, i,
+  (elim_cstrs_map, nfi - 1, i,
    { Structure.proj_name = fi
    ; proj_true = is_local_assum decl
    ; proj_canonical = flags.Data.pf_canonical
@@ -649,6 +719,8 @@ let declare_projections indsp ~kind ~inhabitant_id flags ?fieldlocs fieldimpls =
     | Polymorphic auctx -> UState.Polymorphic_entry (UVars.AbstractContext.repr auctx)
   in
   let univs = univs, UnivNames.empty_binders in
+  let elim_cstrs_map = Cmap_env.empty in
+  let record_quality = Sorts.quality mip.mind_sort in
   let fields, _ = mip.mind_nf_lc.(0) in
   let fields = List.firstn mip.mind_consnrealdecls.(0) fields in
   let paramdecls = Inductive.inductive_paramdecls (mib, uinstance) in
@@ -667,10 +739,10 @@ let declare_projections indsp ~kind ~inhabitant_id flags ?fieldlocs fieldimpls =
     | None -> List.make (List.length fields) None
     | Some fieldlocs -> fieldlocs
   in
-  let (_,_,canonical_projections,_) =
+  let (_, _, _, canonical_projections, _) =
     List.fold_left4
-      (build_proj env mib indsp primitive x rp lifted_fields paramdecls paramargs ~uinstance ~kind ~univs)
-      (List.length fields,0,[],[]) flags (List.rev fieldlocs) (List.rev fields) (List.rev fieldimpls)
+      (build_proj env mib indsp primitive x rp lifted_fields paramdecls paramargs record_quality ~uinstance ~kind ~univs)
+      (elim_cstrs_map, List.length fields,0,[],[]) flags (List.rev fieldlocs) (List.rev fields) (List.rev fieldimpls)
   in
     List.rev canonical_projections
 
@@ -720,7 +792,6 @@ module Record_decl = struct
     records : Data.t list;
     projections_kind : Decls.definition_object_kind;
     indlocs : DeclareInd.indlocs;
-    poly : PolyFlags.t
   }
 end
 
@@ -812,13 +883,12 @@ let pre_process_structure udecl kind ~flags ~primitive_proj (records : Ast.t lis
     Decls.(match kind_class kind with NotClass -> StructureComponent | _ -> Method) in
   entry, projections_kind, decl_data, indlocs
 
-let interp_structure_core (entry:RecordEntry.t) ~projections_kind ~indlocs ~poly data =
+let interp_structure_core (entry:RecordEntry.t) ~projections_kind ~indlocs data =
   let open Record_decl in
   { entry;
     projections_kind;
     records = data;
     indlocs;
-    poly
   }
 
 let interp_structure ~flags udecl kind ~primitive_proj records =
@@ -828,7 +898,7 @@ let interp_structure ~flags udecl kind ~primitive_proj records =
   match entry with
   | DefclassEntry _ -> assert false
   | RecordEntry entry ->
-    interp_structure_core entry ~projections_kind ~indlocs ~poly:flags.poly data
+    interp_structure_core entry ~projections_kind ~indlocs data
 
 module Declared = struct
   type t =
@@ -924,16 +994,16 @@ let declare_class_constant entry (data:Data.t) =
 let set_class_mode ref mode ctx =
   let modes =
     match mode with
-    | Some (Some m) -> Some m
-    | _ ->
+    | Some m -> Some m
+    | None ->
       let ctxl = Context.Rel.nhyps ctx in
       let def = typeclasses_default_mode () in
       let mode = match def with
       | Hints.ModeOutput -> None
-      | Hints.ModeInput ->
-        Some (List.init ctxl (fun _ -> Hints.ModeInput))
+      | Hints.ModeFrozen
+      | Hints.ModeInput
       | Hints.ModeNoHeadEvar ->
-        Some (List.init ctxl (fun _ -> Hints.ModeNoHeadEvar))
+        Some (List.init ctxl (fun _ -> def))
       in
       let wm = List.init ctxl (fun _ -> def) in
       Classes.warn_default_mode (ref, wm);
@@ -991,7 +1061,7 @@ let declare_class ?mode declared =
     cl_projs = projs;
   }
   in
-  Classes.add_class k;
+  Classes.add_class ?mode k;
   set_class_mode impl mode params
 
 let add_constant_class cst =
@@ -1077,10 +1147,10 @@ let definition_structure ~flags udecl kind ~primitive_proj (records : Ast.t list
       declare_class_constant entry data
     | RecordEntry entry ->
       let structure = interp_structure_core entry ~projections_kind ~indlocs
-                        ~poly:flags.poly data in
+                        data in
       declare_structure structure ~schemes:flags.schemes
   in
-  if kind_class kind <> NotClass then declare_class ~mode:flags.mode declared;
+  if kind_class kind <> NotClass then declare_class ?mode:flags.mode declared;
   inds
 
 module Internal = struct
diff --git a/vernac/record.mli b/vernac/record.mli
index f0c1f233767f..686e3a42068d 100644
--- a/vernac/record.mli
+++ b/vernac/record.mli
@@ -81,7 +81,6 @@ module Record_decl : sig
     records : Data.t list;
     projections_kind : Decls.definition_object_kind;
     indlocs : DeclareInd.indlocs;
-    poly : PolyFlags.t
   }
 end
 
diff --git a/vernac/retrieveObl.ml b/vernac/retrieveObl.ml
index 3afbdbf0c322..d2989166ab54 100644
--- a/vernac/retrieveObl.ml
+++ b/vernac/retrieveObl.ml
@@ -237,6 +237,8 @@ let retrieve_obligations env name evm fs ?deps ?status t ty =
     List.fold_right
       (fun (id, (n, nstr), ev) evs ->
         let hyps = Evd.evar_filtered_context ev in
+        (* XXX ignore vars based on secvar status + names of recursive functions
+           instead of length of global context + number of recursive functions *)
         let hyps = trunc_named_context nc_len hyps in
         let evtyp, deps, transp = etype_of_evar evm evs hyps (Evd.evar_concl ev) in
         let evtyp, hyps, chop =
diff --git a/vernac/synterp.ml b/vernac/synterp.ml
index 2f65126d1ce1..712480ac7c5e 100644
--- a/vernac/synterp.ml
+++ b/vernac/synterp.ml
@@ -34,12 +34,6 @@ let warn_legacy_export_set =
   CWarnings.create ~name:"legacy-export-set" ~category:Deprecation.Version.v8_18
     Pp.(fun () -> strbrk "Syntax \"Export Set\" is deprecated, use the attribute syntax \"#[export] Set\" instead.")
 
-let deprecated_nonuniform =
-  CWarnings.create ~name:"deprecated-nonuniform-attribute"
-    ~category:Deprecation.Version.v8_18
-    Pp.(fun () -> strbrk "Attribute '#[nonuniform]' is deprecated, \
-                          use '#[warning=\"-uniform-inheritance\"]' instead.")
-
 let warnings_att =
   Attributes.attribute_of_list [
     "warnings", Attributes.payload_parser ~cat:(^) ~name:"warnings";
@@ -48,12 +42,6 @@ let warnings_att =
 
 let with_generic_atts ~check atts f =
   let atts, warnings = Attributes.parse_with_extra warnings_att atts in
-  let atts, nonuniform = Attributes.parse_with_extra ComCoercion.nonuniform atts in
-  let warnings =
-    let () = if nonuniform <> None && check then deprecated_nonuniform () in
-    if nonuniform <> Some true then warnings else
-      let ui = "-uniform-inheritance" in
-      Some (match warnings with Some w -> w ^ "," ^ ui | None -> ui) in
   match warnings with
   | None -> f ~atts
   | Some warnings ->
diff --git a/vernac/vernacControl.ml b/vernac/vernacControl.ml
index 60dab2866421..da9678a64324 100644
--- a/vernac/vernacControl.ml
+++ b/vernac/vernacControl.ml
@@ -44,6 +44,7 @@ type 'state control_entry =
   | ControlProfile of { to_file : string option; profstate : profile_state }
   | ControlRedirect of { fname : string; truncate : bool}
   | ControlTimeout of { remaining : float }
+  | ControlAllocLimit of { remaining : Control.kilowords; allocated : Control.kilowords }
   | ControlFail of { st : 'state }
   | ControlSucceed of { st : 'state }
 
@@ -146,6 +147,37 @@ let with_timeout ~timeout:n f =
     else Some (ControlTimeout { remaining }, v)
   end
 
+exception AllocLimit
+
+let () = CErrors.register_handler @@ function
+  | AllocLimit -> Some Pp.(str "Allocation limit exceeded.")
+  | _ -> None
+
+let with_alloc_limit ~limit ~allocated f =
+  let () = if limit.Control.kilowords <= 0L then
+      CErrors.user_err Pp.(str "Alloc limit must be > 0.")
+  in
+  if not Memprof_coq.is_real_memprof then CWarnings.warn_no_memprof ();
+  match Control.alloc_limit limit f () with
+  | Error info -> Exninfo.iraise (AllocLimit,info)
+  | Ok (v, {kilowords=alloc}) ->
+    let remaining = Int64.sub limit.kilowords alloc in
+    (* can remaining <= 0 actually happen? not sure *)
+    if remaining <= 0L then raise AllocLimit;
+    let remaining = { Control.kilowords = remaining } in
+    let allocated = { Control.kilowords = Int64.add allocated.Control.kilowords alloc } in
+    Some (ControlAllocLimit { remaining; allocated }, v)
+
+let fmt_allocated { Control.kilowords = allocated } =
+  let open Pp in
+  (* XXX print a few more digits for low Mw allocated? *)
+  let alloc = if allocated >= 1000L then
+    int64 (Int64.div allocated 1000L) ++ str "Mw."
+  else int64 allocated ++ str "kw."
+  in
+  fmt "Succeeded without reaching the allocation limit@ (estimated %t allocated)."
+    (fun () -> alloc)
+
 let real_error_loc ~cmdloc ~eloc =
   if Loc.finer eloc cmdloc then eloc
   else cmdloc
@@ -203,6 +235,7 @@ let under_one_control ~loc ~with_local_state control f =
     let v = Topfmt.with_output_to_file ~truncate fname f () in
     Some (ControlRedirect {fname; truncate=false}, v)
   | ControlTimeout {remaining} -> with_timeout ~timeout:remaining f
+  | ControlAllocLimit {remaining; allocated} -> with_alloc_limit ~limit:remaining ~allocated f
   | ControlFail {st} -> with_fail ~loc ~with_local_state st f
   | ControlSucceed {st} -> with_succeed ~with_local_state st f
 
@@ -237,6 +270,9 @@ let rec after_last_phase ~loc = function
         noop
       | ControlRedirect _ -> noop
       | ControlTimeout _ -> noop
+      | ControlAllocLimit { remaining = _; allocated } ->
+        Feedback.msg_notice @@ fmt_allocated allocated;
+        noop
       | ControlFail _ -> CErrors.user_err Pp.(str "The command has not failed!")
       | ControlSucceed _ -> true
 
@@ -276,6 +312,7 @@ let from_syntax_one : Vernacexpr.control_flag -> unit control_entry = fun flag -
   | ControlTimeout timeout ->
     (* don't check_timeout here as the error won't be caught by surrounding Fail *)
     ControlTimeout { remaining = float_of_int timeout }
+  | ControlAllocLimit limit -> ControlAllocLimit { remaining = limit; allocated = { kilowords = 0L } }
   | ControlFail -> ControlFail { st = () }
   | ControlSucceed -> ControlSucceed { st = () }
 
diff --git a/vernac/vernacentries.ml b/vernac/vernacentries.ml
index eb4719ed6aa8..d7ea97885da6 100644
--- a/vernac/vernacentries.ml
+++ b/vernac/vernacentries.ml
@@ -50,6 +50,7 @@ let scope_class_of_qualid qid =
 (** Standard attributes for definition-like commands. *)
 module DefAttributes = struct
   type t = {
+    hooks : Declare.Hook.t list ;
     scope : definition_scope;
     locality : bool option;
     poly : PolyFlags.t;
@@ -73,6 +74,20 @@ module DefAttributes = struct
      of the coercion from out-of-section [Let Coercion].
   *)
 
+  module Observer = Summary.MakeObservable (struct
+      type value = Declare.Hook.t list attribute
+      let local = false
+      let stage = Summary.Stage.Interp
+      let name = "Definition attribute"
+    end)
+
+  let active_hooks () : Declare.Hook.t list attribute =
+    let module AttList = Monad.Make(Attributes.Notations) in
+    let active = Observer.all_active () in
+    let open Attributes.Notations in
+    AttList.List.map snd active >>= fun res ->
+    return (List.concat res)
+
   let importability_of_bool = function
     | true -> ImportNeedQualified
     | false -> ImportDefaultBehavior
@@ -107,20 +122,23 @@ module DefAttributes = struct
   let def_attributes_gen ?(coercion=false) ?(discharge=NoDischarge,"","") () =
     let discharge, deprecated_thing, replacement = discharge in
     let clearbody = match discharge with DoDischarge -> clearbody | NoDischarge -> return None in
+    (* It is important because it prevents early evaluation of [active_hooks ()] *)
+    return () >>= fun () ->
     (locality ++ user_warns_with_use_globref_instead ++ poly PolyFlags.Definition ++ program ++
                canonical_instance ++ typing_flags ++ using ++
-               reversible ++ clearbody) >>= fun ((((((((locality, user_warns), poly), program),
+               reversible ++ clearbody ++ active_hooks ()) >>=
+    fun (((((((((locality, user_warns), poly), program),
            canonical_instance), typing_flags), using),
-           reversible), clearbody) ->
+           reversible), clearbody), hooks) ->
       let using = Option.map Proof_using.using_from_string using in
       let reversible = Option.default false reversible in
       let () = if Option.has_some clearbody && not (Lib.sections_are_opened())
         then CErrors.user_err Pp.(str "Cannot use attribute clearbody outside sections.")
       in
       let scope = scope_of_locality locality discharge deprecated_thing replacement in
-      return { scope; locality; poly; program; user_warns; canonical_instance; typing_flags; using; reversible; clearbody }
+      return { hooks; scope; locality; poly; program; user_warns; canonical_instance; typing_flags; using; reversible; clearbody }
 
-  let parse ?coercion ?discharge f =
+  let parse ?coercion ?discharge f (* : DefAttributes.t  *) =
     Attributes.parse (def_attributes_gen ?coercion ?discharge ()) f
 
   let def_attributes = def_attributes_gen ()
@@ -167,11 +185,11 @@ let show_top_evars ~proof =
   pr_evars_int sigma ~shelf ~given_up 1 (Evd.undefined_map sigma)
 
 let show_universes ~proof =
-  let Proof.{goals;sigma} = Proof.data proof in
-  let ctx = Evd.sort_context_set (Evd.minimize_universes sigma) in
+  let Proof.{ goals; sigma; poly } = Proof.data proof in
+  let ctx = Evd.sort_context_set (Evd.minimize_universes ~poly sigma) in
   UState.pr (Evd.ustate sigma) ++ fnl () ++
   v 1 (str "Normalized constraints:" ++ cut() ++
-       UnivGen.pr_sort_context (Termops.pr_evd_qvar sigma) (Termops.pr_evd_level sigma) ctx)
+       UnivGen.pr_sort_context (Evd.sort_printer sigma) ctx)
 
 (* Simulate the Intro(s) tactic *)
 let show_intro ~proof all =
@@ -357,13 +375,13 @@ let print_registered () =
 
 let print_registered_schemes () =
   let schemes = DeclareScheme.all_schemes() in
-  let pr_one_scheme ind (kind, c) =
-    pr_global c ++ str " registered as " ++ str kind ++ str " for " ++ pr_global (IndRef ind)
+  let pr_one_scheme key (kind, c) =
+    pr_global c ++ str " registered as " ++ str kind ++ str " for " ++ pr_global key
   in
-  let pr_schemes_of_ind (ind, schemes) =
-    prlist_with_sep fnl (pr_one_scheme ind) (CString.Map.bindings schemes)
+  let pr_schemes_of_ref (key, schemes) =
+    prlist_with_sep fnl (pr_one_scheme key) (CString.Map.bindings schemes)
   in
-  hov 0 (prlist_with_sep fnl pr_schemes_of_ind (Indmap_env.bindings schemes))
+  hov 0 (prlist_with_sep fnl pr_schemes_of_ref (GlobRef.Map_env.bindings schemes))
 
 let dump_universes output g =
   let open Univ in
@@ -705,7 +723,7 @@ let print_universes { sort; subgraph; with_sources; file; } =
   end
 
 let print_sorts () =
-  let qualities = Sorts.QVar.Set.elements (Global.qualities ()) in
+  let qualities = Sorts.Quality.Set.elements @@ QGraph.domain @@ Global.elim_graph () in
   let prq = UnivNames.pr_quality_with_global_universes in
   Pp.prlist_with_sep Pp.spc prq qualities
 
@@ -805,24 +823,37 @@ let vernac_enable_notation ~module_local on rule interp flags scope =
 
 let check_name_freshness locality {CAst.loc;v=id} : unit =
   (* We check existence here: it's a bit late at Qed time *)
-  if Termops.is_section_variable (Global.env ()) id ||
+  if Environ.mem_named id (Global.env ()) ||
      locality <> Discharge && Nametab.exists_cci (Lib.make_path id) ||
      locality <> Discharge && Nametab.exists_cci (Lib.make_path_except_section id)
   then
     user_err ?loc  (Id.print id ++ str " already exists.")
 
-let vernac_definition_hook ~canonical_instance ~local ~poly ~reversible = let open Decls in function
-| Coercion ->
-  Some (ComCoercion.add_coercion_hook ~reversible)
-| CanonicalStructure ->
-  Some (Declare.Hook.(make (fun { S.dref } -> Canonical.declare_canonical_structure ?local dref)))
-| SubClass ->
-  Some (ComCoercion.add_subclass_hook ~poly ~reversible)
-| Definition when canonical_instance ->
-  Some (Declare.Hook.(make (fun { S.dref } -> Canonical.declare_canonical_structure ?local dref)))
-| Let when canonical_instance ->
-  Some (Declare.Hook.(make (fun { S.dref } -> Canonical.declare_canonical_structure dref)))
-| _ -> None
+(* Fold a list of declaration hooks into a single hook that runs them all,
+   in order, when the constant is saved. *)
+let hook_of_hooks hooks =
+  match hooks with
+  | [] -> None
+  | _ -> Some (Declare.Hook.make (fun st -> List.iter (fun hook -> Declare.Hook.call ~hook st) hooks))
+
+let vernac_definition_hook ~hooks ~canonical_instance ~local ~poly ~reversible kind =
+  let hooks =
+    let open Decls in
+    let open Declare.Hook in
+    match kind with
+    | Coercion ->
+      (ComCoercion.coercion_hook ~reversible) :: hooks
+    | CanonicalStructure ->
+      make (fun { S.dref } -> Canonical.declare_canonical_structure ?local dref) :: hooks
+    | SubClass ->
+      (ComCoercion.subclass_hook ~poly ~reversible) :: hooks
+    | Definition when canonical_instance ->
+      make (fun { S.dref } -> Canonical.declare_canonical_structure ?local dref) :: hooks
+    | Let when canonical_instance ->
+      make (fun { S.dref } -> Canonical.declare_canonical_structure dref) :: hooks
+    | _ -> hooks
+  in
+  hook_of_hooks hooks
 
 let default_thm_id = Id.of_string "Unnamed_thm"
 
@@ -845,34 +876,37 @@ let vernac_definition_name lid local =
   lid.v
 
 let vernac_definition_interactive ~atts (discharge, kind) (lid, udecl) bl t =
-  let open DefAttributes in
-  let scope, local, poly, program_mode, user_warns, typing_flags, using, clearbody =
-    atts.scope, atts.locality, atts.poly, atts.program, atts.user_warns, atts.typing_flags, atts.using, atts.clearbody in
-  let canonical_instance, reversible = atts.canonical_instance, atts.reversible in
-  let hook = vernac_definition_hook ~canonical_instance ~local ~poly ~reversible kind in
+  let DefAttributes.{
+    scope; locality=local; poly; program=program_mode; hooks;
+    user_warns; typing_flags; using; clearbody; canonical_instance; reversible;
+    } = atts
+  in
+  let hook = vernac_definition_hook ~hooks ~canonical_instance ~local ~poly ~reversible kind in
   let name = vernac_definition_name lid scope in
-  ComDefinition.do_definition_interactive ?loc:lid.loc ~typing_flags ~program_mode ~name ~poly ~scope ?clearbody:atts.clearbody
-    ~kind:(Decls.IsDefinition kind) ?user_warns ?using:atts.using ?hook udecl bl t
+  ComDefinition.do_definition_interactive ?loc:lid.loc ~typing_flags ~program_mode ~name ~poly ~scope ?clearbody
+    ~kind:(Decls.IsDefinition kind) ?user_warns ?using ?hook udecl bl t
 
 let vernac_definition_refine ~atts (discharge, kind) (lid, udecl) bl red_option c typ_opt =
   if Option.has_some red_option then
     CErrors.user_err ?loc:c.loc Pp.(str "Cannot use Eval with #[refine].");
-  let open DefAttributes in
-  let scope, local, poly, program_mode, user_warns, typing_flags, using, clearbody =
-     atts.scope, atts.locality, atts.poly, atts.program, atts.user_warns, atts.typing_flags, atts.using, atts.clearbody in
-  let canonical_instance, reversible = atts.canonical_instance, atts.reversible in
-  let hook = vernac_definition_hook ~canonical_instance ~local ~poly kind ~reversible in
+  let DefAttributes.{
+    scope; locality=local; poly; program=program_mode; hooks;
+    user_warns; typing_flags; using; clearbody; canonical_instance; reversible;
+    } = atts
+  in
+  let hook = vernac_definition_hook ~hooks ~canonical_instance ~local ~poly kind ~reversible in
   let name = vernac_definition_name lid scope in
   ComDefinition.do_definition_refine ~name ?loc:lid.loc
     ?clearbody ~poly ~typing_flags ~scope ~kind:(Decls.IsDefinition kind)
     ?user_warns ?using udecl bl c typ_opt ?hook
 
 let vernac_definition ~atts ~pm (discharge, kind) (lid, udecl) bl red_option c typ_opt =
-  let open DefAttributes in
-  let scope, local, poly, program_mode, user_warns, typing_flags, using, clearbody =
-    atts.scope, atts.locality, atts.poly, atts.program, atts.user_warns, atts.typing_flags, atts.using, atts.clearbody in
-  let canonical_instance, reversible = atts.canonical_instance, atts.reversible in
-  let hook = vernac_definition_hook ~canonical_instance ~local ~poly kind ~reversible in
+  let DefAttributes.{
+    scope; locality=local; poly; program=program_mode; hooks;
+    user_warns; typing_flags; using; clearbody; canonical_instance; reversible;
+    } = atts
+  in
+  let hook = vernac_definition_hook ~hooks ~canonical_instance ~local ~poly kind ~reversible in
   let name = vernac_definition_name lid scope in
   let red_option = match red_option with
     | None -> None
@@ -894,17 +928,23 @@ let vernac_definition ~atts ~pm (discharge, kind) (lid, udecl) bl red_option c t
 
 (* NB: pstate argument to use combinators easily *)
 let vernac_start_proof ~atts kind l =
-  let open DefAttributes in
   if Dumpglob.dump () then
     List.iter (fun ((id, _), _) -> Dumpglob.dump_definition id false "prf") l;
-  let scope, local, poly, program_mode, user_warns, typing_flags, using, clearbody =
-    atts.scope, atts.locality, atts.poly,
-    atts.program, atts.user_warns, atts.typing_flags, atts.using, atts.clearbody in
+  let DefAttributes.{
+    scope; locality=local; poly; program=program_mode;
+    user_warns; typing_flags; using; clearbody; hooks
+    } = atts
+  in
+  (* Run programmable-attribute hooks when the theorem/lemma is completed,
+     just as for [Definition]. The special coercion/canonical hooks of
+     [vernac_definition_hook] do not apply to proofs, so we only fold the
+     attribute-provided hooks. *)
+  let hook = hook_of_hooks hooks in
   List.iter (fun ((id, _), _) -> check_name_freshness scope id) l;
   match l with
   | [] -> assert false
   | [({v=name; loc},udecl),(bl,typ)] ->
-    ComDefinition.do_definition_interactive ?loc
+    ComDefinition.do_definition_interactive ?loc ?hook
       ~typing_flags ~program_mode ~name ~poly ?clearbody ~scope
       ~kind:(Decls.IsProof kind) ?user_warns ?using udecl bl typ
   | ((lid,_),_) :: _ ->
@@ -912,7 +952,7 @@ let vernac_start_proof ~atts kind l =
         { fname; binders; rtype; body_def = None; univs; notations = []}) l in
     let pm, proof =
       ComFixpoint.do_mutually_recursive ~refine:false ~program_mode ~use_inference_hook:program_mode
-        ~scope ?clearbody ~kind:(Decls.IsProof kind) ~poly ?typing_flags
+        ?hook ~scope ?clearbody ~kind:(Decls.IsProof kind) ~poly ?typing_flags
         ?user_warns ?using (CUnknownRecOrder, fix) in
     assert (Option.is_empty pm);
     Option.get proof
@@ -939,9 +979,7 @@ let vernac_exact_proof ~lemma ~pm c =
   pm
 
 let vernac_assumption ~atts kind l inline =
-  let open DefAttributes in
-  let scope, poly, program_mode, using, user_warns =
-    atts.scope, atts.poly, atts.program, atts.using, atts.user_warns in
+  let DefAttributes.{ scope; poly; program=program_mode; using; user_warns; } = atts in
   if Option.has_some using then
     Attributes.unsupported_attributes [CAst.make ("using",VernacFlagEmpty)];
   ComAssumption.do_assumptions ~poly ~program_mode ~scope ~kind ?user_warns ~inline l
@@ -1296,13 +1334,6 @@ let vernac_inductive ~atts kind indl =
 let preprocess_inductive_decl ~atts kind indl =
   snd @@ preprocess_inductive_decl ~atts kind indl
 
-let vernac_fixpoint_common ~atts l =
-  if Dumpglob.dump () then
-    List.iter (fun { fname } -> Dumpglob.dump_definition fname false "def") l;
-  let scope = atts.DefAttributes.scope in
-  List.iter (fun { fname } -> check_name_freshness scope fname) l;
-  scope
-
 let with_obligations program_mode f pm =
   if program_mode then
     f pm ~program_mode:true
@@ -1312,10 +1343,10 @@ let with_obligations program_mode f pm =
     pm, proof
 
 let vernac_fixpoint ~atts ~refine ~pm (rec_order,fixl) =
-  let open DefAttributes in
-  let scope = vernac_fixpoint_common ~atts fixl in
-  let poly, typing_flags, program_mode, clearbody, using, user_warns =
-    atts.poly, atts.typing_flags, atts.program, atts.clearbody, atts.using, atts.user_warns in
+  let DefAttributes.{ scope; poly; typing_flags; program=program_mode; clearbody; using; user_warns; } = atts in
+  if Dumpglob.dump () then
+    List.iter (fun { fname } -> Dumpglob.dump_definition fname false "def") fixl;
+  List.iter (fun { fname } -> check_name_freshness scope fname) fixl;
   let () =
     if program_mode then
       (* XXX: Switch to the attribute system and match on ~atts *)
@@ -1325,18 +1356,11 @@ let vernac_fixpoint ~atts ~refine ~pm (rec_order,fixl) =
     (fun pm -> ComFixpoint.do_mutually_recursive ?pm ~refine ~scope ?clearbody ~kind:(IsDefinition Fixpoint) ~poly ?typing_flags ?user_warns ?using (CFixRecOrder rec_order, fixl))
     pm
 
-let vernac_cofixpoint_common ~atts l =
-  if Dumpglob.dump () then
-    List.iter (fun { fname } -> Dumpglob.dump_definition fname false "def") l;
-  let scope = atts.DefAttributes.scope in
-  List.iter (fun { fname } -> check_name_freshness scope fname) l;
-  scope
-
 let vernac_cofixpoint ~pm ~refine ~atts cofixl =
-  let open DefAttributes in
-  let scope = vernac_cofixpoint_common ~atts cofixl in
-  let poly, typing_flags, program_mode, clearbody, using, user_warns =
-    atts.poly, atts.typing_flags, atts.program, atts.clearbody, atts.using, atts.user_warns in
+  let DefAttributes.{ scope; poly; typing_flags; program=program_mode; clearbody; using; user_warns; } = atts in
+  if Dumpglob.dump () then
+    List.iter (fun { fname } -> Dumpglob.dump_definition fname false "def") cofixl;
+  List.iter (fun { fname } -> check_name_freshness scope fname) cofixl;
   let () =
     if program_mode then
       let opens = List.exists (fun { body_def } -> Option.is_empty body_def) cofixl in
@@ -1422,14 +1446,14 @@ let add_subnames_of ?loc len n ns full_n ref =
     let ns = Array.fold_left_i (fun j ns _ -> add1 (ConstructRef ((mind,i),j+1)) ns)
         ns mip.mind_consnames
     in
-    List.fold_left (fun ns q ->
-        let s = Elimschemes.elimination_suffix q in
+    let suffixes = List.map Elimschemes.elimination_suffix UnivGen.QualityOrSet.all_constants in
+    List.fold_left (fun ns s ->
         let n_elim = Id.of_string (Id.to_string mip.mind_typename ^ s) in
         match importable_extended_global_of_path ?loc (Libnames.add_path_suffix path_prefix n_elim) with
         | exception Not_found -> ns
         | None -> ns
         | Some ref -> (len, ref) :: ns)
-      ns UnivGen.QualityOrSet.all
+      ns suffixes
 
 let interp_names m ns =
   let dp_m = Nametab.path_of_module m in
@@ -1839,7 +1863,7 @@ let vernac_reserve bl =
     let t,ctx = Constrintern.interp_type env sigma c in
     let t =
       let flags = { (PrintingFlags.Detype.current()) with universes = false } in
-      Detyping.detype Detyping.Now ~flags env (Evd.from_ctx ctx) t
+      Detyping.detype Detyping.Now ~flags env (Evd.from_ustate ctx) t
     in
     let t,_ = Notation_ops.notation_constr_of_glob_constr (default_env ()) t in
     Reserve.declare_reserved_type idl t)
@@ -1925,9 +1949,9 @@ let () =
   declare_bool_option
     { optstage = Summary.Stage.Interp;
       optdepr  = None;
-      optkey   = ["Printing";"Compact";"Contexts"];
-      optread  = (fun () -> Printer.get_compact_context());
-      optwrite = (fun b -> Printer.set_compact_context b) }
+      optkey   = ["Kernel"; "Conversion"; "Dep"; "Heuristic"];
+      optread  = (fun () -> (Global.typing_flags ()).Declarations.unfold_dep_heuristic);
+      optwrite = Global.set_unfold_dep_heuristic }
 
 let () =
   declare_int_option
@@ -2017,6 +2041,14 @@ let () =
       optread  = (fun () -> (Global.typing_flags ()).Declarations.check_universes);
       optwrite = (fun b -> Global.set_check_universes b) }
 
+let () =
+  declare_bool_option
+    { optstage = Summary.Stage.Interp;
+      optdepr  = None;
+      optkey   = ["Indices"; "Matter"];
+      optread  = (fun () -> (Global.typing_flags ()).Declarations.indices_matter);
+      optwrite = (fun b -> Global.set_indices_matter b) }
+
 let () =
   declare_bool_option
     { optstage = Summary.Stage.Interp;
@@ -2092,10 +2124,10 @@ let check_may_eval env sigma redexp rc =
       Evarutil.j_nf_evar sigma (Retyping.get_judgment_of env sigma c)
     else
       let env = Evarutil.nf_env_evar sigma env in
-      let env = Environ.push_qualities ~rigid:false (qs, fst csts) env in (* XXX *)
-      let env = Environ.push_context_set (us, snd csts) env in
-      let c = EConstr.to_constr sigma c in
+      let env = Environ.set_qualities (Evd.elim_graph sigma) env in
+      let env = Environ.set_universes (Evd.universes sigma) env in
       let env = Safe_typing.push_private_constants env (Evd.seff_private @@ Evd.eval_side_effects sigma) in
+      let c = EConstr.to_constr sigma c in
       (* OK to call kernel which does not support evars *)
       Environ.on_judgment EConstr.of_constr (Arguments_renaming.rename_typing env c)
   in
@@ -2128,20 +2160,21 @@ let vernac_declare_reduction ~local s r =
   let sigma = Evd.from_env env in
   Redexpr.declare_red_expr local s (snd (Redexpr.interp_redexp_no_ltac env sigma r))
 
-  (* The same but avoiding the current goal context if any *)
+(* The same as Check 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 = Constrintern.intern_constr env sigma c in
   let sigma, c = Pretyping.understand_tcc ~flags:Pretyping.all_and_fail_flags env sigma c in
-  let sigma = Evd.collapse_sort_variables sigma in
-  let senv = Global.safe_env() in
-  let (qs, us), (qcst, ucst) as uctx = Evd.sort_context_set sigma in
-  let senv = Safe_typing.push_qualities ~rigid:false (qs, qcst) senv in (* XXX *)
-  let senv = Safe_typing.push_context_set ~strict:false (us, ucst) senv in
+  let sigma = Evd.collapse_sort_variables ~only_above_prop:false sigma in
   let c = EConstr.to_constr sigma c in
-  let j = Safe_typing.typing senv c in
-  Prettyp.print_safe_judgment j ++
+  let (qs, us), (qcst, ucst) as uctx = Evd.sort_context_set sigma in
+   (* always empty due to collapse *)
+  let () = assert (Sorts.QContextSet.is_empty (qs, qcst)) in
+  let env = Environ.push_context_set ~strict:false (us, ucst) env in
+  let j = Typeops.infer env c in
+  let j = { Environ.uj_val = EConstr.of_constr j.uj_val; uj_type = EConstr.of_constr j.uj_type } in
+  Prettyp.print_judgment env (Evd.from_env env) j ++
   Printer.pr_sort_context_set sigma uctx
 
 
@@ -2192,6 +2225,30 @@ let prglob_without_notations env sigma c =
   let flags = { flags with notations = false } in
   pr_glob_constr_env ~flags env sigma c
 
+let vernac_print_debug_delta qid =
+  let env = Global.env () in
+  let delta = match qid with
+  | None ->
+    let senv = Global.safe_env () in
+    Safe_typing.delta_of_senv senv
+  | Some qid ->
+    match Nametab.locate_modtype qid with
+    | mp ->
+      let mb = Global.lookup_modtype mp in
+      Mod_declarations.mod_delta mb
+    | exception Not_found ->
+      match Nametab.locate_module qid with
+      | mp ->
+        let mb = Global.lookup_module mp in
+        Mod_declarations.mod_delta mb
+      | exception Not_found ->
+        CErrors.user_err Pp.(str "Unknown module or module type " ++ pr_qualid qid)
+  in
+  let prc c =
+    Printer.pr_lconstr_env env (Evd.from_env env) c.UVars.univ_abstracted_value
+  in
+  Mod_subst.debug_pr_delta prc delta
+
 let vernac_print =
   let no_state f =
     Vernactypes.(typed_vernac_gen ignore_state (fun _ -> no_state, f ()))
@@ -2222,8 +2279,8 @@ let vernac_print =
     Prettyp.print_sec_context_typ env sigma qid
   | PrintInspect n -> with_proof_env @@ fun env sigma ->
     Prettyp.inspect env sigma n
-  | PrintGrammar ent -> no_state @@ fun () -> Metasyntax.pr_grammar ent
-  | PrintCustomGrammar ent -> no_state @@ fun () -> Metasyntax.pr_custom_grammar ent
+  | PrintGrammar {flatten; ent} -> no_state @@ fun () -> Metasyntax.pr_grammar ~flatten ent
+  | PrintCustomGrammar {flatten; ent} -> no_state @@ fun () -> Metasyntax.pr_custom_grammar ~flatten ent
   | PrintKeywords -> no_state Metasyntax.pr_keywords
   | PrintLoadPath dir -> (* For compatibility ? *) no_state @@ fun () -> print_loadpath dir
   | PrintLibraries -> no_state print_libraries
@@ -2235,8 +2292,11 @@ let vernac_print =
     v 0 (prlist_with_sep cut str paths )
   | PrintMLModules -> no_state Mltop.print_ml_modules
   | PrintDebugGC -> no_state Mltop.print_gc
-  | PrintName (qid,udecl) -> with_proof_env_and_opaques @@ fun ~opaque_access env sigma ->
-    Prettyp.print_name opaque_access env sigma qid udecl
+  | PrintDebugDelta qid -> no_state @@ fun () -> vernac_print_debug_delta qid
+  | PrintName (items) -> with_proof_env_and_opaques @@ fun ~opaque_access env sigma ->
+    let pp_one (qid,udecl) =
+      Prettyp.print_name opaque_access env sigma qid udecl
+    in prlist_with_sep (fun () -> fnl () ++ fnl ()) pp_one items
   | PrintGraph -> no_state Prettyp.print_graph
   | PrintClasses -> no_state Prettyp.print_classes
   | PrintTypeclasses -> no_state Prettyp.print_typeclasses
@@ -2272,8 +2332,11 @@ let vernac_print =
     Notation.pr_scope (prglob_without_notations env sigma) s
   | PrintVisibility s -> with_proof_env @@ fun env sigma ->
     Notation.pr_visibility (prglob_without_notations env sigma) s
-  | PrintAbout (ref_or_by_not,udecl,glnumopt) -> with_pstate @@
-    print_about_hyp_globs ref_or_by_not udecl glnumopt
+  | PrintAbout (items, glnumopt) -> with_pstate @@ fun ~pstate ->
+    let pp_one (ref_or_by_not, udecl) =
+      print_about_hyp_globs ~pstate ref_or_by_not udecl glnumopt
+    in
+    prlist_with_sep (fun () -> fnl () ++ fnl ()) pp_one items
   | PrintImplicit qid -> with_proof_env @@ fun env _sigma ->
     Prettyp.print_impargs env (smart_global qid)
   | PrintAssumptions (o,t,rs) -> with_proof_env_and_opaques @@ fun ~opaque_access env sigma ->
@@ -2333,8 +2396,6 @@ let vernac_register ~atts qid r =
     let ns, id = Libnames.repr_qualid n in
     if DirPath.equal (dirpath_of_string "kernel") ns then begin
       unsupported_attributes atts;
-      if Lib.sections_are_opened () then
-        user_err Pp.(str "Registering a kernel type is not allowed in sections.");
       let CPrimitives.PIE pind = match Id.to_string id with
         | "ind_bool" -> CPrimitives.(PIE PIT_bool)
         | "ind_carry" -> CPrimitives.(PIE PIT_carry)
@@ -2351,7 +2412,7 @@ let vernac_register ~atts qid r =
     else
       let local = Attributes.parse hint_locality_default_superglobal atts in
       Rocqlib.register_ref local (Libnames.string_of_qualid n) gr
-  | RegisterScheme { inductive; scheme_kind } ->
+  | RegisterScheme { ref; scheme_kind } ->
     let local = Attributes.parse hint_locality_default_superglobal atts in
     let scheme_kind_s = Libnames.string_of_qualid scheme_kind in
     (* Specific test for the All and AllForall keys, as there are an infinite number of them *)
@@ -2366,9 +2427,9 @@ let vernac_register ~atts qid r =
           || test_all "All_" scheme_kind_s || test_all "AllForall_" scheme_kind_s) then
       warn_unknown_scheme_kind ?loc:scheme_kind.loc scheme_kind
     in
-    let ind = Smartlocate.global_inductive_with_alias inductive in
-    Dumpglob.add_glob ?loc:inductive.loc (IndRef ind);
-    DeclareScheme.declare_scheme local scheme_kind_s (ind, gr)
+    let key = Smartlocate.global_with_alias ref in
+    Dumpglob.add_glob ?loc:ref.loc key;
+    DeclareScheme.declare_scheme local scheme_kind_s (key, gr)
 
 let vernac_library_attributes atts =
   if Global.is_curmod_library () && not (Lib.sections_are_opened ()) then
@@ -2501,11 +2562,64 @@ let vernac_validate_proof ~pstate =
       (Evd.undefined_map sigma)
       (Evd.undefined_map sigma')
   in
+  let missing_qcsts, missing_ucsts =
+    let ustate = Evd.ustate sigma in
+    let ugraph = UState.ugraph ustate in
+    let qgraph = UState.elim_graph ustate in
+    let (qs, us), (qcsts, ucsts) = UState.sort_context_set ustate in
+    let ustate' = Evd.ustate sigma' in
+    let (qs', us'), (qcsts', ucsts') = UState.sort_context_set ustate' in
+
+    (* is it actually possible to have new univs or qualities? *)
+    let _, ucsts' = UState.restrict_universe_context (us',ucsts') us in
+    let missing_ucsts =
+      Univ.UnivConstraints.filter (fun cst -> not @@ UGraph.check_constraint ugraph cst) ucsts'
+    in
+    let missing_ucsts =
+      let nf u = match Univ.Universe.level (UState.nf_universe ustate (Univ.Universe.make u)) with
+        | None -> u
+        | Some u -> u
+      in
+      Univ.UnivConstraints.map (fun (u1,k,u2) -> nf u1, k, nf u2) missing_ucsts
+    in
+
+    let qcsts' = QGraph.constraints_for ~kept:(QGraph.domain qgraph) (UState.elim_graph ustate') in
+    let missing_qcsts =
+      Sorts.ElimConstraints.filter (fun cst -> not @@ QGraph.check_constraint qgraph cst) qcsts'
+    in
+    let missing_qcsts = Sorts.ElimConstraints.map (fun (q1,k,q2) ->
+        UState.nf_quality ustate q1, k, UState.nf_quality ustate q2)
+        missing_qcsts
+    in
+
+    missing_qcsts, missing_ucsts
+  in
   (* TODO check ustate *)
 
-  if Evar.Map.is_empty evar_issues then
-    str "No issues found."
-  else prlist_with_sep fnl snd (Evar.Map.bindings evar_issues)
+  if Evar.Map.is_empty evar_issues &&
+     Univ.UnivConstraints.is_empty missing_ucsts &&
+     Sorts.ElimConstraints.is_empty missing_qcsts then
+    Feedback.msg_notice @@ str "No issues found."
+  else
+    let pp_us =
+      if Univ.UnivConstraints.is_empty missing_ucsts then mt()
+      else
+        hov 2
+          (str "Missing universe constraints:" ++ spc() ++
+           Univ.UnivConstraints.pr (Termops.pr_evd_level sigma) missing_ucsts)
+    in
+    let pp_qs =
+      if Sorts.ElimConstraints.is_empty missing_qcsts then mt()
+      else
+        hov 2
+          (str "Missing elimination constraints:" ++ spc() ++
+           Sorts.ElimConstraints.pr (Evd.quality_printer sigma) missing_qcsts)
+    in
+    let msg =
+      prlist_with_sep fnl snd (Evar.Map.bindings evar_issues) ++ fnl() ++
+      pp_us ++ fnl() ++ pp_qs
+    in
+    CErrors.user_err msg
 
 let vernac_proof pstate tac using =
   let is_let = match Declare.Proof.definition_scope pstate with
@@ -2519,12 +2633,23 @@ let vernac_proof pstate tac using =
       in
       None
   in
+  let () = match Declare.Proof.has_late_init pstate with
+    | None | Some NotRequired -> ()
+    (* currently Next Obligation is accepted both with and without following Proof
+       not sure we want to keep it that way
+       also not sure how well Proof using works with obligations *)
+    | Some Explicit ->
+      CErrors.user_err Pp.(str "Multiple \"Proof\" commands not supported.")
+    | Some Implicit ->
+      CErrors.user_err Pp.(str "\"Proof\" must be the first command in an interactive proof.")
+  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 "VernacProof" (tacs^" "^usings);
   let pstate = Option.fold_left vernac_set_end_tac pstate tac in
   let set_proof_using ps using = Declare.Proof.set_proof_using ps using |> snd in
   let pstate = Option.fold_left set_proof_using pstate using in
+  let pstate = Declare.Proof.finish_late_init pstate Explicit in
   pstate
 
 let translate_vernac_synterp ?loc ~atts v = let open Vernactypes in match v with
@@ -2633,7 +2758,7 @@ let translate_pure_vernac ?loc ~atts v = let open Vernactypes in match v with
   | VernacStartTheoremProof (k,l) ->
     vtopenproof(fun () -> with_def_attributes ~atts vernac_start_proof k l)
   | VernacExactProof c ->
-    vtcloseproof (fun ~lemma ->
+    vtcloseproof ~check_late_init:false (fun ~lemma ->
         unsupported_attributes atts;
         vernac_exact_proof ~lemma c)
 
@@ -2711,8 +2836,8 @@ let translate_pure_vernac ?loc ~atts v = let open Vernactypes in match v with
 
   | VernacAddRewRule (id, c) ->
     vtdefault (fun () ->
-        unsupported_attributes atts;
-        ComRewriteRule.do_rules id.v c)
+        let collapse_sort_variables = Option.default true @@ Attributes.(parse collapse_sort_variables) atts in
+        ComRewriteRule.do_rules ~collapse_sort_variables id.v c)
 
   (* Gallina extensions *)
 
@@ -2899,9 +3024,9 @@ let translate_pure_vernac ?loc ~atts v = let open Vernactypes in match v with
   | VernacValidateProof ->
     vtreadproof(fun ~pstate ->
         unsupported_attributes atts;
-        Feedback.msg_notice @@ vernac_validate_proof ~pstate)
+        vernac_validate_proof ~pstate)
   | VernacProof (tac, using) ->
-    vtmodifyproof(fun ~pstate ->
+    vtmodifyproof ~check_late_init:false (fun ~pstate ->
     unsupported_attributes atts;
     vernac_proof pstate tac using)
 
@@ -2911,7 +3036,7 @@ let translate_pure_vernac ?loc ~atts v = let open Vernactypes in match v with
 
   | VernacAbort ->
     unsupported_attributes atts;
-    vtcloseproof vernac_abort
+    vtcloseproof ~check_late_init:false vernac_abort
 
 let translate_vernac ?loc ~atts v =
   match v with
diff --git a/vernac/vernacentries.mli b/vernac/vernacentries.mli
index dd6f7c10df4b..284499a9908e 100644
--- a/vernac/vernacentries.mli
+++ b/vernac/vernacentries.mli
@@ -73,6 +73,7 @@ val preprocess_inductive_decl
 module DefAttributes : sig
 
 type t = {
+  hooks : Declare.Hook.t list ;
   scope : Locality.definition_scope;
   locality : bool option;
   poly : PolyFlags.t;
@@ -85,6 +86,9 @@ type t = {
   clearbody: bool option;
 }
 
+module Observer : Summary.OBSERVABLE
+  with type value = unit Declare.Hook.g list Attributes.attribute
+
 val def_attributes : t Attributes.attribute
 
 end
diff --git a/vernac/vernacexpr.mli b/vernac/vernacexpr.mli
index 5ac95d8bcedf..1ba20ec8bdb5 100644
--- a/vernac/vernacexpr.mli
+++ b/vernac/vernacexpr.mli
@@ -42,8 +42,8 @@ type printable =
   | PrintFullContext
   | PrintSectionContext of qualid
   | PrintInspect of int
-  | PrintGrammar of string list
-  | PrintCustomGrammar of qualid
+  | PrintGrammar of { flatten : bool; ent : string list }
+  | PrintCustomGrammar of { flatten : bool; ent : qualid }
   | PrintKeywords
   | PrintLoadPath of DirPath.t option
   | PrintLibraries
@@ -53,7 +53,8 @@ type printable =
   | PrintMLLoadPath
   | PrintMLModules
   | PrintDebugGC
-  | PrintName of qualid or_by_notation * UnivNames.full_name_list option
+  | PrintDebugDelta of qualid option
+  | PrintName of (qualid or_by_notation * UnivNames.univ_name_list option) list
   | PrintGraph
   | PrintClasses
   | PrintTypeclasses
@@ -70,7 +71,7 @@ type printable =
   | PrintScopes
   | PrintScope of string
   | PrintVisibility of string option
-  | PrintAbout of qualid or_by_notation * UnivNames.full_name_list option * Goal_select.t option
+  | PrintAbout of (qualid or_by_notation * UnivNames.univ_name_list option) list * Goal_select.t option
   | PrintImplicit of qualid or_by_notation
   | PrintAssumptions of bool * bool * qualid or_by_notation list
   | PrintStrategy of qualid or_by_notation option
@@ -304,7 +305,7 @@ type section_subset_expr =
 type register_kind =
   | RegisterInline
   | RegisterCoqlib of qualid
-  | RegisterScheme of { inductive : qualid; scheme_kind : qualid }
+  | RegisterScheme of { ref : qualid; scheme_kind : qualid }
 
 (** {6 Types concerning the module layer} *)
 
@@ -528,6 +529,7 @@ type control_flag_r =
   | ControlProfile of string option
   | ControlRedirect of string
   | ControlTimeout of int
+  | ControlAllocLimit of Control.kilowords
   | ControlFail
   | ControlSucceed
 
diff --git a/vernac/vernacinterp.ml b/vernac/vernacinterp.ml
index 1855b8d60f3c..1756496b37dc 100644
--- a/vernac/vernacinterp.ml
+++ b/vernac/vernacinterp.ml
@@ -77,7 +77,7 @@ and interp_expr_core ?loc ~atts ~st c =
     let fv = Vernacentries.translate_vernac ?loc ~atts v in
     let stack = st.Vernacstate.interp.lemmas in
     let program = st.Vernacstate.interp.program in
-    let {Vernactypes.prog; proof; opaque_access=(); }, () = Vernactypes.run fv {
+    let {Vernactypes.prog; proof; opaque_access=(); }, () = Vernactypes.run ?loc fv {
         prog=program;
         proof=stack;
         opaque_access=();
diff --git a/vernac/vernactypes.ml b/vernac/vernactypes.ml
index 68121bd05d49..de650bdabcf1 100644
--- a/vernac/vernactypes.ml
+++ b/vernac/vernactypes.ml
@@ -6,7 +6,7 @@
     The additional return data ['d] is useful when combining runners.
     We don't need an additional input data as it can just go in the closure.
 *)
-type ('a,'b,'x) runner = { run : 'd. 'x -> ('a -> 'b * 'd) -> 'x * 'd }
+type ('a,'b,'x) runner = { run : 'd. ?loc:Loc.t -> 'x -> ('a -> 'b * 'd) -> 'x * 'd }
 
 
 module Prog = struct
@@ -22,7 +22,7 @@ module Prog = struct
     | Pop : (state, unit) t
 
   let runner (type a b) (ty:(a,b) t) : (a,b,stack) runner =
-    { run = fun pm f ->
+    { run = fun ?loc pm f ->
       match ty with
       | Ignore -> let (), v = f () in pm, v
       | Modify ->
@@ -52,23 +52,40 @@ module Proof = struct
 
   type (_,_) t =
     | Ignore : (unit, unit) t
-    | Modify : (state, state) t
+    | Modify : { check_late_init : bool } -> (state, state) t
     | Read : (state, unit) t
     | ReadOpt : (state option, unit) t
     | Reject : (unit, unit) t
-    | Close : (state, unit) t
+    | Close : { check_late_init : bool } -> (state, unit) t
     | Open : (unit, state) t
 
   let use = function
     | None -> CErrors.user_err (Pp.str "Command not supported (No proof-editing in progress).")
     | Some stack -> LStack.pop stack
 
+  let quickfix_missing_proof ~loc () =
+    (* quickfix is purely additive so the loc is 0 characters long, at the beginning of the command. *)
+    let loc = { loc with Loc.ep = loc.Loc.bp } in
+    [Quickfix.make ~loc Pp.(str "Proof." ++ fnl())]
+
+  let warn_missing_proof = CWarnings.create ~name:"missing-proof-command" ~category:CWarnings.CoreCategories.fragile
+      ~quickfix:quickfix_missing_proof
+      Pp.(fun () -> str "This interactive proof is not started by the \"Proof\" command.")
+
+  let check_late_init ?loc p =
+    if Option.has_some @@ Declare.Proof.has_late_init p then p
+    else begin
+      warn_missing_proof ?loc ();
+      Declare.Proof.finish_late_init p Implicit
+    end
+
   let runner (type a b) (ty:(a,b) t) : (a,b,stack) runner =
-    { run = fun stack f ->
+    { run = fun ?loc stack f ->
       match ty with
       | Ignore -> let (), v = f () in stack, v
-      | Modify ->
+      | Modify o ->
         let p, rest = use stack in
+        let p = if o.check_late_init then check_late_init ?loc p else p in
         let p, v = f p in
         Some (LStack.push rest p), v
       | Read ->
@@ -85,8 +102,9 @@ module Proof = struct
         in
         let (), v = f () in
         stack, v
-      | Close ->
+      | Close o ->
         let p, rest = use stack in
+        let p = if o.check_late_init then check_late_init ?loc p else p in
         let (), v = f p in
         rest, v
       | Open ->
@@ -109,7 +127,7 @@ module OpaqueAccess = struct
   let access = Library.indirect_accessor[@@warning "-3"]
 
   let runner (type a) (ty:a t) : (a,unit,unit) runner =
-    { run = fun () f ->
+    { run = fun ?loc () f ->
       match ty with
       | Ignore -> let (), v = f () in (), v
       | Access -> let (), v = f access in (), v
@@ -120,9 +138,9 @@ end
 (* lots of messing with tuples in there, can we do better? *)
 let combine_runners (type a b x c d y) (r1:(a,b,x) runner) (r2:(c,d,y) runner)
   : (a*c, b*d, x*y) runner
-  = { run = fun (x,y) f ->
-      match r1.run x @@ fun x ->
-        match r2.run y @@ fun y ->
+  = { run = fun ?loc (x,y) f ->
+      match r1.run ?loc x @@ fun x ->
+        match r2.run ?loc y @@ fun y ->
           match f (x,y)
           with ((b, d), o) -> (d, (b, o))
         with (y, (b, o)) -> (b, (y, o))
@@ -157,10 +175,10 @@ type typed_vernac = unit typed_vernac_gen
 
 type full_state = (Prog.stack,Vernacstate.LemmaStack.t option,unit) state_gen
 
-let run (TypedVernac { spec = { prog; proof; opaque_access }; run }) (st:full_state) : full_state * _ =
+let run ?loc (TypedVernac { spec = { prog; proof; opaque_access }; run }) (st:full_state) : full_state * _ =
   let ( * ) = combine_runners in
   let runner = Prog.runner prog * Proof.runner proof * OpaqueAccess.runner opaque_access in
-  let st, v = runner.run (tuple st) @@ fun st ->
+  let st, v = runner.run ?loc (tuple st) @@ fun st ->
     let st, v= run @@ untuple st in tuple st, v
   in
   untuple st, v
@@ -175,13 +193,15 @@ let vtdefault f = typed_vernac ignore_state
 let vtnoproof f = typed_vernac { ignore_state with proof = Reject }
     (fun (_:no_state) -> let () = f () in no_state)
 
-let vtcloseproof f = typed_vernac { ignore_state with prog = Modify; proof = Close }
+let vtcloseproof ?(check_late_init=true) f =
+  typed_vernac { ignore_state with prog = Modify; proof = Close { check_late_init } }
     (fun {prog; proof} -> let prog = f ~lemma:proof ~pm:prog in { no_state with prog })
 
 let vtopenproof f = typed_vernac { ignore_state with proof = Open }
     (fun (_:no_state) -> let proof = f () in { no_state with proof })
 
-let vtmodifyproof f = typed_vernac { ignore_state with proof = Modify }
+let vtmodifyproof ?(check_late_init=true) f =
+  typed_vernac { ignore_state with proof = Modify { check_late_init } }
     (fun {proof} -> let proof = f ~pstate:proof in { no_state with proof })
 
 let vtreadproofopt f = typed_vernac { ignore_state with proof = ReadOpt }
diff --git a/vernac/vernactypes.mli b/vernac/vernactypes.mli
index b92aa90c5193..7488e8f6b847 100644
--- a/vernac/vernactypes.mli
+++ b/vernac/vernactypes.mli
@@ -26,11 +26,11 @@ module Proof : sig
 
   type (_,_) t =
     | Ignore : (unit, unit) t
-    | Modify : (state, state) t
+    | Modify : { check_late_init : bool } -> (state, state) t
     | Read : (state, unit) t
     | ReadOpt : (state option, unit) t
     | Reject : (unit, unit) t
-    | Close : (state, unit) t
+    | Close : { check_late_init : bool } -> (state, unit) t
     | Open : (unit, state) t
 end
 
@@ -77,15 +77,15 @@ val typed_vernac
 
 type full_state = (Prog.stack, Vernacstate.LemmaStack.t option, unit) state_gen
 
-val run : 'r typed_vernac_gen -> full_state -> full_state * 'r
+val run : ?loc:Loc.t -> 'r typed_vernac_gen -> full_state -> full_state * 'r
 
 (** Some convenient typed_vernac constructors. Used by coqpp. *)
 
 val vtdefault : (unit -> unit) -> typed_vernac
 val vtnoproof : (unit -> unit) -> typed_vernac
-val vtcloseproof : (lemma:Declare.Proof.t -> pm:Declare.OblState.t -> Declare.OblState.t) -> typed_vernac
+val vtcloseproof : ?check_late_init:bool -> (lemma:Declare.Proof.t -> pm:Declare.OblState.t -> Declare.OblState.t) -> typed_vernac
 val vtopenproof : (unit -> Declare.Proof.t) -> typed_vernac
-val vtmodifyproof : (pstate:Declare.Proof.t -> Declare.Proof.t) -> typed_vernac
+val vtmodifyproof : ?check_late_init:bool -> (pstate:Declare.Proof.t -> Declare.Proof.t) -> typed_vernac
 val vtreadproofopt : (pstate:Declare.Proof.t option -> unit) -> typed_vernac
 val vtreadproof : (pstate:Declare.Proof.t -> unit) -> typed_vernac
 val vtreadprogram : (pm:Declare.OblState.t -> unit) -> typed_vernac