From a551165587b844167f3f27a56db8e43cfa0bc8bb Mon Sep 17 00:00:00 2001
From: Jan-Oliver Kaiser <janno@bedrocksystems.com>
Date: Fri, 31 Jan 2025 13:03:22 +0100
Subject: [PATCH 001/578] Support primitive operations in old and new
 unification.

---
 .../04-tactics/20175-janno-unif-red-prim.rst  |  6 +++++
 pretyping/evarconv.ml                         | 27 ++++++++++++++++++-
 pretyping/unification.ml                      | 23 ++++++++++++++++
 test-suite/bugs/bug_18259.v                   | 10 +++++++
 test-suite/bugs/bug_20155.v                   | 19 +++++++++++++
 5 files changed, 84 insertions(+), 1 deletion(-)
 create mode 100644 doc/changelog/04-tactics/20175-janno-unif-red-prim.rst
 create mode 100644 test-suite/bugs/bug_18259.v
 create mode 100644 test-suite/bugs/bug_20155.v

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 <https://github.com/coq/coq/pull/20175>`_,
+  fixes `#18259 <https://github.com/coq/coq/issues/18259>`_
+  and `#20155 <https://github.com/coq/coq/issues/20155>`_,
+  by Jan-Oliver Kaiser).
diff --git a/pretyping/evarconv.ml b/pretyping/evarconv.ml
index 3ab8afd955a0..9952dc976236 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
diff --git a/pretyping/unification.ml b/pretyping/unification.ml
index 438529435e60..d9fd63fffc72 100644
--- a/pretyping/unification.ml
+++ b/pretyping/unification.ml
@@ -812,6 +812,29 @@ let expand_table_key ~metas ts env sigma args = function
         | def ->
         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
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_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.

From 982b0827762952c522f25cb006939344bc5ff1d2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Wed, 29 Oct 2025 17:53:22 +0100
Subject: [PATCH 002/578] Bake the NonLogical run in Logic_monad.run.

There is no real point in exposing this implementation detail, all callers
immediately evaluate the resulting thunk.
---
 engine/logic_monad.ml  | 10 +++++-----
 engine/logic_monad.mli |  4 ++--
 engine/proofview.ml    | 16 ++++++++--------
 3 files changed, 15 insertions(+), 15 deletions(-)

diff --git a/engine/logic_monad.ml b/engine/logic_monad.ml
index 1b7f2799e241..7d664a41ead8 100644
--- a/engine/logic_monad.ml
+++ b/engine/logic_monad.ml
@@ -243,10 +243,10 @@ 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 = ('a, ('a, 'e) reified_, 'e) list_view_
+  and ('a, 'e) reified_ = {r : 'e -> ('a, 'e) reified NonLogical.t} [@@unboxed]
 
-  let rec reflect (m : ('a * 'o, 'e) reified) =
+  let rec reflect (m : ('a * 'o, 'e) reified NonLogical.t) =
     { iolist = fun s0 nil cons ->
       let next = function
       | Nil e -> nil e
@@ -273,7 +273,7 @@ struct
       let p = (x, s) in
       NonLogical.return (Cons (p, {r=l}))
     in
-    m.iolist s rnil rcons
+    m.iolist s rnil rcons ()
 
   let repr x = x
 end
@@ -385,6 +385,6 @@ struct
       let p = (x, s.sstate, s.wstate, s.ustate) in
       NonLogical.return (Cons (p, {r=l}))
     in
-    m.iolist s rnil rcons
+    m.iolist s rnil rcons ()
 
  end
diff --git a/engine/logic_monad.mli b/engine/logic_monad.mli
index 5801f0121a4f..0d3bb9813cfb 100644
--- a/engine/logic_monad.mli
+++ b/engine/logic_monad.mli
@@ -148,7 +148,7 @@ module BackState : sig
   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
 
@@ -204,7 +204,7 @@ module Logical (P:Param) : sig
   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/proofview.ml b/engine/proofview.ml
index cb442d4d9a2d..5ccbb7904cd9 100644
--- a/engine/proofview.ml
+++ b/engine/proofview.ml
@@ -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} *)
 
@@ -1022,7 +1022,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)

From dd3766ec035c8c2ad3b01e9663c5cc15d59fd4d2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Wed, 29 Oct 2025 18:13:53 +0100
Subject: [PATCH 003/578] Collapse NonLogical thunks in the logic monad.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

We leverage the fact that a ~> unit -> b ≅ a -> b where ~> stands
for a hypothetical pure arrow type. This allows replacing all
instances of the NonLogical.t monad in the logic monad type with
basically nothing, leaving effects implicits in the rightmost
arrow type. Since all clients evaluate the thunk directly, the
new code should be equivalent to the previous one.

Actually, it may even be more correct given that we already
implicitly use the function space in the monadic bind operator
to perform side-effects.
---
 engine/logic_monad.ml | 59 ++++++++++++++++++++++++++-----------------
 1 file changed, 36 insertions(+), 23 deletions(-)

diff --git a/engine/logic_monad.ml b/engine/logic_monad.ml
index 7d664a41ead8..bcaac2194299 100644
--- a/engine/logic_monad.ml
+++ b/engine/logic_monad.ml
@@ -182,9 +182,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 }
@@ -210,7 +224,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 *)
 
@@ -244,36 +258,35 @@ 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_
-  and ('a, 'e) reified_ = {r : 'e -> ('a, 'e) reified NonLogical.t} [@@unboxed]
+  and ('a, 'e) reified_ = {r : 'e -> ('a, 'e) reified} [@@unboxed]
 
-  let rec reflect (m : ('a * 'o, 'e) reified NonLogical.t) =
-    { iolist = fun s0 nil cons ->
-      let next = function
+  let rec reflect0 : type r. _ -> _ -> _ -> (_ -> r) -> (_ -> _ -> (_ -> r) -> r) -> r =
+    fun e m s0 nil cons ->
+      match m e 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), {r=l}) -> cons x s (fun e -> reflect0 e l s0 nil cons)
+
+  let reflect (e : 'e) (m : 'e -> ('a * 'o, 'e) reified) =
+    { iolist = fun s0 nil cons -> reflect0 e m s0 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), {r=l}) 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}) ->
-        let l e = reflect (l e) in
+        let l e = reflect e l in
         cons (Cons (x, l)) s nil
       end }
 
   let run m s =
-    let rnil e = NonLogical.return (Nil e) in
+    let rnil e = Nil e in
     let rcons x s l =
       let p = (x, s) in
-      NonLogical.return (Cons (p, {r=l}))
+      Cons (p, {r=l})
     in
-    m.iolist s rnil rcons ()
+    m.iolist s rnil rcons
 
   let repr x = x
 end
@@ -380,11 +393,11 @@ 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 = Nil e in
     let rcons x s l =
       let p = (x, s.sstate, s.wstate, s.ustate) in
-      NonLogical.return (Cons (p, {r=l}))
+      Cons (p, {r=l})
     in
-    m.iolist s rnil rcons ()
+    m.iolist s rnil rcons
 
  end

From 177535bea58b25e3ab8bc81a84d9c1c20cc6a0c5 Mon Sep 17 00:00:00 2001
From: ia0 <git@ia0.eu>
Date: Mon, 24 Nov 2025 12:53:39 +0100
Subject: [PATCH 004/578] Use levels for associativity in refman

Follows #21126. Reverts #21071. Fixes #21029 and #21072.
---
 coqpp/coqpp_ast.mli                           |  1 +
 coqpp/coqpp_lex.mll                           |  1 +
 coqpp/coqpp_main.ml                           |  1 +
 coqpp/coqpp_parse.mly                         |  3 +-
 doc/sphinx/language/core/definitions.rst      |  8 ++---
 doc/sphinx/language/core/variants.rst         |  2 +-
 doc/sphinx/proof-engine/ltac.rst              |  4 +--
 doc/sphinx/proof-engine/ltac2.rst             | 12 ++++----
 .../proofs/writing-proofs/proof-mode.rst      |  4 +--
 doc/tools/docgram/common.edit_mlg             | 28 ++++++++---------
 doc/tools/docgram/doc_grammar.ml              | 18 +++++++----
 doc/tools/docgram/fullGrammar                 | 30 +++++++++----------
 doc/tools/docgram/orderedGrammar              | 30 +++++++++----------
 13 files changed, 76 insertions(+), 66 deletions(-)

diff --git a/coqpp/coqpp_ast.mli b/coqpp/coqpp_ast.mli
index 149260db3a96..f1f566806083 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
diff --git a/coqpp/coqpp_lex.mll b/coqpp/coqpp_lex.mll
index 87fcfe95618e..36008855f1e7 100644
--- a/coqpp/coqpp_lex.mll
+++ b/coqpp/coqpp_lex.mll
@@ -129,6 +129,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 7ce25529520c..b5e182812d37 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
diff --git a/coqpp/coqpp_parse.mly b/coqpp/coqpp_parse.mly
index 27dfa1b67a67..2ccb4f8b9a1f 100644
--- a/coqpp/coqpp_parse.mly
+++ b/coqpp/coqpp_parse.mly
@@ -72,7 +72,7 @@ let rhs_loc n =
 %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
 
@@ -381,6 +381,7 @@ assoc:
 | LEFTA { LeftA }
 | RIGHTA { RightA }
 | NONA { NonA }
+| BOTHA { BothA }
 ;
 
 levels:
diff --git a/doc/sphinx/language/core/definitions.rst b/doc/sphinx/language/core/definitions.rst
index 3683e4c1c2df..fc4634bbe321 100644
--- a/doc/sphinx/language/core/definitions.rst
+++ b/doc/sphinx/language/core/definitions.rst
@@ -40,10 +40,10 @@ Type cast
 .. insertprodn term_cast term_cast
 
 .. prodn::
-   term_cast ::= @term100 <: @type
-   | @term100 <<: @type
-   | @term100 :> @type
-   | @term100 : @type
+   term_cast ::= @term10 <: @type
+   | @term10 <<: @type
+   | @term10 :> @type
+   | @term10 : @type
 
 The expression :n:`@term10 : @type` is a type cast expression. It enforces
 the type of :n:`@term10` to be :n:`@type`.
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/proof-engine/ltac.rst b/doc/sphinx/proof-engine/ltac.rst
index d19dd63869f3..311c4304bfdb 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
diff --git a/doc/sphinx/proof-engine/ltac2.rst b/doc/sphinx/proof-engine/ltac2.rst
index e7d287f92cdc..f4d7d3dbaefc 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
@@ -228,14 +228,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 )
@@ -1226,7 +1226,7 @@ Match on values
       tac2pat3 ::= @tac2pat3 %| {+| @tac2pat2 }
       | @tac2pat3 as @ident
       | @tac2pat2
-      tac2pat2 ::= @tac2pat2 :: @tac2pat2
+      tac2pat2 ::= @tac2pat1 :: @tac2pat2
       | @tac2pat1
       tac2pat1 ::= @qualid {+ @tac2pat0 }
       | @qualid
diff --git a/doc/sphinx/proofs/writing-proofs/proof-mode.rst b/doc/sphinx/proofs/writing-proofs/proof-mode.rst
index 9e71a4c085e9..24b725acbd60 100644
--- a/doc/sphinx/proofs/writing-proofs/proof-mode.rst
+++ b/doc/sphinx/proofs/writing-proofs/proof-mode.rst
@@ -284,8 +284,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
       | ()
diff --git a/doc/tools/docgram/common.edit_mlg b/doc/tools/docgram/common.edit_mlg
index 8f60d508a553..e04448ac919c 100644
--- a/doc/tools/docgram/common.edit_mlg
+++ b/doc/tools/docgram/common.edit_mlg
@@ -342,18 +342,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: [
@@ -2003,8 +2003,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 *)
 ]
 
diff --git a/doc/tools/docgram/doc_grammar.ml b/doc/tools/docgram/doc_grammar.ml
index e576ef41bc06..015939cff2ca 100644
--- a/doc/tools/docgram/doc_grammar.ml
+++ b/doc/tools/docgram/doc_grammar.ml
@@ -482,8 +482,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 +493,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 +507,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 +614,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 +628,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]]
diff --git a/doc/tools/docgram/fullGrammar b/doc/tools/docgram/fullGrammar
index c68f0d979186..db330c96c16f 100644
--- a/doc/tools/docgram/fullGrammar
+++ b/doc/tools/docgram/fullGrammar
@@ -75,10 +75,10 @@ term200: [
 ]
 
 term100: [
-| term100 "<:" term200
-| term100 "<<:" term200
-| term100 ":>" term200
-| term100 ":" term200
+| term99 "<:" term200
+| term99 "<<:" term200
+| term99 ":>" term200
+| term99 ":" term200
 | term99
 ]
 
@@ -261,7 +261,7 @@ pattern200: [
 ]
 
 pattern100: [
-| pattern100 ":" term200
+| pattern99 ":" term200
 | pattern99
 ]
 
@@ -1296,8 +1296,8 @@ ssexpr35: [
 ]
 
 ssexpr50: [
-| ssexpr50 "-" ssexpr0
-| ssexpr50 "+" ssexpr0
+| ssexpr0 "-" ssexpr0
+| ssexpr0 "+" ssexpr0
 | ssexpr0
 ]
 
@@ -2195,9 +2195,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
 ]
 
@@ -2693,7 +2693,7 @@ tac2pat3: [
 ]
 
 tac2pat2: [
-| tac2pat2 "::" tac2pat2      (* ltac2 plugin *)
+| tac2pat1 "::" tac2pat2      (* ltac2 plugin *)
 | tac2pat1      (* ltac2 plugin *)
 ]
 
@@ -2722,7 +2722,7 @@ atomic_tac2pat: [
 ]
 
 ltac2_expr6: [
-| ltac2_expr6 ";" ltac2_expr6      (* ltac2 plugin *)
+| ltac2_expr5 ";" ltac2_expr6      (* ltac2 plugin *)
 | ltac2_expr5      (* ltac2 plugin *)
 ]
 
@@ -2739,12 +2739,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 *)
 ]
 
@@ -2835,12 +2835,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 *)
 ]
 
diff --git a/doc/tools/docgram/orderedGrammar b/doc/tools/docgram/orderedGrammar
index 6e482c58dab3..ac636ef2beed 100644
--- a/doc/tools/docgram/orderedGrammar
+++ b/doc/tools/docgram/orderedGrammar
@@ -419,10 +419,10 @@ term_generalizing: [
 ]
 
 term_cast: [
-| term100 "<:" type
-| term100 "<<:" type
-| term100 ":>" type
-| term100 ":" type
+| term10 "<:" type
+| term10 "<<:" type
+| term10 ":>" type
+| term10 ":" type
 ]
 
 term_match: [
@@ -438,7 +438,7 @@ eqn: [
 ]
 
 pattern: [
-| pattern ":" term
+| pattern10 ":" term
 | pattern10
 ]
 
@@ -1035,8 +1035,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
 ]
 
@@ -1101,12 +1101,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 *)
 ]
 
@@ -2073,7 +2073,7 @@ ltac2_syntax_class: [
 ]
 
 ltac2_expr: [
-| ltac2_expr ";" ltac2_expr      (* ltac2 plugin *)
+| ltac2_expr5 ";" ltac2_expr      (* ltac2 plugin *)
 | ltac2_expr5      (* ltac2 plugin *)
 ]
 
@@ -2088,11 +2088,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 *)
 ]
 
@@ -2169,7 +2169,7 @@ tac2pat3: [
 ]
 
 tac2pat2: [
-| tac2pat2 "::" tac2pat2      (* ltac2 plugin *)
+| tac2pat1 "::" tac2pat2      (* ltac2 plugin *)
 | tac2pat1      (* ltac2 plugin *)
 ]
 
@@ -2271,8 +2271,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
 ]

From df64795f5b79aebddcc37c879501f57c31171b01 Mon Sep 17 00:00:00 2001
From: Johannes Hostert <jojohostert@gmail.com>
Date: Fri, 12 Dec 2025 20:24:20 +0100
Subject: [PATCH 005/578] Fix issue 21422.

The issue is fixed by making sure to not give any special treatment
to the "Proof" keyword after seeing it the first time.
---
 tools/rocqwc.mll | 19 +++++++++++++++++--
 1 file changed, 17 insertions(+), 2 deletions(-)

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

From 40f27461604d220f721b456c84680874f4e83967 Mon Sep 17 00:00:00 2001
From: Johannes Hostert <jojohostert@gmail.com>
Date: Fri, 12 Dec 2025 20:39:21 +0100
Subject: [PATCH 006/578] Add test for issue 21422.

---
 test-suite/coqwc/tactic-named-proof.out |  2 ++
 test-suite/coqwc/tactic-named-proof.v   | 13 +++++++++++++
 2 files changed, 15 insertions(+)
 create mode 100644 test-suite/coqwc/tactic-named-proof.out
 create mode 100644 test-suite/coqwc/tactic-named-proof.v

diff --git a/test-suite/coqwc/tactic-named-proof.out b/test-suite/coqwc/tactic-named-proof.out
new file mode 100644
index 000000000000..6fbdc1776eb1
--- /dev/null
+++ b/test-suite/coqwc/tactic-named-proof.out
@@ -0,0 +1,2 @@
+     spec    proof comments
+        2       10        1 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..149d41ebc9fe
--- /dev/null
+++ b/test-suite/coqwc/tactic-named-proof.v
@@ -0,0 +1,13 @@
+  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".
+    iPoseProof (fupd_mask_frame_r _ _ E' with "(H HP)") as "H"; first set_solver.
+    by rewrite left_id_L.
+  Qed.

From a8e187a23d50a8c7774329e7e9ec35dd75d5e50f Mon Sep 17 00:00:00 2001
From: Tomas <tomdtron@gmail.com>
Date: Mon, 30 Jun 2025 20:00:44 +0200
Subject: [PATCH 007/578] feat: Allow prim projections with postponed eta
 conversion (sort poly)

fix: postponed eta conv flag not set in one case

test: Adjust eta conversion record tests

refactor: Remove trailing whitespaces + ;
---
 checker/values.ml                         |  2 +-
 kernel/cClosure.ml                        | 17 +++++++++++++++++
 kernel/declarations.mli                   |  2 +-
 kernel/indTyping.ml                       |  2 +-
 kernel/sorts.ml                           |  4 ++++
 kernel/sorts.mli                          |  2 ++
 test-suite/success/record_postponed_eta.v | 17 ++++++++---------
 test-suite/success/sort_poly.v            |  2 +-
 vernac/prettyp.ml                         |  1 +
 9 files changed, 36 insertions(+), 13 deletions(-)

diff --git a/checker/values.ml b/checker/values.ml
index 40dc07760549..683c95ea9dae 100644
--- a/checker/values.ml
+++ b/checker/values.ml
@@ -438,7 +438,7 @@ let v_wfp =
 
 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 |] |]
diff --git a/kernel/cClosure.ml b/kernel/cClosure.ml
index 453e59ef01c0..9c914a3107f9 100644
--- a/kernel/cClosure.ml
+++ b/kernel/cClosure.ml
@@ -935,6 +935,18 @@ let get_branch infos ci pms cterm br e =
     let ext = push (Array.length args - 1) [] ctx in
     (br, usubs_consv (Array.rev_of_list ext) e)
 
+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
+
 (** [eta_expand_ind_stack env ind c s t] computes stacks corresponding
     to the conversion of the eta expansion of t, considered as an inhabitant
     of ind, and the Constructor c of this inductive type applied to arguments
@@ -949,11 +961,16 @@ let eta_expand_ind_stack env (ind,u) m (f, s') =
   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 ind_relevance = ind_relevance ind env in
   match Declareops.inductive_make_projections ind mib with
   | Some (projs, has_eta) ->
     let () =
       match has_eta with
       | NoEta -> raise Not_found
+      | MaybeEta ->
+        let relevances = Array.map snd projs in
+        if not @@ has_valid_relevance u ind_relevance relevances
+        then raise Not_found
       | AlwaysEta -> ()
     in
     (* (Construct, pars1 .. parsm :: arg1...argn :: []) ~= (f, s') ->
diff --git a/kernel/declarations.mli b/kernel/declarations.mli
index 3d58466e46c0..971ae89b6a04 100644
--- a/kernel/declarations.mli
+++ b/kernel/declarations.mli
@@ -157,7 +157,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
diff --git a/kernel/indTyping.ml b/kernel/indTyping.ml
index a1c1953be1e3..c3a49e772ecb 100644
--- a/kernel/indTyping.ml
+++ b/kernel/indTyping.ml
@@ -261,7 +261,7 @@ let check_record data =
               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 *)
+              | QSort _ ->  Result.Ok MaybeEta (* For sort variables it depends on the instantiation *)
     )
     (Result.Ok NoEta)
     data
diff --git a/kernel/sorts.ml b/kernel/sorts.ml
index f95495183c76..b15d4b1ecf37 100644
--- a/kernel/sorts.ml
+++ b/kernel/sorts.ml
@@ -511,6 +511,10 @@ let relevance_of_sort = function
   | Prop | Set | Type _ -> Relevant
   | QSort (q, _) -> RelevanceVar q
 
+let is_relevant = function
+  | Relevant -> true
+  | Irrelevant | RelevanceVar _ -> false
+
 let debug_print = function
   | SProp -> Pp.(str "SProp")
   | Prop -> Pp.(str "Prop")
diff --git a/kernel/sorts.mli b/kernel/sorts.mli
index 7299ff2445ac..30076b5336a0 100644
--- a/kernel/sorts.mli
+++ b/kernel/sorts.mli
@@ -210,6 +210,8 @@ 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
 val raw_pr : t -> Pp.t
diff --git a/test-suite/success/record_postponed_eta.v b/test-suite/success/record_postponed_eta.v
index 9490b6fa7945..aade41b290e2 100644
--- a/test-suite/success/record_postponed_eta.v
+++ b/test-suite/success/record_postponed_eta.v
@@ -47,7 +47,6 @@ Proof. intros A r2. Fail reflexivity. Abort.
     r2 : RSToProp A
     Unable to unify "{| f3 := f3 _ r2 |}" with "r2". *)
 
-Set Debug "cClosure".
 (* Conversion when record and field are instantiated to SProp checks correctly *)
 Goal forall (A:SProp) (r2 : RSToSProp@{SProp;0} A), eq r2 {| f3 := r2.(f3 A) |}.
 Proof. intros A r2. reflexivity. Qed.
@@ -78,17 +77,17 @@ Proof. intros A r2. Fail reflexivity. Abort.
 Goal forall (A:SProp) (r2 : RSToS'@{SProp SProp;0 0} A), eq r2 {| f4 := r2.(f4 A) |}.
 Proof. intros A r2. reflexivity. Qed.
 
-(* Conversion when record and field are instantiated to the same sort (Type) still fails correctly because we haven't implemented it *)
+(* Conversion when record and field are instantiated to the same sort (Type) checks correctly *)
 Goal forall (A:Set) (r2 : RSToS'@{Type Type;0 0} A), eq r2 {| f4 := r2.(f4 A) |}.
-Proof. intros A r2. Fail reflexivity. Abort.
+Proof. intros A r2. reflexivity. Qed.
 
-(* Conversion when record and field are instantiated to the same sort (Prop) still fails correctly because we haven't implemented it *)
+(* Conversion when record and field are instantiated to the same sort (Prop) checks correctly *)
 Goal forall (A:Prop) (r2 : RSToS'@{Prop Prop;0 0} A), eq r2 {| f4 := r2.(f4 A) |}.
-Proof. intros A r2. Fail reflexivity. Abort.
+Proof. intros A r2. reflexivity. Qed.
 
-(* Conversion when record is in Type and field is in Prop still fails correctly because we haven't implemented it *)
+(* Conversion when record is in Type and field is in Prop checks correctly *)
 Goal forall (A:Prop) (r2 : RSToS'@{Prop Type;0 0} A), eq r2 {| f4 := r2.(f4 A) |}.
-Proof. intros A r2. Fail reflexivity. Abort.
+Proof. intros A r2. reflexivity. Qed.
 
 Section Sorts.
   Sort s s'.
@@ -115,7 +114,7 @@ Section Sorts.
     r2 : RSToS' A
     Unable to unify "{| f4 := f4 _ r2 |}" with "r2". *)
 
-  (* Conversion when record and field are instantiated to the same sort (Type) still fails correctly because we haven't implemented it *)
+  (* Conversion when record and field are instantiated to the same sort (Type) checks correctly *)
   Goal forall (A:Type@{s;0}) (r2 : RSToS'@{s s;0 0} A), eq r2 {| f4 := r2.(f4 A) |}.
-  Proof. intros A r2. Fail reflexivity. Abort.
+  Proof. intros A r2. reflexivity. Qed.
 End Sorts.
diff --git a/test-suite/success/sort_poly.v b/test-suite/success/sort_poly.v
index 8bb4d81fb7a1..aacf806f95fe 100644
--- a/test-suite/success/sort_poly.v
+++ b/test-suite/success/sort_poly.v
@@ -86,7 +86,7 @@ Module Inference.
   (* implicit instance of zog gets a variable which then gets unified with s from the type of A *)
   Definition zag@{s; |} (A:Type@{s;Set}) := zog A.
 
-  (* implicit type of A gets unified to Type@{s|Set} *)
+  (* implicit type of A gets unified to Type@{s;Set} *)
   Definition zig@{s; |} A := zog@{s;} A.
 
   (* Unfortunately casting a hole to a sort (while typing A on the
diff --git a/vernac/prettyp.ml b/vernac/prettyp.ml
index 463bc2395d82..8f8f296ae243 100644
--- a/vernac/prettyp.ml
+++ b/vernac/prettyp.ml
@@ -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"."]

From 6d36bd9ef8e7ea78ce897738d4bbced55743cd64 Mon Sep 17 00:00:00 2001
From: Tomas Diaz <tomdtron@gmail.com>
Date: Sat, 10 Jan 2026 11:51:19 +0100
Subject: [PATCH 008/578] chore: Add changelog entry

---
 .../01-kernel/21416-record-postponed-eta-Changed.rst        | 6 ++++++
 1 file changed, 6 insertions(+)
 create mode 100644 doc/changelog/01-kernel/21416-record-postponed-eta-Changed.rst

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 <https://github.com/rocq-prover/rocq/pull/21416>`_,
+  by Tomas Diaz).

From 50d2c152f6c567143d61eb197b6fe3b809b36253 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Fri, 16 Jan 2026 17:41:09 +0100
Subject: [PATCH 009/578] Better heuristic for mismatched applications in
 Typing.recheck_against.

The typical use case of this function to retype a term with some subterms
abstracted away. In this case, the only way for an application to change
its length is because a prefix of its head was replaced with another term.
The efficient thing to do is thus to keep the suffix of the application and
to recheck the changed prefix, rather than trying to check the head against
its modified version.

A quick local profiling shows that these mismatched applications are fairly
rare in practice, so this commit is unlikely to make a noticeable difference
on average, but it may matter for some extreme cases.
---
 pretyping/typing.ml | 44 ++++++++++++++++++++++++++++++++++----------
 1 file changed, 34 insertions(+), 10 deletions(-)

diff --git a/pretyping/typing.ml b/pretyping/typing.ml
index 21dd1c9b4e49..e21aa943675c 100644
--- a/pretyping/typing.ml
+++ b/pretyping/typing.ml
@@ -839,30 +839,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 +895,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) ->

From d0c500f1e3b7beff1991e9ca9603acc0b1e01011 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Mon, 19 Jan 2026 15:40:30 +0100
Subject: [PATCH 010/578] Printing flags control extern depth

---
 interp/constrextern.ml      | 8 ++++----
 pretyping/printingFlags.ml  | 8 +++++++-
 pretyping/printingFlags.mli | 5 ++++-
 3 files changed, 15 insertions(+), 6 deletions(-)

diff --git a/interp/constrextern.ml b/interp/constrextern.ml
index 70519ad2b6fe..e1be963b69d2 100644
--- a/interp/constrextern.ml
+++ b/interp/constrextern.ml
@@ -857,7 +857,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 +1318,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 *)
@@ -1546,4 +1546,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/pretyping/printingFlags.ml b/pretyping/printingFlags.ml
index 1e1bc120e832..3712668c2180 100644
--- a/pretyping/printingFlags.ml
+++ b/pretyping/printingFlags.ml
@@ -160,6 +160,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
@@ -336,7 +341,7 @@ module Extern = struct
     projections : bool;
     float : bool;
     factorize_eqns : FactorizeEqns.t;
-    (* XXX depth? *)
+    depth : int option;
   }
 
   let current_ignore_raw () = {
@@ -352,6 +357,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

From 798d7499e547e6c47ba691f68da0115ea306f79b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Mon, 19 Jan 2026 15:40:37 +0100
Subject: [PATCH 011/578] Funind extern with unlimited depth

Fix #21513
---
 plugins/funind/indfun_common.ml |  3 ++-
 test-suite/bugs/bug_21513.v     | 21 +++++++++++++++++++++
 2 files changed, 23 insertions(+), 1 deletion(-)
 create mode 100644 test-suite/bugs/bug_21513.v

diff --git a/plugins/funind/indfun_common.ml b/plugins/funind/indfun_common.ml
index b36b4f4290b0..07d07e0a793a 100644
--- a/plugins/funind/indfun_common.ml
+++ b/plugins/funind/indfun_common.ml
@@ -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/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.

From fc8a42978ac2c9051947539f12d06b0e1d0cecc1 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Mon, 19 Jan 2026 16:14:39 +0100
Subject: [PATCH 012/578] Handle most unused-field warnings

The warning is locally disabled when the record is meant to be the
result of some marshalling.

There are a couple cases where I disabled the warning even though the
field could probably be deleted, in particular zify (too many cases to
want to bother) and some stm stuff with threads (not 100% sure we can
delete those fields).
---
 checker/checkLibrary.ml                       |  2 +
 checker/votour.ml                             |  3 +
 clib/cList.ml                                 |  2 +-
 doc/Makefile.docgram                          | 13 +---
 doc/tools/docgram/README.md                   |  2 -
 doc/tools/docgram/doc_grammar.ml              |  3 -
 doc/tools/docgram/dune                        |  2 +-
 ide/rocqide/protocol/xml_parser.ml            |  2 -
 ide/rocqide/rocqDriver.ml                     |  4 +-
 lib/spawn.ml                                  |  3 +-
 .../funind/functional_principles_proofs.ml    |  2 -
 plugins/funind/recdef.ml                      | 15 +----
 plugins/ltac/pptactic.ml                      |  4 --
 plugins/micromega/certificate.ml              |  9 +--
 plugins/micromega/coq_micromega.ml            | 67 ++++++++-----------
 plugins/micromega/zify.ml                     |  3 +
 stm/asyncTaskQueue.ml                         |  2 +-
 stm/workerPool.ml                             |  2 +-
 tactics/class_tactics.ml                      |  6 +-
 topbin/rocqnative.ml                          |  1 +
 vernac/declare.ml                             |  5 +-
 vernac/declare.mli                            |  1 -
 vernac/metasyntax.ml                          |  4 --
 vernac/mltop.ml                               |  5 +-
 24 files changed, 59 insertions(+), 103 deletions(-)

diff --git a/checker/checkLibrary.ml b/checker/checkLibrary.ml
index 6a7c2f35c7ee..549f51181c52 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)
diff --git a/checker/votour.ml b/checker/votour.ml
index 5fdbb911c761..f6d725d3deda 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
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/doc/Makefile.docgram b/doc/Makefile.docgram
index e78384058722..707d37daa622 100644
--- a/doc/Makefile.docgram
+++ b/doc/Makefile.docgram
@@ -2,13 +2,6 @@
 # doc_grammar tool
 ######################################################################
 
-DOCGRAMWARN ?= 0
-ifeq ($(DOCGRAMWARN),0)
-DOCGRAMWARNFLAG=-no-warn
-else
-DOCGRAMWARNFLAG=
-endif
-
 # List mlg files explicitly to avoid ordering problems (across
 # different installations / make versions).
 DOC_MLGS := \
@@ -51,12 +44,12 @@ endif
 
 doc/tools/docgram/fullGrammar: $(DOC_GRAM) $(DOC_MLGS)
 	$(SHOW)'DOC_GRAM'
-	$(HIDE)$(DOC_GRAM) -short -no-warn $(DOC_MLGS)
+	$(HIDE)$(DOC_GRAM) -short $(DOC_MLGS)
 
 #todo: add a dependency of sphinx on updated_rsts when we're ready
 doc/tools/docgram/orderedGrammar doc/tools/docgram/updated_rsts: doc/tools/docgram/fullGrammar $(DOC_GRAM) $(DOC_EDIT_MLGS)
 	$(SHOW)'DOC_GRAM_RSTS'
-	$(HIDE)$(DOC_GRAM) $(DOCGRAMWARNFLAG) -check-cmds -check-tacs $(DOC_MLGS) $(DOC_RSTS)
+	$(HIDE)$(DOC_GRAM) -check-cmds -check-tacs $(DOC_MLGS) $(DOC_RSTS)
 
 .PRECIOUS: doc/tools/docgram/orderedGrammar
 
@@ -68,7 +61,7 @@ doc_gram: doc/tools/docgram/fullGrammar
 
 doc_gram_verify: $(DOC_GRAM) $(DOC_MLGS)
 	$(SHOW)'DOC_GRAM_VERIFY'
-	$(HIDE)$(DOC_GRAM) -no-warn -verify -check-cmds -check-tacs $(DOC_MLGS) $(DOC_RSTS)
+	$(HIDE)$(DOC_GRAM) -verify -check-cmds -check-tacs $(DOC_MLGS) $(DOC_RSTS)
 
 doc_gram_rsts: doc/tools/docgram/updated_rsts
 
diff --git a/doc/tools/docgram/README.md b/doc/tools/docgram/README.md
index 22b20ffbdac1..d8dd0db95216 100644
--- a/doc/tools/docgram/README.md
+++ b/doc/tools/docgram/README.md
@@ -143,8 +143,6 @@ Other command line arguments:
 
 * `-check-cmds` causes generation of `prodnCommands`
 
-* `-no-warn` suppresses printing of some warning messages
-
 * `-no-update` puts updates to `fullGrammar` and `orderedGrammar` into new files named
   `*.new`, leaving the originals unmodified.  For use in Dune.
 
diff --git a/doc/tools/docgram/doc_grammar.ml b/doc/tools/docgram/doc_grammar.ml
index e576ef41bc06..a4812e5cf8c9 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;
 }
@@ -1817,7 +1815,6 @@ 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-update" -> { args with update = false }
         | "-short" -> { args with fullGrammar = true }
         | "-verbose" -> { args with verbose = true }
diff --git a/doc/tools/docgram/dune b/doc/tools/docgram/dune
index 071acef69229..faaba8a57d67 100644
--- a/doc/tools/docgram/dune
+++ b/doc/tools/docgram/dune
@@ -44,6 +44,6 @@
   orderedGrammar)
  (action
   (progn
-   (chdir %{project_root} (run doc_grammar -no-warn -check-cmds -no-update %{input}))
+   (chdir %{project_root} (run doc_grammar -check-cmds -no-update %{input}))
    (diff? fullGrammar fullGrammar.new)
    (diff? orderedGrammar orderedGrammar.new))))
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..a449ba3680d0 100644
--- a/ide/rocqide/rocqDriver.ml
+++ b/ide/rocqide/rocqDriver.ml
@@ -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/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/plugins/funind/functional_principles_proofs.ml b/plugins/funind/functional_principles_proofs.ml
index 484462f7dc61..08214b0866c7 100644
--- a/plugins/funind/functional_principles_proofs.ml
+++ b/plugins/funind/functional_principles_proofs.ml
@@ -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 }
@@ -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
diff --git a/plugins/funind/recdef.ml b/plugins/funind/recdef.ml
index 00dcd1774d32..0cedf8d8181e 100644
--- a/plugins/funind/recdef.ml
+++ b/plugins/funind/recdef.ml
@@ -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
@@ -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
@@ -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
diff --git a/plugins/ltac/pptactic.ml b/plugins/ltac/pptactic.ml
index 5b6feb19a422..81ece7c5dad2 100644
--- a/plugins/ltac/pptactic.ml
+++ b/plugins/ltac/pptactic.ml
@@ -666,7 +666,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 +1103,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 +1135,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 +1172,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;
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..8748033a0063 100644
--- a/plugins/micromega/coq_micromega.ml
+++ b/plugins/micromega/coq_micromega.ml
@@ -1559,21 +1559,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
@@ -2351,80 +2348,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/zify.ml b/plugins/micromega/zify.ml
index 0ce229de0ed1..77a4efdd0746 100644
--- a/plugins/micromega/zify.ml
+++ b/plugins/micromega/zify.ml
@@ -16,6 +16,9 @@ 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 *)
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/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/tactics/class_tactics.ml b/tactics/class_tactics.ml
index 9400410dcec6..6a00fe99845b 100644
--- a/tactics/class_tactics.ml
+++ b/tactics/class_tactics.ml
@@ -468,7 +468,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;
@@ -499,7 +498,7 @@ module Search = struct
   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 +764,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';
@@ -884,7 +882,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/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/vernac/declare.ml b/vernac/declare.ml
index c9b5d22facce..0bc8249a6994 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 :
diff --git a/vernac/declare.mli b/vernac/declare.mli
index 402c6b1ccc17..3f107286215c 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
diff --git a/vernac/metasyntax.ml b/vernac/metasyntax.ml
index 26270701a65c..0a9487fb9473 100644
--- a/vernac/metasyntax.ml
+++ b/vernac/metasyntax.ml
@@ -1054,16 +1054,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
diff --git a/vernac/mltop.ml b/vernac/mltop.ml
index 9ab237a5bd89..fda6db5febb5 100644
--- a/vernac/mltop.ml
+++ b/vernac/mltop.ml
@@ -426,7 +426,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 =
@@ -468,7 +469,7 @@ let declare_ml_modules local mnames =
   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. *)

From 205239345d6cc94f4ff2e0ddcd939c29dda7ff9a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Mon, 19 Jan 2026 16:18:40 +0100
Subject: [PATCH 013/578] Handle eol-in-string warnings

---
 boot/usage.ml                  | 2 +-
 plugins/ltac2/tac2extravals.ml | 2 +-
 tools/configure/cmdArgs.ml     | 6 +++---
 3 files changed, 5 insertions(+), 5 deletions(-)

diff --git a/boot/usage.ml b/boot/usage.ml
index 21246a0d2697..c3f16ec9365e 100644
--- a/boot/usage.ml
+++ b/boot/usage.ml
@@ -49,7 +49,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/plugins/ltac2/tac2extravals.ml b/plugins/ltac2/tac2extravals.ml
index 1ef7d5a3e9ca..9834a94da572 100644
--- a/plugins/ltac2/tac2extravals.ml
+++ b/plugins/ltac2/tac2extravals.ml
@@ -586,7 +586,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"
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.";

From e925521b9505bf3e6a4a000b256f2646cb721fc7 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Mon, 19 Jan 2026 16:18:55 +0100
Subject: [PATCH 014/578] Control which ocaml warnings are on instead of
 delegating to dune

Notably dune 3.21 will change its defaults (to ocaml upstream defaults).
---
 dune                         | 3 ++-
 tools/configure/configure.ml | 3 +--
 2 files changed, 3 insertions(+), 3 deletions(-)

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/tools/configure/configure.ml b/tools/configure/configure.ml
index a9329c1af616..b761b7b02fef 100644
--- a/tools/configure/configure.ml
+++ b/tools/configure/configure.ml
@@ -137,8 +137,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 =

From f2e73a2a04c987eff44adb16cd98c783ce5fbd44 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Mon, 12 Jan 2026 12:52:56 +0100
Subject: [PATCH 015/578] Delete Termops.free_rels_and_unqualified_refs

The only caller (Impargs.compute_implicits_names) doesn't actually use
the idents this returns, so it can just use free_rels.
---
 engine/termops.ml  | 28 ----------------------------
 engine/termops.mli |  4 ----
 interp/impargs.ml  | 14 +++++++-------
 3 files changed, 7 insertions(+), 39 deletions(-)

diff --git a/engine/termops.ml b/engine/termops.ml
index 213782a0d50c..8ba3fcb0182d 100644
--- a/engine/termops.ml
+++ b/engine/termops.ml
@@ -835,34 +835,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. *)
 
diff --git a/engine/termops.mli b/engine/termops.mli
index 46fc0d85c44f..9c162ed3e7f1 100644
--- a/engine/termops.mli
+++ b/engine/termops.mli
@@ -81,10 +81,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
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) ()

From 2321c2985b6c6f66e946bc787dce175b48efbd24 Mon Sep 17 00:00:00 2001
From: Tomas Diaz <tomdtron@gmail.com>
Date: Fri, 16 Jan 2026 00:16:36 +0100
Subject: [PATCH 016/578] doc: Update sprop doc on sort poly primitive records

---
 doc/sphinx/addendum/sprop.rst        | 25 +++++++++++++++++++++++++
 doc/sphinx/language/core/records.rst |  2 +-
 2 files changed, 26 insertions(+), 1 deletion(-)

diff --git a/doc/sphinx/addendum/sprop.rst b/doc/sphinx/addendum/sprop.rst
index 24637946253f..0a08bb5e7481 100644
--- a/doc/sphinx/addendum/sprop.rst
+++ b/doc/sphinx/addendum/sprop.rst
@@ -145,6 +145,31 @@ 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.
+
+.. rocqdoc::
+    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.
+
+
 Encodings for strict propositions
 ---------------------------------
 
diff --git a/doc/sphinx/language/core/records.rst b/doc/sphinx/language/core/records.rst
index 9782aee6fc66..07256cfc9bff 100644
--- a/doc/sphinx/language/core/records.rst
+++ b/doc/sphinx/language/core/records.rst
@@ -406,7 +406,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 enjoys 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.

From 8fb987a86a59983e1101945bf21a4791cff51464 Mon Sep 17 00:00:00 2001
From: Gregory Malecha <gregory@bluerock.io>
Date: Wed, 25 Jun 2025 11:55:28 -0400
Subject: [PATCH 017/578] Implement Extensible Attributes on Definitions

---
 .../20812-SkySkimmer-extensible-attributes.sh |  1 +
 library/summary.ml                            | 61 +++++++++++++++
 library/summary.mli                           | 56 ++++++++++++++
 test-suite/misc/attributes.sh                 | 22 ++++++
 test-suite/misc/attributes/_CoqProject        |  7 ++
 .../misc/attributes/src/META.rocq-test-suite  | 11 +++
 test-suite/misc/attributes/src/attribute.ml   | 31 ++++++++
 .../attributes/src/attribute_plugin.mlpack    |  1 +
 test-suite/misc/attributes/theories/attr.v    | 17 ++++
 vernac/comCoercion.ml                         | 12 +--
 vernac/comCoercion.mli                        |  4 +-
 vernac/vernacentries.ml                       | 77 +++++++++++++------
 vernac/vernacentries.mli                      |  4 +
 13 files changed, 271 insertions(+), 33 deletions(-)
 create mode 100644 dev/ci/user-overlays/20812-SkySkimmer-extensible-attributes.sh
 create mode 100755 test-suite/misc/attributes.sh
 create mode 100644 test-suite/misc/attributes/_CoqProject
 create mode 100644 test-suite/misc/attributes/src/META.rocq-test-suite
 create mode 100644 test-suite/misc/attributes/src/attribute.ml
 create mode 100644 test-suite/misc/attributes/src/attribute_plugin.mlpack
 create mode 100644 test-suite/misc/attributes/theories/attr.v

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/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/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..f4e447af5c2b
--- /dev/null
+++ b/test-suite/misc/attributes/theories/attr.v
@@ -0,0 +1,17 @@
+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.
+
+(* par marshals th summary, enforcing that it doesn't contain closures *)
+Lemma parfoo : True /\ True.
+Proof.
+  split.
+  par: exact I.
+Defined.
diff --git a/vernac/comCoercion.ml b/vernac/comCoercion.ml
index 9f2556d4822a..944889b8b7d0 100644
--- a/vernac/comCoercion.ml
+++ b/vernac/comCoercion.ml
@@ -352,7 +352,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 +363,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,13 +372,10 @@ 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
+  try_add_new_coercion_subclass ?loc cl ~local:stre ~poly ~reversible
 
 let nonuniform = Attributes.bool_attribute ~name:"nonuniform"
 
-let add_subclass_hook ~poly ~reversible =
-  Declare.Hook.make (add_subclass_hook ~poly ~reversible)
-
 let warn_reverse_no_change =
   CWarnings.create ~name:"reversible-no-change" ~category:CWarnings.CoreCategories.coercions
     (fun () -> str "The reversible attribute is unchanged.")
diff --git a/vernac/comCoercion.mli b/vernac/comCoercion.mli
index 97a28abd2921..bf2bed078870 100644
--- a/vernac/comCoercion.mli
+++ b/vernac/comCoercion.mli
@@ -48,9 +48,9 @@ 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
 
diff --git a/vernac/vernacentries.ml b/vernac/vernacentries.ml
index eb4719ed6aa8..eb5fd94ba274 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 ()
@@ -811,18 +829,27 @@ let check_name_freshness locality {CAst.loc;v=id} : unit =
   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
+let vernac_definition_hook ~atts ~canonical_instance ~local ~poly ~reversible kind =
+  let hooks = atts.DefAttributes.hooks in
+  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
+  match hooks with
+  | [] -> None
+  | _ -> Some (Declare.Hook.make (fun st -> List.iter (fun hook -> Declare.Hook.call ~hook st) hooks))
 
 let default_thm_id = Id.of_string "Unnamed_thm"
 
@@ -848,8 +875,10 @@ 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 hook =
+    let canonical_instance, reversible = atts.canonical_instance, atts.reversible in
+    vernac_definition_hook ~atts ~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
@@ -860,8 +889,10 @@ let vernac_definition_refine ~atts (discharge, kind) (lid, udecl) bl red_option
   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 hook =
+    let canonical_instance, reversible = atts.canonical_instance, atts.reversible in
+    vernac_definition_hook ~atts ~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)
@@ -871,8 +902,10 @@ let vernac_definition ~atts ~pm (discharge, kind) (lid, udecl) bl red_option c 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 kind ~reversible in
+  let hook =
+    let canonical_instance, reversible = atts.canonical_instance, atts.reversible in
+    vernac_definition_hook ~atts ~canonical_instance ~local ~poly kind ~reversible
+  in
   let name = vernac_definition_name lid scope in
   let red_option = match red_option with
     | None -> None
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

From f34bd4c8ee00a7013b3e559ee273cd6de109dd54 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Tue, 20 Jan 2026 09:18:15 +0100
Subject: [PATCH 018/578] Correctly handle sort rigidity in UState union-find.

Instead of storing it directly as a set, we put it in the union-find
node in order to quotient it statically w.r.t. the equivalence
relation. This guarantees statically that we cannot mess with the
quotient.
---
 engine/uState.ml | 117 ++++++++++++++++++++++++++++-------------------
 1 file changed, 69 insertions(+), 48 deletions(-)

diff --git a/engine/uState.ml b/engine/uState.ml
index 2538da7e67b2..ce9ac7dab80f 100644
--- a/engine/uState.ml
+++ b/engine/uState.ml
@@ -106,10 +106,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,51 +125,63 @@ 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 _ as q) -> q
 | exception Not_found -> QVar q
 
+type repr =
+| ReprConstant of Quality.constant
+| ReprVar of QVar.t * bool
+
+let rec repr_node q m = match QMap.find q m.qmap with
+| Canonical { rigid } -> ReprVar (q, rigid)
+| Equiv (QVar q) -> repr_node q m
+| Equiv (QConstant qc) -> ReprConstant qc
+| exception Not_found -> ReprVar (q, true) (* a bit dubious but missing variables are considered rigid *)
+
 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 q m with
+| ReprVar (_, rigid) -> rigid
+| ReprConstant _ -> 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 q = repr_node q m in
+  let q, rigid = match q with ReprVar (q, rigid) -> q, rigid | ReprConstant _ -> assert false in
+  let qv = match qv with QVar qv -> repr_node qv m | QConstant qc -> ReprConstant qc 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 ->
+  | q, 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;
+      Some { qmap = QMap.add q (Equiv (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) ->
+  | q, 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 }
 
 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 q m in
+  let q, rigid = match q with ReprVar (q, rigid) -> q, rigid | ReprConstant _ -> 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
@@ -205,9 +220,10 @@ let nf_quality m = function
 
 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 +234,24 @@ 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 _) | (Canonical _), Equiv q -> Some (Equiv q)
+      | Canonical { rigid = r1 }, Canonical { rigid = r2 } ->
+        (* XXX this looks wrong, but this preserves the previous behaviour *)
+        Some (Canonical { rigid = r1 || r2 })
+      | 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,8 +265,7 @@ 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 }
@@ -257,18 +275,22 @@ let of_elims elims =
   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 }
 
 (* 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)
@@ -278,12 +300,12 @@ let collapse_above_prop ~to_prop m =
 let collapse ?(except=QSet.empty) m =
   QMap.fold (fun q v m ->
            match v with
-           | Some _ -> m
-           | None -> if QSet.mem q m.rigid || QSet.mem q except then m
+           | Equiv _ -> m
+           | Canonical { rigid } -> if 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) =
+let pr prqvar_opt ({ 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
@@ -292,20 +314,19 @@ let pr prqvar_opt ({ qmap; elims; rigid } as m) =
   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 prqvar_opt q with
+  | None -> mt ()
+  | Some qid -> str " (named " ++ Libnames.pr_qualid 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) ++

From 5f46d987c21955496c981b426548101bba2c5872 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Tue, 20 Jan 2026 13:06:43 +0100
Subject: [PATCH 019/578] rocqdep lookup statically linked libs dynamically

Remove dep between rocq-runtime and its own META

Alternative to #21518
---
 .../coq-makefile/findlib-local/META.rocq-runtime      | 10 ++++++++++
 tools/coqdep/lib/dune                                 | 10 ----------
 tools/coqdep/lib/fl.ml                                |  8 ++++++--
 tools/coqdep/lib/static_toplevel_libs.mli             | 11 -----------
 4 files changed, 16 insertions(+), 23 deletions(-)
 delete mode 100644 tools/coqdep/lib/static_toplevel_libs.mli

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/tools/coqdep/lib/dune b/tools/coqdep/lib/dune
index 8c8fa56cff51..87bbd6d28536 100644
--- a/tools/coqdep/lib/dune
+++ b/tools/coqdep/lib/dune
@@ -4,13 +4,3 @@
  (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"))))
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/static_toplevel_libs.mli b/tools/coqdep/lib/static_toplevel_libs.mli
deleted file mode 100644
index ec6e67e3bd66..000000000000
--- a/tools/coqdep/lib/static_toplevel_libs.mli
+++ /dev/null
@@ -1,11 +0,0 @@
-(************************************************************************)
-(*         *      The Rocq Prover / The Rocq Development Team           *)
-(*  v      *         Copyright INRIA, CNRS and contributors             *)
-(* <O___,, * (see version control and CREDITS file for authors & dates) *)
-(*   \VV/  **************************************************************)
-(*    //   *    This file is distributed under the terms of the         *)
-(*         *     GNU Lesser General Public License Version 2.1          *)
-(*         *     (see LICENSE file for the text of the license)         *)
-(************************************************************************)
-
-val static_toplevel_libs : string list

From 8e6da753cce1467df68260970e34bd7ae25dbf84 Mon Sep 17 00:00:00 2001
From: nicolas tabareau <nicolas.tabareau@gmail.com>
Date: Sun, 21 Dec 2025 11:58:45 +0100
Subject: [PATCH 020/578] Update version number for 9.3+alpha

---
 tools/configure/configure.ml | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/tools/configure/configure.ml b/tools/configure/configure.ml
index a9329c1af616..4f96d41fd204 100644
--- a/tools/configure/configure.ml
+++ b/tools/configure/configure.ml
@@ -22,10 +22,10 @@ open CmdArgs.Prefs
 
 let (/) = Filename.concat
 
-let coq_version = "9.2+alpha"
+let coq_version = "9.3+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
+let vo_magic = 90299
 let is_a_released_version = false
 
 (** Default OCaml binaries *)

From aa2a04565319d71e02a14865132cab22fbe5d446 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Fri, 31 Oct 2025 13:33:05 +0100
Subject: [PATCH 021/578] Ltac2: provide user API for printing errors

Close #21250
---
 .../21252-pr-tac2fail-Added.rst               |  4 ++
 plugins/ltac2/tac2core.ml                     |  2 +
 plugins/ltac2/tac2entries.ml                  | 38 +++++++++++++++++--
 plugins/ltac2/tac2quote.mli                   |  2 +
 test-suite/output/ltac2_print_exn.out         | 17 +++++++++
 test-suite/output/ltac2_print_exn.v           | 38 +++++++++++++++++++
 theories/Ltac2/Control.v                      | 28 ++++++++++++++
 7 files changed, 126 insertions(+), 3 deletions(-)
 create mode 100644 doc/changelog/06-Ltac2-language/21252-pr-tac2fail-Added.rst
 create mode 100644 test-suite/output/ltac2_print_exn.out
 create mode 100644 test-suite/output/ltac2_print_exn.v

diff --git a/doc/changelog/06-Ltac2-language/21252-pr-tac2fail-Added.rst b/doc/changelog/06-Ltac2-language/21252-pr-tac2fail-Added.rst
new file mode 100644
index 000000000000..97811493a5a4
--- /dev/null
+++ b/doc/changelog/06-Ltac2-language/21252-pr-tac2fail-Added.rst
@@ -0,0 +1,4 @@
+- **Added:**
+  APIs `Control.print_err` and `Control.print_exn` which may be used to customize printing of Ltac2 errors
+  (`#21252 <https://github.com/rocq-prover/rocq/pull/21252>`_,
+  by Gaëtan Gilbert).
diff --git a/plugins/ltac2/tac2core.ml b/plugins/ltac2/tac2core.ml
index 00a63dc17653..57ea00a6c8df 100644
--- a/plugins/ltac2/tac2core.ml
+++ b/plugins/ltac2/tac2core.ml
@@ -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 *)
diff --git a/plugins/ltac2/tac2entries.ml b/plugins/ltac2/tac2entries.ml
index 193d204936c2..1619ee61b78a 100644
--- a/plugins/ltac2/tac2entries.ml
+++ b/plugins/ltac2/tac2entries.ml
@@ -1333,13 +1333,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
 
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/test-suite/output/ltac2_print_exn.out b/test-suite/output/ltac2_print_exn.out
new file mode 100644
index 000000000000..f8f84e6a60ed
--- /dev/null
+++ b/test-suite/output/ltac2_print_exn.out
@@ -0,0 +1,17 @@
+File "./output/ltac2_print_exn.v", line 11, characters 0-23:
+The command has indeed failed with message:
+hello
+Backtrace:
+Call foo
+Prim <rocq-runtime.plugins.ltac2:zero>
+
+File "./output/ltac2_print_exn.v", line 24, characters 0-23:
+The command has indeed failed with message:
+Uncaught Ltac2 exception: WithTerm constr:(?X1)
+File "./output/ltac2_print_exn.v", line 33, characters 0-23:
+The command has indeed failed with message:
+test ?X1
+File "./output/ltac2_print_exn.v", line 38, characters 0-23:
+The command has indeed failed with message:
+Uncaught Ltac2 exception: Tactic_failure (Some message:(hello))
+Custom Ltac2 printer failed: Uncaught Ltac2 exception: Assertion_failure
diff --git a/test-suite/output/ltac2_print_exn.v b/test-suite/output/ltac2_print_exn.v
new file mode 100644
index 000000000000..b3edac5f6e4d
--- /dev/null
+++ b/test-suite/output/ltac2_print_exn.v
@@ -0,0 +1,38 @@
+Require Import Ltac2.Ltac2.
+Import Printf.
+
+(** basic test, we also check that the backtrace isn't forgotten when
+    using the custom printer *)
+
+Set Ltac2 Backtrace.
+
+Ltac2 foo () := Control.zero (Tactic_failure (Some (Message.of_string "hello"))).
+
+Fail Ltac2 Eval foo ().
+
+Unset Ltac2 Backtrace.
+
+(** Test printing constr even though we have a bad evar map *)
+
+Ltac2 Type exn ::= [ WithTerm (constr) ].
+
+Ltac2 bar () :=
+  let c := open_constr:(_ :> nat) in
+  Control.zero (WithTerm c).
+
+(* default printer doesn't have the evar map but doesn't fail *)
+Fail Ltac2 Eval bar ().
+
+Ltac2 Set Control.print_exn := fun e =>
+  match e with
+  |  WithTerm c => Some (fprintf "test %t" c)
+  | _ => None
+  end.
+
+(* custom printer also doesn't have the evar map but doesn't fail *)
+Fail Ltac2 Eval bar ().
+
+(** Test custom printer producing an error *)
+Ltac2 Set Control.print_exn := fun _ => Control.throw Assertion_failure.
+
+Fail Ltac2 Eval foo ().
diff --git a/theories/Ltac2/Control.v b/theories/Ltac2/Control.v
index b818e30c0525..d5c4c17d7e68 100644
--- a/theories/Ltac2/Control.v
+++ b/theories/Ltac2/Control.v
@@ -224,3 +224,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.

From 4d6379349f48fa156d956be1efced22380ed227b Mon Sep 17 00:00:00 2001
From: Yann Leray <yann.leray@inria.fr>
Date: Fri, 23 May 2025 19:08:14 +0200
Subject: [PATCH 022/578] Cleanup around DefAttributes

---
 plugins/derive/derive.ml |  7 +++-
 vernac/vernacentries.ml  | 83 ++++++++++++++++------------------------
 2 files changed, 37 insertions(+), 53 deletions(-)

diff --git a/plugins/derive/derive.ml b/plugins/derive/derive.ml
index 7c053f83e628..68e9d6e99aeb 100644
--- a/plugins/derive/derive.ml
+++ b/plugins/derive/derive.ml
@@ -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
diff --git a/vernac/vernacentries.ml b/vernac/vernacentries.ml
index eb5fd94ba274..e0dabf15bc27 100644
--- a/vernac/vernacentries.ml
+++ b/vernac/vernacentries.ml
@@ -829,8 +829,7 @@ let check_name_freshness locality {CAst.loc;v=id} : unit =
   then
     user_err ?loc  (Id.print id ++ str " already exists.")
 
-let vernac_definition_hook ~atts ~canonical_instance ~local ~poly ~reversible kind =
-  let hooks = atts.DefAttributes.hooks in
+let vernac_definition_hook ~hooks ~canonical_instance ~local ~poly ~reversible kind =
   let hooks =
     let open Decls in
     let open Declare.Hook in
@@ -872,40 +871,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 hook =
-    let canonical_instance, reversible = atts.canonical_instance, atts.reversible in
-    vernac_definition_hook ~atts ~canonical_instance ~local ~poly ~reversible kind
+  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 hook =
-    let canonical_instance, reversible = atts.canonical_instance, atts.reversible in
-    vernac_definition_hook ~atts ~canonical_instance ~local ~poly kind ~reversible
+  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 hook =
-    let canonical_instance, reversible = atts.canonical_instance, atts.reversible in
-    vernac_definition_hook ~atts ~canonical_instance ~local ~poly kind ~reversible
+  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
@@ -927,12 +923,13 @@ 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;
+    } = atts
+  in
   List.iter (fun ((id, _), _) -> check_name_freshness scope id) l;
   match l with
   | [] -> assert false
@@ -972,9 +969,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
@@ -1329,13 +1324,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
@@ -1345,10 +1333,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 *)
@@ -1358,18 +1346,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

From 39c77c8aca95b11522e7e7033e12963174a56a30 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Wed, 21 Jan 2026 15:24:36 +0100
Subject: [PATCH 023/578] Remove false recursion in internal grammar types

---
 gramlib/grammar.ml | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/gramlib/grammar.ml b/gramlib/grammar.ml
index 8dfc766ccfbd..7ab8c9f9b17a 100644
--- a/gramlib/grammar.ml
+++ b/gramlib/grammar.ml
@@ -210,7 +210,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 +225,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 +236,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;

From b6521b2acbd1a72eaad2143dbfd8d31d29a9086f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Wed, 21 Jan 2026 15:43:57 +0100
Subject: [PATCH 024/578] Update ltac2 syntactic classes doc to mention ltac2
 custom entries

---
 doc/sphinx/proof-engine/ltac2.rst | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/doc/sphinx/proof-engine/ltac2.rst b/doc/sphinx/proof-engine/ltac2.rst
index e7d287f92cdc..39910fd40ddc 100644
--- a/doc/sphinx/proof-engine/ltac2.rst
+++ b/doc/sphinx/proof-engine/ltac2.rst
@@ -1596,8 +1596,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.
 

From 3eedb7c119bdb8fded3aa0de8f328ebdeae4470f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Wed, 21 Jan 2026 17:35:35 +0100
Subject: [PATCH 025/578] Add some asserts in QState.union

---
 engine/uState.ml | 8 +++++---
 1 file changed, 5 insertions(+), 3 deletions(-)

diff --git a/engine/uState.ml b/engine/uState.ml
index ce9ac7dab80f..989c3ac31065 100644
--- a/engine/uState.ml
+++ b/engine/uState.ml
@@ -234,10 +234,12 @@ let union ~fail s1 s2 =
   let extra = ref [] in
   let qmap = QMap.union (fun qk q1 q2 ->
       match q1, q2 with
-      | Equiv q, (Canonical _) | (Canonical _), Equiv q -> Some (Equiv q)
+      | Equiv q, (Canonical {rigid}) | (Canonical {rigid}), Equiv q ->
+        assert (not rigid);
+        Some (Equiv q)
       | Canonical { rigid = r1 }, Canonical { rigid = r2 } ->
-        (* XXX this looks wrong, but this preserves the previous behaviour *)
-        Some (Canonical { rigid = r1 || 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 (Equiv q1))

From 2a552090b1518e81d45def01fe4fbbf061fe6f22 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Mon, 19 Jan 2026 08:40:53 +0100
Subject: [PATCH 026/578] Stop exposing implementation internals in Environ
 API.

The fact that we store bits of the data together as a tuple should
not have been reflected in the API. It is annoying every time we
want to add additional data to the tuple.
---
 kernel/environ.ml    | 51 ++++++++++++++++++++++++++++----------------
 kernel/environ.mli   | 16 +++++++-------
 kernel/nativecode.ml | 10 +++++----
 kernel/typeops.ml    |  4 ++--
 kernel/vmsymtable.ml |  2 +-
 5 files changed, 50 insertions(+), 33 deletions(-)

diff --git a/kernel/environ.ml b/kernel/environ.ml
index db732432b62d..a1f397e0ff44 100644
--- a/kernel/environ.ml
+++ b/kernel/environ.ml
@@ -220,14 +220,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 +251,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
@@ -1084,8 +1097,8 @@ 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;
@@ -1097,8 +1110,8 @@ module Internal = struct
     }
 
     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;
@@ -1108,6 +1121,8 @@ module Internal = struct
       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..2070e73a2e74 100644
--- a/kernel/environ.mli
+++ b/kernel/environ.mli
@@ -37,10 +37,6 @@ type link_info =
 
 type key = int CEphemeron.key option ref
 
-type constant_key = constant_body * (link_info ref * key) * KerName.t
-
-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;
@@ -173,12 +169,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 +240,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 +248,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
@@ -497,8 +497,8 @@ 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;
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/typeops.ml b/kernel/typeops.ml
index babc196a3933..2f837f7afbb9 100644
--- a/kernel/typeops.ml
+++ b/kernel/typeops.ml
@@ -125,11 +125,11 @@ let instantiate_context env u subst nas ctx =
   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
 
 (************************************************)
diff --git a/kernel/vmsymtable.ml b/kernel/vmsymtable.ml
index 5f08956219eb..c577eebc1a39 100644
--- a/kernel/vmsymtable.ml
+++ b/kernel/vmsymtable.ml
@@ -269,7 +269,7 @@ 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

From b5a84075fd80b53f62f4548afbc258f55d9fdb09 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Th=C3=A9o=20Zimmermann?= <theo.zimmermann@telecom-paris.fr>
Date: Wed, 21 Jan 2026 20:47:19 +0100
Subject: [PATCH 027/578] Document description for backporting to multiple
 branches.

---
 dev/doc/release-process.md | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/dev/doc/release-process.md b/dev/doc/release-process.md
index 9ad550d95fb3..89b349e5f654 100644
--- a/dev/doc/release-process.md
+++ b/dev/doc/release-process.md
@@ -18,7 +18,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.

From 6926472fc0570334f2b6e4aec93cc6f40699e338 Mon Sep 17 00:00:00 2001
From: Tomas Diaz <tomdtron@gmail.com>
Date: Thu, 22 Jan 2026 09:31:17 +0100
Subject: [PATCH 028/578] doc: Add record eta restriction section in SProp doc

---
 doc/sphinx/addendum/sprop.rst        | 9 ++++++++-
 doc/sphinx/language/core/records.rst | 2 +-
 2 files changed, 9 insertions(+), 2 deletions(-)

diff --git a/doc/sphinx/addendum/sprop.rst b/doc/sphinx/addendum/sprop.rst
index 0a08bb5e7481..6231d7fde74f 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.
 
@@ -148,7 +150,10 @@ are allowed and have η-conversion.
 Sort polymorphic primitive records are allowed and η-conversion depends on
 the actual instantiation of sorts.
 
-.. rocqdoc::
+.. rocqtop:: in
+
+    Set Universe Polymorphism.
+
     Inductive eq@{s; u} (A : Type@{s;u}) (a : A) : A -> Prop :=
       eq_refl : eq A a a.
 
@@ -169,6 +174,8 @@ the actual instantiation of sorts.
                   eq rs {| rsprj := rs.(rsprj A) |}.
    Proof. intros A rs. reflexivity. Qed.
 
+   Unset Universe Polymorphism.
+
 
 Encodings for strict propositions
 ---------------------------------
diff --git a/doc/sphinx/language/core/records.rst b/doc/sphinx/language/core/records.rst
index 07256cfc9bff..2c8978ba0370 100644
--- a/doc/sphinx/language/core/records.rst
+++ b/doc/sphinx/language/core/records.rst
@@ -406,7 +406,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, in most cases (See :ref:`sprop` for exceptions),
+   non-recursive. The defined type has eta-conversion definitionally, in most cases (See :ref:`sprop <record-eta-restriction>` 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.

From f3ee71c700fb28cf3a095f792da416adfd5430be Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Thu, 22 Jan 2026 15:56:55 +0100
Subject: [PATCH 029/578] Properly define all scheme recursion as one mutual
 block.

All callers were statically defined, this was just open recursion
for no good reason.
---
 tactics/allScheme.ml | 27 +++++++++++----------------
 1 file changed, 11 insertions(+), 16 deletions(-)

diff --git a/tactics/allScheme.ml b/tactics/allScheme.ml
index f2d0fe70d40a..85bd8ca11a06 100644
--- a/tactics/allScheme.ml
+++ b/tactics/allScheme.ml
@@ -78,8 +78,7 @@ let check_strpos_context env uparams default cxt =
   in aux env default (List.rev cxt)
 
 (** 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 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
@@ -118,8 +117,7 @@ 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 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 *)
@@ -131,7 +129,7 @@ let rec compute_params_rec_strpos_arg compute_params_rec_strpos env kn uparams
   List.map2 (&&) strpos_local srpos_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 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 +137,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 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,11 +149,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 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
+  let strpos_ctors = andl_array (compute_params_rec_strpos_ctor
         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 +164,19 @@ 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 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 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 env kn mib =
   (* reset the context *)
   let env = set_rel_context_val empty_rel_context_val env in
   (* compute the data expected *)
@@ -196,10 +192,9 @@ 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
+  compute_params_rec_strpos_aux env kn uparams nuparams mib.mind_nparams_rec mib.mind_nparams inds
 
-
-  (** {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"))

From e57a96da855093901cf192d86d06314acab211d6 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Thu, 22 Jan 2026 16:29:27 +0100
Subject: [PATCH 030/578] Share uniform parameter computation in nested scheme
 computation.

This prevents an exponential blowup. The code is now linear in the
depth of nesting. This is still worse than what we could do in
theory, but this is much better. Ideally we should store this
information directly in the mutual block rather than recomputing it.

Fixes #21535: Recursor generation is exponential in nesting depth.
---
 tactics/allScheme.ml | 40 ++++++++++++++++++++++++++++------------
 1 file changed, 28 insertions(+), 12 deletions(-)

diff --git a/tactics/allScheme.ml b/tactics/allScheme.ml
index 85bd8ca11a06..2c02bb5fb688 100644
--- a/tactics/allScheme.ml
+++ b/tactics/allScheme.ml
@@ -77,8 +77,17 @@ 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)
 
+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 env kn uparams nparams_rec nparams init_value arg =
+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
@@ -106,7 +115,7 @@ let rec compute_params_rec_strpos_arg env kn uparams nparams_rec nparams init_va
         (* 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 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 @@
@@ -117,7 +126,7 @@ let rec compute_params_rec_strpos_arg env kn uparams nparams_rec nparams init_va
              - 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 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 *)
@@ -129,7 +138,7 @@ let rec compute_params_rec_strpos_arg env kn uparams nparams_rec nparams init_va
   List.map2 (&&) strpos_local srpos_hd
 
 (** Computes which uniform parameters are strictly positive in a constructor *)
-and compute_params_rec_strpos_ctor 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 (
@@ -137,7 +146,7 @@ and compute_params_rec_strpos_ctor env kn uparams nparams_rec nparams init_value
         if Option.has_some @@ get_value arg then
           push_rel arg env, acc
         else
-          let strpos_arg = compute_params_rec_strpos_arg 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
@@ -149,12 +158,11 @@ and compute_params_rec_strpos_ctor env kn uparams nparams_rec nparams init_value
   res_ctor
 
 (** Computes which uniform parameters are strictly positive in an inductive block *)
-and compute_params_rec_strpos_ind 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
-        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
 
@@ -164,19 +172,20 @@ and compute_params_rec_strpos_ind env kn uparams nparams_rec nparams init_value
     This function can be used whether the inductive is refered using [Rel] or [Ind].
     This particular data representation is the one of indtypes.
     *)
-and compute_params_rec_strpos_aux env kn uparams nuparams nparams_rec nparams inds =
+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 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
 
-and compute_params_rec_strpos env kn mib =
+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 *)
@@ -192,7 +201,10 @@ and compute_params_rec_strpos env kn mib =
   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 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 } *)
 
@@ -241,6 +253,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

From e2c7ecc67fd4131099505581cf3af58ca377e3cd Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Tue, 20 Jan 2026 13:40:03 +0100
Subject: [PATCH 031/578] Fix nonsensical behaviour of Polymorphic Inductive
 Cumulativity

---
 test-suite/bugs/bug_21524.v   |  8 ++++++
 test-suite/success/CumulInd.v |  9 +++++++
 vernac/attributes.ml          | 50 +++++++++++------------------------
 3 files changed, 33 insertions(+), 34 deletions(-)
 create mode 100644 test-suite/bugs/bug_21524.v

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/success/CumulInd.v b/test-suite/success/CumulInd.v
index 329d6e2f4091..682d29a8dfa7 100644
--- a/test-suite/success/CumulInd.v
+++ b/test-suite/success/CumulInd.v
@@ -4,6 +4,15 @@ Fail Inductive foo@{+u} : Prop := .
 Fail Polymorphic Inductive foo@{*u} : Prop := .
 Inductive foo@{=u} : Prop := .
 
+(* Cumulative attr forbidden without univ poly on *)
+Fail Cumulative Inductive bar@{u} : Prop := .
+
+(* option allowed but does nothing until univ poly is on *)
+Set Polymorphic Inductive Cumulativity.
+
+Fail Inductive bar@{*u} : Prop := .
+Succeed Polymorphic  Inductive bar@{*u} : Prop := .
+
 Set Universe Polymorphism.
 Set Polymorphic Inductive Cumulativity.
 
diff --git a/vernac/attributes.ml b/vernac/attributes.ml
index e06c4c27e9ce..422579164c22 100644
--- a/vernac/attributes.ml
+++ b/vernac/attributes.ml
@@ -294,45 +294,27 @@ 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 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) >>= fun (univ_poly, cumulative) ->
+  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
+  return (PolyFlags.make ~univ_poly ~cumulative ~collapse_sort_variables:true)
 
 let poly_def = poly PolyFlags.Definition
 

From f0976fcfd4120b6eb5d68cebfa00620f5b6b21fa Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Fri, 23 Jan 2026 18:16:47 +0100
Subject: [PATCH 032/578] Ltac2 drop unused loc in binder names of CTacGlb

---
 plugins/ltac2/tac2expr.mli  | 2 +-
 plugins/ltac2/tac2intern.ml | 6 +++---
 plugins/ltac2/tac2print.ml  | 4 ++--
 3 files changed, 6 insertions(+), 6 deletions(-)

diff --git a/plugins/ltac2/tac2expr.mli b/plugins/ltac2/tac2expr.mli
index 724c3a791875..372527aa3ba8 100644
--- a/plugins/ltac2/tac2expr.mli
+++ b/plugins/ltac2/tac2expr.mli
@@ -173,7 +173,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/tac2intern.ml b/plugins/ltac2/tac2intern.ml
index 5a317e831d40..321e23c29d4c 100644
--- a/plugins/ltac2/tac2intern.ml
+++ b/plugins/ltac2/tac2intern.ml
@@ -1120,7 +1120,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
@@ -1391,12 +1391,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
diff --git a/plugins/ltac2/tac2print.ml b/plugins/ltac2/tac2print.ml
index 9d688108dedb..2c4188ca26e9 100644
--- a/plugins/ltac2/tac2print.ml
+++ b/plugins/ltac2/tac2print.ml
@@ -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

From 3ded225547639e6c95f8163c7af536a966631a4b Mon Sep 17 00:00:00 2001
From: Guillaume Melquiond <guillaume.melquiond@inria.fr>
Date: Wed, 9 Apr 2025 10:27:58 +0200
Subject: [PATCH 033/578] Port native_compute to OCaml 5.

---
 kernel/byterun/rocq_values.c | 40 +++++++++++++++++++++++++++++-------
 kernel/nativevalues.ml       | 24 +++++++++++-----------
 tools/configure/configure.ml |  5 +----
 3 files changed, 46 insertions(+), 23 deletions(-)

diff --git a/kernel/byterun/rocq_values.c b/kernel/byterun/rocq_values.c
index 01972d974c47..6cd7770f1369 100644
--- a/kernel/byterun/rocq_values.c
+++ b/kernel/byterun/rocq_values.c
@@ -107,13 +107,39 @@ 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
-  abort();
+/* 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. */
+
+#if defined(__GNUC__) && defined(__amd64__)
+
+asm(".align 8\n\t"
+    ".quad 3067\n"
+    "rocq_curry2_1:\n\t"
+    "jmp caml_curry2_1\n");
+
+#elif defined(__GNUC__) && defined(__i386__)
+
+asm(".align 4\n\t"
+    ".long 3067\n"
+    "rocq_curry2_1:\n\t"
+    "jmp caml_curry2_1\n");
+
 #else
-  Tag_val (arg) = Int_val (new_tag);
+
+void rocq_curry2_1() {
+  abort();
+}
+
 #endif
-  return Val_unit;
+
+value rocq_curry2_1_addr(value) {
+  extern void rocq_curry2_1();
+  return (value)&rocq_curry2_1;
 }
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/tools/configure/configure.ml b/tools/configure/configure.ml
index 4f96d41fd204..62dfff43cfe9 100644
--- a/tools/configure/configure.ml
+++ b/tools/configure/configure.ml
@@ -103,10 +103,7 @@ let caml_version_nums { CamlConf.caml_version; _ } =
   generic_version_nums ~name:"the OCaml compiler" caml_version
 
 let check_caml_version prefs caml_version caml_version_nums =
-  if caml_version_nums >= [5;0;0] && prefs.nativecompiler <> NativeNo 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"
-  else if caml_version_nums >= [4;14;0] then
+  if caml_version_nums >= [4;14;0] then
     cprintf prefs "You have OCaml %s. Good!" caml_version
   else
     let () = cprintf prefs "Your version of OCaml is %s." caml_version in

From 66d55967995025f09cf1be23de15878e458ba8a1 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Thu, 22 Jan 2026 13:10:22 +0100
Subject: [PATCH 034/578] Finer check for native compilation on supported
 architectures.

---
 kernel/byterun/rocq_values.c     |  4 +++-
 tools/configure/configure.ml     |  7 ++++++-
 tools/configure/dune             |  6 +++++-
 tools/configure/rocq_configure.c | 24 ++++++++++++++++++++++++
 4 files changed, 38 insertions(+), 3 deletions(-)
 create mode 100644 tools/configure/rocq_configure.c

diff --git a/kernel/byterun/rocq_values.c b/kernel/byterun/rocq_values.c
index 6cd7770f1369..8cc339c2adf0 100644
--- a/kernel/byterun/rocq_values.c
+++ b/kernel/byterun/rocq_values.c
@@ -115,7 +115,9 @@ value rocq_tcode_array(value tcodes) {
 
    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. */
+   inside blocks that do not have tag 247.
+
+   Keep the compile-time checks in sync with rocq_configure.c */
 
 #if defined(__GNUC__) && defined(__amd64__)
 
diff --git a/tools/configure/configure.ml b/tools/configure/configure.ml
index 62dfff43cfe9..c63f9a6571d0 100644
--- a/tools/configure/configure.ml
+++ b/tools/configure/configure.ml
@@ -102,8 +102,13 @@ let resolve_caml () =
 let caml_version_nums { CamlConf.caml_version; _ } =
   generic_version_nums ~name:"the OCaml compiler" caml_version
 
+external native_5x_available : unit -> bool = "rocq_native_5x_available"
+
 let check_caml_version prefs caml_version caml_version_nums =
-  if caml_version_nums >= [4;14;0] then
+  if caml_version_nums >= [5;0;0] && not (native_5x_available ()) && prefs.nativecompiler <> NativeNo 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 on this architecture"
+  else if caml_version_nums >= [4;14;0] then
     cprintf prefs "You have OCaml %s. Good!" caml_version
   else
     let () = cprintf prefs "Your version of OCaml is %s." caml_version in
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..f09c60a05011
--- /dev/null
+++ b/tools/configure/rocq_configure.c
@@ -0,0 +1,24 @@
+#include <stdlib.h>
+#include <stdio.h>
+#include <caml/memory.h>
+#include <memory.h>
+
+/* Keep in sync with rocq_values.c */
+
+#if defined(__GNUC__) && defined(__amd64__)
+
+#define rocq_proxy_accu_defined
+
+#elif defined(__GNUC__) && defined(__i386__)
+
+#define rocq_proxy_accu_defined
+
+#endif
+
+value rocq_native_5x_available(value dummy) {
+#ifdef rocq_proxy_accu_defined
+  return Val_int(1);
+#else
+  return Val_int(0);
+#endif
+}

From 4bbc2ab745192072dc0fd35f869ff1a92090fd69 Mon Sep 17 00:00:00 2001
From: Guillaume Melquiond <guillaume.melquiond@inria.fr>
Date: Fri, 23 Jan 2026 20:38:59 +0100
Subject: [PATCH 035/578] Restore compatibility with pre-NNP OCaml compilers
 and avoid dynlink errors in bytecode mode.

---
 kernel/byterun/rocq_values.c     | 27 ++++++++++++++++++++++-----
 tools/configure/configure.ml     |  9 ++++++---
 tools/configure/rocq_configure.c | 19 ++++++-------------
 3 files changed, 34 insertions(+), 21 deletions(-)

diff --git a/kernel/byterun/rocq_values.c b/kernel/byterun/rocq_values.c
index 8cc339c2adf0..22642b816fe1 100644
--- a/kernel/byterun/rocq_values.c
+++ b/kernel/byterun/rocq_values.c
@@ -10,6 +10,7 @@
 
 #include <stdlib.h>
 #include <stdio.h>
+#include <caml/config.h>
 #include <caml/memory.h>
 #include "rocq_fix_code.h"
 #include "rocq_instruct.h"
@@ -119,6 +120,13 @@ value rocq_tcode_array(value tcodes) {
 
    Keep the compile-time checks in sync with rocq_configure.c */
 
+#if defined(NO_NAKED_POINTERS)
+
+__attribute__((weak))
+void caml_curry2_1() {
+  abort();
+}
+
 #if defined(__GNUC__) && defined(__amd64__)
 
 asm(".align 8\n\t"
@@ -134,14 +142,23 @@ asm(".align 4\n\t"
     "jmp caml_curry2_1\n");
 
 #else
-
-void rocq_curry2_1() {
-  abort();
-}
-
+#define no_native_compute
 #endif
 
 value rocq_curry2_1_addr(value) {
+#ifdef no_native_compute
+  return (value)NULL;
+#else
   extern void rocq_curry2_1();
   return (value)&rocq_curry2_1;
+#endif
+}
+
+#else // not NO_NAKED_POINTERS
+
+value rocq_curry2_1_addr(value) {
+  extern void caml_curry2_1() __attribute__((weak));
+  return (value)&caml_curry2_1;
 }
+
+#endif
diff --git a/tools/configure/configure.ml b/tools/configure/configure.ml
index c63f9a6571d0..a4df3c6d558b 100644
--- a/tools/configure/configure.ml
+++ b/tools/configure/configure.ml
@@ -102,12 +102,15 @@ let resolve_caml () =
 let caml_version_nums { CamlConf.caml_version; _ } =
   generic_version_nums ~name:"the OCaml compiler" caml_version
 
-external native_5x_available : unit -> bool = "rocq_native_5x_available"
+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] && not (native_5x_available ()) && 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 on this architecture"
+    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
diff --git a/tools/configure/rocq_configure.c b/tools/configure/rocq_configure.c
index f09c60a05011..05290dbf97e2 100644
--- a/tools/configure/rocq_configure.c
+++ b/tools/configure/rocq_configure.c
@@ -1,24 +1,17 @@
-#include <stdlib.h>
-#include <stdio.h>
 #include <caml/memory.h>
-#include <memory.h>
 
 /* Keep in sync with rocq_values.c */
 
 #if defined(__GNUC__) && defined(__amd64__)
-
-#define rocq_proxy_accu_defined
-
 #elif defined(__GNUC__) && defined(__i386__)
-
-#define rocq_proxy_accu_defined
-
+#elif defined(NO_NAKED_POINTERS)
+#define no_native_compute
 #endif
 
-value rocq_native_5x_available(value dummy) {
-#ifdef rocq_proxy_accu_defined
-  return Val_int(1);
-#else
+value rocq_native_available(value dummy) {
+#ifdef no_native_compute
   return Val_int(0);
+#else
+  return Val_int(1);
 #endif
 }

From 714bd3d97d7523bb23f37d16465bb9214a33e8c1 Mon Sep 17 00:00:00 2001
From: ia0 <git@ia0.eu>
Date: Fri, 28 Nov 2025 23:44:41 +0100
Subject: [PATCH 036/578] Do not splice term99

---
 doc/sphinx/language/core/basic.rst       |  3 ++-
 doc/sphinx/language/core/definitions.rst | 24 ++++++++++++------------
 doc/tools/docgram/common.edit_mlg        |  1 -
 doc/tools/docgram/orderedGrammar         | 12 ++++++++----
 4 files changed, 22 insertions(+), 18 deletions(-)

diff --git a/doc/sphinx/language/core/basic.rst b/doc/sphinx/language/core/basic.rst
index 5bbc3d3839fd..631d03d6a8ef 100644
--- a/doc/sphinx/language/core/basic.rst
+++ b/doc/sphinx/language/core/basic.rst
@@ -262,7 +262,8 @@ rest of the Rocq Prover manual: :term:`terms <term>` 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/definitions.rst b/doc/sphinx/language/core/definitions.rst
index fc4634bbe321..5a232d88b26c 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 ::= @term10 <: @type
-   | @term10 <<: @type
-   | @term10 :> @type
-   | @term10 : @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 <LocalInterpretationRulesForNotations>` to
-:n:`@type` then :n:`@term10` is interpreted in that scope.
+:n:`@type` then :n:`@term99` is interpreted in that scope.
 
 .. _gallina-definitions:
 
diff --git a/doc/tools/docgram/common.edit_mlg b/doc/tools/docgram/common.edit_mlg
index e04448ac919c..deee3dc3a9fd 100644
--- a/doc/tools/docgram/common.edit_mlg
+++ b/doc/tools/docgram/common.edit_mlg
@@ -2285,7 +2285,6 @@ SPLICE: [
 | ltac_selector
 | Constr.ident
 | attribute_list
-| term99
 | term90
 | term9
 | term8
diff --git a/doc/tools/docgram/orderedGrammar b/doc/tools/docgram/orderedGrammar
index ac636ef2beed..f367b74f0244 100644
--- a/doc/tools/docgram/orderedGrammar
+++ b/doc/tools/docgram/orderedGrammar
@@ -9,6 +9,10 @@ term: [
 
 term100: [
 | term_cast
+| term99
+]
+
+term99: [
 | term10
 ]
 
@@ -419,10 +423,10 @@ term_generalizing: [
 ]
 
 term_cast: [
-| term10 "<:" type
-| term10 "<<:" type
-| term10 ":>" type
-| term10 ":" type
+| term99 "<:" type
+| term99 "<<:" type
+| term99 ":>" type
+| term99 ":" type
 ]
 
 term_match: [

From e6ad0a7422da6cefd09073098fc42dbe6e45362b Mon Sep 17 00:00:00 2001
From: Guillaume Melquiond <guillaume.melquiond@inria.fr>
Date: Mon, 26 Jan 2026 09:31:14 +0100
Subject: [PATCH 037/578] Document a bit more.

---
 kernel/byterun/rocq_values.c | 7 ++++---
 1 file changed, 4 insertions(+), 3 deletions(-)

diff --git a/kernel/byterun/rocq_values.c b/kernel/byterun/rocq_values.c
index 22642b816fe1..b6f6e238cfd7 100644
--- a/kernel/byterun/rocq_values.c
+++ b/kernel/byterun/rocq_values.c
@@ -116,7 +116,8 @@ value rocq_tcode_array(value tcodes) {
 
    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.
+   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 */
 
@@ -130,14 +131,14 @@ void caml_curry2_1() {
 #if defined(__GNUC__) && defined(__amd64__)
 
 asm(".align 8\n\t"
-    ".quad 3067\n"
+    ".quad 2043\n"
     "rocq_curry2_1:\n\t"
     "jmp caml_curry2_1\n");
 
 #elif defined(__GNUC__) && defined(__i386__)
 
 asm(".align 4\n\t"
-    ".long 3067\n"
+    ".long 2043\n"
     "rocq_curry2_1:\n\t"
     "jmp caml_curry2_1\n");
 

From ff5058da44d2272dba419e7e4873de9bc157d15f Mon Sep 17 00:00:00 2001
From: Guillaume Melquiond <guillaume.melquiond@inria.fr>
Date: Mon, 26 Jan 2026 09:32:38 +0100
Subject: [PATCH 038/578] Disable the C code entirely if Rocq was configured
 without support for native_compute.

---
 kernel/byterun/rocq_values.c | 14 ++++++++------
 tools/configure/configure.ml | 29 +++++++++++++++++++----------
 2 files changed, 27 insertions(+), 16 deletions(-)

diff --git a/kernel/byterun/rocq_values.c b/kernel/byterun/rocq_values.c
index b6f6e238cfd7..845a703db551 100644
--- a/kernel/byterun/rocq_values.c
+++ b/kernel/byterun/rocq_values.c
@@ -121,7 +121,13 @@ value rocq_tcode_array(value tcodes) {
 
    Keep the compile-time checks in sync with rocq_configure.c */
 
-#if defined(NO_NAKED_POINTERS)
+#ifdef NO_NATIVE_COMPUTE
+
+value rocq_curry2_1_addr(value) {
+  return Val_unit;
+}
+
+#elif defined(NO_NAKED_POINTERS)
 
 __attribute__((weak))
 void caml_curry2_1() {
@@ -143,16 +149,12 @@ asm(".align 4\n\t"
     "jmp caml_curry2_1\n");
 
 #else
-#define no_native_compute
+#error "Unsupported architecture for native_compute."
 #endif
 
 value rocq_curry2_1_addr(value) {
-#ifdef no_native_compute
-  return (value)NULL;
-#else
   extern void rocq_curry2_1();
   return (value)&rocq_curry2_1;
-#endif
 }
 
 #else // not NO_NAKED_POINTERS
diff --git a/tools/configure/configure.ml b/tools/configure/configure.ml
index a4df3c6d558b..b2173d1b9b7c 100644
--- a/tools/configure/configure.ml
+++ b/tools/configure/configure.ml
@@ -330,15 +330,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 <https://stackoverflow.com/a/45667927> *)
-    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 <https://stackoverflow.com/a/45667927> *)
+      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).
@@ -521,7 +530,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;

From 42c2d99c4f054b58ac57d1f18fbe32977e99ac8a Mon Sep 17 00:00:00 2001
From: Guillaume Melquiond <guillaume.melquiond@inria.fr>
Date: Mon, 26 Jan 2026 09:58:06 +0100
Subject: [PATCH 039/578] Add changelog entry.

---
 doc/changelog/01-kernel/21540-native5-tag0-alt-Changed.rst | 5 +++++
 1 file changed, 5 insertions(+)
 create mode 100644 doc/changelog/01-kernel/21540-native5-tag0-alt-Changed.rst

diff --git a/doc/changelog/01-kernel/21540-native5-tag0-alt-Changed.rst b/doc/changelog/01-kernel/21540-native5-tag0-alt-Changed.rst
new file mode 100644
index 000000000000..70a23969387b
--- /dev/null
+++ b/doc/changelog/01-kernel/21540-native5-tag0-alt-Changed.rst
@@ -0,0 +1,5 @@
+- **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 <https://github.com/rocq-prover/rocq/pull/21540>`_,
+  fixes `#13940 <https://github.com/rocq-prover/rocq/issues/13940>`_,
+  by Guillaume Melquiond).

From 8bff302d341829f694ff3d88ecb6aa458787dc54 Mon Sep 17 00:00:00 2001
From: Yann Leray <yann.leray@inria.fr>
Date: Mon, 26 Jan 2026 19:38:54 +0100
Subject: [PATCH 040/578] Typo in apply_under_binders

---
 test-suite/bugs/bug_21544.v | 5 +++++
 vernac/comDefinition.ml     | 2 +-
 2 files changed, 6 insertions(+), 1 deletion(-)
 create mode 100644 test-suite/bugs/bug_21544.v

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/vernac/comDefinition.ml b/vernac/comDefinition.ml
index 536272e5b40a..dab32e0114f5 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

From 0b81d35af92153e27e762e7e1db64d4cc441e069 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Tue, 27 Jan 2026 15:54:11 +0100
Subject: [PATCH 041/578] Improve error message for tactic timeout

There is no reason to say "[Prooview.tclTIMEOUT]" in user messages
---
 engine/proofview.ml | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/engine/proofview.ml b/engine/proofview.ml
index 5623c8a4a023..bb846e69d04a 100644
--- a/engine/proofview.ml
+++ b/engine/proofview.ml
@@ -1004,9 +1004,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
 

From 5578a6848aa217479ccb11f0cbb00cf2e950f5d3 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Wed, 28 Jan 2026 14:52:55 +0100
Subject: [PATCH 042/578] Doc for "Printing Let" add ref linking to the
 associated syntax

---
 doc/sphinx/language/extensions/match.rst | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/doc/sphinx/language/extensions/match.rst b/doc/sphinx/language/extensions/match.rst
index ea689e8db62e..458e3630a6ce 100644
--- a/doc/sphinx/language/extensions/match.rst
+++ b/doc/sphinx/language/extensions/match.rst
@@ -94,6 +94,8 @@ constructions. There are two variants of them.
    | let ' @pattern in @pattern := @term return @term100 in @term
 
 
+.. _first-destructuring-let:
+
 First destructuring let syntax
 ++++++++++++++++++++++++++++++
 
@@ -283,7 +285,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:`first destructuring let syntax <first-destructuring-let>`.
 
 .. table:: Printing Let @qualid
 

From 9d9ca80e648bec1bd00b5baf61d441842612db4e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Wed, 28 Jan 2026 14:53:17 +0100
Subject: [PATCH 043/578] Cleanup comment in doc for let-tuple

This syntax doesn't apply to tactics
---
 doc/sphinx/language/extensions/match.rst | 4 +---
 1 file changed, 1 insertion(+), 3 deletions(-)

diff --git a/doc/sphinx/language/extensions/match.rst b/doc/sphinx/language/extensions/match.rst
index 458e3630a6ce..f1a257f60349 100644
--- a/doc/sphinx/language/extensions/match.rst
+++ b/doc/sphinx/language/extensions/match.rst
@@ -99,9 +99,7 @@ constructions. There are two variants of them.
 First destructuring let syntax
 ++++++++++++++++++++++++++++++
 
-.. 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
+.. todo add "irrefutable pattern" to the glossary
 
 The expression :n:`let ( {*, @ident__i } ) := @term__0 in @term__1`
 performs case analysis on :n:`@term__0` whose type must be an

From 48302729a726e3cd607fa0a3ed0977de6bf8f737 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Wed, 28 Jan 2026 14:59:34 +0100
Subject: [PATCH 044/578] doc: add note about the difference between `let (_,
 _) :=` and `let '(_, _) :=`

---
 doc/sphinx/language/extensions/match.rst | 8 ++++++++
 1 file changed, 8 insertions(+)

diff --git a/doc/sphinx/language/extensions/match.rst b/doc/sphinx/language/extensions/match.rst
index f1a257f60349..e7a1f89e7ea2 100644
--- a/doc/sphinx/language/extensions/match.rst
+++ b/doc/sphinx/language/extensions/match.rst
@@ -175,6 +175,14 @@ 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`).
 
+.. note::
+
+   In the first destructuring let syntax, `let (x, y) := ...` handles
+   any inductive type with a unique constructor and 2 arguments.
+
+   In the second 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:
 

From f6bd5fa97ada822fc92fc04ad0024b7c946cfacc Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Wed, 28 Jan 2026 15:15:25 +0100
Subject: [PATCH 045/578] Put back -no-warn option of doc_grammar

I didn't notice that it was both set imperatively and set in the
option record (where the field is then unused) when dealing with the
unused field warning.
---
 doc/Makefile.docgram             | 13 ++++++++++---
 doc/tools/docgram/README.md      |  2 ++
 doc/tools/docgram/doc_grammar.ml |  1 +
 doc/tools/docgram/dune           |  2 +-
 4 files changed, 14 insertions(+), 4 deletions(-)

diff --git a/doc/Makefile.docgram b/doc/Makefile.docgram
index 707d37daa622..e78384058722 100644
--- a/doc/Makefile.docgram
+++ b/doc/Makefile.docgram
@@ -2,6 +2,13 @@
 # doc_grammar tool
 ######################################################################
 
+DOCGRAMWARN ?= 0
+ifeq ($(DOCGRAMWARN),0)
+DOCGRAMWARNFLAG=-no-warn
+else
+DOCGRAMWARNFLAG=
+endif
+
 # List mlg files explicitly to avoid ordering problems (across
 # different installations / make versions).
 DOC_MLGS := \
@@ -44,12 +51,12 @@ endif
 
 doc/tools/docgram/fullGrammar: $(DOC_GRAM) $(DOC_MLGS)
 	$(SHOW)'DOC_GRAM'
-	$(HIDE)$(DOC_GRAM) -short $(DOC_MLGS)
+	$(HIDE)$(DOC_GRAM) -short -no-warn $(DOC_MLGS)
 
 #todo: add a dependency of sphinx on updated_rsts when we're ready
 doc/tools/docgram/orderedGrammar doc/tools/docgram/updated_rsts: doc/tools/docgram/fullGrammar $(DOC_GRAM) $(DOC_EDIT_MLGS)
 	$(SHOW)'DOC_GRAM_RSTS'
-	$(HIDE)$(DOC_GRAM) -check-cmds -check-tacs $(DOC_MLGS) $(DOC_RSTS)
+	$(HIDE)$(DOC_GRAM) $(DOCGRAMWARNFLAG) -check-cmds -check-tacs $(DOC_MLGS) $(DOC_RSTS)
 
 .PRECIOUS: doc/tools/docgram/orderedGrammar
 
@@ -61,7 +68,7 @@ doc_gram: doc/tools/docgram/fullGrammar
 
 doc_gram_verify: $(DOC_GRAM) $(DOC_MLGS)
 	$(SHOW)'DOC_GRAM_VERIFY'
-	$(HIDE)$(DOC_GRAM) -verify -check-cmds -check-tacs $(DOC_MLGS) $(DOC_RSTS)
+	$(HIDE)$(DOC_GRAM) -no-warn -verify -check-cmds -check-tacs $(DOC_MLGS) $(DOC_RSTS)
 
 doc_gram_rsts: doc/tools/docgram/updated_rsts
 
diff --git a/doc/tools/docgram/README.md b/doc/tools/docgram/README.md
index d8dd0db95216..22b20ffbdac1 100644
--- a/doc/tools/docgram/README.md
+++ b/doc/tools/docgram/README.md
@@ -143,6 +143,8 @@ Other command line arguments:
 
 * `-check-cmds` causes generation of `prodnCommands`
 
+* `-no-warn` suppresses printing of some warning messages
+
 * `-no-update` puts updates to `fullGrammar` and `orderedGrammar` into new files named
   `*.new`, leaving the originals unmodified.  For use in Dune.
 
diff --git a/doc/tools/docgram/doc_grammar.ml b/doc/tools/docgram/doc_grammar.ml
index be3888ba07e7..5a8da11616c0 100644
--- a/doc/tools/docgram/doc_grammar.ml
+++ b/doc/tools/docgram/doc_grammar.ml
@@ -1821,6 +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
         | "-no-update" -> { args with update = false }
         | "-short" -> { args with fullGrammar = true }
         | "-verbose" -> { args with verbose = true }
diff --git a/doc/tools/docgram/dune b/doc/tools/docgram/dune
index faaba8a57d67..071acef69229 100644
--- a/doc/tools/docgram/dune
+++ b/doc/tools/docgram/dune
@@ -44,6 +44,6 @@
   orderedGrammar)
  (action
   (progn
-   (chdir %{project_root} (run doc_grammar -check-cmds -no-update %{input}))
+   (chdir %{project_root} (run doc_grammar -no-warn -check-cmds -no-update %{input}))
    (diff? fullGrammar fullGrammar.new)
    (diff? orderedGrammar orderedGrammar.new))))

From 125e981f8bb9394d4fe4e18ab7299885283372cc Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Wed, 28 Jan 2026 15:11:27 +0100
Subject: [PATCH 046/578] Cleanup grammar for letpattern by combining rules

---
 doc/sphinx/language/extensions/match.rst |  3 +--
 doc/tools/docgram/common.edit_mlg        | 10 ++--------
 doc/tools/docgram/fullGrammar            |  4 +---
 doc/tools/docgram/orderedGrammar         |  3 +--
 parsing/g_constr.mlg                     | 14 +++-----------
 test-suite/output/PrintGrammar.out       |  8 ++------
 test-suite/output/PrintGrammarConstr.out |  8 ++------
 7 files changed, 12 insertions(+), 38 deletions(-)

diff --git a/doc/sphinx/language/extensions/match.rst b/doc/sphinx/language/extensions/match.rst
index e7a1f89e7ea2..4af6c8bfa6b9 100644
--- a/doc/sphinx/language/extensions/match.rst
+++ b/doc/sphinx/language/extensions/match.rst
@@ -90,8 +90,7 @@ constructions. There are two variants of them.
 
 .. 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:
diff --git a/doc/tools/docgram/common.edit_mlg b/doc/tools/docgram/common.edit_mlg
index 67c0ae116ee4..2b12707243fe 100644
--- a/doc/tools/docgram/common.edit_mlg
+++ b/doc/tools/docgram/common.edit_mlg
@@ -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: [
diff --git a/doc/tools/docgram/fullGrammar b/doc/tools/docgram/fullGrammar
index ef072bca06ce..2d007eb2273b 100644
--- a/doc/tools/docgram/fullGrammar
+++ b/doc/tools/docgram/fullGrammar
@@ -161,9 +161,7 @@ binder_constr: [
 | "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
+| "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
diff --git a/doc/tools/docgram/orderedGrammar b/doc/tools/docgram/orderedGrammar
index 2afc11218951..33fb93db2e5a 100644
--- a/doc/tools/docgram/orderedGrammar
+++ b/doc/tools/docgram/orderedGrammar
@@ -379,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: [
diff --git a/parsing/g_constr.mlg b/parsing/g_constr.mlg
index 6bddc7fb58e2..6c32c6c54dd1 100644
--- a/parsing/g_constr.mlg
+++ b/parsing/g_constr.mlg
@@ -294,19 +294,11 @@ GRAMMAR EXTEND Gram
         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";
+      | "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, 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)]) }
+          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" ->
diff --git a/test-suite/output/PrintGrammar.out b/test-suite/output/PrintGrammar.out
index a79352a7db0e..6ac58ee6b468 100644
--- a/test-suite/output/PrintGrammar.out
+++ b/test-suite/output/PrintGrammar.out
@@ -13,12 +13,8 @@ Entry binder_constr is
   | "fun"; open_binders; "=>"; term LEVEL "200"
   | "let"; "fix"; fix_decl; "in"; term LEVEL "200"
   | "let"; "cofix"; cofix_body; "in"; term LEVEL "200"
-  | "let"; "'"; pattern LEVEL "200"; ":="; term LEVEL "200"; "in"; term LEVEL
-    "200"
-  | "let"; "'"; pattern LEVEL "200"; ":="; term LEVEL "200"; case_type; "in";
-    term LEVEL "200"
-  | "let"; "'"; pattern LEVEL "200"; "in"; pattern LEVEL "200"; ":="; term
-    LEVEL "200"; case_type; "in"; term LEVEL "200"
+  | "let"; "'"; pattern LEVEL "200"; OPT [ "in"; pattern LEVEL "200" ]; ":=";
+    term LEVEL "200"; OPT case_type; "in"; term LEVEL "200"
   | "let"; name; binders; let_type_cstr; ":="; term LEVEL "200"; "in"; term
     LEVEL "200"
   | "let"; [ "("; LIST0 name SEP ","; ")" | "()" ]; as_return_type; ":=";
diff --git a/test-suite/output/PrintGrammarConstr.out b/test-suite/output/PrintGrammarConstr.out
index 9f4ed3388b34..9b230f711812 100644
--- a/test-suite/output/PrintGrammarConstr.out
+++ b/test-suite/output/PrintGrammarConstr.out
@@ -4,12 +4,8 @@ Entry binder_constr is
   | "fun"; open_binders; "=>"; term LEVEL "200"
   | "let"; "fix"; fix_decl; "in"; term LEVEL "200"
   | "let"; "cofix"; cofix_body; "in"; term LEVEL "200"
-  | "let"; "'"; pattern LEVEL "200"; ":="; term LEVEL "200"; "in"; term LEVEL
-    "200"
-  | "let"; "'"; pattern LEVEL "200"; ":="; term LEVEL "200"; case_type; "in";
-    term LEVEL "200"
-  | "let"; "'"; pattern LEVEL "200"; "in"; pattern LEVEL "200"; ":="; term
-    LEVEL "200"; case_type; "in"; term LEVEL "200"
+  | "let"; "'"; pattern LEVEL "200"; OPT [ "in"; pattern LEVEL "200" ]; ":=";
+    term LEVEL "200"; OPT case_type; "in"; term LEVEL "200"
   | "let"; name; binders; let_type_cstr; ":="; term LEVEL "200"; "in"; term
     LEVEL "200"
   | "let"; [ "("; LIST0 name SEP ","; ")" | "()" ]; as_return_type; ":=";

From 6036c58799eaaa7d47c9f157839c3aa9ec661896 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Wed, 28 Jan 2026 15:52:07 +0100
Subject: [PATCH 047/578] Use :n: for syntax equivalences in destructuring let
 doc

and add a multi constructor case for let-pattern
---
 doc/sphinx/language/extensions/match.rst | 35 ++++++++++++++++--------
 1 file changed, 24 insertions(+), 11 deletions(-)

diff --git a/doc/sphinx/language/extensions/match.rst b/doc/sphinx/language/extensions/match.rst
index 4af6c8bfa6b9..193bd7a6534f 100644
--- a/doc/sphinx/language/extensions/match.rst
+++ b/doc/sphinx/language/extensions/match.rst
@@ -131,26 +131,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
 +++++++++++++++++++++++++++++++
 
-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
 
@@ -170,10 +166,27 @@ 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 first destructuring let syntax, `let (x, y) := ...` handles

From 4c7de248dcd34b34166771fa116346d9fb53b90e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Wed, 28 Jan 2026 15:57:27 +0100
Subject: [PATCH 048/578] Destructuring let doc: name subsections "let-tuple"
 and "let-pattern"

instead of "first" and "second"
---
 doc/sphinx/language/extensions/match.rst | 16 ++++++++--------
 1 file changed, 8 insertions(+), 8 deletions(-)

diff --git a/doc/sphinx/language/extensions/match.rst b/doc/sphinx/language/extensions/match.rst
index 193bd7a6534f..97ad401e84eb 100644
--- a/doc/sphinx/language/extensions/match.rst
+++ b/doc/sphinx/language/extensions/match.rst
@@ -93,10 +93,10 @@ constructions. There are two variants of them.
    | let ' @pattern {? in @pattern } := @term {? return @term100 } in @term
 
 
-.. _first-destructuring-let:
+.. _let-tuple:
 
-First destructuring let syntax
-++++++++++++++++++++++++++++++
+Let-tuple syntax
+++++++++++++++++
 
 .. todo add "irrefutable pattern" to the glossary
 
@@ -141,8 +141,8 @@ and
 
 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 by giving an arbitrary
 pattern (which must be irrefutable) instead of just a tuple for all
@@ -189,10 +189,10 @@ where if :n:`@pattern` is a name then it is used to provide
 
 .. note::
 
-   In the first destructuring let syntax, `let (x, y) := ...` handles
+   In the "let-tuple" syntax, `let (x, y) := ...` handles
    any inductive type with a unique constructor and 2 arguments.
 
-   In the second syntax, `let '(x, y) := ...` handles the inductive
+   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`).
 
@@ -303,7 +303,7 @@ Printing matching on irrefutable patterns
 ++++++++++++++++++++++++++++++++++++++++++
 
 If an inductive type has just one constructor, pattern matching can be
-written using the :ref:`first destructuring let syntax <first-destructuring-let>`.
+written using the :ref:`let-tuple syntax <let-tuple>`.
 
 .. table:: Printing Let @qualid
 

From 8d07b547d66b5130b0dbcfd2b03360e944c073b2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Wed, 28 Jan 2026 16:00:30 +0100
Subject: [PATCH 049/578] Doc: extended matches are not parsing time

---
 doc/sphinx/language/extensions/match.rst | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/doc/sphinx/language/extensions/match.rst b/doc/sphinx/language/extensions/match.rst
index 97ad401e84eb..f698399da212 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:
 

From 100ac4beec888856bc565f9446d5e540ee5f4d94 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Tue, 27 Jan 2026 17:00:56 +0100
Subject: [PATCH 050/578] rocq c does not produce empty vos and vok files

instead the generated makefile handles them
---
 .../09-cli-tools/21548-empty-bok-Changed.rst  |  6 ++++
 doc/sphinx/practical-tools/coq-commands.rst   | 26 ++++++++-------
 test-suite/misc/coqc_dash_vok.sh              | 32 -------------------
 tools/CoqMakefile.in                          |  3 ++
 tools/dune_rule_gen/coq_module.ml             |  1 -
 toplevel/ccompile.ml                          | 30 +++++------------
 6 files changed, 31 insertions(+), 67 deletions(-)
 create mode 100644 doc/changelog/09-cli-tools/21548-empty-bok-Changed.rst
 delete mode 100755 test-suite/misc/coqc_dash_vok.sh

diff --git a/doc/changelog/09-cli-tools/21548-empty-bok-Changed.rst b/doc/changelog/09-cli-tools/21548-empty-bok-Changed.rst
new file mode 100644
index 000000000000..9cbe8104e15a
--- /dev/null
+++ b/doc/changelog/09-cli-tools/21548-empty-bok-Changed.rst
@@ -0,0 +1,6 @@
+- **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 <https://github.com/rocq-prover/rocq/pull/21548>`_,
+  by Gaëtan Gilbert).
diff --git a/doc/sphinx/practical-tools/coq-commands.rst b/doc/sphinx/practical-tools/coq-commands.rst
index 5159223980b6..6c701652c355 100644
--- a/doc/sphinx/practical-tools/coq-commands.rst
+++ b/doc/sphinx/practical-tools/coq-commands.rst
@@ -454,8 +454,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`).
@@ -595,10 +594,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 +602,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 +675,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/test-suite/misc/coqc_dash_vok.sh b/test-suite/misc/coqc_dash_vok.sh
deleted file mode 100755
index 5e4e7f2ff075..000000000000
--- a/test-suite/misc/coqc_dash_vok.sh
+++ /dev/null
@@ -1,32 +0,0 @@
-#!/usr/bin/env bash
-
-IN_V=misc/coqc_cmdline.v
-OUT_VO=misc/coqc_cmdline.vo
-OUT_VOS=misc/coqc_cmdline.vos
-OUT_VOK=misc/coqc_cmdline.vok
-OUT_GLOB=misc/coqc_cmdline.glob
-OUT="${OUT_VO} ${OUT_VOS} ${OUT_VOK} ${OUT_GLOB}"
-
-rm -f ${OUT}
-
-set -x
-
-$coqc ${IN_V} -vos
-$coqc ${IN_V} -vok
-if [ ! -f ${OUT_VOK} ]; then
-  echo "coqc -vok not working in -vos mode"
-  rm -f ${OUT}
-  exit 1
-fi
-
-rm -f ${OUT}
-
-$coqc ${IN_V} -o ${OUT_VO}
-if [ ! -f ${OUT_VOK} ]; then
-  echo "vok not produced in -o mode"
-  rm -f ${OUT}
-  exit 1
-fi
-
-rm -f ${OUT}
-exit 0
diff --git a/tools/CoqMakefile.in b/tools/CoqMakefile.in
index 45da1177ae0e..bf72a055a1ab 100644
--- a/tools/CoqMakefile.in
+++ b/tools/CoqMakefile.in
@@ -784,6 +784,7 @@ 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
@@ -796,6 +797,7 @@ 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 $@
@@ -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/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/toplevel/ccompile.ml b/toplevel/ccompile.ml
index 411e3dd7a141..e43350778157 100644
--- a/toplevel/ccompile.ml
+++ b/toplevel/ccompile.ml
@@ -16,10 +16,6 @@ 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;
@@ -40,12 +36,6 @@ 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
   match mode with
   | BuildVo | BuildVok ->
       let doc, sid = Topfmt.(in_phase ~phase:LoadingPrelude)
@@ -75,18 +65,14 @@ let compile opts stm_options injections copts ~echo ~f_in ~f_out =
       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)

From 9a34d62383567891657ec38c32e98bb43c15cc66 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Tue, 27 Jan 2026 16:52:06 +0100
Subject: [PATCH 051/578] Fix corelib urls in coqdoc

---
 tools/configure/configure.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/tools/configure/configure.ml b/tools/configure/configure.ml
index 8a3fe78521a2..5bd2a80ad119 100644
--- a/tools/configure/configure.ml
+++ b/tools/configure/configure.ml
@@ -443,7 +443,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 "wwwstdlib" (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"

From 89aa9285affdc546989746076a1c1603c1a82517 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Wed, 28 Jan 2026 16:43:52 +0100
Subject: [PATCH 052/578] Rename wwwstdlib -> wwwcorelib etc, add --corelib_url
 arg for rocqdoc

Not entirely sure how best to deprecate a rocqdoc command line
argument, for now it just says deprecated in the usage for
--coqlib_url
---
 config/coq_config.mli        | 2 +-
 ide/rocqide/rocqide.ml       | 2 +-
 tools/configure/configure.ml | 2 +-
 tools/coqdoc/cmdArgs.ml      | 6 ++++--
 tools/coqdoc/common.ml       | 4 ++--
 tools/coqdoc/common.mli      | 2 +-
 tools/coqdoc/index.ml        | 2 +-
 7 files changed, 11 insertions(+), 9 deletions(-)

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/ide/rocqide/rocqide.ml b/ide/rocqide/rocqide.ml
index 3a45f846c6bc..91c1e29321c2 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:"<Primary><Shift>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)));
diff --git a/tools/configure/configure.ml b/tools/configure/configure.ml
index 5bd2a80ad119..97b92b7b6968 100644
--- a/tools/configure/configure.ml
+++ b/tools/configure/configure.ml
@@ -443,7 +443,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 ^ "/corelib/");
+  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"
diff --git a/tools/coqdoc/cmdArgs.ml b/tools/coqdoc/cmdArgs.ml
index 91a2504c1ac1..ded51e9aeca1 100644
--- a/tools/coqdoc/cmdArgs.ml
+++ b/tools/coqdoc/cmdArgs.ml
@@ -184,8 +184,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),
   "<url> <d>  Set URL for external library <d>";
-  "--coqlib_url", arg_string (fun p u -> { p with coqlib_url = u }),
-  "<url> Set URL for Rocq standard library (default: " ^ Coq_config.wwwstdlib ^ ")";
+  "--corelib_url", arg_string (fun p u -> { p with corelib_url = u }),
+  "<url> Set URL for Rocq standard library (default: " ^ Coq_config.wwwcorelib ^ ")";
+  "--coqlib_url", arg_string (fun p u -> { p with corelib_url = u }),
+  "<url> 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 }),
   "<dir> 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..1b70dbb05ae7 100644
--- a/tools/coqdoc/common.ml
+++ b/tools/coqdoc/common.ml
@@ -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..58a6759659f9 100644
--- a/tools/coqdoc/common.mli
+++ b/tools/coqdoc/common.mli
@@ -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

From 0c352c7bc21d80ae28bc4db6219341859ff80f36 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Wed, 28 Jan 2026 17:49:55 +0100
Subject: [PATCH 053/578] `rewrite in` no subterm error mention hyp instead of
 saying "in goal"

---
 pretyping/unification.ml             | 12 ++++++------
 pretyping/unification.mli            |  2 +-
 tactics/rewrite.ml                   |  8 ++++----
 test-suite/output/rewrite_in_err.out |  3 +++
 test-suite/output/rewrite_in_err.v   |  9 +++++++++
 5 files changed, 23 insertions(+), 11 deletions(-)
 create mode 100644 test-suite/output/rewrite_in_err.out
 create mode 100644 test-suite/output/rewrite_in_err.v

diff --git a/pretyping/unification.ml b/pretyping/unification.ml
index 2c0e4b2d9ad0..bf8ec4ef0e8c 100644
--- a/pretyping/unification.ml
+++ b/pretyping/unification.ml
@@ -2416,7 +2416,7 @@ let fast_head_check sigma knd c = match EConstr.kind sigma c, knd with
 (* 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
@@ -2478,7 +2478,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 +2606,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 +2703,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/tactics/rewrite.ml b/tactics/rewrite.ml
index 627601d6917c..715190bf5cc1 100644
--- a/tactics/rewrite.ml
+++ b/tactics/rewrite.ml
@@ -1873,20 +1873,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
@@ -1911,7 +1911,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 }
 
diff --git a/test-suite/output/rewrite_in_err.out b/test-suite/output/rewrite_in_err.out
new file mode 100644
index 000000000000..c32d4838f84d
--- /dev/null
+++ b/test-suite/output/rewrite_in_err.out
@@ -0,0 +1,3 @@
+File "./output/rewrite_in_err.v", line 6, characters 7-23:
+The command has indeed failed with message:
+Found no subterm matching "i" in H.
diff --git a/test-suite/output/rewrite_in_err.v b/test-suite/output/rewrite_in_err.v
new file mode 100644
index 000000000000..85db8edbca32
--- /dev/null
+++ b/test-suite/output/rewrite_in_err.v
@@ -0,0 +1,9 @@
+Require Export Morphisms.
+
+Axiom T : nat -> Prop.
+
+Lemma test i j (Hle : i <= j) (H : T j) : T j.
+  Fail rewrite Hle in H.
+(* The command has indeed failed with message:
+   Found no subterm matching "i" in the current goal. *)
+Abort.

From 27cd36e86d210d3333d5af60800721376eb880c3 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Thu, 29 Jan 2026 13:36:33 +0100
Subject: [PATCH 054/578] Error instead of anomaly for mutual program fixpoints
 with measure

Close #21552
---
 test-suite/bugs/bug_21552.v | 3 +++
 vernac/comFixpoint.ml       | 4 +++-
 2 files changed, 6 insertions(+), 1 deletion(-)
 create mode 100644 test-suite/bugs/bug_21552.v

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/vernac/comFixpoint.ml b/vernac/comFixpoint.ml
index 2073a4393f2b..35b6c8d77f4f 100644
--- a/vernac/comFixpoint.ml
+++ b/vernac/comFixpoint.ml
@@ -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 *)

From 398e4043ff2b93086af0dad19e9bfb4d477260e0 Mon Sep 17 00:00:00 2001
From: Yann Leray <yann.leray@inria.fr>
Date: Tue, 27 Jan 2026 18:01:15 +0100
Subject: [PATCH 055/578] Ensure all files have designated maintainers

---
 .github/CODEOWNERS | 133 +++++++++++++++++++++++++++------------------
 1 file changed, 79 insertions(+), 54 deletions(-)

diff --git a/.github/CODEOWNERS b/.github/CODEOWNERS
index b63244ca64c2..bb20bb8e54dc 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,49 @@
 
 ########## 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
+/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 +208,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 +246,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 +276,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

From db258cb4218830a94ab8a62f0f4609bb83fdd67b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Thu, 29 Jan 2026 15:04:30 +0100
Subject: [PATCH 056/578] egramrocq forget about recursivity of symbols

---
 gramlib/grammar.ml  |  4 +-
 gramlib/grammar.mli |  3 +-
 vernac/egramrocq.ml | 95 ++++++++++++++++++++-------------------------
 3 files changed, 46 insertions(+), 56 deletions(-)

diff --git a/gramlib/grammar.ml b/gramlib/grammar.ml
index 7ab8c9f9b17a..ffe7de84aa30 100644
--- a/gramlib/grammar.ml
+++ b/gramlib/grammar.ml
@@ -128,7 +128,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
 
@@ -1784,7 +1784,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..b0cc7b601971 100644
--- a/gramlib/grammar.mli
+++ b/gramlib/grammar.mli
@@ -136,7 +136,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
 
diff --git a/vernac/egramrocq.ml b/vernac/egramrocq.ml
index 22eec17aac7c..5faf53c79dbe 100644
--- a/vernac/egramrocq.ml
+++ b/vernac/egramrocq.ml
@@ -362,52 +362,47 @@ 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 (make_sep_rules 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) (make_sep_rules 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 (make_sep_rules 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
@@ -504,22 +499,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
@@ -566,15 +556,14 @@ let rec pure_sublevels' assoc from forpat level = function
 | 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 ->
+       if different_levels (from.notation_entry,level) (where,i) then
+         (where,int_of_string i) :: rem
+       else rem
+   in
    (match e with
    | ETProdPattern i -> push InConstrEntry (NumLevel i,InternalProd) rem
    | ETProdConstr (s,p) -> push s p rem
@@ -603,9 +592,9 @@ let extend_constr state forpat ng =
     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

From 8f33a561d9e77e991d86b1e57ebc310700f50ba4 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Thu, 29 Jan 2026 15:25:17 +0100
Subject: [PATCH 057/578] combine int_of_string calls in egramrocq
 pure_sublevels'

---
 vernac/egramrocq.ml | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/vernac/egramrocq.ml b/vernac/egramrocq.ml
index 5faf53c79dbe..b2dfca799ad9 100644
--- a/vernac/egramrocq.ml
+++ b/vernac/egramrocq.ml
@@ -549,7 +549,7 @@ 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
 | [] -> []
@@ -560,8 +560,9 @@ let rec pure_sublevels' assoc from forpat level = function
      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,int_of_string i) :: rem
+         (where,i) :: rem
        else rem
    in
    (match e with

From d11c9f2cbbc12818678a50c15809dc7f61bbebeb Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Thu, 29 Jan 2026 15:29:12 +0100
Subject: [PATCH 058/578] GramConstrNonTerminal id option argument is always
 Some, and content isn't used

---
 parsing/notation_gram.mli |  4 +---
 parsing/procq.mli         |  6 ++----
 vernac/egramrocq.ml       | 15 ++++++---------
 vernac/metasyntax.ml      | 16 +++++++---------
 4 files changed, 16 insertions(+), 25 deletions(-)

diff --git a/parsing/notation_gram.mli b/parsing/notation_gram.mli
index b69f38fc5379..a9f0785e8eca 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
+  | 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
diff --git a/parsing/procq.mli b/parsing/procq.mli
index 914dd95ce5c3..02756096bf71 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
diff --git a/vernac/egramrocq.ml b/vernac/egramrocq.ml
index b2dfca799ad9..36b7175ffefa 100644
--- a/vernac/egramrocq.ml
+++ b/vernac/egramrocq.ml
@@ -461,7 +461,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
@@ -475,9 +475,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) ->
@@ -507,7 +505,7 @@ let rec ty_erase : type s a r. (s, a, r) ty_rule -> (s, a, r) mayrec_rule = func
 | TyNext (rem, TyTerm tok) ->
    let MayRecR rem = ty_erase rem in
    MayRecR (Rule.next rem (Symbol.token tok))
-| TyNext (rem, TyNonTerm (_, _, MayRec s, _)) ->
+| TyNext (rem, TyNonTerm (_, _, MayRec s)) ->
    let MayRecR rem = ty_erase rem in
    MayRecR (Rule.next rem s)
 
@@ -521,12 +519,11 @@ let make_ty_rule assoc from forpat prods =
     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))
@@ -553,7 +550,7 @@ let different_levels (custom,opt_level) (custom',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 =
      let MayRec sym = symbol_of_target where p assoc from forpat in
diff --git a/vernac/metasyntax.ml b/vernac/metasyntax.ml
index 0a9487fb9473..7bbf221c1551 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) *)
@@ -738,15 +737,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 main = GramConstrNonTerminal (ETProdConstr (s,typ)) in
   let tks = List.map (fun (kw,s) -> GramConstrTerminal (kw, s)) 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 @
@@ -809,7 +807,7 @@ let make_production ({notation_level = lev}, _) etyps symbols =
     | [] -> [[]]
     | 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)
@@ -829,16 +827,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

From 6758471b8f1a9765429cd6e7b695eec8a637f4ea Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Thu, 29 Jan 2026 15:55:49 +0100
Subject: [PATCH 059/578] metasyntax convert to token at the same time as we
 check for keyword needed

instead of delaying to egramrocq
---
 parsing/extend.ml         |  4 ++--
 parsing/extend.mli        |  4 ++--
 parsing/notation_gram.mli |  2 +-
 vernac/egramrocq.ml       | 27 +++++++--------------------
 vernac/metasyntax.ml      | 34 ++++++++++++++++++++--------------
 5 files changed, 32 insertions(+), 39 deletions(-)

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/notation_gram.mli b/parsing/notation_gram.mli
index a9f0785e8eca..40722d4690c5 100644
--- a/parsing/notation_gram.mli
+++ b/parsing/notation_gram.mli
@@ -9,7 +9,7 @@
 (************************************************************************)
 
 type grammar_constr_prod_item =
-  | GramConstrTerminal of bool (* true = in keyword position *) * string
+  | 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;
diff --git a/vernac/egramrocq.ml b/vernac/egramrocq.ml
index 36b7175ffefa..1e8511a3b6a9 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
 
@@ -349,18 +349,6 @@ 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 =
 | MayRec : ('s, _, 'a) Symbol.t -> ('s, 'a) mayrec_symbol
 
@@ -386,17 +374,17 @@ let rec symbol_of_entry : type s r. _ -> _ -> (s, r) entry -> (s, r) mayrec_symb
   MayRec (Procq.Symbol.list1 s)
 | TTConstrList (s, typ', tkl, forpat) ->
   let MayRec s = symbol_of_target s typ' assoc from forpat in
-  MayRec (Procq.Symbol.list1sep s (make_sep_rules tkl))
+  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) (make_sep_rules tkl))
+| TTClosedBinderListPure tkl -> MayRec (Procq.Symbol.list1sep (Procq.Symbol.nterm Constr.binder) (Procq.Symbol.tokens tkl))
 | TTClosedBinderListOther (typ,[]) ->
   let MayRec s = symbol_of_entry assoc from typ in
   MayRec (Procq.Symbol.list1 s)
 | TTClosedBinderListOther (typ,tkl) ->
   let MayRec s = symbol_of_entry assoc from typ in
-  MayRec (Procq.Symbol.list1sep s (make_sep_rules tkl))
+  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)
@@ -515,9 +503,8 @@ 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 :: rem ->
     let AnyTyRule r = make_ty_rule rem in
diff --git a/vernac/metasyntax.ml b/vernac/metasyntax.ml
index 7bbf221c1551..341fd43d4f16 100644
--- a/vernac/metasyntax.ml
+++ b/vernac/metasyntax.ml
@@ -738,7 +738,7 @@ let distribute a ll = List.map (fun l -> a @ l) ll
 
 let expand_list_rule s typ tkl x n p ll =
   let main = GramConstrNonTerminal (ETProdConstr (s,typ)) in
-  let tks = List.map (fun (kw,s) -> GramConstrTerminal (kw, s)) tkl 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
@@ -781,26 +781,32 @@ 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
@@ -809,8 +815,8 @@ let make_production ({notation_level = lev}, _) etyps symbols =
         let typ = prod_entry_type (List.assoc m etyps) in
         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 ->
@@ -818,7 +824,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

From e1173183cc9a1300d1b7e90cb4cf7e39013e5f1b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Thu, 29 Jan 2026 17:13:50 +0100
Subject: [PATCH 060/578] Separate grammar extend and adding keywords in
 gramlib

procq still combines them
---
 gramlib/grammar.ml  | 114 ++++++++++++++++++++++++--------------------
 gramlib/grammar.mli |   4 +-
 parsing/procq.ml    |  14 +++---
 3 files changed, 71 insertions(+), 61 deletions(-)

diff --git a/gramlib/grammar.ml b/gramlib/grammar.ml
index 7ab8c9f9b17a..d05af7155eb4 100644
--- a/gramlib/grammar.ml
+++ b/gramlib/grammar.ml
@@ -156,9 +156,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
@@ -686,40 +688,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 +695,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,20 +754,20 @@ 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
@@ -1512,14 +1524,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 *)
 
diff --git a/gramlib/grammar.mli b/gramlib/grammar.mli
index 16c8011b0ae0..fafcc5433374 100644
--- a/gramlib/grammar.mli
+++ b/gramlib/grammar.mli
@@ -165,9 +165,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/parsing/procq.ml b/parsing/procq.ml
index 8cd3a4ff576f..65fc19459ccd 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}
 

From af2788baa8ad0c018f2da5ee8895a8c5e3b7dc0d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Thu, 29 Jan 2026 17:29:32 +0100
Subject: [PATCH 061/578] Fix comment in clexer.mli for odoc

---
 parsing/cLexer.mli | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

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.

From a0931833d526d7ad2a83b7474fc05f2ff0fc3639 Mon Sep 17 00:00:00 2001
From: nicolas tabareau <nicolas.tabareau@gmail.com>
Date: Fri, 30 Jan 2026 11:25:13 +0100
Subject: [PATCH 062/578] add link to 9.2 doc in conf.py

---
 doc/sphinx/conf.py | 1 +
 1 file changed, 1 insertion(+)

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/"),

From f53a1ba51a6b74d6a1dae964c327bb8c5fb3608a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Fri, 30 Jan 2026 14:20:05 +0100
Subject: [PATCH 063/578] Drop tactic "status" in build_by_tactic

It is useless as explained in the comment.
---
 dev/ci/user-overlays/21566-SkySkimmer-build-by-status.sh | 1 +
 plugins/funind/gen_principle.ml                          | 2 +-
 proofs/subproof.ml                                       | 6 ++++--
 proofs/subproof.mli                                      | 4 ++--
 vernac/auto_ind_decl.ml                                  | 6 +++---
 vernac/declare.ml                                        | 3 +--
 6 files changed, 12 insertions(+), 10 deletions(-)
 create mode 100644 dev/ci/user-overlays/21566-SkySkimmer-build-by-status.sh

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/plugins/funind/gen_principle.ml b/plugins/funind/gen_principle.ml
index 5d4cb68ee2d8..62a51b5ae8b3 100644
--- a/plugins/funind/gen_principle.ml
+++ b/plugins/funind/gen_principle.ml
@@ -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 *)
diff --git a/proofs/subproof.ml b/proofs/subproof.ml
index 4bb33de3a997..a222d17eb756 100644
--- a/proofs/subproof.ml
+++ b/proofs/subproof.ml
@@ -135,7 +135,9 @@ 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
+  (* 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
@@ -144,7 +146,7 @@ let build_by_tactic env ~uctx ~poly ~typ tac =
   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
+  body, typ, univs, uctx
 
 let build_by_tactic_opt env ~uctx ~poly ~typ tac =
   try Some (build_by_tactic env ~uctx ~poly ~typ tac)
diff --git a/proofs/subproof.mli b/proofs/subproof.mli
index e15fe359ec77..28a22efc6971 100644
--- a/proofs/subproof.mli
+++ b/proofs/subproof.mli
@@ -27,7 +27,7 @@ val build_by_tactic :
   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 +35,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/vernac/auto_ind_decl.ml b/vernac/auto_ind_decl.ml
index 8798761caa1e..c7e0872dba6d 100644
--- a/vernac/auto_ind_decl.ml
+++ b/vernac/auto_ind_decl.ml
@@ -1195,7 +1195,7 @@ let make_bl_scheme env handle mind =
   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 (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)
@@ -1329,7 +1329,7 @@ let make_lb_scheme env handle mind =
   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 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)
@@ -1524,7 +1524,7 @@ let make_eq_decidability env handle mind =
   (* 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 (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/declare.ml b/vernac/declare.ml
index 0bc8249a6994..0af1f323918a 100644
--- a/vernac/declare.ml
+++ b/vernac/declare.ml
@@ -2466,14 +2466,13 @@ 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) ->
+    | Some (body, types, _univs, uctx) ->
       let () = Inductiveops.control_only_guard env (Evd.from_ctx uctx) (EConstr.of_constr body) in
       Some (body, types, uctx)
   with

From 51894bf1f16be1226463f98a1d61823f3e698330 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Fri, 30 Jan 2026 15:57:04 +0100
Subject: [PATCH 064/578] Fix comment in genarg.mli

register_interp0 is in geninterp not genintern
---
 pretyping/genarg.mli | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/pretyping/genarg.mli b/pretyping/genarg.mli
index 0e7f00f969f4..73f571cca4c9 100644
--- a/pretyping/genarg.mli
+++ b/pretyping/genarg.mli
@@ -36,7 +36,7 @@
       (VernacProof, HintsExtern, Hint Rewrite, etc).
 
       Must be registered with [Genintern.register_intern0] and
-      [Genintern.register_interp0].
+      [Geninterp.register_interp0].
 
       The glob level can be kept (currently with Hint Extern and Hint
       Rewrite) so [Gensubst.register_subst0] is also needed.
@@ -63,7 +63,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 +71,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.
 

From 8bb3ea6664d0b1c16d3fcf31ed755a47d9e16882 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Fri, 30 Jan 2026 15:59:02 +0100
Subject: [PATCH 065/578] Remove unused Gentactic.of_glob_genarg

---
 tactics/gentactic.ml  | 2 --
 tactics/gentactic.mli | 4 ----
 2 files changed, 6 deletions(-)

diff --git a/tactics/gentactic.ml b/tactics/gentactic.ml
index b585212cfe9d..0d53c76853b8 100644
--- a/tactics/gentactic.ml
+++ b/tactics/gentactic.ml
@@ -18,8 +18,6 @@ let of_raw_genarg x = x
 
 let to_raw_genarg x = x
 
-let of_glob_genarg x = x
-
 let print_raw = Pputils.pr_raw_generic
 
 let print_glob = Pputils.pr_glb_generic
diff --git a/tactics/gentactic.mli b/tactics/gentactic.mli
index 529b0b57867c..75f0925b64c1 100644
--- a/tactics/gentactic.mli
+++ b/tactics/gentactic.mli
@@ -20,10 +20,6 @@ type glob_generic_tactic
 val of_raw_genarg : Genarg.raw_generic_argument -> raw_generic_tactic
 (** The genarg must have registrations for all the following APIs. *)
 
-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. *)
-
 val print_raw : Environ.env -> Evd.evar_map -> ?level:Constrexpr.entry_relative_level ->
   raw_generic_tactic -> Pp.t
 

From ff0bcaf401565534b89091e240ed0ea3730ffd60 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Fri, 30 Jan 2026 16:45:01 +0100
Subject: [PATCH 066/578] Gentactic hide that the underlying implem is genarg
 based

We stop exposing the genargs used by gentactic as being genargs and
instead put them in abstract type Gentactic.tag.

In principle we should be able to define our own Dyn and tables instead of
using genargs (we now define our own table for interp because we want another type).
---
 .../21568-SkySkimmer-gentac-up.sh             |  5 +++
 plugins/ltac/pltac.ml                         |  1 -
 plugins/ltac/pptactic.ml                      | 13 ++++--
 plugins/ltac/tacarg.ml                        |  2 +-
 plugins/ltac/tacarg.mli                       |  2 +-
 plugins/ltac/tacintern.ml                     |  2 +-
 plugins/ltac/tacinterp.ml                     |  9 ++++-
 plugins/ltac/tacsubst.ml                      |  2 +-
 plugins/ltac2/tac2env.ml                      |  5 +--
 plugins/ltac2/tac2env.mli                     |  2 +-
 plugins/ltac2/tac2extravals.ml                |  8 ++--
 plugins/ltac2/tac2intern.ml                   |  4 +-
 pretyping/genarg.mli                          | 14 +++----
 tactics/gentactic.ml                          | 40 ++++++++++++++-----
 tactics/gentactic.mli                         | 20 +++++++++-
 vernac/pvernac.ml                             |  6 +--
 vernac/pvernac.mli                            |  2 +-
 17 files changed, 90 insertions(+), 47 deletions(-)
 create mode 100644 dev/ci/user-overlays/21568-SkySkimmer-gentac-up.sh

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/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 81ece7c5dad2..1fd34a8e3b27 100644
--- a/plugins/ltac/pptactic.ml
+++ b/plugins/ltac/pptactic.ml
@@ -1433,7 +1433,12 @@ let () =
   ltop (LevelLe 0)
 
 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))
diff --git a/plugins/ltac/tacarg.ml b/plugins/ltac/tacarg.ml
index c42da18f3bf4..2764b678b56a 100644
--- a/plugins/ltac/tacarg.ml
+++ b/plugins/ltac/tacarg.ml
@@ -32,7 +32,7 @@ let wit_tactic : (raw_tactic_expr, glob_tactic_expr, Val.t) genarg_type =
 
 let wit_ltac_in_term = make0 "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"
diff --git a/plugins/ltac/tacarg.mli b/plugins/ltac/tacarg.mli
index cd1f7dd5b005..26bfcbdeaf0c 100644
--- a/plugins/ltac/tacarg.mli
+++ b/plugins/ltac/tacarg.mli
@@ -49,7 +49,7 @@ val wit_ltac_in_term : (raw_tactic_expr, Names.Id.Set.t * glob_tactic_expr, Util
 (** [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,
diff --git a/plugins/ltac/tacintern.ml b/plugins/ltac/tacintern.ml
index fba856625661..2bace7f2ba65 100644
--- a/plugins/ltac/tacintern.ml
+++ b/plugins/ltac/tacintern.ml
@@ -776,7 +776,7 @@ let () =
   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);
+  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/tacinterp.ml b/plugins/ltac/tacinterp.ml
index 1dfe4e53ec0f..b3217d1770e5 100644
--- a/plugins/ltac/tacinterp.ml
+++ b/plugins/ltac/tacinterp.ml
@@ -2147,8 +2147,13 @@ let () =
   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 ->
diff --git a/plugins/ltac/tacsubst.ml b/plugins/ltac/tacsubst.ml
index 9ab6a9c31551..415297b1a278 100644
--- a/plugins/ltac/tacsubst.ml
+++ b/plugins/ltac/tacsubst.ml
@@ -288,7 +288,7 @@ let () =
   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;
+  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/ltac2/tac2env.ml b/plugins/ltac2/tac2env.ml
index 8dd95904820d..acae4cb6ac78 100644
--- a/plugins/ltac2/tac2env.ml
+++ b/plugins/ltac2/tac2env.ml
@@ -308,10 +308,7 @@ type var_quotation_kind =
 
 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_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..ee42a5235abb 100644
--- a/plugins/ltac2/tac2env.mli
+++ b/plugins/ltac2/tac2env.mli
@@ -184,7 +184,7 @@ val ltac1_prefix : ModPath.t
 val wit_ltac2_constr : (raw_tacexpr, Id.Set.t * glb_tacexpr, Util.Empty.t) genarg_type
 (** 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 =
diff --git a/plugins/ltac2/tac2extravals.ml b/plugins/ltac2/tac2extravals.ml
index d8bc2f900b1e..eb685acef533 100644
--- a/plugins/ltac2/tac2extravals.ml
+++ b/plugins/ltac2/tac2extravals.ml
@@ -354,10 +354,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) =
@@ -443,8 +442,7 @@ let () =
       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 *)
 
diff --git a/plugins/ltac2/tac2intern.ml b/plugins/ltac2/tac2intern.ml
index 321e23c29d4c..c4f1aa99ed0c 100644
--- a/plugins/ltac2/tac2intern.ml
+++ b/plugins/ltac2/tac2intern.ml
@@ -2140,10 +2140,10 @@ let () =
     let tac, _ = intern_rec env (Some (GTypRef (Tuple 0, []))) tac in
     ist, tac
   in
-  Genintern.register_intern0 wit_ltac2_tac intern
+  Gentactic.register_intern 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
+let () = Gentactic.register_subst wit_ltac2_tac subst_expr
 
 let intern_var_quotation_gen ~ispat ist (kind, { CAst.v = id; loc }) =
   let open Genintern in
diff --git a/pretyping/genarg.mli b/pretyping/genarg.mli
index 73f571cca4c9..baac56e8f63d 100644
--- a/pretyping/genarg.mli
+++ b/pretyping/genarg.mli
@@ -35,15 +35,11 @@
     - tactic arguments to commands defined without depending on ltac_plugin
       (VernacProof, HintsExtern, Hint Rewrite, etc).
 
-      Must be registered with [Genintern.register_intern0] and
-      [Geninterp.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.
+      The use of genargs is hidden behind abstract type
+      [Gentactic.tag], and the gentactic register functions must be
+      used. Currently this subcontracts to the genarg infrastructure
+      (eg Genintern) but will probably become independent in the
+      future.
 
     - vernac arguments, used by vernac extend. Usually declared in mlg
       using VERNAC ARGUMENT EXTEND then used in VERNAC EXTEND.
diff --git a/tactics/gentactic.ml b/tactics/gentactic.ml
index 0d53c76853b8..9faaeb612a75 100644
--- a/tactics/gentactic.ml
+++ b/tactics/gentactic.ml
@@ -8,35 +8,57 @@
 (*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
+open Util
 open Names
 
 type raw_generic_tactic = Genarg.raw_generic_argument
 
 type glob_generic_tactic = Genarg.glob_generic_argument
 
-let of_raw_genarg x = x
+type ('raw, 'glob) tag = ('raw, 'glob, Empty.t) Genarg.genarg_type
+
+let make name = Genarg.make0 name
+
+let empty = make "empty"
+
+let of_raw (type a) (tag:(a, _) tag) (x:a) : raw_generic_tactic =
+  GenArg (Rawwit tag, x)
 
 let to_raw_genarg x = x
 
+let register_print = Genprint.register_noval_print0
+
 let print_raw = Pputils.pr_raw_generic
 
 let print_glob = Pputils.pr_glb_generic
 
+let register_subst = Gensubst.register_subst0
+
 let subst = Gensubst.generic_substitute
 
+let register_intern = Genintern.register_intern0
+
 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
 
-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 'glb interp_fun = Geninterp.Val.t Id.Map.t -> 'glb -> unit Proofview.tactic
+
+module InterpObj =
+struct
+  type ('raw, 'glb, 'top) obj = 'glb interp_fun
+  let name = "gentactic.interp"
+  let default _ = None
+end
+
+module Interp = Genarg.Register(InterpObj)
+
+let register_interp = Interp.register0
+
+let interp ?(lfun=Id.Map.empty) (Genarg.GenArg (Glbwit tag, v)) =
+  let interp : _ interp_fun = Interp.obj tag in
+  interp lfun v
 
 let wit_generic_tactic = Genarg.make0 "generic_tactic"
 
diff --git a/tactics/gentactic.mli b/tactics/gentactic.mli
index 75f0925b64c1..77ba14452891 100644
--- a/tactics/gentactic.mli
+++ b/tactics/gentactic.mli
@@ -8,6 +8,7 @@
 (*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
+open Util
 open Names
 
 (** Generic tactic expressions.
@@ -17,8 +18,17 @@ type raw_generic_tactic
 
 type glob_generic_tactic
 
-val of_raw_genarg : Genarg.raw_generic_argument -> raw_generic_tactic
-(** The genarg must have registrations for all the following APIs. *)
+type ('raw, 'glob) tag
+
+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
@@ -26,11 +36,17 @@ 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
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
 

From 3a98b213df9fe3f9d6fb2987c5988fa2ec840343 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Fri, 30 Jan 2026 18:13:03 +0100
Subject: [PATCH 067/578] Stop using genargs to implement gentactic

---
 pretyping/genarg.mli  |  9 ----
 tactics/gentactic.ml  | 96 ++++++++++++++++++++++++++++++++-----------
 tactics/gentactic.mli |  6 +--
 3 files changed, 73 insertions(+), 38 deletions(-)

diff --git a/pretyping/genarg.mli b/pretyping/genarg.mli
index baac56e8f63d..2af6e772f20f 100644
--- a/pretyping/genarg.mli
+++ b/pretyping/genarg.mli
@@ -32,15 +32,6 @@
 
       NB: only the base [ExtraArg] is allowed here.
 
-    - tactic arguments to commands defined without depending on ltac_plugin
-      (VernacProof, HintsExtern, Hint Rewrite, etc).
-
-      The use of genargs is hidden behind abstract type
-      [Gentactic.tag], and the gentactic register functions must be
-      used. Currently this subcontracts to the genarg infrastructure
-      (eg Genintern) but will probably become independent in the
-      future.
-
     - vernac arguments, used by vernac extend. Usually declared in mlg
       using VERNAC ARGUMENT EXTEND then used in VERNAC EXTEND.
 
diff --git a/tactics/gentactic.ml b/tactics/gentactic.ml
index 9faaeb612a75..bea99846b40f 100644
--- a/tactics/gentactic.ml
+++ b/tactics/gentactic.ml
@@ -8,56 +8,104 @@
 (*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
-open Util
 open Names
 
-type raw_generic_tactic = Genarg.raw_generic_argument
+module TDyn = Dyn.Make()
 
-type glob_generic_tactic = Genarg.glob_generic_argument
+type ('raw, 'glb) tag = ('raw * 'glb) TDyn.tag
 
-type ('raw, 'glob) tag = ('raw, 'glob, Empty.t) Genarg.genarg_type
+type raw_generic_tactic = Raw : ('raw, _) tag * 'raw -> raw_generic_tactic
 
-let make name = Genarg.make0 name
+type glob_generic_tactic = Glb : (_, 'glb) tag * 'glb -> glob_generic_tactic
+
+let make name : _ tag = TDyn.create name
 
 let empty = make "empty"
 
 let of_raw (type a) (tag:(a, _) tag) (x:a) : raw_generic_tactic =
-  GenArg (Rawwit tag, x)
+  Raw (tag, x)
+
+module Print = struct
+  type _ t = Print : {
+      raw_print : 'raw Genprint.printer;
+      glb_print : 'glb Genprint.printer;
+    } -> ('raw * 'glb) t
+end
+
+module PrintMap = TDyn.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 to_raw_genarg x = x
+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 register_print = Genprint.register_noval_print0
+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)
 
-let print_raw = Pputils.pr_raw_generic
+module Subst = struct
+  type _ t = Subst : 'glb Gensubst.subst_fun -> (_ * 'glb) t
+end
+
+module SubstMap = TDyn.Map(Subst)
 
-let print_glob = Pputils.pr_glb_generic
+let substs = ref SubstMap.empty
 
-let register_subst = Gensubst.register_subst0
+let register_subst tag subst =
+  assert (not @@ SubstMap.mem tag !substs);
+  substs := SubstMap.add tag (Subst subst) !substs
 
-let subst = Gensubst.generic_substitute
+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
 
-let register_intern = Genintern.register_intern0
+module InternMap = TDyn.Map(Intern)
 
-let intern ?(strict=true) env ?(ltacvars=Id.Set.empty) v =
+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) with ltacvars } in
-  let _, v = Genintern.generic_intern ist v in
-  v
+  let _, v = intern ist v in
+  Glb (tag, v)
 
 type 'glb interp_fun = Geninterp.Val.t Id.Map.t -> 'glb -> unit Proofview.tactic
 
-module InterpObj =
+module Interp =
 struct
-  type ('raw, 'glb, 'top) obj = 'glb interp_fun
-  let name = "gentactic.interp"
-  let default _ = None
+  type _ t = Interp : 'glb interp_fun -> (_ * 'glb) t
 end
 
-module Interp = Genarg.Register(InterpObj)
+module InterpMap = TDyn.Map(Interp)
+
+let interps = ref InterpMap.empty
 
-let register_interp = Interp.register0
+let register_interp tag interp =
+  assert (not @@ InterpMap.mem tag !interps);
+  interps := InterpMap.add tag (Interp interp) !interps
 
-let interp ?(lfun=Id.Map.empty) (Genarg.GenArg (Glbwit tag, v)) =
-  let interp : _ interp_fun = Interp.obj tag in
+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 77ba14452891..99018ad40337 100644
--- a/tactics/gentactic.mli
+++ b/tactics/gentactic.mli
@@ -11,8 +11,7 @@
 open Util
 open Names
 
-(** Generic tactic expressions.
-    Internally implemented using [Genarg]. *)
+(** Generic tactic expressions. *)
 
 type raw_generic_tactic
 
@@ -50,6 +49,3 @@ val register_interp : (_, 'glb) tag -> (Geninterp.Val.t Id.Map.t -> 'glb -> 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 *)

From c90f5fe79c802524e1ae244238291b44b0e18956 Mon Sep 17 00:00:00 2001
From: nicolas tabareau <nicolas.tabareau@gmail.com>
Date: Fri, 30 Jan 2026 18:17:35 +0100
Subject: [PATCH 068/578] changelog for 9.2

---
 .mailmap                                      |   6 +
 dev/tools/list-contributors.sh                |   4 +-
 .../21438-primitive-postponed-eta-Changed.rst |   5 -
 ...1-safe-typing-assert-qualities-Removed.rst |   4 -
 .../21465-better-mod-type-errors-Changed.rst  |   6 -
 .../21540-native5-tag0-alt-Changed.rst        |   5 -
 .../20662-suggest-glob-error-Added.rst        |   4 -
 .../21417-elab-elim-constraints-Added.rst     |   4 -
 .../03-notations/20816-abbrev-mod-Changed.rst |   7 -
 .../20855-abbreviation-Deprecated.rst         |   5 -
 .../20857-qualified-custom-Changed.rst        |   5 -
 .../21107-test-strict-right-assoc-Added.rst   |   4 -
 .../21159-refine-common-prefix-Changed.rst    |   9 -
 .../20045-cmorphisms-params-Fixed.rst         |   5 -
 .../20614-induction-schemes-Changed.rst       |   6 -
 .../20614-induction-schemes-Deprecated.rst    |   5 -
 .../04-tactics/20698-master-Fixed.rst         |   4 -
 ...0780-fix-univpoly-cs-unification-Fixed.rst |   5 -
 .../20810-cctac-primitive-values-Added.rst    |   5 -
 .../04-tactics/21108-rew-hint-cat-Fixed.rst   |   5 -
 ...tion-stop-using-auto-with-star-Removed.rst |   6 -
 .../04-tactics/21172-rm-destauto-Removed.rst  |   5 -
 .../21193-factor-tc-hint-exact-Changed.rst    |   6 -
 .../21245-no-auto-scheme-Deprecated.rst       |   7 -
 .../04-tactics/21356-nested_rec3-Added.rst    |   6 -
 .../04-tactics/21429-sparse_param-Added.rst   |   5 -
 .../20561-ltac2-custom-entry-Added.rst        |   4 -
 .../20759-ltac2-nota-levels-Changed.rst       |  12 -
 .../20794-ltac2-equal-for-ref.rst             |   4 -
 .../20855-abbreviation-Deprecated.rst         |   5 -
 .../20882-ltac2-set-local-Added.rst           |   6 -
 .../21023-ltac2-option-filter-Added.rst       |   4 -
 .../21054-fix-ltac2-pat-parsing-Fixed.rst     |   5 -
 .../21094-ltac2-lpreterm-Added.rst            |   5 -
 .../21096-ltac2-message-lconstr-Added.rst     |   4 -
 .../21162-tac2relevance-Added.rst             |   4 -
 .../06-Ltac2-language/21178-tac2mod-Added.rst |   4 -
 .../21215-ltac2-custom-const-Added.rst        |   5 -
 .../21222-tac2-solve-constraints-Added.rst    |   4 -
 .../21239-tac2pr-things-Added.rst             |   5 -
 .../21252-pr-tac2fail-Added.rst               |   4 -
 .../21264-tac2setglobal-Added.rst             |   4 -
 .../21285-constr-delims-Deprecated.rst        |   8 -
 .../21299-ltac2-compact-Added.rst             |   4 -
 .../21334-ltac2-info-Added.rst                |   5 -
 .../20707-ssrpat-FO-ignore-imparg-Changed.rst |  10 -
 .../21107-test-strict-right-assoc-Changed.rst |   4 -
 .../21244-fix-ssrintro-Changed.rst            |   6 -
 .../19761-hintdb_doc.rst                      |   5 -
 .../20698-rm-loose-hint-Removed.rst           |   4 -
 .../20827-print_hintdb_patterns-Changed.rst   |   6 -
 .../21082-mutual-fixpoint-names-Fixed.rst     |   5 -
 .../21103-show_cmd_diffs-Changed.rst          |   8 -
 .../21114-hintdb-strict-check-Deprecated.rst  |   5 -
 .../21163-scheme-attr-Added.rst               |   5 -
 .../21195-elimination-constraints-Added.rst   |   5 -
 .../21203-create-hint-rewrite-db-Added.rst    |   5 -
 ...it-hint-rewrite-db-creation-Deprecated.rst |   6 -
 .../21241-no-opt-schemes-Changed.rst          |   5 -
 .../21248-scheme-rewriting-Added.rst          |   4 -
 ...ilot-fix-dependent-types-support-Fixed.rst |   5 -
 .../21326-indtab_globref-Changed.rst          |   4 -
 .../21332-derive-gname-Changed.rst            |   5 -
 .../21419-sort-poly-flags-Changed.rst         |   4 -
 ...37-print-assumptions-recursive-Changed.rst |   5 -
 ...-add-fully-qualified-identifiers-Added.rst |   6 -
 .../21473-fix-printing-Fixed.rst              |   4 -
 .../21477-print-assumptions-list-Changed.rst  |   6 -
 .../20878-dep-coqlib-extra-Fixed.rst          |   6 -
 .../20907-corelib-header-Added.rst            |   5 -
 .../09-cli-tools/21038-fix21035-Changed.rst   |   5 -
 .../09-cli-tools/21548-empty-bok-Changed.rst  |   6 -
 ...for-non-assoc-and-non-recovery-Changed.rst |   5 -
 .../20018-strengthen_fix_eq-Added.rst         |   4 -
 .../21211-parray-notation-Changed.rst         |   4 -
 .../21248-scheme-rewriting-Changed.rst        |   6 -
 .../13-extraction/21350-issue-21176-Fixed.rst |   5 -
 .../14-misc/19987-fold-evd-Changed.rst        |   4 -
 .../14-misc/20809-autonaming-goals-Added.rst  |   5 -
 ...-for-induction-principle-cases-Changed.rst |   4 -
 .../14-misc/21306-ramp-up-cond-Changed.rst    |   5 -
 doc/sphinx/changes.rst                        | 577 ++++++++++++++++++
 82 files changed, 585 insertions(+), 412 deletions(-)
 delete mode 100644 doc/changelog/01-kernel/21438-primitive-postponed-eta-Changed.rst
 delete mode 100644 doc/changelog/01-kernel/21451-safe-typing-assert-qualities-Removed.rst
 delete mode 100644 doc/changelog/01-kernel/21465-better-mod-type-errors-Changed.rst
 delete mode 100644 doc/changelog/01-kernel/21540-native5-tag0-alt-Changed.rst
 delete mode 100644 doc/changelog/02-specification-language/20662-suggest-glob-error-Added.rst
 delete mode 100644 doc/changelog/02-specification-language/21417-elab-elim-constraints-Added.rst
 delete mode 100644 doc/changelog/03-notations/20816-abbrev-mod-Changed.rst
 delete mode 100644 doc/changelog/03-notations/20855-abbreviation-Deprecated.rst
 delete mode 100644 doc/changelog/03-notations/20857-qualified-custom-Changed.rst
 delete mode 100644 doc/changelog/03-notations/21107-test-strict-right-assoc-Added.rst
 delete mode 100644 doc/changelog/03-notations/21159-refine-common-prefix-Changed.rst
 delete mode 100644 doc/changelog/04-tactics/20045-cmorphisms-params-Fixed.rst
 delete mode 100644 doc/changelog/04-tactics/20614-induction-schemes-Changed.rst
 delete mode 100644 doc/changelog/04-tactics/20614-induction-schemes-Deprecated.rst
 delete mode 100644 doc/changelog/04-tactics/20698-master-Fixed.rst
 delete mode 100644 doc/changelog/04-tactics/20780-fix-univpoly-cs-unification-Fixed.rst
 delete mode 100644 doc/changelog/04-tactics/20810-cctac-primitive-values-Added.rst
 delete mode 100644 doc/changelog/04-tactics/21108-rew-hint-cat-Fixed.rst
 delete mode 100644 doc/changelog/04-tactics/21129-intuition-stop-using-auto-with-star-Removed.rst
 delete mode 100644 doc/changelog/04-tactics/21172-rm-destauto-Removed.rst
 delete mode 100644 doc/changelog/04-tactics/21193-factor-tc-hint-exact-Changed.rst
 delete mode 100644 doc/changelog/04-tactics/21245-no-auto-scheme-Deprecated.rst
 delete mode 100644 doc/changelog/04-tactics/21356-nested_rec3-Added.rst
 delete mode 100644 doc/changelog/04-tactics/21429-sparse_param-Added.rst
 delete mode 100644 doc/changelog/06-Ltac2-language/20561-ltac2-custom-entry-Added.rst
 delete mode 100644 doc/changelog/06-Ltac2-language/20759-ltac2-nota-levels-Changed.rst
 delete mode 100644 doc/changelog/06-Ltac2-language/20794-ltac2-equal-for-ref.rst
 delete mode 100644 doc/changelog/06-Ltac2-language/20855-abbreviation-Deprecated.rst
 delete mode 100644 doc/changelog/06-Ltac2-language/20882-ltac2-set-local-Added.rst
 delete mode 100644 doc/changelog/06-Ltac2-language/21023-ltac2-option-filter-Added.rst
 delete mode 100644 doc/changelog/06-Ltac2-language/21054-fix-ltac2-pat-parsing-Fixed.rst
 delete mode 100644 doc/changelog/06-Ltac2-language/21094-ltac2-lpreterm-Added.rst
 delete mode 100644 doc/changelog/06-Ltac2-language/21096-ltac2-message-lconstr-Added.rst
 delete mode 100644 doc/changelog/06-Ltac2-language/21162-tac2relevance-Added.rst
 delete mode 100644 doc/changelog/06-Ltac2-language/21178-tac2mod-Added.rst
 delete mode 100644 doc/changelog/06-Ltac2-language/21215-ltac2-custom-const-Added.rst
 delete mode 100644 doc/changelog/06-Ltac2-language/21222-tac2-solve-constraints-Added.rst
 delete mode 100644 doc/changelog/06-Ltac2-language/21239-tac2pr-things-Added.rst
 delete mode 100644 doc/changelog/06-Ltac2-language/21252-pr-tac2fail-Added.rst
 delete mode 100644 doc/changelog/06-Ltac2-language/21264-tac2setglobal-Added.rst
 delete mode 100644 doc/changelog/06-Ltac2-language/21285-constr-delims-Deprecated.rst
 delete mode 100644 doc/changelog/06-Ltac2-language/21299-ltac2-compact-Added.rst
 delete mode 100644 doc/changelog/06-Ltac2-language/21334-ltac2-info-Added.rst
 delete mode 100644 doc/changelog/07-ssreflect/20707-ssrpat-FO-ignore-imparg-Changed.rst
 delete mode 100644 doc/changelog/07-ssreflect/21107-test-strict-right-assoc-Changed.rst
 delete mode 100644 doc/changelog/07-ssreflect/21244-fix-ssrintro-Changed.rst
 delete mode 100644 doc/changelog/08-vernac-commands-and-options/19761-hintdb_doc.rst
 delete mode 100644 doc/changelog/08-vernac-commands-and-options/20698-rm-loose-hint-Removed.rst
 delete mode 100644 doc/changelog/08-vernac-commands-and-options/20827-print_hintdb_patterns-Changed.rst
 delete mode 100644 doc/changelog/08-vernac-commands-and-options/21082-mutual-fixpoint-names-Fixed.rst
 delete mode 100644 doc/changelog/08-vernac-commands-and-options/21103-show_cmd_diffs-Changed.rst
 delete mode 100644 doc/changelog/08-vernac-commands-and-options/21114-hintdb-strict-check-Deprecated.rst
 delete mode 100644 doc/changelog/08-vernac-commands-and-options/21163-scheme-attr-Added.rst
 delete mode 100644 doc/changelog/08-vernac-commands-and-options/21195-elimination-constraints-Added.rst
 delete mode 100644 doc/changelog/08-vernac-commands-and-options/21203-create-hint-rewrite-db-Added.rst
 delete mode 100644 doc/changelog/08-vernac-commands-and-options/21206-deprecate-implicit-hint-rewrite-db-creation-Deprecated.rst
 delete mode 100644 doc/changelog/08-vernac-commands-and-options/21241-no-opt-schemes-Changed.rst
 delete mode 100644 doc/changelog/08-vernac-commands-and-options/21248-scheme-rewriting-Added.rst
 delete mode 100644 doc/changelog/08-vernac-commands-and-options/21313-copilot-fix-dependent-types-support-Fixed.rst
 delete mode 100644 doc/changelog/08-vernac-commands-and-options/21326-indtab_globref-Changed.rst
 delete mode 100644 doc/changelog/08-vernac-commands-and-options/21332-derive-gname-Changed.rst
 delete mode 100644 doc/changelog/08-vernac-commands-and-options/21419-sort-poly-flags-Changed.rst
 delete mode 100644 doc/changelog/08-vernac-commands-and-options/21437-print-assumptions-recursive-Changed.rst
 delete mode 100644 doc/changelog/08-vernac-commands-and-options/21443-copilot-add-fully-qualified-identifiers-Added.rst
 delete mode 100644 doc/changelog/08-vernac-commands-and-options/21473-fix-printing-Fixed.rst
 delete mode 100644 doc/changelog/08-vernac-commands-and-options/21477-print-assumptions-list-Changed.rst
 delete mode 100644 doc/changelog/09-cli-tools/20878-dep-coqlib-extra-Fixed.rst
 delete mode 100644 doc/changelog/09-cli-tools/20907-corelib-header-Added.rst
 delete mode 100644 doc/changelog/09-cli-tools/21038-fix21035-Changed.rst
 delete mode 100644 doc/changelog/09-cli-tools/21548-empty-bok-Changed.rst
 delete mode 100644 doc/changelog/11-corelib/17876-master+gramlib-support-for-non-assoc-and-non-recovery-Changed.rst
 delete mode 100644 doc/changelog/11-corelib/20018-strengthen_fix_eq-Added.rst
 delete mode 100644 doc/changelog/11-corelib/21211-parray-notation-Changed.rst
 delete mode 100644 doc/changelog/11-corelib/21248-scheme-rewriting-Changed.rst
 delete mode 100644 doc/changelog/13-extraction/21350-issue-21176-Fixed.rst
 delete mode 100644 doc/changelog/14-misc/19987-fold-evd-Changed.rst
 delete mode 100644 doc/changelog/14-misc/20809-autonaming-goals-Added.rst
 delete mode 100644 doc/changelog/14-misc/20813-better-names-for-induction-principle-cases-Changed.rst
 delete mode 100644 doc/changelog/14-misc/21306-ramp-up-cond-Changed.rst

diff --git a/.mailmap b/.mailmap
index d9c4cb26dc9e..f1565d1ba1b2 100644
--- a/.mailmap
+++ b/.mailmap
@@ -30,6 +30,7 @@ Frédéric Besson <frederic.besson@inria.fr>         fbesson <fbesson@85f007b7-5
 Frédéric Besson <frederic.besson@inria.fr>         BESSON Frederic <frederic.besson@inria.fr>
 Frédéric Besson <frederic.besson@inria.fr>         fajb <fajb@users.noreply.github.com>
 Siddharth Bhat <siddu.druid@gmail.com>             Siddharth <siddu.druid@gmail.com>
+Eric Bistal < >                                    ericbistal-coder
 Lasse Blaauwbroek <lasse@blaauwbroek.eu>           Lasse Blaauwbroek <lasse@lasse-work.localdomain>
 Lasse Blaauwbroek <lasse@blaauwbroek.eu>           LasseBlaauwbroek
 Martin Bodin <martin.bodin@ens-lyon.org>           Martin Bodin <mbodin@ic.ac.uk>
@@ -50,6 +51,7 @@ Arthur Charguéraud <arthur@chargueraud.org>        charguer <arthur@chargueraud
 chluebi <42419603+chluebi@users.noreply.github.com>  chluebi <42419603+chluebi@users.noreply.github.com>
 Tej Chajed <tchajed@mit.edu>                       tchajed
 Jeffrey Chang <72239159+JeffreyChang12@users.noreply.github.com>  JeffreyChang12 <72239159+JeffreyChang12@users.noreply.github.com>
+Dan Christensen                                    jdchristensen <jdchristensen@users.noreply.github.com>
 Xavier Clerc <xavier.clerc@inria.fr>               xclerc <xclerc@85f007b7-540e-0410-9357-904b9bb8a0f7>
 Xavier Clerc <xavier.clerc@inria.fr>               xclerc <xavier.clerc@inria.fr>
 Cyril Cohen <cyril.cohen@crans.org>                Cyril Cohen <cohen@crans.org>
@@ -57,10 +59,12 @@ Cyril Cohen <cyril.cohen@crans.org>                Cyril Cohen <CohenCyril@users
 Cyril Cohen <cyril.cohen@crans.org>                CohenCyril <CohenCyril@users.noreply.github.com>
 Juan Conejero <juanconrod@protonmail.com>                 Juan C <juanconrod@protonmail.com>
 Pierre Corbineau <Pierre.Corbineau@NOSPAM@imag.fr> corbinea <corbinea@85f007b7-540e-0410-9357-904b9bb8a0f7>
+Pierre Corbineau <Pierre.Corbineau@NOSPAM@imag.fr> PierreCorbineau
 Judicaël Courant <courant@gforge>                  courant <courant@85f007b7-540e-0410-9357-904b9bb8a0f7>
 Pierre Courtieu <Pierre.Courtieu@cnam.fr>          courtieu <courtieu@85f007b7-540e-0410-9357-904b9bb8a0f7>
 Pierre Courtieu <Pierre.Courtieu@cnam.fr>          Matafou
 Julien Cretin <github@ia0.eu>                      ia0 <git@ia0.eu>
+Tomás Díaz <tomdtron@gmail.com>                    TDiazT
 David Delahaye <delahaye@gforge>                   delahaye <delahaye@85f007b7-540e-0410-9357-904b9bb8a0f7>
 Maxime Dénès <mail@maximedenes.fr>                 mdenes <mdenes@85f007b7-540e-0410-9357-904b9bb8a0f7>
 Maxime Dénès <mail@maximedenes.fr>                 Maxime Denes <maximedenes@gillespie.inria.fr>
@@ -151,6 +155,7 @@ Larry Darryl Lee Jr. <llee454@gmail.com>           llee454@gmail.com <llee454@gm
 Larry Darryl Lee Jr. <llee454@gmail.com>           Larry D. Lee Jr <llee454@gmail.com>
 Rodolphe Lepigre <rodolphe@bedrocksystems.com>     rlepigre
 Rodolphe Lepigre <rodolphe@bedrocksystems.com>     rlepigre-skylabs-ai
+Yann Leray <yann.leray@inria.fr>                   yannl35133 <yannl35133@users.noreply.github.com>
 Xavier Leroy <xavier.leroy@college-de-france.fr>   Xavier Leroy <xavier.leroy@inria.fr>
 Pierre Letouzey <pierre.letouzey@inria.fr>         letouzey <letouzey@85f007b7-540e-0410-9357-904b9bb8a0f7>
 Pierre Letouzey <pierre.letouzey@inria.fr>         letouzey <pierre.letouzey@inria.fr>
@@ -159,6 +164,7 @@ Yishuai Li <yishuai@cis.upenn.edu>                 Yishuai Li <yishuai@upenn.edu
 Yishuai Li <yishuai@cis.upenn.edu>                 Yishuai Li <liyishuai@users.noreply.github.com>
 Assia Mahboubi <assia.mahboubi@inria.fr>           amahboub <amahboub@85f007b7-540e-0410-9357-904b9bb8a0f7>
 Kenji Maillard <kenji.maillard@inria.fr>           Kenji Maillard <kenji@maillard.blue>
+Kenji Maillard <kenji.maillard@inria.fr>           kyoDralliam
 Evgeny Makarov <emakarov@gforge>                   emakarov <emakarov@85f007b7-540e-0410-9357-904b9bb8a0f7>
 Gregory Malecha <gmalecha@eecs.harvard.edu>        Gregory Malecha <gmalecha@cs.harvard.edu>
 Gregory Malecha <gmalecha@eecs.harvard.edu>        Gregory Malecha <gmalecha@gmail.com>
diff --git a/dev/tools/list-contributors.sh b/dev/tools/list-contributors.sh
index 6afa02b78211..b1ef1ae65b36 100755
--- a/dev/tools/list-contributors.sh
+++ b/dev/tools/list-contributors.sh
@@ -7,14 +7,14 @@ if [ $# != 1 ]; then
   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/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 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/21465>`_,
-  fixes `#21464 <https://github.com/rocq-prover/rocq/issues/21464>`_,
-  by Jason Gross).
diff --git a/doc/changelog/01-kernel/21540-native5-tag0-alt-Changed.rst b/doc/changelog/01-kernel/21540-native5-tag0-alt-Changed.rst
deleted file mode 100644
index 70a23969387b..000000000000
--- a/doc/changelog/01-kernel/21540-native5-tag0-alt-Changed.rst
+++ /dev/null
@@ -1,5 +0,0 @@
-- **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 <https://github.com/rocq-prover/rocq/pull/21540>`_,
-  fixes `#13940 <https://github.com/rocq-prover/rocq/issues/13940>`_,
-  by Guillaume Melquiond).
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 <https://github.com/rocq-prover/rocq/pull/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 <elim-constraints>`
-  (`#21417 <https://github.com/rocq-prover/rocq/pull/21417>`_,
-  by Tomas Diaz).
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 <https://github.com/rocq-prover/rocq/pull/20816>`_,
-  fixes `#20668 <https://github.com/rocq-prover/rocq/issues/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 <Abbreviation>`,
-  use "Abbreviation" instead
-  (`#20855 <https://github.com/rocq-prover/rocq/pull/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 <Declare 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 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/21159>`_,
-  by Pierre Roux).
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 <https://github.com/rocq-prover/rocq/pull/20045>`_,
-  fixes `#20044 <https://github.com/rocq-prover/rocq/issues/20044>`_,
-  by quarkcool).
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 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/20780>`_,
-  fixes `#20779 <https://github.com/rocq-prover/rocq/issues/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 <https://github.com/rocq-prover/rocq/pull/20810>`_,
-  fixes `#20011 <https://github.com/rocq-prover/rocq/issues/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 <https://github.com/rocq-prover/rocq/pull/21108>`_,
-  fixes `#21106 <https://github.com/rocq-prover/rocq/issues/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 <https://github.com/rocq-prover/rocq/pull/21129>`_,
-  fixes `#4949 <https://github.com/rocq-prover/rocq/issues/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 <https://github.com/rocq-prover/rocq/pull/21172>`_,
-  fixes `#11537 <https://github.com/rocq-prover/rocq/issues/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 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/21429>`_,
-  by Thomas Lamiaux).
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 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/20759>`_,
-  fixes `#20616 <https://github.com/rocq-prover/rocq/issues/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 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/coq/coq/pull/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 <Ltac2 Abbreviation>`,
-  use "Abbreviation" instead
-  (`#20855 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/20882>`_,
-  fixes `#20879 <https://github.com/rocq-prover/rocq/issues/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 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/21054>`_,
-  fixes `#21045 <https://github.com/rocq-prover/rocq/issues/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 <syntactic_classes>` `lpreterm` parsing terms
-  at precedence levl 200 and interpreting them as preterms
-  (`#21094 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/21239>`_,
-  by Gaëtan Gilbert).
diff --git a/doc/changelog/06-Ltac2-language/21252-pr-tac2fail-Added.rst b/doc/changelog/06-Ltac2-language/21252-pr-tac2fail-Added.rst
deleted file mode 100644
index 97811493a5a4..000000000000
--- a/doc/changelog/06-Ltac2-language/21252-pr-tac2fail-Added.rst
+++ /dev/null
@@ -1,4 +0,0 @@
-- **Added:**
-  APIs `Control.print_err` and `Control.print_exn` which may be used to customize printing of Ltac2 errors
-  (`#21252 <https://github.com/rocq-prover/rocq/pull/21252>`_,
-  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 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/21334>`_,
-  fixes `#21312 <https://github.com/rocq-prover/rocq/issues/21312>`_,
-  by Gaëtan Gilbert).
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 <https://github.com/rocq-prover/rocq/pull/20707>`_,
-  fixes `#16763 <https://github.com/rocq-prover/rocq/issues/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 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/21244>`_,
-  by Pierre Roux).
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 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/21082>`_,
-  fixes `#20766 <https://github.com/rocq-prover/rocq/issues/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 <https://github.com/rocq-prover/rocq/pull/21103>`_,
-  fixes `#20793 <https://github.com/rocq-prover/rocq/issues/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 <https://github.com/rocq-prover/rocq/pull/21114>`_,
-  fixes `#4117 <https://github.com/rocq-prover/rocq/issues/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 <https://github.com/rocq-prover/rocq/pull/21163>`_,
-  fixes `#19480 <https://github.com/rocq-prover/rocq/issues/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 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/21313>`_,
-  fixes `#21292 <https://github.com/rocq-prover/rocq/issues/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 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/21437>`_,
-  fixes `#21436 <https://github.com/rocq-prover/rocq/issues/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 <https://github.com/rocq-prover/rocq/pull/21443>`_,
-  fixes `#11852 <https://github.com/rocq-prover/rocq/issues/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
deleted file mode 100644
index 106c6d059e88..000000000000
--- a/doc/changelog/08-vernac-commands-and-options/21473-fix-printing-Fixed.rst
+++ /dev/null
@@ -1,4 +0,0 @@
-- **Fixed:** fallback printing of inductives using
-  ``<inductive:Foo:0>`` should be rarer (it should in any case only
-  happen rarely from module errors) (`#21473
-  <https://github.com/rocq-prover/rocq/pull/21473>`_, by Jason Gross).
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 <https://github.com/rocq-prover/rocq/pull/21477>`_,
-  by Jason Gross).
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 <https://github.com/rocq-prover/rocq/pull/20878>`_,
-  fixes `#20835 <https://github.com/rocq-prover/rocq/issues/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 <rocqdoc>` replaces `@@TITLE@@` with the page title in custom HTML headers
-  (`#20907 <https://github.com/rocq-prover/rocq/pull/20907>`_,
-  fixes `#2511 <https://github.com/rocq-prover/rocq/issues/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 <https://github.com/rocq-prover/rocq/pull/21038>`_,
-  fixes `#21035 <https://github.com/rocq-prover/rocq/issues/21035>`_,
-  by Pierre Roux).
diff --git a/doc/changelog/09-cli-tools/21548-empty-bok-Changed.rst b/doc/changelog/09-cli-tools/21548-empty-bok-Changed.rst
deleted file mode 100644
index 9cbe8104e15a..000000000000
--- a/doc/changelog/09-cli-tools/21548-empty-bok-Changed.rst
+++ /dev/null
@@ -1,6 +0,0 @@
-- **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 <https://github.com/rocq-prover/rocq/pull/21548>`_,
-  by Gaëtan Gilbert).
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 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/21248>`_,
-  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 <https://github.com/rocq-prover/rocq/pull/21350>`_,
-  fixes `#21176 <https://github.com/rocq-prover/rocq/issues/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 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/21306>`_,
-  by Gaëtan Gilbert).
diff --git a/doc/sphinx/changes.rst b/doc/sphinx/changes.rst
index 467ebc130810..3bda88d2bb4b 100644
--- a/doc/sphinx/changes.rst
+++ b/doc/sphinx/changes.rst
@@ -8,6 +8,583 @@ Recent changes
 
    .. include:: ../unreleased.rst
 
+Version 9.2
+-----------
+
+.. contents::
+   :local:
+   :depth: 1
+
+Summary of changes
+~~~~~~~~~~~~~~~~~~
+
+We highlight some of the most impactful changes here:
+
+- Records in `Type` and `Prop`, with only fields in `SProp`,
+  can now have primitive projections but without eta conversion.
+- 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
+- Implicit elaboration of :ref:`elimination constraints <elim-constraints>`
+- 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)
+- congruence tactics now handle primitive ints, floats and strings
+- 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`.
+- Add a `Scheme All` command to generate the `All` predicate and its theorem
+  for inductive types used for the eliminators of nested inductive types
+- :cmd:`Ltac2 Custom Entry` making it possible to define more complex :cmd:`Ltac2 Notation`\s
+  and many other additions to Ltac2 (see below for details).
+  attribute :attr:`schemes` to control automatic scheme declaration
+  (`#21163 <https://github.com/rocq-prover/rocq/pull/21163>`_,
+  fixes `#19480 <https://github.com/rocq-prover/rocq/issues/19480>`_,
+  by Gaëtan Gilbert).
+- Parsing of elimination constraints in prenex polymorphic definitions
+  as well as in constraints declaration :g:`Constraint s1 -> s2.`
+- A :cmd:`Create Rewrite HintDb` command to explicitly declare
+  rewrite hint databases
+- :cmd:`Scheme Rewriting` to explicitly declare rewriting schemes for a given inductive
+- :flag:`Printing Fully Qualified` to print all names (global references, modules,
+  module types, universes, etc) using fully qualified paths
+- Goal names can be automatically generated for :tacn:`induction`,
+  :tacn:`destruct` and :tacn:`eapply` by using the :flag:`Generate Goal Names` flag
+
+
+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 <https://rocq-prover.org/doc/v9.2/refman>`_,
+documentation of the 9.2 `corelib <https://rocq-prover.org/doc/v9.2/corelib>`__
+and `developer documentation of the 9.2 ML API <https://rocq-prover.org/doc/v9.2/api>`_
+are also available.
+
+Théo Zimmermann, with help from Jason Gross and Gaëtan Gilbert, maintained
+`coqbot <https://github.com/rocq-prover/bot>`__ used to run Rocq's CI and other
+pull request management tasks.
+
+Jason Gross maintained the `bug minimizer <https://github.com/JasonGross/coq-tools>`_
+and its `automatic use through coqbot <https://github.com/rocq-prover/rocq/wiki/Coqbot-minimize-feature>`_.
+
+Ali Caglayan, Emilio Jesús Gallego Arias, Rudi Grinberg and Rodolphe Lepigre maintained the
+`Dune build system for OCaml and Coq/Rocq <https://github.com/ocaml/dune/>`_
+used to build the Rocq Prover itself and many Rocq projects.
+
+The `opam repository <https://github.com/coq/opam>`_ 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 <https://rocq-prover.org/packages>`_.
+
+Erik Martin-Dorel maintained the
+`Rocq Docker images <https://hub.docker.com/r/rocq/rocq-prover>`_ and
+the `docker-keeper <https://gitlab.com/erikmd/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 <https://github.com/coq-community/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 <https://github.com/coq-community/coq-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, 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 <https://rocq-prover.org/rocq-team>`_ page for
+more details on Rocq's development teams.
+
+The 43 contributors to the 9.2 version are:
+CharlesCNorton, Ilan, JasonGross, JeanCASPAR, 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, Claude Opus 4.5, 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 <https://discourse.rocq-prover.org>`__ and the
+`Rocq Zulip chat <https://rocq-prover.zulipchat.com>`_.
+
+Nicolas Tabareau is the release managers of Rocq 9.2.
+This release is the result of 397 merged PRs, closing 56 issues.
+
+| Nantes, MArch 2026
+| Nicolas Tabareau for the Rocq development team
+
+Changes in 9.2.0
+~~~~~~~~~~~~~~~~
+
+.. contents::
+   :local:
+
+
+Kernel
+^^^^^^
+
+- **Changed:**
+  Records in `Type` and `Prop`, with only fields in `SProp`,
+  can now have primitive projections but without eta conversion.
+  (`#21438 <https://github.com/rocq-prover/rocq/pull/21438>`_,
+  by Tomas Diaz).
+- **Changed:**
+  Error messages for module signature mismatches and "with Definition"
+  constraint failures are now more detailed
+  (`#21465 <https://github.com/rocq-prover/rocq/pull/21465>`_,
+  fixes `#21464 <https://github.com/rocq-prover/rocq/issues/21464>`_,
+  by Jason Gross).
+- **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 <https://github.com/rocq-prover/rocq/pull/21540>`_,
+  fixes `#13940 <https://github.com/rocq-prover/rocq/issues/13940>`_,
+  by Guillaume Melquiond).
+- **Removed:**
+  the ability to define monomorphic sorts within sections
+  (`#21451 <https://github.com/rocq-prover/rocq/pull/21451>`_,
+  by Pierre-Marie Pédrot).
+
+Specification language, type inference
+^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+
+- **Added:**
+  when a reference is not found in the current environment, the error suggests similar names
+  (`#20662 <https://github.com/rocq-prover/rocq/pull/20662>`_,
+  by Gaëtan Gilbert).
+- **Added:**
+  implicit elaboration of :ref:`elimination constraints <elim-constraints>`
+  (`#21417 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/20816>`_,
+  fixes `#20668 <https://github.com/rocq-prover/rocq/issues/20668>`_,
+  by Gaëtan Gilbert).
+- **Changed:**
+  :cmd:`custom entry <Declare 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 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/21159>`_,
+  by Pierre Roux).
+- **Deprecated:**
+  use of "Notation" keyword for :cmd:`abbreviations <Abbreviation>`,
+  use "Abbreviation" instead
+  (`#20855 <https://github.com/rocq-prover/rocq/pull/20855>`_,
+  by Pierre Roux).
+- **Added:**
+  a warning for non closed notations at level 0
+  (`#21107 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/21193>`_,
+  by Pierre-Marie Pédrot).
+- **Removed:**
+  the implicit call to `auto with *` in intuition solver, that
+  was deprecated since 8.17
+  (`#21129 <https://github.com/rocq-prover/rocq/pull/21129>`_,
+  fixes `#4949 <https://github.com/rocq-prover/rocq/issues/4949>`_,
+  by Pierre-Marie Pédrot).
+- **Removed:**
+  the `destauto` tactic, which was deprecated in 8.20
+  (`#21172 <https://github.com/rocq-prover/rocq/pull/21172>`_,
+  fixes `#11537 <https://github.com/rocq-prover/rocq/issues/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 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/21245>`_,
+  by Gaëtan Gilbert).
+- **Added:**
+  congruence tactics now handle primitive ints, floats and strings
+  (`#20810 <https://github.com/rocq-prover/rocq/pull/20810>`_,
+  fixes `#20011 <https://github.com/rocq-prover/rocq/issues/20011>`_,
+  by Pierre-Marie Pédrot).
+- **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 <https://github.com/rocq-prover/rocq/pull/21356>`_,
+  by Thomas Lamiaux).
+- **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 <https://github.com/rocq-prover/rocq/pull/21429>`_,
+  by Thomas Lamiaux).
+- **Fixed:**
+  ``setoid_rewrite`` now correctly picks up ``Params`` instances when rewriting in ``Type``
+  (`#20045 <https://github.com/rocq-prover/rocq/pull/20045>`_,
+  fixes `#20044 <https://github.com/rocq-prover/rocq/issues/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 <https://github.com/rocq-prover/rocq/pull/20698>`_,
+  by Gaëtan Gilbert).
+- **Fixed:**
+  Canonical structure resolution in tactic unification in presence of
+  universe polymorphism (`#20780 <https://github.com/rocq-prover/rocq/pull/20780>`_,
+  fixes `#20779 <https://github.com/rocq-prover/rocq/issues/20779>`_,
+  by Matthieu Sozeau).
+- **Fixed:**
+  rewrite hints are controlled by the `hints` import category
+  (`#21108 <https://github.com/rocq-prover/rocq/pull/21108>`_,
+  fixes `#21106 <https://github.com/rocq-prover/rocq/issues/21106>`_,
+  by Gaëtan Gilbert).
+
+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 <https://github.com/rocq-prover/rocq/pull/20759>`_,
+  fixes `#20616 <https://github.com/rocq-prover/rocq/issues/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 <https://github.com/rocq-prover/rocq/pull/20759>`_,
+  by Gaëtan Gilbert).
+- **Deprecated:**
+  use of "Notation" keyword for :cmd:`abbreviations <Ltac2 Abbreviation>`,
+  use "Abbreviation" instead
+  (`#20855 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/21285>`_,
+  by Gaëtan Gilbert).
+- **Added:**
+  :cmd:`Ltac2 Custom Entry` making it possible to define more complex :cmd:`Ltac2 Notation`\s
+  (`#20561 <https://github.com/rocq-prover/rocq/pull/20561>`_,
+  by Gaëtan Gilbert).
+- **Added:**
+  ``Ltac2.Reference.equal``
+  (`#20794 <https://github.com/coq/coq/pull/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 <https://github.com/rocq-prover/rocq/pull/20882>`_,
+  fixes `#20879 <https://github.com/rocq-prover/rocq/issues/20879>`_,
+  by Gaëtan Gilbert).
+- **Added:**
+  ``Ltac2.Option.filter``
+  (`#21023 <https://github.com/rocq-prover/rocq/pull/21023>`_,
+  by Jason Gross).
+- **Added:**
+  :ref:`syntactic class <syntactic_classes>` `lpreterm` parsing terms
+  at precedence levl 200 and interpreting them as preterms
+  (`#21094 <https://github.com/rocq-prover/rocq/pull/21094>`_,
+  by Gaëtan Gilbert).
+- **Added:**
+  `Ltac2.Message.of_lconstr` to print terms without surrounding parentheses
+  (`#21096 <https://github.com/rocq-prover/rocq/pull/21096>`_,
+  by Gaëtan Gilbert).
+- **Added:**
+  module `Ltac2.Constr.Relevance` for APIs about proof relevance annotations
+  (`#21162 <https://github.com/rocq-prover/rocq/pull/21162>`_,
+  by Gaëtan Gilbert).
+- **Added:**
+  APIs for module introspection in `Ltac2.Module`
+  (`#21178 <https://github.com/rocq-prover/rocq/pull/21178>`_,
+  by Gaëtan Gilbert).
+- **Added:**
+  :ref:`syntactic_classes` parsing terms support parsing at a specific level
+  and parsing :ref:`custom-entries`
+  (`#21215 <https://github.com/rocq-prover/rocq/pull/21215>`_,
+  by Gaëtan Gilbert).
+- **Added:**
+  `Ltac2.Unification.solve_constraints` (cf :tacn:`solve_constraints`)
+  (`#21222 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/21252>`_,
+  by Gaëtan Gilbert).
+- **Added:**
+  :cmd:`Ltac2 Set` supports attribute :attr:`global`
+  (`#21264 <https://github.com/rocq-prover/rocq/pull/21264>`_,
+  by Gaëtan Gilbert).
+- **Added:**
+  :flag:`Ltac2 Backtrace Compact` to reduce the output of :flag:`Ltac2 Backtrace`
+  (`#21299 <https://github.com/rocq-prover/rocq/pull/21299>`_,
+  by Gaëtan Gilbert).
+- **Added:**
+  `Message.of_exninfo` and `Control.current_exninfo`
+  (`#21334 <https://github.com/rocq-prover/rocq/pull/21334>`_,
+  fixes `#21312 <https://github.com/rocq-prover/rocq/issues/21312>`_,
+  by Gaëtan Gilbert).
+- **Fixed:**
+  associativity of `::` in Ltac2 `match` patterns (:n:`@tac2pat2`)
+  (`#21054 <https://github.com/rocq-prover/rocq/pull/21054>`_,
+  fixes `#21045 <https://github.com/rocq-prover/rocq/issues/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 <https://github.com/rocq-prover/rocq/pull/20707>`_,
+  fixes `#16763 <https://github.com/rocq-prover/rocq/issues/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 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/21103>`_,
+  fixes `#20793 <https://github.com/rocq-prover/rocq/issues/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 <https://github.com/rocq-prover/rocq/pull/21241>`_,
+  by Gaëtan Gilbert).
+- **Changed:**
+  Generalize :cmd:`Register Scheme` from constants to constants, or inductive types, or constructors
+  (`#21326 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/21332>`_,
+  by Gaëtan Gilbert).
+- **Changed:**
+  Generalized universe polymorphism flag structure (ML API change)
+  (`#21419 <https://github.com/rocq-prover/rocq/pull/21419>`_,
+  by Matthieu Sozeau).
+- **Changed:**
+  :cmd:`Print Assumptions` now recurses into the types of axioms
+  (`#21437 <https://github.com/rocq-prover/rocq/pull/21437>`_,
+  fixes `#21436 <https://github.com/rocq-prover/rocq/issues/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 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/20698>`_,
+  by Gaëtan Gilbert).
+- **Deprecated:**
+  implicitly creating hint databases when declaring hints.
+  (`#21114 <https://github.com/rocq-prover/rocq/pull/21114>`_,
+  fixes `#4117 <https://github.com/rocq-prover/rocq/issues/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 <https://github.com/rocq-prover/rocq/pull/21206>`_,
+  by Pierre-Marie Pédrot).
+- **Added:**
+  Additional documentation of Create HintDb (discriminated), proof search
+  tactic performance, matching process and hint transparency
+  (`#19761 <https://github.com/rocq-prover/rocq/pull/19761>`_,
+  by Jim Fehrle).
+- **Added:**
+  attribute :attr:`schemes` to control automatic scheme declaration
+  (`#21163 <https://github.com/rocq-prover/rocq/pull/21163>`_,
+  fixes `#19480 <https://github.com/rocq-prover/rocq/issues/19480>`_,
+  by Gaëtan Gilbert).
+- **Added:**
+  Parsing of elimination constraints in prenex polymorphic definitions
+  as well as in constraints declaration :g:`Constraint s1 -> s2.`
+  (`#21195 <https://github.com/rocq-prover/rocq/pull/21195>`_,
+  by Johann Rosain).
+- **Added:**
+  a :cmd:`Create Rewrite HintDb` command to explicitly declare
+  rewrite hint databases
+  (`#21203 <https://github.com/rocq-prover/rocq/pull/21203>`_,
+  by Pierre-Marie Pédrot).
+- **Added:**
+  :cmd:`Scheme Rewriting` to explicitly declare rewriting schemes for a given inductive
+  (`#21248 <https://github.com/rocq-prover/rocq/pull/21248>`_,
+  by Gaëtan Gilbert).
+- **Added:**
+  :flag:`Printing Fully Qualified` to print all names (global references, modules,
+  module types, universes, etc) using fully qualified paths
+  (`#21443 <https://github.com/rocq-prover/rocq/pull/21443>`_,
+  fixes `#11852 <https://github.com/rocq-prover/rocq/issues/11852>`_,
+  by Jason Gross).
+- **Fixed:**
+  Properly test for duplicate names in mutual blocks
+  (`#21082 <https://github.com/rocq-prover/rocq/pull/21082>`_,
+  fixes `#20766 <https://github.com/rocq-prover/rocq/issues/20766>`_,
+  by Yann Leray).
+- **Fixed:**
+  Fix Derive command to handle dependent types correctly
+  (`#21313 <https://github.com/rocq-prover/rocq/pull/21313>`_,
+  fixes `#21292 <https://github.com/rocq-prover/rocq/issues/21292>`_,
+  by copilot-swe-agent[bot]).
+- **Fixed:** fallback printing of inductives using
+  ``<inductive:Foo:0>`` should be rarer (it should in any case only
+  happen rarely from module errors) (`#21473
+  <https://github.com/rocq-prover/rocq/pull/21473>`_, by Jason Gross).
+
+Command-line tools
+^^^^^^^^^^^^^^^^^^
+
+- **Changed:**
+  in ``-emacs`` mode, goals are no longer spontaneously printed
+  (`#21038 <https://github.com/rocq-prover/rocq/pull/21038>`_,
+  fixes `#21035 <https://github.com/rocq-prover/rocq/issues/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 <https://github.com/rocq-prover/rocq/pull/21548>`_,
+  by Gaëtan Gilbert).
+- **Added:**
+  :ref:`rocq doc <rocqdoc>` replaces `@@TITLE@@` with the page title in custom HTML headers
+  (`#20907 <https://github.com/rocq-prover/rocq/pull/20907>`_,
+  fixes `#2511 <https://github.com/rocq-prover/rocq/issues/2511>`_,
+  by Gaëtan Gilbert).
+- **Fixed:**
+  ``rocq dep`` now handles non .vo dependencies from the ``ROCQPATH``
+  environment variable
+  (`#20878 <https://github.com/rocq-prover/rocq/pull/20878>`_,
+  fixes `#20835 <https://github.com/rocq-prover/rocq/issues/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 <https://github.com/rocq-prover/rocq/pull/17876>`_,
+  by Pierre Roux).
+- **Changed:**
+  level of postfix notations in `PrimArray` to level 1
+  (`#21211 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/21248>`_,
+  by Gaëtan Gilbert).
+- **Added:**
+  a slightly more general variant of Fix_eq which is sometimes more convenient
+  (`#20018 <https://github.com/rocq-prover/rocq/pull/20018>`_,
+  by Owen Conoly).
+
+Infrastructure and dependencies
+^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+
+Extraction
+^^^^^^^^^^
+
+- **Fixed:**
+  Added "effect" as a recognized keyword for ocaml extraction
+  (`#21350 <https://github.com/rocq-prover/rocq/pull/21350>`_,
+  fixes `#21176 <https://github.com/rocq-prover/rocq/issues/21176>`_,
+  by Dan Rostovtsev).
+
+Miscellaneous
+^^^^^^^^^^^^^
+
+- **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 <https://github.com/rocq-prover/rocq/pull/19987>`_,
+  by Quentin Vermande).
+- **Changed:**
+  Hypotheses of generated induction schemes use the constructor name instead of `f`, `f0`, etc
+  (`#20813 <https://github.com/rocq-prover/rocq/pull/20813>`_,
+  by Dario Halilovic).
+- **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 <https://github.com/rocq-prover/rocq/pull/21306>`_,
+  by Gaëtan Gilbert).
+- **Added:**
+  Goal names can be automatically generated for :tacn:`induction`,
+  :tacn:`destruct` and :tacn:`eapply` by using the :flag:`Generate Goal Names` flag
+  (`#20809 <https://github.com/rocq-prover/rocq/pull/20809>`_,
+  by Dario Halilovic).
+
+
 Version 9.1
 -----------
 

From 3713efae1f59cc0c4a907144eedd564cdbe756b7 Mon Sep 17 00:00:00 2001
From: nicolas tabareau <nicolas.tabareau@gmail.com>
Date: Mon, 2 Feb 2026 10:38:53 +0100
Subject: [PATCH 069/578] add links to highlight

---
 doc/sphinx/changes.rst | 54 ++++++++++++++++++++++++++++++------------
 1 file changed, 39 insertions(+), 15 deletions(-)

diff --git a/doc/sphinx/changes.rst b/doc/sphinx/changes.rst
index 3bda88d2bb4b..359e69f8aeb7 100644
--- a/doc/sphinx/changes.rst
+++ b/doc/sphinx/changes.rst
@@ -21,34 +21,31 @@ Summary of changes
 We highlight some of the most impactful changes here:
 
 - Records in `Type` and `Prop`, with only fields in `SProp`,
-  can now have primitive projections but without eta conversion.
-- Reenable support for `native_compute` when compiled with OCaml 5.
+  can now have :ref:`primitive projections but without eta conversion<92etarecord>`.
+- :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
-- Implicit elaboration of :ref:`elimination constraints <elim-constraints>`
+- Implicit elaboration of :ref:`elimination constraints <92elimconstraints>`
 - 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)
-- congruence tactics now handle primitive ints, floats and strings
-- Induction hypotheses are now generated for nested arguments provided
+- congruence tactics now :ref:`handle primitive ints, floats and strings<92congruence>`
+- :ref:`Induction hypotheses are now generated for nested arguments<92nested>` provided
   a `All` predicate, and a theorem to prove it have been registered with
   the keys `All` and `AllForall`.
-- Add a `Scheme All` command to generate the `All` predicate and its theorem
+- 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
-- :cmd:`Ltac2 Custom Entry` making it possible to define more complex :cmd:`Ltac2 Notation`\s
+- :cmd:`Ltac2 Custom Entry` making it possible to define :ref:`more complex :cmd:`Ltac2 Notation`\s<92ltac2>`
   and many other additions to Ltac2 (see below for details).
-  attribute :attr:`schemes` to control automatic scheme declaration
+- attribute :attr:`schemes` to :ref:`control automatic scheme declaration<92scheme>`
   (`#21163 <https://github.com/rocq-prover/rocq/pull/21163>`_,
   fixes `#19480 <https://github.com/rocq-prover/rocq/issues/19480>`_,
   by Gaëtan Gilbert).
-- Parsing of elimination constraints in prenex polymorphic definitions
+- :ref:`Parsing of elimination constraints<92elimparsing>` in prenex polymorphic definitions
   as well as in constraints declaration :g:`Constraint s1 -> s2.`
-- A :cmd:`Create Rewrite HintDb` command to explicitly declare
-  rewrite hint databases
-- :cmd:`Scheme Rewriting` to explicitly declare rewriting schemes for a given inductive
-- :flag:`Printing Fully Qualified` to print all names (global references, modules,
+- :flag:`Printing Fully Qualified` to :ref:`print all names<92printfully>` (global references, modules,
   module types, universes, etc) using fully qualified paths
-- Goal names can be automatically generated for :tacn:`induction`,
+- :ref:`Goal names can be automatically generated<92goalnames>` for :tacn:`induction`,
   :tacn:`destruct` and :tacn:`eapply` by using the :flag:`Generate Goal Names` flag
 
 
@@ -130,6 +127,8 @@ Changes in 9.2.0
 Kernel
 ^^^^^^
 
+.. _92etarecord:
+
 - **Changed:**
   Records in `Type` and `Prop`, with only fields in `SProp`,
   can now have primitive projections but without eta conversion.
@@ -141,6 +140,7 @@ Kernel
   (`#21465 <https://github.com/rocq-prover/rocq/pull/21465>`_,
   fixes `#21464 <https://github.com/rocq-prover/rocq/issues/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 <https://github.com/rocq-prover/rocq/pull/21540>`_,
@@ -158,8 +158,11 @@ Specification language, type inference
   when a reference is not found in the current environment, the error suggests similar names
   (`#20662 <https://github.com/rocq-prover/rocq/pull/20662>`_,
   by Gaëtan Gilbert).
+
+.. _92elimconstaints:
+
 - **Added:**
-  implicit elaboration of :ref:`elimination constraints <elim-constraints>`
+  implicit elaboration of :ref:`elimination constraints <92elimconstraints>`
   (`#21417 <https://github.com/rocq-prover/rocq/pull/21417>`_,
   by Tomas Diaz).
 
@@ -235,17 +238,26 @@ Tactics
   These schemes are now explicitly declared for `eq` in the Corelib
   (`#21245 <https://github.com/rocq-prover/rocq/pull/21245>`_,
   by Gaëtan Gilbert).
+
+.. _92congruence:
+
 - **Added:**
   congruence tactics now handle primitive ints, floats and strings
   (`#20810 <https://github.com/rocq-prover/rocq/pull/20810>`_,
   fixes `#20011 <https://github.com/rocq-prover/rocq/issues/20011>`_,
   by Pierre-Marie Pédrot).
+
+.. _92nested:
+
 - **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 <https://github.com/rocq-prover/rocq/pull/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
@@ -299,6 +311,9 @@ Ltac2 language
   See :n:`@ltac2_constr_synclass_arg`
   (`#21285 <https://github.com/rocq-prover/rocq/pull/21285>`_,
   by Gaëtan Gilbert).
+
+.. _92ltac2:
+
 - **Added:**
   :cmd:`Ltac2 Custom Entry` making it possible to define more complex :cmd:`Ltac2 Notation`\s
   (`#20561 <https://github.com/rocq-prover/rocq/pull/20561>`_,
@@ -461,6 +476,9 @@ Commands and options
   tactic performance, matching process and hint transparency
   (`#19761 <https://github.com/rocq-prover/rocq/pull/19761>`_,
   by Jim Fehrle).
+
+.. _92scheme:
+
 - **Added:**
   attribute :attr:`schemes` to control automatic scheme declaration
   (`#21163 <https://github.com/rocq-prover/rocq/pull/21163>`_,
@@ -480,6 +498,9 @@ Commands and options
   :cmd:`Scheme Rewriting` to explicitly declare rewriting schemes for a given inductive
   (`#21248 <https://github.com/rocq-prover/rocq/pull/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
@@ -578,6 +599,9 @@ Miscellaneous
   This should partially mitigate the performance lost since OCaml 4.14
   (`#21306 <https://github.com/rocq-prover/rocq/pull/21306>`_,
   by Gaëtan Gilbert).
+
+.. _92goalnames:
+
 - **Added:**
   Goal names can be automatically generated for :tacn:`induction`,
   :tacn:`destruct` and :tacn:`eapply` by using the :flag:`Generate Goal Names` flag

From b1221caa003cc706e9ba91678b4d7f80ca42a3e5 Mon Sep 17 00:00:00 2001
From: Mathis Bouverot-Dupuis <mathis.bouverot@ens.psl.eu>
Date: Thu, 29 Jan 2026 11:20:08 +0100
Subject: [PATCH 070/578] ltac2: operations to manipulate transparent states

---
 .../21558-ltac2-transparent-state-Added.rst   |  6 ++
 plugins/ltac2/tac2stdlib.ml                   | 82 ++++++++++++++++++-
 theories/Ltac2/TransparentState.v             | 63 +++++++++++++-
 3 files changed, 148 insertions(+), 3 deletions(-)
 create mode 100644 doc/changelog/06-Ltac2-language/21558-ltac2-transparent-state-Added.rst

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 <https://github.com/rocq-prover/rocq/pull/21558>`_,
+  by Mathis Bouverot-Dupuis).
diff --git a/plugins/ltac2/tac2stdlib.ml b/plugins/ltac2/tac2stdlib.ml
index d968a1a70bd8..b9e727b2311c 100644
--- a/plugins/ltac2/tac2stdlib.ml
+++ b/plugins/ltac2/tac2stdlib.ml
@@ -710,16 +710,94 @@ 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
 
 (** Tactics around Evarconv unification (in [Ltac2/Unification.v]). *)
 
diff --git a/theories/Ltac2/TransparentState.v b/theories/Ltac2/TransparentState.v
index 20cfdba2e8bd..dec7da365743 100644
--- a/theories/Ltac2/TransparentState.v
+++ b/theories/Ltac2/TransparentState.v
@@ -10,7 +10,8 @@
 
 Require Import Ltac2.Init.
 
-(** 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.
 
 (** [empty] is the empty transparency state (all constants are opaque). *)
@@ -25,3 +26,63 @@ 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".

From d0cf2cf22b3539f79c8ae678765f9e991502371a Mon Sep 17 00:00:00 2001
From: nicolas tabareau <nicolas.tabareau@gmail.com>
Date: Mon, 2 Feb 2026 10:54:52 +0100
Subject: [PATCH 071/578] apply various fixes

---
 doc/sphinx/changes.rst | 114 +++++++++++++++++++++--------------------
 1 file changed, 59 insertions(+), 55 deletions(-)

diff --git a/doc/sphinx/changes.rst b/doc/sphinx/changes.rst
index 359e69f8aeb7..652c349a6f4d 100644
--- a/doc/sphinx/changes.rst
+++ b/doc/sphinx/changes.rst
@@ -20,34 +20,30 @@ 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>`.
-- :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
 - 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>`
-- :ref:`Induction hypotheses are now generated for nested arguments<92nested>` provided
-  a `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
-- :cmd:`Ltac2 Custom Entry` making it possible to define :ref:`more complex :cmd:`Ltac2 Notation`\s<92ltac2>`
+- :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).
-- attribute :attr:`schemes` to :ref:`control automatic scheme declaration<92scheme>`
-  (`#21163 <https://github.com/rocq-prover/rocq/pull/21163>`_,
-  fixes `#19480 <https://github.com/rocq-prover/rocq/issues/19480>`_,
-  by Gaëtan Gilbert).
-- :ref:`Parsing of elimination constraints<92elimparsing>` in prenex polymorphic definitions
-  as well as in constraints declaration :g:`Constraint s1 -> s2.`
 - :flag:`Printing Fully Qualified` to :ref:`print all names<92printfully>` (global references, modules,
   module types, universes, etc) using fully qualified paths
-- :ref:`Goal names can be automatically generated<92goalnames>` for :tacn:`induction`,
-  :tacn:`destruct` and :tacn:`eapply` by using the :flag:`Generate Goal Names` flag
-
+- :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**.
@@ -88,7 +84,7 @@ 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, Rodolphe Lepigre, Yann Leray,
+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.
@@ -97,12 +93,12 @@ See the `Rocq Team <https://rocq-prover.org/rocq-team>`_ page for
 more details on Rocq's development teams.
 
 The 43 contributors to the 9.2 version are:
-CharlesCNorton, Ilan, JasonGross, JeanCASPAR, quarkcool, Lionel Blatter, Mathis Bouverot,
+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, Claude Opus 4.5, Clément Pit-Claudel, Pierre-Marie Pédrot,
+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.
 
@@ -111,10 +107,10 @@ the GitHub issue and pull request system,
 the `Discourse forum <https://discourse.rocq-prover.org>`__ and the
 `Rocq Zulip chat <https://rocq-prover.zulipchat.com>`_.
 
-Nicolas Tabareau is the release managers of Rocq 9.2.
+Nicolas Tabareau is the release manager of Rocq 9.2.
 This release is the result of 397 merged PRs, closing 56 issues.
 
-| Nantes, MArch 2026
+| Nantes, March 2026
 | Nicolas Tabareau for the Rocq development team
 
 Changes in 9.2.0
@@ -140,7 +136,9 @@ Kernel
   (`#21465 <https://github.com/rocq-prover/rocq/pull/21465>`_,
   fixes `#21464 <https://github.com/rocq-prover/rocq/issues/21464>`_,
   by Jason Gross).
-.. _92native:
+
+  .. _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 <https://github.com/rocq-prover/rocq/pull/21540>`_,
@@ -159,10 +157,10 @@ Specification language, type inference
   (`#20662 <https://github.com/rocq-prover/rocq/pull/20662>`_,
   by Gaëtan Gilbert).
 
-.. _92elimconstaints:
+  .. _92elimconstraints:
 
 - **Added:**
-  implicit elaboration of :ref:`elimination constraints <92elimconstraints>`
+  implicit elaboration of elimination constraints
   (`#21417 <https://github.com/rocq-prover/rocq/pull/21417>`_,
   by Tomas Diaz).
 
@@ -239,7 +237,7 @@ Tactics
   (`#21245 <https://github.com/rocq-prover/rocq/pull/21245>`_,
   by Gaëtan Gilbert).
 
-.. _92congruence:
+  .. _92congruence:
 
 - **Added:**
   congruence tactics now handle primitive ints, floats and strings
@@ -247,16 +245,16 @@ Tactics
   fixes `#20011 <https://github.com/rocq-prover/rocq/issues/20011>`_,
   by Pierre-Marie Pédrot).
 
-.. _92nested:
+  .. _92nested:
 
 - **Added:**
   Induction hypotheses are now generated for nested arguments provided
-  a `All` predicate, and a theorem to prove it have been registered with
+  an `All` predicate, and a theorem to prove it, have been registered with
   the keys `All` and `AllForall`.
   (`#21356 <https://github.com/rocq-prover/rocq/pull/21356>`_,
   by Thomas Lamiaux).
 
-.. _92nestedscheme:
+  .. _92nestedscheme:
 
 - **Added:**
   Add a `Scheme All` command to generate the `All` predicate and its theorem
@@ -282,6 +280,22 @@ Tactics
   (`#21108 <https://github.com/rocq-prover/rocq/pull/21108>`_,
   fixes `#21106 <https://github.com/rocq-prover/rocq/issues/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 <https://github.com/rocq-prover/rocq/pull/19987>`_,
+  by Quentin Vermande).
+- **Changed:**
+  Hypotheses of generated induction schemes use the constructor name instead of `f`, `f0`, etc
+  (`#20813 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/20809>`_,
+  by Dario Halilovic).
 
 Ltac2 language
 ^^^^^^^^^^^^^^
@@ -312,7 +326,7 @@ Ltac2 language
   (`#21285 <https://github.com/rocq-prover/rocq/pull/21285>`_,
   by Gaëtan Gilbert).
 
-.. _92ltac2:
+  .. _92ltac2:
 
 - **Added:**
   :cmd:`Ltac2 Custom Entry` making it possible to define more complex :cmd:`Ltac2 Notation`\s
@@ -334,7 +348,7 @@ Ltac2 language
   by Jason Gross).
 - **Added:**
   :ref:`syntactic class <syntactic_classes>` `lpreterm` parsing terms
-  at precedence levl 200 and interpreting them as preterms
+  at precedence level 200 and interpreting them as preterms
   (`#21094 <https://github.com/rocq-prover/rocq/pull/21094>`_,
   by Gaëtan Gilbert).
 - **Added:**
@@ -441,6 +455,9 @@ Commands and options
   (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 <https://github.com/rocq-prover/rocq/pull/21332>`_,
   by Gaëtan Gilbert).
+
+  .. _92mlapi:
+
 - **Changed:**
   Generalized universe polymorphism flag structure (ML API change)
   (`#21419 <https://github.com/rocq-prover/rocq/pull/21419>`_,
@@ -477,13 +494,16 @@ Commands and options
   (`#19761 <https://github.com/rocq-prover/rocq/pull/19761>`_,
   by Jim Fehrle).
 
-.. _92scheme:
+  .. _92scheme:
 
 - **Added:**
   attribute :attr:`schemes` to control automatic scheme declaration
   (`#21163 <https://github.com/rocq-prover/rocq/pull/21163>`_,
   fixes `#19480 <https://github.com/rocq-prover/rocq/issues/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.`
@@ -499,7 +519,7 @@ Commands and options
   (`#21248 <https://github.com/rocq-prover/rocq/pull/21248>`_,
   by Gaëtan Gilbert).
 
-.. _92printfully:
+  .. _92printfully:
 
 - **Added:**
   :flag:`Printing Fully Qualified` to print all names (global references, modules,
@@ -516,7 +536,7 @@ Commands and options
   Fix Derive command to handle dependent types correctly
   (`#21313 <https://github.com/rocq-prover/rocq/pull/21313>`_,
   fixes `#21292 <https://github.com/rocq-prover/rocq/issues/21292>`_,
-  by copilot-swe-agent[bot]).
+  by Jason Gross).
 - **Fixed:** fallback printing of inductives using
   ``<inductive:Foo:0>`` should be rarer (it should in any case only
   happen rarely from module errors) (`#21473
@@ -561,7 +581,7 @@ Corelib
   (`#21211 <https://github.com/rocq-prover/rocq/pull/21211>`_,
   by Pierre Roux).
 - **Changed:**
-  rewriting schemes for `eq·` and `eq_true` are explicitly declared in `Init.Logic`
+  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 <https://github.com/rocq-prover/rocq/pull/21248>`_,
@@ -586,28 +606,12 @@ Extraction
 Miscellaneous
 ^^^^^^^^^^^^^
 
-- **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 <https://github.com/rocq-prover/rocq/pull/19987>`_,
-  by Quentin Vermande).
-- **Changed:**
-  Hypotheses of generated induction schemes use the constructor name instead of `f`, `f0`, etc
-  (`#20813 <https://github.com/rocq-prover/rocq/pull/20813>`_,
-  by Dario Halilovic).
 - **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 <https://github.com/rocq-prover/rocq/pull/21306>`_,
   by Gaëtan Gilbert).
 
-.. _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 <https://github.com/rocq-prover/rocq/pull/20809>`_,
-  by Dario Halilovic).
-
 
 Version 9.1
 -----------
@@ -939,7 +943,7 @@ Ltac2 language
   (`#20656 <https://github.com/rocq-prover/rocq/pull/20656>`_,
   by Gaëtan Gilbert).
 
-.. _91ltac2notationfix:
+  .. _91ltac2notationfix:
 
 - **Fixed:**
   Ltac2 in terms in notations is more aware of the notation variables it uses,
@@ -1017,7 +1021,7 @@ Commands and options
   fixes `#20042 <https://github.com/rocq-prover/rocq/issues/20042>`_,
   by Gaëtan Gilbert).
 
-.. _91refinedef:
+  .. _91refinedef:
 
 - **Added:**
   support for the :attr:`refine` attribute to definitions and (co)fixpoints
@@ -1081,7 +1085,7 @@ Infrastructure and dependencies
   (`#20576 <https://github.com/rocq-prover/rocq/pull/20576>`_,
   by Gaëtan Gilbert).
 
-.. _91relocatable:
+  .. _91relocatable:
 
 - **Added:**
   Rocq can be compile-time configured to be relocatable,

From 1e75e294cbbe557c46b6f0a4509875213856e14d Mon Sep 17 00:00:00 2001
From: nicolas tabareau <nicolas.tabareau@gmail.com>
Date: Mon, 2 Feb 2026 14:41:07 +0100
Subject: [PATCH 072/578] update numbers

---
 doc/sphinx/changes.rst | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/doc/sphinx/changes.rst b/doc/sphinx/changes.rst
index 652c349a6f4d..984225d296e6 100644
--- a/doc/sphinx/changes.rst
+++ b/doc/sphinx/changes.rst
@@ -108,7 +108,7 @@ the `Discourse forum <https://discourse.rocq-prover.org>`__ and the
 `Rocq Zulip chat <https://rocq-prover.zulipchat.com>`_.
 
 Nicolas Tabareau is the release manager of Rocq 9.2.
-This release is the result of 397 merged PRs, closing 56 issues.
+This release is the result of 486 merged PRs, closing 4 issues.
 
 | Nantes, March 2026
 | Nicolas Tabareau for the Rocq development team

From b51a6c9023a4b465c5563d1225810955c17b92fb Mon Sep 17 00:00:00 2001
From: vblot <24938579+vblot@users.noreply.github.com>
Date: Tue, 3 Feb 2026 11:28:26 +0100
Subject: [PATCH 073/578] ssrbool predicates documentation: MemPred -> Mem

mem_pred's constructor is Mem, not MemPred
---
 theories/Corelib/ssr/ssrbool.v | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/theories/Corelib/ssr/ssrbool.v b/theories/Corelib/ssr/ssrbool.v
index 94dcca76b150..a3275d7dcefc 100644
--- a/theories/Corelib/ssr/ssrbool.v
+++ b/theories/Corelib/ssr/ssrbool.v
@@ -1215,11 +1215,11 @@ Ltac bool_congr :=
  different predicate type for each predicate parameter of each section or
  lemma.
    In detail, we ensure that the head normal form of mem A is always of the
- eta-long MemPred (fun x => pA x) form, where pA is the pred interpretation of
+ eta-long Mem (fun x => pA x) form, where pA is the pred interpretation of
  A following its predType pT, i.e., the _expansion_ of topred A. For a pred T
- evar ?P, (mem ?P) converts MemPred (fun x => ?P x), whose argument is a Miller
+ evar ?P, (mem ?P) converts Mem (fun x => ?P x), whose argument is a Miller
  pattern and therefore always unify: unifying (mem A) with (mem ?P) always
- yields ?P = pA, because the rigid constant MemPred aligns the unification.
+ yields ?P = pA, because the rigid constant Mem aligns the unification.
  Furthermore, we ensure pA is always either A or toP .... A where toP ... is
  the expansion of @topred T pT, and toP is declared as a Coercion, so pA will
  _display_ as A in either case, and the instances of @mem T (predPredType T) pA

From ae1b1ff749a33df72db30a6c7b5b0c99ad618de1 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Tue, 3 Feb 2026 13:06:05 +0100
Subject: [PATCH 074/578] dev/ci/README-developers.md add note about merlin

---
 dev/ci/README-developers.md | 16 ++++++++++++++++
 1 file changed, 16 insertions(+)

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
 ------------------------------
 

From 557e23bca922227af55cfb9bbbbd78d21f0e6852 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Tue, 3 Feb 2026 10:35:18 +0100
Subject: [PATCH 075/578] Stop using Prop in example of non terminating
 definitional uip

---
 doc/sphinx/addendum/sprop.rst | 29 +++++++++++++++++------------
 1 file changed, 17 insertions(+), 12 deletions(-)

diff --git a/doc/sphinx/addendum/sprop.rst b/doc/sphinx/addendum/sprop.rst
index 6231d7fde74f..e373e65a00fb 100644
--- a/doc/sphinx/addendum/sprop.rst
+++ b/doc/sphinx/addendum/sprop.rst
@@ -221,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.
 
@@ -253,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.
 

From 932e3936112a0c7fe985006d529e790057a43dd9 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Tue, 3 Feb 2026 13:31:41 +0100
Subject: [PATCH 076/578] add irrefutable pattern to glossary

---
 doc/sphinx/language/extensions/match.rst | 7 +++----
 1 file changed, 3 insertions(+), 4 deletions(-)

diff --git a/doc/sphinx/language/extensions/match.rst b/doc/sphinx/language/extensions/match.rst
index f698399da212..ee61d9235dfb 100644
--- a/doc/sphinx/language/extensions/match.rst
+++ b/doc/sphinx/language/extensions/match.rst
@@ -82,8 +82,9 @@ 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
@@ -98,8 +99,6 @@ constructions. There are two variants of them.
 Let-tuple syntax
 ++++++++++++++++
 
-.. todo add "irrefutable pattern" to the glossary
-
 The expression :n:`let ( {*, @ident__i } ) := @term__0 in @term__1`
 performs case analysis on :n:`@term__0` whose type must be an
 inductive type with exactly one constructor.  The number of variables

From 031c8f1cbd3242e01ac3f1e7a5332da7b74611dd Mon Sep 17 00:00:00 2001
From: Ralf Jung <post@ralfj.de>
Date: Mon, 2 Feb 2026 15:11:47 +0100
Subject: [PATCH 077/578] iris-examples: prepare for opam file being renamed

---
 dev/ci/scripts/ci-iris.sh | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

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

From 9b1424650d0a4d41b2a7f3d02c3aa9c16b404308 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Mon, 2 Feb 2026 15:51:41 +0100
Subject: [PATCH 078/578] Stop using genarg for constr syntax extension

Instead we have a separate Dyn
---
 .../21574-SkySkimmer-genconstr.sh             |  5 ++
 interp/constrexpr.mli                         |  4 +-
 interp/constrintern.ml                        | 10 ++--
 interp/constrintern.mli                       |  4 +-
 interp/genintern.ml                           | 58 +++++++++++--------
 interp/genintern.mli                          | 28 +++++----
 interp/notation_ops.ml                        |  2 +-
 interp/notation_term.mli                      |  2 +-
 plugins/ltac/g_ltac.mlg                       |  3 +-
 plugins/ltac/pptactic.ml                      | 29 ++++++----
 plugins/ltac/tacarg.ml                        |  2 +-
 plugins/ltac/tacarg.mli                       |  2 +-
 plugins/ltac/tacintern.ml                     |  4 +-
 plugins/ltac/tacsubst.ml                      |  2 +-
 plugins/ltac2/g_ltac2.mlg                     | 12 ++--
 plugins/ltac2/tac2env.ml                      |  4 +-
 plugins/ltac2/tac2env.mli                     |  5 +-
 plugins/ltac2/tac2extravals.ml                |  9 ++-
 plugins/ltac2/tac2intern.ml                   | 18 +++---
 plugins/ssr/ssrview.ml                        | 15 +++--
 pretyping/detyping.ml                         |  2 +-
 pretyping/genConstr.ml                        | 51 ++++++++++++++++
 pretyping/genConstr.mli                       | 44 ++++++++++++++
 pretyping/genarg.mli                          | 17 ------
 pretyping/gensubst.ml                         | 14 +++++
 pretyping/gensubst.mli                        |  4 ++
 pretyping/globEnv.ml                          | 14 ++---
 pretyping/globEnv.mli                         |  4 +-
 pretyping/glob_term.mli                       |  2 +-
 pretyping/pattern.mli                         |  2 +-
 pretyping/patternops.ml                       | 18 +++---
 pretyping/patternops.mli                      |  2 +-
 pretyping/pretyping.ml                        |  2 +-
 pretyping/pretyping.mli                       |  2 +-
 printing/genprint.ml                          | 21 +++++++
 printing/genprint.mli                         |  9 +++
 printing/ppconstr.ml                          | 27 ++++-----
 37 files changed, 298 insertions(+), 155 deletions(-)
 create mode 100644 dev/ci/user-overlays/21574-SkySkimmer-genconstr.sh
 create mode 100644 pretyping/genConstr.ml
 create mode 100644 pretyping/genConstr.mli

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/interp/constrexpr.mli b/interp/constrexpr.mli
index d76de673dcd5..fedaac086130 100644
--- a/interp/constrexpr.mli
+++ b/interp/constrexpr.mli
@@ -164,10 +164,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/constrintern.ml b/interp/constrintern.ml
index 9d194813b607..5540058beaef 100644
--- a/interp/constrintern.ml
+++ b/interp/constrintern.ml
@@ -2176,8 +2176,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
@@ -2741,10 +2741,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
 
diff --git a/interp/constrintern.mli b/interp/constrintern.mli
index bc168287ee65..d602bc404d47 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
diff --git a/interp/genintern.ml b/interp/genintern.ml
index 13993cc5944d..0bebcb63817a 100644
--- a/interp/genintern.ml
+++ b/interp/genintern.ml
@@ -63,52 +63,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 +141,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..4b4552fdff9a 100644
--- a/interp/genintern.mli
+++ b/interp/genintern.mli
@@ -48,17 +48,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 +67,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/notation_ops.ml b/interp/notation_ops.ml
index c5a282a68325..2f5d3bec7801 100644
--- a/interp/notation_ops.ml
+++ b/interp/notation_ops.ml
@@ -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..0b58c557583e 100644
--- a/interp/notation_term.mli
+++ b/interp/notation_term.mli
@@ -26,7 +26,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/plugins/ltac/g_ltac.mlg b/plugins/ltac/g_ltac.mlg
index 5e205ee765bc..3e158f651c6f 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
 
diff --git a/plugins/ltac/pptactic.ml b/plugins/ltac/pptactic.ml
index 1fd34a8e3b27..e5c953138555 100644
--- a/plugins/ltac/pptactic.ml
+++ b/plugins/ltac/pptactic.ml
@@ -1420,17 +1420,24 @@ let () =
   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 printer f x =
diff --git a/plugins/ltac/tacarg.ml b/plugins/ltac/tacarg.ml
index 2764b678b56a..ac98e78cacb1 100644
--- a/plugins/ltac/tacarg.ml
+++ b/plugins/ltac/tacarg.ml
@@ -30,7 +30,7 @@ let wit_quantified_hypothesis = wit_quant_hyp
 let wit_tactic : (raw_tactic_expr, glob_tactic_expr, Val.t) 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 = Gentactic.make "ltac"
 
diff --git a/plugins/ltac/tacarg.mli b/plugins/ltac/tacarg.mli
index 26bfcbdeaf0c..cac63bb86dc5 100644
--- a/plugins/ltac/tacarg.mli
+++ b/plugins/ltac/tacarg.mli
@@ -44,7 +44,7 @@ val wit_quantified_hypothesis : quantified_hypothesis uniform_genarg_type
 
 val wit_tactic : (raw_tactic_expr, glob_tactic_expr, Geninterp.Val.t) genarg_type
 
-val wit_ltac_in_term : (raw_tactic_expr, Names.Id.Set.t * glob_tactic_expr, Util.Empty.t) 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
diff --git a/plugins/ltac/tacintern.ml b/plugins/ltac/tacintern.ml
index 2bace7f2ba65..462cd1de6c58 100644
--- a/plugins/ltac/tacintern.ml
+++ b/plugins/ltac/tacintern.ml
@@ -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
 
@@ -775,7 +775,7 @@ 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_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));
diff --git a/plugins/ltac/tacsubst.ml b/plugins/ltac/tacsubst.ml
index 415297b1a278..8d90d8ed73ce 100644
--- a/plugins/ltac/tacsubst.ml
+++ b/plugins/ltac/tacsubst.ml
@@ -287,7 +287,7 @@ 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_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);
diff --git a/plugins/ltac2/g_ltac2.mlg b/plugins/ltac2/g_ltac2.mlg
index 45113d4d3c03..24e0bec80eaa 100644
--- a/plugins/ltac2/g_ltac2.mlg
+++ b/plugins/ltac2/g_ltac2.mlg
@@ -944,8 +944,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 +954,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 +963,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 +972,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
diff --git a/plugins/ltac2/tac2env.ml b/plugins/ltac2/tac2env.ml
index acae4cb6ac78..cfcf9cfd7a5c 100644
--- a/plugins/ltac2/tac2env.ml
+++ b/plugins/ltac2/tac2env.ml
@@ -306,8 +306,8 @@ 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_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 =
diff --git a/plugins/ltac2/tac2env.mli b/plugins/ltac2/tac2env.mli
index ee42a5235abb..5f114f67051b 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
@@ -181,7 +180,7 @@ 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) Gentactic.tag
@@ -193,7 +192,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/tac2extravals.ml b/plugins/ltac2/tac2extravals.ml
index eb685acef533..ddd477e43fc6 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))
@@ -390,7 +389,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) =
@@ -434,7 +433,7 @@ 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 _ _ ->
diff --git a/plugins/ltac2/tac2intern.ml b/plugins/ltac2/tac2intern.ml
index c4f1aa99ed0c..c3e188fa7dc4 100644
--- a/plugins/ltac2/tac2intern.ml
+++ b/plugins/ltac2/tac2intern.ml
@@ -2107,7 +2107,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,9 +2128,9 @@ 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
@@ -2142,10 +2142,10 @@ let () =
   in
   Gentactic.register_intern wit_ltac2_tac intern
 
-let () = Gensubst.register_subst0 wit_ltac2_constr (fun s (ids, e) -> ids, subst_expr s e)
+let () = Gensubst.register_constr_subst wit_ltac2_constr (fun s (ids, e) -> ids, subst_expr s e)
 let () = Gentactic.register_subst wit_ltac2_tac subst_expr
 
-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
@@ -2196,11 +2196,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 +2208,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/ssr/ssrview.ml b/plugins/ssr/ssrview.ml
index f0c0cf1fce16..909b92493abb 100644
--- a/plugins/ssr/ssrview.ml
+++ b/plugins/ssr/ssrview.ml
@@ -170,13 +170,16 @@ 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 *)
diff --git a/pretyping/detyping.ml b/pretyping/detyping.ml
index 686f3f3343a9..45e3c6bd492e 100644
--- a/pretyping/detyping.ml
+++ b/pretyping/detyping.ml
@@ -1207,7 +1207,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/genConstr.ml b/pretyping/genConstr.ml
new file mode 100644
index 000000000000..0c6b14f750f4
--- /dev/null
+++ b/pretyping/genConstr.ml
@@ -0,0 +1,51 @@
+(************************************************************************)
+(*         *      The Rocq Prover / The Rocq Development Team           *)
+(*  v      *         Copyright INRIA, CNRS and contributors             *)
+(* <O___,, * (see version control and CREDITS file for authors & dates) *)
+(*   \VV/  **************************************************************)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+module D = Dyn.Make()
+
+type ('raw, 'glb) tag = ('raw * 'glb) D.tag
+
+let create name = D.create name
+
+let eq t1 t2 = D.eq t1 t2
+
+let repr tag = D.repr tag
+
+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..1858bb1c0fc0
--- /dev/null
+++ b/pretyping/genConstr.mli
@@ -0,0 +1,44 @@
+(************************************************************************)
+(*         *      The Rocq Prover / The Rocq Development Team           *)
+(*  v      *         Copyright INRIA, CNRS and contributors             *)
+(* <O___,, * (see version control and CREDITS file for authors & dates) *)
+(*   \VV/  **************************************************************)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(** Tags for extensible terms. The [raw] type is contained in
+    constrexpr, and the [glb] type in glob terms. *)
+type ('raw, 'glb) tag
+
+(** Create a new tag. Tags should be registered with
+    [GlobEnv.register_constr_interp0], [Genintern.register_intern_constr],
+    [Gensubst.register_constr_subst] and [Genprint.register_constr_print].
+
+    Also optionally
+    - [Genintern.register_ntn_subst0] (to be used in notations)
+
+    - [Genintern.register_intern_pat] and [Genintern.register_interp_pat]
+      (to be used in tactic patterns)
+*)
+val create : string -> _ tag
+
+val eq : ('raw1, 'glb1) tag -> ('raw2, 'glb2) tag -> ('raw1 * 'glb1, 'raw2 * 'glb2) Util.eq option
+
+val repr : _ tag -> string
+
+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 2af6e772f20f..62589f27c06f 100644
--- a/pretyping/genarg.mli
+++ b/pretyping/genarg.mli
@@ -15,23 +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.
-
     - vernac arguments, used by vernac extend. Usually declared in mlg
       using VERNAC ARGUMENT EXTEND then used in VERNAC EXTEND.
 
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..fb2e18a34ab7 100644
--- a/pretyping/globEnv.ml
+++ b/pretyping/globEnv.ml
@@ -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..2f2f4998171f 100644
--- a/pretyping/globEnv.mli
+++ b/pretyping/globEnv.mli
@@ -26,7 +26,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} *)
 
@@ -95,4 +95,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_term.mli b/pretyping/glob_term.mli
index 00cf61451638..57ebcf07fe98 100644
--- a/pretyping/glob_term.mli
+++ b/pretyping/glob_term.mli
@@ -113,7 +113,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/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..93421eb770ff 100644
--- a/pretyping/pretyping.ml
+++ b/pretyping/pretyping.ml
@@ -632,7 +632,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;
diff --git a/pretyping/pretyping.mli b/pretyping/pretyping.mli
index edb3f46f0be5..a11296de8aba 100644
--- a/pretyping/pretyping.mli
+++ b/pretyping/pretyping.mli
@@ -202,7 +202,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/printing/genprint.ml b/printing/genprint.ml
index 6f6027300ba7..a74f120b1759 100644
--- a/printing/genprint.ml
+++ b/printing/genprint.ml
@@ -114,6 +114,9 @@ type ('raw, 'glb, 'top) genprinter = {
   top : 'top -> top_printer_result;
 }
 
+let basic_default name =
+  PrinterBasic (fun env sigma -> str "<genarg:" ++ str name ++ str ">")
+
 module PrintObj =
 struct
   type ('raw, 'glb, 'top) obj = ('raw, 'glb, 'top) genprinter
@@ -158,3 +161,21 @@ 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..d9964665ad16 100644
--- a/printing/genprint.mli
+++ b/printing/genprint.mli
@@ -56,3 +56,12 @@ 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..fd7ac67f91ca 100644
--- a/printing/ppconstr.ml
+++ b/printing/ppconstr.ml
@@ -623,28 +623,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

From 8a1cff06cda19ad7d8ebe1be61b7a04814b03faa Mon Sep 17 00:00:00 2001
From: Yann Leray <yann.leray@inria.fr>
Date: Tue, 3 Feb 2026 14:52:44 +0100
Subject: [PATCH 079/578] Which prints an error to stdout whereas command
 doesn't

---
 dev/tools/list-contributors.sh | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/dev/tools/list-contributors.sh b/dev/tools/list-contributors.sh
index b1ef1ae65b36..c49bbccdeef0 100755
--- a/dev/tools/list-contributors.sh
+++ b/dev/tools/list-contributors.sh
@@ -1,6 +1,6 @@
 #!/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"

From 1530a91b3c56ba828e8ac697adc2e272912d9f21 Mon Sep 17 00:00:00 2001
From: JeanCASPAR <55629512+JeanCASPAR@users.noreply.github.com>
Date: Mon, 2 Feb 2026 15:07:13 +0100
Subject: [PATCH 080/578] fix: Scheme Induction generates the wrong name in
 SProp.

Previously, `Scheme Induction for T Sort SProp.` generates an induction
principle named `T_inds` while the default-generated name for the
induction principle in `SProp` for `T` would be `T_sind`.
---
 ...21578-fix-induction-scheme-sprop-Fixed.rst |   6 +
 test-suite/output/SchemeNames.out             | 160 +++++++++---------
 test-suite/output/SchemeNames.v               |  64 +++----
 vernac/indschemes.ml                          |  21 +--
 4 files changed, 129 insertions(+), 122 deletions(-)
 create mode 100644 doc/changelog/08-vernac-commands-and-options/21578-fix-induction-scheme-sprop-Fixed.rst

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 <https://github.com/rocq-prover/rocq/pull/21578>`_,
+  by Jean Caspar).
diff --git a/test-suite/output/SchemeNames.out b/test-suite/output/SchemeNames.out
index 889027b10915..37291d65f753 100644
--- a/test-suite/output/SchemeNames.out
+++ b/test-suite/output/SchemeNames.out
@@ -19,13 +19,13 @@ the return type has sort "Type" while it should be SProp.
 Elimination of an inductive object of sort SProp
 is not allowed on a predicate in sort "Type"
 because strict proofs can be eliminated only to build strict proofs.
-fooSProp_inds :
+fooSProp_sind :
 forall P : fooSProp -> SProp, P aSP -> P bSP -> forall f : fooSProp, P f
 
-fooSProp_inds is not universe polymorphic
-Arguments fooSProp_inds P%_function_scope aSP bSP f
-fooSProp_inds is transparent
-Expands to: Constant SchemeNames.fooSProp_inds
+fooSProp_sind is not universe polymorphic
+Arguments fooSProp_sind P%_function_scope aSP bSP f
+fooSProp_sind is transparent
+Expands to: Constant SchemeNames.fooSProp_sind
 Declared in library SchemeNames, line 13, characters 7-48
 File "./output/SchemeNames.v", line 23, characters 2-48:
 The command has indeed failed with message:
@@ -48,12 +48,12 @@ the return type has sort "Type" while it should be SProp.
 Elimination of an inductive object of sort SProp
 is not allowed on a predicate in sort "Type"
 because strict proofs can be eliminated only to build strict proofs.
-fooSProp_inds_nodep : forall P : SProp, P -> P -> fooSProp -> P
+fooSProp_sind_nodep : forall P : SProp, P -> P -> fooSProp -> P
 
-fooSProp_inds_nodep is not universe polymorphic
-Arguments fooSProp_inds_nodep P%_type_scope aSP bSP f
-fooSProp_inds_nodep is transparent
-Expands to: Constant SchemeNames.fooSProp_inds_nodep
+fooSProp_sind_nodep is not universe polymorphic
+Arguments fooSProp_sind_nodep P%_type_scope aSP bSP f
+fooSProp_sind_nodep is transparent
+Expands to: Constant SchemeNames.fooSProp_sind_nodep
 Declared in library SchemeNames, line 22, characters 7-49
 File "./output/SchemeNames.v", line 32, characters 2-49:
 The command has indeed failed with message:
@@ -76,13 +76,13 @@ the return type has sort "Type" while it should be SProp.
 Elimination of an inductive object of sort SProp
 is not allowed on a predicate in sort "Type"
 because strict proofs can be eliminated only to build strict proofs.
-fooSProp_cases :
+fooSProp_scase :
 forall P : fooSProp -> SProp, P aSP -> P bSP -> forall f : fooSProp, P f
 
-fooSProp_cases is not universe polymorphic
-Arguments fooSProp_cases P%_function_scope aSP bSP f
-fooSProp_cases is transparent
-Expands to: Constant SchemeNames.fooSProp_cases
+fooSProp_scase is not universe polymorphic
+Arguments fooSProp_scase P%_function_scope aSP bSP f
+fooSProp_scase is transparent
+Expands to: Constant SchemeNames.fooSProp_scase
 Declared in library SchemeNames, line 31, characters 7-50
 File "./output/SchemeNames.v", line 41, characters 2-42:
 The command has indeed failed with message:
@@ -105,12 +105,12 @@ the return type has sort "Type" while it should be SProp.
 Elimination of an inductive object of sort SProp
 is not allowed on a predicate in sort "Type"
 because strict proofs can be eliminated only to build strict proofs.
-fooSProp_cases_nodep : forall P : SProp, P -> P -> fooSProp -> P
+fooSProp_scase_nodep : forall P : SProp, P -> P -> fooSProp -> P
 
-fooSProp_cases_nodep is not universe polymorphic
-Arguments fooSProp_cases_nodep P%_type_scope aSP bSP f
-fooSProp_cases_nodep is transparent
-Expands to: Constant SchemeNames.fooSProp_cases_nodep
+fooSProp_scase_nodep is not universe polymorphic
+Arguments fooSProp_scase_nodep P%_type_scope aSP bSP f
+fooSProp_scase_nodep is transparent
+Expands to: Constant SchemeNames.fooSProp_scase_nodep
 Declared in library SchemeNames, line 40, characters 7-43
 File "./output/SchemeNames.v", line 49, characters 2-36:
 The command has indeed failed with message:
@@ -130,13 +130,13 @@ the return type has sort "Type" while it should be SProp or Prop.
 Elimination of an inductive object of sort Prop
 is not allowed on a predicate in sort "Type"
 because proofs can be eliminated only to build proofs.
-fooProp_inds_dep :
+fooProp_sind_dep :
 forall P : fooProp -> SProp, P aP -> P bP -> forall f : fooProp, P f
 
-fooProp_inds_dep is not universe polymorphic
-Arguments fooProp_inds_dep P%_function_scope aP bP f
-fooProp_inds_dep is transparent
-Expands to: Constant SchemeNames.fooProp_inds_dep
+fooProp_sind_dep is not universe polymorphic
+Arguments fooProp_sind_dep P%_function_scope aP bP f
+fooProp_sind_dep is transparent
+Expands to: Constant SchemeNames.fooProp_sind_dep
 Declared in library SchemeNames, line 59, characters 7-47
 fooProp_ind_dep :
 forall P : fooProp -> Prop, P aP -> P bP -> forall f : fooProp, P f
@@ -160,12 +160,12 @@ the return type has sort "Type" while it should be SProp or Prop.
 Elimination of an inductive object of sort Prop
 is not allowed on a predicate in sort "Type"
 because proofs can be eliminated only to build proofs.
-fooProp_inds : forall P : SProp, P -> P -> fooProp -> P
+fooProp_sind : forall P : SProp, P -> P -> fooProp -> P
 
-fooProp_inds is not universe polymorphic
-Arguments fooProp_inds P%_type_scope aP bP f
-fooProp_inds is transparent
-Expands to: Constant SchemeNames.fooProp_inds
+fooProp_sind is not universe polymorphic
+Arguments fooProp_sind P%_type_scope aP bP f
+fooProp_sind is transparent
+Expands to: Constant SchemeNames.fooProp_sind
 Declared in library SchemeNames, line 69, characters 7-48
 fooProp_ind : forall P : Prop, P -> P -> fooProp -> P
 
@@ -188,13 +188,13 @@ the return type has sort "Type" while it should be SProp or Prop.
 Elimination of an inductive object of sort Prop
 is not allowed on a predicate in sort "Type"
 because proofs can be eliminated only to build proofs.
-fooProp_cases_dep :
+fooProp_scase_dep :
 forall P : fooProp -> SProp, P aP -> P bP -> forall f : fooProp, P f
 
-fooProp_cases_dep is not universe polymorphic
-Arguments fooProp_cases_dep P%_function_scope aP bP f
-fooProp_cases_dep is transparent
-Expands to: Constant SchemeNames.fooProp_cases_dep
+fooProp_scase_dep is not universe polymorphic
+Arguments fooProp_scase_dep P%_function_scope aP bP f
+fooProp_scase_dep is transparent
+Expands to: Constant SchemeNames.fooProp_scase_dep
 Declared in library SchemeNames, line 79, characters 7-49
 fooProp_case_dep :
 forall P : fooProp -> Prop, P aP -> P bP -> forall f : fooProp, P f
@@ -218,12 +218,12 @@ the return type has sort "Type" while it should be SProp or Prop.
 Elimination of an inductive object of sort Prop
 is not allowed on a predicate in sort "Type"
 because proofs can be eliminated only to build proofs.
-fooProp_cases : forall P : SProp, P -> P -> fooProp -> P
+fooProp_scase : forall P : SProp, P -> P -> fooProp -> P
 
-fooProp_cases is not universe polymorphic
-Arguments fooProp_cases P%_type_scope aP bP f
-fooProp_cases is transparent
-Expands to: Constant SchemeNames.fooProp_cases
+fooProp_scase is not universe polymorphic
+Arguments fooProp_scase P%_type_scope aP bP f
+fooProp_scase is transparent
+Expands to: Constant SchemeNames.fooProp_scase
 Declared in library SchemeNames, line 89, characters 7-42
 fooProp_case : forall P : Prop, P -> P -> fooProp -> P
 
@@ -236,13 +236,13 @@ File "./output/SchemeNames.v", line 99, characters 2-35:
 The command has indeed failed with message:
 Cannot extract computational content from proposition 
 "fooProp".
-fooSet_inds :
+fooSet_sind :
 forall P : fooSet -> SProp, P aS -> P bS -> forall f : fooSet, P f
 
-fooSet_inds is not universe polymorphic
-Arguments fooSet_inds P%_function_scope aS bS f
-fooSet_inds is transparent
-Expands to: Constant SchemeNames.fooSet_inds
+fooSet_sind is not universe polymorphic
+Arguments fooSet_sind P%_function_scope aS bS f
+fooSet_sind is transparent
+Expands to: Constant SchemeNames.fooSet_sind
 Declared in library SchemeNames, line 109, characters 2-41
 fooSet_ind :
 forall P : fooSet -> Prop, P aS -> P bS -> forall f : fooSet, P f
@@ -267,12 +267,12 @@ Arguments fooSet_rect P%_function_scope aS bS f
 fooSet_rect is transparent
 Expands to: Constant SchemeNames.fooSet_rect
 Declared in library SchemeNames, line 112, characters 2-40
-fooSet_inds_nodep : forall P : SProp, P -> P -> fooSet -> P
+fooSet_sind_nodep : forall P : SProp, P -> P -> fooSet -> P
 
-fooSet_inds_nodep is not universe polymorphic
-Arguments fooSet_inds_nodep P%_type_scope aS bS f
-fooSet_inds_nodep is transparent
-Expands to: Constant SchemeNames.fooSet_inds_nodep
+fooSet_sind_nodep is not universe polymorphic
+Arguments fooSet_sind_nodep P%_type_scope aS bS f
+fooSet_sind_nodep is transparent
+Expands to: Constant SchemeNames.fooSet_sind_nodep
 Declared in library SchemeNames, line 121, characters 2-42
 fooSet_ind_nodep : forall P : Prop, P -> P -> fooSet -> P
 
@@ -295,13 +295,13 @@ Arguments fooSet_rect_nodep P%_type_scope aS bS f
 fooSet_rect_nodep is transparent
 Expands to: Constant SchemeNames.fooSet_rect_nodep
 Declared in library SchemeNames, line 124, characters 2-41
-fooSet_cases :
+fooSet_scase :
 forall P : fooSet -> SProp, P aS -> P bS -> forall f : fooSet, P f
 
-fooSet_cases is not universe polymorphic
-Arguments fooSet_cases P%_function_scope aS bS f
-fooSet_cases is transparent
-Expands to: Constant SchemeNames.fooSet_cases
+fooSet_scase is not universe polymorphic
+Arguments fooSet_scase P%_function_scope aS bS f
+fooSet_scase is transparent
+Expands to: Constant SchemeNames.fooSet_scase
 Declared in library SchemeNames, line 136, characters 2-43
 fooSet_case :
 forall P : fooSet -> Prop, P aS -> P bS -> forall f : fooSet, P f
@@ -327,12 +327,12 @@ Arguments fooSet'_caset P%_function_scope aS' bS' f
 fooSet'_caset is transparent
 Expands to: Constant SchemeNames.fooSet'_caset
 Declared in library SchemeNames, line 139, characters 2-43
-fooSet_cases_nodep : forall P : SProp, P -> P -> fooSet -> P
+fooSet_scase_nodep : forall P : SProp, P -> P -> fooSet -> P
 
-fooSet_cases_nodep is not universe polymorphic
-Arguments fooSet_cases_nodep P%_type_scope aS bS f
-fooSet_cases_nodep is transparent
-Expands to: Constant SchemeNames.fooSet_cases_nodep
+fooSet_scase_nodep is not universe polymorphic
+Arguments fooSet_scase_nodep P%_type_scope aS bS f
+fooSet_scase_nodep is transparent
+Expands to: Constant SchemeNames.fooSet_scase_nodep
 Declared in library SchemeNames, line 148, characters 2-36
 fooSet_case_nodep : forall P : Prop, P -> P -> fooSet -> P
 
@@ -387,13 +387,13 @@ Arguments internal_fooSet_dec_lb x y _
 internal_fooSet_dec_lb is transparent
 Expands to: Constant SchemeNames.internal_fooSet_dec_lb
 Declared in library SchemeNames, line 160, characters 2-29
-fooType_inds :
+fooType_sind :
 forall P : fooType -> SProp, P aT -> P bT -> forall f : fooType, P f
 
-fooType_inds is not universe polymorphic
-Arguments fooType_inds P%_function_scope aT bT f
-fooType_inds is transparent
-Expands to: Constant SchemeNames.fooType_inds
+fooType_sind is not universe polymorphic
+Arguments fooType_sind P%_function_scope aT bT f
+fooType_sind is transparent
+Expands to: Constant SchemeNames.fooType_sind
 Declared in library SchemeNames, line 175, characters 2-42
 fooType_ind :
 forall P : fooType -> Prop, P aT -> P bT -> forall f : fooType, P f
@@ -419,12 +419,12 @@ Arguments fooType_rect P%_function_scope aT bT f
 fooType_rect is transparent
 Expands to: Constant SchemeNames.fooType_rect
 Declared in library SchemeNames, line 178, characters 2-41
-fooType_inds_nodep : forall P : SProp, P -> P -> fooType -> P
+fooType_sind_nodep : forall P : SProp, P -> P -> fooType -> P
 
-fooType_inds_nodep is not universe polymorphic
-Arguments fooType_inds_nodep P%_type_scope aT bT f
-fooType_inds_nodep is transparent
-Expands to: Constant SchemeNames.fooType_inds_nodep
+fooType_sind_nodep is not universe polymorphic
+Arguments fooType_sind_nodep P%_type_scope aT bT f
+fooType_sind_nodep is transparent
+Expands to: Constant SchemeNames.fooType_sind_nodep
 Declared in library SchemeNames, line 187, characters 2-43
 fooType_ind_nodep : forall P : Prop, P -> P -> fooType -> P
 
@@ -447,13 +447,13 @@ Arguments fooType_rect_nodep P%_type_scope aT bT f
 fooType_rect_nodep is transparent
 Expands to: Constant SchemeNames.fooType_rect_nodep
 Declared in library SchemeNames, line 190, characters 2-42
-fooType_cases :
+fooType_scase :
 forall P : fooType -> SProp, P aT -> P bT -> forall f : fooType, P f
 
-fooType_cases is not universe polymorphic
-Arguments fooType_cases P%_function_scope aT bT f
-fooType_cases is transparent
-Expands to: Constant SchemeNames.fooType_cases
+fooType_scase is not universe polymorphic
+Arguments fooType_scase P%_function_scope aT bT f
+fooType_scase is transparent
+Expands to: Constant SchemeNames.fooType_scase
 Declared in library SchemeNames, line 202, characters 2-44
 fooType_case :
 forall P : fooType -> Prop, P aT -> P bT -> forall f : fooType, P f
@@ -479,12 +479,12 @@ Arguments fooType'_caset P%_function_scope aT' bT' f
 fooType'_caset is transparent
 Expands to: Constant SchemeNames.fooType'_caset
 Declared in library SchemeNames, line 205, characters 2-44
-fooType_cases_nodep : forall P : SProp, P -> P -> fooType -> P
+fooType_scase_nodep : forall P : SProp, P -> P -> fooType -> P
 
-fooType_cases_nodep is not universe polymorphic
-Arguments fooType_cases_nodep P%_type_scope aT bT f
-fooType_cases_nodep is transparent
-Expands to: Constant SchemeNames.fooType_cases_nodep
+fooType_scase_nodep is not universe polymorphic
+Arguments fooType_scase_nodep P%_type_scope aT bT f
+fooType_scase_nodep is transparent
+Expands to: Constant SchemeNames.fooType_scase_nodep
 Declared in library SchemeNames, line 214, characters 2-37
 fooType_case_nodep : forall P : Prop, P -> P -> fooType -> P
 
diff --git a/test-suite/output/SchemeNames.v b/test-suite/output/SchemeNames.v
index d3304eb4b4ba..eaf3bec50f1c 100644
--- a/test-suite/output/SchemeNames.v
+++ b/test-suite/output/SchemeNames.v
@@ -10,39 +10,39 @@ Unset Elimination Schemes.
 
   (** ** Try Induction into all Sorts *)
 
-       Scheme Induction for fooSProp Sort SProp. (* fooSProp_inds *)
+       Scheme Induction for fooSProp Sort SProp. (* fooSProp_sind *)
   Fail Scheme Induction for fooSProp Sort Prop.
   Fail Scheme Induction for fooSProp Sort Set.
   Fail Scheme Induction for fooSProp Sort Type.
 
-  About fooSProp_inds.
+  About fooSProp_sind.
 
   (** ** Try Minimality into all Sorts *)
 
-       Scheme Minimality for fooSProp Sort SProp. (* fooSProp_inds_nodep *)
+       Scheme Minimality for fooSProp Sort SProp. (* fooSProp_sind_nodep *)
   Fail Scheme Minimality for fooSProp Sort Prop.
   Fail Scheme Minimality for fooSProp Sort Set.
   Fail Scheme Minimality for fooSProp Sort Type.
 
-  About fooSProp_inds_nodep.
+  About fooSProp_sind_nodep.
 
   (** ** Try Elimination into all Sorts *)
 
-       Scheme Elimination for fooSProp Sort SProp. (* fooSProp_cases *)
+       Scheme Elimination for fooSProp Sort SProp. (* fooSProp_scase *)
   Fail Scheme Elimination for fooSProp Sort Prop.
   Fail Scheme Elimination for fooSProp Sort Set.
   Fail Scheme Elimination for fooSProp Sort Type.
 
-  About fooSProp_cases.
+  About fooSProp_scase.
 
   (** ** Try Case into all Sorts *)
 
-       Scheme Case for fooSProp Sort SProp. (* fooSProp_cases_nodep *)
+       Scheme Case for fooSProp Sort SProp. (* fooSProp_scase_nodep *)
   Fail Scheme Case for fooSProp Sort Prop.
   Fail Scheme Case for fooSProp Sort Set.
   Fail Scheme Case for fooSProp Sort Type.
 
-  About fooSProp_cases_nodep.
+  About fooSProp_scase_nodep.
 
   (** ** Scheme Equality *)
 
@@ -56,42 +56,42 @@ Unset Elimination Schemes.
 
   (** ** Try Induction into all Sorts *)
 
-       Scheme Induction for fooProp Sort SProp. (* fooProp_inds_dep *)
+       Scheme Induction for fooProp Sort SProp. (* fooProp_sind_dep *)
        Scheme Induction for fooProp Sort Prop.  (* fooProp_ind_dep *)
   Fail Scheme Induction for fooProp Sort Set.
   Fail Scheme Induction for fooProp Sort Type.
 
-  About fooProp_inds_dep.
+  About fooProp_sind_dep.
   About fooProp_ind_dep.
 
   (** ** Try Minimality into all Sorts *)
 
-       Scheme Minimality for fooProp Sort SProp. (* fooProp_inds *)
+       Scheme Minimality for fooProp Sort SProp. (* fooProp_sind *)
        Scheme Minimality for fooProp Sort Prop.  (* fooProp_ind *)
   Fail Scheme Minimality for fooProp Sort Set.
   Fail Scheme Minimality for fooProp Sort Type.
 
-  About fooProp_inds.
+  About fooProp_sind.
   About fooProp_ind.
 
   (** ** Try Elimination into all Sorts *)
 
-       Scheme Elimination for fooProp Sort SProp. (* fooProp_cases_dep *)
+       Scheme Elimination for fooProp Sort SProp. (* fooProp_scase_dep *)
        Scheme Elimination for fooProp Sort Prop.  (* fooProp_case_dep *)
   Fail Scheme Elimination for fooProp Sort Set.
   Fail Scheme Elimination for fooProp Sort Type.
 
-  About fooProp_cases_dep.
+  About fooProp_scase_dep.
   About fooProp_case_dep.
 
   (** ** Try Case into all Sorts *)
 
-       Scheme Case for fooProp Sort SProp. (* fooProp_cases *)
+       Scheme Case for fooProp Sort SProp. (* fooProp_scase *)
        Scheme Case for fooProp Sort Prop.  (* fooProp_case *)
   Fail Scheme Case for fooProp Sort Set.
   Fail Scheme Case for fooProp Sort Type.
 
-  About fooProp_cases.
+  About fooProp_scase.
   About fooProp_case.
 
   (** ** Scheme Equality *)
@@ -106,24 +106,24 @@ Unset Elimination Schemes.
 
   (** ** Try Induction into all Sorts *)
 
-  Scheme Induction for fooSet Sort SProp. (* fooSet_inds *)
+  Scheme Induction for fooSet Sort SProp. (* fooSet_sind *)
   Scheme Induction for fooSet Sort Prop.  (* fooSet_ind *)
   Scheme Induction for fooSet Sort Set.   (* fooSet_rec *)
   Scheme Induction for fooSet Sort Type.  (* fooSet_rect *)
 
-  About fooSet_inds.
+  About fooSet_sind.
   About fooSet_ind.
   About fooSet_rec.
   About fooSet_rect.
 
   (** ** Try Minimality into all Sorts *)
 
-  Scheme Minimality for fooSet Sort SProp. (* fooSet_inds_nodep *)
+  Scheme Minimality for fooSet Sort SProp. (* fooSet_sind_nodep *)
   Scheme Minimality for fooSet Sort Prop.  (* fooSet_ind_nodep *)
   Scheme Minimality for fooSet Sort Set.   (* fooSet_rec_nodep *)
   Scheme Minimality for fooSet Sort Type.  (* fooSet_rect_nodep *)
 
-  About fooSet_inds_nodep.
+  About fooSet_sind_nodep.
   About fooSet_ind_nodep.
   About fooSet_rec_nodep.
   About fooSet_rect_nodep.
@@ -133,24 +133,24 @@ Unset Elimination Schemes.
   (** Unforunately there is some overlap with names so we need to create a fresh inductive. *)
   Inductive fooSet' : Set := aS' | bS'.
 
-  Scheme Elimination for fooSet Sort SProp. (* fooSet_cases *)
+  Scheme Elimination for fooSet Sort SProp. (* fooSet_scase *)
   Scheme Elimination for fooSet Sort Prop.  (* fooSet_case *)
   Scheme Elimination for fooSet' Sort Set.  (* fooSet'_case *)
   Scheme Elimination for fooSet' Sort Type. (* fooSet'_caset *)
 
-  About fooSet_cases.
+  About fooSet_scase.
   About fooSet_case.
   About fooSet'_case.
   About fooSet'_caset.
 
    (** ** Try Case into all Sorts *)
 
-  Scheme Case for fooSet Sort SProp. (* fooSet_cases_nodep *)
+  Scheme Case for fooSet Sort SProp. (* fooSet_scase_nodep *)
   Scheme Case for fooSet Sort Prop.  (* fooSet_case_nodep *)
   Scheme Case for fooSet' Sort Set.  (* fooSet'_case_nodep *)
   Scheme Case for fooSet' Sort Type. (* fooSet'_caset_nodep *)
 
-  About fooSet_cases_nodep.
+  About fooSet_scase_nodep.
   About fooSet_case_nodep.
   About fooSet'_case_nodep.
   About fooSet'_caset_nodep.
@@ -172,24 +172,24 @@ Unset Elimination Schemes.
 
   (** ** Try Induction into all Sorts *)
 
-  Scheme Induction for fooType Sort SProp. (* fooType_inds *)
+  Scheme Induction for fooType Sort SProp. (* fooType_sind *)
   Scheme Induction for fooType Sort Prop.  (* fooType_ind *)
   Scheme Induction for fooType Sort Set.   (* fooType_rec *)
   Scheme Induction for fooType Sort Type.  (* fooType_rect *)
 
-  About fooType_inds.
+  About fooType_sind.
   About fooType_ind.
   About fooType_rec.
   About fooType_rect.
 
   (** ** Try Minimality into all Sorts *)
 
-  Scheme Minimality for fooType Sort SProp. (* fooType_inds_nodep *)
+  Scheme Minimality for fooType Sort SProp. (* fooType_sind_nodep *)
   Scheme Minimality for fooType Sort Prop.  (* fooType_ind_nodep *)
   Scheme Minimality for fooType Sort Set.   (* fooType_rec_nodep *)
   Scheme Minimality for fooType Sort Type.  (* fooType_rect_nodep *)
 
-  About fooType_inds_nodep.
+  About fooType_sind_nodep.
   About fooType_ind_nodep.
   About fooType_rec_nodep.
   About fooType_rect_nodep.
@@ -199,24 +199,24 @@ Unset Elimination Schemes.
   (** Unforunately there is some overlap with names so we need to create a fresh inductive. *)
   Inductive fooType' : Type := aT' | bT'.
 
-  Scheme Elimination for fooType Sort SProp. (* fooType_cases *)
+  Scheme Elimination for fooType Sort SProp. (* fooType_scase *)
   Scheme Elimination for fooType Sort Prop.  (* fooType_case *)
   Scheme Elimination for fooType' Sort Set.  (* fooType'_case *)
   Scheme Elimination for fooType' Sort Type. (* fooType'_caset *)
 
-  About fooType_cases.
+  About fooType_scase.
   About fooType_case.
   About fooType'_case.
   About fooType'_caset.
 
   (** ** Try Case into all Sorts *)
 
-  Scheme Case for fooType Sort SProp. (* fooType_cases_nodep *)
+  Scheme Case for fooType Sort SProp. (* fooType_scase_nodep *)
   Scheme Case for fooType Sort Prop.  (* fooType_case_nodep *)
   Scheme Case for fooType' Sort Set.  (* fooType'_case_nodep *)
   Scheme Case for fooType' Sort Type. (* fooType'_caset_nodep *)
 
-  About fooType_cases_nodep.
+  About fooType_scase_nodep.
   About fooType_case_nodep.
   About fooType'_case_nodep.
   About fooType'_caset_nodep.
diff --git a/vernac/indschemes.ml b/vernac/indschemes.ml
index 7390bfcf545c..5805bce664e1 100644
--- a/vernac/indschemes.ml
+++ b/vernac/indschemes.ml
@@ -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 _) -> 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

From 75ab9b5821fa07abff9c99f7d5ca180f98740ff6 Mon Sep 17 00:00:00 2001
From: Suraaj K S <50653618+kssuraaj28@users.noreply.github.com>
Date: Tue, 3 Feb 2026 17:20:18 -0500
Subject: [PATCH 081/578] Fix reference to stdarg.mli in documentation

---
 doc/plugin_tutorial/tuto1/src/g_tuto1.mlg | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

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).

From dd482fe546972c37294107c55a39de635ec73a0f Mon Sep 17 00:00:00 2001
From: Yann Leray <yann.leray@inria.fr>
Date: Tue, 3 Feb 2026 23:42:41 +0100
Subject: [PATCH 082/578] Add private constructors to GADT indices types

---
 gramlib/grammar.ml | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/gramlib/grammar.ml b/gramlib/grammar.ml
index ffe7de84aa30..9ab5cfea4b16 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

From cd345d3fab817d7a2e42db1ec9f1d94ebae3c39c Mon Sep 17 00:00:00 2001
From: Matthieu Sozeau <matthieu.sozeau@inria.fr>
Date: Fri, 9 Jan 2026 09:27:48 +0100
Subject: [PATCH 083/578] Add new "matches" and "tactic" call strategies to
 generalized rewriting
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Fix test-suite file

Fix ltac call strategy

Fix test-suite file relying on Timeouts

Fixes according to SkySkimmer's comments

Hide internal rewrite result type and rename pre_rewrite_result to exposed rewrite_result

Pass the `carrier` type of the left-hand side term which is already computed to
the tactic in the `tactic` strategy. Use named arguments for disambiguation in
its ML type signature

Use smaller nats for tests to run under low-stack environments

Remove commented line

Doc

Bind pattern tactic in Ltac2 as well.

Clean test-suite file

Improve doc, test-suite and use arbitrary `core.eq.refl` to detect conversions in `tactic`

Add changelog entry

Fix handling of local environment in ltac2 tactic call

Move Ltac2 tests to the right file

Rename pattern to "matches"

Update grammar and doc

Apply suggestions from code review

Co-authored-by: Jim Fehrle <jim.fehrle@gmail.com>

Apply suggestion from @mattam82

Apply suggestion from @mattam82

Apply suggestion from @mattam82

Add a test for failure if the goal is instantiated

Apply suggestions from code review

Co-authored-by: Gaëtan Gilbert <gaetan.gilbert@skyskimmer.net>

Moved wrapping code to tac2tactics as suggested by @SkySkimmer

Overlay for tactician
---
 .../21521-mattam82-strat-pattern-ltac.sh      |   1 +
 .../21521-strat-pattern-ltac-Added.rst        |   5 +
 doc/sphinx/addendum/generalized-rewriting.rst |  81 ++++++--
 doc/tools/docgram/fullGrammar                 |   2 +
 doc/tools/docgram/orderedGrammar              |   2 +
 plugins/ltac/g_rewrite.mlg                    |  14 +-
 plugins/ltac/tacexpr.mli                      |   4 +-
 plugins/ltac/tacintern.ml                     |   6 +
 plugins/ltac/tacinterp.ml                     |  14 +-
 plugins/ltac2/tac2ffi.ml                      |  17 ++
 plugins/ltac2/tac2ffi.mli                     |   6 +
 plugins/ltac2/tac2stdlib.ml                   |  25 +++
 plugins/ltac2/tac2tactics.ml                  |  28 +++
 plugins/ltac2/tac2tactics.mli                 |   2 +
 tactics/rewrite.ml                            | 186 ++++++++++++++----
 tactics/rewrite.mli                           |  47 ++---
 test-suite/ltac2/rewrite_strat.v              | 110 +++++++++++
 test-suite/success/rewrite_strat.v            | 127 +++++++++++-
 theories/Ltac2/Rewrite.v                      |  30 +++
 19 files changed, 613 insertions(+), 94 deletions(-)
 create mode 100644 dev/ci/user-overlays/21521-mattam82-strat-pattern-ltac.sh
 create mode 100644 doc/changelog/04-tactics/21521-strat-pattern-ltac-Added.rst

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/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 <strategies4rewriting>`
+  to :tacn:`rewrite_strat` for :ref:`Ltac1 <ltac>` and :ref:`Ltac2 <ltac2>` tactics
+  (`#21521 <https://github.com/rocq-prover/rocq/pull/21521>`_,
+  by Matthieu Sozeau and Mathis Bouverot-Dupuis).
diff --git a/doc/sphinx/addendum/generalized-rewriting.rst b/doc/sphinx/addendum/generalized-rewriting.rst
index 03488da68d87..82f47000dd97 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 <strategies4rewriting>`
+for rewriting *or* applying :ref:`conversions <applyingconversionrules>` (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).
@@ -1009,6 +1011,17 @@ 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.
 
+The :tacn:`rewrite_strat` tactic is more general than :tacn:`setoid_rewrite` as
+it can also be used to apply arbitrary :ref:`conversion strategies <applyingconversionrules>`
+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 <Conversion-rules>` at selected subterms. The :n:`tactic` strategy
+further allows arbitrary customization of strategies through :ref:`Ltac1 <ltac>` or :ref:`Ltac2 <ltac2>` tactics.
+
+The following describes the :ref:`Ltac1 <ltac>` version of the strategies. An :ref:`Ltac2 <ltac2>` version
+with the same primitives is available in the :g:`Ltac2.Rewrite` module.
+
 .. insertprodn rewstrategy rewstrategy0
 
 .. prodn::
@@ -1030,6 +1043,8 @@ 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
@@ -1053,6 +1068,12 @@ 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
 
@@ -1090,33 +1111,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 <applyingconversionrules>`.
+   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
+   parenthesizes for disambiguation, applies :n:`@rewstrategy`
 
 :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 <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 +1210,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.
diff --git a/doc/tools/docgram/fullGrammar b/doc/tools/docgram/fullGrammar
index 2d007eb2273b..ffd5402734a2 100644
--- a/doc/tools/docgram/fullGrammar
+++ b/doc/tools/docgram/fullGrammar
@@ -2408,6 +2408,8 @@ rewstrategy1: [
 | "terms" LIST0 constr
 | "eval" red_expr
 | "fold" constr
+| "matches" constr
+| "tactic" tactic
 | rewstrategy0
 ]
 
diff --git a/doc/tools/docgram/orderedGrammar b/doc/tools/docgram/orderedGrammar
index 33fb93db2e5a..d3cd93739132 100644
--- a/doc/tools/docgram/orderedGrammar
+++ b/doc/tools/docgram/orderedGrammar
@@ -2240,6 +2240,8 @@ rewstrategy1: [
 | "terms" LIST0 one_term
 | "eval" red_expr
 | "fold" one_term
+| "matches" one_term
+| "tactic" ltac_expr
 | rewstrategy0
 | "old_hints" ident
 ]
diff --git a/plugins/ltac/g_rewrite.mlg b/plugins/ltac/g_rewrite.mlg
index 110caa28f4e4..a611aa167e44 100644
--- a/plugins/ltac/g_rewrite.mlg
+++ b/plugins/ltac/g_rewrite.mlg
@@ -68,17 +68,21 @@ END
 
 let subst_strategy sub = 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 "<strategy>"
-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) =
+  Rewrite.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
+  Rewrite.pr_strategy (prc env sigma) prpat prr Id.print prt s
 
 }
 
@@ -124,6 +128,8 @@ GRAMMAR EXTEND Gram
       | IDENT "terms"; h = LIST0 constr -> { StratTerms h }
       | IDENT "eval"; r = red_expr -> { StratEval r }
       | IDENT "fold"; c = constr -> { StratFold c }
+      | IDENT "matches"; c = constr -> { StratMatches c }
+      | IDENT "tactic"; c = tactic -> { StratTactic c }
       | h = rewstrategy0 -> { h } ] ]
   ;
   rewstrategy0:
diff --git a/plugins/ltac/tacexpr.mli b/plugins/ltac/tacexpr.mli
index 71c2e3fe89be..6dea35ce5d77 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) Rewrite.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) Rewrite.strategy_ast
 
 (** Traces *)
 
diff --git a/plugins/ltac/tacintern.ml b/plugins/ltac/tacintern.ml
index 2bace7f2ba65..c57e8cfc6354 100644
--- a/plugins/ltac/tacintern.ml
+++ b/plugins/ltac/tacintern.ml
@@ -735,6 +735,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
 
diff --git a/plugins/ltac/tacinterp.ml b/plugins/ltac/tacinterp.ml
index b3217d1770e5..a348253762df 100644
--- a/plugins/ltac/tacinterp.ml
+++ b/plugins/ltac/tacinterp.ml
@@ -750,12 +750,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
@@ -1980,6 +1974,14 @@ 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 = Rewrite.map_strategy interp_constr interp_pattern interp_redexpr
+            (fun x -> x) (interp_tactic ist) s in
+  Rewrite.strategy_of_ast s
+
 (** FFI *)
 
 module Value = struct
diff --git a/plugins/ltac2/tac2ffi.ml b/plugins/ltac2/tac2ffi.ml
index 82f290c2bea4..6c57feb06baa 100644
--- a/plugins/ltac2/tac2ffi.ml
+++ b/plugins/ltac2/tac2ffi.ml
@@ -204,6 +204,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)
 
diff --git a/plugins/ltac2/tac2ffi.mli b/plugins/ltac2/tac2ffi.mli
index dd9627584419..ae77209028d5 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
diff --git a/plugins/ltac2/tac2stdlib.ml b/plugins/ltac2/tac2stdlib.ml
index b9e727b2311c..c90c57a08a5e 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"
diff --git a/plugins/ltac2/tac2tactics.ml b/plugins/ltac2/tac2tactics.ml
index c1e241b489d1..23ca11cb2e29 100644
--- a/plugins/ltac2/tac2tactics.ml
+++ b/plugins/ltac2/tac2tactics.ml
@@ -435,3 +435,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 ~hypnaming:Evarutil.VarSet.empty 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..6854b4058394 100644
--- a/plugins/ltac2/tac2tactics.mli
+++ b/plugins/ltac2/tac2tactics.mli
@@ -131,3 +131,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/tactics/rewrite.ml b/tactics/rewrite.ml
index 715190bf5cc1..4b12301b8177 100644
--- a/tactics/rewrite.ml
+++ b/tactics/rewrite.ml
@@ -653,7 +653,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 +665,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 +708,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
 
@@ -756,7 +784,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
@@ -1018,7 +1046,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 +1059,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 +1286,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 +1445,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 +1557,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
@@ -1704,32 +1803,36 @@ type binary_strategy =
 
 type nary_strategy = Choice
 
-type ('constr,'redexpr,'id) strategy_ast =
+type ('constr,'constr_pattern,'redexpr,'id,'tactic) strategy_ast =
   | StratId | StratFail | StratRefl
-  | StratUnary of unary_strategy * ('constr,'redexpr,'id) strategy_ast
+  | StratUnary of unary_strategy * ('constr,'constr_pattern,'redexpr,'id,'tactic) 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
+      binary_strategy * ('constr,'constr_pattern,'redexpr,'id,'tactic) strategy_ast * ('constr,'constr_pattern,'redexpr,'id,'tactic) strategy_ast
+  | StratNAry of nary_strategy * ('constr,'constr_pattern,'redexpr,'id,'tactic) 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
+  | StratFix of 'id * ('constr,'constr_pattern,'redexpr,'id,'tactic) strategy_ast
+  | StratMatches of 'constr_pattern
+  | StratTactic of 'tactic
 
-let rec map_strategy f g h = function
+let rec map_strategy f g h i j = 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)
+  | 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 (g r)
+  | StratEval r -> StratEval (h r)
   | StratFold c -> StratFold (f c)
-  | StratVar id -> StratVar (h id)
-  | StratFix (id, s) -> StratFix (h id, map_strategy f g h s)
+  | 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"
@@ -1745,17 +1848,17 @@ let pr_ustrategy = function
 
 let paren p = str "(" ++ p ++ str ")"
 
-let rec pr_strategy0 prc prr prid = function
+let rec pr_strategy0 prc prcp prr prid prtac = function
 | StratId -> str "id"
 | StratFail -> str "fail"
 | StratRefl -> str "refl"
-| str -> paren (pr_strategy prc prr prid str)
+| str -> paren (pr_strategy prc prcp prr prid prtac str)
 
-and pr_strategy1 prc prr prid = function
+and pr_strategy1 prc prcp prr prid prtac = function
 | StratUnary (s, str) ->
-  pr_ustrategy s ++ spc () ++ pr_strategy1 prc prr prid 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 prr prid str)) 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
@@ -1765,23 +1868,26 @@ and pr_strategy1 prc prr prid = function
   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
+| 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 prr prid = function
+and pr_strategy2 prc prcp prr prid prtac = 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)
+  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 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
+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 rec strategy_of_ast bindings = function
+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' = strategy_of_ast bindings s in
+    let s' = aux bindings s in
     let f' = match f with
       | Subterms -> Strategies.all_subterms
       | Subterm -> Strategies.one_subterm
@@ -1795,13 +1901,13 @@ let rec strategy_of_ast bindings = function
       | 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 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 (strategy_of_ast bindings) strs in
+    let strs = List.map (aux bindings) strs in
     begin match strs with
       | [] -> assert false
       | s::strs -> List.fold_left Strategies.choice s strs
@@ -1815,10 +1921,12 @@ let rec strategy_of_ast bindings = function
      (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 -> aux (Id.Map.add id self bindings) s)
+  | StratMatches p -> Strategies.matches p
+  | StratTactic t -> Strategies.ltac1_tactic_call t
+  in aux bindings strat
 
-  | 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
 
diff --git a/tactics/rewrite.mli b/tactics/rewrite.mli
index 652c0e5dbcd4..63056b8dfc8b 100644
--- a/tactics/rewrite.mli
+++ b/tactics/rewrite.mli
@@ -27,48 +27,46 @@ type binary_strategy =
 
 type nary_strategy = Choice
 
-type ('constr,'redexpr,'id) strategy_ast =
+type ('constr,'constr_pattern,'redexpr,'id,'tactic) strategy_ast =
   | StratId | StratFail | StratRefl
-  | StratUnary of unary_strategy * ('constr,'redexpr,'id) strategy_ast
+  | StratUnary of unary_strategy * ('constr,'constr_pattern,'redexpr,'id,'tactic) 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
+      binary_strategy * ('constr,'constr_pattern,'redexpr,'id,'tactic) strategy_ast * ('constr,'constr_pattern,'redexpr,'id,'tactic) strategy_ast
+  | StratNAry of nary_strategy * ('constr,'constr_pattern,'redexpr,'id,'tactic) 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
-
+  | StratFix of 'id * ('constr,'constr_pattern,'redexpr,'id,'tactic) strategy_ast
+  | StratMatches of 'constr_pattern
+  | StratTactic of 'tactic
 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
 
+val subst_rewrite_result : Evd.evar_map -> (Id.t -> constr) -> rewrite_result -> rewrite_result
+
 type strategy
 
-val strategy_of_ast : (Glob_term.glob_constr * constr delayed_open, Redexpr.red_expr delayed_open, Id.t) strategy_ast -> strategy
+val strategy_of_ast : (Glob_term.glob_constr * constr delayed_open, Pattern.constr_pattern, Redexpr.red_expr delayed_open, Id.t, unit Proofview.tactic) strategy_ast -> strategy
 
-val map_strategy : ('a -> 'b) -> ('c -> 'd) -> ('e -> 'f) ->
-  ('a, 'c, 'e) strategy_ast -> ('b, 'd, 'f) strategy_ast
+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) ->
-  ('a, 'b, 'c) strategy_ast -> Pp.t
+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
 
 (** Entry point for user-level "rewrite_strat" *)
 val cl_rewrite_clause_strat : strategy -> Id.t option -> unit Proofview.tactic
@@ -95,15 +93,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 +126,10 @@ sig
 
   val fold : Evd.econstr -> strategy
   val fold_glob : Glob_term.glob_constr -> strategy
+
+  val matches : Pattern.constr_pattern -> 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/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/success/rewrite_strat.v b/test-suite/success/rewrite_strat.v
index 0c464aa900d7..22d23b7c885d 100644
--- a/test-suite/success/rewrite_strat.v
+++ b/test-suite/success/rewrite_strat.v
@@ -1,5 +1,6 @@
 Require Import Setoid.
 
+
 Parameter X : Set.
 
 Parameter f : X -> X.
@@ -55,8 +56,8 @@ Proof.
   reflexivity.
 Time Qed. (* 0.06 s *)
 
-Set Printing All.
-Set Printing Depth 100000.
+(* Set Printing All. *)
+(* Set Printing Depth 100000. *)
 
 Tactic Notation "my_rewrite_strat" constr(x) := rewrite_strat topdown x.
 Tactic Notation "my_rewrite_strat2" uconstr(x) := rewrite_strat topdown x.
@@ -66,3 +67,125 @@ my_rewrite_strat H.
 Undo.
 my_rewrite_strat2 H.
 Abort.
+
+Module StratMatches.
+  Lemma add_0_r x : x + 0 = x.
+  Admitted.
+
+  Goal forall x : nat, x + (x + 0) = x + x.
+  Proof.
+    Fail rewrite_strat (bottomup (matches (x + 0) ; add_0_r)).
+    rewrite_strat (bottomup (matches (_ + 0) ; add_0_r)).
+    reflexivity.
+  Qed.
+
+  Goal forall x : nat, x + (x + 0) = x + x.
+  Proof.
+    intros x.
+    rewrite_strat (bottomup (matches (x + 0) ; add_0_r)).
+    reflexivity.
+  Qed.
+
+  (* Heavy computation if unfolded at any point during unification *)
+  Definition foo (n : nat) :=
+    Nat.pow 2 n.
+
+  Goal foo (200 + 200) = foo 400.
+  Proof.
+    rewrite_strat (bottomup (matches (_ + _); eval cbn)).
+    reflexivity.
+  Qed.
+
+  Goal foo (200 + 200) = foo (399 + 1).
+  Proof.
+    rewrite_strat (bottomup (matches (_ + _); eval cbn)).
+    reflexivity.
+  Qed.
+
+  Import Decimal.
+
+  Lemma heavy : foo (2000 + 2000) = foo (40 * 100).
+  Proof.
+    (* Fail Timeout 1 cbn. *)
+    (* 1.5sec *)
+    Time rewrite_strat (bottomup (choice (matches (_ + _)) (matches (_ * _)); eval cbn)).
+    Undo.
+    (* ~30x faster: 0.05s *)
+    Time rewrite_strat (bottomup (choice (matches (_ + _)) (matches (_ * _)); eval vm_compute)).
+    reflexivity.
+  Defined.
+
+  (* A more complex situation where FO unification is not tried *)
+  Definition bar n (k : nat) := foo n.
+
+  Lemma heavier : foo (200 + 2000 + 1800) = bar (400 * 10) 10.
+  Proof.
+    (* exact_no_check (@eq_refl nat 40000). *)
+    (* Fail Timeout 1 Qed. *)
+    (* Undo. Undo. *)
+    (* Strategy 200 [Nat.add]. *)
+    (* Strategy -300 [Nat.pow foo]. *)
+    (* (* Fail Timeout 1 reflexivity. *) *)
+    (* (* Fail Timeout 1 cbn. *) *)
+    (* (* Untractable *) *)
+    (* (* Fail Timeout 1 rewrite_strat (bottomup (choice (matches (_ + _)) (matches (_ * _)); eval cbn)). *) *)
+    (* (* 0.5s *) *)
+    Time rewrite_strat (bottomup (choice (matches (_ + _)) (matches (_ * _)); eval vm_compute)).
+    unfold bar; reflexivity.
+    (* Immmediate *)
+  Defined.
+
+End StratMatches.
+Import Decimal Nat.
+
+Module StratTactic.
+
+  Ltac is_closed_add t :=
+    match t with
+    | Nat.add _ _ => idtac
+    end.
+
+  Ltac reduce_fo_ind_value :=
+    match goal with
+    | [ |- ?R ?lhs ?rhs ] =>
+        let ty := type of lhs in
+        match ty with
+        | nat =>
+            is_closed_add lhs;
+            (* idtac "match"; *)
+          let rhs' := eval cbv in lhs in
+            (* instantiate is using right-to-left order! *)
+            instantiate (2 := @eq ty);
+            instantiate (1 := rhs');
+            exact_no_check (@eq_refl ty rhs')
+        end
+    end.
+
+  (* Heavy computation if unfolded at any point during unification *)
+  Definition foo (n : nat) :=
+    Nat.pow 2 n.
+
+  Ltac reduce_fo_ind :=
+    rewrite_strat (fix s := choice (tactic reduce_fo_ind_value) (subterm s)).
+
+  Variant rewrite {A : Type} (lhs : A) : Prop :=
+    | success : forall (R : A -> A -> Prop) (rhs : A) (prf : R lhs rhs), rewrite lhs
+    | fail : rewrite lhs
+    | identity : rewrite lhs.
+
+  Lemma heavy : foo (200 + 200) = foo 400.
+  Proof.
+    Time reduce_fo_ind.
+    reflexivity.
+  Time Qed.
+
+  Lemma binders (b : bool) : forall x, (2 + x) = S (S x).
+  Proof.
+    reduce_fo_ind.
+    match goal with
+    | |- forall x, S (S x) = S (S x) => idtac
+    end.
+    trivial.
+  Qed.
+
+End StratTactic.
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 *)

From 62d34c1da8b21d90c83d45b0317a431e042c2b1e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Wed, 7 Jan 2026 16:01:21 +0100
Subject: [PATCH 084/578] extern_reference only fallback for constants from the
 current module

(assuming them to be not-in-nametab side effects)

This lets us print them with a short name instead of pointlessly fully qualified.

It also makes the wrapping of extern_reference in
Printer.safe_extern_wrapper actually useful (since it does
`try orig_extern_ref r with e -> fallback` it would not be useful when
orig_extern_ref could not raise exceptions).

That wrapper is what now handles unknown inductives from module
errors (see eg the expanded test for #2995) so we print a fully
qualified but syntactically correct inductive name instead of
`<inductive:foo:n>`.
---
 .../21473-fix-printing-Fixed.rst              |  5 ++++
 interp/constrextern.ml                        | 23 +++++--------------
 test-suite/bugs/bug_2995.v                    | 17 +++++++++++++-
 test-suite/output-coqtop/bug_16462.out        |  9 ++++----
 test-suite/output-coqtop/bug_16745.out        |  4 ++--
 5 files changed, 33 insertions(+), 25 deletions(-)
 create mode 100644 doc/changelog/08-vernac-commands-and-options/21473-fix-printing-Fixed.rst

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
new file mode 100644
index 000000000000..41ac55a7ed7d
--- /dev/null
+++ b/doc/changelog/08-vernac-commands-and-options/21473-fix-printing-Fixed.rst
@@ -0,0 +1,5 @@
+- **Fixed:** fallback printing of inductives using
+  ``<inductive:Foo:0>`` now prints correctly
+  (though with possibly more qualification than needed)
+  (it should in any case only happen rarely from module errors)
+  (`#21484 <https://github.com/rocq-prover/rocq/pull/21484>`_, by Gaëtan Gilbert).
diff --git a/interp/constrextern.ml b/interp/constrextern.ml
index e1be963b69d2..a70f24752784 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 ("<inductive:" ^ Id.to_string (MutInd.label ind) ^ ":" ^ string_of_int n ^ ">"))
-  | GlobRef.ConstructRef ((ind,0),p) -> Libnames.make_qualid (dirpath_of_modpath (MutInd.modpath ind)) (Id.of_string_soft ("<constructor:" ^ Id.to_string (MutInd.label ind) ^ ":" ^ string_of_int (p+1) ^ ">"))
-  | GlobRef.ConstructRef ((ind,n),p) -> Libnames.make_qualid (dirpath_of_modpath (MutInd.modpath ind)) (Id.of_string_soft ("<constructor:" ^ Id.to_string (MutInd.label ind) ^ ":" ^ string_of_int n ^ ":" ^ string_of_int (p+1) ^ ">"))
-
 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
 
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/output-coqtop/bug_16462.out b/test-suite/output-coqtop/bug_16462.out
index 4257bd024bc6..57ed0d4eb48b 100644
--- a/test-suite/output-coqtop/bug_16462.out
+++ b/test-suite/output-coqtop/bug_16462.out
@@ -11,8 +11,8 @@ Rocq < 1 goal
   ============================
   True
 
-Unnamed_thm < Top.Unnamed_thm_subproof
-Top.Unnamed_thm_subproof
+Unnamed_thm < Unnamed_thm_subproof
+Unnamed_thm_subproof
 Toplevel input, characters 2-7:
 >   baz I.
 >   ^^^^^
@@ -22,9 +22,8 @@ In nested Ltac calls to "baz", "f" (bound to fun f x y => idtac v; f x),
 "f" (bound to
 fun _ => let v' := v in
          constr:((fun _ => ltac:(idtac v'; fail 1)))) and
-"(fun _ => ltac:(idtac v'; fail 1))" (with x:=I,
-v':=Top.Unnamed_thm_subproof, v:=Top.Unnamed_thm_subproof, H:=H), last term
-evaluation failed.
+"(fun _ => ltac:(idtac v'; fail 1))" (with x:=I, v':=Unnamed_thm_subproof,
+v:=Unnamed_thm_subproof, H:=H), last term evaluation failed.
 
 
 Unnamed_thm < 
diff --git a/test-suite/output-coqtop/bug_16745.out b/test-suite/output-coqtop/bug_16745.out
index 7aff505d6bdf..765f2afe2846 100644
--- a/test-suite/output-coqtop/bug_16745.out
+++ b/test-suite/output-coqtop/bug_16745.out
@@ -10,8 +10,8 @@ Unnamed_thm < Unnamed_thm < Unnamed_thm < Toplevel input, characters 111-112:
 >                                             ^
 Error:
 In environment
-x := Top.Unnamed_thm_subproof : nat
-The term "Top.Unnamed_thm_subproof" has type "nat"
+x := Unnamed_thm_subproof : nat
+The term "Unnamed_thm_subproof" has type "nat"
 while it is expected to have type "True".
 
 Unnamed_thm < 

From e9e6f3ac527b3a0f18e6e92a611ca978f664d4c2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Mon, 2 Feb 2026 14:13:46 +0100
Subject: [PATCH 085/578] Move rewrite strat asts to ltac1 plugin

---
 .../21571-SkySkimmer-rew-strar-ast.sh         |   1 +
 plugins/ltac/g_rewrite.mlg                    |   8 +-
 plugins/ltac/rewriteStratAst.ml               | 148 ++++++++++++++++++
 plugins/ltac/rewriteStratAst.mli              |  48 ++++++
 plugins/ltac/tacexpr.mli                      |   4 +-
 plugins/ltac/tacintern.ml                     |   7 +-
 plugins/ltac/tacinterp.ml                     |   4 +-
 tactics/rewrite.ml                            | 143 +----------------
 tactics/rewrite.mli                           |  40 +----
 9 files changed, 219 insertions(+), 184 deletions(-)
 create mode 100644 dev/ci/user-overlays/21571-SkySkimmer-rew-strar-ast.sh
 create mode 100644 plugins/ltac/rewriteStratAst.ml
 create mode 100644 plugins/ltac/rewriteStratAst.mli

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/plugins/ltac/g_rewrite.mlg b/plugins/ltac/g_rewrite.mlg
index a611aa167e44..a5e3b81a98ac 100644
--- a/plugins/ltac/g_rewrite.mlg
+++ b/plugins/ltac/g_rewrite.mlg
@@ -20,6 +20,7 @@ open Genintern
 open Geninterp
 open Extraargs
 open Rewrite
+open RewriteStratAst
 open ComRewrite
 open Stdarg
 open Tactypes
@@ -66,7 +67,8 @@ 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)
@@ -76,13 +78,13 @@ let subst_strategy sub = map_strategy
 let pr_strategy _ _ _ (s : strategy) = Pp.str "<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) (prc env sigma) prr Pputils.pr_lident (prt env sigma Constrexpr.LevelSome) s
+  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
   let prpat (_, c, _) = prc env sigma c in
   let prt = prt env sigma Constrexpr.LevelSome in
-  Rewrite.pr_strategy (prc env sigma) prpat prr Id.print prt s
+  RewriteStratAst.pr_strategy (prc env sigma) prpat prr Id.print prt s
 
 }
 
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             *)
+(* <O___,, * (see version control and CREDITS file for authors & dates) *)
+(*   \VV/  **************************************************************)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+open Pp
+open Names
+open Rewrite
+
+type unary_strategy =
+    Subterms | Subterm | Innermost | Outermost
+  | Bottomup | Topdown | Progress | Try | Any | Repeat
+
+type binary_strategy =
+  | Compose
+
+type nary_strategy = Choice
+
+type ('constr,'constr_pattern,'redexpr,'id,'tactic) strategy_ast =
+  | StratId | StratFail | StratRefl
+  | StratUnary of unary_strategy * ('constr,'constr_pattern,'redexpr,'id,'tactic) strategy_ast
+  | StratBinary of
+      binary_strategy * ('constr,'constr_pattern,'redexpr,'id,'tactic) strategy_ast * ('constr,'constr_pattern,'redexpr,'id,'tactic) strategy_ast
+  | StratNAry of nary_strategy * ('constr,'constr_pattern,'redexpr,'id,'tactic) 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,'constr_pattern,'redexpr,'id,'tactic) strategy_ast
+  | StratMatches of 'constr_pattern
+  | StratTactic of 'tactic
+
+let rec map_strategy f g h i j = function
+  | StratId | StratFail | StratRefl as s -> 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             *)
+(* <O___,, * (see version control and CREDITS file for authors & dates) *)
+(*   \VV/  **************************************************************)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+open Names
+open Tactypes
+open EConstr
+
+type unary_strategy =
+    Subterms | Subterm | Innermost | Outermost
+  | Bottomup | Topdown | Progress | Try | Any | Repeat
+
+type binary_strategy =
+  | Compose
+
+type nary_strategy = Choice
+
+type ('constr,'constr_pattern,'redexpr,'id,'tactic) strategy_ast =
+  | StratId | StratFail | StratRefl
+  | StratUnary of unary_strategy * ('constr,'constr_pattern,'redexpr,'id,'tactic) strategy_ast
+  | StratBinary of
+      binary_strategy * ('constr,'constr_pattern,'redexpr,'id,'tactic) strategy_ast * ('constr,'constr_pattern,'redexpr,'id,'tactic) strategy_ast
+  | StratNAry of nary_strategy * ('constr,'constr_pattern,'redexpr,'id,'tactic) 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,'constr_pattern,'redexpr,'id,'tactic) strategy_ast
+  | StratMatches of 'constr_pattern
+  | StratTactic of 'tactic
+
+val strategy_of_ast :
+  (Glob_term.glob_constr * constr delayed_open, Pattern.constr_pattern, Redexpr.red_expr delayed_open, Id.t, unit Proofview.tactic) strategy_ast ->
+  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/tacexpr.mli b/plugins/ltac/tacexpr.mli
index 6dea35ce5d77..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, constr_expr, Redexpr.raw_red_expr, lident, raw_tactic_expr) Rewrite.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) 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 c57e8cfc6354..432e59cfaa04 100644
--- a/plugins/ltac/tacintern.ml
+++ b/plugins/ltac/tacintern.ml
@@ -716,15 +716,16 @@ let glob_tactic_env l env x =
   intern_pure_tactic { (Genintern.empty_glob_sign ~strict:true env) 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
diff --git a/plugins/ltac/tacinterp.ml b/plugins/ltac/tacinterp.ml
index a348253762df..6bc9e880d154 100644
--- a/plugins/ltac/tacinterp.ml
+++ b/plugins/ltac/tacinterp.ml
@@ -1978,9 +1978,9 @@ 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 = Rewrite.map_strategy interp_constr interp_pattern interp_redexpr
+  let s = RewriteStratAst.map_strategy interp_constr interp_pattern interp_redexpr
             (fun x -> x) (interp_tactic ist) s in
-  Rewrite.strategy_of_ast s
+  RewriteStratAst.strategy_of_ast s
 
 (** FFI *)
 
diff --git a/tactics/rewrite.ml b/tactics/rewrite.ml
index 4b12301b8177..fb6fc31e90ad 100644
--- a/tactics/rewrite.ml
+++ b/tactics/rewrite.ml
@@ -1579,6 +1579,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. *)
@@ -1792,144 +1797,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,'constr_pattern,'redexpr,'id,'tactic) strategy_ast =
-  | StratId | StratFail | StratRefl
-  | StratUnary of unary_strategy * ('constr,'constr_pattern,'redexpr,'id,'tactic) strategy_ast
-  | StratBinary of
-      binary_strategy * ('constr,'constr_pattern,'redexpr,'id,'tactic) strategy_ast * ('constr,'constr_pattern,'redexpr,'id,'tactic) strategy_ast
-  | StratNAry of nary_strategy * ('constr,'constr_pattern,'redexpr,'id,'tactic) 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,'constr_pattern,'redexpr,'id,'tactic) strategy_ast
-  | StratMatches of 'constr_pattern
-  | StratTactic of 'tactic
-
-let rec map_strategy f g h i j = function
-  | StratId | StratFail | StratRefl as s -> 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 -> { 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 -> 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
-
 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
diff --git a/tactics/rewrite.mli b/tactics/rewrite.mli
index 63056b8dfc8b..15df4e0bbd54 100644
--- a/tactics/rewrite.mli
+++ b/tactics/rewrite.mli
@@ -18,34 +18,6 @@ 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,'constr_pattern,'redexpr,'id,'tactic) strategy_ast =
-  | StratId | StratFail | StratRefl
-  | StratUnary of unary_strategy * ('constr,'constr_pattern,'redexpr,'id,'tactic) strategy_ast
-  | StratBinary of
-      binary_strategy * ('constr,'constr_pattern,'redexpr,'id,'tactic) strategy_ast * ('constr,'constr_pattern,'redexpr,'id,'tactic) strategy_ast
-  | StratNAry of nary_strategy * ('constr,'constr_pattern,'redexpr,'id,'tactic) 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,'constr_pattern,'redexpr,'id,'tactic) strategy_ast
-  | StratMatches of 'constr_pattern
-  | StratTactic of 'tactic
-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 =
@@ -60,14 +32,6 @@ val subst_rewrite_result : Evd.evar_map -> (Id.t -> constr) -> rewrite_result ->
 
 type strategy
 
-val strategy_of_ast : (Glob_term.glob_constr * constr delayed_open, Pattern.constr_pattern, Redexpr.red_expr delayed_open, Id.t, unit Proofview.tactic) strategy_ast -> 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
-
 (** Entry point for user-level "rewrite_strat" *)
 val cl_rewrite_clause_strat : strategy -> Id.t option -> unit Proofview.tactic
 
@@ -127,8 +91,12 @@ 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
 

From 55fef43efecfe458ac1c9b47a86a15a36ba16fef Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Wed, 4 Feb 2026 17:08:44 +0100
Subject: [PATCH 086/578] Revert "custom parsers do not use continue_parser"

It seems to be possible to hit this code through the recovery code in
`parser_cont`.

For instance download
https://github.com/impermeable/coq-waterproof/commit/004b4f25701a160bf842a5b225f548f1431013c7
remove the Waterproof Notation for `;` in Waterproof.v
and compile with Rocq V9.2+rc1 (needs some more overlays for master).

The assert failure will be triggered eg in test TakeSuchThat
line 66 `Take x : nat; such that x > 1 as (i).`.

(proof mode entry is a of_parser entry, it successfully parses
`Take x : nat`, rejects `;` then gramlib tries to recover)

This reverts commit c7da07d72e647516e5b416cf9a1ae251a33b9881 (the
raise became a functional Error).
---
 gramlib/grammar.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/gramlib/grammar.ml b/gramlib/grammar.ml
index 9ab5cfea4b16..ff44e77fc8c4 100644
--- a/gramlib/grammar.ml
+++ b/gramlib/grammar.ml
@@ -1617,7 +1617,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 =

From 0a645f17c42cfec460403c98d5205c5339a56f57 Mon Sep 17 00:00:00 2001
From: Suraaj K S <50653618+kssuraaj28@users.noreply.github.com>
Date: Wed, 4 Feb 2026 11:45:32 -0500
Subject: [PATCH 087/578] Correct file reference in g_tuto2.mlg

---
 doc/plugin_tutorial/tuto2/src/g_tuto2.mlg | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

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

From 9c69a9a586100a44be303c2eecfe4d1c544246cb Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Wed, 4 Feb 2026 15:18:16 +0100
Subject: [PATCH 088/578] Changelog for 9.1.1

---
 doc/sphinx/changes.rst | 26 ++++++++++++++++++++++++++
 1 file changed, 26 insertions(+)

diff --git a/doc/sphinx/changes.rst b/doc/sphinx/changes.rst
index 984225d296e6..c3b2e4fd9e57 100644
--- a/doc/sphinx/changes.rst
+++ b/doc/sphinx/changes.rst
@@ -1127,6 +1127,32 @@ Miscellaneous
   (`#20670 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/21479>`_,
+  fixes `#21476 <https://github.com/rocq-prover/rocq/issues/21476>`_,
+  by Yann Leray)
+
+Miscellaneous
+^^^^^^^^^^^^^
+
+- **Fixed:** compatibility with OCaml 5.4 with warnings as errors
+  (`#21261 <https://github.com/rocq-prover/rocq/pull/21261>`_,
+  by Yann Leray)
+- **Fixed:** compatibility with OCaml 5.5 with warnings as errors
+  (`#21584 <https://github.com/rocq-prover/rocq/pull/21584>`_,
+  by Yann Leray and Kate Deplaix)
+- **Changed:** various documentation updates
+
 Version 9.0
 -----------
 

From 10a56c79b52fee2f2c1d660524bb52cded82d645 Mon Sep 17 00:00:00 2001
From: Yann Leray <yann.leray@inria.fr>
Date: Wed, 21 Jan 2026 16:11:37 +0100
Subject: [PATCH 089/578] Only allow universe level comparisons to fail with
 type-in-type

---
 engine/evd.ml             | 13 +++-----
 engine/uState.ml          | 50 +++++++++++++++++-------------
 kernel/indTyping.ml       | 64 +++++++++++++++++++--------------------
 kernel/inductive.ml       | 32 +++++++++-----------
 kernel/uGraph.ml          | 30 +++++++-----------
 kernel/uGraph.mli         |  8 ++---
 pretyping/reductionops.ml |  2 +-
 pretyping/typing.ml       |  5 +--
 8 files changed, 95 insertions(+), 109 deletions(-)

diff --git a/engine/evd.ml b/engine/evd.ml
index f10d71c84e27..1ac67abc3d06 100644
--- a/engine/evd.ml
+++ b/engine/evd.ml
@@ -1148,11 +1148,8 @@ 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
+    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 +1167,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))
diff --git a/engine/uState.ml b/engine/uState.ml
index 989c3ac31065..dac53a8cf151 100644
--- a/engine/uState.ml
+++ b/engine/uState.ml
@@ -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)))
 
@@ -488,10 +494,9 @@ 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 ".")
+      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;
@@ -712,8 +717,7 @@ let warn_template uctx csts =
     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 fail () = sort_inconsistency (get_constraint c) s1 s2
   in
   { l with
     local_sorts = QState.unify_quality ~fail
@@ -748,20 +752,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
@@ -790,7 +794,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 _) ->
@@ -804,7 +808,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
@@ -825,7 +829,7 @@ let process_constraints uctx cstrs =
       | 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
@@ -835,28 +839,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
@@ -872,7 +876,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' ->
@@ -895,8 +899,12 @@ let process_constraints uctx cstrs =
       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 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;
diff --git a/kernel/indTyping.ml b/kernel/indTyping.ml
index 11f1a8a997fb..b01eff746001 100644
--- a/kernel/indTyping.ml
+++ b/kernel/indTyping.ml
@@ -103,40 +103,38 @@ let compute_elim_squash ?(is_real_arg=false) env u info =
           else info
         | Prop | Set | Type _ -> { info with record_arg_info = HasRelevantArg }
   in
-  if (Environ.type_in_type env) then info
+  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 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 }
+    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 }
 
 let check_context_univs ~ctor env info ctx =
   let check_one d (info,env) =
diff --git a/kernel/inductive.ml b/kernel/inductive.ml
index 1ce2cc6509c2..858f52dd790a 100644
--- a/kernel/inductive.ml
+++ b/kernel/inductive.ml
@@ -1666,23 +1666,21 @@ let inductive_of_mutfix ?evars ?elim_to env ((nvect,bodynum),(names,types,bodies
     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 ()
-      else
-        let sind = UVars.subst_instance_sort inst mip.mind_sort in
-        let u = Sorts.univ_of_sort sind 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
-          | 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)
+      let sind = UVars.subst_instance_sort inst mip.mind_sort in
+      let u = Sorts.univ_of_sort sind 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
+        | 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
   in
diff --git a/kernel/uGraph.ml b/kernel/uGraph.ml
index dc5ad7de323a..7cf8ceb40749 100644
--- a/kernel/uGraph.ml
+++ b/kernel/uGraph.ml
@@ -129,29 +129,21 @@ 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
diff --git a/kernel/uGraph.mli b/kernel/uGraph.mli
index 7ed22be15eaa..cc50cc978dea 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].
@@ -64,13 +64,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
 
diff --git a/pretyping/reductionops.ml b/pretyping/reductionops.ml
index 12919597452e..0e1f22e4aa94 100644
--- a/pretyping/reductionops.ml
+++ b/pretyping/reductionops.ml
@@ -1393,7 +1393,7 @@ let infer_conv_ustate ?(catch_incon=true) ?(pb=Conversion.CUMUL)
         with
         | Result.Ok cstr -> Some cstr
         | Result.Error None -> None
-        | Result.Error (Some e) -> raise (UGraph.UniverseInconsistency e)
+        | Result.Error (Some e) -> Empty.abort e
   with
   | UGraph.UniverseInconsistency _ when catch_incon -> None
   | e ->
diff --git a/pretyping/typing.ml b/pretyping/typing.ml
index e21aa943675c..a820559d711b 100644
--- a/pretyping/typing.ml
+++ b/pretyping/typing.ml
@@ -525,10 +525,7 @@ let check_binder_relevance env sigma s decl =
   | None ->
     (* 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
-    in
+    let () = warn_bad_relevance_binder env sigma rs decl in
     sigma, set_annot { (get_annot decl) with binder_relevance = rs } decl
 
 (* cstr must be in n.f. w.r.t. evars and execute returns a judgement

From e8b5fd6b5e7285e7b0a40c291eddb6affb667b0b Mon Sep 17 00:00:00 2001
From: Yann Leray <yann.leray@inria.fr>
Date: Thu, 22 Jan 2026 15:19:04 +0100
Subject: [PATCH 090/578] Fix test-suite

---
 test-suite/output/bug_20242.out | 9 +++++----
 test-suite/output/bug_20242.v   | 9 +++++----
 2 files changed, 10 insertions(+), 8 deletions(-)

diff --git a/test-suite/output/bug_20242.out b/test-suite/output/bug_20242.out
index e660d53d9964..347666a217cf 100644
--- a/test-suite/output/bug_20242.out
+++ b/test-suite/output/bug_20242.out
@@ -1,8 +1,9 @@
-File "./output/bug_20242.v", line 5, characters 49-60:
+File "./output/bug_20242.v", line 6, characters 52-63:
 The command has indeed failed with message:
-Signature components for field B do not match: expected type
-"foo@{Type ; A.A.u0} bug_20242.B.A" but found type
-"foo@{SProp ; bug_20242.26} bug_20242.B.A".
+Signature components for field B do not match:
+conversion of polymorphic values generates additional constraints: 
+""foo@{Type ; Set} bug_20242.B.A@{Var(0)}"" compared to 
+""foo@{Type ; Var(0)} bug_20242.B.A@{Var(0)}"".
 Error: The module B needs to be closed.
 
 
diff --git a/test-suite/output/bug_20242.v b/test-suite/output/bug_20242.v
index a2109b9c1162..4abb450010c6 100644
--- a/test-suite/output/bug_20242.v
+++ b/test-suite/output/bug_20242.v
@@ -1,5 +1,6 @@
 Polymorphic Record foo@{s;u|} (x : Type@{s;u}) := {}.
-Inductive sEmpty : SProp := .
-Module Type A. Axiom A : Type. Axiom B : foo A. End A.
-Unset Universe Checking.
-Module B <: A. Axiom A : SProp. Axiom B : foo A. Fail End B.
+
+Set Universe Polymorphism.
+
+Module Type A. Axiom A@{i} : Type@{i}. Axiom B : foo A. End A.
+Module B <: A. Axiom A@{i} : Prop. Axiom B : foo A. Fail End B.

From 7b02e2c616ee592cbc6a9df31956113f84ec2eac Mon Sep 17 00:00:00 2001
From: Yann Leray <yann.leray@inria.fr>
Date: Fri, 23 Jan 2026 16:22:22 +0100
Subject: [PATCH 091/578] Drop untestable tests

---
 test-suite/bugs/bug_16204.v | 25 -------------------------
 test-suite/bugs/bug_4403.v  |  3 ---
 2 files changed, 28 deletions(-)
 delete mode 100644 test-suite/bugs/bug_16204.v
 delete mode 100644 test-suite/bugs/bug_4403.v

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_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.

From fcb20a0280cbb39fd06ebb2d501b4af00840fa52 Mon Sep 17 00:00:00 2001
From: Yann Leray <yann.leray@inria.fr>
Date: Thu, 5 Feb 2026 14:39:20 +0100
Subject: [PATCH 092/578] Add ignore_elimination_constraints typing flag

---
 checker/checkFlags.ml   |  1 +
 checker/values.ml       |  2 +-
 engine/evd.ml           |  1 +
 engine/uState.ml        | 17 +++++++++++------
 kernel/declarations.mli |  3 +++
 kernel/declareops.ml    |  1 +
 kernel/environ.ml       |  7 +++++++
 kernel/environ.mli      |  3 +++
 kernel/indTyping.ml     |  1 +
 kernel/inductive.ml     |  1 +
 kernel/qGraph.ml        | 15 ++++++++++++---
 kernel/qGraph.mli       |  9 +++++++++
 pretyping/typing.ml     |  5 ++++-
 13 files changed, 55 insertions(+), 11 deletions(-)

diff --git a/checker/checkFlags.ml b/checker/checkFlags.ml
index 568d2aaa9609..0c3a98db311c 100644
--- a/checker/checkFlags.ml
+++ b/checker/checkFlags.ml
@@ -18,6 +18,7 @@ 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;
     allow_uip = flags.allow_uip;
diff --git a/checker/values.ml b/checker/values.ml
index 683c95ea9dae..17b25ca4628b 100644
--- a/checker/values.ml
+++ b/checker/values.ml
@@ -355,7 +355,7 @@ 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|]
 
diff --git a/engine/evd.ml b/engine/evd.ml
index 1ac67abc3d06..d9858fc56870 100644
--- a/engine/evd.ml
+++ b/engine/evd.ml
@@ -1148,6 +1148,7 @@ let set_eq_sort evd s1 s2 =
   match is_eq_sort s1 s2 with
   | None -> evd
   | Some (u1, u2) ->
+    if QGraph.ignore_constraints (UState.elim_graph evd.universes) then evd else
     add_constraints evd
       (UnivProblem.Set.singleton (UnivProblem.UEq (u1,u2)))
 
diff --git a/engine/uState.ml b/engine/uState.ml
index dac53a8cf151..90041147c2d7 100644
--- a/engine/uState.ml
+++ b/engine/uState.ml
@@ -494,6 +494,7 @@ 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 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 ".")
@@ -716,8 +717,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 () = 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
@@ -818,11 +821,11 @@ 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
@@ -893,7 +896,7 @@ 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
@@ -901,6 +904,8 @@ let process_constraints uctx cstrs =
   let unify_universes cst 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)
diff --git a/kernel/declarations.mli b/kernel/declarations.mli
index 971ae89b6a04..ebdd936aacff 100644
--- a/kernel/declarations.mli
+++ b/kernel/declarations.mli
@@ -77,6 +77,9 @@ 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 *)
 
diff --git a/kernel/declareops.ml b/kernel/declareops.ml
index ecd9844cd050..e8460bbf9446 100644
--- a/kernel/declareops.ml
+++ b/kernel/declareops.ml
@@ -22,6 +22,7 @@ let noh hcons x = snd (hcons x)
 let safe_flags oracle = {
   check_guarded = true;
   check_positive = true;
+  check_eliminations = true;
   check_universes = true;
   conv_oracle = oracle;
   share_reduction = true;
diff --git a/kernel/environ.ml b/kernel/environ.ml
index a1f397e0ff44..4b86145c67cd 100644
--- a/kernel/environ.ml
+++ b/kernel/environ.ml
@@ -349,6 +349,7 @@ let is_impredicative_sort env = function
   | Sorts.Type _ | Sorts.QSort _ -> 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
@@ -543,6 +544,7 @@ let same_flags {
      check_guarded;
      check_positive;
      check_universes;
+     check_eliminations;
      conv_oracle;
      indices_matter;
      share_reduction;
@@ -555,6 +557,7 @@ 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 &&
@@ -572,6 +575,7 @@ let set_typing_flags c env =
   else
     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 =
@@ -983,6 +987,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 =
diff --git a/kernel/environ.mli b/kernel/environ.mli
index 2070e73a2e74..b5afd88977a0 100644
--- a/kernel/environ.mli
+++ b/kernel/environ.mli
@@ -78,6 +78,7 @@ 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
 
@@ -473,6 +474,8 @@ 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
diff --git a/kernel/indTyping.ml b/kernel/indTyping.ml
index b01eff746001..72c644c19b56 100644
--- a/kernel/indTyping.ml
+++ b/kernel/indTyping.ml
@@ -103,6 +103,7 @@ let compute_elim_squash ?(is_real_arg=false) env u info =
           else info
         | Prop | Set | Type _ -> { info with record_arg_info = HasRelevantArg }
   in
+  if Environ.ignore_elim_constraints env then info else
   let indu = info.ind_univ
   and check_univ_consistency f induu uu =
     if UGraph.check_leq (universes env) uu induu
diff --git a/kernel/inductive.ml b/kernel/inductive.ml
index 858f52dd790a..f4cf7164ade8 100644
--- a/kernel/inductive.ml
+++ b/kernel/inductive.ml
@@ -1666,6 +1666,7 @@ let inductive_of_mutfix ?evars ?elim_to env ((nvect,bodynum),(names,types,bodies
     let _, mip = lookup_mind_specif env ind in
     (* recursive sprop means non record with projections -> squashed *)
     let () =
+      if Environ.ind_ignores_elim_constraints env ind then () else
       let sind = UVars.subst_instance_sort inst mip.mind_sort in
       let u = Sorts.univ_of_sort sind in
       (* This is an approximation: a [Relevant] variable might be of sort [Prop]
diff --git a/kernel/qGraph.ml b/kernel/qGraph.ml
index fe26f61d1047..55f3644d23a8 100644
--- a/kernel/qGraph.ml
+++ b/kernel/qGraph.ml
@@ -94,6 +94,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
@@ -123,6 +124,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
@@ -225,6 +229,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 +237,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
 
@@ -271,9 +278,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' =
diff --git a/kernel/qGraph.mli b/kernel/qGraph.mli
index 89409ef42560..1a21bd122752 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 =
diff --git a/pretyping/typing.ml b/pretyping/typing.ml
index a820559d711b..0bcf2610f966 100644
--- a/pretyping/typing.ml
+++ b/pretyping/typing.ml
@@ -525,7 +525,10 @@ let check_binder_relevance env sigma s decl =
   | None ->
     (* TODO always anomaly *)
     let rs = ESorts.relevance_of_sort s in
-    let () = warn_bad_relevance_binder env sigma rs decl in
+    let () =
+      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
 
 (* cstr must be in n.f. w.r.t. evars and execute returns a judgement

From aed195a01b28d2568900f2c2460f446eebb202a4 Mon Sep 17 00:00:00 2001
From: Yann Leray <yann.leray@inria.fr>
Date: Fri, 23 Jan 2026 16:24:33 +0100
Subject: [PATCH 093/578] Add overlays for HB and lean-importer

---
 dev/ci/user-overlays/21531-Yann-Leray-stricter-type-in-type.sh | 3 +++
 1 file changed, 3 insertions(+)
 create mode 100644 dev/ci/user-overlays/21531-Yann-Leray-stricter-type-in-type.sh

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

From 1fd16a6725522d0a302ed624036792866b81b425 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Mon, 2 Feb 2026 14:47:56 +0100
Subject: [PATCH 094/578] Move the Ftactic module to the Ltac plugin.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

The only raison d'être of this module was to support the dynamic focussing
of Ltac1. No sane tactic system should rely on it, given it is not even
a monad despite claiming so.
---
 {engine => plugins/ltac}/ftactic.ml   |  0
 {engine => plugins/ltac}/ftactic.mli  |  0
 plugins/ltac/tacentries.ml            |  8 ++++----
 plugins/ltac/tacentries.mli           |  2 +-
 plugins/ltac/tacinterp.ml             | 25 +++++++++++++++++++++++--
 plugins/ltac/tacinterp.mli            | 14 ++++++++++++++
 plugins/ltac2_ltac1/tac2core_ltac1.ml |  8 ++++----
 plugins/ssr/ssrparser.mlg             |  2 +-
 plugins/ssrmatching/ssrmatching.ml    |  2 +-
 pretyping/geninterp.ml                | 17 -----------------
 pretyping/geninterp.mli               |  9 ---------
 11 files changed, 48 insertions(+), 39 deletions(-)
 rename {engine => plugins/ltac}/ftactic.ml (100%)
 rename {engine => plugins/ltac}/ftactic.mli (100%)

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/tacentries.ml b/plugins/ltac/tacentries.ml
index 83adcc7b212e..22a0a60f41e8 100644
--- a/plugins/ltac/tacentries.ml
+++ b/plugins/ltac/tacentries.ml
@@ -841,7 +841,7 @@ let in_tacval =
     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,7 +879,7 @@ type 'b argument_subst =
 
 type ('b, 'c) argument_interp =
 | ArgInterpRet : ('c, 'c) argument_interp
-| ArgInterpFun : ('b, Val.t) interp_fun -> ('b, 'c) argument_interp
+| ArgInterpFun : ('b, Val.t) Tacinterp.Register.interp_fun -> ('b, 'c) argument_interp
 | ArgInterpWit : ('a, 'b, 'r) Genarg.genarg_type -> ('b, 'c) argument_interp
 | ArgInterpSimple :
   (Geninterp.interp_sign -> Environ.env -> Evd.evar_map -> 'b -> 'c) -> ('b, 'c) argument_interp
@@ -909,7 +909,7 @@ 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, Val.t) Tacinterp.Register.interp_fun =
 match arg.arg_interp with
 | ArgInterpRet -> (fun ist v -> Ftactic.return (Geninterp.Val.inject tag v))
 | ArgInterpFun f -> f
@@ -935,7 +935,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..b09e49f5fc3e 100644
--- a/plugins/ltac/tacentries.mli
+++ b/plugins/ltac/tacentries.mli
@@ -155,7 +155,7 @@ 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
+| ArgInterpFun : ('b, Geninterp.Val.t) Tacinterp.Register.interp_fun -> ('b, 'c) argument_interp
 | ArgInterpWit : ('a, 'b, 'r) Genarg.genarg_type -> ('b, 'c) argument_interp
 | ArgInterpSimple :
   (Geninterp.interp_sign -> Environ.env -> Evd.evar_map -> 'b -> 'c) -> ('b, 'c) argument_interp
diff --git a/plugins/ltac/tacinterp.ml b/plugins/ltac/tacinterp.ml
index a348253762df..3f879ce6659f 100644
--- a/plugins/ltac/tacinterp.ml
+++ b/plugins/ltac/tacinterp.ml
@@ -40,6 +40,27 @@ open Proofview.Notations
 open Context.Named.Declaration
 open Ltac_pretype
 
+module Register =
+struct
+type ('glb, 'top) interp_fun = Geninterp.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
+
+end
+
 let do_profile trace ?count_call tac =
   Profile_tactic.do_profile_gen (function
       | (_, c) :: _ -> Some (Pptactic.pp_ltac_call_kind c)
@@ -1572,7 +1593,7 @@ and interp_genarg ist x : Val.t Ftactic.t =
       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
+      Register.generic_interp ist x0
 
 (** returns [true] for genargs which have the same meaning
     independently of goals. *)
@@ -2065,7 +2086,7 @@ let register_interp0 wit f =
   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 interp
 
 let def_intern ist x = (ist, x)
 let def_subst _ x = x
diff --git a/plugins/ltac/tacinterp.mli b/plugins/ltac/tacinterp.mli
index 8ed131672b33..2f403b3d6fe6 100644
--- a/plugins/ltac/tacinterp.mli
+++ b/plugins/ltac/tacinterp.mli
@@ -151,3 +151,17 @@ val interp_intro_pattern : interp_sign -> Environ.env -> Evd.evar_map ->
 
 val default_ist : unit -> Geninterp.interp_sign
 (** Empty ist with debug set on the current value. *)
+
+module Register :
+sig
+open Genarg
+open Geninterp
+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
+end
diff --git a/plugins/ltac2_ltac1/tac2core_ltac1.ml b/plugins/ltac2_ltac1/tac2core_ltac1.ml
index 3f621b2b5987..f790edc12ad8 100644
--- a/plugins/ltac2_ltac1/tac2core_ltac1.ml
+++ b/plugins/ltac2_ltac1/tac2core_ltac1.ml
@@ -351,7 +351,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 +406,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/ssr/ssrparser.mlg b/plugins/ssr/ssrparser.mlg
index 00a6e0f23d7e..a60b4255acff 100644
--- a/plugins/ssr/ssrparser.mlg
+++ b/plugins/ssr/ssrparser.mlg
@@ -162,7 +162,7 @@ let add_genarg tag pr =
   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
diff --git a/plugins/ssrmatching/ssrmatching.ml b/plugins/ssrmatching/ssrmatching.ml
index 4f06465d2ca4..72a6b52b21a1 100644
--- a/plugins/ssrmatching/ssrmatching.ml
+++ b/plugins/ssrmatching/ssrmatching.ml
@@ -102,7 +102,7 @@ let add_genarg tag pr =
   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
diff --git a/pretyping/geninterp.ml b/pretyping/geninterp.ml
index 7b4a9ee1d84b..f3aa111d6f15 100644
--- a/pretyping/geninterp.ml
+++ b/pretyping/geninterp.ml
@@ -86,20 +86,3 @@ 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..5fe0f4f92202 100644
--- a/pretyping/geninterp.mli
+++ b/pretyping/geninterp.mli
@@ -66,12 +66,3 @@ 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

From 31d9934ef68df9b46a685c198997d7229230d3c0 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Thu, 5 Feb 2026 14:48:11 +0100
Subject: [PATCH 095/578] Remove the interpretation functions from
 Tacinterp.Register.

---
 plugins/ltac/tacinterp.mli | 8 +-------
 1 file changed, 1 insertion(+), 7 deletions(-)

diff --git a/plugins/ltac/tacinterp.mli b/plugins/ltac/tacinterp.mli
index 2f403b3d6fe6..a497e81c01f2 100644
--- a/plugins/ltac/tacinterp.mli
+++ b/plugins/ltac/tacinterp.mli
@@ -154,14 +154,8 @@ val default_ist : unit -> Geninterp.interp_sign
 
 module Register :
 sig
-open Genarg
-open Geninterp
 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
+  ('raw, 'glb, 'top) genarg_type -> ('glb, Geninterp.Val.t) interp_fun -> unit
 end

From 676c3215f6910a27541a73d1aeba221cc8e58bf2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Thu, 5 Feb 2026 13:10:11 +0100
Subject: [PATCH 096/578] Add overlays.

---
 dev/ci/user-overlays/21572-ppedrot-move-ftactic-to-ltac.sh | 5 +++++
 1 file changed, 5 insertions(+)
 create mode 100644 dev/ci/user-overlays/21572-ppedrot-move-ftactic-to-ltac.sh

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

From 551f2c2b1f82e8a4aeb7688139cb49f1825934c1 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Fri, 23 Jan 2026 08:44:15 +0100
Subject: [PATCH 097/578] Introduce a dedicated type for recursive environment
 nodes in Indtypes.

---
 kernel/indtypes.ml | 16 +++++++++-------
 1 file changed, 9 insertions(+), 7 deletions(-)

diff --git a/kernel/indtypes.ml b/kernel/indtypes.ml
index 44a13d462084..c80b1e5fa307 100644
--- a/kernel/indtypes.ml
+++ b/kernel/indtypes.ml
@@ -63,6 +63,8 @@ type ill_formed_ind =
 
 exception IllFormedInd of ill_formed_ind
 
+type rdecl = { head : recarg; node : wf_paths }
+
 (* [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. *)
@@ -153,7 +155,7 @@ if Int.equal nmr 0 then 0 else
    [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)
+  (push_rel (LocalAssum (x, a)) env, n+1, ntypes, { head = Norec; node = ra } :: lra)
 
 let ienv_push_inductive (env, n, ntypes, ra_env) ((mi,u),lrecparams) =
   let auxntyp = 1 in
@@ -165,8 +167,8 @@ 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
+    { head = Mrec (RecArgInd mi); node = (Rtree.mk_rec_calls 1).(0) } ::
+    List.map (fun { head = r; node = t } -> { head = r; node = Rtree.lift 1 t }) ra_env in
   (* New index of the inductive types *)
   let newidx = n + auxntyp in
   (env', newidx, ntypes, ra_env')
@@ -220,7 +222,7 @@ let check_positivity_one ~chkpos recursive (env,_,ntypes,_ as ienv) paramsctxt (
                   check_strict_positivity (ienv_push_var ienv (na, b, mk_norec)) nmr d)
         | Rel k ->
             (match List.nth_opt ra_env (k-1) with
-            | Some (ra,rarg) ->
+            | Some { head = ra; node = rarg } ->
             let largs = List.map (whd_all env) largs in
             let nmr1 =
               (match ra with
@@ -312,7 +314,7 @@ let check_positivity_one ~chkpos recursive (env,_,ntypes,_ as ienv) paramsctxt (
     (* 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 ra_env = List.map (fun { head = r; node = t } -> { head = r; node = 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))
@@ -377,13 +379,13 @@ let check_positivity ~chkpos kn names env_ar_par paramsctxt finite inds =
   let ntypes = Array.length inds in
   let recursive = finite != BiFinite 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.mapi (fun j t -> { head = Mrec (RecArgInd (kn, j)); node = 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
+      List.init nparamsctxt (fun _ -> { head = Norec; node = mk_norec }) @ 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

From 35715b2ccb7a9ecb924109287bac654a3f36c7fb Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Fri, 23 Jan 2026 08:47:16 +0100
Subject: [PATCH 098/578] Enforce that Norec nodes are always associated to
 norec in Indtypes.

---
 kernel/indtypes.ml | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/kernel/indtypes.ml b/kernel/indtypes.ml
index c80b1e5fa307..21c046e0cb0a 100644
--- a/kernel/indtypes.ml
+++ b/kernel/indtypes.ml
@@ -154,8 +154,8 @@ 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, { head = Norec; node = ra } :: lra)
+let ienv_push_var (env, n, ntypes, lra) (x, a) =
+  (push_rel (LocalAssum (x, a)) env, n+1, ntypes, { head = Norec; node = mk_norec } :: lra)
 
 let ienv_push_inductive (env, n, ntypes, ra_env) ((mi,u),lrecparams) =
   let auxntyp = 1 in
@@ -178,7 +178,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
 
@@ -217,9 +217,9 @@ 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 { head = ra; node = rarg } ->
@@ -337,7 +337,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 () =

From 8daec53b84031cb0d5e605f473512f865841d9d3 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Fri, 23 Jan 2026 16:57:58 +0100
Subject: [PATCH 099/578] Invariant in Indtypes rtree environment.

We know statically that the rel context and the rtree context are
synchronized. In particular they must have the same size.
---
 kernel/indtypes.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/kernel/indtypes.ml b/kernel/indtypes.ml
index 21c046e0cb0a..f7faa4c7c945 100644
--- a/kernel/indtypes.ml
+++ b/kernel/indtypes.ml
@@ -240,7 +240,7 @@ let check_positivity_one ~chkpos recursive (env,_,ntypes,_ as ienv) paramsctxt (
                  not (List.for_all (noccur_between n ntypes) largs)
               then failwith_non_pos_list n ntypes largs
               else (nmr1,rarg)
-            | None -> (nmr,mk_norec))
+            | None -> assert false)
         | Ind ind_kn ->
             (** If one of the inductives of the mutually inductive
                 block being defined appears in a parameter, then we

From a6f9ec1bd8123863e564b382591de01652e8aa3a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Fri, 23 Jan 2026 17:02:07 +0100
Subject: [PATCH 100/578] More precise type for rtree environments in Indtypes.

The only reason we care about the value of the recarg_type is to check
whether we are looking at the inductive being defined or some other
nesting inductive type. We replace this by a proper ADT.
---
 kernel/indtypes.ml | 49 +++++++++++++++++++++++++---------------------
 1 file changed, 27 insertions(+), 22 deletions(-)

diff --git a/kernel/indtypes.ml b/kernel/indtypes.ml
index f7faa4c7c945..08ee09913c0e 100644
--- a/kernel/indtypes.ml
+++ b/kernel/indtypes.ml
@@ -63,7 +63,17 @@ type ill_formed_ind =
 
 exception IllFormedInd of ill_formed_ind
 
-type rdecl = { head : recarg; node : wf_paths }
+type rdecl =
+| Toplevel of wf_paths (* The inductive being checked *)
+| Nesting of wf_paths (* A nested inductive node *)
+| 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)
+| 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)
@@ -155,7 +165,7 @@ if Int.equal nmr 0 then 0 else
    [lra] is the list of recursive tree of each variable
  *)
 let ienv_push_var (env, n, ntypes, lra) (x, a) =
-  (push_rel (LocalAssum (x, a)) env, n+1, ntypes, { head = Norec; node = mk_norec } :: lra)
+  (push_rel (LocalAssum (x, a)) env, n+1, ntypes, Other :: lra)
 
 let ienv_push_inductive (env, n, ntypes, ra_env) ((mi,u),lrecparams) =
   let auxntyp = 1 in
@@ -166,9 +176,7 @@ let ienv_push_inductive (env, n, ntypes, ra_env) ((mi,u),lrecparams) =
     let anon = Context.make_annot Anonymous r in
     let decl = LocalAssum (anon, hnf_prod_applist env ty lrecparams) in
     push_rel decl env in
-  let ra_env' =
-    { head = Mrec (RecArgInd mi); node = (Rtree.mk_rec_calls 1).(0) } ::
-    List.map (fun { head = r; node = t } -> { head = r; node = Rtree.lift 1 t }) ra_env in
+  let ra_env' = Nesting (Rtree.mk_rec_calls 1).(0) :: List.map lift_rdecl ra_env in
   (* New index of the inductive types *)
   let newidx = n + auxntyp in
   (env', newidx, ntypes, ra_env')
@@ -197,7 +205,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
@@ -222,24 +230,22 @@ let check_positivity_one ~chkpos recursive (env,_,ntypes,_ as ienv) paramsctxt (
                   check_strict_positivity (ienv_push_var ienv (na, b)) nmr d)
         | Rel k ->
             (match List.nth_opt ra_env (k-1) with
-            | Some { head = ra; node = 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)
+              (* 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
+              | Other -> nmr, mk_norec
+              end
             | None -> assert false)
         | Ind ind_kn ->
             (** If one of the inductives of the mutually inductive
@@ -314,7 +320,7 @@ let check_positivity_one ~chkpos recursive (env,_,ntypes,_ as ienv) paramsctxt (
     (* 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 { head = r; node = t } -> { head = r; node = Rtree.lift 1 t }) ra_env in
+    let ra_env = List.map lift_rdecl 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))
@@ -379,13 +385,12 @@ let check_positivity ~chkpos kn names env_ar_par paramsctxt finite inds =
   let ntypes = Array.length inds in
   let recursive = finite != BiFinite in
   if not recursive && Array.length inds <> 1 then raise (InductiveError (env_ar_par,Type_errors.BadEntry));
-  let rc = Array.mapi (fun j t -> { head = Mrec (RecArgInd (kn, j)); node = 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 _ -> { head = Norec; node = 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

From c00430367c1d99f7b1cb2659fca709bedbb44e2e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Thu, 5 Feb 2026 17:43:08 +0100
Subject: [PATCH 101/578] Stdarg.wit_identref is vernac_genarg_type

It doesn't have a registered intern so the glob and top types were
incorrect and should be empty.
---
 tactics/stdarg.mli | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

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
 

From 0e70d6e29d9cab34aa16761251f5005a370cd22c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Thu, 5 Feb 2026 17:48:42 +0100
Subject: [PATCH 102/578] Fix changelog for #16539

---
 doc/sphinx/changes.rst | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/doc/sphinx/changes.rst b/doc/sphinx/changes.rst
index 984225d296e6..49b0ee383a16 100644
--- a/doc/sphinx/changes.rst
+++ b/doc/sphinx/changes.rst
@@ -4794,7 +4794,7 @@ Ltac2 language
   by Jason Gross).
 - **Added:**
   ``Ltac2.Option.equal``
-  (`#16538 <https://github.com/rocq-prover/rocq/pull/16538>`_,
+  (`#16539 <https://github.com/rocq-prover/rocq/pull/16539>`_,
   by Jason Gross).
 - **Added:**
   syntax for Ltac2 record update ``{ foo with field := bar }``

From 614687be5293b5bde28f9198d4f17f7341630f71 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Fri, 6 Feb 2026 11:25:38 +0100
Subject: [PATCH 103/578] Shortcut pretyping of applications with no arguments

---
 pretyping/pretyping.ml      | 4 ++++
 test-suite/bugs/bug_21596.v | 6 ++++++
 2 files changed, 10 insertions(+)
 create mode 100644 test-suite/bugs/bug_21596.v

diff --git a/pretyping/pretyping.ml b/pretyping/pretyping.ml
index 96ded43b0f35..6876af0f4502 100644
--- a/pretyping/pretyping.ml
+++ b/pretyping/pretyping.ml
@@ -1059,6 +1059,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
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.

From f3f0183c0d25b163a54191803291cf216cfef53c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Fri, 6 Feb 2026 11:28:59 +0100
Subject: [PATCH 104/578] Update comment in notation_term: fixpoints are
 allowed

and have been allowed since ebf38f04cad3c4abbb779c3c40c1ba6d69bc0f71 (2008)
---
 interp/notation_term.mli | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/interp/notation_term.mli b/interp/notation_term.mli
index abb6c5a66b17..469dd95f9947 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] *)

From d7148e3bc04fecfbf0060b7489dd75f034fd4a72 Mon Sep 17 00:00:00 2001
From: jstrattonsmith <49959196+jstrattonsmith@users.noreply.github.com>
Date: Fri, 6 Feb 2026 17:33:48 -0500
Subject: [PATCH 105/578] Fixing grammar of the introductory ssreflect
 documentation.

---
 doc/sphinx/proof-engine/ssreflect-proof-language.rst | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/doc/sphinx/proof-engine/ssreflect-proof-language.rst b/doc/sphinx/proof-engine/ssreflect-proof-language.rst
index f266363ceff0..ea8e2146dfc6 100644
--- a/doc/sphinx/proof-engine/ssreflect-proof-language.rst
+++ b/doc/sphinx/proof-engine/ssreflect-proof-language.rst
@@ -1046,7 +1046,7 @@ 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
+   the variables and assumption of the goal into the constants
    ``m n : nat`` and the fact ``le_n_m : n <= m``, thus exposing the
    conclusion ``m - n + n = m``.
 

From a702d94718d047919982f787028022f2b5a562cb Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Mon, 9 Feb 2026 11:15:41 +0100
Subject: [PATCH 106/578] Update closed issue counts in changelog

Close #21581
---
 doc/sphinx/changes.rst | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/doc/sphinx/changes.rst b/doc/sphinx/changes.rst
index 83df62922d8d..03069dc4b8d8 100644
--- a/doc/sphinx/changes.rst
+++ b/doc/sphinx/changes.rst
@@ -108,7 +108,7 @@ the `Discourse forum <https://discourse.rocq-prover.org>`__ and the
 `Rocq Zulip chat <https://rocq-prover.zulipchat.com>`_.
 
 Nicolas Tabareau is the release manager of Rocq 9.2.
-This release is the result of 486 merged PRs, closing 4 issues.
+This release is the result of 486 merged PRs, closing 80 issues.
 
 | Nantes, March 2026
 | Nicolas Tabareau for the Rocq development team
@@ -705,7 +705,7 @@ the `Discourse forum <https://discourse.rocq-prover.org>`__ and the
 `Rocq Zulip chat <https://rocq-prover.zulipchat.com>`_.
 
 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

From da48380202dd6aa735a0f3d1afa1e115ff1065b5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Mon, 9 Feb 2026 11:47:06 +0100
Subject: [PATCH 107/578] cclosure less polymorphic types for rewrite rules

---
 kernel/cClosure.ml | 95 +++++++++++++++++++++++-----------------------
 1 file changed, 48 insertions(+), 47 deletions(-)

diff --git a/kernel/cClosure.ml b/kernel/cClosure.ml
index ba020ce45172..c59dc56b6b13 100644
--- a/kernel/cClosure.ml
+++ b/kernel/cClosure.ml
@@ -1492,29 +1492,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
@@ -1533,20 +1531,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 =
@@ -1592,7 +1603,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
@@ -1614,7 +1625,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; _ } ->
@@ -1623,7 +1634,7 @@ 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 =
+and match_endstack : 'a. ('a, 'a depth) reduction -> _ -> _ -> pat_state:'a depth -> _ -> _ -> 'a =
   fun red info tab ~pat_state states next ->
   match next with
   | Continue next -> match_main red info tab ~pat_state states next
@@ -1631,7 +1642,7 @@ and match_endstack : 'a. ('a, 'a patstate) reduction -> _ -> _ -> pat_state:(_,
       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 =
+and try_unfoldfix : 'a. ('a, 'a depth) reduction -> _ -> _ -> pat_state:'a depth -> _ -> 'a =
   fun 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
@@ -1642,7 +1653,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 ->
@@ -1708,7 +1719,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
@@ -1725,7 +1736,7 @@ 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 =
+and match_head : 'a. ('a, 'a depth) reduction -> _ -> _ -> pat_state:'a depth -> _ -> _ -> _ -> _ -> _ -> _ -> 'a =
   fun red info tab ~pat_state next context states patterns t stk ->
   match [@ocaml.warning "-4"] t.term with
   | FInd (ind', u) ->
@@ -1881,7 +1892,7 @@ 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 =
@@ -1903,12 +1914,7 @@ 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
@@ -1998,12 +2004,7 @@ 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
 
@@ -2043,7 +2044,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;

From 3393fa86a94653f77e6935f4ad701ab1dc0a657b Mon Sep 17 00:00:00 2001
From: nicolas tabareau <nicolas.tabareau@gmail.com>
Date: Fri, 6 Feb 2026 18:16:22 +0100
Subject: [PATCH 108/578] avoid delta unfolding for finding instance

---
 tactics/equality.ml         | 33 +++++++++++++++++++++++----------
 tactics/equality.mli        |  2 +-
 test-suite/bugs/bug_21601.v | 21 +++++++++++++++++++++
 3 files changed, 45 insertions(+), 11 deletions(-)
 create mode 100644 test-suite/bugs/bug_21601.v

diff --git a/tactics/equality.ml b/tactics/equality.ml
index fd5bc18014be..4631b68a6e4c 100644
--- a/tactics/equality.ml
+++ b/tactics/equality.ml
@@ -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
@@ -495,14 +505,17 @@ let find_elim lft2rgt dep inccl type_of_cls (ctx, hdcncl, args) =
       Proofview.Unsafe.tclEVARS sigma <*> Proofview.tclUNIT (gref, UnknownPosition)
     | _ -> 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)
     | None -> gen_elim ()
diff --git a/tactics/equality.mli b/tactics/equality.mli
index fa3d56eeb6ad..a00084b8483b 100644
--- a/tactics/equality.mli
+++ b/tactics/equality.mli
@@ -27,7 +27,7 @@ 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 ->
+val lookup_eq_eliminator_with_error : ?het_eq:bool -> Environ.env -> Evd.evar_map -> Evd.econstr ->
   dep:orientation -> inccl:orientation -> l2r:orientation option ->
   c_sort:ESorts.t ->
   e_sort:ESorts.t ->
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.

From 9472fd9bbb31d9511792e217b7122df6ed05624a Mon Sep 17 00:00:00 2001
From: nicolas tabareau <nicolas.tabareau@gmail.com>
Date: Mon, 9 Feb 2026 16:11:35 +0100
Subject: [PATCH 109/578] remove use of `option orientation` when only
 orientation is needed

---
 plugins/ssr/ssrequality.ml |  2 +-
 tactics/equality.ml        | 80 +++++++++++++++++++-------------------
 tactics/equality.mli       |  2 +-
 3 files changed, 42 insertions(+), 42 deletions(-)

diff --git a/plugins/ssr/ssrequality.ml b/plugins/ssr/ssrequality.ml
index d4cc38261cd4..341b9c72c855 100644
--- a/plugins/ssr/ssrequality.ml
+++ b/plugins/ssr/ssrequality.ml
@@ -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
diff --git a/tactics/equality.ml b/tactics/equality.ml
index 4631b68a6e4c..b1dc3dbf2c26 100644
--- a/tactics/equality.ml
+++ b/tactics/equality.ml
@@ -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 =
@@ -533,7 +533,7 @@ let leibniz_rewrite_ebindings_clause cls lft2rgt tac c ((_, hdcncl, _) as t) l w
   let inccl = Option.is_empty cls in
   find_elim lft2rgt dep inccl type_of_cls t >>= fun (elim, indarg) ->
       general_elim_clause with_evars frzevars tac cls c t l
-      (match lft2rgt with None -> false | Some b -> b) elim indarg
+      lft2rgt elim indarg
   end
 
 let adjust_rewriting_direction args lft2rgt =
@@ -543,10 +543,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)
 
@@ -1150,7 +1150,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
diff --git a/tactics/equality.mli b/tactics/equality.mli
index a00084b8483b..8c3f1d75b7a6 100644
--- a/tactics/equality.mli
+++ b/tactics/equality.mli
@@ -28,7 +28,7 @@ type conditions =
   | AllMatches (* Rewrite all matches whose side-conditions are solved *)
 
 val lookup_eq_eliminator_with_error : ?het_eq:bool -> Environ.env -> Evd.evar_map -> Evd.econstr ->
-  dep:orientation -> inccl:orientation -> l2r:orientation option ->
+  dep:bool -> inccl:bool -> l2r:orientation ->
   c_sort:ESorts.t ->
   e_sort:ESorts.t ->
   p_sort:ESorts.t ->

From d46b368d8406f13942b442d5bfd7e7510ffa5221 Mon Sep 17 00:00:00 2001
From: Chantal Keller <ckeller@lmf.cnrs.fr>
Date: Mon, 9 Feb 2026 18:02:58 +0100
Subject: [PATCH 110/578] Change ownership of the trakt plugin

---
 dev/ci/ci-basic-overlay.sh | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/dev/ci/ci-basic-overlay.sh b/dev/ci/ci-basic-overlay.sh
index 31b0d1534e14..a16ddf5de664 100644
--- a/dev/ci/ci-basic-overlay.sh
+++ b/dev/ci/ci-basic-overlay.sh
@@ -549,5 +549,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

From 266d58e77ee929149498659a92b749d34388823a Mon Sep 17 00:00:00 2001
From: Mathis Bouverot-Dupuis <mathis.bouverot@ens.psl.eu>
Date: Tue, 10 Feb 2026 11:20:09 +0100
Subject: [PATCH 111/578] setoid rewriting: improve support for forall_relation

---
 test-suite/success/rewrite_forall_relation.v | 15 +++++++++
 theories/Corelib/Classes/Morphisms.v         | 33 +++++++++++++++-----
 2 files changed, 41 insertions(+), 7 deletions(-)
 create mode 100644 test-suite/success/rewrite_forall_relation.v

diff --git a/test-suite/success/rewrite_forall_relation.v b/test-suite/success/rewrite_forall_relation.v
new file mode 100644
index 000000000000..95da90eb985d
--- /dev/null
+++ b/test-suite/success/rewrite_forall_relation.v
@@ -0,0 +1,15 @@
+(** Test setoid rewriting with forall_relation. *)
+
+From Corelib Require Import Morphisms.
+
+Axiom K : nat -> nat -> nat -> Type.
+Axiom T : nat -> forall n1 n2 n3, K n1 n2 n3 -> Prop.
+
+Instance T_Proper : Proper (le ==> forallR n1 n2 n3, eq ==> Basics.impl)%signature T.
+Admitted.
+
+Lemma test i j (Hle : i <= j) n1 n2 n3 (k : K n1 n2 n3) (H : T i n1 n2 n3 k) : T j n1 n2 n3 k.
+Proof.
+  rewrite <-Hle.
+  exact H.
+Qed.
diff --git a/theories/Corelib/Classes/Morphisms.v b/theories/Corelib/Classes/Morphisms.v
index 79b24b3dff00..dd668e55ece7 100644
--- a/theories/Corelib/Classes/Morphisms.v
+++ b/theories/Corelib/Classes/Morphisms.v
@@ -165,6 +165,17 @@ Ltac reflexive_proxy_tac A R :=
 #[global]
 Hint Extern 1 (@ReflexiveProxy ?A ?R) => reflexive_proxy_tac A R : typeclass_instances.
 
+Section ForallRelation.
+  Let U := Type.
+  Context {A : U} (P : A -> U).
+
+  (** Dependent pointwise lifting of a relation on the range. *)
+  Definition forall_relation
+             (sig : forall a, relation (P a)) : relation (forall x, P x) :=
+    fun f g => forall a, sig a (f a) (g a).
+
+End ForallRelation.
+
 (** Notations reminiscent of the old syntax for declaring morphisms. *)
 Declare Scope signature_scope.
 Delimit Scope signature_scope with signature.
@@ -180,6 +191,10 @@ Module ProperNotations.
   Notation " R --> R' " := (@respectful _ _ (flip (R%signature)) (R'%signature))
     (right associativity, at level 55) : signature_scope.
 
+  Notation "'forallR' x .. y , R" :=
+    (@forall_relation _ _ (fun x => .. (@forall_relation _ _ (fun y => R%signature)) ..))
+    (right associativity, at level 55, x binder, y binder) : signature_scope.
+
 End ProperNotations.
 
 Arguments Proper {A}%_type R%_signature m.
@@ -232,12 +247,6 @@ Section Relations.
   
   Definition forall_def : Type := forall x : A, P x.
   
-  (** Dependent pointwise lifting of a relation on the range. *)
-  
-  Definition forall_relation 
-             (sig : forall a, relation (P a)) : relation (forall x, P x) :=
-    fun f g => forall a, sig a (f a) (g a).
-
   Lemma pointwise_pointwise (R : relation B) :
     relation_equivalence (pointwise_relation A R) (@eq A ==> R).
   Proof. intros. split; reduce; subst; firstorder. Qed.
@@ -279,7 +288,7 @@ Section Relations.
   
   (** For dependent function types. *)
   Lemma forall_subrelation (R S : forall x : A, relation (P x)) :
-    (forall a, subrelation (R a) (S a)) -> subrelation (forall_relation R) (forall_relation S).
+    (forall a, subrelation (R a) (S a)) -> subrelation (forall_relation _ R) (forall_relation _ S).
   Proof. intros H x y H0 a. apply H. apply H0. Qed.
 End Relations.
 
@@ -662,9 +671,19 @@ Proof.
   - apply NB. apply H. apply NA. apply H0.
 Qed.
 
+Lemma flip_forall {A : Type} {B : A -> Type} (R R' : forall a, relation (B a))
+  `(N : forall a, Normalizes (B a) (R a) (flip (R' a))) :
+  Normalizes (forall a, B a) (forall_relation R) (flip (forall_relation R')).
+Proof.
+intros F G. split.
+- intros H a. specialize (H a). now apply (N a) in H.
+- intros H a. specialize (H a). now apply (N a) in H.
+Qed.
+
 Ltac normalizes :=
   match goal with
     | [ |- Normalizes _ (respectful _ _) _ ] => class_apply @flip_arrow
+    | [ |- Normalizes _ (forall_relation _) _ ] => class_apply @flip_forall
     | _ => class_apply @flip_atom
   end.
 

From accb9e0cb6858d22a36b2ab1cf8ffa56c0e69d7a Mon Sep 17 00:00:00 2001
From: Yann Leray <yann.leray@inria.fr>
Date: Tue, 10 Feb 2026 15:05:30 +0100
Subject: [PATCH 112/578] Changelog and test

---
 .../01-kernel/21531-stricter-type-in-type-Fixed.rst         | 6 ++++++
 test-suite/bugs/bug_20667.v                                 | 5 +++++
 2 files changed, 11 insertions(+)
 create mode 100644 doc/changelog/01-kernel/21531-stricter-type-in-type-Fixed.rst
 create mode 100644 test-suite/bugs/bug_20667.v

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 <https://github.com/rocq-prover/rocq/pull/21531>`_,
+  fixes `#20241 <https://github.com/rocq-prover/rocq/issues/20241>`_
+  and `#20667 <https://github.com/rocq-prover/rocq/issues/20667>`_,
+  by Yann Leray).
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).

From bd34ba377deb0479601de99a31da38b8d0b5c37d Mon Sep 17 00:00:00 2001
From: Yann Leray <yann.leray@inria.fr>
Date: Tue, 10 Feb 2026 15:16:47 +0100
Subject: [PATCH 113/578] Remove unnecessary type annotations (4.14)

---
 kernel/cClosure.ml | 18 ++++++------------
 1 file changed, 6 insertions(+), 12 deletions(-)

diff --git a/kernel/cClosure.ml b/kernel/cClosure.ml
index c59dc56b6b13..aad194b2c9a1 100644
--- a/kernel/cClosure.ml
+++ b/kernel/cClosure.ml
@@ -1634,16 +1634,14 @@ and match_kill : 'a. ('a, 'a depth) reduction -> _ -> _ -> pat_state:'a depth ->
       | 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 depth) 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 depth) 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
@@ -1736,8 +1734,7 @@ and match_arg : 'a. ('a, 'a depth) reduction -> _ -> _ -> pat_state:'a depth ->
   else
     match_main red info tab ~pat_state states next
 
-and match_head : 'a. ('a, 'a depth) reduction -> _ -> _ -> pat_state:'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"]
@@ -1895,8 +1892,7 @@ end
 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
@@ -2009,12 +2005,10 @@ and knr_ret : type a. _ -> _ -> pat_state: a depth -> ?failed: _ -> _ -> a =
       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
 

From d706b3766ff4dc224de42bc79f996a1ad8cc4666 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Fri, 23 Jan 2026 09:32:51 +0100
Subject: [PATCH 114/578] Do not introduce recursive rtrees for non-recursive
 nesting inductive types.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

The previous code was representing every nested inductive node as an rtree
of the form µX.F{X}. For nesting types that were not recursive this was
inefficient, as the variable X cannot appear in the body F of the rtree,
leading to useless rtree expansions in fixpoint computation. This commit
basically compiles this node as F with the above notation.
---
 kernel/indtypes.ml | 35 ++++++++++++++++++++++++++++-------
 1 file changed, 28 insertions(+), 7 deletions(-)

diff --git a/kernel/indtypes.ml b/kernel/indtypes.ml
index 08ee09913c0e..fb3cfdaff8ac 100644
--- a/kernel/indtypes.ml
+++ b/kernel/indtypes.ml
@@ -66,6 +66,7 @@ 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 *)
@@ -73,6 +74,7 @@ type rdecl =
 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
@@ -167,7 +169,14 @@ if Int.equal nmr 0 then 0 else
 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
@@ -176,7 +185,10 @@ let ienv_push_inductive (env, n, ntypes, ra_env) ((mi,u),lrecparams) =
     let anon = Context.make_annot Anonymous r in
     let decl = LocalAssum (anon, hnf_prod_applist env ty lrecparams) in
     push_rel decl env in
-  let ra_env' = Nesting (Rtree.mk_rec_calls 1).(0) :: List.map lift_rdecl ra_env in
+  let ra_env' =
+    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')
@@ -244,6 +256,10 @@ let check_positivity_one ~chkpos recursive (env,_,ntypes,_ as ienv) paramsctxt (
                 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)
@@ -294,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 =
@@ -314,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 lift_rdecl 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
@@ -383,7 +404,7 @@ 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.map (fun t -> Toplevel t) (Rtree.mk_rec_calls ntypes) in
   let ra_env_ar = Array.rev_to_list rc in

From cf049ec9e193d915a98ea7f0d18b47b283d455a0 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Wed, 11 Feb 2026 16:37:55 +0100
Subject: [PATCH 115/578] Stop doing intern/extern roundtrip in beautify

This is probably buggy and anyway questionable behaviour.
---
 printing/ppconstr.ml | 9 +--------
 1 file changed, 1 insertion(+), 8 deletions(-)

diff --git a/printing/ppconstr.ml b/printing/ppconstr.ml
index cccb54a7323a..1648e6008248 100644
--- a/printing/ppconstr.ml
+++ b/printing/ppconstr.ml
@@ -832,15 +832,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

From d44ca472b08bd6215c7f9d6751a5723bbb54a220 Mon Sep 17 00:00:00 2001
From: Jim Fehrle <jim.fehrle@gmail.com>
Date: Wed, 11 Feb 2026 09:19:19 -0800
Subject: [PATCH 116/578] Improve wording

---
 doc/sphinx/proof-engine/ssreflect-proof-language.rst | 7 +++----
 1 file changed, 3 insertions(+), 4 deletions(-)

diff --git a/doc/sphinx/proof-engine/ssreflect-proof-language.rst b/doc/sphinx/proof-engine/ssreflect-proof-language.rst
index ea8e2146dfc6..f947b7a21f29 100644
--- a/doc/sphinx/proof-engine/ssreflect-proof-language.rst
+++ b/doc/sphinx/proof-engine/ssreflect-proof-language.rst
@@ -1045,10 +1045,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 into 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

From 40be85879c8786cea9e4cf6456d17a33af5c33d8 Mon Sep 17 00:00:00 2001
From: Mathis Bouverot-Dupuis <mathis.bouverot@ens.psl.eu>
Date: Wed, 11 Feb 2026 19:44:41 +0100
Subject: [PATCH 117/578] fix bug in Procq.parse_string

---
 parsing/procq.ml | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/parsing/procq.ml b/parsing/procq.ml
index 65fc19459ccd..1af149145240 100644
--- a/parsing/procq.ml
+++ b/parsing/procq.ml
@@ -274,7 +274,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 =

From 8260958dee165726f7b7151ff594920307b068f7 Mon Sep 17 00:00:00 2001
From: nicolas tabareau <nicolas.tabareau@gmail.com>
Date: Thu, 12 Feb 2026 09:06:25 +0100
Subject: [PATCH 118/578] fix missing sort elim logic on find_positions

---
 tactics/equality.ml         | 30 ++++++++++++++++++------------
 test-suite/bugs/bug_21614.v | 23 +++++++++++++++++++++++
 2 files changed, 41 insertions(+), 12 deletions(-)
 create mode 100644 test-suite/bugs/bug_21614.v

diff --git a/tactics/equality.ml b/tactics/equality.ml
index b1dc3dbf2c26..335d7236187e 100644
--- a/tactics/equality.ml
+++ b/tactics/equality.ml
@@ -886,7 +886,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
@@ -896,14 +896,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)
+        not (UnivGen.QualityOrSet.equal s UnivGen.QualityOrSet.sprop) &&
+        allowed_elim
     in
     if keep then [(List.rev posn,t1,t2)] else []
   in
@@ -911,36 +912,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 = UnivGen.QualityOrSet.quality @@ 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)))
@@ -956,10 +960,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 = UnivGen.QualityOrSet.quality @@ get_sort_quality_of env sigma ty1 in
+    Inr (findrec [] s t1 t2)
   with DiscrFound (path, d) ->
     Inl (path, d)
 
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.

From f9332c16c3c43dd5a3f549e131e1dccc79783d1e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Fri, 13 Feb 2026 13:25:39 +0100
Subject: [PATCH 119/578] Cleanup old comments in evd.mli

---
 engine/evd.mli | 8 ++------
 1 file changed, 2 insertions(+), 6 deletions(-)

diff --git a/engine/evd.mli b/engine/evd.mli
index 30fd89e717d0..3356886d37e6 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. *)
@@ -490,10 +489,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. *)

From dc9c5eec6e4d5f57c1b15a6345e821fcd6c16855 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Fri, 13 Feb 2026 13:29:45 +0100
Subject: [PATCH 120/578] Only expose 1 state monad API in evd

The convention is to return evar map on the left, there is no reason
to expose a state monad where it's returned on the right.
---
 engine/evd.ml             | 22 +---------------------
 engine/evd.mli            |  3 +--
 plugins/ltac/tacinterp.ml |  4 ++--
 tactics/redexpr.ml        |  2 +-
 4 files changed, 5 insertions(+), 26 deletions(-)

diff --git a/engine/evd.ml b/engine/evd.ml
index d9858fc56870..f450164dac4a 100644
--- a/engine/evd.ml
+++ b/engine/evd.ml
@@ -1472,7 +1472,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
@@ -1492,26 +1492,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..157a2e809600 100644
--- a/engine/evd.mli
+++ b/engine/evd.mli
@@ -503,8 +503,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
diff --git a/plugins/ltac/tacinterp.ml b/plugins/ltac/tacinterp.ml
index 1e732d30f452..ceb51dc10200 100644
--- a/plugins/ltac/tacinterp.ml
+++ b/plugins/ltac/tacinterp.ml
@@ -1740,7 +1740,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)
@@ -1756,7 +1756,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)
diff --git a/tactics/redexpr.ml b/tactics/redexpr.ml
index 67a7b8ebe07e..47cbc3dc16e3 100644
--- a/tactics/redexpr.ml
+++ b/tactics/redexpr.ml
@@ -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

From 20bf183d881bfb21a29c619f026859aceed7801b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Thu, 5 Feb 2026 14:19:38 +0100
Subject: [PATCH 121/578] coqpp remove unused INTERPRETED ( ident ) BY syntax

---
 coqpp/coqpp_ast.mli   | 2 +-
 coqpp/coqpp_main.ml   | 4 +---
 coqpp/coqpp_parse.mly | 7 +------
 3 files changed, 3 insertions(+), 10 deletions(-)

diff --git a/coqpp/coqpp_ast.mli b/coqpp/coqpp_ast.mli
index f1f566806083..471d2d9f28e2 100644
--- a/coqpp/coqpp_ast.mli
+++ b/coqpp/coqpp_ast.mli
@@ -140,7 +140,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_main.ml b/coqpp/coqpp_main.ml
index fac5e0486313..31868f245f54 100644
--- a/coqpp/coqpp_main.ml
+++ b/coqpp/coqpp_main.ml
@@ -681,10 +681,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 2ccb4f8b9a1f..5b8bd248c99e 100644
--- a/coqpp/coqpp_parse.mly
+++ b/coqpp/coqpp_parse.mly
@@ -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:

From b63c2a70479b1b6eb4d2b89e96014bc56f7f5778 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Fri, 13 Feb 2026 16:53:57 +0100
Subject: [PATCH 122/578] Add various tests for commutative cuts in fixpoint
 guard.

A bunch of guard condition code is not tested in the test-suite, this
file adds a little bit more coverage.
---
 test-suite/success/subterm.v | 49 ++++++++++++++++++++++++++++++++++++
 1 file changed, 49 insertions(+)
 create mode 100644 test-suite/success/subterm.v

diff --git a/test-suite/success/subterm.v b/test-suite/success/subterm.v
new file mode 100644
index 000000000000..769f9b44510e
--- /dev/null
+++ b/test-suite/success/subterm.v
@@ -0,0 +1,49 @@
+(** This file tests a few tricky successful cases of commutative
+    cuts in the guard condition. *)
+
+Module MutualCut.
+
+Inductive T (A : unit) := node (x : T A) with U (A : unit) := .
+
+Axiom e : tt = tt.
+
+(** Commutative cut returning a non-trivial mutual. *)
+Fixpoint F (x : T tt) : False :=
+  match x with
+  | node _ x =>
+    F match e in _ = t return T t with eq_refl => x end
+  end.
+
+End MutualCut.
+
+Module NestedCut.
+
+Set Warnings "-register-all".
+
+Inductive T := node : prod (list T) (list T) -> T.
+
+Axiom e : T = T.
+
+(** This succeeds because the size of the second projection is unchanged by the cast *)
+Fixpoint F (t : T) : unit := match t with
+| node p =>
+  let p := match e in _ = X return prod (list X) (list T) with eq_refl => p end in
+  let l := snd p in
+  match l with
+  | nil => tt
+  | cons x _ => F x
+  end
+end.
+
+(** This fails because the size of the first projection is destroyed by the cast *)
+Fail Fixpoint G (t : T) : unit := match t with
+| node p =>
+  let p := match e in _ = X return prod (list X) (list T) with eq_refl => p end in
+  let l := fst p in
+  match l with
+  | nil => tt
+  | cons x _ => G x
+  end
+end.
+
+End NestedCut.

From 147cb1a1b9cffb5d8a67904af7613772aeaa1e07 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Fri, 13 Feb 2026 17:14:47 +0100
Subject: [PATCH 123/578] Move Geninterp.interp_sign to ltac plugin

---
 dev/top_printers.ml                   |  2 +-
 dev/top_printers.mli                  |  2 +-
 plugins/ltac/g_rewrite.mlg            |  3 +--
 plugins/ltac/g_rewrite.mli            |  2 +-
 plugins/ltac/internals.mli            |  4 ++--
 plugins/ltac/tacentries.ml            | 12 ++++++------
 plugins/ltac/tacentries.mli           | 14 +++++++-------
 plugins/ltac/tacenv.ml                |  7 ++++++-
 plugins/ltac/tacenv.mli               |  7 ++++++-
 plugins/ltac/tacinterp.ml             | 18 +++++++++---------
 plugins/ltac/tacinterp.mli            | 18 +++++++++---------
 plugins/ltac2_ltac1/tac2core_ltac1.ml |  4 ++--
 plugins/ssr/ssrast.mli                |  2 +-
 plugins/ssr/ssrcommon.ml              |  2 +-
 plugins/ssr/ssrcommon.mli             |  2 +-
 plugins/ssr/ssrview.ml                |  4 ++--
 plugins/ssrmatching/ssrmatching.ml    |  4 ++--
 plugins/ssrmatching/ssrmatching.mli   | 13 +++++++------
 pretyping/geninterp.ml                |  8 --------
 pretyping/geninterp.mli               |  6 ------
 20 files changed, 65 insertions(+), 69 deletions(-)

diff --git a/dev/top_printers.ml b/dev/top_printers.ml
index ce63fd9e216a..5109e6c10e75 100644
--- a/dev/top_printers.ml
+++ b/dev/top_printers.ml
@@ -653,7 +653,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..1c11f4707460 100644
--- a/dev/top_printers.mli
+++ b/dev/top_printers.mli
@@ -203,7 +203,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/plugins/ltac/g_rewrite.mlg b/plugins/ltac/g_rewrite.mlg
index a5e3b81a98ac..c7623f058873 100644
--- a/plugins/ltac/g_rewrite.mlg
+++ b/plugins/ltac/g_rewrite.mlg
@@ -17,7 +17,6 @@ open Locus
 open Constrexpr
 open Glob_term
 open Genintern
-open Geninterp
 open Extraargs
 open Rewrite
 open RewriteStratAst
@@ -38,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)))
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.mli b/plugins/ltac/internals.mli
index 0c33c7e3a89f..4bd96aba258f 100644
--- a/plugins/ltac/internals.mli
+++ b/plugins/ltac/internals.mli
@@ -31,7 +31,7 @@ val with_delayed_uconstr : Tacinterp.interp_sign ->
 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 ->
+val replace_term : Tacinterp.interp_sign -> bool option -> closed_glob_constr ->
   Locus.clause -> unit tactic
 
 val discrHyp : Names.Id.t -> unit tactic
@@ -59,7 +59,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} *)
 
diff --git a/plugins/ltac/tacentries.ml b/plugins/ltac/tacentries.ml
index 22a0a60f41e8..f3d229a3cc1b 100644
--- a/plugins/ltac/tacentries.ml
+++ b/plugins/ltac/tacentries.ml
@@ -635,7 +635,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 +662,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 +680,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 +707,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
@@ -837,7 +837,7 @@ let in_tacval =
   (* No need to register a value tag for it via register_val0 since we will
      never access this genarg directly. *)
   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
@@ -882,7 +882,7 @@ type ('b, 'c) argument_interp =
 | ArgInterpFun : ('b, Val.t) Tacinterp.Register.interp_fun -> ('b, 'c) argument_interp
 | ArgInterpWit : ('a, 'b, 'r) 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/tacentries.mli b/plugins/ltac/tacentries.mli
index b09e49f5fc3e..bdc365f043bb 100644
--- a/plugins/ltac/tacentries.mli
+++ b/plugins/ltac/tacentries.mli
@@ -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,14 +88,14 @@ 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
 
@@ -106,8 +106,8 @@ val tactic_extend : string -> string -> level:Int.t ->
 
 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 +155,10 @@ type 'b argument_subst =
 
 type ('b, 'c) argument_interp =
 | ArgInterpRet : ('c, 'c) argument_interp
-| ArgInterpFun : ('b, Geninterp.Val.t) Tacinterp.Register.interp_fun -> ('b, 'c) argument_interp
+| ArgInterpFun : ('b, Tacinterp.Value.t) Tacinterp.Register.interp_fun -> ('b, 'c) argument_interp
 | ArgInterpWit : ('a, 'b, 'r) 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..2270b8f162c2 100644
--- a/plugins/ltac/tacenv.ml
+++ b/plugins/ltac/tacenv.ml
@@ -59,8 +59,13 @@ let check_alias key = KerName.Map.mem key !alias_map
 
 (** ML tactic extensions (TacML) *)
 
+type interp_sign =
+  { lfun : Geninterp.Val.t Id.Map.t
+  ; poly : PolyFlags.t
+  ; extra : Geninterp.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
diff --git a/plugins/ltac/tacenv.mli b/plugins/ltac/tacenv.mli
index 6a5111f6905f..3717f4898f33 100644
--- a/plugins/ltac/tacenv.mli
+++ b/plugins/ltac/tacenv.mli
@@ -84,8 +84,13 @@ val ltac_entries : unit -> ltac_entry KerName.Map.t
 
 (** {5 ML tactic extensions} *)
 
+type interp_sign =
+  { lfun : Geninterp.Val.t Id.Map.t
+  ; poly : PolyFlags.t
+  ; extra : Geninterp.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
diff --git a/plugins/ltac/tacinterp.ml b/plugins/ltac/tacinterp.ml
index ceb51dc10200..66225a51cdaa 100644
--- a/plugins/ltac/tacinterp.ml
+++ b/plugins/ltac/tacinterp.ml
@@ -40,9 +40,15 @@ open Proofview.Notations
 open Context.Named.Declaration
 open Ltac_pretype
 
+(* 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 : Geninterp.TacStore.t }
+
 module Register =
 struct
-type ('glb, 'top) interp_fun = Geninterp.interp_sign -> 'glb -> 'top Ftactic.t
+type ('glb, 'top) interp_fun = interp_sign -> 'glb -> 'top Ftactic.t
 
 module InterpObj =
 struct
@@ -164,12 +170,6 @@ 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
@@ -647,7 +647,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
@@ -1085,7 +1085,7 @@ 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
diff --git a/plugins/ltac/tacinterp.mli b/plugins/ltac/tacinterp.mli
index a497e81c01f2..1636f6049c06 100644
--- a/plugins/ltac/tacinterp.mli
+++ b/plugins/ltac/tacinterp.mli
@@ -18,6 +18,12 @@ open Tactypes
 
 val ltac_trace_info : ltac_stack Exninfo.t
 
+(** 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 : Geninterp.TacStore.t }
+
 module Value :
 sig
   type t = Geninterp.Val.t
@@ -26,7 +32,7 @@ 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 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
@@ -39,12 +45,6 @@ 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
@@ -64,7 +64,7 @@ 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 *)
 
@@ -149,7 +149,7 @@ 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 :
diff --git a/plugins/ltac2_ltac1/tac2core_ltac1.ml b/plugins/ltac2_ltac1/tac2core_ltac1.ml
index f790edc12ad8..f0b711f53816 100644
--- a/plugins/ltac2_ltac1/tac2core_ltac1.ml
+++ b/plugins/ltac2_ltac1/tac2core_ltac1.ml
@@ -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
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/ssrcommon.ml b/plugins/ssr/ssrcommon.ml
index f84eeaab288e..1efa4dd45475 100644
--- a/plugins/ssr/ssrcommon.ml
+++ b/plugins/ssr/ssrcommon.ml
@@ -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 }
diff --git a/plugins/ssr/ssrcommon.mli b/plugins/ssr/ssrcommon.mli
index 8274657acbee..979ae0985678 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
diff --git a/plugins/ssr/ssrview.ml b/plugins/ssr/ssrview.ml
index 909b92493abb..7dbf4f3ef8cf 100644
--- a/plugins/ssr/ssrview.ml
+++ b/plugins/ssr/ssrview.ml
@@ -186,8 +186,8 @@ end)
 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/ssrmatching.ml b/plugins/ssrmatching/ssrmatching.ml
index 72a6b52b21a1..f5b5763c2483 100644
--- a/plugins/ssrmatching/ssrmatching.ml
+++ b/plugins/ssrmatching/ssrmatching.ml
@@ -1004,7 +1004,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
@@ -1497,7 +1497,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 })}
 
diff --git a/plugins/ssrmatching/ssrmatching.mli b/plugins/ssrmatching/ssrmatching.mli
index 447b3ed93b42..eab4ec3ce789 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
@@ -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/pretyping/geninterp.ml b/pretyping/geninterp.ml
index f3aa111d6f15..5112be129a04 100644
--- a/pretyping/geninterp.ml
+++ b/pretyping/geninterp.ml
@@ -8,7 +8,6 @@
 (*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
-open Names
 open Genarg
 
 module TacStore = Store.Make ()
@@ -79,10 +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 }
diff --git a/pretyping/geninterp.mli b/pretyping/geninterp.mli
index 5fe0f4f92202..0ae50dd4f4d2 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} *)
@@ -61,8 +60,3 @@ val register_val0 : ('raw, 'glb, 'top) genarg_type -> 'top Val.tag option -> uni
 (** {6 Interpretation functions} *)
 
 module TacStore : Store.S
-
-type interp_sign =
-  { lfun : Val.t Id.Map.t
-  ; poly : PolyFlags.t
-  ; extra : TacStore.t }

From 3f9415899fa77788bad9be6f0319f55f65188993 Mon Sep 17 00:00:00 2001
From: Matthieu Sozeau <matthieu.sozeau@inria.fr>
Date: Sat, 14 Feb 2026 09:41:42 +0100
Subject: [PATCH 124/578] Stop zeta-normalizing the proofs in generalized
 rewriting

---
 doc/changelog/04-tactics/21631-stop-zeta-rewrite-Changed.rst | 5 +++++
 tactics/rewrite.ml                                           | 4 ----
 2 files changed, 5 insertions(+), 4 deletions(-)
 create mode 100644 doc/changelog/04-tactics/21631-stop-zeta-rewrite-Changed.rst

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 <https://github.com/rocq-prover/rocq/pull/21631>`_,
+  by Matthieu Sozeau).
diff --git a/tactics/rewrite.ml b/tactics/rewrite.ml
index fb6fc31e90ad..3fbddc077d7b 100644
--- a/tactics/rewrite.ml
+++ b/tactics/rewrite.ml
@@ -1623,9 +1623,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
@@ -1667,7 +1664,6 @@ 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
         let term =
           match abs with
           | None -> p

From bb26f6feedad519a9e6e4c5fb5586c9a6b441c4b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Sun, 15 Feb 2026 18:32:49 +0100
Subject: [PATCH 125/578] Fix should_invert_case calls in VM/native reification

Fix #21633
---
 pretyping/nativenorm.ml     | 2 +-
 pretyping/vnorm.ml          | 2 +-
 test-suite/bugs/bug_21633.v | 4 ++++
 3 files changed, 6 insertions(+), 2 deletions(-)
 create mode 100644 test-suite/bugs/bug_21633.v

diff --git a/pretyping/nativenorm.ml b/pretyping/nativenorm.ml
index c0701bf61d16..4c3a89f06e46 100644
--- a/pretyping/nativenorm.ml
+++ b/pretyping/nativenorm.ml
@@ -342,7 +342,7 @@ and nf_atom_type env sigma atom =
       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 iv = if Inductiveops.Internal.should_invert_case env sigma relevance ci then
           CaseInvert {indices=realargs}
         else NoInvert
       in
diff --git a/pretyping/vnorm.ml b/pretyping/vnorm.ml
index 4899028760d4..4cb34121a33e 100644
--- a/pretyping/vnorm.ml
+++ b/pretyping/vnorm.ml
@@ -306,7 +306,7 @@ and nf_stk ?from:(from=0) env sigma c t stk  =
       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 iv = if Inductiveops.Internal.should_invert_case env sigma relevance ci then
           CaseInvert {indices=realargs}
         else NoInvert
       in
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).

From 16b6893cd4d25ce50e68a050b00e97f3de3f6275 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Fri, 13 Feb 2026 14:04:49 +0100
Subject: [PATCH 126/578] Remove -load-vernac-source-verbose and -verbose
 command line flags

They would print the input file to stdout as it compiled.

This was probably used by people calling coqtop directly in the
terminal and is useless now.

`-verbose` has been a noop for a while BTW.
---
 boot/usage.ml                                 |  2 --
 .../21626-noverbose-Removed.rst               |  7 ++++++
 doc/sphinx/practical-tools/coq-commands.rst   |  5 -----
 sysinit/coqargs.ml                            | 11 ++++------
 sysinit/coqargs.mli                           |  2 +-
 toplevel/ccompile.ml                          | 16 +++++++-------
 toplevel/coqcargs.ml                          | 22 +++++--------------
 toplevel/coqcargs.mli                         |  4 +---
 toplevel/coqrc.ml                             |  4 ++--
 toplevel/load.ml                              |  4 ++--
 toplevel/vernac.ml                            | 22 ++++---------------
 toplevel/vernac.mli                           |  7 +++---
 12 files changed, 38 insertions(+), 68 deletions(-)
 create mode 100644 doc/changelog/08-vernac-commands-and-options/21626-noverbose-Removed.rst

diff --git a/boot/usage.ml b/boot/usage.ml
index c3f16ec9365e..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\
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 <https://github.com/rocq-prover/rocq/pull/21626>`_,
+  by Gaëtan Gilbert).
diff --git a/doc/sphinx/practical-tools/coq-commands.rst b/doc/sphinx/practical-tools/coq-commands.rst
index 6c701652c355..4f3171d2c1be 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`.
diff --git a/sysinit/coqargs.ml b/sysinit/coqargs.ml
index e5126f8cd871..97bc7a82432f 100644
--- a/sysinit/coqargs.ml
+++ b/sysinit/coqargs.ml
@@ -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;
 }
 
@@ -173,8 +173,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 }}
@@ -301,10 +301,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
diff --git a/sysinit/coqargs.mli b/sysinit/coqargs.mli
index 908524ebf584..5a89b4b9da74 100644
--- a/sysinit/coqargs.mli
+++ b/sysinit/coqargs.mli
@@ -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/toplevel/ccompile.ml b/toplevel/ccompile.ml
index e43350778157..71610cea098b 100644
--- a/toplevel/ccompile.ml
+++ b/toplevel/ccompile.ml
@@ -22,7 +22,7 @@ let source ldir file = Loc.InFile {
   }
 
 (* 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
@@ -59,7 +59,7 @@ 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 ~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
@@ -84,25 +84,25 @@ 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 ~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
+      (fun f_in -> compile opts stm_opts copts injections ~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..d53caec8c4e4 100644
--- a/toplevel/coqcargs.ml
+++ b/toplevel/coqcargs.ml
@@ -17,11 +17,9 @@ 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
-
   ; glob_out    : glob_output option
 
   ; output_context : bool
@@ -33,8 +31,6 @@ let default =
   ; compile_file = None
   ; compilation_output_name = None
 
-  ; echo = false
-
   ; glob_out = None
 
   ; output_context = false
@@ -58,29 +54,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 +100,6 @@ let parse arglist : t =
         (* Non deprecated options *)
         | "-output-context" ->
           { oval with output_context = true }
-        (* Verbose == echo mode *)
-        | "-verbose" ->
-          echo := true;
-          oval
         (* Output filename *)
         | "-o" ->
           { oval with compilation_output_name = Some (next ()) }
diff --git a/toplevel/coqcargs.mli b/toplevel/coqcargs.mli
index 0f4d83a26e33..d71797df48b7 100644
--- a/toplevel/coqcargs.mli
+++ b/toplevel/coqcargs.mli
@@ -29,11 +29,9 @@ 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
-
   ; glob_out    : glob_output option
 
   ; output_context : bool
diff --git a/toplevel/coqrc.ml b/toplevel/coqrc.ml
index bbce570e702d..3db729d41260 100644
--- a/toplevel/coqrc.ml
+++ b/toplevel/coqrc.ml
@@ -21,7 +21,7 @@ let load_rcfile ~rcfile ~state =
       match rcfile with
       | Some rcfile ->
         if CUnix.file_readable_p rcfile then
-          Vernac.load_vernac ~echo:false ~check:true ~state rcfile
+          Vernac.load_vernac ~check:true ~state rcfile
         else raise (Sys_error ("Cannot read rcfile: "^ rcfile))
       | None ->
         try
@@ -32,7 +32,7 @@ let load_rcfile ~rcfile ~state =
             Envars.home ~warn / "."^rcdefaultname^"."^Coq_config.version;
             Envars.home ~warn / "."^rcdefaultname
           ] in
-          Vernac.load_vernac ~echo:false ~check:true ~state inferedrc
+          Vernac.load_vernac ~check:true ~state inferedrc
         with Not_found -> state
         (*
         Flags.if_verbose
diff --git a/toplevel/load.ml b/toplevel/load.ml
index 4ad0d433d79d..7c0b864ae69a 100644
--- a/toplevel/load.ml
+++ b/toplevel/load.ml
@@ -26,10 +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
+      let load_vernac f = Vernac.load_vernac ~check:true ~state f in
       if !Flags.beautify
       then Flags.with_option Flags.beautify_file load_vernac f_in
       else load_vernac s
diff --git a/toplevel/vernac.ml b/toplevel/vernac.ml
index 392a667170da..2b6acac19535 100644
--- a/toplevel/vernac.ml
+++ b/toplevel/vernac.ml
@@ -24,16 +24,6 @@ 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
-
-
 type time_output =
   | ToFeedback
   | ToChannel of Format.formatter
@@ -94,11 +84,10 @@ 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 ~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)
@@ -118,9 +107,6 @@ let load_vernac_core ~echo ~check ~state ?source file =
       input_cleanup ();
       state, ids, Procq.Parsable.comments in_pa
     | Some ast ->
-      (* Printing of AST for -compile-verbose *)
-      Option.iter (vernac_echo ?loc:ast.CAst.loc) in_echo;
-
       checknav ast;
 
       let state =
@@ -223,8 +209,8 @@ let beautify_pass ~doc ~comments ~ids ~filename =
 
 (* 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
+let load_vernac ~check ~state ?source filename =
+  let ostate, ids, comments = load_vernac_core ~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 *)
diff --git a/toplevel/vernac.mli b/toplevel/vernac.mli
index b6ea3901b12c..b40e3d31dc19 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 : check:bool ->
   state:State.t -> ?source:Loc.source -> string -> State.t

From 46660743ffa04e43be85c5f811fa0600f5704cfd Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Fri, 13 Feb 2026 17:37:14 +0100
Subject: [PATCH 127/578] More clever fast path for commutative cut fixpoint
 guard condition.

Inductive indices (and non-uniform parameters) are irrelevant for
the associated recursive tree. Thus, when casting a tree across a
commutative cut for subterm computation, they can be safely ignored.
One must only check for the presence of variables introduced by the
return clause in the parameters of the inductive type being
transtyped.

This optimization makes the guardedness check from #21105 go from
around ~20 seconds to less than a second on my machine.
---
 kernel/inductive.ml | 88 ++++++++++++++++++++++++++-------------------
 1 file changed, 51 insertions(+), 37 deletions(-)

diff --git a/kernel/inductive.ml b/kernel/inductive.ml
index f4cf7164ade8..4ea5d885afcd 100644
--- a/kernel/inductive.ml
+++ b/kernel/inductive.ml
@@ -1021,6 +1021,16 @@ let get_recargs_approx cache ?evars env tree ind args =
   assigned Norec *)
   build_recargs_nested (env,[]) tree (ind, args)
 
+(* 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 + k) 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 =
@@ -1028,63 +1038,67 @@ let restrict_spec cache ?evars env spec p =
   | Not_subterm | Internally_bound_subterm _ -> 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
+    if has_constant_parameters env absctxlen (List.length arctx) i args then spec
+    else 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
 
 (* [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 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 cache ?evars elt in
+          if has_constant_parameters env absctxlen (k + List.length ctx) ind args then SArg spec
+          else
+            let sarg = lazy begin 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)
+            end in
+            SArg sarg
+        | _ -> SArg (set_iota_specif (lazy 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 []
+        elt :: filter_stack (push_rel d env) (k + 1) c0 stack'
+      | _ -> List.fold_right (fun _ l -> SArg (set_iota_specif (lazy Not_subterm)) :: l) 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

From 8135246787cc423fa4c257c7e94eb5a63a4cebaa Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Mon, 16 Feb 2026 13:59:50 +0100
Subject: [PATCH 128/578] Minor clean ups in Inductive.

---
 kernel/inductive.ml | 22 +++++++++++-----------
 1 file changed, 11 insertions(+), 11 deletions(-)

diff --git a/kernel/inductive.ml b/kernel/inductive.ml
index 4ea5d885afcd..6e6d19f62a83 100644
--- a/kernel/inductive.ml
+++ b/kernel/inductive.ml
@@ -960,9 +960,8 @@ let get_recargs_approx cache ?evars env tree ind args =
     if is_norec_path tree then tree
     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 *)
@@ -978,7 +977,7 @@ let get_recargs_approx cache ?evars env tree ind args =
     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
@@ -1054,8 +1053,8 @@ let restrict_spec cache ?evars env spec p =
     | 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)
+      let tree = inter_wf_paths tree recargs in
+      Subterm (l, st, tree)
     | _ -> assert false
     end
   | _ -> Not_subterm
@@ -1087,16 +1086,17 @@ let filter_stack_domain cache stack_element_specif set_iota_specif ?evars env p
           else
             let sarg = lazy begin 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)
+            | Subterm (l, s, tree) ->
+              let recargs = get_recargs_approx cache ?evars env tree ind args in
+              let tree = inter_wf_paths tree recargs in
+              Subterm (l, s, tree)
             end in
             SArg sarg
         | _ -> SArg (set_iota_specif (lazy Not_subterm))
         in
         elt :: filter_stack (push_rel d env) (k + 1) c0 stack'
-      | _ -> List.fold_right (fun _ l -> SArg (set_iota_specif (lazy Not_subterm)) :: l) stack []
+      | _ ->
+        List.map (fun _ -> SArg (set_iota_specif (lazy Not_subterm))) stack
   in
   filter_stack env 0 ar stack
 

From 4edbaca30ef3d177e6502be90725a5b29e9f6dbd Mon Sep 17 00:00:00 2001
From: Yann Leray <yann.leray@inria.fr>
Date: Mon, 16 Feb 2026 15:06:49 +0100
Subject: [PATCH 129/578] Stop accepting non-closed recursive trees

---
 kernel/inductive.ml | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/kernel/inductive.ml b/kernel/inductive.ml
index f4cf7164ade8..5c56f08dcb86 100644
--- a/kernel/inductive.ml
+++ b/kernel/inductive.ml
@@ -673,7 +673,8 @@ type subterm_spec =
 let is_norec_path t = match Rtree.dest_head 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
 

From df57f219ae04973f930bb5508a3de7f30d36b7dd Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Fri, 13 Feb 2026 17:16:24 +0100
Subject: [PATCH 130/578] Move Geninterp.TacStore to ltac plugin

---
 dev/ci/user-overlays/21630-SkySkimmer-geninterp-ltac.sh | 7 +++++++
 plugins/ltac/tacenv.ml                                  | 4 +++-
 plugins/ltac/tacenv.mli                                 | 4 +++-
 plugins/ltac/tacinterp.ml                               | 6 +++---
 plugins/ltac/tacinterp.mli                              | 8 +++-----
 pretyping/geninterp.ml                                  | 2 --
 pretyping/geninterp.mli                                 | 4 ----
 7 files changed, 19 insertions(+), 16 deletions(-)
 create mode 100644 dev/ci/user-overlays/21630-SkySkimmer-geninterp-ltac.sh

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/plugins/ltac/tacenv.ml b/plugins/ltac/tacenv.ml
index 2270b8f162c2..8a545c314a81 100644
--- a/plugins/ltac/tacenv.ml
+++ b/plugins/ltac/tacenv.ml
@@ -59,10 +59,12 @@ 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 : Geninterp.TacStore.t }
+  ; extra : TacStore.t }
 
 type ml_tactic =
   Geninterp.Val.t list -> interp_sign -> unit Proofview.tactic
diff --git a/plugins/ltac/tacenv.mli b/plugins/ltac/tacenv.mli
index 3717f4898f33..660fd865c0f4 100644
--- a/plugins/ltac/tacenv.mli
+++ b/plugins/ltac/tacenv.mli
@@ -84,10 +84,12 @@ 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 : Geninterp.TacStore.t }
+  ; extra : TacStore.t }
 
 type ml_tactic =
   Val.t list -> interp_sign -> unit Proofview.tactic
diff --git a/plugins/ltac/tacinterp.ml b/plugins/ltac/tacinterp.ml
index 66225a51cdaa..5f31c0083f3b 100644
--- a/plugins/ltac/tacinterp.ml
+++ b/plugins/ltac/tacinterp.ml
@@ -40,11 +40,13 @@ open Proofview.Notations
 open Context.Named.Declaration
 open Ltac_pretype
 
+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 : Geninterp.TacStore.t }
+  ; extra : TacStore.t }
 
 module Register =
 struct
@@ -162,8 +164,6 @@ let name_vfun appl vle =
     of_tacvalue (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"
diff --git a/plugins/ltac/tacinterp.mli b/plugins/ltac/tacinterp.mli
index 1636f6049c06..57c0353fb244 100644
--- a/plugins/ltac/tacinterp.mli
+++ b/plugins/ltac/tacinterp.mli
@@ -18,11 +18,13 @@ 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 : Geninterp.TacStore.t }
+  ; extra : TacStore.t }
 
 module Value :
 sig
@@ -41,10 +43,6 @@ 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
-
 open Genintern
 
 val f_avoid_ids : Id.Set.t TacStore.field
diff --git a/pretyping/geninterp.ml b/pretyping/geninterp.ml
index 5112be129a04..f756c1602024 100644
--- a/pretyping/geninterp.ml
+++ b/pretyping/geninterp.ml
@@ -10,8 +10,6 @@
 
 open Genarg
 
-module TacStore = Store.Make ()
-
 (** Dynamic toplevel values *)
 
 module ValT = Dyn.Make ()
diff --git a/pretyping/geninterp.mli b/pretyping/geninterp.mli
index 0ae50dd4f4d2..d4ba8c275d40 100644
--- a/pretyping/geninterp.mli
+++ b/pretyping/geninterp.mli
@@ -56,7 +56,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

From 258e98651f44f6d3f227e70f2bcb81f8d4642ba2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Fri, 13 Feb 2026 15:23:58 +0100
Subject: [PATCH 131/578] Align Evd and UState API names

eg Evd.new_quality_variable was equivalent to
UState.new_sort_variable, and Evd.new_sort_variable combined
new_quality and new_univ (fixed by renaming the UState API to match
Evd)

also renamed Evd.merge_universe_context -> merge_ustate for clarity
---
 engine/evd.ml                      | 25 ++++++++++++-------------
 engine/evd.mli                     |  6 ++++--
 engine/uState.ml                   | 12 ++++++------
 engine/uState.mli                  |  8 ++++----
 plugins/ssr/ssrbwd.ml              |  2 +-
 plugins/ssr/ssrcommon.ml           | 12 ++++++------
 plugins/ssr/ssrelim.ml             | 10 +++++-----
 plugins/ssr/ssrequality.ml         |  6 +++---
 plugins/ssr/ssrfwd.ml              |  2 +-
 plugins/ssr/ssripats.ml            |  2 +-
 plugins/ssrmatching/ssrmatching.ml |  2 +-
 proofs/subproof.ml                 |  2 +-
 stm/partac.ml                      |  2 +-
 tactics/eqschemes.ml               |  2 +-
 vernac/auto_ind_decl.ml            |  8 ++++----
 vernac/declare.ml                  |  2 +-
 16 files changed, 52 insertions(+), 51 deletions(-)

diff --git a/engine/evd.ml b/engine/evd.ml
index d9858fc56870..2250fed460ef 100644
--- a/engine/evd.ml
+++ b/engine/evd.ml
@@ -904,9 +904,11 @@ 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 merge_universe_context = merge_ustate
+
 let set_universe_context evd uctx' =
   { evd with universes = uctx' }
 
@@ -1007,8 +1009,6 @@ 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
@@ -1042,35 +1042,34 @@ 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.qsort q u
 
 let add_forgotten_univ d u =
   { d with universes = UState.add_forgotten_univ d.universes u }
diff --git a/engine/evd.mli b/engine/evd.mli
index 3356886d37e6..a7021c605fa6 100644
--- a/engine/evd.mli
+++ b/engine/evd.mli
@@ -607,7 +607,6 @@ 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 universe_context_set : evar_map -> Univ.ContextSet.t
 val sort_context_set : evar_map -> UnivGen.sort_context_set
@@ -626,9 +625,12 @@ 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 merge_universe_context : evar_map -> UState.t -> evar_map
+val merge_ustate : evar_map -> UState.t -> evar_map
 val set_universe_context : evar_map -> UState.t -> evar_map
 
+val merge_universe_context : evar_map -> UState.t -> evar_map
+[@@deprecated "(9.3) Use [Evd.merge_ustate]"]
+
 val merge_universe_context_set : ?loc:Loc.t -> ?sideff:bool -> rigid -> evar_map -> Univ.ContextSet.t -> evar_map
 
 val merge_sort_context_set : ?loc:Loc.t -> ?sort_rigid:bool -> ?sideff:bool ->
diff --git a/engine/uState.ml b/engine/uState.ml
index 90041147c2d7..c56d20d026ad 100644
--- a/engine/uState.ml
+++ b/engine/uState.ml
@@ -1282,7 +1282,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
@@ -1341,9 +1341,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
@@ -1429,7 +1429,7 @@ 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)
@@ -1441,7 +1441,7 @@ let new_sort_variable ?loc ?(sort_rigid = false) ?name uctx =
   in
   { uctx with sort_variables; names }, 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
@@ -1459,7 +1459,7 @@ 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))
+       fst (new_univ_level_variable ?loc univ_rigid (Some id) uctx))
     uctx binders
 
 let from_env ?(binders=[]) env =
diff --git a/engine/uState.mli b/engine/uState.mli
index 260f000adcaa..8651d8615020 100644
--- a/engine/uState.mli
+++ b/engine/uState.mli
@@ -187,9 +187,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 +213,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
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..ff52355d9d2d 100644
--- a/plugins/ssr/ssrcommon.ml
+++ b/plugins/ssr/ssrcommon.ml
@@ -687,7 +687,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 +761,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
@@ -1049,7 +1049,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 +1062,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 +1131,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 +1140,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
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 341b9c72c855..7938f5549d23 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
@@ -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
@@ -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
 
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/ssripats.ml b/plugins/ssr/ssripats.ml
index 18625ad3a794..20a04f31661a 100644
--- a/plugins/ssr/ssripats.ml
+++ b/plugins/ssr/ssripats.ml
@@ -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/ssrmatching/ssrmatching.ml b/plugins/ssrmatching/ssrmatching.ml
index 72a6b52b21a1..a41cededdf16 100644
--- a/plugins/ssrmatching/ssrmatching.ml
+++ b/plugins/ssrmatching/ssrmatching.ml
@@ -1461,7 +1461,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 *)
diff --git a/proofs/subproof.ml b/proofs/subproof.ml
index a222d17eb756..c128ae9e081b 100644
--- a/proofs/subproof.ml
+++ b/proofs/subproof.ml
@@ -145,7 +145,7 @@ 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
+  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 =
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/tactics/eqschemes.ml b/tactics/eqschemes.ml
index bcfdee3a8557..c6f4a16f08dd 100644
--- a/tactics/eqschemes.ml
+++ b/tactics/eqschemes.ml
@@ -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
diff --git a/vernac/auto_ind_decl.ml b/vernac/auto_ind_decl.ml
index c7e0872dba6d..745ae0fae4db 100644
--- a/vernac/auto_ind_decl.ml
+++ b/vernac/auto_ind_decl.ml
@@ -670,7 +670,7 @@ 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
@@ -1184,7 +1184,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
@@ -1319,7 +1319,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 =
@@ -1515,7 +1515,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
diff --git a/vernac/declare.ml b/vernac/declare.ml
index 0af1f323918a..e9eac6647902 100644
--- a/vernac/declare.ml
+++ b/vernac/declare.ml
@@ -703,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 *)

From 3ae6b493e7bca6f8bf205fda605c38660c14df04 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Thu, 12 Feb 2026 16:55:23 +0100
Subject: [PATCH 132/578] Cleanup beautify handling

- remove Flags.beautify and beautify_file

- `-beautify` is now only supported for compile mode

- beautify printing is done incrementally between parsing and
  executing commands instead of all at once at the end of the file.
  This prevents errors from notations disappearing etc (close #8640).

- cleanup comment handling functions (extract_comments and Pp comment printing)

- stop checking the flag in constrextern (anyway extern should not be
  used in beautify since cf049ec9e1)
---
 doc/sphinx/practical-tools/coq-commands.rst   |  3 +-
 gramlib/grammar.ml                            |  4 +
 gramlib/grammar.mli                           |  1 +
 gramlib/plexing.mli                           |  1 +
 interp/constrextern.ml                        |  2 +-
 lib/flags.ml                                  |  4 -
 lib/flags.mli                                 |  4 -
 lib/pp.ml                                     | 45 +++++-----
 parsing/cLexer.ml                             |  1 +
 printing/ppconstr.ml                          |  2 +-
 printing/pputils.ml                           | 18 ++--
 sysinit/coqargs.ml                            |  3 -
 sysinit/coqargs.mli                           |  1 -
 sysinit/coqinit.ml                            |  6 --
 .../misc/comment-lexing/test.v.beautified     |  2 +
 toplevel/ccompile.ml                          | 12 ++-
 toplevel/coqcargs.ml                          |  5 ++
 toplevel/coqcargs.mli                         |  2 +
 toplevel/load.ml                              |  5 +-
 toplevel/vernac.ml                            | 84 ++++++++++---------
 toplevel/vernac.mli                           |  2 +-
 vernac/ppvernac.ml                            | 18 ++--
 22 files changed, 113 insertions(+), 112 deletions(-)

diff --git a/doc/sphinx/practical-tools/coq-commands.rst b/doc/sphinx/practical-tools/coq-commands.rst
index 4f3171d2c1be..cb787ec90d6f 100644
--- a/doc/sphinx/practical-tools/coq-commands.rst
+++ b/doc/sphinx/practical-tools/coq-commands.rst
@@ -461,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
diff --git a/gramlib/grammar.ml b/gramlib/grammar.ml
index e7fa19780877..b09b167eed2e 100644
--- a/gramlib/grammar.ml
+++ b/gramlib/grammar.ml
@@ -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] *)
 
@@ -1593,6 +1595,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
diff --git a/gramlib/grammar.mli b/gramlib/grammar.mli
index 51d94833c634..532fd02caaae 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
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/interp/constrextern.ml b/interp/constrextern.ml
index a70f24752784..d9a350c9f484 100644
--- a/interp/constrextern.ml
+++ b/interp/constrextern.ml
@@ -490,7 +490,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
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/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/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/printing/ppconstr.ml b/printing/ppconstr.ml
index 0493300eb0fc..e360a6020f0d 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)
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/sysinit/coqargs.ml b/sysinit/coqargs.ml
index 97bc7a82432f..141e6cec5ecf 100644
--- a/sysinit/coqargs.ml
+++ b/sysinit/coqargs.ml
@@ -64,7 +64,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;
@@ -127,7 +126,6 @@ let default_config = {
   native_include_dirs = [];
   output_directory = None;
   exclude_dirs = [];
-  beautify = false;
   quiet = false;
   time = None;
   test_mode = false;
@@ -376,7 +374,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 5a89b4b9da74..fa04c49c55be 100644
--- a/sysinit/coqargs.mli
+++ b/sysinit/coqargs.mli
@@ -59,7 +59,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;
diff --git a/sysinit/coqinit.ml b/sysinit/coqinit.ml
index 963820a1755d..a588d88b1067 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;
diff --git a/test-suite/misc/comment-lexing/test.v.beautified b/test-suite/misc/comment-lexing/test.v.beautified
index 70b4b57ba839..8be6b8805136 100644
--- a/test-suite/misc/comment-lexing/test.v.beautified
+++ b/test-suite/misc/comment-lexing/test.v.beautified
@@ -17,11 +17,13 @@ intro c0.
       et on doit alors prouver [coul_suiv c0 = Vert]
       sous cette hypothèse supplémentaire ;
       lorsque l'on introduit une hypothèse, on lui donne un nom. *)
+
 intro c0rou.
 (* /!\   CRASH ON THIS LINE   /!\ *)
 (** Le raisonnement sous-jacent est :
       soit c0rou une preuve arbitraire (inconnue) de [c0 = Rouge],
       on peut s'en servir pour démontrer coul_suiv [c0 = Vert]. *)
+
 rewrite c0rou.
 cbn[coul_suiv].
 reflexivity.
diff --git a/toplevel/ccompile.ml b/toplevel/ccompile.ml
index 71610cea098b..6e36f71495e5 100644
--- a/toplevel/ccompile.ml
+++ b/toplevel/ccompile.ml
@@ -36,6 +36,8 @@ let compile opts stm_options injections copts ~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 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)
@@ -59,7 +61,7 @@ let compile opts stm_options injections copts ~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 ~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
@@ -84,7 +86,7 @@ let compile opts stm_options injections copts ~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 ~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
@@ -98,11 +100,7 @@ let compile opts stm_opts copts injections ~f_in ~f_out =
 
 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 ~f_in ~f_out) f_in
-  else
-    compile opts stm_opts copts injections ~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 d53caec8c4e4..f0f7c46fb694 100644
--- a/toplevel/coqcargs.ml
+++ b/toplevel/coqcargs.ml
@@ -20,6 +20,8 @@ type t =
   ; compile_file: string option
   ; compilation_output_name : string option
 
+  ; beautify : bool
+
   ; glob_out    : glob_output option
 
   ; output_context : bool
@@ -31,6 +33,8 @@ let default =
   ; compile_file = None
   ; compilation_output_name = None
 
+  ; beautify = false
+
   ; glob_out = None
 
   ; output_context = false
@@ -100,6 +104,7 @@ let parse arglist : t =
         (* Non deprecated options *)
         | "-output-context" ->
           { oval with output_context = true }
+        |"-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 d71797df48b7..21f7f2c27b4e 100644
--- a/toplevel/coqcargs.mli
+++ b/toplevel/coqcargs.mli
@@ -32,6 +32,8 @@ type t =
   ; compile_file: string option  (* bool is verbosity  *)
   ; compilation_output_name : string option
 
+  ; beautify : bool
+
   ; glob_out    : glob_output option
 
   ; output_context : bool
diff --git a/toplevel/load.ml b/toplevel/load.ml
index 7c0b864ae69a..9ebedc8152d7 100644
--- a/toplevel/load.ml
+++ b/toplevel/load.ml
@@ -28,11 +28,8 @@ let load_vernacular opts ~state =
   List.fold_left
     (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 ~check:true ~state f in
-      if !Flags.beautify
-      then Flags.with_option Flags.beautify_file load_vernac f_in
-      else load_vernac s
+      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 2b6acac19535..643e68870401 100644
--- a/toplevel/vernac.ml
+++ b/toplevel/vernac.ml
@@ -24,6 +24,20 @@ 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.")
 
+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
   | ToChannel of Format.formatter
@@ -84,7 +98,7 @@ 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 ~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 input_cleanup () = close_in in_chan in
@@ -94,8 +108,7 @@ let load_vernac_core ~check ~state ?source file =
       (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 () ->
@@ -104,9 +117,18 @@ let load_vernac_core ~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 ->
+      let () = beautify |> Option.iter @@ fun beautify ->
+        vernac_beautify beautify ast (Procq.Parsable.comments in_pa);
+        Procq.Parsable.drop_comments in_pa
+      in
+
       checknav ast;
 
       let state =
@@ -131,9 +153,9 @@ let load_vernac_core ~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 ();
@@ -176,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 ~check ~state ?source filename =
-  let ostate, ids, comments = load_vernac_core ~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 b40e3d31dc19..5f9c56bf782f 100644
--- a/toplevel/vernac.mli
+++ b/toplevel/vernac.mli
@@ -32,5 +32,5 @@ val process_expr : state:State.t -> Vernacexpr.vernac_control -> State.t
 
 (** [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 : check:bool ->
+val load_vernac : ?beautify:bool -> check:bool ->
   state:State.t -> ?source:Loc.source -> string -> State.t
diff --git a/vernac/ppvernac.ml b/vernac/ppvernac.ml
index 37488709e4af..07073ebba031 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"
@@ -535,7 +539,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 +547,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 +564,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 *)
@@ -920,7 +922,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()

From 09ed28c9e04ea1e43966348d1b534f348d1b8849 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Mon, 16 Feb 2026 17:09:47 +0100
Subject: [PATCH 133/578] Slight cleanup in coqrc.ml

---
 toplevel/coqrc.ml | 48 ++++++++++++++++++++++-------------------------
 1 file changed, 22 insertions(+), 26 deletions(-)

diff --git a/toplevel/coqrc.ml b/toplevel/coqrc.ml
index 3db729d41260..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 ~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 ~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

From 3afa9f51a7935ac360f194cf8304b7aed0c9a4ab Mon Sep 17 00:00:00 2001
From: Dario Halilovic <dario.halilovic@epfl.ch>
Date: Mon, 16 Feb 2026 22:04:46 +0100
Subject: [PATCH 134/578] Do not consider removed evars when computing evar
 name conflicts

---
 engine/evarnames.ml | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/engine/evarnames.ml b/engine/evarnames.ml
index 2ebaa2e3535d..cb2820298af4 100644
--- a/engine/evarnames.ml
+++ b/engine/evarnames.ml
@@ -262,6 +262,7 @@ let add_fresh basename ev ?parent evn =
   in
   let qualid = EvarQualid.{ basename; path = path ev evn } in
   let ans = NameResolution.find qualid evn.name_resolution in
+  let ans = Evar.Set.diff ans evn.removed_evars in
   if Evar.Set.is_empty ans then
     (* No need to give the parent since it's already registered *)
     add basename ev evn
@@ -362,6 +363,7 @@ let name_of ev evn =
   | None -> None
   | Some name ->
     let conflicts = NameResolution.find name evn.name_resolution in
+    let conflicts = Evar.Set.diff conflicts evn.removed_evars in
     (* TODO: we should the caller handle the conflict themselves instead of
        generating nonsensical names in linear time. *)
     match classify_set conflicts with
@@ -385,6 +387,7 @@ let has_unambiguous_name ev evn =
   | None -> false
   | Some name ->
     let ans = NameResolution.find name evn.name_resolution in
+    let ans = Evar.Set.diff ans evn.removed_evars in
     match classify_set ans with
     | SetEmpty | SetOther -> false
     | SetSingleton e ->
@@ -393,6 +396,8 @@ let has_unambiguous_name ev evn =
 let resolve fp evn =
   let qualid = EvarQualid.make fp in
   let evs = NameResolution.find qualid evn.name_resolution in
+  (* Do not consider removed evars as conflicts for name resolution *)
+  let evs = Evar.Set.diff evs evn.removed_evars in
   let open Pp in
   match classify_set evs with
   | SetEmpty -> raise Not_found

From 2e97742fdeb4798693099a88a4d7e6b2a2853ac9 Mon Sep 17 00:00:00 2001
From: Dario Halilovic <dario.halilovic@epfl.ch>
Date: Mon, 16 Feb 2026 23:59:46 +0100
Subject: [PATCH 135/578] Add test for bug 21637

---
 test-suite/bugs/bug_21637.v | 13 +++++++++++++
 1 file changed, 13 insertions(+)
 create mode 100644 test-suite/bugs/bug_21637.v

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.

From 5fd904e5d6ffaa836820e41d09a3813186d76451 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Tue, 17 Feb 2026 14:57:09 +0100
Subject: [PATCH 136/578] Stop using Let in float/specs test

It created huge contexts when I wanted to open an interactive proof to
look around.
---
 test-suite/primitive/float/specs.v | 70 +++++++++++++++---------------
 1 file changed, 36 insertions(+), 34 deletions(-)

diff --git a/test-suite/primitive/float/specs.v b/test-suite/primitive/float/specs.v
index 952b73fb717d..c9930780857c 100644
--- a/test-suite/primitive/float/specs.v
+++ b/test-suite/primitive/float/specs.v
@@ -19,7 +19,10 @@ Notation "[ x ; y ; .. ; z ]" :=  (cons x (cons y .. (cons z nil) ..))
 Open Scope list_scope.
 Open Scope float_scope.
 
-Section __WORK_AROUND_COQBUG_4790.
+Module Type T. End T.
+
+(* use empty type to avoid native compiling expanded values  *)
+Module Tests : T.
 (** *************************************************************************)
 (** * Specifying the arguments to test on *)
 (** EDIT HERE TO ADD MORE TESTS *)
@@ -408,24 +411,24 @@ Definition combine_annotations (orig : list ANNOTATED_BARE_SPEC) (result : list
     Reductions like [cbv] and [lazy] and the [vm] are mostly
     indifferent.  So we maintain both [_red] versions for [simpl] and
     [cbn] and non-[_red] versions for [native_compute]. *)
-(** We make [_red] definitions [Let] statements, to work around
+(** We make [_red] definitions [Definition] statements, to work around
     COQBUG(https://github.com/rocq-prover/rocq/issues/4790) and avoid stack
     overflows in COQNATIVE *)
 
 (** * 1. Test the specs *)
 Section TestSpecs.
 
-Time Let specs_red : list ANNOTATED_BARE_SPEC
+Time Definition specs_red : list ANNOTATED_BARE_SPEC
   := Eval cbv [spec_list instantiate_all_ways] in instantiate_all_ways spec_list. (* 0.911 secs *)
 
-Let bare_specs_red : list BARE_SPEC
+Definition bare_specs_red : list BARE_SPEC
   := Eval cbv [map_fst specs_red] in map_fst specs_red.
 
-Time Let bare_specs_vm : list BARE_SPEC
+Time Definition bare_specs_vm : list BARE_SPEC
   := Eval vm_compute in bare_specs_red. (* 1.934 secs *)
 
 (** ** Fuse in the annotations so that we can report errors nicely *)
-Time Let results_vm : list ANNOTATED_BARE_SPEC
+Time Definition results_vm : list ANNOTATED_BARE_SPEC
   := Eval cbv [combine_annotations bare_specs_vm specs_red] in combine_annotations specs_red bare_specs_vm. (* 1.374 secs *)
 
 (** ** Report results *)
@@ -441,17 +444,17 @@ Axiom wrong_spec : forall x, (- x)%float = PrimFloat.abs x.
 
 Definition wrong_spec_list : list SPEC := cons ( `wrong_spec ) nil.
 
-Let wrong_specs : list ANNOTATED_BARE_SPEC
+Definition wrong_specs : list ANNOTATED_BARE_SPEC
   := Eval cbv [wrong_spec_list instantiate_all_ways] in instantiate_all_ways wrong_spec_list.
 
-Let wrong_bare_specs : list BARE_SPEC
+Definition wrong_bare_specs : list BARE_SPEC
   := Eval cbv [map_fst wrong_specs] in map_fst wrong_specs.
 
-Let wrong_bare_specs_vm : list BARE_SPEC
+Definition wrong_bare_specs_vm : list BARE_SPEC
   := Eval vm_compute in wrong_bare_specs.
 
 (** ** Fuse in the annotations so that we can report errors nicely *)
-Let wrong_results_vm : list ANNOTATED_BARE_SPEC
+Definition wrong_results_vm : list ANNOTATED_BARE_SPEC
   := Eval cbv [combine_annotations wrong_bare_specs_vm wrong_specs] in combine_annotations wrong_specs wrong_bare_specs_vm.
 
 (** ** Report results *)
@@ -470,11 +473,11 @@ End NegativeTest.
 
 Definition op_specs : list ANNOTATED_BARE_SPEC
   := instantiate_all_ways_nored op_spec_list.
-Time Let op_specs_red : list ANNOTATED_BARE_SPEC
+Time Definition op_specs_red : list ANNOTATED_BARE_SPEC
   := Eval cbv [instantiate_all_ways op_spec_list] in instantiate_all_ways op_spec_list. (* 0.883 secs *)
 Definition op_bare_specs : list BARE_SPEC
   := map fst op_specs.
-Let op_bare_specs_red : list BARE_SPEC
+Definition op_bare_specs_red : list BARE_SPEC
   := Eval cbv [map_fst op_specs_red] in map_fst op_specs_red.
 
 (** Machinery for evaluating independently the LHS of specs *)
@@ -502,13 +505,13 @@ Fixpoint merge_lhs (ls : list BARE_SPEC) (result : hlist) : list BARE_SPEC
      end.
 
 (** 0. evaluate [op_specs] with [vm_compute] *)
-Let op_bare_specs_vm : list BARE_SPEC
+Definition op_bare_specs_vm : list BARE_SPEC
   := Eval vm_compute in op_bare_specs_red.
 
 (** 1. [extract_lhs] of [op_specs] *)
 Definition LHS_op : hlist
   := extract_lhs op_bare_specs.
-Let LHS_op_red : hlist
+Definition LHS_op_red : hlist
   := Eval cbv [op_bare_specs_red extract_lhs] in extract_lhs op_bare_specs_red.
 
 (** 2. evaluate LHS with each mechanism *)
@@ -519,7 +522,7 @@ Let LHS_op_red : hlist
 (** ** [vm_compute] is ommited as it is the reference *)
 (** ** [native_compute] *)
 (** Native is slow at compiling big code, so we start from smaller code *)
-Let LHS_op_native := Eval native_compute in extract_lhs op_bare_specs.
+Definition LHS_op_native := Eval native_compute in extract_lhs op_bare_specs.
 
 (** ** [hnf] *)
 (** recursively applies hnf to all elements of the list *)
@@ -531,48 +534,48 @@ Ltac2 rec eval_hnf_hlist (c : constr) : constr
          '(hcons $h $t)
      | hnil => 'hnil
      end.
-Time Let LHS_op_hnf := ltac2:(let l := Std.eval_hnf 'LHS_op_red in let x := eval_hnf_hlist l in exact $x). (* 16.309 secs *)
+Time Definition LHS_op_hnf := ltac2:(let l := Std.eval_hnf 'LHS_op_red in let x := eval_hnf_hlist l in exact $x). (* 16.309 secs *)
 
 (** ** [cbn] *)
-Time Let LHS_op_cbn := Eval cbn in ltac2:(let l := Std.eval_hnf 'LHS_op_red in exact $l). (* 0.25 secs *)
+Time Definition LHS_op_cbn := Eval cbn in ltac2:(let l := Std.eval_hnf 'LHS_op_red in exact $l). (* 0.25 secs *)
 
 (** ** [simpl] *)
-Time Let LHS_op_simpl := Eval simpl in ltac2:(let l := Std.eval_hnf 'LHS_op_red in exact $l). (* 0.296 secs *)
+Time Definition LHS_op_simpl := Eval simpl in ltac2:(let l := Std.eval_hnf 'LHS_op_red in exact $l). (* 0.296 secs *)
 
 (** ** [cbv] *)
-Time Let LHS_op_cbv := Eval cbv in ltac2:(let l := Std.eval_hnf 'LHS_op_red in exact $l). (* 0.292 secs *)
+Time Definition LHS_op_cbv := Eval cbv in ltac2:(let l := Std.eval_hnf 'LHS_op_red in exact $l). (* 0.292 secs *)
 
 (** ** [lazy] *)
-Time Let LHS_op_lazy := Eval lazy in ltac2:(let l := Std.eval_hnf 'LHS_op_red in exact $l). (* 0.259 secs *)
+Time Definition LHS_op_lazy := Eval lazy in ltac2:(let l := Std.eval_hnf 'LHS_op_red in exact $l). (* 0.259 secs *)
 
 (** 3. [merge_lhs] with results of 2. and 0. *)
 
 (** ** fuse the results of vm RHS (vm because it's fast) back into cbn/hnf/simpl LHS for comparison *)
-Let op_bare_specs_native : list BARE_SPEC
+Definition op_bare_specs_native : list BARE_SPEC
   := Eval cbv [merge_lhs op_bare_specs_vm LHS_op_native] in merge_lhs op_bare_specs_vm LHS_op_native.
-Let op_bare_specs_hnf : list BARE_SPEC
+Definition op_bare_specs_hnf : list BARE_SPEC
   := Eval cbv [merge_lhs op_bare_specs_vm LHS_op_hnf] in merge_lhs op_bare_specs_vm LHS_op_hnf.
-Let op_bare_specs_cbn : list BARE_SPEC
+Definition op_bare_specs_cbn : list BARE_SPEC
   := Eval cbv [merge_lhs op_bare_specs_vm LHS_op_cbn] in merge_lhs op_bare_specs_vm LHS_op_cbn.
-Let op_bare_specs_simpl : list BARE_SPEC
+Definition op_bare_specs_simpl : list BARE_SPEC
   := Eval cbv [merge_lhs op_bare_specs_vm LHS_op_simpl] in merge_lhs op_bare_specs_vm LHS_op_simpl.
-Let op_bare_specs_cbv : list BARE_SPEC
+Definition op_bare_specs_cbv : list BARE_SPEC
   := Eval cbv [merge_lhs op_bare_specs_vm LHS_op_cbv] in merge_lhs op_bare_specs_vm LHS_op_cbv.
-Let op_bare_specs_lazy : list BARE_SPEC
+Definition op_bare_specs_lazy : list BARE_SPEC
   := Eval cbv [merge_lhs op_bare_specs_vm LHS_op_lazy] in merge_lhs op_bare_specs_vm LHS_op_lazy.
 
 (** ** Fuse in the annotations so that we can report errors nicely *)
-Time Let op_results_native : list ANNOTATED_BARE_SPEC
+Time Definition op_results_native : list ANNOTATED_BARE_SPEC
   := Eval cbv [combine_annotations op_specs_red op_bare_specs_native] in combine_annotations op_specs_red op_bare_specs_native. (* 0.826 secs *)
-Time Let op_results_hnf : list ANNOTATED_BARE_SPEC
+Time Definition op_results_hnf : list ANNOTATED_BARE_SPEC
   := Eval cbv [combine_annotations op_specs_red op_bare_specs_hnf] in combine_annotations op_specs_red op_bare_specs_hnf. (* 0.83 secs *)
-Time Let op_results_cbn : list ANNOTATED_BARE_SPEC
+Time Definition op_results_cbn : list ANNOTATED_BARE_SPEC
   := Eval cbv [combine_annotations op_specs_red op_bare_specs_cbn] in combine_annotations op_specs_red op_bare_specs_cbn. (* 0.83 secs *)
-Time Let op_results_simpl : list ANNOTATED_BARE_SPEC
+Time Definition op_results_simpl : list ANNOTATED_BARE_SPEC
   := Eval cbv [combine_annotations op_specs_red op_bare_specs_simpl] in combine_annotations op_specs_red op_bare_specs_simpl. (* 0.865 secs *)
-Time Let op_results_cbv : list ANNOTATED_BARE_SPEC
+Time Definition op_results_cbv : list ANNOTATED_BARE_SPEC
   := Eval cbv [combine_annotations op_specs_red op_bare_specs_cbv] in combine_annotations op_specs_red op_bare_specs_cbv. (* 0.845 secs *)
-Time Let op_results_lazy : list ANNOTATED_BARE_SPEC
+Time Definition op_results_lazy : list ANNOTATED_BARE_SPEC
   := Eval cbv [combine_annotations op_specs_red op_bare_specs_lazy] in combine_annotations op_specs_red op_bare_specs_lazy. (* 0.812 secs *)
 
 (** ** Report results *)
@@ -583,5 +586,4 @@ Ltac2 Eval report_results "cbn" 'op_results_cbn.
 Ltac2 Eval report_results "simpl" 'op_results_simpl.
 Ltac2 Eval report_results "cbv" 'op_results_cbv.
 Ltac2 Eval report_results "lazy" 'op_results_lazy.
-
-End __WORK_AROUND_COQBUG_4790.
+End Tests.

From 281b658b14ffe74955a6feb5a4246ffe654c755a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Tue, 17 Feb 2026 15:41:39 +0100
Subject: [PATCH 137/578] Ltac2.Control.reorder_goals

Close #20087
---
 .../21642-redoer-goals-Added.rst              |  5 +++
 plugins/ltac2/tac2core.ml                     | 24 ++++++++++++++
 plugins/ltac2/tac2ffi.ml                      | 33 ++++++++++---------
 plugins/ltac2/tac2ffi.mli                     |  1 +
 test-suite/ltac2/reorder_goals.v              | 21 ++++++++++++
 theories/Ltac2/Control.v                      |  5 +++
 6 files changed, 74 insertions(+), 15 deletions(-)
 create mode 100644 doc/changelog/06-Ltac2-language/21642-redoer-goals-Added.rst
 create mode 100644 test-suite/ltac2/reorder_goals.v

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 <https://github.com/rocq-prover/rocq/pull/21642>`_,
+  fixes `#20087 <https://github.com/rocq-prover/rocq/issues/20087>`_,
+  by Gaëtan Gilbert).
diff --git a/plugins/ltac2/tac2core.ml b/plugins/ltac2/tac2core.ml
index 57ea00a6c8df..214a57526cbc 100644
--- a/plugins/ltac2/tac2core.ml
+++ b/plugins/ltac2/tac2core.ml
@@ -1081,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) ->
diff --git a/plugins/ltac2/tac2ffi.ml b/plugins/ltac2/tac2ffi.ml
index 6c57feb06baa..b4c3679d0af1 100644
--- a/plugins/ltac2/tac2ffi.ml
+++ b/plugins/ltac2/tac2ffi.ml
@@ -277,21 +277,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
 
@@ -514,3 +499,21 @@ let reference = {
   r_of = of_reference;
   r_to = to_reference;
 }
+
+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 ae77209028d5..dab0e6f0f1bd 100644
--- a/plugins/ltac2/tac2ffi.mli
+++ b/plugins/ltac2/tac2ffi.mli
@@ -275,3 +275,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/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/theories/Ltac2/Control.v b/theories/Ltac2/Control.v
index d5c4c17d7e68..03d51bb12717 100644
--- a/theories/Ltac2/Control.v
+++ b/theories/Ltac2/Control.v
@@ -88,6 +88,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.

From 4b6ae51006adbca772b59a32f8009078f809ac16 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Tue, 17 Feb 2026 16:18:30 +0100
Subject: [PATCH 138/578] Add version info in ocaml deprecation messages

Deprecations in Names added in a95ad451e8afb51a8c02fa3087255b2d6372eacc
Deprecation in Libnames added in 729c382f422ed85a78f2ee19b36e8a72757ce7d0
---
 kernel/names.mli     | 18 +++++++++---------
 library/libnames.mli |  2 +-
 2 files changed, 10 insertions(+), 10 deletions(-)

diff --git a/kernel/names.mli b/kernel/names.mli
index f8ee314b58d0..9e7be1b72777 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} *)
 
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]. *)

From 65c2017866e8896218c828fb3bb79ba780e18b9d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Tue, 17 Feb 2026 16:42:53 +0100
Subject: [PATCH 139/578] Remove useless try/with Not_found in detyping

---
 pretyping/detyping.ml | 25 ++++++++++++-------------
 1 file changed, 12 insertions(+), 13 deletions(-)

diff --git a/pretyping/detyping.ml b/pretyping/detyping.ml
index 45e3c6bd492e..5b1989d23f5f 100644
--- a/pretyping/detyping.ml
+++ b/pretyping/detyping.ml
@@ -612,19 +612,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
+      RegularStyle
+    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 ->

From ea6bc0927a6b8c20fdba9480da8f9607012b8039 Mon Sep 17 00:00:00 2001
From: Dario Halilovic <dario.halilovic@epfl.ch>
Date: Tue, 17 Feb 2026 17:05:23 +0100
Subject: [PATCH 140/578] Create get_matching_evars helper in Evarnames

---
 engine/evarnames.ml | 23 ++++++++++++-----------
 1 file changed, 12 insertions(+), 11 deletions(-)

diff --git a/engine/evarnames.ml b/engine/evarnames.ml
index cb2820298af4..fa077e6bae25 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,9 +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
-  let ans = Evar.Set.diff ans evn.removed_evars 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
@@ -362,8 +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 = Evar.Set.diff conflicts evn.removed_evars 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
@@ -386,18 +390,15 @@ 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
-    let ans = Evar.Set.diff ans evn.removed_evars 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)
 
 let resolve fp evn =
   let qualid = EvarQualid.make fp in
-  let evs = NameResolution.find qualid evn.name_resolution in
-  (* Do not consider removed evars as conflicts for name resolution *)
-  let evs = Evar.Set.diff evs evn.removed_evars in
+  let evs = get_matching_evars qualid evn in
   let open Pp in
   match classify_set evs with
   | SetEmpty -> raise Not_found

From 47ab8e413714d58dc1676801f842220e3aab6728 Mon Sep 17 00:00:00 2001
From: Dario Halilovic <dario.halilovic@epfl.ch>
Date: Tue, 17 Feb 2026 17:08:17 +0100
Subject: [PATCH 141/578] Remove unnecessary removed_evars membership checks

---
 engine/evarnames.ml | 7 ++-----
 1 file changed, 2 insertions(+), 5 deletions(-)

diff --git a/engine/evarnames.ml b/engine/evarnames.ml
index fa077e6bae25..05a32ec9fa86 100644
--- a/engine/evarnames.ml
+++ b/engine/evarnames.ml
@@ -393,8 +393,7 @@ let has_unambiguous_name ev evn =
     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
@@ -402,8 +401,6 @@ let resolve fp evn =
   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 ".")

From e05eb5323b124d57ec554574c0ef6dd2239f17a1 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Tue, 17 Feb 2026 17:12:08 +0100
Subject: [PATCH 142/578] Reindent pretype_if

It was strangely indented after the constructor count check
---
 pretyping/pretyping.ml | 109 ++++++++++++++++++++---------------------
 1 file changed, 54 insertions(+), 55 deletions(-)

diff --git a/pretyping/pretyping.ml b/pretyping/pretyping.ml
index f5702dca9787..4cddddec56ff 100644
--- a/pretyping/pretyping.ml
+++ b/pretyping/pretyping.ml
@@ -1435,64 +1435,63 @@ 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 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
-        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 ~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|]))
+    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 ->

From 65b0bca0ed1f903c7f79c7ec8c33285d0b062caa Mon Sep 17 00:00:00 2001
From: Dario Halilovic <dario.halilovic@epfl.ch>
Date: Tue, 17 Feb 2026 17:41:19 +0100
Subject: [PATCH 143/578] Remove "Generate Goal Names" from known RocqIDE
 options

This fixes the incorrect "Set this option from the IDE menu instead" warning.
---
 ide/rocqide/idetop.ml | 1 -
 1 file changed, 1 deletion(-)

diff --git a/ide/rocqide/idetop.ml b/ide/rocqide/idetop.ml
index 05fd2e95058c..5578834cbe5e 100644
--- a/ide/rocqide/idetop.ml
+++ b/ide/rocqide/idetop.ml
@@ -67,7 +67,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

From d6b2a8eadfb25a579b4619c045a9943654aa5b6d Mon Sep 17 00:00:00 2001
From: Pierre Roux <pierre.roux@onera.fr>
Date: Wed, 18 Feb 2026 14:26:50 +0100
Subject: [PATCH 144/578] [refman] Renaming Stdlib -> Corelib

---
 doc/sphinx/addendum/universe-polymorphism.rst   |  2 +-
 doc/sphinx/language/core/assumptions.rst        |  2 +-
 doc/sphinx/language/core/modules.rst            | 14 +++++++-------
 doc/sphinx/proof-engine/vernacular-commands.rst |  4 ++--
 4 files changed, 11 insertions(+), 11 deletions(-)

diff --git a/doc/sphinx/addendum/universe-polymorphism.rst b/doc/sphinx/addendum/universe-polymorphism.rst
index 400f40336e3e..fe65afc99f05 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
diff --git a/doc/sphinx/language/core/assumptions.rst b/doc/sphinx/language/core/assumptions.rst
index 7877d5decdbb..87d599895a91 100644
--- a/doc/sphinx/language/core/assumptions.rst
+++ b/doc/sphinx/language/core/assumptions.rst
@@ -38,7 +38,7 @@ 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))`,
+`(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/modules.rst b/doc/sphinx/language/core/modules.rst
index 7de3dccb4c94..0bd74ebec5b6 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::
@@ -562,7 +562,7 @@ While qualified names always consist of a series of dot-separated :n:`@ident`\s,
 
 **File part.** Files are identified by :gdef:`logical paths <logical path>`,
 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 <physical path>`) in the user's file system.
@@ -587,14 +587,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/proof-engine/vernacular-commands.rst b/doc/sphinx/proof-engine/vernacular-commands.rst
index 42f5bcbcb3cd..1a98906234a7 100644
--- a/doc/sphinx/proof-engine/vernacular-commands.rst
+++ b/doc/sphinx/proof-engine/vernacular-commands.rst
@@ -519,7 +519,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 +605,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

From 8beb6bfadfd81b08cc95cdc46d24251f569b9218 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Tue, 17 Feb 2026 16:53:59 +0100
Subject: [PATCH 145/578] Add flag to control printing alternate match syntaxes

This was already possible using Printing All but didn't have a
separate flag.
---
 .../21645-print-regular-match-Added.rst             |  4 ++++
 doc/sphinx/language/extensions/match.rst            | 13 +++++++++++++
 pretyping/printingFlags.ml                          |  5 ++++-
 3 files changed, 21 insertions(+), 1 deletion(-)
 create mode 100644 doc/changelog/08-vernac-commands-and-options/21645-print-regular-match-Added.rst

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 <https://github.com/rocq-prover/rocq/pull/21645>`_,
+  by Gaëtan Gilbert).
diff --git a/doc/sphinx/language/extensions/match.rst b/doc/sphinx/language/extensions/match.rst
index ee61d9235dfb..fb44d8cfa6c9 100644
--- a/doc/sphinx/language/extensions/match.rst
+++ b/doc/sphinx/language/extensions/match.rst
@@ -348,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 <if-then-else>` and :ref:`let
+   <irrefutable-patterns>`), 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
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
diff --git a/pretyping/printingFlags.ml b/pretyping/printingFlags.ml
index 3712668c2180..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
@@ -253,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;
   }
 

From 78927f52d1f4aced9d7f927d43e3549f7c6922e0 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Wed, 18 Feb 2026 19:24:14 +0100
Subject: [PATCH 146/578] Prevent line breaking in Print LoadPath

Should help those who want to parse this output (https://rocq-prover.zulipchat.com/#narrow/channel/304019-Proof-General-users/topic/.22Go.20to.20definition.22.20in.20Emacs.20not.20working.20for.20Ocaml.205.2E3.2F5.2E4/near/574570432)
---
 vernac/loadpath.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

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
 

From 2f1e0faa729ac599bc790adb567b15a4f61eadf8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Wed, 18 Feb 2026 18:22:25 +0100
Subject: [PATCH 147/578] Enforce that genarg interp functions are at the
 correct type

It never made any sense to be able to declare an interp function with
top type = Empty.t.

We add a new Val.tag "Any" for genargs whose top type is Val.t without
a dedicated dyn tag (typically ltac2 in 1 quotation genargs).
---
 .../21655-SkySkimmer-genarg-correct-typ.sh    |   5 +
 plugins/ltac/taccoerce.ml                     |   1 +
 plugins/ltac/tacentries.ml                    |  15 +--
 plugins/ltac/tacentries.mli                   |   4 +-
 plugins/ltac/tacinterp.ml                     | 124 ++++++++----------
 plugins/ltac/tacinterp.mli                    |   5 +-
 plugins/ltac2_ltac1/tac2core_ltac1.ml         |  21 +--
 plugins/ltac2_ltac1/tac2core_ltac1.mli        |   6 +-
 plugins/ssr/ssrparser.mlg                     |   2 +-
 plugins/ssrmatching/ssrmatching.ml            |   2 +-
 pretyping/geninterp.ml                        |   6 +-
 pretyping/geninterp.mli                       |   5 +-
 12 files changed, 100 insertions(+), 96 deletions(-)
 create mode 100644 dev/ci/user-overlays/21655-SkySkimmer-genarg-correct-typ.sh

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/plugins/ltac/taccoerce.ml b/plugins/ltac/taccoerce.ml
index 5b19076420bd..feef6ed741bd 100644
--- a/plugins/ltac/taccoerce.ml
+++ b/plugins/ltac/taccoerce.ml
@@ -175,6 +175,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
diff --git a/plugins/ltac/tacentries.ml b/plugins/ltac/tacentries.ml
index f3d229a3cc1b..147b744ebf15 100644
--- a/plugins/ltac/tacentries.ml
+++ b/plugins/ltac/tacentries.ml
@@ -834,8 +834,7 @@ 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.Tacinterp.lfun) tac.tacval_var in
     let tac = MLTacMap.get tac.tacval_tac !ml_table in
@@ -879,8 +878,8 @@ type 'b argument_subst =
 
 type ('b, 'c) argument_interp =
 | ArgInterpRet : ('c, 'c) argument_interp
-| ArgInterpFun : ('b, Val.t) Tacinterp.Register.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 :
   (Tacinterp.interp_sign -> Environ.env -> Evd.evar_map -> 'b -> 'c) -> ('b, 'c) argument_interp
 
@@ -909,18 +908,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) Tacinterp.Register.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) =
diff --git a/plugins/ltac/tacentries.mli b/plugins/ltac/tacentries.mli
index bdc365f043bb..91cca039aebf 100644
--- a/plugins/ltac/tacentries.mli
+++ b/plugins/ltac/tacentries.mli
@@ -155,8 +155,8 @@ type 'b argument_subst =
 
 type ('b, 'c) argument_interp =
 | ArgInterpRet : ('c, 'c) argument_interp
-| ArgInterpFun : ('b, Tacinterp.Value.t) Tacinterp.Register.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 :
   (Tacinterp.interp_sign -> Environ.env -> Evd.evar_map -> 'b -> 'c) -> ('b, 'c) argument_interp
 
diff --git a/plugins/ltac/tacinterp.ml b/plugins/ltac/tacinterp.ml
index 5f31c0083f3b..36dc70975291 100644
--- a/plugins/ltac/tacinterp.ml
+++ b/plugins/ltac/tacinterp.ml
@@ -54,7 +54,7 @@ type ('glb, 'top) interp_fun = interp_sign -> 'glb -> 'top Ftactic.t
 
 module InterpObj =
 struct
-  type ('raw, 'glb, 'top) obj = ('glb, Val.t) interp_fun
+  type ('raw, 'glb, 'top) obj = ('glb, 'top) interp_fun
   let name = "interp"
   let default _ = None
 end
@@ -63,8 +63,6 @@ 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
 
 end
@@ -93,9 +91,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
@@ -425,6 +420,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} ->
@@ -726,6 +729,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
 
@@ -1090,6 +1102,43 @@ let type_uconstr ?(flags = (constr_flags ()))
     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
@@ -1291,7 +1340,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 ->
@@ -1564,61 +1613,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 ->
-      Register.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
@@ -2082,11 +2076,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
-  Register.register_interp0 wit interp
+  Register.register_interp0 wit f
 
 let def_intern ist x = (ist, x)
 let def_subst _ x = x
diff --git a/plugins/ltac/tacinterp.mli b/plugins/ltac/tacinterp.mli
index 57c0353fb244..6342c33a2ae7 100644
--- a/plugins/ltac/tacinterp.mli
+++ b/plugins/ltac/tacinterp.mli
@@ -66,7 +66,8 @@ val type_uconstr :
 
 (** 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
@@ -155,5 +156,5 @@ sig
 type ('glb, 'top) interp_fun = interp_sign -> 'glb -> 'top Ftactic.t
 
 val register_interp0 :
-  ('raw, 'glb, 'top) genarg_type -> ('glb, Geninterp.Val.t) interp_fun -> unit
+  ('raw, 'glb, 'top) genarg_type -> ('glb, 'top) interp_fun -> unit
 end
diff --git a/plugins/ltac2_ltac1/tac2core_ltac1.ml b/plugins/ltac2_ltac1/tac2core_ltac1.ml
index f0b711f53816..a86ad034f24c 100644
--- a/plugins/ltac2_ltac1/tac2core_ltac1.ml
+++ b/plugins/ltac2_ltac1/tac2core_ltac1.ml
@@ -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
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/ssr/ssrparser.mlg b/plugins/ssr/ssrparser.mlg
index a60b4255acff..57ccbf298144 100644
--- a/plugins/ssr/ssrparser.mlg
+++ b/plugins/ssr/ssrparser.mlg
@@ -158,7 +158,7 @@ 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
diff --git a/plugins/ssrmatching/ssrmatching.ml b/plugins/ssrmatching/ssrmatching.ml
index 02fe9daca3f1..c1644adc86d5 100644
--- a/plugins/ssrmatching/ssrmatching.ml
+++ b/plugins/ssrmatching/ssrmatching.ml
@@ -98,7 +98,7 @@ 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
diff --git a/pretyping/geninterp.ml b/pretyping/geninterp.ml
index f756c1602024..e862f12b32a9 100644
--- a/pretyping/geninterp.ml
+++ b/pretyping/geninterp.ml
@@ -19,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
@@ -43,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
 
diff --git a/pretyping/geninterp.mli b/pretyping/geninterp.mli
index d4ba8c275d40..0c92d362a595 100644
--- a/pretyping/geninterp.mli
+++ b/pretyping/geninterp.mli
@@ -21,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

From 9f87df9fc3401013e28a1991d544dc1819abfb8e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Thu, 19 Feb 2026 19:55:00 +0100
Subject: [PATCH 148/578] Stop going through genargs to print values in
 Pptactic.pr_value

This removes the only user of (generic_)top_print, so we remove top_print.

(top printers are still used by val printers ie generic_val_print)
---
 plugins/ltac/pptactic.ml | 32 +++++++++-----------------------
 printing/genprint.ml     | 12 +++---------
 printing/genprint.mli    |  4 ----
 3 files changed, 12 insertions(+), 36 deletions(-)

diff --git a/plugins/ltac/pptactic.ml b/plugins/ltac/pptactic.ml
index e5c953138555..22e0aea6f7d9 100644
--- a/plugins/ltac/pptactic.ml
+++ b/plugins/ltac/pptactic.ml
@@ -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
diff --git a/printing/genprint.ml b/printing/genprint.ml
index a74f120b1759..30c6218535d2 100644
--- a/printing/genprint.ml
+++ b/printing/genprint.ml
@@ -111,7 +111,6 @@ let _ =
 type ('raw, 'glb, 'top) genprinter = {
   raw : 'raw -> printer_result;
   glb : 'glb -> printer_result;
-  top : 'top -> top_printer_result;
 }
 
 let basic_default name =
@@ -126,7 +125,6 @@ struct
     let printer = {
       raw = (fun _ -> PrinterBasic (fun env sigma -> str "<genarg:" ++ str name ++ str ">"));
       glb = (fun _ -> PrinterBasic (fun env sigma -> str "<genarg:" ++ str name ++ str ">"));
-      top = (fun _ -> TopPrinterBasic (fun () -> str "<genarg:" ++ str name ++ str ">"));
     } in
     Some printer
 end
@@ -134,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' ->
@@ -144,23 +142,19 @@ 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)
diff --git a/printing/genprint.mli b/printing/genprint.mli
index d9964665ad16..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,7 +51,6 @@ 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 *)

From 167aa273c92e6780e6767ad5dc7416f50fabd09f Mon Sep 17 00:00:00 2001
From: Tomas Diaz <tomdtron@gmail.com>
Date: Wed, 24 Sep 2025 18:59:14 +0200
Subject: [PATCH 149/578] feat: Add elaboration of fresh qualities

Currently behind a Sort Polymorphism flag.

fix: Generate proper sort variable in record

feat: Add sort elab for interactive definitions

fix: Thread sort poly flag more correctly

It was being passed as unconstrained_sorts in some cases.

refactor: Remove unnecessary sort_poly flags

fix: Add sort_poly to prepare_obligations

refactor: Remove remaining fixmes and todos

refactor: General cleanup

refactor: Get ?evar_handler from evd

refactor: Remove search_fix_guard

doc: comment collapse

refactor: Remove unnecessary unconstrained_sorts

refactor: Remove unnecessary check for collapse_sort_variables

revert: Some changes in unify quality

feat: Add elim constraints to non-prim records with sort variables

doc: Add doc on flag + implicit elab of sorts

chore: Add changelog entry

chore: Add overlays

refactor: indentation

feat: Add more specific elim constraints to non-prim projections

Address comments

refactor: Pass on sigma in search_guard

test: Move sort_poly_elab test to output folder

fix: Change assert implicit sort vars for error in sections

fix(attempt): Return evd from make_recursive_bodies

refactor: Change option array to list option

refactor: Use Cmap_env to keep elim constraints from projs

Apply suggestion from @SkySkimmer

update test
---
 .../user-overlays/21450-TDiazT-elab-sorts.sh  |    1 +
 .../21450-elab-sorts-Added.rst                |    4 +
 doc/sphinx/addendum/universe-polymorphism.rst |   40 +-
 engine/evarutil.ml                            |    4 +-
 engine/evarutil.mli                           |    2 +-
 engine/evd.ml                                 |   10 +-
 engine/evd.mli                                |    4 +-
 engine/uState.ml                              |   59 +-
 engine/uState.mli                             |    2 +-
 kernel/inductive.ml                           |  111 +-
 kernel/inductive.mli                          |   11 +-
 kernel/safe_typing.ml                         |    3 +-
 plugins/ltac/leminv.ml                        |    2 +-
 pretyping/inductiveops.ml                     |    7 +-
 pretyping/pretyping.ml                        |   36 +-
 pretyping/pretyping.mli                       |   17 +-
 pretyping/typing.ml                           |   17 +-
 pretyping/typing.mli                          |    2 +
 test-suite/output/Fixpoint.out                |    6 +-
 test-suite/output/FixpointNoElim.out          |   12 +-
 test-suite/output/FixpointNoElim.v            |    2 +-
 test-suite/output/sort_poly_elab.out          | 1314 +++++++++++++++++
 test-suite/output/sort_poly_elab.v            |  794 ++++++++++
 test-suite/success/sort_poly.v                |    8 +-
 test-suite/success/sort_poly_elab.v           |  175 ---
 vernac/attributes.ml                          |   19 +-
 vernac/attributes.mli                         |    1 +
 vernac/classes.ml                             |    2 +-
 vernac/comAssumption.ml                       |    2 +-
 vernac/comDefinition.ml                       |    4 +-
 vernac/comFixpoint.ml                         |    4 +-
 vernac/comInductive.ml                        |   18 +-
 vernac/comRewriteRule.ml                      |   18 +-
 vernac/comRewriteRule.mli                     |    1 +
 vernac/declare.ml                             |   46 +-
 vernac/record.ml                              |  129 +-
 vernac/record.mli                             |    1 -
 vernac/vernacentries.ml                       |    9 +-
 38 files changed, 2517 insertions(+), 380 deletions(-)
 create mode 100644 dev/ci/user-overlays/21450-TDiazT-elab-sorts.sh
 create mode 100644 doc/changelog/02-specification-language/21450-elab-sorts-Added.rst
 create mode 100644 test-suite/output/sort_poly_elab.out
 create mode 100644 test-suite/output/sort_poly_elab.v
 delete mode 100644 test-suite/success/sort_poly_elab.v

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/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 <https://github.com/rocq-prover/rocq/pull/21450>`_,
+  by Tomas Diaz).
diff --git a/doc/sphinx/addendum/universe-polymorphism.rst b/doc/sphinx/addendum/universe-polymorphism.rst
index 400f40336e3e..b17b901dcabe 100644
--- a/doc/sphinx/addendum/universe-polymorphism.rst
+++ b/doc/sphinx/addendum/universe-polymorphism.rst
@@ -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}.
@@ -855,6 +853,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 +974,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 +999,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/engine/evarutil.ml b/engine/evarutil.ml
index 93e784c71cd4..eb0fb31e5c80 100644
--- a/engine/evarutil.ml
+++ b/engine/evarutil.ml
@@ -32,8 +32,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 ?(to_type = true) sigma f =
+  let sigma = minimize_universes ~to_type sigma in
   let uvars = ref Univ.Level.Set.empty in
   let nf_constr c =
     let _, varsc = EConstr.universes_of_constr sigma c in
diff --git a/engine/evarutil.mli b/engine/evarutil.mli
index 2c52ee5fb925..5940ab6fadb6 100644
--- a/engine/evarutil.mli
+++ b/engine/evarutil.mli
@@ -150,7 +150,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 -> ?to_type:bool -> evar_map ->
   ((EConstr.t -> Constr.t) -> 'a) ->
   evar_map * 'a
 
diff --git a/engine/evd.ml b/engine/evd.ml
index f450164dac4a..b9b832805953 100644
--- a/engine/evd.ml
+++ b/engine/evd.ml
@@ -1031,7 +1031,7 @@ 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 ~to_type:(PolyFlags.collapse_sort_variables poly) uctx in
   let uctx = UState.restrict uctx vars in
   ignore (UState.check_univ_decl ~poly uctx udecl)
 
@@ -1212,13 +1212,13 @@ 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 ?(to_type = true) evd =
+  let universes = UState.collapse_sort_variables ?except ~to_type evd.universes in
   { evd with universes }
 
-let minimize_universes ?(collapse_sort_variables=true) evd =
+let minimize_universes ?(collapse_sort_variables=true) ?(to_type = true) evd =
   let uctx' = if collapse_sort_variables
-    then UState.collapse_sort_variables evd.universes
+    then UState.collapse_sort_variables ~to_type evd.universes
     else evd.universes
   in
   let uctx' = UState.normalize_variables uctx' in
diff --git a/engine/evd.mli b/engine/evd.mli
index 6a8df8146dbd..ccbe8115b1c5 100644
--- a/engine/evd.mli
+++ b/engine/evd.mli
@@ -638,12 +638,12 @@ 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 -> ?to_type: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 : ?collapse_sort_variables:bool -> ?to_type:bool -> evar_map -> evar_map
 
 (** Lift [UState.update_sigma_univs] *)
 val update_sigma_univs : UGraph.t -> evar_map -> evar_map
diff --git a/engine/uState.ml b/engine/uState.ml
index 90041147c2d7..1703c33ce125 100644
--- a/engine/uState.ml
+++ b/engine/uState.ml
@@ -101,7 +101,7 @@ 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 collapse : ?except:QVar.Set.t -> ?to_type:bool -> t -> t
   val pr : (QVar.t -> Libnames.qualid option) -> t -> Pp.t
   val of_elims : QGraph.t -> t
   val elims : t -> QGraph.t
@@ -164,8 +164,8 @@ let set q qv m =
   let q, rigid = match q with ReprVar (q, rigid) -> q, rigid | ReprConstant _ -> assert false in
   let qv = match qv with QVar qv -> repr_node qv m | QConstant qc -> ReprConstant qc 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, ReprVar (qv, _qvrigd) ->
+  match qv with
+  | ReprVar (qv, _qvrigd) ->
     if QVar.equal q qv then Some m
     else if rigid then None
     else
@@ -173,9 +173,10 @@ let set q qv m =
         if is_above_prop m q
         then QSet.add qv (QSet.remove q m.above_prop)
         else m.above_prop in
-      Some { qmap = QMap.add q (Equiv (QVar qv)) m.qmap; above_prop;
-             elims = enforce_eq (QVar qv) (QVar q) m.elims; initial_elims = m.initial_elims }
-  | q, ReprConstant qc ->
+      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 rigid then None
     else
@@ -305,13 +306,40 @@ let collapse_above_prop ~to_prop m =
          )
          m.qmap m
 
-let collapse ?(except=QSet.empty) m =
+let collapse ?(except=QSet.empty) ?(to_type = true) 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
-           | Equiv _ -> m
-           | Canonical { rigid } -> if rigid || QSet.mem q except then m
-                    else Option.get (set q qtype m))
-         m.qmap 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 to_type then Option.get (set q qtype m) else m)
+    m.qmap m
 
 let pr prqvar_opt ({ qmap; elims } as m) =
   let open Pp in
@@ -358,7 +386,8 @@ let normalize_elim_constraints m cstrs =
   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
@@ -1505,8 +1534,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 ?(to_type = true) uctx =
+  let sorts = QState.collapse ?except ~to_type uctx.sort_variables in
   normalize_quality_variables { uctx with sort_variables = sorts }
 
 let minimize uctx =
diff --git a/engine/uState.mli b/engine/uState.mli
index 260f000adcaa..330c484d1153 100644
--- a/engine/uState.mli
+++ b/engine/uState.mli
@@ -243,7 +243,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 -> ?to_type:bool -> t -> t
 
 type ('a, 'b, 'c, 'd) gen_universe_decl = {
   univdecl_qualities : 'a;
diff --git a/kernel/inductive.ml b/kernel/inductive.ml
index f4cf7164ade8..95e410473e75 100644
--- a/kernel/inductive.ml
+++ b/kernel/inductive.ml
@@ -1626,7 +1626,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,9 +1643,7 @@ 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
+  let raise_err = raise_fix_guard_err_fn env recdef names 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,
@@ -1662,54 +1667,70 @@ let inductive_of_mutfix ?evars ?elim_to env ((nvect,bodynum),(names,types,bodies
             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.ind_ignores_elim_constraints env ind then () else
-      let sind = UVars.subst_instance_sort inst mip.mind_sort in
-      let u = Sorts.univ_of_sort sind 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
-        | 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
+    check_occur fixenv 1 def
   in
   (* Do it on every fixpoint *)
   let rv = Array.map2_i find_ind nvect bodies in
   (Array.map fst rv, Array.map snd rv)
 
-
-let check_fix ?evars ?elim_to env ((nvect,_),(names,_,bodies as recdef) as fix) =
+(* 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 _, mip = lookup_mind_specif env ind in
+        let ind_sort = UVars.subst_instance_sort inst 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 out_sort = match names.(i).Context.binder_relevance with
+          | Irrelevant -> Sorts.sprop
+          | Relevant -> Sorts.prop
+          | RelevanceVar q -> Sorts.qsort q u in
+        (ind_sort, out_sort) :: sorts
+      ) [] minds)
+
+
+let check_fix_pre_sorts ?evars 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
+(* 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
-  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 raise_err = raise_fix_guard_err_fn env recdef names in
+  let () =
+    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 get_tree 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 cache ?evars renv nvect trees body
+        with FixGuardError (err_env, err) -> raise_err err_env i err
+      done
+  in
+  sorts_opt
+
+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. *)
diff --git a/kernel/inductive.mli b/kernel/inductive.mli
index 27c86340ebfb..d1bbf5d71f8d 100644
--- a/kernel/inductive.mli
+++ b/kernel/inductive.mli
@@ -193,9 +193,14 @@ 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
diff --git a/kernel/safe_typing.ml b/kernel/safe_typing.ml
index 696ece152ac2..3655cef09605 100644
--- a/kernel/safe_typing.ml
+++ b/kernel/safe_typing.ml
@@ -695,7 +695,8 @@ let push_section_context uctx senv =
     Sorts.QVar.is_global 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 and elimination constraints 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 _ -> ()
diff --git a/plugins/ltac/leminv.ml b/plugins/ltac/leminv.ml
index c823e999577d..1b53958dcbcf 100644
--- a/plugins/ltac/leminv.ml
+++ b/plugins/ltac/leminv.ml
@@ -212,7 +212,7 @@ let inversion_scheme ~name ~poly env sigma t sort dep_option inv_op =
   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 ~to_type:(PolyFlags.collapse_sort_variables poly) sigma in
   let rec fill_holes c =
     match EConstr.kind sigma c with
     | Evar (e,args) ->
diff --git a/pretyping/inductiveops.ml b/pretyping/inductiveops.ml
index 496330f1df31..28adc0d10333 100644
--- a/pretyping/inductiveops.ml
+++ b/pretyping/inductiveops.ml
@@ -270,10 +270,13 @@ 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 (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
diff --git a/pretyping/pretyping.ml b/pretyping/pretyping.ml
index f5702dca9787..50e28531091c 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)
@@ -252,7 +247,8 @@ type pretype_flags = {
 
 let glob_opt_qvar ?loc ~flags sigma = function
   | 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
@@ -555,7 +551,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
@@ -880,7 +876,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 +889,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
 
diff --git a/pretyping/pretyping.mli b/pretyping/pretyping.mli
index a11296de8aba..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 *)
diff --git a/pretyping/typing.ml b/pretyping/typing.ml
index 0bcf2610f966..4da05cc1ffd0 100644
--- a/pretyping/typing.ml
+++ b/pretyping/typing.ml
@@ -328,12 +328,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
@@ -583,7 +594,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) ->
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/test-suite/output/Fixpoint.out b/test-suite/output/Fixpoint.out
index 7bd2bd4c82a9..7aea18965be2 100644
--- a/test-suite/output/Fixpoint.out
+++ b/test-suite/output/Fixpoint.out
@@ -82,9 +82,9 @@ The command has indeed failed with message:
 Recursive definition of foo' and bar' is ill-formed.
 As a mutual fixpoint decreasing on the 1st argument of foo' and
 1st argument of bar':
-Cannot define a fixpoint with principal argument living in sort 
-"SProp" to produce a value in sort "Prop"
-because "SProp" does not eliminate to "Prop".
+Recursive call to bar' has principal argument equal to 
+"SI" instead of
+a subterm of "n".
 As a mutual fixpoint decreasing on the 1st argument of foo' and
 2nd argument of bar':
 Recursive call to bar' has principal argument equal to 
diff --git a/test-suite/output/FixpointNoElim.out b/test-suite/output/FixpointNoElim.out
index 519cfc7689d0..5b0f7f3c0e4e 100644
--- a/test-suite/output/FixpointNoElim.out
+++ b/test-suite/output/FixpointNoElim.out
@@ -1,10 +1,6 @@
-File "./output/FixpointNoElim.v", line 4, characters 0-48:
+File "./output/FixpointNoElim.v", line 4, characters 0-49:
 Warning: Not a truly recursive fixpoint. [non-recursive,fixpoints,default]
-File "./output/FixpointNoElim.v", line 4, characters 0-48:
+File "./output/FixpointNoElim.v", line 4, characters 0-49:
 The command has indeed failed with message:
-Recursive definition of bar is ill-formed.
-Cannot define a fixpoint
-with principal argument living in sort "Type@{α3 ; Set}"
-to produce a value in sort "Prop"
-because "Type@{α3 ; Set}" does not eliminate to "Prop".
-Recursive definition is: "fun _ : foo => I".
+Elimination constraints are not implied by the ones declared: 
+s -> Prop
diff --git a/test-suite/output/FixpointNoElim.v b/test-suite/output/FixpointNoElim.v
index b3eca7e8442c..c5821c239a02 100644
--- a/test-suite/output/FixpointNoElim.v
+++ b/test-suite/output/FixpointNoElim.v
@@ -1,4 +1,4 @@
 Set Universe Polymorphism.
 Inductive foo@{s;} : Type@{s;Set} := XX.
 
-Fail Fixpoint bar@{s;} (f:foo@{s;}) : True := I.
+Fail Fixpoint bar@{s;|} (f:foo@{s;}) : True := I.
diff --git a/test-suite/output/sort_poly_elab.out b/test-suite/output/sort_poly_elab.out
new file mode 100644
index 000000000000..d1f98faa00a2
--- /dev/null
+++ b/test-suite/output/sort_poly_elab.out
@@ -0,0 +1,1314 @@
+qsort@{α ; u} : Type@{u+1}
+(* α ; u |=  *)
+
+qsort is universe polymorphic
+qsort is transparent
+Expands to: Constant sort_poly_elab.Reduction.qsort
+Declared in library sort_poly_elab, line 10, characters 13-18
+qsort'@{α ; u u0} : Type@{u}
+(* α ; u u0 |= u0 < u *)
+
+qsort' is universe polymorphic
+qsort' is transparent
+Expands to: Constant sort_poly_elab.Reduction.qsort'
+Declared in library sort_poly_elab, line 14, characters 13-19
+@eq_refl Type@{sort_poly_elab.26} q1
+:
+@eq Type@{sort_poly_elab.26} q1 tU@{Type ; }
+     : @eq Type@{sort_poly_elab.26} q1 tU@{Type ; }
+(* {sort_poly_elab.26} |= U < sort_poly_elab.26 *)
+@eq_refl Type@{sort_poly_elab.29} q2
+:
+@eq Type@{sort_poly_elab.29} q2 tU@{Type ; }
+     : @eq Type@{sort_poly_elab.29} q2 tU@{Type ; }
+(* {sort_poly_elab.29} |= U < sort_poly_elab.29 *)
+@eq_refl Type@{sort_poly_elab.32} q3
+:
+@eq Type@{sort_poly_elab.32} q3 tU@{Type ; }
+     : @eq Type@{sort_poly_elab.32} q3 tU@{Type ; }
+(* {sort_poly_elab.32} |= U < sort_poly_elab.32 *)
+exfalso@{α ; u} : forall (A : Type@{α ; u}) (_ : False), A
+(* α ; u |=  *)
+
+exfalso is universe polymorphic
+Arguments exfalso A%_type_scope H
+exfalso is transparent
+Expands to: Constant sort_poly_elab.Reduction.exfalso
+Declared in library sort_poly_elab, line 32, characters 13-20
+iter@{α ; u} :
+forall (A : Type@{α ; u}) (_ : forall _ : A, A) (_ : nat) (_ : A), A
+(* α ; u |=  *)
+
+iter is universe polymorphic
+Arguments iter A%_type_scope f%_function_scope n%_nat_scope x
+iter is transparent
+Expands to: Constant sort_poly_elab.Reduction.iter
+Declared in library sort_poly_elab, line 39, characters 11-15
+Box@{α α0 ; u} : forall _ : Type@{α ; u}, Type@{α0 ; u}
+(* α α0 ; u |=  *)
+
+Box is universe polymorphic
+Box@{α α0 ; u} may only be eliminated to produce values whose type is in sort quality α0,
+  unless instantiated such that the qualities α and Prop
+  are equal to the instantiation of α0, or to qualities smaller
+  (SProp <= Prop <= Type, and all variables <= Type)
+  than the instantiation of α0.
+Arguments Box A%_type_scope
+Expands to: Inductive sort_poly_elab.Conversion.Box
+Declared in library sort_poly_elab, line 54, characters 12-15
+t1@{α α0 ; u} :
+forall (A : Type@{α ; u}) (_ : A) (_ : A), Box@{α α0 ; u} A
+(* α α0 ; u |=  *)
+
+t1 is universe polymorphic
+Arguments t1 A%_type_scope x y
+t1 is transparent
+Expands to: Constant sort_poly_elab.Conversion.t1
+Declared in library sort_poly_elab, line 58, characters 13-15
+t2@{α α0 ; u} :
+forall (A : Type@{α ; u}) (_ : A) (_ : A), Box@{α α0 ; u} A
+(* α α0 ; u |=  *)
+
+t2 is universe polymorphic
+Arguments t2 A%_type_scope x y
+t2 is transparent
+Expands to: Constant sort_poly_elab.Conversion.t2
+Declared in library sort_poly_elab, line 62, characters 13-15
+t1'@{α ; u} : forall (A : Type@{α ; u}) (_ : A) (_ : A), A
+(* α ; u |=  *)
+
+t1' is universe polymorphic
+Arguments t1' A%_type_scope x y
+t1' is transparent
+Expands to: Constant sort_poly_elab.Conversion.t1'
+Declared in library sort_poly_elab, line 66, characters 13-16
+t2'@{α ; u} : forall (A : Type@{α ; u}) (_ : A) (_ : A), A
+(* α ; u |=  *)
+
+t2' is universe polymorphic
+Arguments t2' A%_type_scope x y
+t2' is transparent
+Expands to: Constant sort_poly_elab.Conversion.t2'
+Declared in library sort_poly_elab, line 70, characters 13-16
+File "./output/sort_poly_elab.v", line 73, characters 13-20:
+The command has indeed failed with message:
+The term
+ "@eq_refl
+    (forall (_ : nat) (_ : nat), Box@{Type Type ; sort_poly_elab.54} nat)
+    (t1@{Type Type ; sort_poly_elab.54} nat)"
+has type
+ "@eq (forall (_ : nat) (_ : nat), Box@{Type Type ; sort_poly_elab.54} nat)
+    (t1@{Type Type ; sort_poly_elab.54} nat)
+    (t1@{Type Type ; sort_poly_elab.54} nat)"
+while it is expected to have type
+ "@eq (forall (_ : nat) (_ : nat), Box@{Type Type ; sort_poly_elab.54} nat)
+    (t1@{Type Type ; sort_poly_elab.54} nat)
+    (t2@{Type Type ; sort_poly_elab.54} nat)"
+(cannot unify "t1@{Type Type ; sort_poly_elab.54} nat" and
+"t2@{Type Type ; sort_poly_elab.54} nat").
+File "./output/sort_poly_elab.v", line 74, characters 13-20:
+The command has indeed failed with message:
+The term
+ "@eq_refl (forall (_ : nat) (_ : nat), nat)
+    (t1'@{Type ; sort_poly_elab.58} nat)"
+has type
+ "@eq (forall (_ : nat) (_ : nat), nat) (t1'@{Type ; sort_poly_elab.58} nat)
+    (t1'@{Type ; sort_poly_elab.58} nat)"
+while it is expected to have type
+ "@eq (forall (_ : nat) (_ : nat), nat) (t1'@{Type ; sort_poly_elab.58} nat)
+    (t2'@{Type ; sort_poly_elab.59} nat)"
+(cannot unify "t1'@{Type ; sort_poly_elab.58} nat" and
+"t2'@{Type ; sort_poly_elab.59} nat").
+fun A : SProp =>
+@eq_refl (forall (_ : A) (_ : A), Box@{SProp Type ; sort_poly_elab.62} A)
+  (t1@{SProp Type ; sort_poly_elab.62} A)
+:
+@eq (forall (_ : A) (_ : A), Box@{SProp Type ; sort_poly_elab.62} A)
+  (t1@{SProp Type ; sort_poly_elab.62} A)
+  (t2@{SProp Type ; sort_poly_elab.62} A)
+     : forall A : SProp,
+       @eq (forall (_ : A) (_ : A), Box@{SProp Type ; sort_poly_elab.62} A)
+         (t1@{SProp Type ; sort_poly_elab.62} A)
+         (t2@{SProp Type ; sort_poly_elab.62} A)
+(* {sort_poly_elab.62} |=  *)
+fun A : SProp =>
+@eq_refl (Box@{SProp Type ; sort_poly_elab.66} (forall (_ : A) (_ : A), A))
+  (box@{SProp Type ; sort_poly_elab.66} (forall (_ : A) (_ : A), A)
+     (t1'@{SProp ; sort_poly_elab.67} A))
+:
+@eq (Box@{SProp Type ; sort_poly_elab.66} (forall (_ : A) (_ : A), A))
+  (box@{SProp Type ; sort_poly_elab.66} (forall (_ : A) (_ : A), A)
+     (t1'@{SProp ; sort_poly_elab.67} A))
+  (box@{SProp Type ; sort_poly_elab.66} (forall (_ : A) (_ : A), A)
+     (t2'@{SProp ; sort_poly_elab.69} A))
+     : forall A : SProp,
+       @eq (Box@{SProp Type ; sort_poly_elab.66} (forall (_ : A) (_ : A), A))
+         (box@{SProp Type ; sort_poly_elab.66} (forall (_ : A) (_ : A), A)
+            (t1'@{SProp ; sort_poly_elab.67} A))
+         (box@{SProp Type ; sort_poly_elab.66} (forall (_ : A) (_ : A), A)
+            (t2'@{SProp ; sort_poly_elab.69} A))
+(* {sort_poly_elab.69 sort_poly_elab.67 sort_poly_elab.66} |=  *)
+ignore@{α ; u} : forall {A : Type@{α ; u}} (_ : A), unit
+(* α ; u |=  *)
+
+ignore is universe polymorphic
+Arguments ignore {A}%_type_scope x
+ignore is transparent
+Expands to: Constant sort_poly_elab.Conversion.ignore
+Declared in library sort_poly_elab, line 91, characters 13-19
+unfold_ignore@{α α0 α1 ; u} :
+forall A : Type@{α1 ; u},
+@eq unit
+  (@ignore@{α ; u} (forall (_ : A) (_ : A), Box@{α1 α ; u} A)
+     (t1@{α1 α ; u} A))
+  (@ignore@{α0 ; u} (forall (_ : A) (_ : A), Box@{α1 α0 ; u} A)
+     (t2@{α1 α0 ; u} A))
+(* α α0 α1 ; u |=  *)
+
+unfold_ignore is universe polymorphic
+Arguments unfold_ignore A%_type_scope
+unfold_ignore is transparent
+Expands to: Constant sort_poly_elab.Conversion.unfold_ignore
+Declared in library sort_poly_elab, line 95, characters 13-26
+t@{α ; u} :
+forall (A : SProp) (_ : A) (_ : A), Box@{SProp α ; u} A
+(* α ; u |=  *)
+
+t is universe polymorphic
+Arguments t A%_type_scope x y
+t is transparent
+Expands to: Constant sort_poly_elab.Conversion.t
+Declared in library sort_poly_elab, line 104, characters 13-14
+v@{α ; u} : forall (A : Type@{α ; u}) (_ : bool), A
+(* α ; u |=  *)
+
+v is universe polymorphic
+Arguments v A%_type_scope _%_bool_scope
+Expands to: Constant sort_poly_elab.Conversion.v
+Declared in library sort_poly_elab, line 108, characters 8-9
+File "./output/sort_poly_elab.v", line 110, characters 50-51:
+The command has indeed failed with message:
+In environment
+P : forall _ : nat, Type@{α57 ; sort_poly_elab.85}
+x : P (v@{Type ; sort_poly_elab.84} nat true)
+The term "x" has type "P (v@{Type ; sort_poly_elab.84} nat true)"
+while it is expected to have type
+ "P (v@{Type ; sort_poly_elab.86} nat false)".
+fun (A : SProp) (P : forall _ : A, Type@{sort_poly_elab.91})
+  (x : P (v@{SProp ; sort_poly_elab.90} A true)) =>
+x : P (v@{SProp ; sort_poly_elab.92} A false)
+     : forall (A : SProp) (P : forall _ : A, Type@{sort_poly_elab.91})
+         (_ : P (v@{SProp ; sort_poly_elab.90} A true)),
+       P (v@{SProp ; sort_poly_elab.92} A false)
+(* {sort_poly_elab.92 sort_poly_elab.91 sort_poly_elab.90 sort_poly_elab.88} |=
+      *)
+zog@{α ; u} : forall _ : Type@{α ; u}, Type@{α ; u}
+(* α ; u |=  *)
+
+zog is universe polymorphic
+Arguments zog A%_type_scope
+zog is transparent
+Expands to: Constant sort_poly_elab.Inference.zog
+Declared in library sort_poly_elab, line 118, characters 13-16
+zag@{α ; u} : forall _ : Type@{α ; u}, Type@{α ; u}
+(* α ; u |=  *)
+
+zag is universe polymorphic
+Arguments zag A%_type_scope
+zag is transparent
+Expands to: Constant sort_poly_elab.Inference.zag
+Declared in library sort_poly_elab, line 123, characters 13-16
+zig@{α ; u} : forall _ : Type@{α ; u}, Type@{α ; u}
+(* α ; u |=  *)
+
+zig is universe polymorphic
+Arguments zig A%_type_scope
+zig is transparent
+Expands to: Constant sort_poly_elab.Inference.zig
+Declared in library sort_poly_elab, line 128, characters 13-16
+File "./output/sort_poly_elab.v", line 133, characters 66-67:
+The command has indeed failed with message:
+In environment
+A : Type@{s ; Set}
+The term "A" has type "Type@{s ; Set}" while it is expected to have type
+ "Type@{s' ; Set}"
+(universe inconsistency: Cannot enforce Type@{s | Set} <= Type@{s' | Set}).
+implicit@{α ; u} : Type@{α ; u}
+(* α ; u |=  *)
+
+implicit is universe polymorphic
+implicit@{α ; u} may only be eliminated to produce values whose type is in sort quality α,
+  unless instantiated such that the quality SProp
+  is equal to the instantiation of α, or to qualities smaller
+  (SProp <= Prop <= Type, and all variables <= Type)
+  than the instantiation of α.
+Expands to: Inductive sort_poly_elab.Inductives.implicit
+Declared in library sort_poly_elab, line 137, characters 12-20
+foo1@{α ; u} : Type@{α ; u}
+(* α ; u |=  *)
+
+foo1 is universe polymorphic
+foo1@{α ; u} may only be eliminated to produce values whose type is in sort quality α,
+  unless instantiated such that the quality SProp
+  is equal to the instantiation of α, or to qualities smaller
+  (SProp <= Prop <= Type, and all variables <= Type)
+  than the instantiation of α.
+Expands to: Inductive sort_poly_elab.Inductives.foo1
+Declared in library sort_poly_elab, line 141, characters 12-16
+File "./output/sort_poly_elab.v", line 144, characters 13-22:
+The command has indeed failed with message:
+The reference foo1_sind was not found in the current environment.
+Did you mean bool_sind, prod_sind, or_sind or bool_ind?
+File "./output/sort_poly_elab.v", line 148, characters 2-94:
+The command has indeed failed with message:
+Elimination constraints are not implied by the ones declared: 
+s -> Prop
+foo1_False@{s ; u} : forall _ : foo1@{s ; u}, False
+(* s ; u |= s -> Prop *)
+
+foo1_False is universe polymorphic
+Arguments foo1_False x
+foo1_False is transparent
+Expands to: Constant sort_poly_elab.Inductives.foo1_False
+Declared in library sort_poly_elab, line 152, characters 13-23
+foo1_False'@{α ; u} : forall _ : foo1@{α ; u}, False
+(* α ; u |= α -> Prop *)
+
+foo1_False' is universe polymorphic
+Arguments foo1_False' x
+foo1_False' is transparent
+Expands to: Constant sort_poly_elab.Inductives.foo1_False'
+Declared in library sort_poly_elab, line 157, characters 13-24
+foo2@{α ; u} : Type@{α ; u+1}
+(* α ; u |=  *)
+
+foo2 is universe polymorphic
+foo2@{α ; u} may only be eliminated to produce values whose type is in sort quality α,
+  unless instantiated such that the qualities Prop and Type
+  are equal to the instantiation of α, or to qualities smaller
+  (SProp <= Prop <= Type, and all variables <= Type)
+  than the instantiation of α.
+Expands to: Inductive sort_poly_elab.Inductives.foo2
+Declared in library sort_poly_elab, line 162, characters 12-16
+File "./output/sort_poly_elab.v", line 165, characters 13-22:
+The command has indeed failed with message:
+The reference foo2_rect was not found in the current environment.
+Did you mean bool_rect, sig2_rect, prod_rect, ex2_rect or bool_rec?
+foo3@{α α0 ; u} : forall _ : Type@{α0 ; u}, Type@{α ; u}
+(* α α0 ; u |=  *)
+
+foo3 is universe polymorphic
+foo3@{α α0 ; u} may only be eliminated to produce values whose type is in sort quality α,
+  unless instantiated such that the qualities α0 and Prop
+  are equal to the instantiation of α, or to qualities smaller
+  (SProp <= Prop <= Type, and all variables <= Type)
+  than the instantiation of α.
+Arguments foo3 A%_type_scope
+Expands to: Inductive sort_poly_elab.Inductives.foo3
+Declared in library sort_poly_elab, line 168, characters 12-16
+File "./output/sort_poly_elab.v", line 171, characters 13-22:
+The command has indeed failed with message:
+The reference foo3_rect was not found in the current environment.
+Did you mean bool_rect, prod_rect or bool_rec?
+foo5@{α ; u} : forall _ : Type@{α ; u}, Prop
+(* α ; u |=  *)
+
+foo5 is universe polymorphic
+foo5@{α ; u} may only be eliminated to produce values whose type is SProp or Prop,
+  unless instantiated such that the quality α is SProp or Prop.
+Arguments foo5 A%_type_scope
+Expands to: Inductive sort_poly_elab.Inductives.foo5
+Declared in library sort_poly_elab, line 174, characters 12-16
+foo5_ind'@{α ; u} :
+forall (A : Type@{α ; u}) (P : Prop) (_ : forall _ : A, P)
+  (_ : foo5@{α ; u} A),
+P
+(* α ; u |=  *)
+
+foo5_ind' is universe polymorphic
+Arguments foo5_ind' (A P)%_type_scope _%_function_scope _
+foo5_ind' is transparent
+Expands to: Constant sort_poly_elab.Inductives.foo5_ind'
+Declared in library sort_poly_elab, line 178, characters 13-22
+foo5_Prop_rect@{α ; u} :
+forall (A : Prop) (P : forall _ : foo5@{Type ; Set} A, Type@{α ; u})
+  (_ : forall a : A, P (Foo5@{Type ; Set} A a)) (f : foo5@{Type ; Set} A),
+P f
+(* α ; u |= Prop -> α *)
+
+foo5_Prop_rect is universe polymorphic
+Arguments foo5_Prop_rect A%_type_scope (P H)%_function_scope f
+foo5_Prop_rect is transparent
+Expands to: Constant sort_poly_elab.Inductives.foo5_Prop_rect
+Declared in library sort_poly_elab, line 182, characters 13-27
+foo5_Prop_rect'@{α ; u} :
+forall (A : Prop) (P : forall _ : foo5@{Prop ; Set} A, Type@{α ; u})
+  (_ : forall a : A, P (Foo5@{Prop ; Set} A a)) (f : foo5@{Prop ; Set} A),
+P f
+(* α ; u |=  *)
+
+foo5_Prop_rect' is universe polymorphic
+Arguments foo5_Prop_rect' A%_type_scope (P H)%_function_scope f
+foo5_Prop_rect' is transparent
+Expands to: Constant sort_poly_elab.Inductives.foo5_Prop_rect'
+Declared in library sort_poly_elab, line 193, characters 13-28
+foo6@{α ; u} : Type@{α ; u}
+(* α ; u |=  *)
+
+foo6 is universe polymorphic
+foo6@{α ; u} may only be eliminated to produce values whose type is in sort quality α,
+  unless instantiated such that the quality Prop
+  is equal to the instantiation of α, or to qualities smaller
+  (SProp <= Prop <= Type, and all variables <= Type)
+  than the instantiation of α.
+Expands to: Inductive sort_poly_elab.Inductives.foo6
+Declared in library sort_poly_elab, line 204, characters 12-16
+File "./output/sort_poly_elab.v", line 206, characters 13-22:
+The command has indeed failed with message:
+The reference foo6_sind was not found in the current environment.
+Did you mean foo5_sind, foo5_ind, bool_sind, prod_sind, or_sind, foo5_ind' or
+bool_ind?
+foo6_rect@{α α0 ; u u0} :
+forall (P : forall _ : foo6@{α ; u}, Type@{α0 ; u0}) 
+  (_ : P Foo6@{α ; u}) (f : foo6@{α ; u}),
+P f
+(* α α0 ; u u0 |= α -> α0 *)
+
+foo6_rect is universe polymorphic
+Arguments foo6_rect P%_function_scope H f
+foo6_rect is transparent
+Expands to: Constant sort_poly_elab.Inductives.foo6_rect
+Declared in library sort_poly_elab, line 209, characters 13-22
+foo6_prop_rect@{α ; u u0} :
+forall (P : forall _ : foo6@{Prop ; u}, Type@{α ; u0})
+  (_ : P Foo6@{Prop ; u}) (f : foo6@{Prop ; u}),
+P f
+(* α ; u u0 |=  *)
+
+foo6_prop_rect is universe polymorphic
+Arguments foo6_prop_rect P%_function_scope H f
+foo6_prop_rect is transparent
+Expands to: Constant sort_poly_elab.Inductives.foo6_prop_rect
+Declared in library sort_poly_elab, line 218, characters 13-27
+foo6_type_rect@{α ; u u0} :
+forall (P : forall _ : foo6@{Type ; u}, Type@{α ; u0})
+  (_ : P Foo6@{Type ; u}) (f : foo6@{Type ; u}),
+P f
+(* α ; u u0 |=  *)
+
+foo6_type_rect is universe polymorphic
+Arguments foo6_type_rect P%_function_scope H f
+foo6_type_rect is transparent
+Expands to: Constant sort_poly_elab.Inductives.foo6_type_rect
+Declared in library sort_poly_elab, line 227, characters 13-27
+foo7@{α ; } : Type@{α ; Set}
+(* α ;  |=  *)
+
+foo7 is universe polymorphic
+foo7@{α ; } may only be eliminated to produce values whose type is in sort quality α,
+  unless instantiated such that the quality Type
+  is equal to the instantiation of α, or to qualities smaller
+  (SProp <= Prop <= Type, and all variables <= Type)
+  than the instantiation of α.
+Expands to: Inductive sort_poly_elab.Inductives.foo7
+Declared in library sort_poly_elab, line 236, characters 12-16
+File "./output/sort_poly_elab.v", line 238, characters 13-22:
+The command has indeed failed with message:
+The reference foo7_sind was not found in the current environment.
+Did you mean foo5_sind, foo5_ind, bool_sind, prod_sind, or_sind, foo5_ind' or
+bool_ind?
+File "./output/sort_poly_elab.v", line 239, characters 13-21:
+The command has indeed failed with message:
+The reference foo7_ind was not found in the current environment. Did you mean
+foo5_ind, foo5_sind, foo5_ind' or bool_ind?
+foo7_prop_ind@{} :
+forall (P : forall _ : foo7@{Prop ; }, Prop) (_ : P Foo7_1@{Prop ; })
+  (_ : P Foo7_2@{Prop ; }) (f : foo7@{Prop ; }),
+P f
+
+foo7_prop_ind is universe polymorphic
+Arguments foo7_prop_ind P%_function_scope H H' f
+foo7_prop_ind is transparent
+Expands to: Constant sort_poly_elab.Inductives.foo7_prop_ind
+Declared in library sort_poly_elab, line 241, characters 13-26
+foo7_prop_rect@{α ; u} :
+forall (P : forall _ : foo7@{Prop ; }, Type@{α ; u}) 
+  (_ : P Foo7_1@{Prop ; }) (_ : P Foo7_2@{Prop ; }) 
+  (f : foo7@{Prop ; }),
+P f
+(* α ; u |= Prop -> α *)
+
+foo7_prop_rect is universe polymorphic
+Arguments foo7_prop_rect P%_function_scope H H' f
+foo7_prop_rect is transparent
+Expands to: Constant sort_poly_elab.Inductives.foo7_prop_rect
+Declared in library sort_poly_elab, line 248, characters 13-27
+sigma@{α α0 α1 ; u u0} :
+forall (A : Type@{α ; u}) (_ : forall _ : A, Type@{α0 ; u0}),
+Type@{α1 ; max(u,u0)}
+(* α α0 α1 ; u u0 |=  *)
+
+sigma is universe polymorphic
+sigma@{α α0 α1 ; u u0} may only be eliminated to produce values whose type is in sort quality α1,
+  unless instantiated such that the qualities α, α0 and Prop
+  are equal to the instantiation of α1, or to qualities smaller
+  (SProp <= Prop <= Type, and all variables <= Type)
+  than the instantiation of α1.
+Arguments sigma A%_type_scope B%_function_scope
+Expands to: Inductive sort_poly_elab.Inductives.sigma
+Declared in library sort_poly_elab, line 258, characters 12-17
+sigma_srect@{α α0 α1 α2 ; u u0 u1} :
+forall (A : Type@{α0 ; u}) (B : forall _ : A, Type@{α1 ; u0})
+  (P : forall _ : sigma@{α0 α1 α ; u u0} A B, Type@{α2 ; u1})
+  (_ : forall (x : A) (b : B x), P (pair@{α0 α1 α ; u u0} A B x b))
+  (s : sigma@{α0 α1 α ; u u0} A B),
+P s
+(* α α0 α1 α2 ; u u0 u1 |= α -> α2 *)
+
+sigma_srect is universe polymorphic
+Arguments sigma_srect A%_type_scope (B P H)%_function_scope s
+sigma_srect is transparent
+Expands to: Constant sort_poly_elab.Inductives.sigma_srect
+Declared in library sort_poly_elab, line 263, characters 13-24
+pr1@{α α0 α1 ; u u0} :
+forall {A : Type@{α1 ; u}} {B : forall _ : A, Type@{α ; u0}}
+  (_ : sigma@{α1 α α0 ; u u0} A B),
+A
+(* α α0 α1 ; u u0 |= α0 -> α1 *)
+
+pr1 is universe polymorphic
+Arguments pr1 {A}%_type_scope {B}%_function_scope s
+pr1 is transparent
+Expands to: Constant sort_poly_elab.Inductives.pr1
+Declared in library sort_poly_elab, line 273, characters 13-16
+pr2@{α α0 α1 ; u u0} :
+forall {A : Type@{α1 ; u}} {B : forall _ : A, Type@{α ; u0}}
+  (s : sigma@{α1 α α0 ; u u0} A B),
+B (@pr1@{α α0 α1 ; u u0} A B s)
+(* α α0 α1 ; u u0 |= α0 -> α
+                     α0 -> α1 *)
+
+pr2 is universe polymorphic
+Arguments pr2 {A}%_type_scope {B}%_function_scope s
+pr2 is transparent
+Expands to: Constant sort_poly_elab.Inductives.pr2
+Declared in library sort_poly_elab, line 278, characters 13-16
+π2 not a defined object.
+seq@{α ; u} : forall (A : Type@{α ; u}) (_ : A) (_ : A), Prop
+(* α ; u |=  *)
+
+seq is universe polymorphic
+Arguments seq A%_type_scope a _
+Expands to: Inductive sort_poly_elab.Inductives.seq
+Declared in library sort_poly_elab, line 293, characters 12-15
+eta@{α α0 α1 ; u u0 u1} :
+forall (A : Type@{α1 ; u0}) (B : forall _ : A, Type@{α ; u1})
+  (s : sigma@{α1 α α0 ; u0 u1} A B),
+seq@{α0 ; u} (sigma@{α1 α α0 ; u0 u1} A B) s
+  (pair@{α1 α α0 ; u0 u1} A B (@pr1@{α α0 α1 ; u0 u1} A B s)
+     (@pr2@{α α0 α1 ; u0 u1} A B s))
+(* α α0 α1 ; u u0 u1 |= α0 -> α
+                        α0 -> α1
+                        α0 -> Prop,
+                        u0 <= u
+                        u1 <= u *)
+
+eta is universe polymorphic
+Arguments eta A%_type_scope B%_function_scope s
+eta is opaque
+Expands to: Constant sort_poly_elab.Inductives.eta
+Declared in library sort_poly_elab, line 298, characters 13-16
+sum@{α α0 α1 ; u u0} :
+forall (_ : Type@{α ; u}) (_ : Type@{α0 ; u0}), Type@{α1 ; max(Set,u,u0)}
+(* α α0 α1 ; u u0 |=  *)
+
+sum is universe polymorphic
+sum@{α α0 α1 ; u u0} may only be eliminated to produce values whose type is in sort quality α1,
+  unless instantiated such that the qualities α, α0 and Type
+  are equal to the instantiation of α1, or to qualities smaller
+  (SProp <= Prop <= Type, and all variables <= Type)
+  than the instantiation of α1.
+Arguments sum (A B)%_type_scope
+Expands to: Inductive sort_poly_elab.Inductives.sum
+Declared in library sort_poly_elab, line 307, characters 12-15
+File "./output/sort_poly_elab.v", line 318, characters 2-297:
+The command has indeed failed with message:
+Elimination constraints are not implied by the ones declared: 
+s0 -> s0'
+sum_elim@{α α0 α1 α2 ; u u0 u1} :
+forall (A : Type@{α0 ; u}) (B : Type@{α1 ; u0})
+  (P : forall _ : sum@{α0 α1 α ; u u0} A B, Type@{α2 ; u1})
+  (_ : forall a : A, P (@inl@{α0 α1 α ; u u0} A B a))
+  (_ : forall b : B, P (@inr@{α0 α1 α ; u u0} A B b))
+  (x : sum@{α0 α1 α ; u u0} A B),
+P x
+(* α α0 α1 α2 ; u u0 u1 |= α -> α2 *)
+
+sum_elim is universe polymorphic
+Arguments sum_elim (A B)%_type_scope (P fl fr)%_function_scope x
+sum_elim is transparent
+Expands to: Constant sort_poly_elab.Inductives.sum_elim
+Declared in library sort_poly_elab, line 329, characters 13-21
+File "./output/sort_poly_elab.v", line 344, characters 2-66:
+The command has indeed failed with message:
+The quality constraints are inconsistent: cannot enforce Prop -> Type
+because it would identify Type and Prop which is inconsistent.
+This is introduced by the constraints Prop -> Type
+idT@{α α0 α1 ; u u0} :
+forall (A : Type@{α0 ; u}) (B : Type@{α1 ; u0})
+  (_ : sum@{α0 α1 α ; u u0} A B),
+sum@{α0 α1 Type ; u u0} A B
+(* α α0 α1 ; u u0 |= α -> Type *)
+
+idT is universe polymorphic
+Arguments idT (A B)%_type_scope x
+idT is transparent
+Expands to: Constant sort_poly_elab.Inductives.idT
+Declared in library sort_poly_elab, line 356, characters 13-16
+idP@{α α0 α1 ; u u0} :
+forall (A : Type@{α0 ; u}) (B : Type@{α1 ; u0})
+  (_ : sum@{α0 α1 α ; u u0} A B),
+sum@{α0 α1 Prop ; u u0} A B
+(* α α0 α1 ; u u0 |= α -> Prop *)
+
+idP is universe polymorphic
+Arguments idP (A B)%_type_scope x
+idP is transparent
+Expands to: Constant sort_poly_elab.Inductives.idP
+Declared in library sort_poly_elab, line 366, characters 13-16
+idS@{α α0 α1 ; u u0} :
+forall (A : Type@{α0 ; u}) (B : Type@{α1 ; u0})
+  (_ : sum@{α0 α1 α ; u u0} A B),
+sum@{α0 α1 SProp ; u u0} A B
+(* α α0 α1 ; u u0 |= α -> SProp *)
+
+idS is universe polymorphic
+Arguments idS (A B)%_type_scope x
+idS is transparent
+Expands to: Constant sort_poly_elab.Inductives.idS
+Declared in library sort_poly_elab, line 376, characters 13-16
+idV@{α α0 α1 α2 ; u u0} :
+forall (A : Type@{α1 ; u}) (B : Type@{α2 ; u0})
+  (_ : sum@{α1 α2 α ; u u0} A B),
+sum@{α1 α2 α0 ; u u0} A B
+(* α α0 α1 α2 ; u u0 |= α -> α0 *)
+
+idV is universe polymorphic
+Arguments idV (A B)%_type_scope x
+idV is transparent
+Expands to: Constant sort_poly_elab.Inductives.idV
+Declared in library sort_poly_elab, line 386, characters 13-16
+File "./output/sort_poly_elab.v", line 395, characters 2-57:
+The command has indeed failed with message:
+The quality constraints are inconsistent: cannot enforce Prop -> Type
+because it would identify Type and Prop which is inconsistent.
+This is introduced by the constraints Prop -> Type
+list@{α α0 ; u} :
+forall _ : Type@{α ; u}, Type@{α0 ; max(Set,u)}
+(* α α0 ; u |=  *)
+
+list is universe polymorphic
+list@{α α0 ; u} may only be eliminated to produce values whose type is in sort quality α0,
+  unless instantiated such that the qualities α and Type
+  are equal to the instantiation of α0, or to qualities smaller
+  (SProp <= Prop <= Type, and all variables <= Type)
+  than the instantiation of α0.
+Arguments list A%_type_scope
+Expands to: Inductive sort_poly_elab.Inductives.list
+Declared in library sort_poly_elab, line 400, characters 12-16
+list_elim@{α α0 α1 ; u u0} :
+forall (A : Type@{α0 ; u}) (P : forall _ : list@{α0 α ; u} A, Type@{α1 ; u0})
+  (_ : P (@nil@{α0 α ; u} A))
+  (_ : forall (x : A) (l : list@{α0 α ; u} A) (_ : P l),
+       P (@cons@{α0 α ; u} A x l))
+  (l : list@{α0 α ; u} A),
+P l
+(* α α0 α1 ; u u0 |= α -> α1 *)
+
+list_elim is universe polymorphic
+Arguments list_elim A%_type_scope P%_function_scope fn fc%_function_scope l
+list_elim is transparent
+Expands to: Constant sort_poly_elab.Inductives.list_elim
+Declared in library sort_poly_elab, line 408, characters 13-22
+list_idT@{α α0 ; u} :
+forall {A : Type@{α0 ; u}} (_ : list@{α0 α ; u} A), list@{α0 Type ; u} A
+(* α α0 ; u |= α -> Type *)
+
+list_idT is universe polymorphic
+Arguments list_idT {A}%_type_scope l
+list_idT is transparent
+Expands to: Constant sort_poly_elab.Inductives.list_idT
+Declared in library sort_poly_elab, line 419, characters 11-19
+list_idP@{α α0 ; u} :
+forall {A : Type@{α0 ; u}} (_ : list@{α0 α ; u} A), list@{α0 Prop ; u} A
+(* α α0 ; u |= α -> Prop *)
+
+list_idP is universe polymorphic
+Arguments list_idP {A}%_type_scope l
+list_idP is transparent
+Expands to: Constant sort_poly_elab.Inductives.list_idP
+Declared in library sort_poly_elab, line 427, characters 11-19
+list_idS@{α α0 ; u} :
+forall {A : Type@{α0 ; u}} (_ : list@{α0 α ; u} A), list@{α0 SProp ; u} A
+(* α α0 ; u |= α -> SProp *)
+
+list_idS is universe polymorphic
+Arguments list_idS {A}%_type_scope l
+list_idS is transparent
+Expands to: Constant sort_poly_elab.Inductives.list_idS
+Declared in library sort_poly_elab, line 435, characters 11-19
+map@{α α0 α1 α2 ; u u0} :
+forall (A : Type@{α2 ; u}) (B : Type@{α0 ; u0}) (_ : forall _ : A, B)
+  (_ : list@{α2 α ; u} A),
+list@{α0 α1 ; u0} B
+(* α α0 α1 α2 ; u u0 |= α -> α1 *)
+
+map is universe polymorphic
+Arguments map (A B)%_type_scope f%_function_scope l
+map is transparent
+Expands to: Constant sort_poly_elab.Inductives.map
+Declared in library sort_poly_elab, line 443, characters 11-14
+False'@{α ; u} : Type@{α ; u}
+(* α ; u |=  *)
+
+False' is universe polymorphic
+False'@{α ; u} may only be eliminated to produce values whose type is in sort quality α,
+  unless instantiated such that the quality SProp
+  is equal to the instantiation of α, or to qualities smaller
+  (SProp <= Prop <= Type, and all variables <= Type)
+  than the instantiation of α.
+Expands to: Inductive sort_poly_elab.Inductives.False'
+Declared in library sort_poly_elab, line 457, characters 12-18
+False'_False@{α ; u} :
+forall _ : False'@{α ; u}, False
+(* α ; u |= α -> Prop *)
+
+False'_False is universe polymorphic
+Arguments False'_False x
+False'_False is transparent
+Expands to: Constant sort_poly_elab.Inductives.False'_False
+Declared in library sort_poly_elab, line 461, characters 13-25
+bool@{α ; } : Type@{α ; Set}
+(* α ;  |=  *)
+
+bool is universe polymorphic
+bool@{α ; } may only be eliminated to produce values whose type is in sort quality α,
+  unless instantiated such that the quality Type
+  is equal to the instantiation of α, or to qualities smaller
+  (SProp <= Prop <= Type, and all variables <= Type)
+  than the instantiation of α.
+Expands to: Inductive sort_poly_elab.Inductives.bool
+Declared in library sort_poly_elab, line 468, characters 12-16
+bool_to_Prop@{α ; } : forall _ : bool@{α ; }, Prop
+(* α ;  |= α -> Type *)
+
+bool_to_Prop is universe polymorphic
+Arguments bool_to_Prop b
+bool_to_Prop is transparent
+Expands to: Constant sort_poly_elab.Inductives.bool_to_Prop
+Declared in library sort_poly_elab, line 471, characters 13-25
+bool_to_True_conj@{α ; } :
+forall _ : bool@{α ; }, or True True
+(* α ;  |= α -> Prop *)
+
+bool_to_True_conj is universe polymorphic
+Arguments bool_to_True_conj b
+bool_to_True_conj is transparent
+Expands to: Constant sort_poly_elab.Inductives.bool_to_True_conj
+Declared in library sort_poly_elab, line 480, characters 13-30
+bool_to_Prop'@{α ; } : forall _ : bool@{α ; }, Prop
+(* α ;  |= α -> Type *)
+
+bool_to_Prop' is universe polymorphic
+Arguments bool_to_Prop' b
+bool_to_Prop' is transparent
+Expands to: Constant sort_poly_elab.Inductives.bool_to_Prop'
+Declared in library sort_poly_elab, line 490, characters 21-34
+File "./output/sort_poly_elab.v", line 502, characters 2-80:
+The command has indeed failed with message:
+Incorrect elimination of "true@{Test ; }" in the inductive type
+"bool@{Test ; }":
+the return type has sort "Set"
+while it should be in a sort Test eliminates to.
+Elimination of a sort polymorphic inductive object instantiated to a variable sort quality
+is only allowed on itself or with an explicit elimination constraint to the target sort.
+unit@{α ; u} : Type@{α ; u}
+(* α ; u |=  *)
+
+unit is universe polymorphic
+unit@{α ; u} may only be eliminated to produce values whose type is in sort quality α,
+  unless instantiated such that the quality Prop
+  is equal to the instantiation of α, or to qualities smaller
+  (SProp <= Prop <= Type, and all variables <= Type)
+  than the instantiation of α.
+Expands to: Inductive sort_poly_elab.Inductives.unit
+Declared in library sort_poly_elab, line 511, characters 12-16
+FooNat@{α ; } : Type@{α ; Set}
+(* α ;  |=  *)
+
+FooNat is universe polymorphic
+FooNat@{α ; } may only be eliminated to produce values whose type is in sort quality α,
+  unless instantiated such that the quality Type
+  is equal to the instantiation of α, or to qualities smaller
+  (SProp <= Prop <= Type, and all variables <= Type)
+  than the instantiation of α.
+Expands to: Inductive sort_poly_elab.Inductives.FooNat
+Declared in library sort_poly_elab, line 519, characters 12-18
+Foo@{α α0 ; } :
+forall _ : FooNat@{α ; }, FooNat@{α0 ; }
+(* α α0 ;  |= α -> α0 *)
+
+Foo is universe polymorphic
+Arguments Foo n
+Foo is transparent
+Expands to: Constant sort_poly_elab.Inductives.Foo
+Declared in library sort_poly_elab, line 524, characters 13-16
+Foo@{Type Prop ; }
+     : forall _ : FooNat@{Type ; }, FooNat@{Prop ; }
+File "./output/sort_poly_elab.v", line 532, characters 2-30:
+The command has indeed failed with message:
+The quality constraints are inconsistent: cannot enforce Prop -> Type
+because it would identify Type and Prop which is inconsistent.
+This is introduced by the constraints Prop -> Type
+File "./output/sort_poly_elab.v", line 541, characters 2-30:
+The command has indeed failed with message:
+The record R1 could not be defined as a primitive record because it has no
+projections. [non-primitive-record,records,default]
+R2@{α ; u} : forall _ : SProp, Type@{α ; u}
+(* α ; u |= α -> SProp *)
+
+R2 is universe polymorphic
+R2 has primitive projections with eta conversion depending on sort instantiation.
+Arguments R2 A%_type_scope
+Expands to: Inductive sort_poly_elab.Records.R2
+Declared in library sort_poly_elab, line 543, characters 9-11
+R3@{α α0 ; u} :
+forall _ : Type@{α ; u}, Type@{α0 ; u}
+(* α α0 ; u |= α0 -> α *)
+
+R3 is universe polymorphic
+R3 has primitive projections with eta conversion depending on sort instantiation.
+Arguments R3 A%_type_scope
+Expands to: Inductive sort_poly_elab.Records.R3
+Declared in library sort_poly_elab, line 547, characters 9-11
+R4@{s ; } : forall _ : Type@{s ; Set}, Type@{s ; Set}
+(* s ;  |=  *)
+
+R4 is universe polymorphic
+R4 has primitive projections with eta conversion.
+Arguments R4 A%_type_scope
+Expands to: Inductive sort_poly_elab.Records.R4
+Declared in library sort_poly_elab, line 552, characters 9-11
+File "./output/sort_poly_elab.v", line 556, characters 2-49:
+The command has indeed failed with message:
+The record R5 could not be defined as a primitive record because it is
+squashed. [non-primitive-record,records,default]
+R5@{α ; u} : forall _ : Type@{α ; u}, SProp
+(* α ; u |= SProp -> α *)
+
+R5 is universe polymorphic
+R5@{α ; u} may only be eliminated to produce values whose type is SProp.
+Arguments R5 A%_type_scope
+Expands to: Inductive sort_poly_elab.Records.R5
+Declared in library sort_poly_elab, line 558, characters 11-13
+R6@{s ; } : forall _ : Type@{s ; Set}, Set
+(* s ;  |=  *)
+
+R6 is universe polymorphic
+R6 has primitive projections with eta conversion.
+Arguments R6 A%_type_scope
+Expands to: Inductive sort_poly_elab.Records.R6
+Declared in library sort_poly_elab, line 563, characters 9-11
+fun (A : SProp) (x y : R6@{SProp ; } A) =>
+@eq_refl (Conversion.Box@{SProp Type ; sort_poly_elab.361} A)
+  (Conversion.box@{SProp Type ; sort_poly_elab.361} A (R6f1 _ x))
+:
+@eq (Conversion.Box@{SProp Type ; sort_poly_elab.361} A)
+  (Conversion.box@{SProp Type ; sort_poly_elab.361} A (R6f1 _ x))
+  (Conversion.box@{SProp Type ; sort_poly_elab.361} A (R6f1 _ y))
+     : forall (A : SProp) (x y : R6@{SProp ; } A),
+       @eq (Conversion.Box@{SProp Type ; sort_poly_elab.361} A)
+         (Conversion.box@{SProp Type ; sort_poly_elab.361} A (R6f1 _ x))
+         (Conversion.box@{SProp Type ; sort_poly_elab.361} A (R6f1 _ y))
+(* {sort_poly_elab.361} |=  *)
+File "./output/sort_poly_elab.v", line 569, characters 10-17:
+The command has indeed failed with message:
+In environment
+A : Prop
+x : R6@{α375 ; } A
+y : R6@{α378 ; } A
+The term
+ "@eq_refl (Conversion.Box@{α373 Type ; sort_poly_elab.365} A)
+    (Conversion.box@{α373 Type ; sort_poly_elab.365} A (R6f1 _ x))"
+has type
+ "@eq (Conversion.Box@{α373 Type ; sort_poly_elab.365} A)
+    (Conversion.box@{α373 Type ; sort_poly_elab.365} A (R6f1 _ x))
+    (Conversion.box@{α373 Type ; sort_poly_elab.365} A (R6f1 _ x))"
+while it is expected to have type
+ "@eq (Conversion.Box@{α373 Type ; sort_poly_elab.365} A)
+    (Conversion.box@{α373 Type ; sort_poly_elab.365} A (R6f1 _ x))
+    (Conversion.box@{α373 Type ; sort_poly_elab.365} A (R6f1 _ y))"
+(cannot unify "Conversion.box@{α373 Type ; sort_poly_elab.365} A (R6f1 _ x)"
+and "Conversion.box@{α373 Type ; sort_poly_elab.365} A (R6f1 _ y)").
+File "./output/sort_poly_elab.v", line 571, characters 10-17:
+The command has indeed failed with message:
+In environment
+A : SProp
+x : R6@{SProp ; } A
+y : R6@{SProp ; } A
+The term
+ "@eq_refl (Conversion.Box@{Type Type ; sort_poly_elab.369} nat)
+    (Conversion.box@{Type Type ; sort_poly_elab.369} nat (R6f2 _ x))"
+has type
+ "@eq (Conversion.Box@{Type Type ; sort_poly_elab.369} nat)
+    (Conversion.box@{Type Type ; sort_poly_elab.369} nat (R6f2 _ x))
+    (Conversion.box@{Type Type ; sort_poly_elab.369} nat (R6f2 _ x))"
+while it is expected to have type
+ "@eq (Conversion.Box@{Type Type ; sort_poly_elab.369} nat)
+    (Conversion.box@{Type Type ; sort_poly_elab.369} nat (R6f2 _ x))
+    (Conversion.box@{Type Type ; sort_poly_elab.369} nat (R6f2 _ y))"
+(cannot unify "Conversion.box@{Type Type ; sort_poly_elab.369} nat (R6f2 _ x)"
+and "Conversion.box@{Type Type ; sort_poly_elab.369} nat (R6f2 _ y)").
+R7@{α α0 ; u} :
+forall _ : Type@{α ; u}, Type@{α0 ; max(Set,u)}
+(* α α0 ; u |=  *)
+
+R7 is universe polymorphic
+R7@{α α0 ; u} may only be eliminated to produce values whose type is in sort quality α0,
+  unless instantiated such that the qualities α, Prop and Type
+  are equal to the instantiation of α0, or to qualities smaller
+  (SProp <= Prop <= Type, and all variables <= Type)
+  than the instantiation of α0.
+Arguments R7 A%_type_scope
+Expands to: Inductive sort_poly_elab.Records.R7
+Declared in library sort_poly_elab, line 574, characters 38-40
+R7f1@{α α0 ; u} :
+forall (A : Type@{α ; u}) (_ : R7@{α α0 ; u} A), A
+(* α α0 ; u |= α0 -> α *)
+
+R7f1 is universe polymorphic
+R7f1 is a projection of R7
+Arguments R7f1 A%_type_scope r
+R7f1 is transparent
+Expands to: Constant sort_poly_elab.Records.R7f1
+Declared in library sort_poly_elab, line 574, characters 55-59
+R7f2@{α α0 ; u} :
+forall (A : Type@{α ; u}) (_ : R7@{α α0 ; u} A), nat
+(* α α0 ; u |= α0 -> Type *)
+
+R7f2 is universe polymorphic
+R7f2 is a projection of R7
+Arguments R7f2 A%_type_scope r
+R7f2 is transparent
+Expands to: Constant sort_poly_elab.Records.R7f2
+Declared in library sort_poly_elab, line 574, characters 65-69
+Rsigma@{s ; u v} :
+forall (A : Type@{s ; u}) (_ : forall _ : A, Type@{s ; v}),
+Type@{s ; max(u,v)}
+(* s ; u v |=  *)
+
+Rsigma is universe polymorphic
+Rsigma has primitive projections with eta conversion.
+Arguments Rsigma A%_type_scope B%_function_scope
+Expands to: Inductive sort_poly_elab.Records.Rsigma
+Declared in library sort_poly_elab, line 585, characters 9-15
+Rsigma_srect@{α α0 ; u u0 u1} :
+forall (A : Type@{α ; u}) (B : forall _ : A, Type@{α ; u0})
+  (P : forall _ : Rsigma@{α ; u u0} A B, Type@{α0 ; u1})
+  (_ : forall (x : A) (b : B x), P (Rpair@{α ; u u0} A B x b))
+  (s : Rsigma@{α ; u u0} A B),
+P s
+(* α α0 ; u u0 u1 |=  *)
+
+Rsigma_srect is universe polymorphic
+Arguments Rsigma_srect A%_type_scope (B P H)%_function_scope s
+Rsigma_srect is transparent
+Expands to: Constant sort_poly_elab.Records.Rsigma_srect
+Declared in library sort_poly_elab, line 590, characters 13-25
+sexists@{α ; u} :
+forall (A : Type@{α ; u}) (_ : forall _ : A, Prop), Prop
+(* α ; u |=  *)
+
+sexists is universe polymorphic
+sexists@{α ; u} may only be eliminated to produce values whose type is SProp or Prop,
+  unless instantiated such that the quality α is SProp or Prop.
+Arguments sexists A%_type_scope B%_function_scope
+Expands to: Inductive sort_poly_elab.Records.sexists
+Declared in library sort_poly_elab, line 604, characters 12-19
+sexists_ind@{Type ;
+sort_poly_elab.392}
+     : forall (A : Type@{sort_poly_elab.392}) (B : forall _ : A, Prop)
+         (P : Prop) (_ : forall (a : A) (_ : B a), P)
+         (_ : sexists@{Type ; sort_poly_elab.392} A B),
+       P
+(* {sort_poly_elab.392} |=  *)
+R8@{α α0 ; u} : Type@{α ; u+1}
+(* α α0 ; u |=  *)
+
+R8 is universe polymorphic
+R8@{α α0 ; u} may only be eliminated to produce values whose type is in sort quality α,
+  unless instantiated such that the qualities α0, Prop and Type
+  are equal to the instantiation of α, or to qualities smaller
+  (SProp <= Prop <= Type, and all variables <= Type)
+  than the instantiation of α.
+Expands to: Inductive sort_poly_elab.Records.R8
+Declared in library sort_poly_elab, line 614, characters 9-11
+R8f1@{α α0 ; u} :
+forall _ : R8@{α α0 ; u}, Type@{α0 ; u}
+(* α α0 ; u |= α -> Type *)
+
+R8f1 is universe polymorphic
+R8f1 is a projection of R8
+Arguments R8f1 r
+R8f1 is transparent
+Expands to: Constant sort_poly_elab.Records.R8f1
+Declared in library sort_poly_elab, line 615, characters 4-8
+R8f2@{α α0 ; u} :
+forall r : R8@{α α0 ; u}, R8f1@{α α0 ; u} r
+(* α α0 ; u |= α -> α0
+               α -> Type *)
+
+R8f2 is universe polymorphic
+R8f2 is a projection of R8
+Arguments R8f2 r
+R8f2 is transparent
+Expands to: Constant sort_poly_elab.Records.R8f2
+Declared in library sort_poly_elab, line 616, characters 4-8
+R9@{α α0 α1 ; } : Type@{α ; Set}
+(* α α0 α1 ;  |=  *)
+
+R9 is universe polymorphic
+R9@{α α0 α1 ; } may only be eliminated to produce values whose type is in sort quality α,
+  unless instantiated such that the qualities α0, α1 and Prop
+  are equal to the instantiation of α, or to qualities smaller
+  (SProp <= Prop <= Type, and all variables <= Type)
+  than the instantiation of α.
+Expands to: Inductive sort_poly_elab.Records.R9
+Declared in library sort_poly_elab, line 634, characters 9-11
+R9f1@{α α0 α1 ; } :
+forall _ : R9@{α α0 α1 ; }, bool@{α0 ; }
+(* α α0 α1 ;  |= α -> α0 *)
+
+R9f1 is universe polymorphic
+R9f1 is a projection of R9
+Arguments R9f1 r
+R9f1 is transparent
+Expands to: Constant sort_poly_elab.Records.R9f1
+Declared in library sort_poly_elab, line 635, characters 4-8
+R9f2@{α α0 α1 ; } :
+forall _ : R9@{α α0 α1 ; }, bool@{α1 ; }
+(* α α0 α1 ;  |= α -> α1 *)
+
+R9f2 is universe polymorphic
+R9f2 is a projection of R9
+Arguments R9f2 r
+R9f2 is transparent
+Expands to: Constant sort_poly_elab.Records.R9f2
+Declared in library sort_poly_elab, line 636, characters 4-8
+R10@{α α0 α1 α2 ; u u0} :
+forall _ : Type@{α0 ; u}, Type@{α ; max(Set,u,u0)}
+(* α α0 α1 α2 ; u u0 |=  *)
+
+R10 is universe polymorphic
+R10@{α α0 α1 α2 ; u u0} may only be eliminated to produce values whose type is in sort quality α,
+  unless instantiated such that the qualities α0, α1, α2 and Prop
+  are equal to the instantiation of α, or to qualities smaller
+  (SProp <= Prop <= Type, and all variables <= Type)
+  than the instantiation of α.
+Arguments R10 A%_type_scope
+Expands to: Inductive sort_poly_elab.Records.R10
+Declared in library sort_poly_elab, line 648, characters 9-12
+R10f1@{α α0 α1 α2 ; u u0} :
+forall (A : Type@{α0 ; u}) (_ : R10@{α α0 α1 α2 ; u u0} A), A
+(* α α0 α1 α2 ; u u0 |= α -> α0 *)
+
+R10f1 is universe polymorphic
+R10f1 is a projection of R10
+Arguments R10f1 A%_type_scope r
+R10f1 is transparent
+Expands to: Constant sort_poly_elab.Records.R10f1
+Declared in library sort_poly_elab, line 649, characters 4-9
+R10f2@{α α0 α1 α2 ; u u0} :
+forall (A : Type@{α0 ; u}) (r : R10@{α α0 α1 α2 ; u u0} A),
+@eq@{α0 α1 ; u u0} A (R10f1@{α α0 α1 α2 ; u u0} A r)
+  (R10f1@{α α0 α1 α2 ; u u0} A r)
+(* α α0 α1 α2 ; u u0 |= α -> α0
+                        α -> α1 *)
+
+R10f2 is universe polymorphic
+R10f2 is a projection of R10
+Arguments R10f2 A%_type_scope r
+R10f2 is transparent
+Expands to: Constant sort_poly_elab.Records.R10f2
+Declared in library sort_poly_elab, line 650, characters 4-9
+R10f3@{α α0 α1 α2 ; u u0} :
+forall (A : Type@{α0 ; u}) (_ : R10@{α α0 α1 α2 ; u u0} A), bool@{α2 ; }
+(* α α0 α1 α2 ; u u0 |= α -> α2 *)
+
+R10f3 is universe polymorphic
+R10f3 is a projection of R10
+Arguments R10f3 A%_type_scope r
+R10f3 is transparent
+Expands to: Constant sort_poly_elab.Records.R10f3
+Declared in library sort_poly_elab, line 651, characters 4-9
+R11@{α α0 α1 α2 α3 α4 α5 ; u} :
+Type@{α ; Set}
+(* α α0 α1 α2 α3 α4 α5 ; u |= α0 -> α3
+                              α3 -> Type *)
+
+R11 is universe polymorphic
+R11@{α α0 α1 α2 α3 α4 α5 ; u} may only be eliminated to produce values whose type is in sort quality α,
+  unless instantiated such that the qualities α3, α4, α5 and Prop
+  are equal to the instantiation of α, or to qualities smaller
+  (SProp <= Prop <= Type, and all variables <= Type)
+  than the instantiation of α.
+Expands to: Inductive sort_poly_elab.Records.R11
+Declared in library sort_poly_elab, line 667, characters 9-12
+R11f1@{α α0 α1 α2 α3 α4 α5 ; u} :
+forall _ : R11@{α α0 α1 α2 α3 α4 α5 ; u}, bool@{α3 ; }
+(* α α0 α1 α2 α3 α4 α5 ; u |= α -> α3
+                              α0 -> α3
+                              α3 -> Type *)
+
+R11f1 is universe polymorphic
+R11f1 is a projection of R11
+Arguments R11f1 r
+R11f1 is transparent
+Expands to: Constant sort_poly_elab.Records.R11f1
+Declared in library sort_poly_elab, line 668, characters 4-9
+R11f2@{α α0 α1 α2 α3 α4 α5 ; u} :
+forall r : R11@{α α0 α1 α2 α3 α4 α5 ; u},
+let r0 : R10@{α0 α1 α2 α3 ; Set u} bool@{α1 ; } :=
+  Build_R10@{α0 α1 α2 α3 ; Set u} bool@{α1 ; } true@{α1 ; }
+    (@eq_refl@{α1 α2 ; Set u} bool@{α1 ; } true@{α1 ; })
+    (R11f1@{α α0 α1 α2 α3 α4 α5 ; u} r)
+  in
+match R10f3@{α0 α1 α2 α3 ; Set u} bool@{α1 ; } r0 return Type@{α4 ; Set} with
+| true => bool@{α4 ; }
+| false => bool@{α4 ; }
+end
+(* α α0 α1 α2 α3 α4 α5 ; u |= α -> α3
+                              α -> α4
+                              α0 -> α3
+                              α3 -> Type *)
+
+R11f2 is universe polymorphic
+R11f2 is a projection of R11
+Arguments R11f2 r
+R11f2 is transparent
+Expands to: Constant sort_poly_elab.Records.R11f2
+Declared in library sort_poly_elab, line 669, characters 4-9
+R11f3@{α α0 α1 α2 α3 α4 α5 ; u} :
+forall _ : R11@{α α0 α1 α2 α3 α4 α5 ; u}, bool@{α5 ; }
+(* α α0 α1 α2 α3 α4 α5 ; u |= α -> α5
+                              α0 -> α3
+                              α3 -> Type *)
+
+R11f3 is universe polymorphic
+R11f3 is a projection of R11
+Arguments R11f3 r
+R11f3 is transparent
+Expands to: Constant sort_poly_elab.Records.R11f3
+Declared in library sort_poly_elab, line 674, characters 4-9
+R12@{α α0 ; } : Type@{α ; Set}
+(* α α0 ;  |= α0 -> Type *)
+
+R12 is universe polymorphic
+R12@{α α0 ; } may only be eliminated to produce values whose type is in sort quality α,
+  unless instantiated such that the qualities α0, Prop and Type
+  are equal to the instantiation of α, or to qualities smaller
+  (SProp <= Prop <= Type, and all variables <= Type)
+  than the instantiation of α.
+Expands to: Inductive sort_poly_elab.Records.R12
+Declared in library sort_poly_elab, line 693, characters 9-12
+R12f1@{α α0 ; } :
+forall _ : R12@{α α0 ; }, bool@{α0 ; }
+(* α α0 ;  |= α -> α0
+              α0 -> Type *)
+
+R12f1 is universe polymorphic
+R12f1 is a projection of R12
+Arguments R12f1 r
+R12f1 is transparent
+Expands to: Constant sort_poly_elab.Records.R12f1
+Declared in library sort_poly_elab, line 694, characters 4-9
+R12f2@{α α0 ; } :
+forall r : R12@{α α0 ; },
+let f' : forall _ : nat, nat :=
+  fix F (n : nat) : nat :=
+    match R12f1@{α α0 ; } r return nat with
+    | true => n
+    | false => O
+    end
+  in
+match f' O return Set with
+| O => bool@{Type ; }
+| S _ => nat
+end
+(* α α0 ;  |= α -> α0
+              α -> Type
+              α0 -> Type *)
+
+R12f2 is universe polymorphic
+R12f2 is a projection of R12
+Arguments R12f2 r
+R12f2 is transparent
+Expands to: Constant sort_poly_elab.Records.R12f2
+Declared in library sort_poly_elab, line 695, characters 4-9
+R13@{α α0 α1 α2 ; u u0} :
+Type@{α ; max(Set,u+1,u0+1)}
+(* α α0 α1 α2 ; u u0 |= α1 -> Type
+                        α2 -> Type,
+                        u0 <= u *)
+
+R13 is universe polymorphic
+R13@{α α0 α1 α2 ; u u0} may only be eliminated to produce values whose type is in sort quality α,
+  unless instantiated such that the qualities α0, α1, Prop and Type
+  are equal to the instantiation of α, or to qualities smaller
+  (SProp <= Prop <= Type, and all variables <= Type)
+  than the instantiation of α.
+Expands to: Inductive sort_poly_elab.Records.R13
+Declared in library sort_poly_elab, line 710, characters 9-12
+R13f1@{α α0 α1 α2 ; u u0} :
+forall _ : R13@{α α0 α1 α2 ; u u0}, Type@{α0 ; u}
+(* α α0 α1 α2 ; u u0 |= α -> Type
+                        α1 -> Type
+                        α2 -> Type,
+                        u0 <= u *)
+
+R13f1 is universe polymorphic
+R13f1 is a projection of R13
+Arguments R13f1 r
+R13f1 is transparent
+Expands to: Constant sort_poly_elab.Records.R13f1
+Declared in library sort_poly_elab, line 711, characters 4-9
+R13f2@{α α0 α1 α2 ; u u0} :
+forall _ : R13@{α α0 α1 α2 ; u u0}, Type@{α0 ; u0}
+(* α α0 α1 α2 ; u u0 |= α -> Type
+                        α1 -> Type
+                        α2 -> Type,
+                        u0 <= u *)
+
+R13f2 is universe polymorphic
+R13f2 is a projection of R13
+Arguments R13f2 r
+R13f2 is transparent
+Expands to: Constant sort_poly_elab.Records.R13f2
+Declared in library sort_poly_elab, line 712, characters 4-9
+R13f3@{α α0 α1 α2 ; u u0} :
+forall _ : R13@{α α0 α1 α2 ; u u0}, bool@{α1 ; }
+(* α α0 α1 α2 ; u u0 |= α -> α1
+                        α1 -> Type
+                        α2 -> Type,
+                        u0 <= u *)
+
+R13f3 is universe polymorphic
+R13f3 is a projection of R13
+Arguments R13f3 r
+R13f3 is transparent
+Expands to: Constant sort_poly_elab.Records.R13f3
+Declared in library sort_poly_elab, line 713, characters 4-9
+R13f4@{α α0 α1 α2 ; u u0} :
+forall (r : R13@{α α0 α1 α2 ; u u0}) (b : bool@{α2 ; }),
+match b return Type@{α0 ; u} with
+| true =>
+    match R13f3@{α α0 α1 α2 ; u u0} r return Type@{α0 ; u} with
+    | true => R13f1@{α α0 α1 α2 ; u u0} r
+    | false => R13f2@{α α0 α1 α2 ; u u0} r
+    end
+| false => bool@{α0 ; }
+end
+(* α α0 α1 α2 ; u u0 |= α -> α0
+                        α -> α1
+                        α -> Type
+                        α1 -> Type
+                        α2 -> Type,
+                        u0 <= u *)
+
+R13f4 is universe polymorphic
+R13f4 is a projection of R13
+Arguments R13f4 r b
+R13f4 is transparent
+Expands to: Constant sort_poly_elab.Records.R13f4
+Declared in library sort_poly_elab, line 714, characters 4-9
+C1@{α α0 ; u} : forall _ : Type@{α ; u}, Type@{α0 ; u}
+(* α α0 ; u |=  *)
+
+C1 is universe polymorphic
+C1@{α α0 ; u} may only be eliminated to produce values whose type is in sort quality α0,
+  unless instantiated such that the qualities α and Prop
+  are equal to the instantiation of α0, or to qualities smaller
+  (SProp <= Prop <= Type, and all variables <= Type)
+  than the instantiation of α0.
+Arguments C1 A%_type_scope
+Expands to: Inductive sort_poly_elab.Classes.C1
+Declared in library sort_poly_elab, line 749, characters 8-10
+C1f1@{α α0 ; u} :
+forall {A : Type@{α ; u}} {_ : C1@{α α0 ; u} A}, A
+(* α α0 ; u |= α0 -> α *)
+
+C1f1 is universe polymorphic
+C1f1 is a projection of C1
+Arguments C1f1 {A}%_type_scope {C1}
+C1f1 is transparent
+Expands to: Constant sort_poly_elab.Classes.C1f1
+Declared in library sort_poly_elab, line 750, characters 4-8
+C1I1@{α α0 ; u} : C1@{α α0 ; u} unit@{α ; u}
+(* α α0 ; u |=  *)
+
+C1I1 is universe polymorphic
+C1I1 is transparent
+Expands to: Constant sort_poly_elab.Classes.C1I1
+Declared in library sort_poly_elab, line 757, characters 11-15
+C1ProgramI1@{α α0 ; u} : C1@{α α0 ; u} unit@{α ; u}
+(* α α0 ; u |=  *)
+
+C1ProgramI1 is universe polymorphic
+C1ProgramI1 is transparent
+Expands to: Constant sort_poly_elab.Classes.C1ProgramI1
+Declared in library sort_poly_elab, line 760, characters 19-30
+C1RefineI1@{α α0 ; u} : C1@{α α0 ; u} unit@{α ; u}
+(* α α0 ; u |=  *)
+
+C1RefineI1 is universe polymorphic
+C1RefineI1 is transparent
+Expands to: Constant sort_poly_elab.Classes.C1RefineI1
+Declared in library sort_poly_elab, line 767, characters 11-21
+C1InteractiveI1@{α α0 ; u} : C1@{α α0 ; u} unit@{α ; u}
+(* α α0 ; u |=  *)
+
+C1InteractiveI1 is universe polymorphic
+C1InteractiveI1 is transparent
+Expands to: Constant sort_poly_elab.Classes.C1InteractiveI1
+Declared in library sort_poly_elab, line 772, characters 11-26
+C1AxiomaticI1@{α α0 ; u} : C1@{α α0 ; u} unit@{α ; u}
+(* α α0 ; u |=  *)
+
+C1AxiomaticI1 is universe polymorphic
+Expands to: Constant sort_poly_elab.Classes.C1AxiomaticI1
+Declared in library sort_poly_elab, line 776, characters 9-22
+C1InductiveI1@{α ; u} : Type@{α ; u}
+(* α ; u |=  *)
+
+C1InductiveI1 is universe polymorphic
+C1InductiveI1@{α ; u} may only be eliminated to produce values whose type is in sort quality α,
+  unless instantiated such that the quality Prop
+  is equal to the instantiation of α, or to qualities smaller
+  (SProp <= Prop <= Type, and all variables <= Type)
+  than the instantiation of α.
+Expands to: Inductive sort_poly_elab.Classes.C1InductiveI1
+Declared in library sort_poly_elab, line 780, characters 12-25
+File "./output/sort_poly_elab.v", line 789, characters 0-76:
+The command has indeed failed with message:
+Sort metavariables must be collapsed to Type in universe monomorphic constructions.
+Attr@{α ; u} : Type@{α ; u}
+(* α ; u |=  *)
+
+Attr is universe polymorphic
+Attr@{α ; u} may only be eliminated to produce values whose type is in sort quality α,
+  unless instantiated such that the quality Prop
+  is equal to the instantiation of α, or to qualities smaller
+  (SProp <= Prop <= Type, and all variables <= Type)
+  than the instantiation of α.
+Expands to: Inductive sort_poly_elab.Attr
+Declared in library sort_poly_elab, line 793, characters 10-14
diff --git a/test-suite/output/sort_poly_elab.v b/test-suite/output/sort_poly_elab.v
new file mode 100644
index 000000000000..9907f7cdf9ed
--- /dev/null
+++ b/test-suite/output/sort_poly_elab.v
@@ -0,0 +1,794 @@
+Set Universe Polymorphism.
+Unset Collapse Sorts ToType.
+Set Printing Universes.
+Set Printing Sort Qualities.
+Set Printing All.
+Set Warnings "-native-compiler-disabled".
+
+Module Reduction.
+
+  Definition qsort := Type.
+  (* qsort@{α ; u |} = Type@{α ; u} : Type@{u+1} *)
+  About qsort.
+
+  Definition qsort' : Type := Type.
+  (* qsort'@{α ; u u0 |} = Type@{α ; u0} : Type@{u} *)
+  About qsort'.
+
+  Monomorphic Universe U.
+
+  Definition tU := Type@{U}.
+  Definition qU := qsort@{Type ; U}.
+
+  Definition q1 := Eval lazy in qU.
+  Check eq_refl : q1 = tU.
+
+  Definition q2 := Eval vm_compute in qU.
+  Check eq_refl : q2 = tU.
+
+  Definition q3 := Eval native_compute in qU.
+  Check eq_refl : q3 = tU.
+
+  Definition exfalso (A:Type) (H:False) : A := match H with end.
+  (* exfalso@{α ; u |} : forall A : Type@{α ; _}, False -> A *)
+  About exfalso.
+
+  Definition exfalsoVM := Eval vm_compute in exfalso@{Type;Set}.
+  Definition exfalsoNative := Eval native_compute in exfalso@{Type;Set}.
+
+  Fixpoint iter (A:Type) (f:A -> A) n x :=
+    match n with
+    | 0 => x
+    | S k => iter A f k (f x)
+    end.
+  (* iter@{α ; u |} : forall (A : Type@{α ; u}) (_ : forall _ : A, A) (_ : nat) (_ : A), A *)
+  About iter.
+
+  Definition iterType := Eval lazy in iter@{Type;_}.
+  Definition iterSProp := Eval lazy in iter@{SProp;_}.
+
+End Reduction.
+
+Module Conversion.
+
+  Inductive Box (A:Type) := box (_:A).
+  (* Box@{α α0 ; u |} (A : Type@{α ; u}) : Type@{α0 ; u} *)
+  About Box.
+
+  Definition t1 (A:Type) (x y : A) := box _ x.
+  (* t1@{α α0 ; u |} : forall (A : Type@{α ; u}) (_ : A) (_ : A), Box@{α α0 ; u} A *)
+  About t1.
+
+  Definition t2 (A:Type) (x y : A) := box _ y.
+  (* t2@{α α0 ; u |} : forall (A : Type@{α ; u}) (_ : A) (_ : A), Box@{α α0 ; u} A *)
+  About t2.
+
+  Definition t1' (A:Type) (x y : A) := x.
+  (* t1'@{α ; u |} : forall (A : Type@{α ; u}) (_ : A) (_ : A), A *)
+  About t1'.
+
+  Definition t2' (A:Type) (x y : A) := y.
+  About t2'.
+
+  Fail Check eq_refl : t1 nat = t2 nat.
+  Fail Check eq_refl : t1' nat = t2' nat.
+
+  Check fun A:SProp => eq_refl : t1 A = t2 A.
+  (* : forall A : SProp,
+       @eq (forall (_ : A) (_ : A), Box@{SProp Type ; sort_poly_elab.475} A)
+         (t1@{SProp Type ; sort_poly_elab.475} A)
+         (t2@{SProp Type ; sort_poly_elab.475} A) *)
+
+  Check fun A:SProp => eq_refl : box _ (t1' A) = box _ (t2' A).
+  (* : forall A : SProp,
+       @eq
+         (Box@{SProp Type ; sort_poly_elab.479} (forall (_ : A) (_ : A), A))
+         (box@{SProp Type ; sort_poly_elab.479} (forall (_ : A) (_ : A), A)
+            (t1'@{SProp ; sort_poly_elab.480} A))
+         (box@{SProp Type ; sort_poly_elab.479} (forall (_ : A) (_ : A), A)
+            (t2'@{SProp ; sort_poly_elab.482} A)) *)
+
+  Definition ignore {A:Type} (x:A) := tt.
+  (* ignore@{α ; u |} : forall {A : Type@{α ; u}} (_ : A), unit *)
+  About ignore.
+
+  Definition unfold_ignore (A:Type) : ignore (t1 A) = ignore (t2 A) := eq_refl.
+  (* unfold_ignore@{α α0 α1 ; u |} : forall A : Type@{α ; u},
+       @eq unit
+         (@ignore@{α0 ; u} (forall (_ : A) (_ : A), Box@{α α0 ; u} A)
+            (t1@{α α0 ; u} A))
+         (@ignore@{α1 ; u} (forall (_ : A) (_ : A), Box@{α α1 ; u} A)
+            (t2@{α α1 ; u} A)) *)
+  About unfold_ignore.
+
+  Definition t (A:SProp) := Eval lazy in t1 A.
+  (* t@{α ; u |} : forall (A : SProp) (_ : A) (_ : A), Box@{SProp α ; u} A *)
+  About t.
+
+  Axiom v : forall (A:Type), bool -> A.
+  About v.
+  Fail Check fun P (x:P (v@{Type;_} nat true)) => x : P (v nat false).
+  Check fun (A:SProp) P (x:P (v A true)) => x : P (v A false).
+    (* : forall (A : SProp) (P : A -> Type@{sort_poly_elab.105}),
+       P (v@{SProp ; sort_poly_elab.104} A true) ->
+       P (v@{SProp ; sort_poly_elab.106} A false) *)
+End Conversion.
+
+Module Inference.
+  Definition zog (A:Type) := A.
+  (* zog@{α ; u |} : Type@{α ; _} -> Type@{α ; _} *)
+  About zog.
+
+  (* implicit instance of zog gets a variable which then gets unified with s from the type of A *)
+  Definition zag (A:Type) := zog A.
+  (* zag@{α ; u |} : Type@{α ; _} -> Type@{α ; _} *)
+  About zag.
+
+  (* implicit type of A gets unified to Type@{s;u} *)
+  Definition zig A := zog A.
+  (* zig@{α ; u |} : Type@{α ; _} -> Type@{α ; _} *)
+  About zig.
+
+  (* different manually bound sort variables don't unify *)
+  Fail Definition zog'@{s s'; |} (A:Type@{s;Set}) := zog@{s';Set} A.
+End Inference.
+
+Module Inductives.
+  Inductive implicit :=.
+  (* implicit@{α ; u} : Type@{α ; _} *)
+  About implicit.
+
+  Inductive foo1 : Type := .
+  (* foo1@{α ; u |} : Type@{α ; _} :=  . *)
+  About foo1.
+  Fail Check foo1_sind.
+  (* The reference foo1_sind was not found in the current environment. Did you mean bool_sind, prod_sind, or_sind or bool_ind? *)
+
+  (* Fails if constraints cannot be extended *)
+  Fail Definition foo1_False@{s;+|} (x : foo1@{s;_}) : False := match x return False with end.
+  (* Elimination constraints are not implied by the ones declared: s -> Prop *)
+
+  (* Explicitly allowing extending the constraints *)
+  Definition foo1_False@{s;+|+} (x : foo1@{s;_}) : False := match x return False with end.
+  (* s ; u |= s -> Prop *)
+  About foo1_False.
+
+  (* Fully implicit qualities and constraints *)
+  Definition foo1_False' (x : foo1) : False := match x return False with end.
+  (* foo1_False'@{α ; u |} : foo1@{α ; u} -> False *)
+  (* α ; u |= α -> Prop *)
+  About foo1_False'.
+
+  Inductive foo2 := Foo2 : Type -> foo2.
+  (* foo2@{α ; u |} : Type@{α ; u+1} *)
+  About foo2.
+  Fail Check foo2_rect.
+  (* The reference foo2_rect was not found in the current environment. Did you mean bool_rect, sig2_rect, prod_rect, ex2_rect or bool_rec? *)
+
+  Inductive foo3 A := Foo3 : A -> foo3 A.
+  (* foo3@{α α0 ; u |} (A : Type@{α0 ; u}) : Type@{α ; u} *)
+  About foo3.
+  Fail Check foo3_rect.
+  (* The reference foo3_rect was not found in the current environment. Did you mean bool_rect, prod_rect or bool_rec? *)
+
+  Inductive foo5 (A : Type) : Prop := Foo5 (_ : A).
+  (* foo5@{α ; u} : Type@{α ; u} -> Prop *)
+  About foo5.
+
+  Definition foo5_ind' : forall (A : Type) (P : Prop), (A -> P) -> foo5 A -> P
+    := foo5_ind.
+  About foo5_ind'.
+
+  Definition foo5_Prop_rect (A:Prop) (P:foo5 A -> Type)
+    (H : forall a, P (Foo5 A a))
+    (f : foo5 A)
+    : P f
+    := match f with Foo5 _ a => H a end.
+  (* foo5_Prop_rect@{α ; u} :
+    forall (A : Prop) (P : foo5@{Type ; Set} A -> Type@{α ; u}),
+    (forall a : A, P (Foo5@{Type ; Set} A a)) -> forall f : foo5@{Type ; Set} A, P f *)
+  (* α ; u |= Prop -> α *)
+  About foo5_Prop_rect.
+
+  Definition foo5_Prop_rect' (A : Prop) (P : foo5 A -> Type)
+    (H : forall a, P (Foo5 A a))
+    (f : foo5@{Prop;_} A)
+    : P f
+    := match f with Foo5 _ a => H a end.
+  (* foo5_Prop_rect'@{α ; u} :
+    forall (A : Prop) (P : foo5@{Prop ; Set} A -> Type@{α ; u}),
+    (forall a : A, P (Foo5@{Prop ; Set} A a)) -> forall f : foo5@{Prop ; Set} A, P f *)
+  (* α ; u |=  *)
+  About foo5_Prop_rect'.
+
+  Inductive foo6 : Type := Foo6.
+  About foo6.
+  Fail Check foo6_sind.
+  (* The reference foo6_sind was not found in the current environment. Did you mean foo5_sind, foo5_ind, bool_sind, prod_sind, or_sind, foo5_ind' or bool_ind? *)
+
+  Definition foo6_rect (P:foo6 -> Type)
+    (H : P Foo6)
+    (f : foo6)
+    : P f
+    := match f with Foo6 => H end.
+  (* foo6_rect@{α α0 ; u u0} : forall P : foo6@{α0 ; u} -> Type@{α ; u0}, P Foo6@{α0 ; u} -> forall f : foo6@{α0 ; u}, P f *)
+  (* α α0 ; u u0 |= α0 -> α *)
+  About foo6_rect.
+
+  Definition foo6_prop_rect (P:foo6 -> Type)
+    (H : P Foo6)
+    (f : foo6@{Prop;_})
+    : P f
+    := match f with Foo6 => H end.
+  (* foo6_prop_rect@{α ; u u0} : forall P : foo6@{Prop ; u} -> Type@{α ; u0}, P Foo6@{Prop ; u} -> forall f : foo6@{Prop ; u}, P f *)
+  (* α ; u u0 |=  *)
+  About foo6_prop_rect.
+
+  Definition foo6_type_rect (P:foo6 -> Type)
+    (H : P Foo6)
+    (f : foo6@{Type;_})
+    : P f
+    := match f with Foo6 => H end.
+  (* foo6_type_rect@{α ; u u0} : forall P : foo6@{Type ; u} -> Type@{α ; u0}, P Foo6@{Type ; u} -> forall f : foo6@{Type ; u}, P f *)
+  (* α ; u u0 |=  *)
+  About foo6_type_rect.
+
+  Inductive foo7 : Type := Foo7_1 | Foo7_2.
+  About foo7.
+  Fail Check foo7_sind.
+  Fail Check foo7_ind.
+
+  Definition foo7_prop_ind (P:foo7 -> Prop)
+    (H : P Foo7_1) (H' : P Foo7_2)
+    (f : foo7@{Prop;})
+    : P f
+    := match f with Foo7_1 => H | Foo7_2 => H' end.
+  About foo7_prop_ind.
+
+  Definition foo7_prop_rect (P:foo7 -> Type)
+    (H : P Foo7_1) (H' : P Foo7_2)
+    (f : foo7@{Prop;})
+    : P f
+    := match f with Foo7_1 => H | Foo7_2 => H' end.
+  About foo7_prop_rect.
+
+  (*********************************************)
+  (*                 SIGMA                     *)
+  (*********************************************)
+  Inductive sigma (A:Type) (B:A -> Type) : Type
+    := pair : forall x : A, B x -> sigma A B.
+  (* Inductive sigma@{α α0 α1 ; u u0 |} (A : Type@{α ; u}) (B : A -> Type@{α0 ; u0}) : Type@{α1 ; max(u,u0)} *)
+  About sigma.
+
+  Definition sigma_srect A B
+    (P : sigma A B -> Type)
+    (H : forall x b, P (pair _ _ x b))
+    (s:sigma A B)
+    : P s
+    := match s with pair _ _ x b => H x b end.
+  (* α α0 α1 α2 ; u u0 u1 |= α2 -> α *)
+  About sigma_srect.
+
+  (* Elimination constraints are added *)
+  Definition pr1 {A B} (s:sigma A B) : A
+    := match s with pair _ _ x _ => x end.
+  (* α α0 α1 ; u u0 |= α1 -> α *)
+  About pr1.
+
+  Definition pr2 {A B} (s:sigma A B) : B (pr1 s)
+    := match s with pair _ _ _ y => y end.
+  (* α α0 α1 ; u u0 |= α1 -> α
+                       α1 -> α0 *)
+  About pr2.
+
+
+  Definition π1 {A:Type} {P:A -> Type} (p : sigma@{Type _ _;_ _} A P) : A :=
+    match p return A with pair _ _ a _ => a end.
+  (* α α0 ; u u0 |= α0 -> Type *)
+  About π2.
+
+  (*********************************************)
+  (*                   EQ                      *)
+  (*********************************************)
+  Inductive seq (A:Type) (a:A) : A -> Prop := seq_refl : seq A a a.
+  (* Inductive seq@{α ; u |} (A : Type@{α ; u}) (a : A) : A -> Prop *)
+  Arguments seq_refl {_ _}.
+  About seq.
+
+  Definition eta A B (s:sigma A B) : seq _ s (pair A B (pr1 s) (pr2 s)).
+  Proof.
+    destruct s. simpl. reflexivity.
+  Qed.
+  About eta.
+
+  (*********************************************)
+  (*                   SUM                     *)
+  (*********************************************)
+  Inductive sum (A B : Type) : Type :=
+  | inl : A -> sum A B
+  | inr : B -> sum A B.
+  (* sum@{α α0 α1 ; u u0} : Type@{α ; u} -> Type@{α0 ; u0} -> Type@{α1 ; max(Set,u,u0)} *)
+  (* α α0 α1 ; u u0 |=  *)
+  About sum.
+
+  Arguments inl {A B} _ , [A] B _.
+  Arguments inr {A B} _ , A [B] _.
+
+  (* Elimination constraint left explicitly empty. Definition fails because of missing constraint. *)
+  Fail Definition sum_elim@{sl sr s0 s0';ul ur v|}
+    (A : Type@{sl;ul}) (B : Type@{sr;ur}) (P : sum@{sl sr s0;ul ur} A B -> Type@{s0';v})
+    (fl : forall a, P (inl a)) (fr : forall b, P (inr b)) (x : sum@{sl sr s0;ul ur} A B) :=
+    match x with
+    | inl a => fl a
+    | inr b => fr b
+    end.
+  (* The command has indeed failed with message:
+  Elimination constraints are not implied by the ones declared: s0->s0' *)
+
+  (* Leaving them implicit *)
+  Definition sum_elim (A B : Type) (P : sum A B -> Type)
+    (fl : forall a, P (inl a)) (fr : forall b, P (inr b)) (x : sum A B) :=
+    match x with
+    | inl a => fl a
+    | inr b => fr b
+    end.
+  (* α α0 α1 α2 ; u u0 u1 |= α2 -> α *)
+  About sum_elim.
+
+  Definition sum_sind := sum_elim@{Type Type Type SProp;_ _ _}.
+  Definition sum_rect := sum_elim@{Type Type Type Type;_ _ _}.
+  Definition sum_ind := sum_elim@{Type Type Type Prop;_ _ _}.
+
+  Definition or_ind := sum_elim@{Prop Prop Prop Prop;_ _ _}.
+  Definition or_sind := sum_elim@{Prop Prop Prop SProp;_ _ _}.
+  Fail Definition or_rect := sum_elim@{Prop Prop Prop Type;_ _ _}.
+  (* The command has indeed failed with message:
+  The quality constraints are inconsistent: cannot enforce Prop -> Type because it would identify Type and Prop which is inconsistent.
+  This is introduced by the constraints Prop -> Type *)
+
+  Definition sumor := sum@{Type Prop Type;_ _}.
+
+  Definition sumor_sind := sum_elim@{Type Prop Type SProp;_ _ _}.
+  Definition sumor_rect := sum_elim@{Type Prop Type Type;_ _ _}.
+  Definition sumor_ind := sum_elim@{Type Prop Type Prop;_ _ _}.
+
+  (* Implicit qualities and constraints are elaborated *)
+  Definition idT (A B : Type) (x : sum A B)
+    : sum@{_ _ Type; _ _} A B :=
+    match x with
+    | inl a => inl a
+    | inr b => inr b
+    end.
+  (* α α0 α1 ; u u0 |= α -> Type *)
+  About idT.
+
+  (* Implicit qualities and constraints are elaborated *)
+  Definition idP (A B : Type) (x : sum A B)
+    : sum@{_ _ Prop; _ _} A B :=
+    match x with
+    | inl a => inl a
+    | inr b => inr b
+    end.
+  (* α α0 α1 ; u u0 |= α -> Prop *)
+  About idP.
+
+  (* Implicit qualities and constraints are elaborated *)
+  Definition idS (A B : Type) (x : sum A B)
+    : sum@{_ _ SProp; _ _} A B :=
+    match x with
+    | inl a => inl a
+    | inr b => inr b
+    end.
+  (* α α0 α1 ; u u0 |= α -> Prop *)
+  About idS.
+
+  (* Implicit qualities and constraints are elaborated *)
+  Definition idV (A B : Type) (x : sum A B)
+    : sum A B :=
+    match x with
+    | inl a => inl a
+    | inr b => inr b
+    end.
+  (* α α0 α1 α2 ; u u0 |= α -> α2 *)
+  About idV.
+
+  Fail Compute idV@{Prop Type Prop Type;Set Set} (inl I).
+
+  (*********************************************)
+  (*                  LIST                     *)
+  (*********************************************)
+  Inductive list (A : Type) : Type :=
+  | nil : list A
+  | cons : A -> list A -> list A.
+  About list.
+
+  Arguments nil {A}.
+  Arguments cons {A} _ _.
+
+  Definition list_elim
+    (A : Type) (P : list A -> Type)
+    (fn : P nil) (fc : forall (x : A) (l : list A), P l -> P (cons x l)) :=
+    fix F (l : list A) : P l :=
+      match l with
+      | nil => fn
+      | cons x l => fc x l (F l)
+      end.
+  (* α α0 α1 ; u u0 |= α1 -> α *)
+  About list_elim.
+
+  Fixpoint list_idT {A : Type} (l : list A) : list@{_ Type;_} A :=
+    match l with
+    | nil => nil
+    | cons x l => cons x (list_idT l)
+    end.
+  (* α α0 ; u |= α -> Type *)
+  About list_idT.
+
+  Fixpoint list_idP {A : Type} (l : list A) : list@{_ Prop;_} A :=
+    match l with
+    | nil => nil
+    | cons x l => cons x (list_idP l)
+    end.
+  (* α α0 ; u |= α -> Prop *)
+  About list_idP.
+
+  Fixpoint list_idS {A : Type} (l : list A) : list@{_ SProp;_} A :=
+    match l with
+    | nil => nil
+    | cons x l => cons x (list_idS l)
+    end.
+  (* α α0 ; u |= α -> SProp *)
+  About list_idS.
+
+  Fixpoint map A B f (l : list A) : list B :=
+    match l with
+    | nil => nil
+    | cons x l' => cons (f x) (map A B f l')
+    end.
+  (* map@{α α0 α1 α2 ; u u0} :
+      forall (A : Type@{α ; u}) (B : Type@{α1 ; u0}) (_ : forall _ : A, B)
+      (_ : list@{α α0 ; u} A), list@{α1 α2 ; u0} B *)
+  (* α α0 α1 α2 ; u u0 |= α0 -> α2 *)
+  About map.
+
+  (*********************************************)
+  (*                  FALSE                    *)
+  (*********************************************)
+  Inductive False' : Type :=.
+  (* False'@{α ; u} : Type@{α ; u} *)
+  About False'.
+
+  Definition False'_False (x : False') : False := match x return False with end.
+  (* α ; u |= α -> Prop *)
+  About False'_False.
+
+  (*********************************************)
+  (*                  BOOL                     *)
+  (*********************************************)
+  Inductive bool : Type := true | false.
+  About bool.
+
+  Definition bool_to_Prop (b : bool) : Prop.
+  Proof.
+    destruct b.
+    - exact True.
+    - exact False.
+  Defined.
+  (* α ;  |= α -> Type *)
+  About bool_to_Prop.
+
+  Definition bool_to_True_conj (b : bool) : True \/ True.
+  Proof.
+    destruct b.
+    - exact (or_introl I).
+    - exact (or_intror I).
+  Defined.
+  (* α ;  |= α -> Prop *)
+  About bool_to_True_conj.
+
+  (* Using Program *)
+  Program Definition bool_to_Prop' (b : bool) : Prop := _.
+  Next Obligation.
+    intro b; destruct b.
+    - exact True.
+    - exact False.
+  Defined.
+  (* α ;  |= α -> Type *)
+  About bool_to_Prop'.
+
+  #[universes(polymorphic=no)]
+  Sort Test.
+  (* Sort variables not instantiated *)
+  Fail Check (match true@{Test;} return ?[P] with true => tt | false => tt end).
+  (* Incorrect elimination of "true@{Test ; }" in the inductive type "bool@{Test ; }":
+  the return type has sort "Set" while it should be in a sort Test eliminates to.
+  Elimination of a sort polymorphic inductive object instantiated to a variable sort quality
+  is only allowed on itself or with an explicit elimination constraint to the target sort. *)
+
+  (*********************************************)
+  (*                  UNIT                     *)
+  (*********************************************)
+  Inductive unit : Type := tt.
+  (* unit@{α ; u} : Type@{α ; u} *)
+  About unit.
+
+  (*********************************************)
+  (*                  MISC                     *)
+  (*********************************************)
+  (* Interactive definition *)
+  Inductive FooNat :=
+  | FO : FooNat
+  | FS : FooNat -> FooNat.
+  About FooNat.
+
+  Definition Foo (n : FooNat) : FooNat.
+    destruct n.
+    - exact FO.
+    - exact FO.
+  Defined.
+  About Foo.
+
+  Check Foo@{Type Prop;}.
+  Fail Check Foo@{Prop Type;}.
+End Inductives.
+
+Module Records.
+
+  Set Primitive Projections.
+  Set Warnings "+records".
+
+  (* the SProp instantiation may not be primitive so the whole thing must be nonprimitive *)
+  Fail Record R1 : Type := {}.
+
+  Record R2 (A:SProp) : Type := { R2f1 : A }.
+  (* R2@{α ; u} : SProp -> Type@{α ; _} *)
+  About R2.
+
+  Record R3 (A:Type) : Type := { R3f1 : A }.
+  (* R3@{α α0 ; u} : forall _ : Type@{α ; u}, Type@{α0 ; u} *)
+  (* α α0 ; u |= α0 -> α *)
+  About R3.
+
+  Record R4@{s; |} (A:Type@{s;Set}) : Type@{s;Set} := { R4f1 : A}.
+  About R4.
+
+  (* non SProp instantiation must be squashed *)
+  Fail Record R5 (A:Type) : SProp := { R5f1 : A}.
+  #[warnings="-non-primitive-record"]
+    Record R5 (A:Type) : SProp := { R5f1 : A}.
+  (* R5@{α ; u} : forall _ : Type@{α ; u}, SProp *)
+  (* α ; u |= SProp -> α *)
+  About R5.
+
+  Record R6@{s; |+} (A:Type@{s;Set}) : Set := { R6f1 : A; R6f2 : nat }.
+  About R6.
+
+  Check fun (A:SProp) (x y : R6 A) =>
+          eq_refl : Conversion.box _ x.(R6f1 _) = Conversion.box _ y.(R6f1 _).
+  Fail Check fun (A:Prop) (x y : R6 A) =>
+          eq_refl : Conversion.box _ x.(R6f1 _) = Conversion.box _ y.(R6f1 _).
+  Fail Check fun (A:SProp) (x y : R6 A) =>
+          eq_refl : Conversion.box _ x.(R6f2 _) = Conversion.box _ y.(R6f2 _).
+
+  (* Elimination constraints are added specifically for each projection *)
+  #[projections(primitive=no)] Record R7 (A:Type) := { R7f1 : A; R7f2 : nat }.
+  (* Record R7@{α α0 ; u |} (A : Type@{α ; u}) : Type@{α0 ; max(Set,u)}  *)
+  (* R7f1@{α α0 ; u |} : forall A : Type@{α ; u}, R7@{α α0 ; u} A -> A
+      α α0 ; u |= α0 -> α *)
+  (* R7f2@{α α0 ; u |} : forall A : Type@{α ; u}, R7@{α α0 ; u} A -> nat
+      α α0 ; u |= α0 -> Type *)
+  About R7.
+  About R7f1.
+  About R7f2.
+
+  (* sigma as a primitive record works better *)
+  Record Rsigma@{s;u v|} (A:Type@{s;u}) (B:A -> Type@{s;v}) : Type@{s;max(u,v)}
+    := Rpair { Rpr1 : A; Rpr2 : B Rpr1 }.
+  About Rsigma.
+
+  (* match desugared to primitive projections using definitional eta *)
+  Definition Rsigma_srect A B
+    (P : Rsigma A B -> Type)
+    (H : forall x b, P (Rpair _ _ x b))
+    (s:Rsigma A B)
+    : P s
+    := match s with Rpair _ _ x b => H x b end.
+  (* Rsigma_srect@{α α0 ; u u0 u1 |} : forall (A : Type@{α0 ; _}) (B : A -> Type@{α0 ; _})
+         (P : Rsigma A B -> Type@{α ; _}),
+       (forall (x : A) (b : B x), P {| Rpr1 := x; Rpr2 := b |}) ->
+       forall s : Rsigma A B, P s *)
+  About Rsigma_srect.
+
+  (* sort polymorphic exists (we could also make B sort poly)
+     can't be a primitive record since the first projection isn't defined at all sorts *)
+  Inductive sexists (A:Type) (B:A -> Prop) : Prop
+    := sexist : forall a:A, B a -> sexists A B.
+  About sexists.
+
+  (* we can eliminate to Prop *)
+  Check sexists_ind.
+
+  Unset Primitive Projections.
+
+  (* Elimination constraints are added specifically for each projection *)
+  Record R8 := {
+    R8f1 : Type;
+    R8f2 : R8f1
+  }.
+  (* Record R8@{α α0 ; u |} : Type@{α ; u+1}. *)
+  (* R8f1@{α α0 ; u |} : R8@{α α0 ; u} -> Type@{α0 ; u}
+      α α0 ; u |= α -> Type *)
+  (* R8f2@{α α0 ; u |} : forall r : R8@{α α0 ; u}, R8f1@{α α0 ; u} r
+      α α0 ; u |= α -> α0
+                  α -> Type *)
+  About R8.
+  About R8f1.
+  About R8f2.
+
+  Inductive eq {A} x : A -> Type :=
+  eq_refl : eq x x.
+
+  Inductive bool := true | false.
+
+  (* Elimination constraints are added specifically for each projection *)
+  Record R9 := {
+    R9f1 : bool ;
+    R9f2 : bool ;
+  }.
+  (* R9@{α α0 α1 ; } : Type@{α ; Set} *)
+  (* R9f1@{α α0 α1 ; } : forall _ : R9@{α α0 α1 ; }, bool@{α0 ; } *)
+        (* α α0 α1 ;  |= α -> α0 *)
+  (* R9f2@{α α0 α1 ; } : forall _ : R9@{α α0 α1 ; }, bool@{α1 ; } *)
+        (* α α0 α1 ;  |= α -> α1 *)
+  About R9.
+  About R9f1.
+  About R9f2.
+
+  (* Elimination constraints are added specifically for each projection *)
+  Record R10 (A : Type) := {
+    R10f1 : A ;
+    R10f2 : eq R10f1 R10f1 ;
+    R10f3 : bool
+  }.
+  (* R10@{α α0 α1 α2 ; u u0} : forall _ : Type@{α0 ; u}, Type@{α ; max(Set,u,u0)} *)
+  (* R10f1@{α α0 α1 α2 ; u u0} : forall (A : Type@{α0 ; u}) (_ : R@{α α0 α1 α2 ; u u0} A), A *)
+     (* α α0 α1 α2 ; u u0 |= α -> α0 *)
+  (* R10f2@{α α0 α1 α2 ; u u0} : forall (A : Type@{α0 ; u}) (r : R@{α α0 α1 α2 ; u u0} A),
+                              @eq@{α0 α1 ; u u0} A (x@{α α0 α1 α2 ; u u0} A r) (x@{α α0 α1 α2 ; u u0} A r) *)
+     (* α α0 α1 α2 ; u u0 |= α -> α0
+                             α -> α1 *)
+  (* R10f3@{α α0 α1 α2 ; u u0} : forall (A : Type@{α0 ; u}) (_ : R@{α α0 α1 α2 ; u u0} A), bool@{α2 ; } *)
+     (* α α0 α1 α2 ; u u0 |= α -> α2 *)
+  About R10.
+  About R10f1.
+  About R10f2.
+  About R10f3.
+
+  Record R11 := {
+    R11f1 : bool ;
+    R11f2 : let r := {| R10f1 := true; R10f2 := eq_refl true ; R10f3 := R11f1 |} in
+         if R10f3 bool r then
+          bool
+        else
+          bool ;
+    R11f3 : bool
+  }.
+  (* R11@{α α0 α1 α2 α3 α4 α5 ; u} : Type@{α ; Set} *)
+       (* α α0 α1 α2 α3 α4 α5 ; u |= α0 -> α3
+                                     α3 -> Type *)
+  (* R11f2 : ... *)
+    (* α α0 α1 α2 α3 α4 α5 ; u |= α -> α3
+                              α -> α4
+                              α0 -> α3
+                              α3 -> Type *)
+  (* R11f3 : ... *)
+    (* α α0 α1 α2 α3 α4 α5 ; u |= α -> α5
+                              α0 -> α3
+                              α3 -> Type *)
+  About R11.
+  About R11f1.
+  About R11f2.
+  About R11f3.
+
+  Record R12 := {
+    R12f1 : bool ;
+    R12f2 : let f' :=
+          fix F n :=
+            if R12f1 then n else O
+        in
+        match f' O with
+        | O => bool
+        | S _ => nat
+        end
+        }.
+  About R12.
+  About R12f1.
+  About R12f2.
+
+ (* Elimination constraints added to the inductive itself and propagated to projections.
+    Elimination constraints of projections are specifically for each projection *)
+  Record R13 := {
+    R13f1 : Type ;
+    R13f2 : Type ;
+    R13f3 : bool;
+    R13f4 : forall (b : bool),
+          match b with
+          | true => match R13f3 with (* Depends on R13f3 *)
+                    | true => R13f1
+                    | false => R13f2
+                    end
+          | false => bool
+          end
+    }.
+   (* R13@{α α0 α1 α2 ; u u0} : Type@{α ; max(Set,u+1,u0+1)} *)
+       (* α α0 α1 α2 ; u u0 |= α1 -> Type
+                               α2 -> Type,
+                               u0 <= u *)
+  (* R13f3@{α α0 α1 α2 ; u u0} : forall _ : R'@{α α0 α1 α2 ; u u0}, bool@{α1 ; }  *)
+      (* α α0 α1 α2 ; u u0 |= α -> α1
+                              α1 -> Type
+                              α2 -> Type,
+                              u0 <= u *)
+  (* R13f4@{α α0 α1 α2 ; u u0} : ... *)
+      (* α α0 α1 α2 ; u u0 |= α -> α0
+                              α -> α1
+                              α -> Type
+                              α1 -> Type
+                              α2 -> Type,
+                              u0 <= u *)
+  About R13.
+  About R13f1.
+  About R13f2.
+  About R13f3.
+  About R13f4.
+
+End Records.
+
+Module Classes.
+
+  Class C1 (A : Type) : Type := {
+    C1f1 : A
+  }.
+  About C1.
+  About C1f1.
+
+  Inductive unit : Type := tt.
+
+  Instance C1I1 : C1 unit := { C1f1 := tt }.
+  About C1I1.
+
+  Program Instance C1ProgramI1 : C1 unit.
+  Next Obligation.
+    exact tt.
+  Defined.
+  About C1ProgramI1.
+
+  #[refine]
+  Instance C1RefineI1 : C1 unit := { C1f1 := _ }.
+  exact tt.
+  Defined.
+  About C1RefineI1.
+
+  Instance C1InteractiveI1 : C1 unit.
+  Proof. constructor. exact tt. Defined.
+  About C1InteractiveI1.
+
+  Axiom (C1AxiomaticI1 : C1 unit).
+  Existing Instance C1AxiomaticI1.
+  About C1AxiomaticI1.
+
+  Inductive C1InductiveI1 := mkInductive.
+  About C1InductiveI1.
+
+  Existing Class C1InductiveI1.
+
+End Classes.
+
+Unset Universe Polymorphism.
+Set Collapse Sorts ToType.
+Fail #[universes(collapse_sort_variables=no)]
+Inductive Attr : Type := attr.
+
+#[universes(polymorphic, collapse_sort_variables=no)]
+Inductive Attr : Type := attr.
+About Attr.
diff --git a/test-suite/success/sort_poly.v b/test-suite/success/sort_poly.v
index 4347f98cf567..d704caac3e51 100644
--- a/test-suite/success/sort_poly.v
+++ b/test-suite/success/sort_poly.v
@@ -172,6 +172,9 @@ Module Inductives.
     (f : foo6@{s';})
     : P f
     := match f with Foo6 => H end.
+  (* The command has indeed failed with message:
+     Elimination constraints are not implied by the ones declared:
+     s' -> s *)
 
   Inductive foo7@{s; |} : Type@{s;Set} := Foo7_1 | Foo7_2.
   Fail Check foo7_sind.
@@ -205,11 +208,8 @@ Module Inductives.
 
   (* non SProp instantiation must be squashed *)
   Fail Record R5@{s; |} (A:Type@{s;Set}) : SProp := { R5f1 : A}.
-  Fail #[warnings="-non-primitive-record"]
+  #[warnings="-non-primitive-record"]
     Record R5@{s; |} (A:Type@{s;Set}) : SProp := { R5f1 : A}.
-  #[warnings="-non-primitive-record,-cannot-define-projection"]
-    Record R5@{s; |} (A:Type@{s;Set}) : SProp := { R5f1 : A}.
-  Fail Check R5f1.
   Definition R5f1_sprop (A:SProp) (r:R5 A) : A := let (f) := r in f.
   Fail Definition R5f1_prop (A:Prop) (r:R5 A) : A := let (f) := r in f.
 
diff --git a/test-suite/success/sort_poly_elab.v b/test-suite/success/sort_poly_elab.v
deleted file mode 100644
index 015b61193f9b..000000000000
--- a/test-suite/success/sort_poly_elab.v
+++ /dev/null
@@ -1,175 +0,0 @@
-Set Universe Polymorphism.
-
-Inductive sum@{sl sr s;ul ur} (A : Type@{sl;ul}) (B : Type@{sr;ur}) : Type@{s;max(ul,ur)} :=
-| inl : A -> sum A B
-| inr : B -> sum A B.
-
-Arguments inl {A B} _ , [A] B _.
-Arguments inr {A B} _ , A [B] _.
-
-(* Elimination constraint left explicitly empty. Definition fails because of missing constraint. *)
-Fail Definition sum_elim@{sl sr s0 s0';ul ur v|}
-  (A : Type@{sl;ul}) (B : Type@{sr;ur}) (P : sum@{sl sr s0;ul ur} A B -> Type@{s0';v})
-  (fl : forall a, P (inl a)) (fr : forall b, P (inr b)) (x : sum@{sl sr s0;ul ur} A B) :=
-    match x with
-    | inl a => fl a
-    | inr b => fr b
-    end.
-(* The command has indeed failed with message:
-Elimination constraints are not implied by the ones declared: s0->s0' *)
-
-(* Using + to elaborate missing constraints. Definition passes *)
-Definition sum_elim@{sl sr s0 s0';ul ur v|+}
-  (A : Type@{sl;ul}) (B : Type@{sr;ur}) (P : sum@{sl sr s0;ul ur} A B -> Type@{s0';v})
-  (fl : forall a, P (inl a)) (fr : forall b, P (inr b)) (x : sum@{sl sr s0;ul ur} A B) :=
-    match x with
-    | inl a => fl a
-    | inr b => fr b
-    end.
-(* sl sr s0 s0' ; ul ur v |= s0->s0' *)
-
-Definition sum_sind := sum_elim@{Type Type Type SProp;_ _ _}.
-Definition sum_rect := sum_elim@{Type Type Type Type;_ _ _}.
-Definition sum_ind := sum_elim@{Type Type Type Prop;_ _ _}.
-
-Definition or_ind := sum_elim@{Prop Prop Prop Prop;_ _ _}.
-Definition or_sind := sum_elim@{Prop Prop Prop SProp;_ _ _}.
-Fail Definition or_rect := sum_elim@{Prop Prop Prop Type;_ _ _}.
-(* The command has indeed failed with message:
-The quality constraints are inconsistent: cannot enforce Prop -> Type because it would identifyType and Prop which is inconsistent.
-This is introduced by the constraints Type -> Prop *)
-
-Definition sumor := sum@{Type Prop Type;_ _}.
-
-Definition sumor_sind := sum_elim@{Type Prop Type SProp;_ _ _}.
-Definition sumor_rect := sum_elim@{Type Prop Type Type;_ _ _}.
-Definition sumor_ind := sum_elim@{Type Prop Type Prop;_ _ _}.
-
-(* Implicit constraints are elaborated *)
-Definition idT@{sl sr s;ul ur} (A : Type@{sl;ul}) (B : Type@{sr;ur}) (x : sum@{sl sr s;ul ur} A B)
-  : sum@{sl sr Type;ul ur} A B :=
-  match x return sum@{sl sr Type;ul ur} A B with
-  | inl a => inl a
-  | inr b => inr b
-  end.
-(* sl sr s ; ul ur |= s->Type *)
-
-(* Implicit constraints are elaborated *)
-Definition idP@{sl sr s;ul ur} (A : Type@{sl;ul}) (B : Type@{sr;ur}) (x : sum@{sl sr s;ul ur} A B)
-  : sum@{sl sr Prop;ul ur} A B :=
-  match x return sum@{sl sr Prop;ul ur} A B with
-  | inl a => inl a
-  | inr b => inr b
-  end.
-(* sl sr s ; ul ur |= s->Prop *)
-
-(* Implicit constraints are elaborated *)
-Definition idS@{sl sr s;ul ur} (A : Type@{sl;ul}) (B : Type@{sr;ur}) (x : sum@{sl sr s;ul ur} A B)
-  : sum@{sl sr SProp;ul ur} A B :=
-  match x return sum@{sl sr SProp;ul ur} A B with
-  | inl a => inl a
-  | inr b => inr b
-  end.
-(* sl sr s ; ul ur |= s->SProp *)
-
-(* Implicit constraints are elaborated *)
-Definition idV@{sl sr s s';ul ur} (A : Type@{sl;ul}) (B : Type@{sr;ur}) (x : sum@{sl sr s;ul ur} A B)
-  : sum@{sl sr s';ul ur} A B :=
-  match x return sum@{sl sr s';ul ur} A B with
-  | inl a => inl a
-  | inr b => inr b
-  end.
-(* sl sr s s' ; ul ur |= s->s' *)
-
-Inductive List'@{s s';l} (A : Type@{s;l}) : Type@{s';l} :=
-| nil' : List' A
-| cons' : A -> List' A -> List' A.
-
-Arguments nil' {A}.
-Arguments cons' {A} _ _.
-
-Definition list'_elim@{s s0 s';l l'}
-  (A : Type@{s;l}) (P : List'@{s s0;l} A -> Type@{s';l'})
-  (fn : P nil') (fc : forall (x : A) (l : List' A), P l -> P (cons' x l)) :=
-  fix F (l : List'@{s s0;l} A) : P l :=
-    match l with
-    | nil' => fn
-    | cons' x l => fc x l (F l)
-    end.
-(* s s0 s' ; l l' |= s0->s' *)
-
-Fixpoint list'_idT@{s s';l} {A : Type@{s;l}} (l : List'@{s s';l} A) : List'@{s Type;l} A :=
-  match l with
-  | nil' => nil'
-  | cons' x l => cons' x (list'_idT l)
-  end.
-(* s s' ; l |= s'->Type *)
-
-Fixpoint list'_idP@{s s';l} {A : Type@{s;l}} (l : List'@{s s';l} A) : List'@{s Prop;l} A :=
-  match l with
-  | nil' => nil'
-  | cons' x l => cons' x (list'_idP l)
-  end.
-(* s s' ; l |= s'->Prop *)
-
-Fixpoint list'_idS@{s s';l} {A : Type@{s;l}} (l : List'@{s s';l} A) : List'@{s SProp;l} A :=
-  match l with
-  | nil' => nil'
-  | cons' x l => cons' x (list'_idS l)
-  end.
-(* s s' ; l |= s'->SProp *)
-
-(* Elimination constraint left explicitly empty. Definition fails because of missing constraint. *)
-Fail Fixpoint list'_idV@{s s0 s';l l'|l <= l'} {A : Type@{s;l}} (l : List'@{s s0;l} A) : List'@{s s';l'} A :=
-  match l with
-  | nil' => nil'
-  | cons' x l => cons' x (list'_idV l)
-  end.
-(* The command has indeed failed with message:
-Elimination constraints are not implied by the ones declared: s0->s' *)
-
-(* Using + to elaborate missing constraints. Definition passes *)
-Fixpoint list'_idV@{s s0 s';l l'|l <= l' + } {A : Type@{s;l}} (l : List'@{s s0;l} A) : List'@{s s';l'} A :=
-  match l with
-  | nil' => nil'
-  | cons' x l => cons' x (list'_idV l)
-  end.
-(* s s0 s' ; l l' |= s0->s', l <= l' *)
-
-
-Inductive False'@{s;u} : Type@{s;u} :=.
-
-Definition False'_False@{s; +|+} (x : False'@{s;_}) : False := match x return False with end.
-(* s ; u |= s->Prop *)
-
-Inductive bool@{s;u} : Type@{s;u} := true | false.
-
-Definition bool_to_Prop@{s;u} (b : bool@{s;u}) : Prop.
-Proof.
-  destruct b.
-  - exact True.
-  - exact False.
-Defined.
-(* s ; u |= s->Type *)
-
-Definition bool_to_True_conj@{s;u} (b : bool@{s;u}) : True \/ True.
-Proof.
-  destruct b.
-  - exact (or_introl I).
-  - exact (or_intror I).
-Defined.
-(* s ; u |= s->Prop *)
-
-Program Definition bool_to_Prop'@{s;u} (b : bool@{s;u}) : Prop := _.
-Next Obligation.
-  intro b; destruct b.
-  - exact True.
-  - exact False.
-Defined.
-(* s ; u |= s->Type *)
-
-Inductive unit@{s;u} : Type@{s;u} := tt.
-
-#[universes(polymorphic=no)]
-Sort Test.
-Check (match true@{Test;Set} return ?[P] with true => tt | false => tt end).
diff --git a/vernac/attributes.ml b/vernac/attributes.ml
index 422579164c22..4e86dec2760e 100644
--- a/vernac/attributes.ml
+++ b/vernac/attributes.ml
@@ -297,6 +297,13 @@ let polymorphic =
 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 -> qualify_attribute ukey (bool_attribute ~name:"cumulative")
@@ -305,7 +312,7 @@ let cumulative kind =
      return None
 
 let poly kind =
-  (polymorphic ++ cumulative kind) >>= fun (univ_poly, cumulative) ->
+  (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
@@ -314,7 +321,15 @@ let poly kind =
         CErrors.user_err Pp.(str "Cannot set polymorphic inductive cumulativity status when not in universe polymorphism mode.")
       else b
   in
-  return (PolyFlags.make ~univ_poly ~cumulative ~collapse_sort_variables:true)
+  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/classes.ml b/vernac/classes.ml
index 4ce8f53a6c7d..d83ea26f94a9 100644
--- a/vernac/classes.ml
+++ b/vernac/classes.ml
@@ -421,7 +421,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 ~to_type:(PolyFlags.collapse_sort_variables poly) sigma in
   (* Check that the type is free of evars now. *)
   Pretyping.check_evars env sigma termtype;
   termtype, sigma
diff --git a/vernac/comAssumption.ml b/vernac/comAssumption.ml
index 45896964473c..7dea250a1415 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 ~to_type:(PolyFlags.collapse_sort_variables 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/comDefinition.ml b/vernac/comDefinition.ml
index dab32e0114f5..062be2491c30 100644
--- a/vernac/comDefinition.ml
+++ b/vernac/comDefinition.ml
@@ -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)
@@ -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 ~to_type:(PolyFlags.collapse_sort_variables 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 35b6c8d77f4f..0313f73688c5 100644
--- a/vernac/comFixpoint.ml
+++ b/vernac/comFixpoint.ml
@@ -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 =
@@ -580,7 +580,7 @@ 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 ~to_type:(PolyFlags.collapse_sort_variables poly) sigma in
 
   let sigma, ({fixdefs=bodies;fixrs;fixtypes;fixwfs} as fix), obls, hook =
     match pm with
diff --git a/vernac/comInductive.ml b/vernac/comInductive.ml
index 9e7e64867e07..1fb2862801b2 100644
--- a/vernac/comInductive.ml
+++ b/vernac/comInductive.ml
@@ -320,7 +320,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.
@@ -515,7 +518,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 ~to_type:(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
@@ -644,7 +647,8 @@ 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 collapse_sort_variables = PolyFlags.collapse_sort_variables poly in
+  let sigma = Evd.minimize_universes ~collapse_sort_variables:(not collapse_sort_variables) ~to_type:collapse_sort_variables sigma in
   let sigma = restrict_inductive_universes sigma ctx_params arities constructors in
 
   let sigma, univ_entry, ubinders, global_univs =
@@ -680,12 +684,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 +736,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/comRewriteRule.ml b/vernac/comRewriteRule.ml
index 494ce61a5bf9..ed101d3207f1 100644
--- a/vernac/comRewriteRule.ml
+++ b/vernac/comRewriteRule.ml
@@ -40,12 +40,13 @@ 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 ~to_type:(PolyFlags.collapse_sort_variables poly) evd in
   let _qvars, uvars = EConstr.universes_of_constr evd typ in
   let evd = Evd.restrict_universe_context evd uvars in
   let typ = EConstr.to_constr evd typ in
@@ -368,7 +369,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,12 +422,12 @@ 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 ~to_type:(PolyFlags.collapse_sort_variables poly) evd in
   let _qvars, uvars = EConstr.universes_of_constr evd lhs in
   let evd = Evd.restrict_universe_context evd uvars in
   let uctx, uctx' = UState.check_univ_decl_rev (Evd.ustate evd) udecl in
@@ -476,8 +477,7 @@ 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 ~to_type:collapse_sort_variables 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 fail pp = warn_rewrite_rules_break_SR ?loc:rhs_loc Pp.(surround (str "universe inconsistency") ++ str"." ++ spc() ++ str "Missing constraints: " ++ pp) in
@@ -542,8 +542,8 @@ let interp_rule (udecl, lhs, rhs: Constrexpr.universe_decl_expr option * _ * _)
 
   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/declare.ml b/vernac/declare.ml
index 0af1f323918a..dc3a0cce88b0 100644
--- a/vernac/declare.ml
+++ b/vernac/declare.ml
@@ -1027,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
@@ -1054,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_ctx 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
@@ -1089,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 ~to_type:(PolyFlags.collapse_sort_variables 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
@@ -1106,7 +1114,8 @@ 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 to_type = PolyFlags.collapse_sort_variables poly in
+  let sigma, (body, types) = Evarutil.finalize ~abort_on_undefined_evars:false ~to_type
       sigma (fun nf -> nf body, nf types)
   in
   RetrieveObl.check_evars env sigma;
@@ -1118,7 +1127,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 ~to_type:(PolyFlags.collapse_sort_variables poly)
       sigma (fun nf -> nf types)
   in
   let univs = Evd.check_univ_decl ~poly sigma udecl in
@@ -1200,15 +1209,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 ~to_type:(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
@@ -2079,22 +2089,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 ~to_type:(PolyFlags.collapse_sort_variables 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 }
@@ -2236,12 +2248,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
   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 ~to_type:(PolyFlags.collapse_sort_variables 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
diff --git a/vernac/record.ml b/vernac/record.ml
index dc76c5d34542..7f32bcc3e19e 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
@@ -250,9 +263,10 @@ 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 to_type = PolyFlags.collapse_sort_variables poly in
   let sigma, (params, sort, typ, projtyp) =
-    Evarutil.finalize ~abort_on_undefined_evars:false sigma (fun nf ->
+    Evarutil.finalize ~abort_on_undefined_evars:false ~to_type 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 +355,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 +371,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 +386,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
@@ -551,6 +565,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 +618,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 +638,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 +657,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 +676,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 +720,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 +740,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 +793,6 @@ module Record_decl = struct
     records : Data.t list;
     projections_kind : Decls.definition_object_kind;
     indlocs : DeclareInd.indlocs;
-    poly : PolyFlags.t
   }
 end
 
@@ -812,13 +884,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 +899,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 =
@@ -1077,7 +1148,7 @@ 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;
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/vernacentries.ml b/vernac/vernacentries.ml
index e0dabf15bc27..43ab42ffd3b1 100644
--- a/vernac/vernacentries.ml
+++ b/vernac/vernacentries.ml
@@ -185,8 +185,9 @@ 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 to_type = PolyFlags.collapse_sort_variables poly in
+  let ctx = Evd.sort_context_set (Evd.minimize_universes ~to_type 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)
@@ -2725,8 +2726,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 *)
 

From 6762645a8b43d226cc1f9e6eeb1cf35dc75611cb Mon Sep 17 00:00:00 2001
From: Pierre Roux <pierre.roux@onera.fr>
Date: Fri, 20 Feb 2026 11:35:57 +0100
Subject: [PATCH 150/578] [documentation] Deploy the refman of Stdlib only for
 master branch

Temporary solution until this refman gets automatically deployed by
the Stdlib library repo.
C.f., https://github.com/rocq-prover/stdlib/issues/239
---
 .gitlab-ci.yml | 7 ++++---
 1 file changed, 4 insertions(+), 3 deletions(-)

diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
index 4a5f4e5c820f..3dcd53cd36bc 100644
--- a/.gitlab-ci.yml
+++ b/.gitlab-ci.yml
@@ -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
+    - if [ $CI_COMMIT_REF_NAME = "master" ] ; then rm -rf _deploy/$CI_COMMIT_REF_NAME/refman-stdlib ; fi
     - rm -rf _deploy/$CI_COMMIT_REF_NAME/stdlib
     - 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/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
+    - 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
     - cp -rv saved_build_ci/stdlib/_build/default/doc/stdlib/html _deploy/$CI_COMMIT_REF_NAME/stdlib
     - cd _deploy/$CI_COMMIT_REF_NAME/
-    - git add api refman corelib refman-stdlib stdlib
+    - git add api refman corelib stdlib
+    - if [ $CI_COMMIT_REF_NAME = "master" ] ; then git add refman-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
 

From d75ca888e96a3e39af6dc559abebab18b929633b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Tue, 17 Feb 2026 16:56:56 +0100
Subject: [PATCH 151/578] case styles MatchStyle and RegularStyle are the same

---
 .../user-overlays/21646-SkySkimmer-match-style.sh  |  9 +++++++++
 interp/constrextern.ml                             |  2 +-
 interp/constrintern.ml                             |  2 +-
 kernel/constr.ml                                   |  4 ++--
 kernel/constr.mli                                  |  2 +-
 parsing/g_constr.mlg                               |  2 +-
 plugins/cc/ccprojectability.ml                     |  2 +-
 plugins/funind/glob_termops.ml                     |  2 +-
 plugins/ltac2/tac2core.ml                          |  2 +-
 pretyping/cases.ml                                 |  2 +-
 pretyping/combinators.ml                           |  2 +-
 pretyping/detyping.ml                              |  2 +-
 pretyping/glob_ops.ml                              |  3 +--
 pretyping/libBinding.ml                            |  2 +-
 pretyping/nativenorm.ml                            |  2 +-
 pretyping/vnorm.ml                                 |  2 +-
 proofs/clenv.ml                                    |  2 +-
 tactics/eqschemes.ml                               | 14 +++++++-------
 tactics/equality.ml                                |  2 +-
 tactics/tactics.ml                                 |  2 +-
 20 files changed, 35 insertions(+), 27 deletions(-)
 create mode 100644 dev/ci/user-overlays/21646-SkySkimmer-match-style.sh

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/interp/constrextern.ml b/interp/constrextern.ml
index d9a350c9f484..b8b9a51d731b 100644
--- a/interp/constrextern.ml
+++ b/interp/constrextern.ml
@@ -1475,7 +1475,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
diff --git a/interp/constrintern.ml b/interp/constrintern.ml
index 5540058beaef..5fae22ddcf7b 100644
--- a/interp/constrintern.ml
+++ b/interp/constrintern.ml
@@ -2676,7 +2676,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 @@
diff --git a/kernel/constr.ml b/kernel/constr.ml
index 12b09455a688..e4db9a344946 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 }
 
@@ -1283,7 +1283,7 @@ struct
     | IfStyle -> 1
     | LetPatternStyle -> 2
     | MatchStyle -> 3
-    | RegularStyle -> 4 in
+    in
     h1
   let hash ~hind ci =
     let h1 = hind in
diff --git a/kernel/constr.mli b/kernel/constr.mli
index 60594d54a290..59235995ebb5 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 }
 
diff --git a/parsing/g_constr.mlg b/parsing/g_constr.mlg
index 6c32c6c54dd1..4261636d27d8 100644
--- a/parsing/g_constr.mlg
+++ b/parsing/g_constr.mlg
@@ -369,7 +369,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";
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/funind/glob_termops.ml b/plugins/funind/glob_termops.ml
index 4b7b51537e99..4809a1ef05e1 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
diff --git a/plugins/ltac2/tac2core.ml b/plugins/ltac2/tac2core.ml
index 57ea00a6c8df..96d1226e950e 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
diff --git a/pretyping/cases.ml b/pretyping/cases.ml
index 57a3f09f4862..5ccaaed54436 100644
--- a/pretyping/cases.ml
+++ b/pretyping/cases.ml
@@ -1968,7 +1968,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)
diff --git a/pretyping/combinators.ml b/pretyping/combinators.ml
index dfadbb48b263..beb8161aa303 100644
--- a/pretyping/combinators.ml
+++ b/pretyping/combinators.ml
@@ -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 5b1989d23f5f..f5bdb4ad391a 100644
--- a/pretyping/detyping.ml
+++ b/pretyping/detyping.ml
@@ -615,7 +615,7 @@ let detype_case ~flags computable detype detype_eqns avoid env sigma (ci, univs,
   let tag =
     let tag = ci.ci_pp_info.style in
     if flags.flg.always_regular_match_style then
-      RegularStyle
+      MatchStyle
     else if tag == LetPatternStyle then
       tag
     else if PrintingLet.active ci.ci_ind then
diff --git a/pretyping/glob_ops.ml b/pretyping/glob_ops.ml
index db3017fc71bc..7655d8cfbf06 100644
--- a/pretyping/glob_ops.ml
+++ b/pretyping/glob_ops.ml
@@ -129,8 +129,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/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 4c3a89f06e46..c983c941768a 100644
--- a/pretyping/nativenorm.ml
+++ b/pretyping/nativenorm.ml
@@ -341,7 +341,7 @@ 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 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
diff --git a/pretyping/vnorm.ml b/pretyping/vnorm.ml
index 4cb34121a33e..631c09c72da5 100644
--- a/pretyping/vnorm.ml
+++ b/pretyping/vnorm.ml
@@ -305,7 +305,7 @@ 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 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
diff --git a/proofs/clenv.ml b/proofs/clenv.ml
index dcb09c2197a2..5638406c5112 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,
diff --git a/tactics/eqschemes.ml b/tactics/eqschemes.ml
index c6f4a16f08dd..98ce70561669 100644
--- a/tactics/eqschemes.ml
+++ b/tactics/eqschemes.ml
@@ -216,7 +216,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 +281,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 +419,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 +527,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 +608,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
@@ -826,7 +826,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 335d7236187e..9aa1d715b553 100644
--- a/tactics/equality.ml
+++ b/tactics/equality.ml
@@ -1063,7 +1063,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
diff --git a/tactics/tactics.ml b/tactics/tactics.ml
index 822b614689eb..6b8b7133f1be 100644
--- a/tactics/tactics.ml
+++ b/tactics/tactics.ml
@@ -1500,7 +1500,7 @@ let make_projection env sigma params cstr sign elim i n c (ind, u) =
              (UnivGen.QualityOrSet.of_quality @@ 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 @@

From 7b9f526b6270eba819d40411d65d6427347a9976 Mon Sep 17 00:00:00 2001
From: Pierre Roux <pierre.roux@onera.fr>
Date: Mon, 23 Feb 2026 08:05:32 +0100
Subject: [PATCH 152/578] [documentation] Deploy Stdlib doc only for master
 branch

Follow up of https://github.com/rocq-prover/rocq/pull/21659
---
 .gitlab-ci.yml | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
index 3dcd53cd36bc..0f004787db7a 100644
--- a/.gitlab-ci.yml
+++ b/.gitlab-ci.yml
@@ -489,16 +489,16 @@ doc:refman:deploy:
     - rm -rf _deploy/$CI_COMMIT_REF_NAME/refman
     - rm -rf _deploy/$CI_COMMIT_REF_NAME/corelib
     - if [ $CI_COMMIT_REF_NAME = "master" ] ; then rm -rf _deploy/$CI_COMMIT_REF_NAME/refman-stdlib ; fi
-    - rm -rf _deploy/$CI_COMMIT_REF_NAME/stdlib
+    - 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/default/doc/corelib/html _deploy/$CI_COMMIT_REF_NAME/corelib
     - 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
-    - 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/stdlib/html _deploy/$CI_COMMIT_REF_NAME/stdlib ; fi
     - cd _deploy/$CI_COMMIT_REF_NAME/
-    - git add api refman corelib stdlib
-    - if [ $CI_COMMIT_REF_NAME = "master" ] ; then git add refman-stdlib ; fi
+    - 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
 

From 4d2124c7336a0c2d983943db6e20530e9a6d3f4f Mon Sep 17 00:00:00 2001
From: Yann Leray <yann.leray@inria.fr>
Date: Fri, 15 Nov 2024 15:48:37 +0100
Subject: [PATCH 153/578] Support for matching global sorts

---
 checker/mod_checking.ml  |  3 ++-
 checker/values.ml        | 11 ++++++++---
 kernel/declarations.mli  |  4 ++--
 kernel/sorts.ml          | 15 +++++++++++----
 kernel/sorts.mli         |  5 +++--
 vernac/comRewriteRule.ml | 16 +++++++++++-----
 6 files changed, 37 insertions(+), 17 deletions(-)

diff --git a/checker/mod_checking.ml b/checker/mod_checking.ml
index 2727491ecb5e..f6b8e9efa927 100644
--- a/checker/mod_checking.ml
+++ b/checker/mod_checking.ml
@@ -92,7 +92,7 @@ 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 +141,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
diff --git a/checker/values.ml b/checker/values.ml
index 17b25ca4628b..7fadd47225a0 100644
--- a/checker/values.ml
+++ b/checker/values.ml
@@ -498,13 +498,18 @@ let v_retroknowledge =
 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 =
diff --git a/kernel/declarations.mli b/kernel/declarations.mli
index ebdd936aacff..dbbbade91617 100644
--- a/kernel/declarations.mli
+++ b/kernel/declarations.mli
@@ -303,12 +303,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/sorts.ml b/kernel/sorts.ml
index 4f947bf649f2..2069c6bf6d01 100644
--- a/kernel/sorts.ml
+++ b/kernel/sorts.ml
@@ -57,6 +57,11 @@ struct
     | Unif _ -> None
     | Global _ -> None
 
+  let name = function
+  | Global id -> Some id
+  | Var _ -> None
+  | Unif _ -> None
+
   let hash = function
     | Var q -> Hashset.Combine.combinesmall 1 q
     | Unif (s,q) -> Hashset.Combine.(combinesmall 2 (combine (CString.hash s) q))
@@ -253,13 +258,14 @@ module Quality = struct
   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, QVar (QVar.Global 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 _), (QConstant _ | QVar _) -> None
 end
 
 module ElimConstraint = struct
@@ -520,7 +526,7 @@ let pr prv pru = function
 let raw_pr = pr QVar.raw_pr Univ.Universe.raw_pr
 
 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
@@ -539,5 +545,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), QSort (QVar.Global 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 c5601df9c082..a07df598a370 100644
--- a/kernel/sorts.mli
+++ b/kernel/sorts.mli
@@ -29,6 +29,7 @@ sig
   type t
 
   val var_index : t -> int option
+  val name : t -> QGlobal.t option
 
   val make_var : int -> t
   val make_unif : string -> int -> t
@@ -121,7 +122,7 @@ module Quality : sig
   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
@@ -211,6 +212,6 @@ val pr : (QVar.t -> Pp.t) -> (Univ.Universe.t -> Pp.t) -> t -> Pp.t
 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/vernac/comRewriteRule.ml b/vernac/comRewriteRule.ml
index 494ce61a5bf9..f675198ffeda 100644
--- a/vernac/comRewriteRule.ml
+++ b/vernac/comRewriteRule.ml
@@ -112,9 +112,11 @@ 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
   | 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
+    | Global qg -> stateq, PQGlobal qg
+    | Var qi ->
+        update_invtblq1 ~loc evd q qi stateq, PQVar (Some qi)
+    | Unif _ -> stateq, PQVar None
 
 let update_invtblu ~loc evd (qsubst, usubst) (state, stateq, stateu : state) u : state * _ =
   let (q, u) = u |> UVars.Instance.to_array in
@@ -147,8 +149,9 @@ let safe_sort_pattern_of_sort ~loc evd (qsubst, usubst) (st, sq, su as state) s
   | Prop -> state, PSProp
   | Set -> state, PSSet
   | QSort (qold, u) ->
+      let qv = match Sorts.Quality.subst_fn qsubst qold with QConstant _ -> assert false | QVar qv -> qv in
       let sq, bq =
-        match Sorts.Quality.(var_index @@ subst_fn qsubst qold) with
+        match Sorts.QVar.var_index qv with
         | Some q -> update_invtblq1 ~loc evd (QVar qold) q sq, Some q
         | None -> sq, None
       in
@@ -157,7 +160,9 @@ let safe_sort_pattern_of_sort ~loc evd (qsubst, usubst) (st, sq, su as state) s
         | Some (lvlold, lvl) -> update_invtblu1 ~loc evd lvlold lvl su, Some lvl
         | None -> su, None
       in
-      (st, sq, su), PSQSort (bq, ba)
+      match Sorts.QVar.name qv with
+      | Some qg -> (st, sq, su), PSGlobal (qg, ba)
+      | None -> (st, sq, su), PSQSort (bq, ba)
 
 
 let warn_irrelevant_pattern =
@@ -510,6 +515,7 @@ let interp_rule (udecl, lhs, rhs: Constrexpr.universe_decl_expr option * _ * _)
           Pp.(str "Sort variable " ++ Termops.pr_evd_qvar evd q ++ str " appears in the replacement but does not appear in the pattern.")
     | Some n when n < 0 || n > nvarqs' -> CErrors.anomaly Pp.(str "Unknown sort variable in rewrite rule.")
     | Some _ -> ()
+    | None when Option.has_some (Sorts.QVar.name q) -> ()
     | None ->
         if not @@ Sorts.QVar.Set.mem q (evd |> Evd.sort_context_set |> fst |> fst) then
           CErrors.user_err ?loc:rhs_loc

From 78d6ac65ed8e36dcaa338f7567bf3c4f8c004dca Mon Sep 17 00:00:00 2001
From: Yann Leray <yann.leray@inria.fr>
Date: Mon, 23 Feb 2026 16:22:27 +0100
Subject: [PATCH 154/578] Changelog, test

---
 .../21663-rr-match-global-sorts-Added.rst     |  4 +++
 test-suite/success/rewrule_quality_match.v    | 28 +++++++++++--------
 2 files changed, 21 insertions(+), 11 deletions(-)
 create mode 100644 doc/changelog/01-kernel/21663-rr-match-global-sorts-Added.rst

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 <https://github.com/rocq-prover/rocq/pull/21663>`_,
+  by Yann Leray).
diff --git a/test-suite/success/rewrule_quality_match.v b/test-suite/success/rewrule_quality_match.v
index 13ce4018c763..d568dc0050c3 100644
--- a/test-suite/success/rewrule_quality_match.v
+++ b/test-suite/success/rewrule_quality_match.v
@@ -1,29 +1,35 @@
 (* -*- mode: coq; coq-prog-args: ("-allow-rewrite-rules") -*- *)
 
-#[universes(polymorphic)] Symbol irrel@{q;u} : forall {A : Type@{q;u}}, A -> bool.
+#[universes(polymorphic)] Symbol dispatch@{q;u} : forall {A : Type@{q;u}}, A -> nat.
+
+Sort s.
 
 Rewrite Rule id_rew :=
-| irrel@{SProp|_} _ => true
-| irrel@{Type|_} _ => false.
+| dispatch@{SProp;_} _ => 0
+| dispatch@{Type;_} _ => 1
+| dispatch@{s;_} _ => 2.
 
 Inductive STrue : SProp := SI.
 
+#[universes(template=no)]
+Inductive sTrue : Type@{s;_} := sI.
+
 Goal True.
-  let c := constr:((irrel SI, irrel tt)) in
+  let c := constr:((dispatch SI, dispatch tt, dispatch sI)) in
   let cl := eval lazy in c in
-  constr_eq cl (true, false).
+  constr_eq cl (0, 1, 2).
 
-  let c := constr:((irrel SI, irrel tt)) in
+  let c := constr:((dispatch SI, dispatch tt, dispatch sI)) in
   let cl := eval cbv in c in
-  constr_eq cl (true, false).
+  constr_eq cl (0, 1, 2).
 
-  let c := constr:((irrel SI, irrel tt)) in
+  let c := constr:((dispatch SI, dispatch tt, dispatch sI)) in
   let cl := eval cbn in c in
-  constr_eq cl (true, false).
+  constr_eq cl (0, 1, 2).
 
-  let c := constr:((irrel SI, irrel tt)) in
+  let c := constr:((dispatch SI, dispatch tt, dispatch sI)) in
   let cl := eval simpl in c in
-  constr_eq cl (true, false).
+  constr_eq cl (0, 1, 2).
 
   exact I.
 Qed.

From 6c6b1804597171678c006043d42c775a878815ea Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Tue, 24 Feb 2026 11:48:32 +0100
Subject: [PATCH 155/578] Remove the not extremely well-named Inv.inv function.

It was only used once in funind and the function is easily reachable
through the Inv.inv_clause wrapper.
---
 plugins/funind/invfun.ml | 2 +-
 tactics/inv.mli          | 3 ---
 2 files changed, 1 insertion(+), 4 deletions(-)

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/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
 

From a885344fa867553961a8eaff406b59d922240b23 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Tue, 24 Feb 2026 15:11:29 +0100
Subject: [PATCH 156/578] Disallow Type@{s; _} from being a valid template
 conclusion

Fix #21664

Less syntactic, more semantic version of #21665
---
 test-suite/bugs/bug_21664.v | 12 ++++++++++++
 vernac/comInductive.ml      | 19 ++++++++++---------
 2 files changed, 22 insertions(+), 9 deletions(-)
 create mode 100644 test-suite/bugs/bug_21664.v

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/vernac/comInductive.ml b/vernac/comInductive.ml
index 1fb2862801b2..f68aa7a99e45 100644
--- a/vernac/comInductive.ml
+++ b/vernac/comInductive.ml
@@ -391,12 +391,15 @@ let get_template_binding_arity sigma c =
   | _ -> 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
+    | QSort (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."
+    | _ -> 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
@@ -464,7 +467,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
@@ -569,10 +573,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."
@@ -582,7 +583,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

From 6a3ea867686f0818d453000958f887641c3631c6 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Tue, 24 Feb 2026 16:47:37 +0100
Subject: [PATCH 157/578] Don't check opacity of constant in Typeclasses Opaque

Fix #19482
---
 test-suite/bugs/bug_19482.v | 8 ++++++++
 vernac/classes.ml           | 3 +--
 2 files changed, 9 insertions(+), 2 deletions(-)
 create mode 100644 test-suite/bugs/bug_19482.v

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/vernac/classes.ml b/vernac/classes.ml
index d83ea26f94a9..6b5e46601267 100644
--- a/vernac/classes.ml
+++ b/vernac/classes.ml
@@ -40,8 +40,7 @@ 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 ())
+      (fun x -> Tacred.soft_evaluable_of_global_reference
           (Smartlocate.global_with_alias x))
       refs
   in

From 26768dd26b5cf9eaa30294fc05d3f451c30a3fc1 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Tue, 24 Feb 2026 16:48:07 +0100
Subject: [PATCH 158/578] Remove unused evaluable_of_global_reference

---
 pretyping/tacred.ml  | 10 ----------
 pretyping/tacred.mli |  5 -----
 2 files changed, 15 deletions(-)

diff --git a/pretyping/tacred.ml b/pretyping/tacred.ml
index 768e69f2f41f..0a61972e21ab 100644
--- a/pretyping/tacred.ml
+++ b/pretyping/tacred.ml
@@ -94,16 +94,6 @@ 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 global_of_evaluable_reference = function
   | Evaluable.EvalConstRef cst -> GlobRef.ConstRef cst
   | Evaluable.EvalVarRef id -> GlobRef.VarRef id
diff --git a/pretyping/tacred.mli b/pretyping/tacred.mli
index a6e4a2e20c6c..5e789ecb6943 100644
--- a/pretyping/tacred.mli
+++ b/pretyping/tacred.mli
@@ -42,11 +42,6 @@ val is_evaluable : Environ.env -> Evd.evar_map -> Evaluable.t -> bool
 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). *)
-
 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. *)

From bfb7d39c73ade9c9b8e29f77298e808648b1c5b2 Mon Sep 17 00:00:00 2001
From: Jan-Oliver Kaiser <janno@skylabs-ai.com>
Date: Wed, 25 Feb 2026 11:40:00 +0100
Subject: [PATCH 159/578] Raise NativeDestKO for invalid primitive array terms

---
 pretyping/reductionops.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/pretyping/reductionops.ml b/pretyping/reductionops.ml
index 0e1f22e4aa94..31f0de041226 100644
--- a/pretyping/reductionops.ml
+++ b/pretyping/reductionops.ml
@@ -564,7 +564,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

From ba6a408bea9b1b26d88e2b1bf5500980e4466d56 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Wed, 25 Feb 2026 14:16:55 +0100
Subject: [PATCH 160/578] Add test

---
 test-suite/bugs/bug_21672.v | 8 ++++++++
 1 file changed, 8 insertions(+)
 create mode 100644 test-suite/bugs/bug_21672.v

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.

From ee2fb1359d80f02aef44e83ba58313c03e37884f Mon Sep 17 00:00:00 2001
From: Jason Gross <jgross@mit.edu>
Date: Sat, 17 Jan 2026 13:54:31 -0800
Subject: [PATCH 161/578] Add Kernel Conversion Dep Heuristic flag for smarter
 constant unfolding.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

This PR adds an optional heuristic to the conversion algorithm that can
significantly speed up conversions when two constants have the same
oracle level and one depends on the other.

The key insight is that when checking c1 = c2 where c2's definition
mentions c1 (c2 depends on c1), it's better to unfold c2 first
regardless of which side it appears on.

Example: if fact100' := fact100 and fact100 := fact 100, then:
- Without heuristic: fact100 = fact100' is fast but fact100' = fact100 times out
- With heuristic: both directions are fast

The flag is controlled via "Set Kernel Conversion Dep Heuristic" and
defaults to off (preserving current behavior).

Changes:
- kernel/environ.ml: Add constant_dependencies function
- kernel/conv_oracle.ml: Add oracle_compare that returns Same when
  the oracle doesn't prefer either constant
- kernel/conversion.ml: Use dependency heuristic when flag is enabled
  and oracle_compare returns Same
- vernac/vernacentries.ml: Add option declaration
- doc/sphinx: Document the new flag
- test-suite: Add test demonstrating the behavior

Fixes #21509

Co-Authored-By: Pierre-Marie Pédrot <pierre-marie.pedrot@inria.fr>
Co-Authored-By: Claude Opus 4.5 <noreply@anthropic.com>
---
 checker/checkFlags.ml                         |  1 +
 checker/values.ml                             |  2 +-
 ...21514-unfold-dep-heuristic-names-Added.rst | 11 +++
 doc/sphinx/proofs/writing-proofs/equality.rst | 16 +++++
 kernel/conv_oracle.ml                         | 57 +++++++++------
 kernel/conv_oracle.mli                        |  9 +++
 kernel/conversion.ml                          | 22 +++++-
 kernel/declarations.mli                       |  3 +
 kernel/declareops.ml                          |  1 +
 kernel/environ.ml                             | 70 ++++++++++++++++++-
 kernel/environ.mli                            |  9 +++
 kernel/safe_typing.ml                         |  4 ++
 kernel/safe_typing.mli                        |  1 +
 library/global.ml                             |  3 +
 library/global.mli                            |  2 +
 test-suite/success/UnfoldDepHeuristic.v       | 32 +++++++++
 vernac/vernacentries.ml                       |  8 +++
 17 files changed, 224 insertions(+), 27 deletions(-)
 create mode 100644 doc/changelog/01-kernel/21514-unfold-dep-heuristic-names-Added.rst
 create mode 100644 test-suite/success/UnfoldDepHeuristic.v

diff --git a/checker/checkFlags.ml b/checker/checkFlags.ml
index 0c3a98db311c..b851234fa661 100644
--- a/checker/checkFlags.ml
+++ b/checker/checkFlags.ml
@@ -21,6 +21,7 @@ let set_local_flags flags env =
     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/values.ml b/checker/values.ml
index 17b25ca4628b..cd92f02d0843 100644
--- a/checker/values.ml
+++ b/checker/values.ml
@@ -357,7 +357,7 @@ let v_typing_flags =
   v_tuple "typing_flags"
     [|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|]|]
 
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
+  <https://github.com/rocq-prover/rocq/pull/21514>`_, fixes `#21509
+  <https://github.com/rocq-prover/rocq/issues/21509>`_, by Jason Gross).
diff --git a/doc/sphinx/proofs/writing-proofs/equality.rst b/doc/sphinx/proofs/writing-proofs/equality.rst
index fbc03ee27eea..a91d26c81fe1 100644
--- a/doc/sphinx/proofs/writing-proofs/equality.rst
+++ b/doc/sphinx/proofs/writing-proofs/equality.rst
@@ -559,6 +559,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.
diff --git a/kernel/conv_oracle.ml b/kernel/conv_oracle.ml
index e092b0478c1a..a39b4317fff4 100644
--- a/kernel/conv_oracle.ml
+++ b/kernel/conv_oracle.ml
@@ -113,34 +113,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..3a04408a9242 100644
--- a/kernel/conversion.ml
+++ b/kernel/conversion.ml
@@ -465,7 +465,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
@@ -991,7 +1009,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/declarations.mli b/kernel/declarations.mli
index ebdd936aacff..280f21a5dced 100644
--- a/kernel/declarations.mli
+++ b/kernel/declarations.mli
@@ -86,6 +86,9 @@ type typing_flags = {
   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 *)
 
diff --git a/kernel/declareops.ml b/kernel/declareops.ml
index e8460bbf9446..373dd0408724 100644
--- a/kernel/declareops.ml
+++ b/kernel/declareops.ml
@@ -26,6 +26,7 @@ let safe_flags oracle = {
   check_universes = true;
   conv_oracle = oracle;
   share_reduction = true;
+  unfold_dep_heuristic = false;
   enable_VM = true;
   enable_native_compiler = true;
   indices_matter = true;
diff --git a/kernel/environ.ml b/kernel/environ.ml
index 4b86145c67cd..65cd4df5fed2 100644
--- a/kernel/environ.ml
+++ b/kernel/environ.ml
@@ -48,6 +48,32 @@ 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 = {
@@ -82,6 +108,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
@@ -117,6 +144,7 @@ let empty_env = {
   vm_library = Vmlibrary.empty;
   retroknowledge = Retroknowledge.empty;
   rewrite_rules_allowed = false;
+  constant_deps = CEphemeron.create DepCache.empty;
 }
 
 
@@ -548,6 +576,7 @@ let same_flags {
      conv_oracle;
      indices_matter;
      share_reduction;
+     unfold_dep_heuristic;
      enable_VM;
      enable_native_compiler;
      impredicative_set;
@@ -561,6 +590,7 @@ let same_flags {
   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 &&
@@ -624,7 +654,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
@@ -1091,6 +1129,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
diff --git a/kernel/environ.mli b/kernel/environ.mli
index b5afd88977a0..235ad7033de3 100644
--- a/kernel/environ.mli
+++ b/kernel/environ.mli
@@ -490,6 +490,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. *)
diff --git a/kernel/safe_typing.ml b/kernel/safe_typing.ml
index 3655cef09605..7ef7df93c150 100644
--- a/kernel/safe_typing.ml
+++ b/kernel/safe_typing.ml
@@ -335,6 +335,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
diff --git a/kernel/safe_typing.mli b/kernel/safe_typing.mli
index 35b2fc364509..9b162866b556 100644
--- a/kernel/safe_typing.mli
+++ b/kernel/safe_typing.mli
@@ -168,6 +168,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
diff --git a/library/global.ml b/library/global.ml
index e42b2970aef4..0b3323a993cc 100644
--- a/library/global.ml
+++ b/library/global.ml
@@ -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..13d2ac8bb12b 100644
--- a/library/global.mli
+++ b/library/global.mli
@@ -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/test-suite/success/UnfoldDepHeuristic.v b/test-suite/success/UnfoldDepHeuristic.v
new file mode 100644
index 000000000000..ca35101e2bd4
--- /dev/null
+++ b/test-suite/success/UnfoldDepHeuristic.v
@@ -0,0 +1,32 @@
+(* Test for the Kernel Conversion Dep Heuristic flag *)
+
+(* Define a factorial function *)
+Fixpoint fact (n : nat) := match n with O => 1 | S n => (S n) * fact n end.
+
+(* Define constants that depend on each other:
+   fact100' depends on fact100 which depends on fact *)
+Definition fact100 := fact 100.
+Definition fact100' := fact100.
+
+(* Without the heuristic, conversion prefers unfolding right-to-left by default.
+   - fact100 = fact100' is fast because fact100' (on the right) is unfolded first,
+     revealing fact100, and both sides are then syntactically equal
+   - fact100' = fact100 is slow because fact100 (on the right) is unfolded first
+     and fully reduced to normal form before the left side is considered
+
+   With the heuristic enabled, when the oracle doesn't prefer either constant,
+   we prefer unfolding the constant that depends on the other one. Since
+   fact100' depends on fact100, we prefer unfolding fact100' regardless of
+   which side it appears on. *)
+
+(* Test 1: This direction is always fast (unfolds fact100' first) *)
+Timeout 1 Check eq_refl : fact100 = fact100'.
+
+(* Test 2: Without heuristic this times out, with heuristic it's fast *)
+(* First verify the timeout behavior without the heuristic *)
+Unset Kernel Conversion Dep Heuristic.
+Fail Timeout 1 Check eq_refl : fact100' = fact100.
+
+(* Now enable the heuristic and verify it works *)
+Set Kernel Conversion Dep Heuristic.
+Timeout 1 Check eq_refl : fact100' = fact100.
diff --git a/vernac/vernacentries.ml b/vernac/vernacentries.ml
index 43ab42ffd3b1..d982f9e72a46 100644
--- a/vernac/vernacentries.ml
+++ b/vernac/vernacentries.ml
@@ -1936,6 +1936,14 @@ let () =
       optread  = (fun () -> (Global.typing_flags ()).Declarations.share_reduction);
       optwrite = Global.set_share_reduction }
 
+let () =
+  declare_bool_option
+    { optstage = Summary.Stage.Interp;
+      optdepr  = None;
+      optkey   = ["Kernel"; "Conversion"; "Dep"; "Heuristic"];
+      optread  = (fun () -> (Global.typing_flags ()).Declarations.unfold_dep_heuristic);
+      optwrite = Global.set_unfold_dep_heuristic }
+
 let () =
   declare_bool_option
     { optstage = Summary.Stage.Interp;

From e6a2fb9b2fa240194e1469439b56339b9b415d78 Mon Sep 17 00:00:00 2001
From: Pierre Roux <pierre.roux@onera.fr>
Date: Tue, 10 Feb 2026 10:11:15 +0100
Subject: [PATCH 162/578] Add "of _ & _ & _" syntax for constructors
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

e.g.: Variant t := C1 of a & b & c | C2 x y of P x & Q y.

Co-authored-by: Gaëtan Gilbert <gaetan.gilbert@skyskimmer.net>
---
 .../02-specification-language/21611-of-ampersand.rst |  7 +++++++
 doc/sphinx/language/core/basic.rst                   |  2 +-
 doc/sphinx/language/core/inductive.rst               |  5 ++++-
 doc/tools/docgram/common.edit_mlg                    |  5 +++--
 doc/tools/docgram/fullGrammar                        |  6 +++++-
 doc/tools/docgram/orderedGrammar                     |  2 +-
 test-suite/output/PrintKeywords.out                  |  1 +
 theories/Corelib/Classes/CMorphisms.v                |  2 +-
 theories/Corelib/Classes/Morphisms.v                 |  2 +-
 vernac/g_vernac.mlg                                  | 12 ++++++++++--
 10 files changed, 34 insertions(+), 10 deletions(-)
 create mode 100644 doc/changelog/02-specification-language/21611-of-ampersand.rst

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..47679970f648
--- /dev/null
+++ b/doc/changelog/02-specification-language/21611-of-ampersand.rst
@@ -0,0 +1,7 @@
+- **Added:**
+  new syntactic sugars `of T & ... & T` for anonymous binders
+  `(_ : T)` 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 <https://github.com/rocq-prover/rocq/pull/21611>`_,
+  by Pierre Roux).
diff --git a/doc/sphinx/language/core/basic.rst b/doc/sphinx/language/core/basic.rst
index 9500325363e9..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`::
 
diff --git a/doc/sphinx/language/core/inductive.rst b/doc/sphinx/language/core/inductive.rst
index 7b68a55e6ed9..00bca1b0b1ae 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
diff --git a/doc/tools/docgram/common.edit_mlg b/doc/tools/docgram/common.edit_mlg
index 2b12707243fe..cf70461c9093 100644
--- a/doc/tools/docgram/common.edit_mlg
+++ b/doc/tools/docgram/common.edit_mlg
@@ -1457,8 +1457,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" *)
@@ -2299,6 +2299,7 @@ SPLICE: [
 | preident
 | lpar_id_coloneq
 | binders
+| constructor_binders
 | check_module_types
 | decl_sep
 | function_fix_definition (* loses funind annotation *)
diff --git a/doc/tools/docgram/fullGrammar b/doc/tools/docgram/fullGrammar
index ffd5402734a2..747ccfd2dc2a 100644
--- a/doc/tools/docgram/fullGrammar
+++ b/doc/tools/docgram/fullGrammar
@@ -1135,8 +1135,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: [
diff --git a/doc/tools/docgram/orderedGrammar b/doc/tools/docgram/orderedGrammar
index d3cd93739132..09d7959b3ae0 100644
--- a/doc/tools/docgram/orderedGrammar
+++ b/doc/tools/docgram/orderedGrammar
@@ -572,7 +572,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: [
diff --git a/test-suite/output/PrintKeywords.out b/test-suite/output/PrintKeywords.out
index f25f491e162f..7dc6175218a7 100644
--- a/test-suite/output/PrintKeywords.out
+++ b/test-suite/output/PrintKeywords.out
@@ -83,6 +83,7 @@ if
 in
 let
 match
+of
 return
 then
 using
diff --git a/theories/Corelib/Classes/CMorphisms.v b/theories/Corelib/Classes/CMorphisms.v
index 54ad5fbdd091..59fd8f59ab6b 100644
--- a/theories/Corelib/Classes/CMorphisms.v
+++ b/theories/Corelib/Classes/CMorphisms.v
@@ -437,7 +437,7 @@ Section GenericInstances.
     Proper R' (m x).
   Proof. simpl_crelation. Qed.
   
-  Class Params {A} (of : A) (arity : nat).
+  Class Params {A} (from : A) (arity : nat).
     
   Lemma flip_respectful {A B} (R : crelation A) (R' : crelation B) :
     relation_equivalence (flip (R ==> R')) (flip R ==> flip R').
diff --git a/theories/Corelib/Classes/Morphisms.v b/theories/Corelib/Classes/Morphisms.v
index 79b24b3dff00..19a94ca3c88e 100644
--- a/theories/Corelib/Classes/Morphisms.v
+++ b/theories/Corelib/Classes/Morphisms.v
@@ -538,7 +538,7 @@ Class PartialApplication.
 
 CoInductive normalization_done : Prop := did_normalization.
 
-Class Params {A : Type} (of : A) (arity : nat).
+Class Params {A : Type} (from : A) (arity : nat).
 #[global] Instance eq_pars : Params (@eq) 1 := {}.
 #[global] Instance iff_pars : Params (@iff) 0 := {}.
 #[global] Instance impl_pars : Params (@impl) 0 := {}.
diff --git a/vernac/g_vernac.mlg b/vernac/g_vernac.mlg
index f8c59c08a039..030a62269d33 100644
--- a/vernac/g_vernac.mlg
+++ b/vernac/g_vernac.mlg
@@ -639,9 +639,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)))) } ]

From af52fac7294bdc9253eec85f8cbc8622bd7894e4 Mon Sep 17 00:00:00 2001
From: Pierre Roux <pierre.roux@onera.fr>
Date: Tue, 17 Feb 2026 11:15:33 +0100
Subject: [PATCH 163/578] Add `& T` syntax for anonymous binders `(_ : T)`

---
 .../02-specification-language/21611-of-ampersand.rst      | 4 ++--
 .../07-ssreflect/21611-of-ampersand-of-Removed.rst        | 5 +++++
 doc/sphinx/language/core/assumptions.rst                  | 3 +++
 doc/tools/docgram/fullGrammar                             | 1 +
 doc/tools/docgram/orderedGrammar                          | 1 +
 parsing/g_constr.mlg                                      | 4 +++-
 plugins/ssr/ssrvernac.mlg                                 | 8 --------
 test-suite/prerequisite/ssr_mini_mathcomp.v               | 6 +++---
 theories/Corelib/ssr/ssreflect.v                          | 2 +-
 9 files changed, 19 insertions(+), 15 deletions(-)
 create mode 100644 doc/changelog/07-ssreflect/21611-of-ampersand-of-Removed.rst

diff --git a/doc/changelog/02-specification-language/21611-of-ampersand.rst b/doc/changelog/02-specification-language/21611-of-ampersand.rst
index 47679970f648..0f086e21b45d 100644
--- a/doc/changelog/02-specification-language/21611-of-ampersand.rst
+++ b/doc/changelog/02-specification-language/21611-of-ampersand.rst
@@ -1,6 +1,6 @@
 - **Added:**
-  new syntactic sugars `of T & ... & T` for anonymous binders
-  `(_ : T)` in constructors, enabling the
+  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 <https://github.com/rocq-prover/rocq/pull/21611>`_,
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 <https://github.com/rocq-prover/rocq/pull/21611>`_,
+  by Pierre Roux).
diff --git a/doc/sphinx/language/core/assumptions.rst b/doc/sphinx/language/core/assumptions.rst
index 87d599895a91..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,6 +39,8 @@ 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)`.
 
+: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,
diff --git a/doc/tools/docgram/fullGrammar b/doc/tools/docgram/fullGrammar
index 747ccfd2dc2a..36cff2190314 100644
--- a/doc/tools/docgram/fullGrammar
+++ b/doc/tools/docgram/fullGrammar
@@ -348,6 +348,7 @@ closed_binder: [
 | "`{" LIST1 typeclass_constraint SEP "," "}"
 | "`[" LIST1 typeclass_constraint SEP "," "]"
 | "'" pattern0
+| "&" term99
 ]
 
 one_open_binder: [
diff --git a/doc/tools/docgram/orderedGrammar b/doc/tools/docgram/orderedGrammar
index 09d7959b3ae0..f2b81f604e1d 100644
--- a/doc/tools/docgram/orderedGrammar
+++ b/doc/tools/docgram/orderedGrammar
@@ -405,6 +405,7 @@ binder: [
 | generalizing_binder
 | "(" name ":" type "|" term ")"
 | "'" pattern0
+| "&" term99
 ]
 
 implicit_binders: [
diff --git a/parsing/g_constr.mlg b/parsing/g_constr.mlg
index 4261636d27d8..00fcb117a02f 100644
--- a/parsing/g_constr.mlg
+++ b/parsing/g_constr.mlg
@@ -508,7 +508,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/plugins/ssr/ssrvernac.mlg b/plugins/ssr/ssrvernac.mlg
index 1df591df336e..d93101b33c13 100644
--- a/plugins/ssr/ssrvernac.mlg
+++ b/plugins/ssr/ssrvernac.mlg
@@ -116,14 +116,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   *)
diff --git a/test-suite/prerequisite/ssr_mini_mathcomp.v b/test-suite/prerequisite/ssr_mini_mathcomp.v
index 083e9681269c..78a41c2501ef 100644
--- a/test-suite/prerequisite/ssr_mini_mathcomp.v
+++ b/test-suite/prerequisite/ssr_mini_mathcomp.v
@@ -695,7 +695,7 @@ Structure type := Pack {sort; _ : class_of sort; _ : Type}.
 Local Coercion sort : type >-> Sortclass.
 Variables (T : Type) (cT : type).
 Definition class := let: Pack _ c _ as cT' := cT return class_of cT' in c.
-Definition clone c of phant_id class c := @Pack T c T.
+Definition clone c & phant_id class c := @Pack T c T.
 Let xT := let: Pack T _ _ := cT in T.
 Notation xclass := (class : class_of xT).
 
@@ -798,7 +798,7 @@ Structure type : Type := Pack {sort : Type; _ : class_of sort; _ : Type}.
 Local Coercion sort : type >-> Sortclass.
 Variables (T : Type) (cT : type).
 Definition class := let: Pack _ c _ as cT' := cT return class_of cT' in c.
-Definition clone c of phant_id class c := @Pack T c T.
+Definition clone c & phant_id class c := @Pack T c T.
 Let xT := let: Pack T _ _ := cT in T.
 Notation xclass := (class : class_of xT).
 
@@ -948,7 +948,7 @@ Structure type : Type := Pack {sort; _ : class_of sort; _ : Type}.
 Local Coercion sort : type >-> Sortclass.
 Variables (T : Type) (cT : type).
 Definition class := let: Pack _ c _ as cT' := cT return class_of cT' in c.
-Definition clone c of phant_id class c := @Pack T c T.
+Definition clone c & phant_id class c := @Pack T c T.
 Let xT := let: Pack T _ _ := cT in T.
 Notation xclass := (class : class_of xT).
 
diff --git a/theories/Corelib/ssr/ssreflect.v b/theories/Corelib/ssr/ssreflect.v
index 458d179955a3..ee59e60a7753 100644
--- a/theories/Corelib/ssr/ssreflect.v
+++ b/theories/Corelib/ssr/ssreflect.v
@@ -231,7 +231,7 @@ 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.
+Definition get_by vT sT & sT -> vT := @get vT sT.
 
 End TheCanonical.
 

From 24a453441d0d8ca357fe862df5067c658a9a5ab2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Thu, 26 Feb 2026 15:57:27 +0100
Subject: [PATCH 164/578] Fix incorrect test-suite/_CoqProject

the makefile uses -R not -Q
---
 test-suite/_CoqProject | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

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

From ca415d188e4479956dc2678b058829e931628fb8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Wed, 11 Feb 2026 16:30:18 +0100
Subject: [PATCH 165/578] Typecheck ignoring errors instead of globalize for
 Ltac2 Globalize

This adds a mode to ltac2 typechecking which accumulates errors
instead of raising an exception at the first error.

Ltac2 Globalize then uses this mode and ignores the accumulated errors
(we could print them instead).

The accumulation mode could also be used to provide all errors from an
ltac2 expression in regular code in the future (with a flag).

Together with #21617 this gets us closer to removing the globalize
code (which doesn't work on quotations so should be avoided).
---
 plugins/ltac2/tac2entries.ml                |  5 +-
 plugins/ltac2/tac2extravals.ml              |  2 -
 plugins/ltac2/tac2intern.ml                 | 81 ++++++++++++---------
 plugins/ltac2/tac2intern.mli                |  7 +-
 plugins/ltac2/tac2typing_env.ml             | 37 ++++++++--
 plugins/ltac2/tac2typing_env.mli            | 10 ++-
 test-suite/output/ltac2_check_globalize.out | 21 +++---
 test-suite/output/ltac2_typed_notations.out | 16 ++--
 8 files changed, 109 insertions(+), 70 deletions(-)

diff --git a/plugins/ltac2/tac2entries.ml b/plugins/ltac2/tac2entries.ml
index 1619ee61b78a..0a435d4e0aa0 100644
--- a/plugins/ltac2/tac2entries.ml
+++ b/plugins/ltac2/tac2entries.ml
@@ -1599,8 +1599,9 @@ 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 *)
 
diff --git a/plugins/ltac2/tac2extravals.ml b/plugins/ltac2/tac2extravals.ml
index eb685acef533..1f5b4fcdbef1 100644
--- a/plugins/ltac2/tac2extravals.ml
+++ b/plugins/ltac2/tac2extravals.ml
@@ -418,7 +418,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 =
@@ -438,7 +437,6 @@ let () =
 
 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
diff --git a/plugins/ltac2/tac2intern.ml b/plugins/ltac2/tac2intern.ml
index c4f1aa99ed0c..7e68945a954b 100644
--- a/plugins/ltac2/tac2intern.ml
+++ b/plugins/ltac2/tac2intern.ml
@@ -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
@@ -1521,29 +1526,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
@@ -1583,6 +1591,17 @@ 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 () 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
   (* Initialize type parameters *)
@@ -1776,10 +1795,6 @@ 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 { Goptions.get = typed_notations } =
   Goptions.declare_bool_option_and_ref
     ~key:["Ltac2";"Typed";"Notations"] ~value:true ()
diff --git a/plugins/ltac2/tac2intern.mli b/plugins/ltac2/tac2intern.mli
index ab1a7a5f5e7c..986b07b8ed02 100644
--- a/plugins/ltac2/tac2intern.mli
+++ b/plugins/ltac2/tac2intern.mli
@@ -19,6 +19,9 @@ val intern_typedef : (KerName.t * int) Id.Map.t -> raw_quant_typedef -> glb_quan
 val intern_open_type : raw_typexpr -> type_scheme
 val intern_notation_data : Id.Set.t -> raw_tacexpr -> Tac2env.notation_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 ->
   Genintern.glob_sign ->
@@ -66,10 +69,6 @@ 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/tac2typing_env.ml b/plugins/ltac2/tac2typing_env.ml
index 4f2fac4a0eb9..f5030e07f21e 100644
--- a/plugins/ltac2/tac2typing_env.ml
+++ b/plugins/ltac2/tac2typing_env.ml
@@ -105,6 +105,9 @@ 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 *)
@@ -118,17 +121,30 @@ 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 *)
 }
 
-let empty_env ?(strict=true) () = {
+let empty_env ?(strict=true) ?(accumulate_errors=false) () = {
   env_var = Id.Map.empty;
   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;
 }
 
+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 set_rec self env = { env with env_rec = self }
@@ -328,7 +344,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 +359,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..db5894e43bfa 100644
--- a/plugins/ltac2/tac2typing_env.mli
+++ b/plugins/ltac2/tac2typing_env.mli
@@ -21,8 +21,14 @@ 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 -> 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 set_rec : (KerName.t * int) Id.Map.t -> t -> t
 
diff --git a/test-suite/output/ltac2_check_globalize.out b/test-suite/output/ltac2_check_globalize.out
index 095dffab1b35..da333a6bdb37 100644
--- a/test-suite/output/ltac2_check_globalize.out
+++ b/test-suite/output/ltac2_check_globalize.out
@@ -16,25 +16,26 @@ let x := fun x => x in
 let _ := x 1 in
 let _ := x "" in
 () : unit
-let accu := { contents := []} in
-(let x := fun x => accu.(contents) := (x :: accu.(contents)) in
- let _ := x 1 in
- let _ := x "" in
- ());
+let accu := { contents := [] } in
+let _ :=
+  let x := fun x => accu.(contents) := (x :: accu.(contents)) in
+  let _ := x 1 in
+  let _ := x "" in
+  ()
+in
 accu.(contents)
 File "./output/ltac2_check_globalize.v", line 38, characters 0-144:
 The command has indeed failed with message:
 This expression has type string but an expression was expected of type 
 int
-let (m : '__α Pattern.goal_matching) :=
-  ([(([(None, (Pattern.MatchPattern, pat:(_)))],
+let m :=
+  [(([(None, (Pattern.MatchPattern, pat:(_)))],
       (Pattern.MatchPattern, pat:(_))),
      (fun h =>
       let h := Array.get h 0 in
       fun _ => fun _ => fun _ => fun _ => Std.clear h));
-     (([], (Pattern.MatchPattern, pat:(_))),
+    (([], (Pattern.MatchPattern, pat:(_))),
       (fun _ => fun _ => fun _ => fun _ => fun _ => ()))]
-    : _ Pattern.goal_matching)
 in
-Pattern.lazy_goal_match0 false m :'__α
+Pattern.lazy_goal_match0 false m
 constr:(ltac2:(()))
diff --git a/test-suite/output/ltac2_typed_notations.out b/test-suite/output/ltac2_typed_notations.out
index 1dc6a480f925..caa4e8b6c12b 100644
--- a/test-suite/output/ltac2_typed_notations.out
+++ b/test-suite/output/ltac2_typed_notations.out
@@ -2,12 +2,10 @@ File "./output/ltac2_typed_notations.v", line 5, characters 9-10:
 The command has indeed failed with message:
 This expression has type bool but an expression was expected of type 
 constr
-fun (b : bool) =>
-(let c := b in
- let (m : '__α Pattern.constr_matching) :=
-   [(Pattern.MatchPattern, pat:(true),
-     (fun _ => fun (_ : constr array) => true));
-     (Pattern.MatchPattern, pat:(false),
-      (fun _ => fun (_ : constr array) => false))]
- with (t : constr) := c in
- Pattern.one_match0 t m :'__α : bool)
+fun b =>
+let c := b in
+let m :=
+  [(Pattern.MatchPattern, pat:(true), (fun _ => fun _ => true));
+    (Pattern.MatchPattern, pat:(false), (fun _ => fun _ => false))]
+with t := c in
+Pattern.one_match0 t m

From b6ec7b61524109468fa476aaaa907f920d75ada9 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Thu, 26 Feb 2026 17:38:22 +0100
Subject: [PATCH 166/578] Stop using infer_conv_ustate in unification

The type compatibility check throws away the univ constraints, so we
use a univ-ignoring comparison instead.

The main call is incorrect when alpha equality infers unsatisfiable
constraints and reducing is needed.

Fix #21674
---
 pretyping/reductionops.ml   | 52 +++++++++++++++++--------------------
 pretyping/reductionops.mli  |  5 ++--
 pretyping/unification.ml    | 41 +++++++++++++----------------
 test-suite/bugs/bug_21674.v | 28 ++++++++++++++++++++
 4 files changed, 72 insertions(+), 54 deletions(-)
 create mode 100644 test-suite/bugs/bug_21674.v

diff --git a/pretyping/reductionops.ml b/pretyping/reductionops.ml
index 31f0de041226..9343cd15fa0f 100644
--- a/pretyping/reductionops.ml
+++ b/pretyping/reductionops.ml
@@ -1266,6 +1266,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 +1396,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) -> Empty.abort 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 }
 
diff --git a/pretyping/reductionops.mli b/pretyping/reductionops.mli
index fe05059bee68..f003559812f0 100644
--- a/pretyping/reductionops.mli
+++ b/pretyping/reductionops.mli
@@ -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
diff --git a/pretyping/unification.ml b/pretyping/unification.ml
index 851831124a88..95ae3f13d918 100644
--- a/pretyping/unification.ml
+++ b/pretyping/unification.ml
@@ -1009,19 +1009,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
@@ -1473,22 +1472,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)
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 *)

From 179b0fdb1ca6e0ab1995866520df6b94559e4a25 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Thu, 26 Feb 2026 15:07:15 +0100
Subject: [PATCH 167/578] Rename soft_evaluable_of_global_reference ->
 evaluable_of_global_reference

---
 dev/ci/user-overlays/21669-SkySkimmer-eval-ref.sh | 3 +++
 plugins/ltac/tacintern.ml                         | 2 +-
 pretyping/tacred.ml                               | 4 +++-
 pretyping/tacred.mli                              | 6 +++++-
 tactics/redexpr.ml                                | 2 +-
 vernac/classes.ml                                 | 2 +-
 vernac/comHints.ml                                | 7 +------
 7 files changed, 15 insertions(+), 11 deletions(-)
 create mode 100644 dev/ci/user-overlays/21669-SkySkimmer-eval-ref.sh

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/plugins/ltac/tacintern.ml b/plugins/ltac/tacintern.ml
index 2e91c7da2139..ed4a97aecfca 100644
--- a/plugins/ltac/tacintern.ml
+++ b/plugins/ltac/tacintern.ml
@@ -305,7 +305,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
diff --git a/pretyping/tacred.ml b/pretyping/tacred.ml
index 0a61972e21ab..0b174425dbbc 100644
--- a/pretyping/tacred.ml
+++ b/pretyping/tacred.ml
@@ -84,7 +84,7 @@ let value_of_evaluable_ref env sigma evref u =
   | 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,6 +94,8 @@ let soft_evaluable_of_global_reference ?loc = function
   | GlobRef.VarRef id -> Evaluable.EvalVarRef id
   | r -> error_not_evaluable ?loc r
 
+let soft_evaluable_of_global_reference = evaluable_of_global_reference
+
 let global_of_evaluable_reference = function
   | Evaluable.EvalConstRef cst -> GlobRef.ConstRef cst
   | Evaluable.EvalVarRef id -> GlobRef.VarRef id
diff --git a/pretyping/tacred.mli b/pretyping/tacred.mli
index 5e789ecb6943..11ed06bd8542 100644
--- a/pretyping/tacred.mli
+++ b/pretyping/tacred.mli
@@ -42,10 +42,14 @@ val is_evaluable : Environ.env -> Evd.evar_map -> Evaluable.t -> bool
 exception NotEvaluableRef of GlobRef.t
 val error_not_evaluable : ?loc:Loc.t -> GlobRef.t -> 'a
 
-val soft_evaluable_of_global_reference :
+val 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. *)
 
+val soft_evaluable_of_global_reference :
+  ?loc:Loc.t -> GlobRef.t -> Evaluable.t
+[@@deprecated "(9.3) Use evaluable_of_global_reference."]
+
 val global_of_evaluable_reference :
   Evaluable.t -> GlobRef.t
 
diff --git a/tactics/redexpr.ml b/tactics/redexpr.ml
index 47cbc3dc16e3..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;
diff --git a/vernac/classes.ml b/vernac/classes.ml
index 6b5e46601267..c2b7d7438484 100644
--- a/vernac/classes.ml
+++ b/vernac/classes.ml
@@ -40,7 +40,7 @@ let set_typeclass_transparency ?typeclasses_db ~locality c b =
 
 let set_typeclass_transparency_com ~locality refs b =
   let refs = List.map
-      (fun x -> Tacred.soft_evaluable_of_global_reference
+      (fun x -> Tacred.evaluable_of_global_reference
           (Smartlocate.global_with_alias x))
       refs
   in
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 ->

From 6c38b9d8e0975025a3674eb4961ffce90d6cb50c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Fri, 27 Feb 2026 15:57:38 +0100
Subject: [PATCH 168/578] Optimize a fast-path in Genlambda compilation.

Rather than computing first whether a variable appears in a term in O(n)
and then checking that some term is a value in O(1), we flip the order.
This prevents a superlinear blowup in an optimization pass in Genlambda
that was observable in #13606.
---
 kernel/genlambda.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/kernel/genlambda.ml b/kernel/genlambda.ml
index 0c6fa358fc2c..31d75df1ca30 100644
--- a/kernel/genlambda.ml
+++ b/kernel/genlambda.ml
@@ -525,7 +525,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')

From d7397cb320b312f46edad2f28241e0d4e1f3cd03 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Sun, 1 Mar 2026 10:05:34 +0100
Subject: [PATCH 169/578] Bench sort vosize.log by % change then absolute
 change

---
 dev/bench/bench.sh | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/dev/bench/bench.sh b/dev/bench/bench.sh
index 6e40e014fe50..5dd12ce0d7e9 100755
--- a/dev/bench/bench.sh
+++ b/dev/bench/bench.sh
@@ -679,6 +679,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

From 1e160311cf247852c4c812380823ae878db757c8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Mon, 2 Mar 2026 13:32:02 +0100
Subject: [PATCH 170/578] Fix typo in frel/frel conversion
 skip_irrelevant_stacks

AFAICT this does not lead to an actual bug because by typing we can
only have nontrivial stacks after skipping the irrelevant part by
having a case, but case from irrelevant to relevant are caseinvert and
don't go in the stack.

I guess it could cause issues when elimination checking is unset (lean importer).
---
 kernel/conversion.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/kernel/conversion.ml b/kernel/conversion.ml
index 3a04408a9242..34ac100da015 100644
--- a/kernel/conversion.ml
+++ b/kernel/conversion.ml
@@ -429,7 +429,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

From eb7354b5e75a002b145e0340a61eb29dccae9d7a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Mon, 2 Mar 2026 13:54:31 +0100
Subject: [PATCH 171/578] Fix missing relevance substitution for fprod

Fix #21691
---
 dev/doc/critical-bugs.md    | 14 ++++++++++++++
 kernel/cClosure.ml          |  2 +-
 test-suite/bugs/bug_21691.v |  8 ++++++++
 3 files changed, 23 insertions(+), 1 deletion(-)
 create mode 100644 test-suite/bugs/bug_21691.v

diff --git a/dev/doc/critical-bugs.md b/dev/doc/critical-bugs.md
index 586dbaf6b980..b3ee8f710011 100644
--- a/dev/doc/critical-bugs.md
+++ b/dev/doc/critical-bugs.md
@@ -40,6 +40,7 @@ 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)
     - [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)
@@ -449,6 +450,19 @@ 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)
+
 ### Primitive projections
 
 #### check of guardedness of extra arguments of primitive projections missing
diff --git a/kernel/cClosure.ml b/kernel/cClosure.ml
index aad194b2c9a1..1b6c582cc82f 100644
--- a/kernel/cClosure.ml
+++ b/kernel/cClosure.ml
@@ -577,7 +577,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,
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 *)

From a57574e79bc861d30926f20d2f425eaa3ec1f1c6 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Mon, 2 Mar 2026 14:34:24 +0100
Subject: [PATCH 172/578] Preserve backtrace for "tried to normalize ill typed
 term" exceptions

---
 pretyping/reductionops.ml |  6 ++++--
 tactics/generalize.ml     | 12 +++---------
 tactics/induction.ml      |  2 +-
 tactics/tacticErrors.ml   |  2 +-
 vernac/himsg.ml           |  4 ++--
 5 files changed, 11 insertions(+), 15 deletions(-)

diff --git a/pretyping/reductionops.ml b/pretyping/reductionops.ml
index 31f0de041226..7c02d8adc8f2 100644
--- a/pretyping/reductionops.ml
+++ b/pretyping/reductionops.ml
@@ -1146,7 +1146,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 +1156,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
diff --git a/tactics/generalize.ml b/tactics/generalize.ml
index 28a1d8003575..cf11b59e1875 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
diff --git a/tactics/induction.ml b/tactics/induction.ml
index 1fd67fc6ab18..8d15d260e2f4 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)
 
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/vernac/himsg.ml b/vernac/himsg.ml
index 6878e4afbc6d..69aee8d76309 100644
--- a/vernac/himsg.ml
+++ b/vernac/himsg.ml
@@ -1754,7 +1754,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)
 
@@ -1823,7 +1823,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)
 

From 4260f3d8b5fec3af501b771a7339e9a9304bc520 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Fri, 13 Feb 2026 14:41:10 +0100
Subject: [PATCH 173/578] Constrintern_intern_core takes glob_sign instead of
 args generated from it

---
 interp/constrintern.ml         | 14 +++++++++++---
 interp/constrintern.mli        |  8 +++-----
 plugins/ltac/tacintern.ml      | 11 +++--------
 plugins/ltac2/tac2extravals.ml |  8 +-------
 4 files changed, 18 insertions(+), 23 deletions(-)

diff --git a/interp/constrintern.ml b/interp/constrintern.ml
index 5fae22ddcf7b..77fac5efa5dc 100644
--- a/interp/constrintern.ml
+++ b/interp/constrintern.ml
@@ -2963,13 +2963,21 @@ 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 intern_core kind ?(pattern_mode=false) ist c =
+  let env = ist.Genintern.genv in
+  let sigma = Evd.from_env env in
+  let Genintern.{ intern_ids = ids; notation_variable_status = vl } = ist.intern_sign in
+  let ltacvars = {
+    ltac_vars = ist.ltacvars;
+    ltac_bound = Id.Set.empty;
+    ltac_extra = ist.extra;
+  }
+  in
   let tmp_scope = scope_of_type_kind env sigma 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;
+    {ids; strict_check = Some ist.strict_check; pattern_mode;
      local_univs = { bound = bound_univs sigma; unb_univs = true };
      tmp_scope; scopes = []; impls;
      binder_block_names = Some (Some k); ntn_binding_ids = Id.Set.empty}
diff --git a/interp/constrintern.mli b/interp/constrintern.mli
index d602bc404d47..c53597e3a9f7 100644
--- a/interp/constrintern.mli
+++ b/interp/constrintern.mli
@@ -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 *)
diff --git a/plugins/ltac/tacintern.ml b/plugins/ltac/tacintern.ml
index 2e91c7da2139..ec78d1c1bcbf 100644
--- a/plugins/ltac/tacintern.ml
+++ b/plugins/ltac/tacintern.ml
@@ -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
diff --git a/plugins/ltac2/tac2extravals.ml b/plugins/ltac2/tac2extravals.ml
index 1b0149258ea5..dd0d20b13510 100644
--- a/plugins/ltac2/tac2extravals.ml
+++ b/plugins/ltac2/tac2extravals.ml
@@ -45,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 =

From a79dc8f5a61c83fc13f2135b33eedc921d1c694b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Fri, 13 Feb 2026 15:12:31 +0100
Subject: [PATCH 174/578] Check universes are declared in constr inside tactics

Close #21616
---
 .../21627-SkySkimmer-intern-constr-in-tac.sh  |  3 +++
 .../21627-intern-constr-in-tac-Fixed.rst      |  6 +++++
 interp/constrintern.ml                        | 15 ++++++++---
 interp/genintern.ml                           |  8 +++---
 interp/genintern.mli                          |  3 ++-
 plugins/ltac/tacentries.ml                    |  6 +++--
 plugins/ltac/tacintern.ml                     |  6 ++---
 plugins/ltac/tacintern.mli                    |  2 +-
 plugins/ltac/tacinterp.ml                     | 13 ++++++----
 plugins/ltac2/tac2entries.ml                  | 13 +++++-----
 plugins/ltac2/tac2intern.ml                   | 25 ++++++++++---------
 plugins/ltac2/tac2intern.mli                  |  2 +-
 plugins/ltac2/tac2typing_env.ml               |  7 +++++-
 plugins/ltac2/tac2typing_env.mli              |  4 ++-
 tactics/gentactic.ml                          |  3 ++-
 test-suite/bugs/bug_21616.v                   |  6 +++++
 16 files changed, 81 insertions(+), 41 deletions(-)
 create mode 100644 dev/ci/user-overlays/21627-SkySkimmer-intern-constr-in-tac.sh
 create mode 100644 doc/changelog/02-specification-language/21627-intern-constr-in-tac-Fixed.rst
 create mode 100644 test-suite/bugs/bug_21616.v

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/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 <https://github.com/rocq-prover/rocq/pull/21627>`_,
+  fixes `#21616 <https://github.com/rocq-prover/rocq/issues/21616>`_,
+  by Gaëtan Gilbert).
diff --git a/interp/constrintern.ml b/interp/constrintern.ml
index 77fac5efa5dc..647cbf4f3ac8 100644
--- a/interp/constrintern.ml
+++ b/interp/constrintern.ml
@@ -2731,6 +2731,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 = {
@@ -2965,20 +2966,26 @@ let interp_constr_pattern env sigma ?as_type ?strict_check c =
 
 let intern_core kind ?(pattern_mode=false) ist c =
   let env = ist.Genintern.genv in
-  let sigma = Evd.from_env env in
-  let Genintern.{ intern_ids = ids; notation_variable_status = vl } = ist.intern_sign 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
-  let tmp_scope = scope_of_type_kind env sigma kind 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 = Some ist.strict_check; pattern_mode;
-     local_univs = { bound = bound_univs sigma; unb_univs = true };
+     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
diff --git a/interp/genintern.ml b/interp/genintern.ml
index 0bebcb63817a..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;
 }
 
diff --git a/interp/genintern.mli b/interp/genintern.mli
index 4b4552fdff9a..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
diff --git a/plugins/ltac/tacentries.ml b/plugins/ltac/tacentries.ml
index 147b744ebf15..e8381ae1a2bb 100644
--- a/plugins/ltac/tacentries.ml
+++ b/plugins/ltac/tacentries.ml
@@ -350,7 +350,7 @@ 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 =
@@ -380,7 +380,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
diff --git a/plugins/ltac/tacintern.ml b/plugins/ltac/tacintern.ml
index ec78d1c1bcbf..ecfbd84427a5 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 *)
 
@@ -705,10 +705,10 @@ let intern_ltac_in_term ?loc:_ 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
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 36dc70975291..59af118cb231 100644
--- a/plugins/ltac/tacinterp.ml
+++ b/plugins/ltac/tacinterp.ml
@@ -2037,12 +2037,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
@@ -2056,18 +2058,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
diff --git a/plugins/ltac2/tac2entries.ml b/plugins/ltac2/tac2entries.ml
index 0a435d4e0aa0..2fb4ceff9fc1 100644
--- a/plugins/ltac2/tac2entries.ml
+++ b/plugins/ltac2/tac2entries.ml
@@ -360,7 +360,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)
@@ -1245,7 +1245,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 +1264,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 +1273,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
@@ -1589,7 +1590,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() ++
@@ -1607,7 +1608,7 @@ let globalize_expr e =
 
 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/tac2intern.ml b/plugins/ltac2/tac2intern.ml
index d859a2510c63..ea1760ea3063 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
@@ -1376,7 +1376,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
@@ -1580,8 +1580,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
@@ -1592,7 +1592,7 @@ let intern ~strict ctx e =
   (e, (!count, t))
 
 let intern_accumulate_errors ~strict ctx e =
-  let env = empty_env ~strict ~accumulate_errors:true () in
+  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
@@ -1603,7 +1603,8 @@ let intern_accumulate_errors ~strict ctx e =
   (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
@@ -1646,7 +1647,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
@@ -1656,7 +1657,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
@@ -1801,7 +1802,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
@@ -2102,7 +2103,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
@@ -2151,7 +2152,7 @@ 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
@@ -2195,7 +2196,7 @@ let intern_var_quotation_gen ?loc ~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 *)
diff --git a/plugins/ltac2/tac2intern.mli b/plugins/ltac2/tac2intern.mli
index 986b07b8ed02..ff0ced7dcf53 100644
--- a/plugins/ltac2/tac2intern.mli
+++ b/plugins/ltac2/tac2intern.mli
@@ -14,7 +14,7 @@ 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
diff --git a/plugins/ltac2/tac2typing_env.ml b/plugins/ltac2/tac2typing_env.ml
index f5030e07f21e..822c6902b22c 100644
--- a/plugins/ltac2/tac2typing_env.ml
+++ b/plugins/ltac2/tac2typing_env.ml
@@ -123,9 +123,11 @@ type t = {
   (** 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) ?(accumulate_errors=false) () = {
+let empty_env ?(strict=true) ?(accumulate_errors=false) univs () = {
   env_var = Id.Map.empty;
   env_cst = UF.create ();
   env_als = ref Id.Map.empty;
@@ -133,6 +135,7 @@ let empty_env ?(strict=true) ?(accumulate_errors=false) () = {
   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 =
@@ -147,6 +150,8 @@ let get_errors env =
 
 let env_strict env = env.env_strict
 
+let env_univs env = env.env_univs
+
 let set_rec self env = { env with env_rec = self }
 
 let reject_unbound_tvar env = { env with env_opn = false }
diff --git a/plugins/ltac2/tac2typing_env.mli b/plugins/ltac2/tac2typing_env.mli
index db5894e43bfa..ce1324790b19 100644
--- a/plugins/ltac2/tac2typing_env.mli
+++ b/plugins/ltac2/tac2typing_env.mli
@@ -22,7 +22,7 @@ end
 type t
 
 (** default strict:true, accumulate_errors:false *)
-val empty_env : ?strict:bool -> ?accumulate_errors:bool -> unit -> t
+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
@@ -34,6 +34,8 @@ 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/tactics/gentactic.ml b/tactics/gentactic.ml
index bea99846b40f..66176796190a 100644
--- a/tactics/gentactic.ml
+++ b/tactics/gentactic.ml
@@ -85,7 +85,8 @@ let register_intern tag intern =
 
 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) with ltacvars } 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)
 
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}.

From 58c2526d16073069fdc5fd70c0d93de0e553743e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Mon, 2 Mar 2026 13:39:26 +0100
Subject: [PATCH 175/578] Fix missing stack conversion for fcaseinvert

Fix #21690
---
 dev/doc/critical-bugs.md    | 14 ++++++++++++++
 kernel/conversion.ml        |  3 ++-
 test-suite/bugs/bug_21690.v | 28 ++++++++++++++++++++++++++++
 3 files changed, 44 insertions(+), 1 deletion(-)
 create mode 100644 test-suite/bugs/bug_21690.v

diff --git a/dev/doc/critical-bugs.md b/dev/doc/critical-bugs.md
index b3ee8f710011..c3c745c187ae 100644
--- a/dev/doc/critical-bugs.md
+++ b/dev/doc/critical-bugs.md
@@ -41,6 +41,7 @@ This file recollects knowledge about critical bugs found in Coq since version 8.
       - [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)
     - [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)
@@ -463,6 +464,19 @@ fix.
   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.
+
 ### Primitive projections
 
 #### check of guardedness of extra arguments of primitive projections missing
diff --git a/kernel/conversion.ml b/kernel/conversion.ml
index 3a04408a9242..6bac57b1ac41 100644
--- a/kernel/conversion.ml
+++ b/kernel/conversion.ml
@@ -771,7 +771,8 @@ 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
+      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
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.

From 6b8ea1e5bf900a81799c5af0ccb936c4acc8c431 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Mon, 2 Mar 2026 14:20:53 +0100
Subject: [PATCH 176/578] Fix incorrect discharge of squashing info

Fix #21694
---
 dev/doc/critical-bugs.md    | 13 +++++++++++++
 kernel/cooking.ml           |  3 +++
 kernel/cooking.mli          |  2 ++
 kernel/discharge.ml         | 13 ++++++++++++-
 test-suite/bugs/bug_21694.v | 27 +++++++++++++++++++++++++++
 5 files changed, 57 insertions(+), 1 deletion(-)
 create mode 100644 test-suite/bugs/bug_21694.v

diff --git a/dev/doc/critical-bugs.md b/dev/doc/critical-bugs.md
index c3c745c187ae..ab48ce07db7d 100644
--- a/dev/doc/critical-bugs.md
+++ b/dev/doc/critical-bugs.md
@@ -42,6 +42,7 @@ This file recollects knowledge about critical bugs found in Coq since version 8.
       - [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)
     - [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)
@@ -477,6 +478,18 @@ fix.
 - 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)
+
 ### Primitive projections
 
 #### check of guardedness of extra arguments of primitive projections missing
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/discharge.ml b/kernel/discharge.ml
index cf37ea0d5637..8ad2fb5dec3c 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,7 +151,7 @@ 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;
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." *)

From 6049d4d0334eaa8173df4f9837a90fdaa4d08a63 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Tue, 3 Mar 2026 08:07:23 +0100
Subject: [PATCH 177/578] Fix missing substitution in module aliasing.

Fixes #21685: Module alias corrupts delta-resolver.
---
 dev/doc/critical-bugs.md    | 12 ++++++++++++
 kernel/modops.ml            |  5 +++--
 test-suite/bugs/bug_21695.v | 23 +++++++++++++++++++++++
 3 files changed, 38 insertions(+), 2 deletions(-)
 create mode 100644 test-suite/bugs/bug_21695.v

diff --git a/dev/doc/critical-bugs.md b/dev/doc/critical-bugs.md
index c3c745c187ae..acfad4e02319 100644
--- a/dev/doc/critical-bugs.md
+++ b/dev/doc/critical-bugs.md
@@ -347,6 +347,18 @@ 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
+
 ### Universes
 
 #### issue with two parameters in the same universe level
diff --git a/kernel/modops.ml b/kernel/modops.ml
index cb696805b2fd..37f6fd8d09be 100644
--- a/kernel/modops.ml
+++ b/kernel/modops.ml
@@ -270,7 +270,8 @@ 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
@@ -331,7 +332,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
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.
+*)

From b9e972bbdd837921c352dc979ecc82db0ad1282b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Mon, 2 Mar 2026 14:06:43 +0100
Subject: [PATCH 178/578] Fix missing univ subst of array instance in lazy

Fix #21692
---
 dev/doc/critical-bugs.md    | 12 ++++++++++++
 kernel/cClosure.ml          |  1 +
 test-suite/bugs/bug_21692.v |  8 ++++++++
 3 files changed, 21 insertions(+)
 create mode 100644 test-suite/bugs/bug_21692.v

diff --git a/dev/doc/critical-bugs.md b/dev/doc/critical-bugs.md
index ab48ce07db7d..f2bfc0bce494 100644
--- a/dev/doc/critical-bugs.md
+++ b/dev/doc/critical-bugs.md
@@ -43,6 +43,7 @@ This file recollects knowledge about critical bugs found in Coq since version 8.
       - [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)
     - [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)
@@ -490,6 +491,17 @@ fix.
 - 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
+
 ### Primitive projections
 
 #### check of guardedness of extra arguments of primitive projections missing
diff --git a/kernel/cClosure.ml b/kernel/cClosure.ml
index 1b6c582cc82f..95d947515318 100644
--- a/kernel/cClosure.ml
+++ b/kernel/cClosure.ml
@@ -1467,6 +1467,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
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)}". *)

From 0bbb0bccc91c0836157e492d22cda53142f74725 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Mon, 2 Mar 2026 12:45:24 +0100
Subject: [PATCH 179/578] Fix typo in convert_return_clause

Does not lead to a bug AFAICT due to cumulativity invariants.
---
 kernel/conversion.ml | 6 +++++-
 1 file changed, 5 insertions(+), 1 deletion(-)

diff --git a/kernel/conversion.ml b/kernel/conversion.ml
index 2d992c0f5e66..0e974fc66679 100644
--- a/kernel/conversion.ml
+++ b/kernel/conversion.ml
@@ -771,6 +771,10 @@ 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
+      (* 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
 
@@ -918,7 +922,7 @@ 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

From 5afe5ec142bfd8136947f436cfa755f94416ebdf Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Mon, 2 Mar 2026 13:20:19 +0100
Subject: [PATCH 180/578] Fix double substitution in letins from indices in
 match return clause

Fix #21689
---
 dev/doc/critical-bugs.md    | 14 ++++++++++++++
 kernel/conversion.ml        | 13 ++++++-------
 test-suite/bugs/bug_21689.v |  7 +++++++
 3 files changed, 27 insertions(+), 7 deletions(-)
 create mode 100644 test-suite/bugs/bug_21689.v

diff --git a/dev/doc/critical-bugs.md b/dev/doc/critical-bugs.md
index f2bfc0bce494..196faf499f90 100644
--- a/dev/doc/critical-bugs.md
+++ b/dev/doc/critical-bugs.md
@@ -44,6 +44,7 @@ This file recollects knowledge about critical bugs found in Coq since version 8.
       - [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)
     - [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)
@@ -502,6 +503,19 @@ fix.
 - 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/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)
+
 ### Primitive projections
 
 #### check of guardedness of extra arguments of primitive projections missing
diff --git a/kernel/conversion.ml b/kernel/conversion.ml
index 0e974fc66679..aa4c0bd3a1a4 100644
--- a/kernel/conversion.ml
+++ b/kernel/conversion.ml
@@ -285,12 +285,11 @@ let eta_expand_constructor env ((ind,ctor),u as pctor) =
   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
@@ -905,9 +904,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
@@ -926,7 +925,7 @@ and convert_return_clause mib mip l2r infos e1 e2 l1 l2 u1 u2 pms1 pms2 p1 p2 cu
       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
 
@@ -939,7 +938,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
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")." *)

From 3e41033bd93a2d84c3cbcaae26268774fdda3401 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Tue, 3 Mar 2026 09:15:24 +0100
Subject: [PATCH 181/578] Remove Mod_declaration.subst_dom and its
 implementation.

This is now unused, all functions substituting on the domain of
delta-resolvers rely directly on the Mod_subst API.
---
 kernel/mod_declarations.ml  | 4 +---
 kernel/mod_declarations.mli | 1 -
 2 files changed, 1 insertion(+), 4 deletions(-)

diff --git a/kernel/mod_declarations.ml b/kernel/mod_declarations.ml
index 9d6a46221777..53fdd6edd55d 100644
--- a/kernel/mod_declarations.ml
+++ b/kernel/mod_declarations.ml
@@ -273,15 +273,13 @@ 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 | Shallow of Mod_subst.substitution
 
-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
diff --git a/kernel/mod_declarations.mli b/kernel/mod_declarations.mli
index 0daff971fee8..edecce2cf6ea 100644
--- a/kernel/mod_declarations.mli
+++ b/kernel/mod_declarations.mli
@@ -96,7 +96,6 @@ val set_retroknowledge : module_body -> Retroknowledge.action list -> module_bod
 (** {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

From f42a3d244f5dbd262a172dd45d86f44d519031c3 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Tue, 3 Mar 2026 09:24:58 +0100
Subject: [PATCH 182/578] Stronger static invariant for
 Mod_subst.subst_dom_delta_resolver.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

This function is only used with trivial substitutions in order to
rename the root of the resolver, basically implementing α-equivalence
in a named world.
---
 kernel/mod_subst.ml  | 7 ++++---
 kernel/mod_subst.mli | 5 +++--
 kernel/modops.ml     | 5 ++---
 3 files changed, 9 insertions(+), 8 deletions(-)

diff --git a/kernel/mod_subst.ml b/kernel/mod_subst.ml
index 88088010629c..b05bf957ce20 100644
--- a/kernel/mod_subst.ml
+++ b/kernel/mod_subst.ml
@@ -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..d3bcf483120d 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 :
diff --git a/kernel/modops.ml b/kernel/modops.ml
index 37f6fd8d09be..a8e298a50b81 100644
--- a/kernel/modops.ml
+++ b/kernel/modops.ml
@@ -278,7 +278,7 @@ let rec strengthen_and_subst_module mb subst mp_from mp_to =
           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
@@ -380,10 +380,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' =

From 5512c6781c633f91c8d2fca481196a0cd73ead4c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Tue, 3 Mar 2026 10:27:36 +0100
Subject: [PATCH 183/578] Remove the shallow module substitution API.

There was only one caller of this function, and it was applying it to
a substitution defined as a map_mp with an empty resolver. In this
situation, performing a shallow substitution was equivalent to a normal
one. Note that shallow substitutions where introduced in 3b63821 in
order to preserve the semantics with certainty, but the reason the code
was written like that in the first place was probably a typo introduced
long ago when the module system was rehauled.
---
 kernel/mod_declarations.ml  | 4 +---
 kernel/mod_declarations.mli | 1 -
 kernel/modops.ml            | 2 +-
 3 files changed, 2 insertions(+), 5 deletions(-)

diff --git a/kernel/mod_declarations.ml b/kernel/mod_declarations.ml
index 53fdd6edd55d..ae76240bffa8 100644
--- a/kernel/mod_declarations.ml
+++ b/kernel/mod_declarations.ml
@@ -273,17 +273,15 @@ let functorize_module params mb =
 
 (** Substitutions of modular structures *)
 
-type subst_kind = Codom | Both | Neither | Shallow of Mod_subst.substitution
+type subst_kind = Codom | Both | Neither
 
 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
 | 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
diff --git a/kernel/mod_declarations.mli b/kernel/mod_declarations.mli
index edecce2cf6ea..c633b742be6a 100644
--- a/kernel/mod_declarations.mli
+++ b/kernel/mod_declarations.mli
@@ -98,7 +98,6 @@ val set_retroknowledge : module_body -> Retroknowledge.action list -> module_bod
 type 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/modops.ml b/kernel/modops.ml
index a8e298a50b81..a53245f9d874 100644
--- a/kernel/modops.ml
+++ b/kernel/modops.ml
@@ -351,7 +351,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

From d04d246bb1c77fa4c49bac82d041e995a569e416 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Mon, 26 Jan 2026 15:35:31 +0100
Subject: [PATCH 184/578] Move code about mod subst from tac2intern to new file
 tac2subst

---
 plugins/ltac2/tac2entries.ml          |   7 +-
 plugins/ltac2/tac2intern.ml           | 271 -------------------------
 plugins/ltac2/tac2intern.mli          |   8 -
 plugins/ltac2/tac2subst.ml            | 281 ++++++++++++++++++++++++++
 plugins/ltac2/tac2subst.mli           |  19 ++
 plugins/ltac2_ltac1/tac2core_ltac1.ml |   4 +-
 6 files changed, 306 insertions(+), 284 deletions(-)
 create mode 100644 plugins/ltac2/tac2subst.ml
 create mode 100644 plugins/ltac2/tac2subst.mli

diff --git a/plugins/ltac2/tac2entries.ml b/plugins/ltac2/tac2entries.ml
index 2fb4ceff9fc1..3bc4371e4f12 100644
--- a/plugins/ltac2/tac2entries.ml
+++ b/plugins/ltac2/tac2entries.ml
@@ -22,6 +22,7 @@ open Nametab
 open Tac2expr
 open Tac2print
 open Tac2intern
+open Tac2subst
 
 (** Grammar entries *)
 
@@ -977,10 +978,10 @@ let cache_synext_interp (local,kn,tac) =
 
 let subst_notation_data subst = function
   | Tac2env.UntypedNota body as n ->
-    let body' = Tac2intern.subst_rawexpr subst body in
+    let body' = Tac2subst.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 body' = Tac2subst.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
@@ -1200,7 +1201,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;
diff --git a/plugins/ltac2/tac2intern.ml b/plugins/ltac2/tac2intern.ml
index ea1760ea3063..5f31f09e1658 100644
--- a/plugins/ltac2/tac2intern.ml
+++ b/plugins/ltac2/tac2intern.ml
@@ -1828,274 +1828,6 @@ let intern_notation_data ids body =
     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 *)
-
 (** Registering *)
 
 let genintern_core ?(check_unused=true) ist locals expected v =
@@ -2158,9 +1890,6 @@ let () =
   in
   Gentactic.register_intern wit_ltac2_tac intern
 
-let () = Gensubst.register_constr_subst wit_ltac2_constr (fun s (ids, e) -> ids, subst_expr s e)
-let () = Gentactic.register_subst wit_ltac2_tac subst_expr
-
 let intern_var_quotation_gen ?loc ~ispat ist (kind, { CAst.v = id; loc }) =
   let open Genintern in
   let kind = match kind with
diff --git a/plugins/ltac2/tac2intern.mli b/plugins/ltac2/tac2intern.mli
index ff0ced7dcf53..44010935968b 100644
--- a/plugins/ltac2/tac2intern.mli
+++ b/plugins/ltac2/tac2intern.mli
@@ -9,7 +9,6 @@
 (************************************************************************)
 
 open Names
-open Mod_subst
 open Tac2expr
 
 type context = (Id.t * type_scheme) list
@@ -56,13 +55,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
diff --git a/plugins/ltac2/tac2subst.ml b/plugins/ltac2/tac2subst.ml
new file mode 100644
index 000000000000..6600b52d1b32
--- /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___,, * (see version control and CREDITS file for authors & dates) *)
+(*   \VV/  **************************************************************)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+open Util
+open Names
+open Tac2expr
+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 = 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 (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 ({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             *)
+(* <O___,, * (see version control and CREDITS file for authors & dates) *)
+(*   \VV/  **************************************************************)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+open Mod_subst
+open Tac2expr
+
+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
diff --git a/plugins/ltac2_ltac1/tac2core_ltac1.ml b/plugins/ltac2_ltac1/tac2core_ltac1.ml
index a86ad034f24c..e70b4d67e591 100644
--- a/plugins/ltac2_ltac1/tac2core_ltac1.ml
+++ b/plugins/ltac2_ltac1/tac2core_ltac1.ml
@@ -312,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 =

From 3e24daa897bfd7cd6e23b64487558912eeb630eb Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Thu, 22 Jan 2026 14:12:52 +0100
Subject: [PATCH 185/578] Reify syntax of ltac2 syntactic classes independent
 of interpretation

In particular, `constr(nat)`, `constr(type)` and `open_constr` all
have the same syntax (`nterm constr`).
---
 plugins/ltac2/tac2entries.ml    | 214 ++++++++++++++++++++++++++------
 plugins/ltac2/tac2entries.mli   |  66 ++++++++--
 plugins/ltac2/tac2extravals.ml  | 106 +++++++---------
 test-suite/ltac2/seq_notation.v |   7 ++
 4 files changed, 290 insertions(+), 103 deletions(-)
 create mode 100644 test-suite/ltac2/seq_notation.v

diff --git a/plugins/ltac2/tac2entries.ml b/plugins/ltac2/tac2entries.ml
index 3bc4371e4f12..d0f707364c2b 100644
--- a/plugins/ltac2/tac2entries.ml
+++ b/plugins/ltac2/tac2entries.ml
@@ -9,7 +9,7 @@
 (************************************************************************)
 
 (* must be before open Libobject, otherwise Dyn is Libobject.Dyn *)
-module SynclassDyn = Dyn.Make()
+module DynMake = Dyn.Make
 
 open Pp
 open Util
@@ -607,39 +607,8 @@ let import_type qid as_id =
 
 (** 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
@@ -695,6 +664,178 @@ let inCustomEntry : Id.t -> bool -> Libobject.obj =
     classify_function = (fun local -> if local then Dispose else Substitute);
   }
 
+module Syntax = struct
+
+  module DynEntry = DynMake()
+
+  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
+
+  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 -> '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.t) -> f ()), 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 -> fulla) x = f (fun hd -> g (hd, x)) 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) -> 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 Pltac.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)
+
+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 = DynMake()
+
+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
@@ -729,7 +870,7 @@ let terminal_synclass_tag : string SynclassDyn.tag = SynclassDyn.create "<termin
 
 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))
+  SyntaxRule (Syntax.token (Tok.PIDENT (Some str)), (fun _ -> v_unit))
 
 let () =
   syntax_class_interps := SynclassInterpMap.add terminal_synclass_tag interp_terminal !syntax_class_interps
@@ -741,12 +882,12 @@ type custom_synclass_data = {
 
 let interp_custom_entry data : syntax_class_rule =
   let ename = data.custom_synclass_name in
-  let entry = find_custom_entry ename in
+  let entry = Syntax.custom_ltac2 ename in
   match data.custom_synclass_level with
   | None ->
-    SyntaxRule (Procq.Symbol.nterm entry, (fun expr -> expr))
+    SyntaxRule (Syntax.nterm entry, (fun expr -> expr))
   | Some lev ->
-    SyntaxRule (Procq.Symbol.nterml entry (level_name lev), (fun expr -> expr))
+    SyntaxRule (Syntax.nterml entry (level_name lev), (fun expr -> expr))
 
 let custom_synclass_tag : custom_synclass_data SynclassDyn.tag = SynclassDyn.create "<custom>"
 
@@ -869,6 +1010,7 @@ let rec get_rule (tok : SynclassDyn.t token list) : krule = match tok with
 | TacNonTerm (na, v) :: tok ->
   let SyntaxRule (syntax_class, inj) = interp_syntax_class v in
   let KRule (rule, act) = get_rule tok in
+  let Syntax.Symb (_,syntax_class) = Syntax.to_symbol syntax_class 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)
diff --git a/plugins/ltac2/tac2entries.mli b/plugins/ltac2/tac2entries.mli
index a85a76be09c3..3022a9fb04d5 100644
--- a/plugins/ltac2/tac2entries.mli
+++ b/plugins/ltac2/tac2entries.mli
@@ -49,8 +49,64 @@ val perform_eval : pstate:Declare.Proof.t option -> raw_tacexpr -> unit
 
 (** {5 Notations} *)
 
+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 : (raw_tacexpr, _, 'a) Procq.Symbol.t * ('a -> raw_tacexpr) -> syntax_class_rule
+| SyntaxRule : 'a Syntax.t * ('a -> raw_tacexpr) -> syntax_class_rule
 
 type used_levels
 
@@ -92,14 +148,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/tac2extravals.ml b/plugins/ltac2/tac2extravals.ml
index dd0d20b13510..66a8bc012da5 100644
--- a/plugins/ltac2/tac2extravals.ml
+++ b/plugins/ltac2/tac2extravals.ml
@@ -452,16 +452,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 = Tac2entries.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)
+    Tac2entries.SyntaxRule (TacSyn.nterm entry, f)
   end
 
+let add_expr_syntax_class name entry f =
+  (* XXX name for register_entry? *)
+  let entry = Tac2entries.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
 
@@ -469,7 +476,7 @@ 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
+    let syntax_class = TacSyn.token (Tok.PKEYWORD s) in
     Tac2entries.SyntaxRule (syntax_class, (fun _ -> q_unit))
   end
 
@@ -477,7 +484,7 @@ 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
+    let syntax_class = TacSyn.token (CLexer.terminal s) in
     Tac2entries.SyntaxRule (syntax_class, (fun _ -> q_unit))
   end
 
@@ -494,13 +501,12 @@ let () = add_syntax_class_full "list0" {
   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 syntax_class = TacSyn.list0 syntax_class in
     let act l = Tac2quote.of_list act l in
     Tac2entries.SyntaxRule (syntax_class, act)
-  | subclass, Some str ->
+  | subclass, Some sep ->
     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
+    let syntax_class = TacSyn.list0 syntax_class ~sep in
     let act l = Tac2quote.of_list act l in
     Tac2entries.SyntaxRule (syntax_class, act)
   end;
@@ -519,13 +525,12 @@ let () = add_syntax_class_full "list1" {
   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 syntax_class = TacSyn.list1 syntax_class in
     let act l = Tac2quote.of_list act l in
     Tac2entries.SyntaxRule (syntax_class, act)
-  | subclass, Some str ->
+  | subclass, Some sep ->
     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
+    let syntax_class = TacSyn.list1 syntax_class ~sep in
     let act l = Tac2quote.of_list act l in
     Tac2entries.SyntaxRule (syntax_class, act)
   end;
@@ -540,7 +545,7 @@ let () = add_syntax_class_full "opt" {
   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 syntax_class = TacSyn.opt syntax_class in
     let act opt = match opt with
       | None ->
         CAst.make @@ CTacCst (AbsKn (Other c_none))
@@ -555,7 +560,7 @@ 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)
   end
@@ -564,7 +569,7 @@ 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)
   end
@@ -578,7 +583,7 @@ 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)
   end
@@ -673,13 +678,13 @@ 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 () =
@@ -693,7 +698,7 @@ let add_constr_classes (name,lname) quote =
     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)
+      Tac2entries.SyntaxRule (TacSyn.nterm TacSyn.lconstr, act)
     end
   in
   ()
@@ -728,46 +733,31 @@ 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 *)
-
-open Procq
+let () = add_generic_syntax_class "pattern" Tac2entries.Syntax.constr Tac2quote.wit_pattern
 
-type _ converter =
-| CvNil : (Loc.t -> raw_tacexpr) converter
-| CvCns : 'act converter * ('a -> raw_tacexpr) option -> ('a -> 'act) converter
+(** seq syntax class, a bit hairy. *)
 
-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 : 'a TacSyn.seq * ('a -> raw_tacexpr list) -> seqrule
 
-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 Tac2entries.SyntaxRule (synx, fx) = Tac2entries.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
+  Tac2entries.SyntaxRule (TacSyn.seq syn, f)
 
 let intern_seq_rule toks =
   List.fold_left_map (fun used tok ->
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.

From e0942718c359d00eb1c882c2cf70d6c08f4b0a9a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Fri, 23 Jan 2026 18:09:44 +0100
Subject: [PATCH 186/578] Fully separate ltac2 notation parsing from
 intern-time data

---
 clib/dyn.ml                   |   3 +
 clib/dyn.mli                  |   3 +
 interp/numTok.ml              |   7 +
 interp/numTok.mli             |   1 +
 parsing/tok.ml                |  28 +++
 parsing/tok.mli               |   4 +
 plugins/ltac2/tac2entries.ml  | 367 ++++++++++++++++++++++++----------
 plugins/ltac2/tac2entries.mli |   8 +-
 plugins/ltac2/tac2env.ml      |  16 --
 plugins/ltac2/tac2env.mli     |  15 --
 plugins/ltac2/tac2expr.mli    |   6 +-
 plugins/ltac2/tac2intern.ml   |  32 ++-
 plugins/ltac2/tac2intern.mli  |  14 +-
 plugins/ltac2/tac2print.ml    |   2 +-
 14 files changed, 351 insertions(+), 155 deletions(-)

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/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/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/plugins/ltac2/tac2entries.ml b/plugins/ltac2/tac2entries.ml
index d0f707364c2b..79783cd54467 100644
--- a/plugins/ltac2/tac2entries.ml
+++ b/plugins/ltac2/tac2entries.ml
@@ -9,6 +9,7 @@
 (************************************************************************)
 
 (* must be before open Libobject, otherwise Dyn is Libobject.Dyn *)
+module type ValueS = Dyn.ValueS
 module DynMake = Dyn.Make
 
 open Pp
@@ -690,6 +691,25 @@ module Syntax = struct
     | 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
@@ -720,7 +740,7 @@ module Syntax = struct
   type ('a,'fulla) rule =
       Rule :
         'mayrec rec_ *
-        (('a -> 'fulla) -> 'f) *
+        (('a -> Loc.t -> 'fulla) -> 'f) *
         (raw_tacexpr, 'mayrec, 'f, Loc.t -> 'fulla) Procq.Rule.t ->
         ('a,'fulla) rule
 
@@ -757,11 +777,11 @@ module Syntax = struct
   and seq_to_rule : type a fulla. a seq -> (a,fulla) rule =
     fun s ->
     match s with
-    | Nil -> Rule (NoRec, (fun f (_:Loc.t) -> f ()), Procq.Rule.stop)
+    | 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 -> fulla) x = f (fun hd -> g (hd, 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
@@ -776,7 +796,7 @@ module Syntax = struct
     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) -> x))]
+    | 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
@@ -801,6 +821,135 @@ module Syntax = struct
   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 =
@@ -962,13 +1111,6 @@ let parse_token = function
   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
@@ -986,39 +1128,27 @@ 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;
+  synext_tok : ParsedNota.any;
+  synext_level : int;
+  synext_local : bool;
 }
 
-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 Syntax.Symb (_,syntax_class) = Syntax.to_symbol syntax_class 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)
+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 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 AnySeq rest = get_nota_parsing tok in
+  AnySeq (Snoc (rest, Syntax.token (CLexer.terminal t)))
 
 let deprecated_ltac2_notation =
   Deprecation.create_warning
@@ -1060,22 +1190,15 @@ let check_levels st used_levels =
   Tac2Custom.Map.iter iter used_levels
 
 let perform_notation syn st =
-  let tok = syn.synext_tok in
+  let Any parsing = 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)
+  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 (act mk) in
-  let entry, lev = syn.synext_entry 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
@@ -1097,13 +1220,11 @@ let ltac2_notation =
 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 }
+(* XXX missing subst on custom entries, including recursively in SynclassDyn.t *)
+let subst_synext (subst, syn) = syn
 
 let classify_synext o =
-  if o.synext_loc then Dispose else Substitute
+  if o.synext_local then Dispose else Substitute
 
 let ltac2_notation_cat = Libobject.create_category "ltac2.notations"
 
@@ -1113,13 +1234,58 @@ let inTac2Notation : synext -> obj =
      cache_function  = cache_synext;
      open_function   = simple_open ~cat:ltac2_notation_cat cache_synext;
      subst_function = subst_synext;
-     classify_function = classify_synext}
+     classify_function = classify_synext;
+  }
+
+type 'body notation_interp = {
+  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_tok : SynclassDyn.t token list;
+  nota_body : 'body;
+}
+
+let notation_data = 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 syn
+  : notation_data * (lname * raw_tacexpr) list =
+  let WithArgs ((rule, _ as parsing), args) = TacSyn.get syn in
+  let data : notation_data notation_interp = ParsedNota.AnyMap.get (Any parsing) !notation_data 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 (local,kn,tac) =
-  Tac2env.define_notation kn tac
+let () = Tac2intern.set_interp_notation interp_notation
+
+let cache_synext_interp data =
+  notation_data := ParsedNota.AnyMap.add data.nota_parsing data !notation_data
 
 let subst_notation_data subst = function
-  | Tac2env.UntypedNota body as n ->
+  | UntypedNota body as n ->
     let body' = Tac2subst.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 ->
@@ -1129,16 +1295,16 @@ let subst_notation_data subst = function
     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')
+(* 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 classify_synext_interp (local,_,_) =
-  if local then Dispose else Substitute
+let classify_synext_interp data =
+  if data.nota_local then Dispose else Substitute
 
-let inTac2NotationInterp : (bool*KerName.t*Tac2env.notation_data) -> obj =
+let inTac2NotationInterp : _ -> 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;
@@ -1176,30 +1342,9 @@ let inTac2Abbreviation : Id.t -> abbreviation -> obj =
      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 'body notation_interpretation_data =
+| Abbreviation of Id.t * Deprecation.t option * 'body
+| Synext of 'body notation_interp
 
 type notation_target = qualid option * int option
 
@@ -1241,13 +1386,6 @@ let register_notation atts tkn (entry,lev) 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
@@ -1279,30 +1417,41 @@ let register_notation atts tkn (entry,lev) body =
           | _ -> 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 AnySeq parsing = get_nota_parsing tokens in
+    let parsing = ParsedNota.Any (parsing, entry) 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;
+      synext_tok = parsing;
+      synext_level = lev;
+      synext_local = local;
     } in
     Lib.add_leaf (inTac2Notation ext);
-    Synext (local,key,ids,body)
+    Synext {
+      nota_local = local;
+      nota_raw = tkn;
+      nota_depr = deprecation;
+      nota_parsing = parsing;
+      nota_tok = tokens;
+      nota_body = body;
+    }
 
 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
     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 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_notation_data ids data.nota_body in
+    Lib.add_leaf (inTac2NotationInterp { data with nota_body = body })
 
 type redefinition = {
   redef_local : Libobject.locality;
diff --git a/plugins/ltac2/tac2entries.mli b/plugins/ltac2/tac2entries.mli
index 3022a9fb04d5..06e7d0a5bf5c 100644
--- a/plugins/ltac2/tac2entries.mli
+++ b/plugins/ltac2/tac2entries.mli
@@ -27,7 +27,7 @@ val register_primitive : ?deprecation:Deprecation.t -> ?local:bool ->
 
 val register_struct : Attributes.vernac_flags -> strexpr -> unit
 
-type notation_interpretation_data
+type _ notation_interpretation_data
 
 type notation_target = qualid option * int option
 
@@ -36,12 +36,12 @@ val pr_register_notation : sexpr list -> notation_target -> raw_tacexpr -> Pp.t
 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
+  notation_target -> 'body -> 'body notation_interpretation_data
 
 val register_abbreviation : Attributes.vernac_flags -> Id.t CAst.t ->
-  raw_tacexpr -> notation_interpretation_data
+  'body -> 'body notation_interpretation_data
 
-val register_notation_interpretation : notation_interpretation_data -> unit
+val register_notation_interpretation : raw_tacexpr notation_interpretation_data -> unit
 
 val register_custom_entry : lident -> unit
 
diff --git a/plugins/ltac2/tac2env.ml b/plugins/ltac2/tac2env.ml
index cfcf9cfd7a5c..3b60a4ed536e 100644
--- a/plugins/ltac2/tac2env.ml
+++ b/plugins/ltac2/tac2env.ml
@@ -66,17 +66,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 }
@@ -124,11 +113,6 @@ let define_alias ?deprecation kn tac =
 
 let interp_alias kn = KerName.Map.find kn ltac_state.contents.ltac_aliases
 
-let define_notation kn tac =
-  ltac_notations := KerName.Map.add kn tac !ltac_notations
-
-let interp_notation kn = KerName.Map.find kn !ltac_notations
-
 module ML =
 struct
   type t = ml_tactic_name
diff --git a/plugins/ltac2/tac2env.mli b/plugins/ltac2/tac2env.mli
index 5f114f67051b..538de5c81e98 100644
--- a/plugins/ltac2/tac2env.mli
+++ b/plugins/ltac2/tac2env.mli
@@ -93,21 +93,6 @@ type alias_data = {
 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
-
 (** {5 Name management} *)
 
 val push_ltac : visibility -> full_path -> tacref -> unit
diff --git a/plugins/ltac2/tac2expr.mli b/plugins/ltac2/tac2expr.mli
index 372527aa3ba8..9b47c752a26a 100644
--- a/plugins/ltac2/tac2expr.mli
+++ b/plugins/ltac2/tac2expr.mli
@@ -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
diff --git a/plugins/ltac2/tac2intern.ml b/plugins/ltac2/tac2intern.ml
index 5f31f09e1658..e8f8faeb1025 100644
--- a/plugins/ltac2/tac2intern.ml
+++ b/plugins/ltac2/tac2intern.ml
@@ -1113,8 +1113,24 @@ 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
+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 interp_notation = ref (fun ?loc _ -> assert false)
+
+let set_interp_notation f = interp_notation := f
+let interp_notation ?loc (syn:tacsyn) : _ * _ =
+  !interp_notation ?loc syn
+
+let expand_notation ?loc syn =
+  let data, el = interp_notation ?loc 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
@@ -1260,8 +1276,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 syn in
   intern_rec env tycon v
 | CTacCnv (e, tc) ->
   let tc = intern_type env tc in
@@ -1719,8 +1735,8 @@ let globalize_gen ~tacext ids tac =
       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
+    | CTacSyn syn ->
+      let v = expand_notation ?loc syn in
       globalize ids v
     | CTacCnv (e, t) ->
       let e = globalize ids e in
@@ -1818,7 +1834,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 {
+    TypedNota {
       nota_prms = prms;
       nota_argtys = argtys;
       nota_ty = ty;
@@ -1826,7 +1842,7 @@ let intern_notation_data ids body =
     }
   else
     let body = globalize ids body in
-    Tac2env.UntypedNota body
+    UntypedNota body
 
 (** Registering *)
 
diff --git a/plugins/ltac2/tac2intern.mli b/plugins/ltac2/tac2intern.mli
index 44010935968b..45b8405111d7 100644
--- a/plugins/ltac2/tac2intern.mli
+++ b/plugins/ltac2/tac2intern.mli
@@ -11,12 +11,21 @@
 open Names
 open Tac2expr
 
+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 context = (Id.t * type_scheme) list
 
 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 -> notation_data
 
 val intern_accumulate_errors : strict:bool -> context -> raw_tacexpr ->
   glb_tacexpr * type_scheme * Pp.t Loc.located list
@@ -69,3 +78,6 @@ val error_nparams_mismatch : ?loc:Loc.t -> int -> int -> 'a
 (** Misc *)
 
 val drop_ltac2_env : Genintern.Store.t -> Genintern.Store.t
+
+val set_interp_notation :
+  (?loc:Loc.t -> tacsyn -> notation_data * (lname * raw_tacexpr) list) -> unit
diff --git a/plugins/ltac2/tac2print.ml b/plugins/ltac2/tac2print.ml
index 2c4188ca26e9..939015b3e768 100644
--- a/plugins/ltac2/tac2print.ml
+++ b/plugins/ltac2/tac2print.ml
@@ -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 "<notation %t>" (fun () -> KerName.print kn)
+  | CTacSyn _ -> fmt "<notation>" (* TODO *)
   | CTacLet (isrec, bnd, e) ->
     let paren = match lvl with
       | E0 | E1 | E2 | E3 | E4 -> paren

From 49c94d499ccb4175de4141468c6df6ed2dbc6d62 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Mon, 26 Jan 2026 15:30:57 +0100
Subject: [PATCH 187/578] Move code about ltac2 notations to new file tac2syn
 from Tac2entries

syntax class declarations stay in tac2extravals, this ensures that we
expose enough API for further plugins

a bit stays in tac2entries to avoid cyclic dependency between tac2syn
and tac2intern
---
 plugins/ltac2/g_ltac2.mlg      |   4 +-
 plugins/ltac2/g_ltac2.mli      |   6 +-
 plugins/ltac2/tac2entries.ml   | 809 +-------------------------------
 plugins/ltac2/tac2entries.mli  |  93 +---
 plugins/ltac2/tac2extravals.ml |  72 +--
 plugins/ltac2/tac2intern.ml    |  19 +-
 plugins/ltac2/tac2intern.mli   |  14 +-
 plugins/ltac2/tac2syn.ml       | 821 +++++++++++++++++++++++++++++++++
 plugins/ltac2/tac2syn.mli      | 128 +++++
 9 files changed, 1011 insertions(+), 955 deletions(-)
 create mode 100644 plugins/ltac2/tac2syn.ml
 create mode 100644 plugins/ltac2/tac2syn.mli

diff --git a/plugins/ltac2/g_ltac2.mlg b/plugins/ltac2/g_ltac2.mlg
index 24e0bec80eaa..95e6a5421b09 100644
--- a/plugins/ltac2/g_ltac2.mlg
+++ b/plugins/ltac2/g_ltac2.mlg
@@ -987,7 +987,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
 
 }
@@ -1038,7 +1038,7 @@ VERNAC COMMAND EXTEND VernacDeclareTactic2Definition
   Tac2entries.import_type qid id
   }
 | [ "Ltac2" "Custom" "Entry" identref(id) ] => { Vernacextend.(VtSideff ([], VtNow)) } SYNTERP AS _ {
-  Tac2entries.register_custom_entry id
+  Tac2syn.register_custom_entry id
   } -> {
   ()
 }
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/tac2entries.ml b/plugins/ltac2/tac2entries.ml
index 79783cd54467..cf1955fa46c7 100644
--- a/plugins/ltac2/tac2entries.ml
+++ b/plugins/ltac2/tac2entries.ml
@@ -8,10 +8,6 @@
 (*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
-(* must be before open Libobject, otherwise Dyn is Libobject.Dyn *)
-module type ValueS = Dyn.ValueS
-module DynMake = Dyn.Make
-
 open Pp
 open Util
 open CAst
@@ -29,7 +25,7 @@ open Tac2subst
 
 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"
@@ -606,710 +602,7 @@ let import_type qid as_id =
       });
     Lib.add_leaf (inImportType as_id orig)
 
-(** Parsing *)
-
-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 =
-  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 = DynMake()
-
-  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 Pltac.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 = DynMake()
-
-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 "<terminal>"
-
-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 "<custom>"
-
-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 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_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"
-    (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 -> 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
-
-(* XXX missing subst on custom entries, including recursively in SynclassDyn.t *)
-let subst_synext (subst, syn) = syn
-
-let classify_synext o =
-  if o.synext_local 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;
-  }
-
-type 'body notation_interp = {
-  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_tok : SynclassDyn.t token list;
-  nota_body : 'body;
-}
-
-let notation_data = 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 syn
-  : notation_data * (lname * raw_tacexpr) list =
-  let WithArgs ((rule, _ as parsing), args) = TacSyn.get syn in
-  let data : notation_data notation_interp = ParsedNota.AnyMap.get (Any parsing) !notation_data 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 () = Tac2intern.set_interp_notation interp_notation
-
-let cache_synext_interp data =
-  notation_data := ParsedNota.AnyMap.add data.nota_parsing data !notation_data
-
-let subst_notation_data subst = function
-  | UntypedNota body as n ->
-    let body' = Tac2subst.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' = Tac2subst.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 classify_synext_interp data =
-  if data.nota_local then Dispose else Substitute
-
-let inTac2NotationInterp : _ -> 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}
+(** {5 Parsing} *)
 
 type abbreviation = {
   abbr_body : raw_tacexpr;
@@ -1332,35 +625,22 @@ let subst_abbreviation (subst, abbr) =
   if body' == abbr.abbr_body then abbr
   else { abbr_body = body'; abbr_depr = abbr.abbr_depr }
 
-let classify_abbreviation o = Substitute
-
-let inTac2Abbreviation : Id.t -> abbreviation -> obj =
+let inTac2Abbreviation : Id.t -> abbreviation -> Libobject.obj =
+  let open Libobject in
   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}
+     classify_function = (fun _ -> Substitute);
+}
 
 type 'body notation_interpretation_data =
 | Abbreviation of Id.t * Deprecation.t option * 'body
-| Synext of 'body notation_interp
-
-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)
+| Synext of '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)
 
@@ -1371,9 +651,7 @@ 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.")
-
-let tactic_qualid = qualid_of_ident (Id.of_string "tactic")
+      Pp.(fun () -> strbrk "Use of \"Ltac2 Notation\" keyword for abbreviations is deprecated, use \"Ltac2 Abbreviation\" instead.")
 
 let register_notation atts tkn (entry,lev) body =
   match tkn, entry, lev with
@@ -1384,59 +662,8 @@ let register_notation atts tkn (entry,lev) body =
     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
-    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 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);
-    Synext {
-      nota_local = local;
-      nota_raw = tkn;
-      nota_depr = deprecation;
-      nota_parsing = parsing;
-      nota_tok = tokens;
-      nota_body = body;
-    }
+    let data = Tac2syn.register_notation atts tkn (entry,lev) body in
+    Synext data
 
 let register_notation_interpretation = function
   | Abbreviation (id, deprecation, body) ->
@@ -1444,14 +671,10 @@ let register_notation_interpretation = function
     let abbr = { abbr_body = body; abbr_depr = deprecation } in
     Lib.add_leaf (inTac2Abbreviation id abbr)
   | Synext 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_notation_data ids data.nota_body in
-    Lib.add_leaf (inTac2NotationInterp { data with nota_body = body })
+    let data = Tac2syn.intern_notation_interpretation intern_notation_data data in
+    Tac2syn.register_notation_interpretation data
+
+(** {5 Redefinition} *)
 
 type redefinition = {
   redef_local : Libobject.locality;
diff --git a/plugins/ltac2/tac2entries.mli b/plugins/ltac2/tac2entries.mli
index 06e7d0a5bf5c..4d649d2d5588 100644
--- a/plugins/ltac2/tac2entries.mli
+++ b/plugins/ltac2/tac2entries.mli
@@ -25,111 +25,22 @@ 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
-
 val pr_register_abbreviation : Id.t CAst.t -> raw_tacexpr -> Pp.t
 
 val register_notation : Attributes.vernac_flags -> sexpr list ->
-  notation_target -> 'body -> 'body notation_interpretation_data
+  Tac2syn.notation_target -> 'body -> 'body notation_interpretation_data
 
 val register_abbreviation : Attributes.vernac_flags -> Id.t CAst.t ->
   'body -> 'body notation_interpretation_data
 
 val register_notation_interpretation : 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} *)
-
-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 *)
-
 (** {5 Inspecting} *)
 
 val print_located_tactic : Libnames.qualid -> unit
diff --git a/plugins/ltac2/tac2extravals.ml b/plugins/ltac2/tac2extravals.ml
index 66a8bc012da5..18fd16748e4c 100644
--- a/plugins/ltac2/tac2extravals.ml
+++ b/plugins/ltac2/tac2extravals.ml
@@ -438,11 +438,11 @@ let () =
 (** 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);
   }
 
@@ -452,19 +452,19 @@ let syntax_class_fail s args =
 
 let q_unit = CAst.make @@ CTacCst (AbsKn (Tuple 0))
 
-module TacSyn = Tac2entries.Syntax
+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 (TacSyn.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 = Tac2entries.Syntax.register_entry entry in
+  let entry = Tac2syn.Syntax.register_entry entry in
   add_expr_syntax_class0 name entry f
 
 let add_generic_syntax_class s entry arg =
@@ -477,7 +477,7 @@ let () = add_syntax_class "keyword" begin function
 | arg -> syntax_class_fail "keyword" arg
   end begin fun s ->
     let syntax_class = TacSyn.token (Tok.PKEYWORD s) in
-    Tac2entries.SyntaxRule (syntax_class, (fun _ -> q_unit))
+    Tac2syn.SyntaxRule (syntax_class, (fun _ -> q_unit))
   end
 
 let () = add_syntax_class "terminal" begin function
@@ -485,66 +485,66 @@ let () = add_syntax_class "terminal" begin function
 | arg -> syntax_class_fail "terminal" arg
   end begin fun s ->
     let syntax_class = TacSyn.token (CLexer.terminal s) in
-    Tac2entries.SyntaxRule (syntax_class, (fun _ -> q_unit))
+    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 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)
+    Tac2syn.SyntaxRule (syntax_class, act)
   | subclass, Some sep ->
-    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 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 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)
+    Tac2syn.SyntaxRule (syntax_class, act)
   | subclass, Some sep ->
-    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 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 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 ->
@@ -552,7 +552,7 @@ let () = add_syntax_class_full "opt" {
       | 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;
 }
 
@@ -562,7 +562,7 @@ let () = add_syntax_class "self" begin function
   end begin fun () ->
     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
@@ -571,7 +571,7 @@ let () = add_syntax_class "next" begin function
   end begin fun () ->
     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
@@ -585,20 +585,20 @@ let () = add_syntax_class "tactic" begin function
   end begin fun lev ->
     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;
 }
 
@@ -691,14 +691,14 @@ let add_constr_classes (name,lname) quote =
     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 (TacSyn.nterm TacSyn.lconstr, act)
+      Tac2syn.SyntaxRule (TacSyn.nterm TacSyn.lconstr, act)
     end
   in
   ()
@@ -733,7 +733,7 @@ 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" Tac2entries.Syntax.constr Tac2quote.wit_pattern
+let () = add_generic_syntax_class "pattern" Tac2syn.Syntax.constr Tac2quote.wit_pattern
 
 (** seq syntax class, a bit hairy. *)
 
@@ -744,7 +744,7 @@ let rec interp_seq_rule = function
     SeqRule (TacSyn.nil, (fun () -> []))
   | (skipx,synx) :: rest ->
     let SeqRule (synrest, frest) = interp_seq_rule rest in
-    let Tac2entries.SyntaxRule (synx, fx) = Tac2entries.interp_syntax_class synx in
+    let Tac2syn.SyntaxRule (synx, fx) = Tac2syn.interp_syntax_class synx in
     let f (rest, x) =
       if skipx then frest rest
       else
@@ -757,17 +757,17 @@ let rec interp_seq_rule = function
 let interp_seq_rule toks =
   let SeqRule (syn, f) = interp_seq_rule (List.rev toks) in
   let f x = Tac2quote.of_tuple @@ List.rev @@ f x in
-  Tac2entries.SyntaxRule (TacSyn.seq syn, f)
+  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/tac2intern.ml b/plugins/ltac2/tac2intern.ml
index e8f8faeb1025..89a9a2b24a5b 100644
--- a/plugins/ltac2/tac2intern.ml
+++ b/plugins/ltac2/tac2intern.ml
@@ -1113,23 +1113,8 @@ 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.")
 
-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 interp_notation = ref (fun ?loc _ -> assert false)
-
-let set_interp_notation f = interp_notation := f
-let interp_notation ?loc (syn:tacsyn) : _ * _ =
-  !interp_notation ?loc syn
-
 let expand_notation ?loc syn =
-  let data, el = interp_notation ?loc syn in
+  let data, el = Tac2syn.interp_notation ?loc syn in
   match data with
   | UntypedNota body ->
     let el = List.map (fun (pat, e) -> CAst.map (fun na -> CPatVar na) pat, e) el in
@@ -1834,7 +1819,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
-    TypedNota {
+    Tac2syn.TypedNota {
       nota_prms = prms;
       nota_argtys = argtys;
       nota_ty = ty;
diff --git a/plugins/ltac2/tac2intern.mli b/plugins/ltac2/tac2intern.mli
index 45b8405111d7..f165131539ee 100644
--- a/plugins/ltac2/tac2intern.mli
+++ b/plugins/ltac2/tac2intern.mli
@@ -11,21 +11,12 @@
 open Names
 open Tac2expr
 
-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 context = (Id.t * type_scheme) list
 
 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 -> notation_data
+val intern_notation_data : Id.Set.t -> raw_tacexpr -> Tac2syn.notation_data
 
 val intern_accumulate_errors : strict:bool -> context -> raw_tacexpr ->
   glb_tacexpr * type_scheme * Pp.t Loc.located list
@@ -78,6 +69,3 @@ val error_nparams_mismatch : ?loc:Loc.t -> int -> int -> 'a
 (** Misc *)
 
 val drop_ltac2_env : Genintern.Store.t -> Genintern.Store.t
-
-val set_interp_notation :
-  (?loc:Loc.t -> tacsyn -> notation_data * (lname * raw_tacexpr) list) -> unit
diff --git a/plugins/ltac2/tac2syn.ml b/plugins/ltac2/tac2syn.ml
new file mode 100644
index 000000000000..2d2fcd981079
--- /dev/null
+++ b/plugins/ltac2/tac2syn.ml
@@ -0,0 +1,821 @@
+(************************************************************************)
+(*         *      The Rocq Prover / The Rocq Development Team           *)
+(*  v      *         Copyright INRIA, CNRS and contributors             *)
+(* <O___,, * (see version control and CREDITS file for authors & dates) *)
+(*   \VV/  **************************************************************)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+open Util
+open CAst
+open Names
+open Libnames
+open Tac2expr
+open Tac2subst
+
+let check_lowercase {loc;v=id} =
+  if Tac2env.is_constructor (Libnames.qualid_of_ident id) then
+    CErrors.user_err ?loc Pp.(str "The identifier " ++ Id.print id ++ str " must start with a lowercase letter.")
+
+let internal_ltac2_expr = Procq.Entry.make "ltac2_expr"
+
+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 "<terminal>"
+
+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 "<custom>"
+
+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 '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_tok : SynclassDyn.t token list;
+  nota_body : 'body;
+}
+
+let notation_data = 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 syn
+  : notation_data * (lname * raw_tacexpr) list =
+  let WithArgs ((rule, _ as parsing), args) = TacSyn.get syn in
+  let data : notation_data notation_interpretation =
+    ParsedNota.AnyMap.get (Any parsing) !notation_data
+  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 =
+  notation_data := ParsedNota.AnyMap.add data.nota_parsing 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 = qualid option * int option
+
+let pr_register_notation tkn (entry,lev) body =
+  let open Pp in
+  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)
+
+let tactic_qualid = qualid_of_ident (Id.of_string "tactic")
+
+let register_notation atts tkn (entry,lev) body =
+  let deprecation, local = Attributes.(parse Notations.(deprecation ++ locality)) atts in
+  let local = Option.default false local 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 -> 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 lev 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_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
+  { data with nota_body = body }
+
+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..30d66f267cc0
--- /dev/null
+++ b/plugins/ltac2/tac2syn.mli
@@ -0,0 +1,128 @@
+(************************************************************************)
+(*         *      The Rocq Prover / The Rocq Development Team           *)
+(*  v      *         Copyright INRIA, CNRS and contributors             *)
+(* <O___,, * (see version control and CREDITS file for authors & dates) *)
+(*   \VV/  **************************************************************)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+open Names
+open Tac2expr
+
+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 -> tacsyn -> notation_data * (lname * raw_tacexpr) list
+
+type 'body notation_interpretation
+
+val ltac2_notation_cat : Libobject.category
+
+type notation_target = Libnames.qualid option * int option
+
+val pr_register_notation : sexpr list -> notation_target -> raw_tacexpr -> Pp.t
+
+val register_notation : Attributes.vernac_flags -> sexpr list ->
+  notation_target -> 'body -> 'body notation_interpretation
+(** Does not handle the deprecated abbreviation syntax *)
+
+val intern_notation_interpretation : (Id.Set.t -> 'raw -> 'glb) -> 'raw notation_interpretation ->
+  'glb notation_interpretation
+
+val register_notation_interpretation : 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

From 2959b8e5057b02200a546d444b42475a8bd9d2c9 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Mon, 26 Jan 2026 17:26:43 +0100
Subject: [PATCH 188/578] use record type for notation_target

---
 plugins/ltac2/g_ltac2.mlg    | 12 +++++++-----
 plugins/ltac2/tac2entries.ml | 12 ++++++++----
 plugins/ltac2/tac2syn.ml     | 17 ++++++++++-------
 plugins/ltac2/tac2syn.mli    |  5 ++++-
 4 files changed, 29 insertions(+), 17 deletions(-)

diff --git a/plugins/ltac2/g_ltac2.mlg b/plugins/ltac2/g_ltac2.mlg
index 95e6a5421b09..6f575d89db12 100644
--- a/plugins/ltac2/g_ltac2.mlg
+++ b/plugins/ltac2/g_ltac2.mlg
@@ -458,14 +458,16 @@ GRAMMAR EXTEND Gram
         { SexprRec (loc, id, tok) }
     ] ]
   ;
-  syn_level:
-    [ [ -> { None, None }
-      | ":"; n = Prim.natural -> { None, Some n }
-      | ":"; id = qualid; n = OPT [ "("; n = Prim.natural; ")" -> { n } ] -> { Some id, n }
+  syn_target:
+    [ [ -> { { Tac2syn.target_entry = None; target_level = None } }
+      | ":"; n = Prim.natural -> { { Tac2syn.target_entry = None; target_level = Some n } }
+      | ":"; id = qualid; n = OPT [ "("; n = Prim.natural; ")" -> { n } ] -> {
+          { Tac2syn.target_entry = Some id; target_level = n }
+        }
     ] ]
   ;
   tac2def_syn:
-    [ [ toks = LIST1 ltac2_syntax_class; n = syn_level; ":=";
+    [ [ toks = LIST1 ltac2_syntax_class; n = syn_target; ":=";
         e = ltac2_expr ->
         { (toks, n, e) }
     ] ]
diff --git a/plugins/ltac2/tac2entries.ml b/plugins/ltac2/tac2entries.ml
index cf1955fa46c7..fb1d1e783637 100644
--- a/plugins/ltac2/tac2entries.ml
+++ b/plugins/ltac2/tac2entries.ml
@@ -653,16 +653,20 @@ let warn_deprecated_notation_for_abbreviation =
     CWarnings.create ~name:"ltac2-notation-for-abbreviation" ~category:Deprecation.Version.v9_2
       Pp.(fun () -> strbrk "Use of \"Ltac2 Notation\" keyword for abbreviations is deprecated, use \"Ltac2 Abbreviation\" instead.")
 
-let register_notation atts tkn (entry,lev) body =
-  match tkn, entry, lev with
-  | [SexprRec (_, {loc;v=Some id}, [])], None, None ->
+let is_abbrev_target target =
+  let open Tac2syn in
+  Option.is_empty target.target_entry && Option.is_empty target.target_level
+
+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 data = Tac2syn.register_notation atts tkn (entry,lev) body in
+    let data = Tac2syn.register_notation atts tkn target body in
     Synext data
 
 let register_notation_interpretation = function
diff --git a/plugins/ltac2/tac2syn.ml b/plugins/ltac2/tac2syn.ml
index 2d2fcd981079..18313606eb62 100644
--- a/plugins/ltac2/tac2syn.ml
+++ b/plugins/ltac2/tac2syn.ml
@@ -731,11 +731,14 @@ let inTac2NotationInterp : _ -> Libobject.obj =
      classify_function = (fun data -> if data.nota_local then Dispose else Substitute);
 }
 
-type notation_target = qualid option * int option
+type notation_target = {
+  target_entry : qualid option;
+  target_level : int option;
+}
 
-let pr_register_notation tkn (entry,lev) body =
+let pr_register_notation tkn target body =
   let open Pp in
-  let pptarget = match entry, lev with
+  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
@@ -748,10 +751,10 @@ let pr_register_notation tkn (entry,lev) body =
 
 let tactic_qualid = qualid_of_ident (Id.of_string "tactic")
 
-let register_notation atts tkn (entry,lev) body =
+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 entry with
+  let entry = match target.target_entry with
     | Some entry ->
       if qualid_eq entry tactic_qualid then None
       else begin
@@ -762,13 +765,13 @@ let register_notation atts tkn (entry,lev) body =
   in
   (* Globalize so that names are absolute *)
   let lev = if Option.has_some entry then
-      let lev = match lev with
+      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 lev with
+    else match target.target_level with
       | Some n ->
         let () =
           if n < 0 || n > 6 then
diff --git a/plugins/ltac2/tac2syn.mli b/plugins/ltac2/tac2syn.mli
index 30d66f267cc0..38626258b761 100644
--- a/plugins/ltac2/tac2syn.mli
+++ b/plugins/ltac2/tac2syn.mli
@@ -107,7 +107,10 @@ type 'body notation_interpretation
 
 val ltac2_notation_cat : Libobject.category
 
-type notation_target = Libnames.qualid option * int option
+type notation_target = {
+  target_entry : Libnames.qualid option;
+  target_level : int option;
+}
 
 val pr_register_notation : sexpr list -> notation_target -> raw_tacexpr -> Pp.t
 

From 21b3a4d5b28638f2d17d16612ff689c933b8475a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Mon, 26 Jan 2026 17:18:24 +0100
Subject: [PATCH 189/578] Ltac2 scoped notations (basic features)

basic: no local scopes (ie no equivalent of `%` in constr)

unlike constr, the default scope is a real scope `Ltac2.Init.core`
instead of being a pseudo-scope (AFAIU of what's happening with constr
notation scopes)
---
 ...21542-SkySkimmer-ltac2-scoped-notations.sh |   1 +
 .../21542-ltac2-scoped-notations-Added.rst    |   7 +
 doc/sphinx/proof-engine/ltac2.rst             |  30 +++-
 doc/tools/docgram/common.edit_mlg             |   2 +-
 doc/tools/docgram/fullGrammar                 |   7 +-
 doc/tools/docgram/orderedGrammar              |   5 +-
 plugins/ltac2/g_ltac2.mlg                     |  41 ++++--
 plugins/ltac2/tac2entries.ml                  |   5 +-
 plugins/ltac2/tac2entries.mli                 |   9 +-
 plugins/ltac2/tac2intern.ml                   |  56 ++++----
 plugins/ltac2/tac2syn.ml                      | 131 +++++++++++++++++-
 plugins/ltac2/tac2syn.mli                     |  30 +++-
 plugins/ltac2/tac2typing_env.ml               |   5 +
 plugins/ltac2/tac2typing_env.mli              |   2 +
 test-suite/ltac2/scoped_notations.v           |  78 +++++++++++
 theories/Ltac2/Init.v                         |   2 +
 16 files changed, 347 insertions(+), 64 deletions(-)
 create mode 100644 dev/ci/user-overlays/21542-SkySkimmer-ltac2-scoped-notations.sh
 create mode 100644 doc/changelog/06-Ltac2-language/21542-ltac2-scoped-notations-Added.rst
 create mode 100644 test-suite/ltac2/scoped_notations.v

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/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 <https://github.com/rocq-prover/rocq/pull/21542>`_,
+  fixes `#16538 <https://github.com/rocq-prover/rocq/issues/16538>`_
+  and `#17330 <https://github.com/rocq-prover/rocq/issues/17330>`_,
+  by Gaëtan Gilbert).
diff --git a/doc/sphinx/proof-engine/ltac2.rst b/doc/sphinx/proof-engine/ltac2.rst
index 31935df9376e..c87a2360731f 100644
--- a/doc/sphinx/proof-engine/ltac2.rst
+++ b/doc/sphinx/proof-engine/ltac2.rst
@@ -1256,7 +1256,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 +1282,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<syntactic_classes>`.  `print` and `of_constr` are
@@ -1368,6 +1377,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
diff --git a/doc/tools/docgram/common.edit_mlg b/doc/tools/docgram/common.edit_mlg
index cf70461c9093..40df4ee53ff0 100644
--- a/doc/tools/docgram/common.edit_mlg
+++ b/doc/tools/docgram/common.edit_mlg
@@ -2422,7 +2422,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/fullGrammar b/doc/tools/docgram/fullGrammar
index 36cff2190314..4e97a4b7ec7d 100644
--- a/doc/tools/docgram/fullGrammar
+++ b/doc/tools/docgram/fullGrammar
@@ -711,6 +711,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 *)
@@ -2977,14 +2980,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 f2b81f604e1d..73fb39f693e4 100644
--- a/doc/tools/docgram/orderedGrammar
+++ b/doc/tools/docgram/orderedGrammar
@@ -925,7 +925,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 ")" ) ]
@@ -1012,6 +1012,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 *)
diff --git a/plugins/ltac2/g_ltac2.mlg b/plugins/ltac2/g_ltac2.mlg
index 6f575d89db12..d0e23f677131 100644
--- a/plugins/ltac2/g_ltac2.mlg
+++ b/plugins/ltac2/g_ltac2.mlg
@@ -459,17 +459,17 @@ GRAMMAR EXTEND Gram
     ] ]
   ;
   syn_target:
-    [ [ -> { { Tac2syn.target_entry = None; target_level = None } }
-      | ":"; n = Prim.natural -> { { Tac2syn.target_entry = None; target_level = Some n } }
-      | ":"; id = qualid; n = OPT [ "("; n = Prim.natural; ")" -> { n } ] -> {
-          { Tac2syn.target_entry = Some id; target_level = n }
-        }
+    [ [ -> { 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_target; ":=";
+    [ [ 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:
@@ -1039,26 +1039,43 @@ VERNAC COMMAND EXTEND VernacDeclareTactic2Definition
   } -> {
   Tac2entries.import_type qid id
   }
-| [ "Ltac2" "Custom" "Entry" identref(id) ] => { Vernacextend.(VtSideff ([], VtNow)) } SYNTERP AS _ {
-  Tac2syn.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/tac2entries.ml b/plugins/ltac2/tac2entries.ml
index fb1d1e783637..f24b43b9064d 100644
--- a/plugins/ltac2/tac2entries.ml
+++ b/plugins/ltac2/tac2entries.ml
@@ -635,9 +635,9 @@ let inTac2Abbreviation : Id.t -> abbreviation -> Libobject.obj =
      classify_function = (fun _ -> Substitute);
 }
 
-type 'body notation_interpretation_data =
+type ('scope,'body) notation_interpretation_data =
 | Abbreviation of Id.t * Deprecation.t option * 'body
-| Synext of 'body Tac2syn.notation_interpretation
+| Synext of ('scope, 'body) Tac2syn.notation_interpretation
 
 let pr_register_abbreviation id body =
   let open Pp in
@@ -656,6 +656,7 @@ let warn_deprecated_notation_for_abbreviation =
 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 target body =
   match tkn, is_abbrev_target target with
diff --git a/plugins/ltac2/tac2entries.mli b/plugins/ltac2/tac2entries.mli
index 4d649d2d5588..38b494f4e67a 100644
--- a/plugins/ltac2/tac2entries.mli
+++ b/plugins/ltac2/tac2entries.mli
@@ -25,17 +25,18 @@ val import_type : qualid -> Id.t -> unit
 val register_primitive : ?deprecation:Deprecation.t -> ?local:bool ->
   Names.lident -> raw_typexpr -> ml_tactic_name -> unit
 
-type _ notation_interpretation_data
+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 ->
-  Tac2syn.notation_target -> 'body -> 'body notation_interpretation_data
+  Tac2syn.notation_target -> 'body -> (qualid option, 'body) notation_interpretation_data
 
 val register_abbreviation : Attributes.vernac_flags -> Id.t CAst.t ->
-  'body -> 'body notation_interpretation_data
+  'body -> (_ option, 'body) notation_interpretation_data
 
-val register_notation_interpretation : raw_tacexpr notation_interpretation_data -> unit
+val register_notation_interpretation
+  : (qualid option, raw_tacexpr) notation_interpretation_data -> unit
 
 val register_struct : Attributes.vernac_flags -> strexpr -> unit
 
diff --git a/plugins/ltac2/tac2intern.ml b/plugins/ltac2/tac2intern.ml
index 89a9a2b24a5b..e96bb76f46ad 100644
--- a/plugins/ltac2/tac2intern.ml
+++ b/plugins/ltac2/tac2intern.ml
@@ -1113,8 +1113,8 @@ 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 syn =
-  let data, el = Tac2syn.interp_notation ?loc syn in
+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
@@ -1262,7 +1262,7 @@ let rec intern_rec env tycon {loc;v=e} =
   if is_rec then intern_let_rec env loc el tycon e
   else intern_let env loc ids el tycon e
 | CTacSyn syn ->
-  let v = expand_notation ?loc syn in
+  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
@@ -1681,7 +1681,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
@@ -1702,67 +1702,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 syn ->
-      let v = expand_notation ?loc syn in
-      globalize ids v
+      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
@@ -1788,7 +1788,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,_)) =
diff --git a/plugins/ltac2/tac2syn.ml b/plugins/ltac2/tac2syn.ml
index 18313606eb62..111cb782f683 100644
--- a/plugins/ltac2/tac2syn.ml
+++ b/plugins/ltac2/tac2syn.ml
@@ -21,6 +21,102 @@ let check_lowercase {loc;v=id} =
 
 let internal_ltac2_expr = Procq.Entry.make "ltac2_expr"
 
+module Tac2Scope = KerName
+
+module ScopeV = struct
+  include Tac2Scope
+  let is_var _ = None
+  let stage = Summary.Stage.Synterp
+  let summary_name = "ltac2_scopetab"
+end
+module ScopeTab = Nametab.EasyNoWarn(ScopeV)()
+
+let find_scope sc =
+  try ScopeTab.locate sc
+  with Not_found ->
+    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
@@ -658,17 +754,19 @@ type notation_data =
       nota_body : glb_tacexpr;
     }
 
-type 'body notation_interpretation = {
+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 = Summary.ref ~name:"tac2notation-data" ParsedNota.AnyMap.empty
+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
@@ -689,12 +787,22 @@ let rec interp_notation_args : type a. a Syntax.seq -> _ -> a -> _ = fun parsing
 (* 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 syn
+let interp_notation ?loc scopes syn
   : notation_data * (lname * raw_tacexpr) list =
   let WithArgs ((rule, _ as parsing), args) = TacSyn.get syn in
-  let data : notation_data notation_interpretation =
+  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)
@@ -703,7 +811,12 @@ let interp_notation ?loc syn
   data.nota_body, args
 
 let cache_synext_interp data =
-  notation_data := ParsedNota.AnyMap.add data.nota_parsing data !notation_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 ->
@@ -734,6 +847,7 @@ let inTac2NotationInterp : _ -> Libobject.obj =
 type notation_target = {
   target_entry : qualid option;
   target_level : int option;
+  target_scope : qualid option;
 }
 
 let pr_register_notation tkn target body =
@@ -803,6 +917,7 @@ let register_notation atts tkn target body =
     nota_depr = deprecation;
     nota_parsing = parsing;
     nota_tok = tokens;
+    nota_scope = target.target_scope;
     nota_body = body;
   }
 
@@ -814,7 +929,11 @@ let intern_notation_interpretation intern_body data =
   in
   let ids = List.fold_left accumulate_ids Id.Set.empty data.nota_tok in
   let body = intern_body ids data.nota_body in
-  { data with nota_body = body }
+  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)
diff --git a/plugins/ltac2/tac2syn.mli b/plugins/ltac2/tac2syn.mli
index 38626258b761..897cdff223a0 100644
--- a/plugins/ltac2/tac2syn.mli
+++ b/plugins/ltac2/tac2syn.mli
@@ -9,8 +9,23 @@
 (************************************************************************)
 
 open Names
+open Libnames
 open Tac2expr
 
+module Tac2Scope : module type of KerName
+
+module ScopeTab : Nametab.NAMETAB with type elt = Tac2Scope.t
+
+val declare_scope : Id.t -> 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
@@ -101,27 +116,28 @@ type notation_data =
       nota_body : glb_tacexpr;
     }
 
-val interp_notation : ?loc:Loc.t -> tacsyn -> notation_data * (lname * raw_tacexpr) list
+val interp_notation : ?loc:Loc.t -> Tac2Scope.t list -> tacsyn -> notation_data * (lname * raw_tacexpr) list
 
-type 'body notation_interpretation
+type ('scope, 'body) notation_interpretation
 
 val ltac2_notation_cat : Libobject.category
 
 type notation_target = {
-  target_entry : Libnames.qualid option;
+  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 -> 'body notation_interpretation
+  notation_target -> 'body -> (qualid option, 'body) notation_interpretation
 (** Does not handle the deprecated abbreviation syntax *)
 
-val intern_notation_interpretation : (Id.Set.t -> 'raw -> 'glb) -> 'raw notation_interpretation ->
-  'glb notation_interpretation
+val intern_notation_interpretation : (Id.Set.t -> 'raw -> 'glb) -> (qualid option, 'raw) notation_interpretation ->
+  (Tac2Scope.t, 'glb) notation_interpretation
 
-val register_notation_interpretation : notation_data notation_interpretation -> unit
+val register_notation_interpretation : (Tac2Scope.t, notation_data) notation_interpretation -> unit
 
 val register_custom_entry : lident -> unit
 
diff --git a/plugins/ltac2/tac2typing_env.ml b/plugins/ltac2/tac2typing_env.ml
index 822c6902b22c..1c64acf0fac4 100644
--- a/plugins/ltac2/tac2typing_env.ml
+++ b/plugins/ltac2/tac2typing_env.ml
@@ -111,6 +111,8 @@ 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;
@@ -129,6 +131,7 @@ type t = {
 
 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;
@@ -152,6 +155,8 @@ 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 }
diff --git a/plugins/ltac2/tac2typing_env.mli b/plugins/ltac2/tac2typing_env.mli
index ce1324790b19..681306dee881 100644
--- a/plugins/ltac2/tac2typing_env.mli
+++ b/plugins/ltac2/tac2typing_env.mli
@@ -30,6 +30,8 @@ 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
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/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.

From e6dc3185ea5a773444b274db8298757b5b54e2e4 Mon Sep 17 00:00:00 2001
From: Josselin Poiret <dev@jpoiret.xyz>
Date: Tue, 3 Mar 2026 16:22:13 +0100
Subject: [PATCH 190/578] allScheme: Check for arities deeply using
 Reduction.is_arity.

The previous code did not reduce recursively under head products when checking for arities
in uniform parameters.
---
 tactics/allScheme.ml                     |  3 +--
 test-suite/output/nested_eliminators.out | 10 ++++++++++
 test-suite/output/nested_eliminators.v   | 12 ++++++++++++
 3 files changed, 23 insertions(+), 2 deletions(-)

diff --git a/tactics/allScheme.ml b/tactics/allScheme.ml
index 2c02bb5fb688..391d1323bdd5 100644
--- a/tactics/allScheme.ml
+++ b/tactics/allScheme.ml
@@ -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)
 
diff --git a/test-suite/output/nested_eliminators.out b/test-suite/output/nested_eliminators.out
index ac7f675fab74..cc44669d7bed 100644
--- a/test-suite/output/nested_eliminators.out
+++ b/test-suite/output/nested_eliminators.out
@@ -1635,3 +1635,13 @@ Arguments MRT_ind (P MRTnode)%_function_scope m
 MRT_ind is transparent
 Expands to: Constant nested_eliminators.TestWarning.MRT_ind
 Declared in library nested_eliminators, line 403, characters 2-55
+Nester_all@{α ; u} :
+forall X : unit -> P unit,
+(forall u u0 : unit, X u u0 -> Type@{α ; u}) ->
+Nester X -> Type@{max(P.u1,u)}
+(* α ; *u |=  *)
+
+Nester_all is universe polymorphic
+Arguments Nester_all (X PX)%_function_scope n
+Expands to: Inductive nested_eliminators.DeepArities.Nester_all
+Declared in library nested_eliminators, line 417, characters 2-24
diff --git a/test-suite/output/nested_eliminators.v b/test-suite/output/nested_eliminators.v
index 86dec4e6557c..c14cee33815d 100644
--- a/test-suite/output/nested_eliminators.v
+++ b/test-suite/output/nested_eliminators.v
@@ -406,3 +406,15 @@ Module TestWarning.
   About MRT_ind.
 
 End TestWarning.
+
+
+
+Module DeepArities.
+  Definition P A := A -> Type.
+
+  Inductive Nester (X : unit -> P unit) : Type :=
+  | nester_intro : X tt tt -> Nester X.
+  Scheme All for Nester.
+
+  About Nester_all.
+End DeepArities.

From d66f6ec731e3c196f5f4f2c454e88d5c037d728d Mon Sep 17 00:00:00 2001
From: Yann Leray <yann.leray@inria.fr>
Date: Mon, 2 Mar 2026 16:56:07 +0100
Subject: [PATCH 191/578] Detect cross-calls in computation for uniform
 arguments of nested mutual fixpoints

Co-authored-by: Claude <claude@anthropic.com>
---
 dev/doc/critical-bugs.md    | 11 ++++++++++
 kernel/inductive.ml         |  4 ++--
 test-suite/bugs/bug_21682.v | 41 +++++++++++++++++++++++++++++++++++++
 3 files changed, 54 insertions(+), 2 deletions(-)
 create mode 100644 test-suite/bugs/bug_21682.v

diff --git a/dev/doc/critical-bugs.md b/dev/doc/critical-bugs.md
index 78b92ed298af..3d6715e18db8 100644
--- a/dev/doc/critical-bugs.md
+++ b/dev/doc/critical-bugs.md
@@ -25,6 +25,7 @@ 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)
     - [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)
@@ -274,6 +275,16 @@ and lack of checking of relevance marks on constants in coqchk
 - 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)
+
 ### Module system
 
 #### missing universe constraints in typing "with" clause of a module type
diff --git a/kernel/inductive.ml b/kernel/inductive.ml
index dd880ff7d0cc..a6a26c826f38 100644
--- a/kernel/inductive.ml
+++ b/kernel/inductive.ml
@@ -1294,8 +1294,8 @@ let find_uniform_parameters recindx nargs bodies =
     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
+      (* A recursive reference to any one of the mutual fixpoints *)
+      if n > k && n <= k + nbodies then
         List.fold_left_i (fun j nuniformparams a ->
             match kind a with
             | Rel m when Int.equal m (k - j) ->
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.
+*)

From 3f51c22a7c01444a4b37c0c6256be14a2c4aad0e Mon Sep 17 00:00:00 2001
From: Yann Leray <yann.leray@inria.fr>
Date: Mon, 2 Mar 2026 17:01:37 +0100
Subject: [PATCH 192/578] Restore reduction across nested fixpoints (and
 needreduce status) for uniform arguments during guard checking

Co-authored-by: Hugo Herbelin <Hugo.Herbelin@inria.fr>
---
 dev/doc/critical-bugs.md    | 13 ++++++++++++-
 kernel/inductive.ml         |  7 ++++++-
 test-suite/bugs/bug_21683.v | 21 +++++++++++++++++++++
 3 files changed, 39 insertions(+), 2 deletions(-)
 create mode 100644 test-suite/bugs/bug_21683.v

diff --git a/dev/doc/critical-bugs.md b/dev/doc/critical-bugs.md
index 3d6715e18db8..c4b8405744e1 100644
--- a/dev/doc/critical-bugs.md
+++ b/dev/doc/critical-bugs.md
@@ -26,6 +26,7 @@ This file recollects knowledge about critical bugs found in Coq since version 8.
       - [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)
     - [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)
@@ -270,7 +271,7 @@ 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)
@@ -285,6 +286,16 @@ and lack of checking of relevance marks on constants in coqchk
 - 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)
+
 ### Module system
 
 #### missing universe constraints in typing "with" clause of a module type
diff --git a/kernel/inductive.ml b/kernel/inductive.ml
index a6a26c826f38..6a058e9da469 100644
--- a/kernel/inductive.ml
+++ b/kernel/inductive.ml
@@ -1288,6 +1288,8 @@ let check_is_subterm x tree =
 
 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 =
@@ -1339,7 +1341,10 @@ let filter_fix_stack_domain cache ?evars nr decrarg stack nuniformparams =
     | 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 cache ?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
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.

From 297e68be0e9bf7f8dd91b448b2a7db2fa041a4bb Mon Sep 17 00:00:00 2001
From: Yann Leray <yann.leray@inria.fr>
Date: Mon, 2 Mar 2026 17:03:37 +0100
Subject: [PATCH 193/578] Count argument-less recursive calls for uniform
 argument computation in guard checker for nested fixpoints

---
 dev/doc/critical-bugs.md    | 11 ++++++++++
 kernel/inductive.ml         | 18 +++++++++-------
 test-suite/bugs/bug_21701.v | 42 +++++++++++++++++++++++++++++++++++++
 3 files changed, 63 insertions(+), 8 deletions(-)
 create mode 100644 test-suite/bugs/bug_21701.v

diff --git a/dev/doc/critical-bugs.md b/dev/doc/critical-bugs.md
index c4b8405744e1..e0ae12adafab 100644
--- a/dev/doc/critical-bugs.md
+++ b/dev/doc/critical-bugs.md
@@ -27,6 +27,7 @@ This file recollects knowledge about critical bugs found in Coq since version 8.
       - [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)
     - [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)
@@ -296,6 +297,16 @@ and lack of checking of relevance marks on constants in coqchk
 - 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)
+
 ### Module system
 
 #### missing universe constraints in typing "with" clause of a module type
diff --git a/kernel/inductive.ml b/kernel/inductive.ml
index 6a058e9da469..a39e7f2c01ac 100644
--- a/kernel/inductive.ml
+++ b/kernel/inductive.ml
@@ -1298,14 +1298,16 @@ let find_uniform_parameters recindx nargs bodies =
     | Rel n ->
       (* A recursive reference to any one of the mutual fixpoints *)
       if n > k && n <= k + nbodies 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
+        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
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.
+*)

From 791f553878dcb9ae5f9d6be85f16cd089f1ea5d5 Mon Sep 17 00:00:00 2001
From: Yann Leray <yann.leray@inria.fr>
Date: Mon, 2 Mar 2026 17:03:49 +0100
Subject: [PATCH 194/578] Changelog

---
 doc/changelog/01-kernel/21684-master-Fixed.rst | 7 +++++++
 1 file changed, 7 insertions(+)
 create mode 100644 doc/changelog/01-kernel/21684-master-Fixed.rst

diff --git a/doc/changelog/01-kernel/21684-master-Fixed.rst b/doc/changelog/01-kernel/21684-master-Fixed.rst
new file mode 100644
index 000000000000..75c838eab031
--- /dev/null
+++ b/doc/changelog/01-kernel/21684-master-Fixed.rst
@@ -0,0 +1,7 @@
+- **Fixed:**
+  Fix the detection and treatment of uniform arguments of nested fixpoints
+  (`#21684 <https://github.com/rocq-prover/rocq/pull/21684>`_,
+  fixes `#21682 <https://github.com/rocq-prover/rocq/issues/21682>`_
+  and `#21683 <https://github.com/rocq-prover/rocq/issues/21683>`_
+  and `#21701 <https://github.com/rocq-prover/rocq/issues/21701>`_,
+  by Yann Leray).

From 9ed993b5e0d0433f2978f8d8ec61ae334e97e1af Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Tue, 3 Mar 2026 16:52:18 +0100
Subject: [PATCH 195/578] Properly compute polymorphic "with Definition" module
 types.

The most expressive fix is not the one suggested by the LLM. Rather
than strenghtening the local universe constraints of the with definition,
we pick the most precise type of this definition. By cumulativity,
this will preserve typing in all instances while resulting in a more
general module type.

This commit also covertly fixes two hidden bugs.
- The first one occurred for with Definition where the constant
being replaced has a body: the previous code did not typecheck the
new body in this case and called conversion on a potentially
ill-typed term.
- The second one was due to a misused environment leading to a
potentially cyclic definition.

Fixes #21702: Incorrect with Definition universe constraint handling.
---
 dev/doc/critical-bugs.md    | 12 ++++++++++++
 kernel/mod_typing.ml        | 19 ++++++++++++-------
 test-suite/bugs/bug_21702.v | 31 +++++++++++++++++++++++++++++++
 3 files changed, 55 insertions(+), 7 deletions(-)
 create mode 100644 test-suite/bugs/bug_21702.v

diff --git a/dev/doc/critical-bugs.md b/dev/doc/critical-bugs.md
index 78b92ed298af..80637932fb8a 100644
--- a/dev/doc/critical-bugs.md
+++ b/dev/doc/critical-bugs.md
@@ -362,6 +362,18 @@ 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
 
+#### 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
+
 ### Universes
 
 #### issue with two parameters in the same universe level
diff --git a/kernel/mod_typing.ml b/kernel/mod_typing.ml
index 858eb91029b1..f5c0f2cd62f0 100644
--- a/kernel/mod_typing.ml
+++ b/kernel/mod_typing.ml
@@ -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 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 -> j.uj_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 -> j.uj_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
@@ -115,10 +115,14 @@ let rec check_with_def (cst, ustate) env struc (idl, wth) mp reso =
           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,13 +136,14 @@ let rec check_with_def (cst, ustate) env struc (idl, wth) mp reso =
             | Primitive _ -> error WithCannotConstrainPrimitive
             | Symbol _ -> error WithCannotConstrainSymbol
           in
-          cst
+          j.uj_type, cst
         | Monomorphic, Polymorphic _ -> error (WithSignatureMismatch (PolymorphicStatusExpected true))
         | Polymorphic _, Monomorphic -> error (WithSignatureMismatch (PolymorphicStatusExpected false))
       in
       let cb' =
         { cb with
           const_body = Def wth.w_def;
+          const_type = typ;
           const_universes = wth.w_univs;
           const_body_code = wth.w_bytecode; }
       in
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.

From 36ff9eea9c4addf681c2bc7371ed8de873a36007 Mon Sep 17 00:00:00 2001
From: Enrico Tassi <Enrico.Tassi@Inria.fr>
Date: Wed, 4 Mar 2026 09:27:55 +0100
Subject: [PATCH 196/578] ci: bump elpi to 3.6.1

---
 .gitlab-ci.yml                       | 2 +-
 dev/ci/docker/edge_ubuntu/Dockerfile | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
index 0f004787db7a..e3d4517163a8 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-03-04-d4fe8f0464"
   BASE_IMAGE: "$CI_REGISTRY_IMAGE:$BASE_CACHEKEY"
   EDGE_IMAGE: "$CI_REGISTRY_IMAGE:$EDGE_CACHEKEY"
 
diff --git a/dev/ci/docker/edge_ubuntu/Dockerfile b/dev/ci/docker/edge_ubuntu/Dockerfile
index e89cfb23ba1b..b8f6a7422103 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="elpi.3.6.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

From 255d86ed8d8a47aa914581e7187ffd11b7dd101c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Wed, 4 Mar 2026 08:47:45 +0100
Subject: [PATCH 197/578] Revert to the old behaviour for module with
 Definition type.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

This is motivated by backwards compatibility, rather than theoretical
motivations. Basically when computing Module M with Definition t := u,
where u : U and t : T in M, we have two choices for the returned module
type, and neither is better in the absolute.

Since U ≤ T by typing, for the new field we can pick either MT { t : T := u }
or MU { t : U := u }, both being type sound due to cumulativity
invariants. In particular, MU ≤ MT, and with additional constraints
not made explicit, in some sense MU is the minimal type and MT the maximal
type that can be computed for the with Definition module type.
In this view, they are both "canonical" in some sense.

Neither is better because for a module N : S, it is natural to take
S as small as possible, so favouring MU, but for a functor F(X : S),
it goes the other way around, favouring MT.

The old code was taking MT with a bug in the polymorphic case, and
the previous commit changed this to taking MU. Unfortunately it seems
that some developments rely on taking MT in the mono case, so we
revert back to the old behaviour fixed for the polymorphic case.
---
 kernel/mod_typing.ml        | 18 +++++++++++++-----
 test-suite/bugs/bug_21707.v | 16 ++++++++++++++++
 2 files changed, 29 insertions(+), 5 deletions(-)
 create mode 100644 test-suite/bugs/bug_21707.v

diff --git a/kernel/mod_typing.ml b/kernel/mod_typing.ml
index f5c0f2cd62f0..a082b63da85b 100644
--- a/kernel/mod_typing.ml
+++ b/kernel/mod_typing.ml
@@ -83,7 +83,7 @@ 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 typ, ctx' =
+      let (univs, typ), ctx' =
         match cb.const_universes, wth.w_univs with
         | Monomorphic, Monomorphic ->
           let error_univ_mismatch env t1 t2 = function
@@ -95,13 +95,13 @@ let rec check_with_def (cst, ustate) env struc (idl, wth) mp reso =
           | Undef _ | OpaqueDef _ ->
             let typ = cb.const_type in
             begin match infer_gen_conv_leq (cst, ustate) env' j.uj_type typ with
-            | Result.Ok cst -> j.uj_type, 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 -> j.uj_type, 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
@@ -136,15 +136,23 @@ let rec check_with_def (cst, ustate) env struc (idl, wth) mp reso =
             | Primitive _ -> error WithCannotConstrainPrimitive
             | Symbol _ -> error WithCannotConstrainSymbol
           in
-          j.uj_type, 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_type = typ;
-          const_universes = wth.w_univs;
+          const_universes = univs;
           const_body_code = wth.w_bytecode; }
       in
       before@(lab,SFBconst(cb'))::after, ctx'
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.

From d77a23093c8c8303d5cb4b17bd7222ad32bb9cfc Mon Sep 17 00:00:00 2001
From: Enrico Tassi <Enrico.Tassi@Inria.fr>
Date: Wed, 4 Mar 2026 11:15:32 +0100
Subject: [PATCH 198/578] overlay

---
 dev/ci/user-overlays/21708-gares-elpi-361.sh | 1 +
 1 file changed, 1 insertion(+)
 create mode 100644 dev/ci/user-overlays/21708-gares-elpi-361.sh

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

From 791dadf716c8ac243026c8c4b46b726ea30b0b53 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Wed, 4 Mar 2026 14:19:09 +0100
Subject: [PATCH 199/578] Fix link in critical-bugs.md

Reported-by: bschommer
---
 dev/doc/critical-bugs.md | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/dev/doc/critical-bugs.md b/dev/doc/critical-bugs.md
index d3d997b0aae7..50ad81929891 100644
--- a/dev/doc/critical-bugs.md
+++ b/dev/doc/critical-bugs.md
@@ -566,7 +566,7 @@ fix.
 - 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/pull/21688)
+- 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

From 9b06ec50a57c74f29658a50a1ceb1721ff091f27 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Wed, 4 Mar 2026 14:33:28 +0100
Subject: [PATCH 200/578] Remove Sorts.Quality.all (which contains a dummy
 `QVar -1`)

For the change in vernacentries add_subnames_of, note that
elimination_suffix produces _rect on both QVar and QType, so the dummy
var is not needed.
---
 engine/univGen.ml       | 1 -
 engine/univGen.mli      | 1 -
 kernel/sorts.ml         | 1 -
 kernel/sorts.mli        | 2 --
 vernac/vernacentries.ml | 6 +++---
 5 files changed, 3 insertions(+), 8 deletions(-)

diff --git a/engine/univGen.ml b/engine/univGen.ml
index 81d226ddbd7c..759276d5f0fc 100644
--- a/engine/univGen.ml
+++ b/engine/univGen.ml
@@ -71,7 +71,6 @@ module QualityOrSet = struct
   let raw_pr = pr Sorts.QVar.raw_pr
 
   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
diff --git a/engine/univGen.mli b/engine/univGen.mli
index 2add1595c5ee..4b15ffbf2657 100644
--- a/engine/univGen.mli
+++ b/engine/univGen.mli
@@ -40,7 +40,6 @@ module QualityOrSet : sig
   val raw_pr : t -> Pp.t
 
   val all_constants : t list
-  val all : t list
 end
 
 type univ_length_mismatch = {
diff --git a/kernel/sorts.ml b/kernel/sorts.ml
index 2069c6bf6d01..e6aa67e14811 100644
--- a/kernel/sorts.ml
+++ b/kernel/sorts.ml
@@ -202,7 +202,6 @@ module Quality = struct
   let raw_pr q = pr QVar.raw_pr 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
diff --git a/kernel/sorts.mli b/kernel/sorts.mli
index a07df598a370..a71a12787cef 100644
--- a/kernel/sorts.mli
+++ b/kernel/sorts.mli
@@ -105,8 +105,6 @@ module Quality : sig
   val raw_pr : t -> Pp.t
 
   val all_constants : t list
-  val all : t list
-  (* Returns a dummy variable *)
 
   val hash : t -> int
 
diff --git a/vernac/vernacentries.ml b/vernac/vernacentries.ml
index d982f9e72a46..c79c0c663de3 100644
--- a/vernac/vernacentries.ml
+++ b/vernac/vernacentries.ml
@@ -1437,14 +1437,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

From 2e1ef69117ea8602f0f06f86eb6d971333a27e33 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Wed, 4 Mar 2026 14:55:39 +0100
Subject: [PATCH 201/578] Inline Sorts.is_small in its only caller

---
 engine/eConstr.ml  | 1 -
 engine/eConstr.mli | 1 -
 kernel/constr.ml   | 1 -
 kernel/constr.mli  | 1 -
 kernel/sorts.ml    | 4 ----
 kernel/sorts.mli   | 1 -
 tactics/tactics.ml | 4 +++-
 7 files changed, 3 insertions(+), 10 deletions(-)

diff --git a/engine/eConstr.ml b/engine/eConstr.ml
index 533a4c5c4be6..f31e880d4529 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)
diff --git a/engine/eConstr.mli b/engine/eConstr.mli
index 3a485da1e3fd..ef42c242fa35 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
diff --git a/kernel/constr.ml b/kernel/constr.ml
index e4db9a344946..e8896c649382 100644
--- a/kernel/constr.ml
+++ b/kernel/constr.ml
@@ -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 *)
diff --git a/kernel/constr.mli b/kernel/constr.mli
index 59235995ebb5..53e10fccb545 100644
--- a/kernel/constr.mli
+++ b/kernel/constr.mli
@@ -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
diff --git a/kernel/sorts.ml b/kernel/sorts.ml
index 2069c6bf6d01..bdd6d262e71a 100644
--- a/kernel/sorts.ml
+++ b/kernel/sorts.ml
@@ -407,10 +407,6 @@ let is_set = function
   | Set -> true
   | SProp | Prop | Type _ | QSort _ -> false
 
-let is_small = function
-  | SProp | Prop | Set -> true
-  | Type _ | QSort _ -> false
-
 let levels s = match s with
 | SProp | Prop -> Level.Set.empty
 | Set -> Level.Set.singleton Level.set
diff --git a/kernel/sorts.mli b/kernel/sorts.mli
index a07df598a370..0b7385e0cc51 100644
--- a/kernel/sorts.mli
+++ b/kernel/sorts.mli
@@ -178,7 +178,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
diff --git a/tactics/tactics.ml b/tactics/tactics.ml
index 6b8b7133f1be..48fc89aa02fc 100644
--- a/tactics/tactics.ml
+++ b/tactics/tactics.ml
@@ -295,7 +295,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 _ | QSort _ -> default_type_ident
 
 let default_id env sigma decl =
   let open Context.Rel.Declaration in

From a08e2075578c95e4efbb8cc009e5bcab940d423b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Wed, 4 Mar 2026 17:02:54 +0100
Subject: [PATCH 202/578] Stop using safe_env for `Type` command

There are probably no qvars after collapse is called, but if there are
pushing them to a safe env is questionable.

Also we may want to stop using collapse in this command.
---
 vernac/vernacentries.ml | 14 +++++++-------
 1 file changed, 7 insertions(+), 7 deletions(-)

diff --git a/vernac/vernacentries.ml b/vernac/vernacentries.ml
index d982f9e72a46..41b71cb75586 100644
--- a/vernac/vernacentries.ml
+++ b/vernac/vernacentries.ml
@@ -2151,20 +2151,20 @@ 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 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
+  let env = Environ.push_qualities ~rigid:false (qs, qcst) env in (* XXX always empty due to collapse? *)
+  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
 
 

From c9da0c07c938b0ae6e4ea76aed764878055bfc52 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Wed, 11 Feb 2026 13:29:24 +0100
Subject: [PATCH 203/578] Partial abstraction of subtree type.

---
 kernel/inductive.ml | 117 +++++++++++++++++++++++++-------------------
 1 file changed, 66 insertions(+), 51 deletions(-)

diff --git a/kernel/inductive.ml b/kernel/inductive.ml
index a39e7f2c01ac..3d617401c042 100644
--- a/kernel/inductive.ml
+++ b/kernel/inductive.ml
@@ -664,27 +664,55 @@ let size_glb s1 s2 =
        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 inter_recarg r1 r2 = if eq_recarg r1 r2 then Some r1 else None
+
+module WfPaths :
+sig
+type t
+val make : wf_paths -> t
+val repr : t -> wf_paths
+val inter : t -> t -> t
+val restrict : t -> wf_paths -> t
+val dest_subterms : t -> t list array
+val is_norec : t -> bool
+val is_inductive : env -> inductive -> t -> bool
+val is_primitive : env -> Constant.t -> t -> bool
+end =
+struct
+type t = wf_paths
+let make x = x
+let repr x = x
+let inter t1 t2 = Rtree.inter Declareops.eq_recarg inter_recarg Norec t1 t2
+let restrict = inter
+
+let dest_subterms = dest_subterms
 
-let is_norec_path t = match Rtree.dest_head t with
+let is_norec t = match Rtree.dest_head t with
 | Norec -> true
 | Mrec _ -> 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 is_primitive env cst t = match dest_recarg t with
+| Mrec (RecArgPrim c) -> QConstant.equal env cst c
+| Norec | Mrec _ -> false
 
-let inter_wf_paths = Rtree.inter Declareops.eq_recarg inter_recarg Norec
+end
+
+type subterm_spec =
+    Subterm of (Int.Set.t * size * WfPaths.t)
+  | Dead_code
+  | Not_subterm
+  | Internally_bound_subterm of Int.Set.t
 
 let incl_wf_paths = Rtree.incl Declareops.eq_recarg inter_recarg Norec
 
 let spec_of_tree internal t =
-  if is_norec_path t
-  then Not_subterm
+  if WfPaths.is_norec t then Not_subterm
   else Subterm (internal, Strict, t)
 
 let merge_internal_subterms l1 l2 =
@@ -700,7 +728,7 @@ let inter_spec s1 s2 =
   | 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)
+     Subterm (merge_internal_subterms l1 l2, size_glb a1 a2, WfPaths.inter t1 t2)
 
 let subterm_spec_glb =
   Array.fold_left inter_spec Dead_code
@@ -800,11 +828,6 @@ 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. *)
@@ -821,18 +844,14 @@ let branches_specif renv c_spec ci =
     | 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
+                Subterm (internal,_,t) when WfPaths.is_inductive renv.env ci.ci_ind t ->
+                  let vra = (WfPaths.dest_subterms t).(i) in
+                  let () = assert (Int.equal nca (List.length vra)) in
+                  Array.map_of_list (fun t -> spec_of_tree internal t) 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
@@ -942,23 +961,19 @@ 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
+      if WfPaths.is_inductive env (fst ind_kn) tree then
+        build_recargs_nested ienv tree (ind_kn, largs)
+      else mk_norec
     | 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_primitive 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 nonrecpar = mib.mind_nparams - mib.mind_nparams_rec in
@@ -973,8 +988,8 @@ 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 [|WfPaths.dest_subterms tree|]
+      else Array.map (fun v -> Array.map (fun l -> List.map WfPaths.make l) v) (Cache.get_inductive_subterms mind mib cache)
     in
     let mk_irecargs j mip =
       (* The nested inductive type with parameters removed *)
@@ -993,12 +1008,12 @@ 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) (WfPaths.dest_subterms tree).(0) largs in
     let recargs = [| mk_paths (Mrec (RecArgPrim c)) [| paths |] |] in
     (Rtree.mk_rec recargs).(0)
 
@@ -1054,7 +1069,7 @@ let restrict_spec cache ?evars env spec p =
     | Dead_code -> spec
     | Subterm (l, st, tree) ->
       let recargs = get_recargs_approx cache ?evars env tree i args in
-      let tree = inter_wf_paths tree recargs in
+      let tree = WfPaths.restrict tree recargs in
       Subterm (l, st, tree)
     | _ -> assert false
     end
@@ -1089,7 +1104,7 @@ let filter_stack_domain cache stack_element_specif set_iota_specif ?evars env p
             | Not_subterm | Dead_code | Internally_bound_subterm _ as spec -> spec
             | Subterm (l, s, tree) ->
               let recargs = get_recargs_approx cache ?evars env tree ind args in
-              let tree = inter_wf_paths tree recargs in
+              let tree = WfPaths.restrict tree recargs in
               Subterm (l, s, tree)
             end in
             SArg sarg
@@ -1151,7 +1166,7 @@ let rec subterm_specif cache ?evars renv stack t =
                      (* 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
+          (nbfix-i, lazy (Subterm(Int.Set.empty,Strict,WfPaths.make recargs))) in
         let decrArg = recindxs.(i) in
         let theBody = bodies.(i)   in
         let nbOfAbst = decrArg+1 in
@@ -1180,7 +1195,7 @@ let rec subterm_specif cache ?evars renv stack t =
       (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
+         let wf_args = (WfPaths.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)
@@ -1225,7 +1240,7 @@ and primitive_specif cache ?evars renv op args =
     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
+      let wf_args = (WfPaths.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
@@ -1280,7 +1295,7 @@ type check_subterm_result =
 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
+    if incl_wf_paths tree (WfPaths.repr tree') then NeedReduceSubterm need_reduce
     else InvalidSubterm
   | Dead_code -> NeedReduceSubterm Int.Set.empty
   | Not_subterm | Subterm (_,Large,_) -> InvalidSubterm
@@ -1738,7 +1753,7 @@ let check_fix_pre_sorts ?evars env ((nvect, _), (names, _, bodies as recdef) as
       let trees = Array.map get_tree 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
+        let renv = make_renv fenv nvect.(i) (WfPaths.make trees.(i)) in
         try check_one_fix cache ?evars renv nvect trees body
         with FixGuardError (err_env, err) -> raise_err err_env i err
       done
@@ -1791,13 +1806,13 @@ let check_one_cofix cache ?evars env nbfix def deftype =
             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 WfPaths.is_norec 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;
+                      check_rec_call env true n rar (WfPaths.dest_subterms rar) t;
                       process_args_of_constr (lr, lrar)
                     end
               | [],_ -> ()
@@ -1836,7 +1851,7 @@ let check_one_cofix cache ?evars env nbfix def deftype =
                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
+                     let vlra = WfPaths.dest_subterms tree in
                      Array.iter (check_rec_call env alreadygrd n tree vlra) vrest
                    else
                      raise (CoFixGuardError (env,RecCallInCaseFun c))
@@ -1855,8 +1870,8 @@ let check_one_cofix cache ?evars env nbfix def deftype =
            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.make (lookup_subterms env mind) in
+  check_rec_call env false 1 vlra (WfPaths.dest_subterms vlra) def
 
 (* The  function which checks that the whole block of definitions
    satisfies the guarded condition *)

From a85d4ccdb756dbee07f0306da03a687281a36daf Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Thu, 19 Feb 2026 14:51:28 +0100
Subject: [PATCH 204/578] Add an implementation of Hopcroft algorithm.

---
 lib/hopcroft.ml  | 365 +++++++++++++++++++++++++++++++++++++++++++++++
 lib/hopcroft.mli |  38 +++++
 2 files changed, 403 insertions(+)
 create mode 100644 lib/hopcroft.ml
 create mode 100644 lib/hopcroft.mli

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             *)
+(* <O___,, * (see version control and CREDITS file for authors & dates) *)
+(*   \VV/  **************************************************************)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(** Partition refinement algorithm *)
+
+module type PartitionS =
+sig
+  type t
+  (** Type of partition structure *)
+
+  type set
+  (** Type of partitions *)
+
+  val create : int -> 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             *)
+(* <O___,, * (see version control and CREDITS file for authors & dates) *)
+(*   \VV/  **************************************************************)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(** Hopcroft algorithm *)
+
+module type S =
+sig
+  type label
+  type state
+  type transition = {
+    src : state;
+    lbl : label;
+    dst : state;
+  }
+
+  type automaton = {
+    states : int;
+    (** The number of states of the automaton. *)
+    partitions : state list list;
+    (** A set of state partitions initially known to be observationally
+        distinct. For instance, if the automaton has the list [l] as accepting
+        states, one can set [partitions = [l]]. *)
+    transitions : transition list;
+    (** The transitions of the automaton without duplicates. *)
+  }
+
+  val reduce : automaton -> 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

From 2f6d51bbb08729527f5d3427242070634d1ea00d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Fri, 20 Feb 2026 16:24:23 +0100
Subject: [PATCH 205/578] Use automata rather than regular trees for guard
 checking.

This representation prevents an exponential blowup when nesting inductive
types. It makes guard checking basically instantaneous on some examples
that used to take about 30s.

Fixes #19650: Taking a long time to type check inductive types.
Fixes #21526: Slow fixpoint type-checking due to the guard condition.
---
 kernel/inductive.ml |  67 ++++++++++++----
 kernel/rtree.ml     | 191 +++++++++++++++++++++++++++++++++++++++++++-
 kernel/rtree.mli    |  36 +++++++++
 3 files changed, 279 insertions(+), 15 deletions(-)

diff --git a/kernel/inductive.ml b/kernel/inductive.ml
index 3d617401c042..0aa8fb5d1cf0 100644
--- a/kernel/inductive.ml
+++ b/kernel/inductive.ml
@@ -664,30 +664,68 @@ let size_glb s1 s2 =
        empty type
  *)
 
-let inter_recarg r1 r2 = if eq_recarg r1 r2 then Some r1 else None
+module RecArg =
+struct
+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 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 meet r1 r2 = match r1, r2 with
+| Mrec _, Mrec _ ->
+  let () = assert (eq_recarg r1 r2) in
+  r1
+| Norec, Norec -> Norec
+| (Norec, Mrec _) | (Mrec _, Norec) -> Norec
+
+end
 
 module WfPaths :
 sig
 type t
 val make : wf_paths -> t
-val repr : t -> wf_paths
 val inter : t -> t -> t
 val restrict : t -> wf_paths -> t
 val dest_subterms : t -> t list array
 val is_norec : t -> bool
 val is_inductive : env -> inductive -> t -> bool
 val is_primitive : env -> Constant.t -> t -> bool
+val equal : t -> t -> bool
 end =
 struct
-type t = wf_paths
-let make x = x
-let repr x = x
-let inter t1 t2 = Rtree.inter Declareops.eq_recarg inter_recarg Norec t1 t2
-let restrict = inter
 
-let dest_subterms = dest_subterms
+module Atm = Rtree.Automaton
+
+type t = recarg Atm.t
+
+let make path =
+  let automaton = Atm.make path in
+  Atm.compact RecArg.compare automaton
+
+let inter t1 t2 =
+  let automaton = Atm.inter RecArg.meet t1 t2 in
+  if automaton == t1 then t1 else Atm.compact RecArg.compare automaton
 
-let is_norec t = match Rtree.dest_head t with
+let restrict t p =
+  let automaton = Atm.inter RecArg.meet t (make p) in
+  Atm.compact RecArg.compare automaton
+
+let dest_subterms t =
+  let trans = Atm.transitions t (Atm.initial t) in
+  let map v = Array.map_to_list (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 _ ->
@@ -701,6 +739,9 @@ let is_primitive env cst t = match dest_recarg t with
 | Mrec (RecArgPrim c) -> QConstant.equal env cst c
 | Norec | Mrec _ -> false
 
+let equal t1 t2 =
+  Atm.equal eq_recarg t1 t2
+
 end
 
 type subterm_spec =
@@ -709,8 +750,6 @@ type subterm_spec =
   | Not_subterm
   | Internally_bound_subterm of Int.Set.t
 
-let incl_wf_paths = Rtree.incl Declareops.eq_recarg inter_recarg Norec
-
 let spec_of_tree internal t =
   if WfPaths.is_norec t then Not_subterm
   else Subterm (internal, Strict, t)
@@ -1295,7 +1334,7 @@ type check_subterm_result =
 let check_is_subterm x tree =
   match Lazy.force x with
   | Subterm (need_reduce,Strict,tree') ->
-    if incl_wf_paths tree (WfPaths.repr tree') then NeedReduceSubterm need_reduce
+    if WfPaths.equal tree tree' then NeedReduceSubterm need_reduce
     else InvalidSubterm
   | Dead_code -> NeedReduceSubterm Int.Set.empty
   | Not_subterm | Subterm (_,Large,_) -> InvalidSubterm
@@ -1748,12 +1787,12 @@ let check_fix_pre_sorts ?evars env ((nvect, _), (names, _, bodies as recdef) as
     if flags.check_guarded then
       let get_tree (kn,i) =
         let mib = Environ.lookup_mind kn env in
-        mib.mind_packets.(i).mind_recargs
+        WfPaths.make mib.mind_packets.(i).mind_recargs
       in
       let trees = Array.map get_tree inds in
       for i = 0 to Array.length bodies - 1 do
         let (fenv, body) = rdef.(i) in
-        let renv = make_renv fenv nvect.(i) (WfPaths.make trees.(i)) in
+        let renv = make_renv fenv nvect.(i) trees.(i) in
         try check_one_fix cache ?evars renv nvect trees body
         with FixGuardError (err_env, err) -> raise_err err_env i err
       done
diff --git a/kernel/rtree.ml b/kernel/rtree.ml
index 1e2145f0aad9..450bb7851e8a 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,192 @@ 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
+
+end
diff --git a/kernel/rtree.mli b/kernel/rtree.mli
index 24a479c5e3f6..4069f8b84333 100644
--- a/kernel/rtree.mli
+++ b/kernel/rtree.mli
@@ -109,3 +109,39 @@ 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
+
+end

From 1cdafe4059b1ddb4e40e6e7c5d774c68d1b2c13f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Tue, 24 Feb 2026 18:06:05 +0100
Subject: [PATCH 206/578] Store inductive automata next to their regular tree
 in Declarations.

This prevents having to recompute them every single time we perform a guard
check. Note that we could probably get rid of the regular tree at some point,
since it is now only used in a marginal way.
---
 checker/checkInductive.ml |  3 +-
 checker/values.ml         |  5 +++
 kernel/declarations.mli   |  2 ++
 kernel/declareops.ml      | 16 ++++++++++
 kernel/declareops.mli     |  1 +
 kernel/discharge.ml       |  1 +
 kernel/indtypes.ml        |  5 +++
 kernel/inductive.ml       | 66 ++++++++++++++-------------------------
 kernel/rtree.ml           |  5 +++
 kernel/rtree.mli          |  3 ++
 10 files changed, 63 insertions(+), 44 deletions(-)

diff --git a/checker/checkInductive.ml b/checker/checkInductive.ml
index e5dcd76b48cb..a1c6e6b83f11 100644
--- a/checker/checkInductive.ml
+++ b/checker/checkInductive.ml
@@ -172,7 +172,7 @@ 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_consnrealargs; mind_consnrealdecls; mind_recargs; mind_automaton; mind_relevance;
       mind_nb_constant; mind_nb_args; mind_reloc_tbl } =
   let check = check mind in
 
@@ -195,6 +195,7 @@ let check_packet mind ind
   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);
 
diff --git a/checker/values.ml b/checker/values.ml
index 4e1d5111f6f4..080a115a5acb 100644
--- a/checker/values.ml
+++ b/checker/values.ml
@@ -436,6 +436,10 @@ let v_wfp =
       [|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" 3
@@ -458,6 +462,7 @@ let v_one_ind = v_tuple "one_inductive_body"
     v_array v_int;
     v_array v_int;
     v_wfp;
+    v_automaton;
     v_relevance;
     v_int;
     v_int;
diff --git a/kernel/declarations.mli b/kernel/declarations.mli
index 080634139c36..02b5b0e2a9fe 100644
--- a/kernel/declarations.mli
+++ b/kernel/declarations.mli
@@ -250,6 +250,8 @@ type one_inductive_body = {
 
     mind_recargs : wf_paths; (** Signature of recursive arguments in the constructors *)
 
+    mind_automaton : recarg Rtree.Automaton.t; (** Minimal automaton generated from the above *)
+
     mind_relevance : Sorts.relevance;
     (* XXX this is redundant with mind_sort, is it actually worth keeping? *)
 
diff --git a/kernel/declareops.ml b/kernel/declareops.ml
index 373dd0408724..7dab6c0dca99 100644
--- a/kernel/declareops.ml
+++ b/kernel/declareops.ml
@@ -159,6 +159,18 @@ let eq_recarg r1 r2 = match r1, r2 with
 | Mrec t1, Mrec t2 -> eq_recarg_type t1 t2
 | Mrec _, _ -> 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 pr_recarg_type = let open Pp in function
   | RecArgInd (mind,i) ->
      str "Mrec[" ++ Names.MutInd.print mind ++ pr_comma () ++ int i ++ str "]"
@@ -209,6 +221,9 @@ let recarg_length p j =
 
 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 } *)
 
 let subst_mind_record subst r = match r with
@@ -234,6 +249,7 @@ let subst_mind_packet subst mbp =
     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_nb_constant = mbp.mind_nb_constant;
     mind_nb_args = mbp.mind_nb_args;
diff --git a/kernel/declareops.mli b/kernel/declareops.mli
index 9cb522a7152b..25ef2241305a 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
diff --git a/kernel/discharge.ml b/kernel/discharge.ml
index 8ad2fb5dec3c..466a76bb9681 100644
--- a/kernel/discharge.ml
+++ b/kernel/discharge.ml
@@ -156,6 +156,7 @@ let cook_one_ind info cache ~params ~ntypes mip =
     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_nb_constant = mip.mind_nb_constant;
     mind_nb_args = mip.mind_nb_args;
diff --git a/kernel/indtypes.ml b/kernel/indtypes.ml
index fb3cfdaff8ac..efafbf9c066a 100644
--- a/kernel/indtypes.ml
+++ b/kernel/indtypes.ml
@@ -543,6 +543,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;
@@ -558,6 +562,7 @@ let build_inductive env ~sec_univs names prv univs template variance
         mind_user_lc = lc;
         mind_nf_lc = nf_lc;
         mind_recargs = recarg;
+        mind_automaton = automaton;
         mind_relevance;
         mind_nb_constant = !nconst;
         mind_nb_args = !nblock;
diff --git a/kernel/inductive.ml b/kernel/inductive.ml
index 0aa8fb5d1cf0..568b000a738b 100644
--- a/kernel/inductive.ml
+++ b/kernel/inductive.ml
@@ -664,33 +664,10 @@ let size_glb s1 s2 =
        empty type
  *)
 
-module RecArg =
-struct
-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 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 meet r1 r2 = match r1, r2 with
-| Mrec _, Mrec _ ->
-  let () = assert (eq_recarg r1 r2) in
-  r1
-| Norec, Norec -> Norec
-| (Norec, Mrec _) | (Mrec _, Norec) -> Norec
-
-end
-
 module WfPaths :
 sig
 type t
-val make : wf_paths -> t
+val make : recarg Rtree.Automaton.t -> t (* must be minimal! *)
 val inter : t -> t -> t
 val restrict : t -> wf_paths -> t
 val dest_subterms : t -> t list array
@@ -705,17 +682,24 @@ module Atm = Rtree.Automaton
 
 type t = recarg Atm.t
 
-let make path =
-  let automaton = Atm.make path in
-  Atm.compact RecArg.compare automaton
+let make t = t
+
+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 RecArg.meet t1 t2 in
-  if automaton == t1 then t1 else Atm.compact RecArg.compare automaton
+  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 automaton = Atm.inter RecArg.meet t (make p) in
-  Atm.compact RecArg.compare automaton
+  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_subterms t =
   let trans = Atm.transitions t (Atm.initial t) in
@@ -865,7 +849,7 @@ let lift1_stack = lift_stack 1
 
 let lookup_subterms env ind =
   let (_,mip) = lookup_mind_specif env ind in
-  mip.mind_recargs
+  WfPaths.make mip.mind_automaton
 
 (* 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
@@ -967,15 +951,15 @@ module Cache :
 sig
   type t
   val create : unit -> t
-  val get_inductive_subterms : MutInd.t -> mutual_inductive_body -> t -> wf_paths list array array
+  val get_inductive_subterms : MutInd.t -> mutual_inductive_body -> t -> WfPaths.t list array array
 end =
 struct
-  type ans = wf_paths list array array
+  type ans = WfPaths.t 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 ans = Array.map (fun mip -> WfPaths.dest_subterms (WfPaths.make mip.mind_automaton)) mib.mind_packets in
     let () = cache := Mindmap_env.add mind ans !cache in
     ans
   | Some ans -> ans
@@ -1028,7 +1012,7 @@ let get_recargs_approx cache ?evars env tree ind args =
     mutually recursive containers are not supported. *)
     let trees =
       if Int.equal auxntyp 1 then [|WfPaths.dest_subterms tree|]
-      else Array.map (fun v -> Array.map (fun l -> List.map WfPaths.make l) v) (Cache.get_inductive_subterms mind mib cache)
+      else Cache.get_inductive_subterms mind mib cache
     in
     let mk_irecargs j mip =
       (* The nested inductive type with parameters removed *)
@@ -1205,7 +1189,7 @@ let rec subterm_specif cache ?evars renv stack t =
                      (* Why Strict here ? To be general, it could also be
                         Large... *)
           assign_var_spec renv'
-          (nbfix-i, lazy (Subterm(Int.Set.empty,Strict,WfPaths.make recargs))) in
+          (nbfix-i, lazy (Subterm(Int.Set.empty,Strict,recargs))) in
         let decrArg = recindxs.(i) in
         let theBody = bodies.(i)   in
         let nbOfAbst = decrArg+1 in
@@ -1785,11 +1769,7 @@ let check_fix_pre_sorts ?evars env ((nvect, _), (names, _, bodies as recdef) as
   let raise_err = raise_fix_guard_err_fn env recdef names in
   let () =
     if flags.check_guarded then
-      let get_tree (kn,i) =
-        let mib = Environ.lookup_mind kn env in
-        WfPaths.make mib.mind_packets.(i).mind_recargs
-      in
-      let trees = Array.map get_tree inds in
+      let trees = Array.map (fun ind -> 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
@@ -1909,7 +1889,7 @@ let check_one_cofix cache ?evars env nbfix def deftype =
            raise (CoFixGuardError (env,NotGuardedForm t)) in
 
   let ((mind, _),_) = codomain_is_coind ?evars env deftype in
-  let vlra = WfPaths.make (lookup_subterms env mind) in
+  let vlra = lookup_subterms env mind in
   check_rec_call env false 1 vlra (WfPaths.dest_subterms vlra) def
 
 (* The  function which checks that the whole block of definitions
diff --git a/kernel/rtree.ml b/kernel/rtree.ml
index 450bb7851e8a..093b4e0ec8b6 100644
--- a/kernel/rtree.ml
+++ b/kernel/rtree.ml
@@ -453,4 +453,9 @@ let equal eqf { init = i1; states = st1 } { init = i2; states = st2 } =
   | _ -> 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 4069f8b84333..0579c6fae0ce 100644
--- a/kernel/rtree.mli
+++ b/kernel/rtree.mli
@@ -144,4 +144,7 @@ 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

From fe196ea0e04f5971b580335479d172bdf9f72209 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Thu, 5 Mar 2026 14:42:18 +0100
Subject: [PATCH 207/578] Notation.interp_prim_token does not need to return
 the scope

---
 interp/constrintern.ml | 6 +++---
 interp/notation.ml     | 2 +-
 interp/notation.mli    | 4 ++--
 3 files changed, 6 insertions(+), 6 deletions(-)

diff --git a/interp/constrintern.ml b/interp/constrintern.ml
index 647cbf4f3ac8..bd07afd0a18b 100644
--- a/interp/constrintern.ml
+++ b/interp/constrintern.ml
@@ -1883,7 +1883,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 +1901,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) ->
@@ -2800,7 +2800,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) =
diff --git a/interp/notation.ml b/interp/notation.ml
index a99bfe4fb71a..d1327f62aaf7 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
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 *)

From 71bcfab828eba92cdf8a6d275e54196d591d6291 Mon Sep 17 00:00:00 2001
From: Matthieu Sozeau <matthieu.sozeau@inria.fr>
Date: Thu, 5 Mar 2026 15:46:09 +0100
Subject: [PATCH 208/578] Fix minimize_universes call in comInductive

---
 vernac/comInductive.ml | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/vernac/comInductive.ml b/vernac/comInductive.ml
index f68aa7a99e45..8bc0b4112198 100644
--- a/vernac/comInductive.ml
+++ b/vernac/comInductive.ml
@@ -648,8 +648,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 collapse_sort_variables = PolyFlags.collapse_sort_variables poly in
-  let sigma = Evd.minimize_universes ~collapse_sort_variables:(not collapse_sort_variables) ~to_type:collapse_sort_variables sigma in
+  let sigma = Evd.minimize_universes ~collapse_sort_variables:false sigma in
   let sigma = restrict_inductive_universes sigma ctx_params arities constructors in
 
   let sigma, univ_entry, ubinders, global_univs =

From 017bdf898900b7a6bb72d9f9c7dda4130cca861c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Wed, 11 Feb 2026 15:32:39 +0100
Subject: [PATCH 209/578] Renaming in ML APIs about ltac2 abbreviations: alias
 -> abbrev

---
 plugins/ltac2/tac2entries.ml | 16 ++++++++--------
 plugins/ltac2/tac2env.ml     | 26 +++++++++++++-------------
 plugins/ltac2/tac2env.mli    | 12 ++++++------
 plugins/ltac2/tac2expr.mli   |  4 ++--
 plugins/ltac2/tac2intern.ml  | 36 ++++++++++++++++++------------------
 plugins/ltac2/tac2print.ml   |  2 +-
 plugins/ltac2/tac2subst.ml   |  4 ++--
 7 files changed, 50 insertions(+), 50 deletions(-)

diff --git a/plugins/ltac2/tac2entries.ml b/plugins/ltac2/tac2entries.ml
index f24b43b9064d..550dabec5941 100644
--- a/plugins/ltac2/tac2entries.ml
+++ b/plugins/ltac2/tac2entries.ml
@@ -610,15 +610,15 @@ type abbreviation = {
 }
 
 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 ?deprecation:abbr.abbr_depr kn abbr.abbr_body
 
 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 ?deprecation:abbr.abbr_depr kn abbr.abbr_body
 
 let subst_abbreviation (subst, abbr) =
   let body' = subst_rawexpr subst abbr.abbr_body in
@@ -753,7 +753,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
@@ -995,8 +995,8 @@ 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
 
@@ -1051,7 +1051,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)
diff --git a/plugins/ltac2/tac2env.ml b/plugins/ltac2/tac2env.ml
index 3b60a4ed536e..b5c03956b909 100644
--- a/plugins/ltac2/tac2env.ml
+++ b/plugins/ltac2/tac2env.ml
@@ -37,9 +37,9 @@ type projection_data = {
   pdata_indx : int;
 }
 
-type alias_data = {
-  alias_body : raw_tacexpr;
-  alias_depr : Deprecation.t option;
+type abbrev_data = {
+  abbrev_body : raw_tacexpr;
+  abbrev_depr : Deprecation.t option;
 }
 
 type ltac_state = {
@@ -47,7 +47,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 +55,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 = {
@@ -106,12 +106,12 @@ 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 ?deprecation kn tac =
   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 data = { abbrev_body = tac; abbrev_depr = deprecation } in
+  ltac_state := { state with ltac_abbrevs = KerName.Map.add kn data state.ltac_abbrevs }
 
-let interp_alias kn = KerName.Map.find kn ltac_state.contents.ltac_aliases
+let interp_abbrev kn = KerName.Map.find kn ltac_state.contents.ltac_abbrevs
 
 module ML =
 struct
@@ -138,16 +138,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
diff --git a/plugins/ltac2/tac2env.mli b/plugins/ltac2/tac2env.mli
index 538de5c81e98..950c21322010 100644
--- a/plugins/ltac2/tac2env.mli
+++ b/plugins/ltac2/tac2env.mli
@@ -83,15 +83,15 @@ 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_body : raw_tacexpr;
+  abbrev_depr : Deprecation.t option;
 }
 
-val define_alias : ?deprecation:Deprecation.t -> ltac_constant -> raw_tacexpr -> unit
-val interp_alias : ltac_constant -> alias_data
+val define_abbrev : ?deprecation:Deprecation.t -> ltac_constant -> raw_tacexpr -> unit
+val interp_abbrev : ltac_constant -> abbrev_data
 
 (** {5 Name management} *)
 
diff --git a/plugins/ltac2/tac2expr.mli b/plugins/ltac2/tac2expr.mli
index 9b47c752a26a..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
diff --git a/plugins/ltac2/tac2intern.ml b/plugins/ltac2/tac2intern.ml
index e96bb76f46ad..ca39e916edc6 100644
--- a/plugins/ltac2/tac2intern.ml
+++ b/plugins/ltac2/tac2intern.ml
@@ -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
@@ -1179,14 +1179,14 @@ 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) ->
+  | ArgArg (TacAbbrev kn) ->
     let e =
-      try Tac2env.interp_alias kn
+      try Tac2env.interp_abbrev kn
       with Not_found ->
-        CErrors.anomaly (str "Missing hardwired alias " ++ KerName.print kn)
+        CErrors.anomaly (str "Missing hardwired abbrev " ++ KerName.print kn)
     in
-    let () = check_deprecated_ltac2 ?loc qid (TacAlias kn) in
-    intern_rec env tycon e.alias_body
+    let () = check_deprecated_ltac2 ?loc qid (TacAbbrev kn) in
+    intern_rec env tycon e.abbrev_body
   end
 | CTacCst qid ->
   let kn = get_constructor env qid in
@@ -1217,22 +1217,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 = Tac2env.interp_abbrev 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.abbrev_body, args))
 | CTacApp (f, args) ->
   let loc = f.loc in
   let (f, ft) = intern_rec env None f in
diff --git a/plugins/ltac2/tac2print.ml b/plugins/ltac2/tac2print.ml
index 939015b3e768..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.")
diff --git a/plugins/ltac2/tac2subst.ml b/plugins/ltac2/tac2subst.ml
index 6600b52d1b32..1970964f0cc3 100644
--- a/plugins/ltac2/tac2subst.ml
+++ b/plugins/ltac2/tac2subst.ml
@@ -161,9 +161,9 @@ let subst_tacref subst ref = match ref with
 | AbsKn (TacConstant kn) ->
   let kn' = subst_kn subst kn in
   if kn' == kn then ref else AbsKn (TacConstant kn')
-| AbsKn (TacAlias kn) ->
+| AbsKn (TacAbbrev kn) ->
   let kn' = subst_kn subst kn in
-  if kn' == kn then ref else AbsKn (TacAlias kn')
+  if kn' == kn then ref else AbsKn (TacAbbrev kn')
 
 let subst_projection subst prj = match prj with
 | RelId _ -> prj

From 1941dd08c3e619852c0d987ab18eba0612a5c263 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Wed, 11 Feb 2026 15:47:18 +0100
Subject: [PATCH 210/578] Ltac2 Abbreviations typecheck at declaration time

---
 .../21617-tac2abbrev-up-Added.rst             |  6 ++++
 doc/sphinx/proof-engine/ltac2.rst             |  6 ++--
 plugins/ltac2/tac2entries.ml                  | 25 ++++++--------
 plugins/ltac2/tac2env.ml                      |  7 ++--
 plugins/ltac2/tac2env.mli                     |  6 ++--
 plugins/ltac2/tac2intern.ml                   | 33 ++++++++++++++-----
 plugins/ltac2/tac2intern.mli                  |  1 +
 test-suite/output/ltac2_printabout.out        |  2 +-
 test-suite/output/ltac2_printabout.v          |  2 +-
 test-suite/output/ltac2_typed_notations.out   |  3 ++
 test-suite/output/ltac2_typed_notations.v     |  2 ++
 11 files changed, 61 insertions(+), 32 deletions(-)
 create mode 100644 doc/changelog/06-Ltac2-language/21617-tac2abbrev-up-Added.rst

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 <https://github.com/rocq-prover/rocq/pull/21617>`_,
+  by Gaëtan Gilbert).
diff --git a/doc/sphinx/proof-engine/ltac2.rst b/doc/sphinx/proof-engine/ltac2.rst
index c87a2360731f..e5a5dae3406e 100644
--- a/doc/sphinx/proof-engine/ltac2.rst
+++ b/doc/sphinx/proof-engine/ltac2.rst
@@ -1432,8 +1432,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.
 
diff --git a/plugins/ltac2/tac2entries.ml b/plugins/ltac2/tac2entries.ml
index 550dabec5941..399fdaa88177 100644
--- a/plugins/ltac2/tac2entries.ml
+++ b/plugins/ltac2/tac2entries.ml
@@ -604,29 +604,25 @@ let import_type qid as_id =
 
 (** {5 Parsing} *)
 
-type abbreviation = {
-  abbr_body : raw_tacexpr;
-  abbr_depr : Deprecation.t option;
-}
-
 let perform_abbreviation visibility ((sp, kn), abbr) =
   let () = Tac2env.push_ltac visibility sp (TacAbbrev kn) in
-  Tac2env.define_abbrev ?deprecation:abbr.abbr_depr kn abbr.abbr_body
+  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 (TacAbbrev kn) in
-  Tac2env.define_abbrev ?deprecation:abbr.abbr_depr kn abbr.abbr_body
+  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 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 -> Libobject.obj =
-  let open Libobject in
+let inTac2Abbreviation : Id.t -> Tac2env.abbrev_data -> obj =
   declare_named_object {(default_object "TAC2-ABBREVIATION") with
      cache_function  = cache_abbreviation;
      load_function   = load_abbreviation;
@@ -672,8 +668,7 @@ let register_notation atts tkn target body =
 
 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 data ->
     let data = Tac2syn.intern_notation_interpretation intern_notation_data data in
@@ -998,7 +993,7 @@ let print_tacref ~print_def qid = function
   | 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
diff --git a/plugins/ltac2/tac2env.ml b/plugins/ltac2/tac2env.ml
index b5c03956b909..46ebb31b360b 100644
--- a/plugins/ltac2/tac2env.ml
+++ b/plugins/ltac2/tac2env.ml
@@ -38,7 +38,9 @@ type projection_data = {
 }
 
 type abbrev_data = {
-  abbrev_body : raw_tacexpr;
+  abbrev_prms : int;
+  abbrev_ty : int glb_typexpr;
+  abbrev_body : glb_tacexpr;
   abbrev_depr : Deprecation.t option;
 }
 
@@ -106,9 +108,8 @@ let define_type kn e =
 
 let interp_type kn = KerName.Map.find kn ltac_state.contents.ltac_types
 
-let define_abbrev ?deprecation kn tac =
+let define_abbrev kn data =
   let state = !ltac_state in
-  let data = { abbrev_body = tac; abbrev_depr = deprecation } in
   ltac_state := { state with ltac_abbrevs = KerName.Map.add kn data state.ltac_abbrevs }
 
 let interp_abbrev kn = KerName.Map.find kn ltac_state.contents.ltac_abbrevs
diff --git a/plugins/ltac2/tac2env.mli b/plugins/ltac2/tac2env.mli
index 950c21322010..e57ddf02887e 100644
--- a/plugins/ltac2/tac2env.mli
+++ b/plugins/ltac2/tac2env.mli
@@ -86,11 +86,13 @@ val interp_projection : ltac_projection -> projection_data
 (** {5 Toplevel definition of abbreviations} *)
 
 type abbrev_data = {
-  abbrev_body : raw_tacexpr;
+  abbrev_prms : int;
+  abbrev_ty : int glb_typexpr;
+  abbrev_body : glb_tacexpr;
   abbrev_depr : Deprecation.t option;
 }
 
-val define_abbrev : ?deprecation:Deprecation.t -> ltac_constant -> raw_tacexpr -> unit
+val define_abbrev : ltac_constant -> abbrev_data -> unit
 val interp_abbrev : ltac_constant -> abbrev_data
 
 (** {5 Name management} *)
diff --git a/plugins/ltac2/tac2intern.ml b/plugins/ltac2/tac2intern.ml
index ca39e916edc6..8f8e43f7140a 100644
--- a/plugins/ltac2/tac2intern.ml
+++ b/plugins/ltac2/tac2intern.ml
@@ -1113,6 +1113,14 @@ 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_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
@@ -1180,13 +1188,9 @@ let rec intern_rec env tycon {loc;v=e} =
     let () = check_deprecated_ltac2 ?loc qid (TacConstant kn) in
     check (GTacRef kn, fresh_type_scheme env sch)
   | ArgArg (TacAbbrev kn) ->
-    let e =
-      try Tac2env.interp_abbrev kn
-      with Not_found ->
-        CErrors.anomaly (str "Missing hardwired abbrev " ++ KerName.print kn)
-    in
+    let e = expand_abbrev ?loc kn in
     let () = check_deprecated_ltac2 ?loc qid (TacAbbrev kn) in
-    intern_rec env tycon e.abbrev_body
+    intern_rec env tycon e
   end
 | CTacCst qid ->
   let kn = get_constructor env qid in
@@ -1222,7 +1226,7 @@ let rec intern_rec env tycon {loc;v=e} =
   | ArgArg (TacAbbrev kn) -> kn
   | ArgVar _ | (ArgArg (TacConstant _)) -> assert false
   in
-  let e = Tac2env.interp_abbrev kn in
+  let e = expand_abbrev ?loc:aloc kn in
   let () = check_deprecated_ltac2 ?loc:aloc qid (TacAbbrev kn) in
   let map arg =
     (* Thunk abbrev arguments *)
@@ -1232,7 +1236,7 @@ let rec intern_rec env tycon {loc;v=e} =
     CAst.make ?loc @@ CTacFun ([var], arg)
   in
   let args = List.map map args in
-  intern_rec env tycon (CAst.make ?loc @@ CTacApp (e.abbrev_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
@@ -1797,6 +1801,19 @@ let globalize ids tac =
   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
     ~key:["Ltac2";"Typed";"Notations"] ~value:true ()
diff --git a/plugins/ltac2/tac2intern.mli b/plugins/ltac2/tac2intern.mli
index f165131539ee..f1db1cfa4a9c 100644
--- a/plugins/ltac2/tac2intern.mli
+++ b/plugins/ltac2/tac2intern.mli
@@ -17,6 +17,7 @@ val intern : strict:bool -> UnivNames.universe_binders -> context -> raw_tacexpr
 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 -> 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
diff --git a/test-suite/output/ltac2_printabout.out b/test-suite/output/ltac2_printabout.out
index 860a185a6dee..be81b069173f 100644
--- a/test-suite/output/ltac2_printabout.out
+++ b/test-suite/output/ltac2_printabout.out
@@ -13,7 +13,7 @@ Inr : 'b -> ('a, 'b) either
 Triple : 'c -> 'b -> 'a -> ('a, 'b, 'c) triple
 Not_found : exn
 Out_of_bounds : message option -> exn
-Ltac2 Notation nota := () ()
+Ltac2 Notation nota := fun thunk => thunk ()
 Ltac2 Type constr
 Ltac2 Type constr := Init.constr
 ('a, 'b) thing := 'b option
diff --git a/test-suite/output/ltac2_printabout.v b/test-suite/output/ltac2_printabout.v
index d8e78248a378..0cbf190e63cb 100644
--- a/test-suite/output/ltac2_printabout.v
+++ b/test-suite/output/ltac2_printabout.v
@@ -31,7 +31,7 @@ Print Ltac2 Out_of_bounds.
 
 (* alias *)
 
-Ltac2 Abbreviation nota := () ().
+Ltac2 Abbreviation nota := fun thunk => thunk ().
 
 Print nota.
 
diff --git a/test-suite/output/ltac2_typed_notations.out b/test-suite/output/ltac2_typed_notations.out
index caa4e8b6c12b..b83774579b08 100644
--- a/test-suite/output/ltac2_typed_notations.out
+++ b/test-suite/output/ltac2_typed_notations.out
@@ -9,3 +9,6 @@ let m :=
     (Pattern.MatchPattern, pat:(false), (fun _ => fun _ => false))]
 with t := c in
 Pattern.one_match0 t m
+File "./output/ltac2_typed_notations.v", line 18, characters 31-32:
+The command has indeed failed with message:
+This expression has type int. It is not a function and cannot be applied.
diff --git a/test-suite/output/ltac2_typed_notations.v b/test-suite/output/ltac2_typed_notations.v
index 2de4a96c76cd..b3255c28b562 100644
--- a/test-suite/output/ltac2_typed_notations.v
+++ b/test-suite/output/ltac2_typed_notations.v
@@ -14,3 +14,5 @@ Ltac2 Globalize fun (b: bool) =>
   | true => true
   | false => false
   end : bool).
+
+Fail Ltac2 Abbreviation bar := 0 0.

From 353f2630b583c2c0af526443f11b3b06d949e341 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Wed, 11 Feb 2026 15:50:58 +0100
Subject: [PATCH 211/578] Stop exposing Tac2intern.globalize

(only used when unset typed notations, caller also in tac2intern)
---
 plugins/ltac2/tac2intern.mli | 6 ------
 1 file changed, 6 deletions(-)

diff --git a/plugins/ltac2/tac2intern.mli b/plugins/ltac2/tac2intern.mli
index f1db1cfa4a9c..e84893177123 100644
--- a/plugins/ltac2/tac2intern.mli
+++ b/plugins/ltac2/tac2intern.mli
@@ -56,12 +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]. *)
 
-(** {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. *)
-
 (** Errors *)
 
 val error_nargs_mismatch : ?loc:Loc.t -> ltac_constructor -> int -> int -> 'a

From d43d444dcff6192adcaeb035b115b800e94c6b3f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Fri, 13 Feb 2026 13:45:53 +0100
Subject: [PATCH 212/578] overlay

---
 dev/ci/user-overlays/21617-SkySkimmer-tac2abbrev-up.sh | 1 +
 1 file changed, 1 insertion(+)
 create mode 100644 dev/ci/user-overlays/21617-SkySkimmer-tac2abbrev-up.sh

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

From a5d9fdd7b155018067cb8103544f83ab98e976fc Mon Sep 17 00:00:00 2001
From: nicolas tabareau <nicolas.tabareau@gmail.com>
Date: Thu, 5 Mar 2026 17:47:54 +0100
Subject: [PATCH 213/578] fix missing renaming

---
 ide/rocqide/rocqDriver.ml | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/ide/rocqide/rocqDriver.ml b/ide/rocqide/rocqDriver.ml
index a449ba3680d0..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"

From 8108e63c0ff70623d01ea9c7a62a091ec3402103 Mon Sep 17 00:00:00 2001
From: Matthieu Sozeau <matthieu.sozeau@inria.fr>
Date: Thu, 5 Mar 2026 16:13:22 +0100
Subject: [PATCH 214/578] Fix Evd.minimize_universes API to take PolyFlags.t

---
 engine/evarutil.ml       |  4 ++--
 engine/evarutil.mli      |  2 +-
 engine/evd.ml            | 15 +++++++++------
 engine/evd.mli           |  6 ++++--
 plugins/ltac/leminv.ml   |  2 +-
 vernac/classes.ml        |  2 +-
 vernac/comAssumption.ml  |  2 +-
 vernac/comDefinition.ml  |  2 +-
 vernac/comFixpoint.ml    |  2 +-
 vernac/comInductive.ml   |  2 +-
 vernac/comRewriteRule.ml |  6 +++---
 vernac/declare.ml        | 11 +++++------
 vernac/record.ml         |  3 +--
 vernac/vernacentries.ml  |  3 +--
 14 files changed, 32 insertions(+), 30 deletions(-)

diff --git a/engine/evarutil.ml b/engine/evarutil.ml
index eb0fb31e5c80..5baa9e7ac426 100644
--- a/engine/evarutil.ml
+++ b/engine/evarutil.ml
@@ -32,8 +32,8 @@ let create_clos_infos env sigma flags =
 (* Expanding/testing/exposing existential variables *)
 (****************************************************)
 
-let finalize ?abort_on_undefined_evars ?(to_type = true) sigma f =
-  let sigma = minimize_universes ~to_type 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
diff --git a/engine/evarutil.mli b/engine/evarutil.mli
index 5940ab6fadb6..dcd6036b5b1c 100644
--- a/engine/evarutil.mli
+++ b/engine/evarutil.mli
@@ -150,7 +150,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 -> ?to_type:bool -> evar_map ->
+val finalize : ?abort_on_undefined_evars:bool -> ?poly:PolyFlags.t -> evar_map ->
   ((EConstr.t -> Constr.t) -> 'a) ->
   evar_map * 'a
 
diff --git a/engine/evd.ml b/engine/evd.ml
index c4c068a0f061..bb675f50d72a 100644
--- a/engine/evd.ml
+++ b/engine/evd.ml
@@ -1215,15 +1215,18 @@ let collapse_sort_variables ?except ?(to_type = true) evd =
   let universes = UState.collapse_sort_variables ?except ~to_type evd.universes in
   { evd with universes }
 
-let minimize_universes ?(collapse_sort_variables=true) ?(to_type = true) evd =
-  let uctx' = if collapse_sort_variables
-    then UState.collapse_sort_variables ~to_type 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 ~to_type: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
diff --git a/engine/evd.mli b/engine/evd.mli
index 5eaf5a8460e8..e3a894c45df4 100644
--- a/engine/evd.mli
+++ b/engine/evd.mli
@@ -644,8 +644,10 @@ val collapse_sort_variables : ?except:Sorts.QVar.Set.t -> ?to_type:bool -> evar_
 
 val fix_undefined_variables : evar_map -> evar_map
 
-(** Universe minimization (collapse_sort_variables is true by default) *)
-val minimize_universes : ?collapse_sort_variables:bool -> ?to_type: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/plugins/ltac/leminv.ml b/plugins/ltac/leminv.ml
index 1b53958dcbcf..18b6dc880e31 100644
--- a/plugins/ltac/leminv.ml
+++ b/plugins/ltac/leminv.ml
@@ -212,7 +212,7 @@ let inversion_scheme ~name ~poly env sigma t sort dep_option inv_op =
   end in
   let avoid = ref Id.Set.empty in
   let Proof.{sigma} = Proof.data pf in
-  let sigma = Evd.minimize_universes ~to_type:(PolyFlags.collapse_sort_variables poly) sigma in
+  let sigma = Evd.minimize_universes ~poly sigma in
   let rec fill_holes c =
     match EConstr.kind sigma c with
     | Evar (e,args) ->
diff --git a/vernac/classes.ml b/vernac/classes.ml
index c2b7d7438484..850aa21de16e 100644
--- a/vernac/classes.ml
+++ b/vernac/classes.ml
@@ -420,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 ~to_type:(PolyFlags.collapse_sort_variables poly) 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/comAssumption.ml b/vernac/comAssumption.ml
index 7dea250a1415..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 ~to_type:(PolyFlags.collapse_sort_variables poly) 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/comDefinition.ml b/vernac/comDefinition.ml
index 062be2491c30..3910776213cf 100644
--- a/vernac/comDefinition.ml
+++ b/vernac/comDefinition.ml
@@ -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 ~to_type:(PolyFlags.collapse_sort_variables poly) 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 0313f73688c5..d73d86123130 100644
--- a/vernac/comFixpoint.ml
+++ b/vernac/comFixpoint.ml
@@ -580,7 +580,7 @@ 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 ~to_type:(PolyFlags.collapse_sort_variables poly) sigma in
+  let sigma = Evd.minimize_universes ~poly sigma in
 
   let sigma, ({fixdefs=bodies;fixrs;fixtypes;fixwfs} as fix), obls, hook =
     match pm with
diff --git a/vernac/comInductive.ml b/vernac/comInductive.ml
index 8bc0b4112198..8cfdc18778b8 100644
--- a/vernac/comInductive.ml
+++ b/vernac/comInductive.ml
@@ -648,7 +648,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 =
diff --git a/vernac/comRewriteRule.ml b/vernac/comRewriteRule.ml
index 756e2762f321..2c7475891177 100644
--- a/vernac/comRewriteRule.ml
+++ b/vernac/comRewriteRule.ml
@@ -46,7 +46,7 @@ let do_symbol ~poly ~unfold_fix udecl (id, typ) =
       env evd typ
   in
   Pretyping.check_evars_are_solved ~program_mode:false env evd;
-  let evd = Evd.minimize_universes ~to_type:(PolyFlags.collapse_sort_variables poly) 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 typ = EConstr.to_constr evd typ in
@@ -432,7 +432,7 @@ let interp_rule ~collapse_sort_variables (udecl, lhs, rhs: Constrexpr.universe_d
     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 ~to_type:(PolyFlags.collapse_sort_variables poly) 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 uctx, uctx' = UState.check_univ_decl_rev (Evd.ustate evd) udecl in
@@ -482,7 +482,7 @@ let interp_rule ~collapse_sort_variables (udecl, lhs, rhs: Constrexpr.universe_d
         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 ~to_type:collapse_sort_variables 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 fail pp = warn_rewrite_rules_break_SR ?loc:rhs_loc Pp.(surround (str "universe inconsistency") ++ str"." ++ spc() ++ str "Missing constraints: " ++ pp) in
diff --git a/vernac/declare.ml b/vernac/declare.ml
index 5d9909c20801..39626cdaab64 100644
--- a/vernac/declare.ml
+++ b/vernac/declare.ml
@@ -1097,7 +1097,7 @@ let declare_definition ~info ~cinfo ~opaque ~obls ~body ?using sigma =
   Option.iter (check_evars_are_solved env sigma) typ;
   check_evars_are_solved env sigma body;
   let poly = info.Info.poly in
-  let sigma = Evd.minimize_universes ~to_type:(PolyFlags.collapse_sort_variables poly) sigma 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
@@ -1114,8 +1114,7 @@ let prepare_obligations ~name poly ?types ~body env sigma =
     | Some t -> t
     | None -> Retyping.get_type_of env sigma body
   in
-  let to_type = PolyFlags.collapse_sort_variables poly in
-  let sigma, (body, types) = Evarutil.finalize ~abort_on_undefined_evars:false ~to_type
+  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;
@@ -1127,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 ~to_type:(PolyFlags.collapse_sort_variables poly)
+  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
@@ -2089,7 +2088,7 @@ 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 ~to_type:(PolyFlags.collapse_sort_variables poly) 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
@@ -2253,7 +2252,7 @@ let save_admitted ~pm ~proof =
   let sigma = Evd.from_ctx 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 ~to_type:(PolyFlags.collapse_sort_variables poly) 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
diff --git a/vernac/record.ml b/vernac/record.ml
index 7f32bcc3e19e..ac19aad7c694 100644
--- a/vernac/record.ml
+++ b/vernac/record.ml
@@ -264,9 +264,8 @@ let def_class_levels ~def ~env_ar_params sigma aritysorts ctors =
     sigma, s, ctor
 
 let finalize_def_class ~poly env sigma ~params ~sort ~projtyp =
-  let to_type = PolyFlags.collapse_sort_variables poly in
   let sigma, (params, sort, typ, projtyp) =
-    Evarutil.finalize ~abort_on_undefined_evars:false ~to_type 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 *)
diff --git a/vernac/vernacentries.ml b/vernac/vernacentries.ml
index ea200de03455..56a550c11684 100644
--- a/vernac/vernacentries.ml
+++ b/vernac/vernacentries.ml
@@ -186,8 +186,7 @@ let show_top_evars ~proof =
 
 let show_universes ~proof =
   let Proof.{ goals; sigma; poly } = Proof.data proof in
-  let to_type = PolyFlags.collapse_sort_variables poly in
-  let ctx = Evd.sort_context_set (Evd.minimize_universes ~to_type sigma) 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)

From dbcb5cdaa9091593cbd06dc8177808ac53eaf913 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?L=C3=A9o=20Soudant?= <soudant.leo@gmail.com>
Date: Thu, 5 Mar 2026 11:45:35 +0100
Subject: [PATCH 215/578] Changed Scheme all warning

---
 doc/sphinx/proofs/writing-proofs/reasoning-inductives.rst | 2 +-
 tactics/allScheme.ml                                      | 5 ++++-
 test-suite/output/nested_eliminators.out                  | 3 ++-
 3 files changed, 7 insertions(+), 3 deletions(-)

diff --git a/doc/sphinx/proofs/writing-proofs/reasoning-inductives.rst b/doc/sphinx/proofs/writing-proofs/reasoning-inductives.rst
index c966734c0390..e03dfd42f305 100644
--- a/doc/sphinx/proofs/writing-proofs/reasoning-inductives.rst
+++ b/doc/sphinx/proofs/writing-proofs/reasoning-inductives.rst
@@ -1322,7 +1322,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. It can be generated using command "Scheme All" e.g. "Scheme All for @ident.".
       :name: register-all
 
       The `All` and `AllForall` predicate need to be defined and registered before the
diff --git a/tactics/allScheme.ml b/tactics/allScheme.ml
index 2c02bb5fb688..53aab58ff340 100644
--- a/tactics/allScheme.ml
+++ b/tactics/allScheme.ml
@@ -282,7 +282,10 @@ let warn_lookup_not_found =
       ++ strbrk "No scheme for "
       ++ Nametab.XRefs.pr (TrueGlobal (IndRef ind_nested))
       ++ strbrk " is registered as "
-      ++ strbrk key ++  str "."
+      ++ strbrk key ++  strbrk ". "
+      ++ strbrk "It can be generated using command \"Scheme All\" e.g. \"Scheme All for "
+      ++ Nametab.XRefs.pr (TrueGlobal (IndRef ind_nested))
+      ++ str ".\"."
     )
 
 (** Lookup the partial [all] predicate for [ind_nested] for [args_are_nested].
diff --git a/test-suite/output/nested_eliminators.out b/test-suite/output/nested_eliminators.out
index ac7f675fab74..c854dc4c29d8 100644
--- a/test-suite/output/nested_eliminators.out
+++ b/test-suite/output/nested_eliminators.out
@@ -1624,7 +1624,8 @@ Expands to: Constant nested_eliminators.SortPoly.SRT_sind
 Declared in library nested_eliminators, line 381, characters 2-57
 File "./output/nested_eliminators.v", line 398, characters 2-60:
 The command has indeed failed with message:
-MRT is nested using list. No scheme for list is registered as All.
+MRT is nested using list. No scheme for list is registered as All. It can be
+generated using command "Scheme All" e.g. "Scheme All for list.".
 [register-all,automation,default]
 MRT_ind :
 forall P : MRT -> Prop,

From b49ef915f85535c73192d2e95b6a45fe2d6a5a4b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Wed, 4 Mar 2026 17:05:07 +0100
Subject: [PATCH 216/578] Restrict retroknowledge declaration to toplevel.

Fixes #14822: Desynchronization of retroknowledge in module types.
Fixes #21693: Incorrect module substitution of retroknowledge.
---
 checker/mod_checking.ml     |  1 -
 checker/safe_checking.ml    |  3 ++-
 checker/values.ml           |  8 +++----
 kernel/mod_declarations.ml  | 39 ++++++---------------------------
 kernel/mod_declarations.mli | 11 ++++------
 kernel/mod_typing.ml        |  4 ++--
 kernel/modops.ml            |  3 +--
 kernel/safe_typing.ml       | 32 +++++++++++++++++++++------
 kernel/safe_typing.mli      |  1 +
 test-suite/bugs/bug_14822.v | 43 +++++++++++++++++++++++++++++++++++++
 test-suite/bugs/bug_18503.v | 41 -----------------------------------
 vernac/comPrimitive.ml      |  2 --
 vernac/declaremods.ml       |  2 +-
 vernac/vernacentries.ml     |  2 --
 14 files changed, 90 insertions(+), 102 deletions(-)
 create mode 100644 test-suite/bugs/bug_14822.v
 delete mode 100644 test-suite/bugs/bug_18503.v

diff --git a/checker/mod_checking.ml b/checker/mod_checking.ml
index f6b8e9efa927..9004abfc4a8f 100644
--- a/checker/mod_checking.ml
+++ b/checker/mod_checking.ml
@@ -247,7 +247,6 @@ let rec check_mexpression env opac sign mbtyp mp_mse res = match sign with
 
 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
diff --git a/checker/safe_checking.ml b/checker/safe_checking.ml
index 7b8e014dfb7c..8e41bedd1a5c 100644
--- a/checker/safe_checking.ml
+++ b/checker/safe_checking.ml
@@ -14,6 +14,7 @@ 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 =
@@ -23,7 +24,7 @@ let import senv opac clib vmtab digest =
   let () = assert (Sorts.QVar.Set.for_all check_quality (fst qualities)) in
   let env = push_qualities ~rigid:true 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 = Modops.add_retroknowledge retro 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 (_,senv) = Safe_typing.import clib vmtab digest senv in senv, opac
diff --git a/checker/values.ml b/checker/values.ml
index 080a115a5acb..fbf3274d5ff2 100644
--- a/checker/values.ml
+++ b/checker/values.ml
@@ -498,7 +498,7 @@ 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
 
@@ -594,10 +594,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])
 
@@ -607,7 +607,7 @@ 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_sort_context_set; v_deps; v_flags; v_retroknowledge|]
 
 (** Toplevel structures in a vo (see Cic.mli) *)
 
diff --git a/kernel/mod_declarations.ml b/kernel/mod_declarations.ml
index ae76240bffa8..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 =
@@ -295,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 ->
@@ -325,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
@@ -336,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 c633b742be6a..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,7 +89,6 @@ 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} *)
 
diff --git a/kernel/mod_typing.ml b/kernel/mod_typing.ml
index a082b63da85b..f136f31f5dfc 100644
--- a/kernel/mod_typing.ml
+++ b/kernel/mod_typing.ml
@@ -339,12 +339,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. *)
diff --git a/kernel/modops.ml b/kernel/modops.ml
index a53245f9d874..ed2821db0205 100644
--- a/kernel/modops.ml
+++ b/kernel/modops.ml
@@ -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 =
diff --git a/kernel/safe_typing.ml b/kernel/safe_typing.ml
index 7ef7df93c150..5b834ae8d8cf 100644
--- a/kernel/safe_typing.ml
+++ b/kernel/safe_typing.ml
@@ -179,6 +179,7 @@ type compiled_library = {
   comp_sorts : Sorts.QContextSet.t;
   comp_deps : library_info array;
   comp_flags : permanent_flags;
+  comp_retro : Retroknowledge.action list;
 }
 
 type reimport = compiled_library * Vmlibrary.on_disk * vodigest
@@ -731,6 +732,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 }
@@ -1107,7 +1118,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)
@@ -1406,13 +1416,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
@@ -1452,12 +1462,14 @@ 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 newenv = Modops.add_retroknowledge senv.local_retroknowledge newenv in
   let senv' = propagate_loads { senv with env = newenv } in
   let newenv = Modops.add_module mp mb senv'.env 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
 
@@ -1477,6 +1489,7 @@ let end_modtype l senv =
   let mtb = build_mtb auto_tb senv.modresolver in
   let newenv = Environ.add_modtype mp mtb senv'.env 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
 
@@ -1493,7 +1506,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) ->
@@ -1533,6 +1546,8 @@ let module_of_library lib = lib.comp_mod
 
 let univs_of_library lib = lib.comp_sorts, lib.comp_univs
 
+let retroknowledge_of_library lib = lib.comp_retro
+
 (** FIXME: MS: remove?*)
 let current_modpath senv = senv.modpath
 let current_dirpath senv = Names.ModPath.dp (current_modpath senv)
@@ -1571,7 +1586,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
@@ -1590,7 +1605,8 @@ let export ~output_native_objects senv dir =
     comp_univs = senv.univ;
     comp_sorts = senv.qualities;
     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)
@@ -1606,6 +1622,7 @@ 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))
@@ -1613,6 +1630,7 @@ let import lib vmtab vodigest senv =
   let () = assert (Sorts.QVar.Set.for_all check_quality (fst qualities)) in
   let env = Environ.push_qualities ~rigid:true qualities senv.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
diff --git a/kernel/safe_typing.mli b/kernel/safe_typing.mli
index 9b162866b556..f419ba3060ae 100644
--- a/kernel/safe_typing.mli
+++ b/kernel/safe_typing.mli
@@ -240,6 +240,7 @@ 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 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
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_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/vernac/comPrimitive.ml b/vernac/comPrimitive.ml
index fbcb2b90a931..88889d74d933 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
diff --git a/vernac/declaremods.ml b/vernac/declaremods.ml
index 3909e3388f86..560f598a62bb 100644
--- a/vernac/declaremods.ml
+++ b/vernac/declaremods.ml
@@ -1443,7 +1443,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/vernacentries.ml b/vernac/vernacentries.ml
index ea200de03455..fe0fafa5cbd6 100644
--- a/vernac/vernacentries.ml
+++ b/vernac/vernacentries.ml
@@ -2356,8 +2356,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)

From c97a064f3457c711373db54dbdf69b79d1c3d99b Mon Sep 17 00:00:00 2001
From: Jason Gross <jasongross9@gmail.com>
Date: Sun, 8 Mar 2026 15:48:29 +0000
Subject: [PATCH 217/578] Add regression test for Scheme universe anomaly
 (fixes #21730)

The bug was that `Scheme Elimination` for an inductive included from
another module could trigger an anomaly about undefined universe levels.
This was fixed by commit d142e673b6 which replaced `UState.of_context_set`
(which did not include the global universe graph) with `Evd.from_env`
followed by `fresh_inductive_instance` in `do_mutual_induction_scheme`.

Co-Authored-By: Claude Opus 4.6 <noreply@anthropic.com>
---
 test-suite/bugs/bug_21730.v | 17 +++++++++++++++++
 1 file changed, 17 insertions(+)
 create mode 100644 test-suite/bugs/bug_21730.v

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.

From 6f67e5f442916f950e94d40695882c3caeaa335a Mon Sep 17 00:00:00 2001
From: Yann Leray <yann.leray@inria.fr>
Date: Thu, 5 Mar 2026 18:04:58 +0100
Subject: [PATCH 218/578] Group all operations on subterms in a single module,
 simplify on_branches

---
 kernel/inductive.ml | 636 ++++++++++++++++++++++----------------------
 1 file changed, 321 insertions(+), 315 deletions(-)

diff --git a/kernel/inductive.ml b/kernel/inductive.ml
index 568b000a738b..6f6e045a5c6f 100644
--- a/kernel/inductive.ml
+++ b/kernel/inductive.ml
@@ -633,48 +633,30 @@ 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
-
-(* 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
- *)
+(************************************************************************)
+(* Subterm information *)
 
 module WfPaths :
 sig
 type t
-val make : recarg Rtree.Automaton.t -> t (* must be minimal! *)
+val lookup_subterms : env -> inductive -> t
 val inter : t -> t -> t
 val restrict : t -> wf_paths -> t
-val dest_subterms : t -> t list array
+val dest_subterms : t -> t array array
 val is_norec : t -> bool
 val is_inductive : env -> inductive -> t -> bool
-val is_primitive : env -> Constant.t -> t -> bool
+val is_primitive_positive_container : env -> Constant.t -> t -> bool
 val equal : t -> t -> bool
+
+module Cache :
+sig
+  type wf_paths = t
+  type t
+  val create : unit -> t
+  val get_inductive_subterms : MutInd.t -> mutual_inductive_body -> t -> wf_paths array array array
+end
+
 end =
 struct
 
@@ -682,7 +664,9 @@ module Atm = Rtree.Automaton
 
 type t = recarg Atm.t
 
-let make t = t
+let lookup_subterms env ind =
+  let _, mip = lookup_mind_specif env ind in
+  mip.mind_automaton
 
 let meet_recarg r1 r2 = match r1, r2 with
 | Mrec _, Mrec _ ->
@@ -703,7 +687,7 @@ let restrict t p =
 
 let dest_subterms t =
   let trans = Atm.transitions t (Atm.initial t) in
-  let map v = Array.map_to_list (fun tgt -> Atm.move t tgt) v in
+  let map v = Array.map (fun tgt -> Atm.move t tgt) v in
   Array.map map trans
 
 let dest_recarg t =
@@ -719,175 +703,172 @@ let is_inductive env ind t = match dest_recarg t with
 | Mrec (RecArgInd i) -> QInd.equal env ind i
 | Norec | Mrec (RecArgPrim _) -> false
 
-let is_primitive env cst t = match dest_recarg t with
+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 equal t1 t2 =
   Atm.equal eq_recarg t1 t2
 
+module Cache :
+sig
+  type wf_paths = t
+  type t
+  val create : unit -> t
+  val get_inductive_subterms : MutInd.t -> mutual_inductive_body -> t -> wf_paths array array array
+end =
+struct
+  type wf_paths = t
+  type ans = t array 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_automaton) mib.mind_packets in
+    let () = cache := Mindmap_env.add mind ans !cache in
+    ans
+  | Some ans -> ans
 end
 
-type subterm_spec =
-    Subterm of (Int.Set.t * size * WfPaths.t)
-  | Dead_code
-  | Not_subterm
-  | Internally_bound_subterm of Int.Set.t
-
-let spec_of_tree internal t =
-  if WfPaths.is_norec t then Not_subterm
-  else Subterm (internal, Strict, t)
-
-let merge_internal_subterms l1 l2 =
-  Int.Set.union l1 l2
-
-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, WfPaths.inter t1 t2)
-
-let subterm_spec_glb =
-  Array.fold_left inter_spec Dead_code
-
-type guard_env =
-  { env     : env;
-    (* dB of last fixpoint *)
-    rel_min : int;
-    (* dB of variables denoting subterms *)
-    genv    : subterm_spec 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(Int.Set.empty, Large,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 }
+end
 
-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)
+(*************************************)
+(* Exported utilities for positivity *)
 
-(* 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
-
-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 }
+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 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 }
+(* 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
 
-type fix_check_result =
-  | NeedReduce of env * fix_guard_error
-  | NoNeedReduce
+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
 
-(* 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
 
-let (|||) x y = match x with
-  | NeedReduce _ -> x
-  | NoNeedReduce -> y
+(*****************************************************************************)
+(* Subterm specification *)
+module Subterm = struct
 
-let rec needreduce_of_stack = function
-  | [] -> NoNeedReduce
-  | SArg _ :: l -> needreduce_of_stack l
-  | SClosure (needreduce,_,_,_) :: l -> needreduce ||| needreduce_of_stack l
+type size = Large | Strict
 
-let redex_level rs = List.length rs
+(* 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
+
+let structural tree =
+  Subterm (Large, tree, Int.Set.empty)
+
+
+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.equal tree tree' then
+      NeedReduce l
+    else
+      InvalidSubterm
+  | NotSubterm | Subterm (Large, _, _) -> InvalidSubterm
 
-let push_stack_closure renv needreduce c stack =
-  (SClosure (needreduce, renv, 0, c)) :: stack
+(** 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 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 =
+  (* As computing subterms is more expensive than computing discr
+     (because of dest_subterms), we put it in a single lazy block. *)
+  let subterms = lazy begin match Lazy.force discr with
+    | DeadCode | Vars _ | NotSubterm as spec ->
+      Inl spec
+    | Subterm (_, tree, vars) ->
+      let subtree = WfPaths.dest_subterms tree in
+      let subterms = Array.map (Array.map (spec_of_tree Strict vars)) subtree in
+      Inr subterms
+  end in
+  fun i j -> lazy begin match Lazy.force subterms with
+  | Inl spec -> spec
+  | Inr spec_arr -> spec_arr.(i).(j)
+  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 push_stack_args l stack =
-  List.fold_right (fun spec stack -> SArg spec :: stack) l stack
+let on_projection discr n =
+  Lazy.force (on_constructors (lazy discr) 0 n)
 
-let lift_stack k =
-   List.map (function
-       | SClosure (needreduce,s,n,c) -> SClosure (needreduce,s,n+k,c)
-       | x -> x)
+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
-  WfPaths.make mip.mind_automaton
-
-(* 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
-  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 WfPaths.is_inductive renv.env ci.ci_ind t ->
-                  let vra = (WfPaths.dest_subterms t).(i) in
-                  let () = assert (Int.equal nca (List.length vra)) in
-                  Array.map_of_list (fun t -> spec_of_tree internal t) 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). *)
@@ -918,53 +899,6 @@ 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 -> WfPaths.t list array array
-end =
-struct
-  type ans = WfPaths.t 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 -> WfPaths.dest_subterms (WfPaths.make mip.mind_automaton)) 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
@@ -988,7 +922,7 @@ let get_recargs_approx cache ?evars env tree ind args =
         build_recargs_nested ienv tree (ind_kn, largs)
       else mk_norec
     | Const (c,_) when is_primitive_positive_container env c ->
-      if WfPaths.is_primitive env c tree then
+      if WfPaths.is_primitive_positive_container env c tree then
         build_recargs_nested_primitive ienv tree (c, largs)
       else mk_norec
     | _err ->
@@ -1012,7 +946,7 @@ let get_recargs_approx cache ?evars env tree ind args =
     mutually recursive containers are not supported. *)
     let trees =
       if Int.equal auxntyp 1 then [|WfPaths.dest_subterms tree|]
-      else Cache.get_inductive_subterms mind mib cache
+      else WfPaths.Cache.get_inductive_subterms mind mib cache
     in
     let mk_irecargs j mip =
       (* The nested inductive type with parameters removed *)
@@ -1036,29 +970,142 @@ let get_recargs_approx cache ?evars env tree ind args =
     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) (WfPaths.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 =
+    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 trees.(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 cache ?evars env spec ind args =
+  match spec with
+  | DeadCode | Vars _ | NotSubterm as spec -> spec
+  | Subterm (size, tree, vars) ->
+    let recargs = get_recargs_approx cache ?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 (if n >= 1 then Subterm.Vars (Int.Set.singleton n) else Subterm.NotSubterm) 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 _ -> (* outside context of the fixpoint *) Subterm.NotSubterm
+
+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.NotSubterm::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.NotSubterm::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
@@ -1073,7 +1120,7 @@ let has_constant_parameters env nvars k ((mind, _), _) args =
    allowed to flow out of a match with predicate p in environment env. *)
 let restrict_spec cache ?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
@@ -1088,15 +1135,9 @@ let restrict_spec cache ?evars env spec p =
   match kind i with
   | Ind i ->
     if has_constant_parameters env absctxlen (List.length arctx) i args then spec
-    else begin match spec with
-    | Dead_code -> spec
-    | Subterm (l, st, tree) ->
-      let recargs = get_recargs_approx cache ?evars env tree i args in
-      let tree = WfPaths.restrict tree recargs in
-      Subterm (l, st, tree)
-    | _ -> assert false
-    end
-  | _ -> Not_subterm
+    else
+      Subterm.prune_path cache ?evars env spec i args
+  | _ -> Subterm.NotSubterm
 
 (* [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. *)
@@ -1123,19 +1164,12 @@ let filter_stack_domain cache stack_element_specif set_iota_specif ?evars env p
           let spec = stack_element_specif cache ?evars elt in
           if has_constant_parameters env absctxlen (k + List.length ctx) ind args then SArg spec
           else
-            let sarg = lazy begin match Lazy.force spec with
-            | Not_subterm | Dead_code | Internally_bound_subterm _ as spec -> spec
-            | Subterm (l, s, tree) ->
-              let recargs = get_recargs_approx cache ?evars env tree ind args in
-              let tree = WfPaths.restrict tree recargs in
-              Subterm (l, s, tree)
-            end in
-            SArg sarg
-        | _ -> SArg (set_iota_specif (lazy Not_subterm))
+            SArg (lazy (Subterm.prune_path cache ?evars env (Lazy.force spec) ind args))
+        | _ -> SArg (set_iota_specif (lazy Subterm.NotSubterm))
         in
         elt :: filter_stack (push_rel d env) (k + 1) c0 stack'
       | _ ->
-        List.map (fun _ -> SArg (set_iota_specif (lazy Not_subterm))) stack
+        List.map (fun _ -> SArg (set_iota_specif (lazy Subterm.NotSubterm))) stack
   in
   filter_stack env 0 ar stack
 
@@ -1154,15 +1188,13 @@ let rec subterm_specif cache ?evars renv stack t =
       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 cases_spec = Subterm.on_branches renv.env ci.ci_ind (lazy_subterm_specif cache ?evars renv [] c) in
       let stl =
         Array.mapi (fun i br' ->
-                    let stack_br = push_stack_args (cases_spec.(i)) stack' in
+                    let stack_br = push_stack_args (cases_spec i) stack' in
                     subterm_specif cache ?evars renv stack_br br')
                   lbr in
-      let spec = subterm_spec_glb stl in
+      let spec = Subterm.inter_spec stl in
       restrict_spec cache ?evars renv.env spec p
 
     | Fix ((recindxs,i),(_,typarray,bodies as recdef)) ->
@@ -1171,7 +1203,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.NotSubterm
     else
       let (ctxt,clfix) = whd_decompose_prod ?evars renv.env typarray.(i) in
       let oind =
@@ -1179,17 +1211,17 @@ 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.NotSubterm (* happens if fix is polymorphic *)
         | Some (ind, _) ->
         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' =
                      (* 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
+          (nbfix-i, lazy (Subterm.spec_of_tree Strict Int.Set.empty recargs)) in
         let decrArg = recindxs.(i) in
         let theBody = bodies.(i)   in
         let nbOfAbst = decrArg+1 in
@@ -1211,33 +1243,24 @@ let rec subterm_specif cache ?evars renv stack t =
         subterm_specif cache ?evars (push_var renv (x,a,spec)) stack' b
 
       (* Metas and evars are considered OK *)
-    | (Meta _|Evar _) -> Dead_code
+    | (Meta _|Evar _) -> Subterm.DeadCode
 
     | 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 = (WfPaths.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)
+      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.NotSubterm
       with
         | NotEvaluableConst (IsPrimitive (_u,op)) when List.length l >= CPrimitives.arity op ->
           primitive_specif cache ?evars renv op l
-        | NotEvaluableConst _ -> Not_subterm
+        | NotEvaluableConst _ -> Subterm.NotSubterm
       end
 
     | Var _ | Sort _ | Cast _ | Prod _ | LetIn _ | App _ | Ind _
       | Construct _ | CoFix _ | Int _ | Float _ | String _
-      | Array _ -> Not_subterm
+      | Array _ -> Subterm.NotSubterm
 
 
       (* Other terms are not subterms *)
@@ -1250,7 +1273,7 @@ and stack_element_specif cache ?evars = function
   | SArg x -> x
 
 and extract_stack cache ?evars = function
-   | [] -> Lazy.from_val Not_subterm, []
+   | [] -> lazy Subterm.NotSubterm, []
    | elt :: l -> stack_element_specif cache ?evars elt, l
 
 and primitive_specif cache ?evars renv op args =
@@ -1261,19 +1284,12 @@ and primitive_specif cache ?evars renv op args =
        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 = (WfPaths.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
+    Subterm.on_array subt
+  | _ -> Subterm.NotSubterm
 
 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
+        | Subterm.NotSubterm -> if nr >= 1 then Subterm.Vars (Int.Set.singleton nr) else Subterm.NotSubterm
         | spec -> spec)
 
 (************************************************************************)
@@ -1287,8 +1303,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
@@ -1310,19 +1326,10 @@ 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 WfPaths.equal 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
@@ -1389,7 +1396,7 @@ let filter_fix_stack_domain cache ?evars nr decrarg stack nuniformparams =
           (* 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 (set_iota_specif nr (lazy Subterm.NotSubterm)) in
       a :: aux (i+1) nuniformparams stack
   in aux 0 nuniformparams stack
 
@@ -1449,8 +1456,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 cache ?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
@@ -1466,12 +1473,11 @@ 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 case_spec = Subterm.on_branches renv.env ci.ci_ind (set_iota_specif nr (lazy_subterm_specif cache ?evars renv [] c_0)) in
             let stack' = filter_stack_domain cache stack_element_specif (set_iota_specif 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 () ->
@@ -1757,7 +1763,7 @@ let sorts_of_mutfix env minds names =
 
 
 let check_fix_pre_sorts ?evars env ((nvect, _), (names, _, bodies as recdef) as fix) =
-  let cache = Cache.create () in
+  let cache = WfPaths.Cache.create () in
 (* 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,
@@ -1769,7 +1775,7 @@ let check_fix_pre_sorts ?evars env ((nvect, _), (names, _, bodies as recdef) as
   let raise_err = raise_fix_guard_err_fn env recdef names in
   let () =
     if flags.check_guarded then
-      let trees = Array.map (fun ind -> lookup_subterms env ind) inds in
+      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
@@ -1836,7 +1842,7 @@ let check_one_cofix cache ?evars env nbfix def deftype =
                     end
               | [],_ -> ()
               | _ -> anomaly_ill_typed ()
-            in process_args_of_constr (realargs, lra)
+            in process_args_of_constr (realargs, Array.to_list lra)
 
         | Lambda (x,a,b) ->
             let () = assert (List.is_empty args) in
@@ -1862,9 +1868,9 @@ 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 cache ?evars env (Subterm.structural tree) p with
+            | Vars _ | DeadCode -> assert false
+            | Subterm (_, tree', _) -> tree'
             | _ -> raise (CoFixGuardError (env, ReturnPredicateNotCoInductive c))
             in
                if (noccur_with_meta n nbfix p) then
@@ -1889,14 +1895,14 @@ let check_one_cofix cache ?evars env nbfix def deftype =
            raise (CoFixGuardError (env,NotGuardedForm t)) in
 
   let ((mind, _),_) = codomain_is_coind ?evars env deftype in
-  let vlra = lookup_subterms env mind in
+  let vlra = WfPaths.lookup_subterms env mind in
   check_rec_call env false 1 vlra (WfPaths.dest_subterms 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 cache = WfPaths.Cache.create () in
   let flags = Environ.typing_flags env in
   if flags.check_guarded then
     let nbfix = Array.length bodies in

From 9bc45a9b6183ff7dfb5e8fd8e157e133b2002786 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Thu, 5 Mar 2026 16:36:24 +0100
Subject: [PATCH 219/578] Use levels instead of separate entries for rewrite
 strategies

We could use NEXT instead of explicit levels in most of these but to
minimize changes I used explicit levels.
---
 doc/sphinx/addendum/generalized-rewriting.rst | 17 ++++++------
 doc/sphinx/changes.rst                        |  2 +-
 doc/tools/docgram/common.edit_mlg             | 13 +++-------
 doc/tools/docgram/fullGrammar                 | 13 +++++-----
 doc/tools/docgram/orderedGrammar              |  8 ++++--
 plugins/ltac/g_rewrite.mlg                    | 26 +++++++------------
 6 files changed, 34 insertions(+), 45 deletions(-)

diff --git a/doc/sphinx/addendum/generalized-rewriting.rst b/doc/sphinx/addendum/generalized-rewriting.rst
index 82f47000dd97..5bb8b9770bdf 100644
--- a/doc/sphinx/addendum/generalized-rewriting.rst
+++ b/doc/sphinx/addendum/generalized-rewriting.rst
@@ -975,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.
 
@@ -1022,11 +1022,12 @@ further allows arbitrary customization of strategies through :ref:`Ltac1 <ltac>`
 The following describes the :ref:`Ltac1 <ltac>` version of the strategies. An :ref:`Ltac2 <ltac2>` version
 with the same primitives is available in the :g:`Ltac2.Rewrite` module.
 
-.. insertprodn rewstrategy rewstrategy0
+.. insertprodn rewstrategy2 rewstrategy0
 
 .. prodn::
-   rewstrategy ::= fix @ident := @rewstrategy1
+   rewstrategy2 ::= fix @ident := @rewstrategy1
    | {+; @rewstrategy1 }
+   | @rewstrategy1
    rewstrategy1 ::= <- @one_term
    | progress @rewstrategy1
    | try @rewstrategy1
@@ -1051,7 +1052,7 @@ with the same primitives is available in the :g:`Ltac2.Rewrite` module.
    | fail
    | id
    | refl
-   | ( @rewstrategy )
+   | ( @rewstrategy2 )
 
 :n:`@one_term`
    lemma, left to right
@@ -1080,7 +1081,7 @@ with the same primitives is available in the :g:`Ltac2.Rewrite` module.
 :n:`try @rewstrategy1`
    try catch
 
-:n:`@rewstrategy ; @rewstrategy1`
+:n:`{+; @rewstrategy1 }`
    composition
 
 :n:`choice {+ @rewstrategy0 }`
@@ -1128,8 +1129,8 @@ with the same primitives is available in the :g:`Ltac2.Rewrite` module.
    fixpoint operator, where :math:`\texttt{fix }f := v` evaluates to
    :math:`\subst{v}{f}{(\texttt{fix }f := v)}`
 
-:n:`( @rewstrategy )`
-   parenthesizes for disambiguation, applies :n:`@rewstrategy`
+:n:`( @rewstrategy2 )`
+   parenthesizes for disambiguation, applies :n:`@rewstrategy2`
 
 :n:`old_hints @ident`
    to be documented
diff --git a/doc/sphinx/changes.rst b/doc/sphinx/changes.rst
index 03069dc4b8d8..6450a6b721e3 100644
--- a/doc/sphinx/changes.rst
+++ b/doc/sphinx/changes.rst
@@ -2306,7 +2306,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 <https://github.com/rocq-prover/rocq/pull/18094>`_,
   fixes `#13702 <https://github.com/rocq-prover/rocq/issues/13702>`_,
   by Jason Gross and Gaëtan Gilbert).
diff --git a/doc/tools/docgram/common.edit_mlg b/doc/tools/docgram/common.edit_mlg
index 40df4ee53ff0..786b3a648e6f 100644
--- a/doc/tools/docgram/common.edit_mlg
+++ b/doc/tools/docgram/common.edit_mlg
@@ -1110,9 +1110,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
@@ -2255,14 +2255,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
diff --git a/doc/tools/docgram/fullGrammar b/doc/tools/docgram/fullGrammar
index 4e97a4b7ec7d..7016896cae35 100644
--- a/doc/tools/docgram/fullGrammar
+++ b/doc/tools/docgram/fullGrammar
@@ -1875,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
@@ -2389,12 +2389,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
 ]
 
@@ -2426,7 +2425,7 @@ rewstrategy0: [
 | "id"
 | "fail"
 | "refl"
-| "(" rewstrategy ")"
+| "(" rewstrategy2 ")"
 ]
 
 id_or_meta: [
diff --git a/doc/tools/docgram/orderedGrammar b/doc/tools/docgram/orderedGrammar
index 73fb39f693e4..5fa00c28c5ef 100644
--- a/doc/tools/docgram/orderedGrammar
+++ b/doc/tools/docgram/orderedGrammar
@@ -1537,7 +1537,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 )
@@ -1550,6 +1549,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
@@ -2223,8 +2223,12 @@ rewrite_occs: [
 ]
 
 rewstrategy: [
+]
+
+rewstrategy2: [
 | "fix" ident ":=" rewstrategy1
 | LIST1 rewstrategy1 SEP ";"
+| rewstrategy1
 ]
 
 rewstrategy1: [
@@ -2255,7 +2259,7 @@ rewstrategy0: [
 | "fail"
 | "id"
 | "refl"
-| "(" rewstrategy ")"
+| "(" rewstrategy2 ")"
 ]
 
 l3_tactic: [
diff --git a/plugins/ltac/g_rewrite.mlg b/plugins/ltac/g_rewrite.mlg
index c7623f058873..22a9f51c9e6e 100644
--- a/plugins/ltac/g_rewrite.mlg
+++ b/plugins/ltac/g_rewrite.mlg
@@ -101,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) }
@@ -123,18 +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 }
       | IDENT "matches"; c = constr -> { StratMatches c }
-      | IDENT "tactic"; c = tactic -> { StratTactic c }
-      | h = rewstrategy0 -> { h } ] ]
-  ;
-  rewstrategy0:
-    [ NONA
+      | IDENT "tactic"; c = tactic -> { StratTactic c } ]
+    | "0" NONA
       [ c = constr -> { StratConstr (c, true) }
       | IDENT "id" -> { StratId }
       | IDENT "fail" -> { StratFail }

From 23e2f72d4249bd735a51d1a3cd08fae3d4cb3ed6 Mon Sep 17 00:00:00 2001
From: Yann Leray <yann.leray@inria.fr>
Date: Tue, 10 Mar 2026 16:33:58 +0100
Subject: [PATCH 220/578] Make subterm type private

---
 kernel/inductive.ml | 129 +++++++++++++++++++++++++++++++-------------
 1 file changed, 93 insertions(+), 36 deletions(-)

diff --git a/kernel/inductive.ml b/kernel/inductive.ml
index 6f6e045a5c6f..0b1db73f3a64 100644
--- a/kernel/inductive.ml
+++ b/kernel/inductive.ml
@@ -767,7 +767,53 @@ let abstract_mind_lc ntyps npars mind lc =
 
 (*****************************************************************************)
 (* Subterm specification *)
-module Subterm = struct
+module Subterm : sig
+
+type size = Large | Strict
+
+(**
+  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
+
+val check : t -> WfPaths.t -> check_result
+
+val inter_spec : t array -> t
+
+val on_branches : env -> inductive -> t lazy_t -> int -> t lazy_t list
+
+val on_projection : t -> int -> t
+val on_array : t -> t
+
+val prune_path : WfPaths.Cache.t -> ?evars:CClosure.evar_handler ->
+  env -> t -> pinductive -> types list -> t
+
+end = struct
 
 type size = Large | Strict
 
@@ -796,9 +842,31 @@ type 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 structural tree =
-  Subterm (Large, tree, Int.Set.empty)
+  spec_of_tree Large Int.Set.empty tree
 
+let strict_subterm tree =
+  spec_of_tree Strict Int.Set.empty tree
+
+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
@@ -815,13 +883,6 @@ let check t tree =
       InvalidSubterm
   | NotSubterm | Subterm (Large, _, _) -> InvalidSubterm
 
-(** 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 inter_spec s1 s2 =
   match s1, s2 with
   | s, DeadCode | DeadCode, s -> s
@@ -1034,25 +1095,25 @@ 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 (if n >= 1 then Subterm.Vars (Int.Set.singleton n) else Subterm.NotSubterm) in
+  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 _ -> (* outside context of the fixpoint *) Subterm.NotSubterm
+  with Failure _ | Invalid_argument _ -> (* outside context of the fixpoint *) Subterm.not_subterm
 
 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.NotSubterm::ge) n renv.genv }
+    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.NotSubterm::ge) n renv.genv }
+    genv = iterate (fun ge -> lazy Subterm.not_subterm::ge) n renv.genv }
 
 type fix_check_result =
   | NeedReduce of env * fix_guard_error
@@ -1137,11 +1198,11 @@ let restrict_spec cache ?evars env spec p =
     if has_constant_parameters env absctxlen (List.length arctx) i args then spec
     else
       Subterm.prune_path cache ?evars env spec i args
-  | _ -> Subterm.NotSubterm
+  | _ -> 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 cache 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
@@ -1165,11 +1226,11 @@ let filter_stack_domain cache stack_element_specif set_iota_specif ?evars env p
           if has_constant_parameters env absctxlen (k + List.length ctx) ind args then SArg spec
           else
             SArg (lazy (Subterm.prune_path cache ?evars env (Lazy.force spec) ind args))
-        | _ -> SArg (set_iota_specif (lazy Subterm.NotSubterm))
+        | _ -> SArg not_subterm
         in
         elt :: filter_stack (push_rel d env) (k + 1) c0 stack'
       | _ ->
-        List.map (fun _ -> SArg (set_iota_specif (lazy Subterm.NotSubterm))) stack
+        List.map (fun _ -> SArg not_subterm) stack
   in
   filter_stack env 0 ar stack
 
@@ -1187,7 +1248,7 @@ 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 stack' = filter_stack_domain cache 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 cache ?evars renv [] c) in
       let stl =
         Array.mapi (fun i br' ->
@@ -1203,7 +1264,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 Subterm.NotSubterm
+    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 =
@@ -1211,7 +1272,7 @@ 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 -> Subterm.NotSubterm (* happens if fix is polymorphic *)
+        | None -> Subterm.not_subterm (* happens if fix is polymorphic *)
         | Some (ind, _) ->
         let nbfix = Array.length typarray in
         let recargs = WfPaths.lookup_subterms renv.env ind in
@@ -1221,7 +1282,7 @@ let rec subterm_specif cache ?evars renv stack t =
                      (* Why Strict here ? To be general, it could also be
                         Large... *)
           assign_var_spec renv'
-          (nbfix-i, lazy (Subterm.spec_of_tree Strict Int.Set.empty recargs)) in
+          (nbfix-i, lazy (Subterm.strict_subterm recargs)) in
         let decrArg = recindxs.(i) in
         let theBody = bodies.(i)   in
         let nbOfAbst = decrArg+1 in
@@ -1243,7 +1304,7 @@ let rec subterm_specif cache ?evars renv stack t =
         subterm_specif cache ?evars (push_var renv (x,a,spec)) stack' b
 
       (* Metas and evars are considered OK *)
-    | (Meta _|Evar _) -> Subterm.DeadCode
+    | (Meta _|Evar _) -> Subterm.dead_code
 
     | Proj (p, _, c) ->
       let subt = subterm_specif cache ?evars renv stack c in
@@ -1251,16 +1312,16 @@ let rec subterm_specif cache ?evars renv stack t =
 
     | Const c ->
       begin try
-        let _ = Environ.constant_value_in renv.env c in Subterm.NotSubterm
+        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 _ -> Subterm.NotSubterm
+        | NotEvaluableConst _ -> Subterm.not_subterm
       end
 
     | Var _ | Sort _ | Cast _ | Prod _ | LetIn _ | App _ | Ind _
       | Construct _ | CoFix _ | Int _ | Float _ | String _
-      | Array _ -> Subterm.NotSubterm
+      | Array _ -> Subterm.not_subterm
 
 
       (* Other terms are not subterms *)
@@ -1273,7 +1334,7 @@ and stack_element_specif cache ?evars = function
   | SArg x -> x
 
 and extract_stack cache ?evars = function
-   | [] -> lazy Subterm.NotSubterm, []
+   | [] -> lazy Subterm.not_subterm, []
    | elt :: l -> stack_element_specif cache ?evars elt, l
 
 and primitive_specif cache ?evars renv op args =
@@ -1285,12 +1346,7 @@ and primitive_specif cache ?evars renv op args =
     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
     Subterm.on_array subt
-  | _ -> Subterm.NotSubterm
-
-let set_iota_specif nr spec =
-  lazy (match Lazy.force spec with
-        | Subterm.NotSubterm -> if nr >= 1 then Subterm.Vars (Int.Set.singleton nr) else Subterm.NotSubterm
-        | spec -> spec)
+  | _ -> Subterm.not_subterm
 
 (************************************************************************)
 
@@ -1396,7 +1452,7 @@ let filter_fix_stack_domain cache ?evars nr decrarg stack nuniformparams =
           (* 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 Subterm.NotSubterm)) in
+          SArg (Lazy.from_val (Subterm.internal nr)) in
       a :: aux (i+1) nuniformparams stack
   in aux 0 nuniformparams stack
 
@@ -1473,8 +1529,9 @@ 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 = Subterm.on_branches renv.env ci.ci_ind (set_iota_specif nr (lazy_subterm_specif cache ?evars renv [] c_0)) 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 cache ?evars renv [] c_0) in
+            let case_spec = Subterm.on_branches renv.env ci.ci_ind c_spec in
+            let stack' = filter_stack_domain cache 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
@@ -1868,7 +1925,7 @@ 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.structural tree) p with
+            let tree = match restrict_spec cache ?evars env (Subterm.strict_subterm tree) p with
             | Vars _ | DeadCode -> assert false
             | Subterm (_, tree', _) -> tree'
             | _ -> raise (CoFixGuardError (env, ReturnPredicateNotCoInductive c))

From 5817449b3a3a6610b06a127397a683313708addc Mon Sep 17 00:00:00 2001
From: Johannes Hostert <jojohostert@gmail.com>
Date: Tue, 10 Mar 2026 19:08:38 +0100
Subject: [PATCH 221/578] add changelog

---
 doc/changelog/09-cli-tools/21423-rocq-wc-Proof-Fixed.rst | 5 +++++
 1 file changed, 5 insertions(+)
 create mode 100644 doc/changelog/09-cli-tools/21423-rocq-wc-Proof-Fixed.rst

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 <https://github.com/rocq-prover/rocq/pull/21423>`_,
+  fixes `#21422 <https://github.com/rocq-prover/rocq/issues/21422>`_,
+  by Johannes Hostert).

From 13ce46be7393ff304280c0701cf2b71299bbfbd8 Mon Sep 17 00:00:00 2001
From: Yann Leray <yann.leray@inria.fr>
Date: Tue, 10 Mar 2026 19:32:21 +0100
Subject: [PATCH 222/578] Fix instance argument to Print and About with
 sort_variables

---
 doc/sphinx/proof-engine/vernacular-commands.rst | 2 +-
 doc/tools/docgram/fullGrammar                   | 2 +-
 doc/tools/docgram/orderedGrammar                | 2 +-
 engine/univNames.ml                             | 4 +---
 engine/univNames.mli                            | 4 +---
 printing/printer.mli                            | 2 +-
 vernac/g_vernac.mlg                             | 2 +-
 vernac/prettyp.mli                              | 4 ++--
 vernac/printmod.mli                             | 2 +-
 vernac/vernacexpr.mli                           | 4 ++--
 10 files changed, 12 insertions(+), 16 deletions(-)

diff --git a/doc/sphinx/proof-engine/vernacular-commands.rst b/doc/sphinx/proof-engine/vernacular-commands.rst
index 1a98906234a7..e61401feab48 100644
--- a/doc/sphinx/proof-engine/vernacular-commands.rst
+++ b/doc/sphinx/proof-engine/vernacular-commands.rst
@@ -16,7 +16,7 @@ Displaying
    .. 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`.
 
diff --git a/doc/tools/docgram/fullGrammar b/doc/tools/docgram/fullGrammar
index 7016896cae35..b8017b485a5d 100644
--- a/doc/tools/docgram/fullGrammar
+++ b/doc/tools/docgram/fullGrammar
@@ -1566,7 +1566,7 @@ search_queries: [
 ]
 
 univ_name_list: [
-| "@{" LIST0 name "}"
+| "@{" LIST0 name OPT [ ";" LIST0 name ] "}"
 ]
 
 syntax: [
diff --git a/doc/tools/docgram/orderedGrammar b/doc/tools/docgram/orderedGrammar
index 5fa00c28c5ef..2e7466bc2702 100644
--- a/doc/tools/docgram/orderedGrammar
+++ b/doc/tools/docgram/orderedGrammar
@@ -1096,7 +1096,7 @@ logical_kind: [
 ]
 
 univ_name_list: [
-| "@{" LIST0 name "}"
+| "@{" LIST0 name OPT [ ";" LIST0 name ] "}"
 ]
 
 enable_notation_flag: [
diff --git a/engine/univNames.ml b/engine/univNames.ml
index 71e97ae8bc1e..2689cb1e1975 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
diff --git a/engine/univNames.mli b/engine/univNames.mli
index 9149a0d67c4d..80b04c0cd07a 100644
--- a/engine/univNames.mli
+++ b/engine/univNames.mli
@@ -22,9 +22,7 @@ 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
diff --git a/printing/printer.mli b/printing/printer.mli
index 7925a1a286ec..e88e6caba771 100644
--- a/printing/printer.mli
+++ b/printing/printer.mli
@@ -163,7 +163,7 @@ val pr_universes  : evar_map ->
 
     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
+  (GlobRef.t * UnivNames.univ_name_list) option -> UnivNames.universe_binders * UnivNames.rev_binders
 
 (** Printing global references using names as short as possible *)
 
diff --git a/vernac/g_vernac.mlg b/vernac/g_vernac.mlg
index 030a62269d33..5a5189fb8253 100644
--- a/vernac/g_vernac.mlg
+++ b/vernac/g_vernac.mlg
@@ -1327,7 +1327,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/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.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/vernacexpr.mli b/vernac/vernacexpr.mli
index 5ac95d8bcedf..f1d6e80d11ab 100644
--- a/vernac/vernacexpr.mli
+++ b/vernac/vernacexpr.mli
@@ -53,7 +53,7 @@ type printable =
   | PrintMLLoadPath
   | PrintMLModules
   | PrintDebugGC
-  | PrintName of qualid or_by_notation * UnivNames.full_name_list option
+  | PrintName of qualid or_by_notation * UnivNames.univ_name_list option
   | PrintGraph
   | PrintClasses
   | PrintTypeclasses
@@ -70,7 +70,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 * 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

From cc0f51a4ddef19212111d099af069c7b0bed83ff Mon Sep 17 00:00:00 2001
From: Johannes Hostert <jojohostert@gmail.com>
Date: Tue, 10 Mar 2026 23:01:56 +0100
Subject: [PATCH 223/578] use non-ascii symbol in test to enforce proper
 unicode handling

---
 test-suite/coqwc/tactic-named-proof.out | 2 +-
 test-suite/coqwc/tactic-named-proof.v   | 3 ++-
 2 files changed, 3 insertions(+), 2 deletions(-)

diff --git a/test-suite/coqwc/tactic-named-proof.out b/test-suite/coqwc/tactic-named-proof.out
index 6fbdc1776eb1..c49a6cdaa7a4 100644
--- a/test-suite/coqwc/tactic-named-proof.out
+++ b/test-suite/coqwc/tactic-named-proof.out
@@ -1,2 +1,2 @@
      spec    proof comments
-        2       10        1 coqwc/tactic-named-proof.v
+        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
index 149d41ebc9fe..39c0acab239c 100644
--- a/test-suite/coqwc/tactic-named-proof.v
+++ b/test-suite/coqwc/tactic-named-proof.v
@@ -8,6 +8,7 @@
     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".
-    iPoseProof (fupd_mask_frame_r _ _ E' with "(H HP)") as "H"; first set_solver.
+    (* 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.

From b73510569ae1db29d03a871f6ec20ae994a64ca2 Mon Sep 17 00:00:00 2001
From: Nathan van der Kamp <nbvdkamp@gmail.com>
Date: Tue, 10 Mar 2026 23:54:17 +0100
Subject: [PATCH 224/578] Move TestSearchOpenMod to the correct directory

In its old location it wasn't being run and breaking it did not make the
test suite fail.
---
 test-suite/{ => output}/TestSearchOpenMod.out | 0
 test-suite/{ => output}/TestSearchOpenMod.v   | 0
 2 files changed, 0 insertions(+), 0 deletions(-)
 rename test-suite/{ => output}/TestSearchOpenMod.out (100%)
 rename test-suite/{ => output}/TestSearchOpenMod.v (100%)

diff --git a/test-suite/TestSearchOpenMod.out b/test-suite/output/TestSearchOpenMod.out
similarity index 100%
rename from test-suite/TestSearchOpenMod.out
rename to test-suite/output/TestSearchOpenMod.out
diff --git a/test-suite/TestSearchOpenMod.v b/test-suite/output/TestSearchOpenMod.v
similarity index 100%
rename from test-suite/TestSearchOpenMod.v
rename to test-suite/output/TestSearchOpenMod.v

From ba1e035b39411c728e4365767899bfae0a61458d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Wed, 11 Mar 2026 14:52:50 +0100
Subject: [PATCH 225/578] Fix forgotten univ subst when inlining in VM/native

Fix #21736
---
 dev/doc/critical-bugs.md    | 16 ++++++++++++++++
 kernel/genlambda.ml         |  4 +++-
 test-suite/bugs/bug_21736.v | 21 +++++++++++++++++++++
 3 files changed, 40 insertions(+), 1 deletion(-)
 create mode 100644 test-suite/bugs/bug_21736.v

diff --git a/dev/doc/critical-bugs.md b/dev/doc/critical-bugs.md
index 50ad81929891..ebe9d7e6d649 100644
--- a/dev/doc/critical-bugs.md
+++ b/dev/doc/critical-bugs.md
@@ -72,6 +72,7 @@ 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)
     - [Forgetting unsafe flags](#forgetting-unsafe-flags)
@@ -849,6 +850,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/kernel/genlambda.ml b/kernel/genlambda.ml
index 31d75df1ca30..9500f2cbb442 100644
--- a/kernel/genlambda.ml
+++ b/kernel/genlambda.ml
@@ -782,7 +782,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/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.

From 0659fa98feeb42aa373a3c17a7f56ded231a40ad Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Wed, 11 Mar 2026 16:26:01 +0100
Subject: [PATCH 226/578] Primitive array axioms are universe polymorphic

The flag was only set in one of the split off files in the stdlib split.
---
 doc/changelog/11-corelib/21744-arrayaxioms-Fixed.rst | 5 +++++
 theories/Corelib/Array/ArrayAxioms.v                 | 2 ++
 2 files changed, 7 insertions(+)
 create mode 100644 doc/changelog/11-corelib/21744-arrayaxioms-Fixed.rst

diff --git a/doc/changelog/11-corelib/21744-arrayaxioms-Fixed.rst b/doc/changelog/11-corelib/21744-arrayaxioms-Fixed.rst
new file mode 100644
index 000000000000..d985a6abcc1d
--- /dev/null
+++ b/doc/changelog/11-corelib/21744-arrayaxioms-Fixed.rst
@@ -0,0 +1,5 @@
+- **Fixed:**
+  primitive array axioms (in `ArrayAxioms`) are universe polymorphic
+  (they were inadvertently turned monomorphic in the stdlib split)
+  (`#21744 <https://github.com/rocq-prover/rocq/pull/21744>`_,
+  by Gaëtan Gilbert).
diff --git a/theories/Corelib/Array/ArrayAxioms.v b/theories/Corelib/Array/ArrayAxioms.v
index 57fcbd386041..d30d2c08137f 100644
--- a/theories/Corelib/Array/ArrayAxioms.v
+++ b/theories/Corelib/Array/ArrayAxioms.v
@@ -1,5 +1,7 @@
 From Corelib Require Import PrimArray.
 
+Set Universe Polymorphism.
+
 Local Abbreviation in_bounds i t := (PrimInt63.ltb i (length t)).
 
 Axiom get_out_of_bounds : forall A (t:array A) i,

From 27fb16aa0beda73e52e539d34c9f83e980f721fe Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Wed, 11 Mar 2026 16:46:55 +0100
Subject: [PATCH 227/578] Reject local constraints between global sorts when
 interpreting univ decls

---
 interp/constrintern.ml                          | 2 +-
 test-suite/success/sort_poly_elim_rigid_paths.v | 2 ++
 2 files changed, 3 insertions(+), 1 deletion(-)

diff --git a/interp/constrintern.ml b/interp/constrintern.ml
index bd07afd0a18b..39b4e502129d 100644
--- a/interp/constrintern.ml
+++ b/interp/constrintern.ml
@@ -3178,7 +3178,7 @@ 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 ->
diff --git a/test-suite/success/sort_poly_elim_rigid_paths.v b/test-suite/success/sort_poly_elim_rigid_paths.v
index 0c78771c6afc..44acd84ccc75 100644
--- a/test-suite/success/sort_poly_elim_rigid_paths.v
+++ b/test-suite/success/sort_poly_elim_rigid_paths.v
@@ -12,8 +12,10 @@ Check t@{s s'';Set Set}.
 (* This should fail though as we don't have [s'' -> s'] or [s'' -> s] declared. *)
 Fail Check t@{s'' s';Set Set}.
 Fail Check t@{s'' s;Set Set}.
+Fail Definition withelim@{|s'' -> s'} := tt.
 
 (* But if we do this, both should work. *)
 Constraint s'' -> s.
 Check t@{s'' s';Set Set}.
 Check t@{s'' s;Set Set}.
+Definition withelim@{|s'' -> s'} := tt.

From 79bc41b650bc3f379f408119635a389c81177365 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Wed, 11 Mar 2026 16:50:18 +0100
Subject: [PATCH 228/578] Use assert false instead of anomaly with empty string

---
 plugins/funind/gen_principle.ml | 2 +-
 pretyping/evarconv.ml           | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/plugins/funind/gen_principle.ml b/plugins/funind/gen_principle.ml
index 62a51b5ae8b3..185d22809aeb 100644
--- a/plugins/funind/gen_principle.ml
+++ b/plugins/funind/gen_principle.ml
@@ -1322,7 +1322,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/pretyping/evarconv.ml b/pretyping/evarconv.ml
index e1665d2f9b9f..6535830e2bbe 100644
--- a/pretyping/evarconv.ml
+++ b/pretyping/evarconv.ml
@@ -534,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

From 7915f792636315ba8f8795543df0715287eb1e6c Mon Sep 17 00:00:00 2001
From: Nicolas Tabareau <nicolas.tabareau@inria.fr>
Date: Wed, 11 Mar 2026 18:13:49 +0100
Subject: [PATCH 229/578] Add *explicit* universe polymorphism to array axioms

---
 theories/Corelib/Array/ArrayAxioms.v | 22 +++++++++++-----------
 1 file changed, 11 insertions(+), 11 deletions(-)

diff --git a/theories/Corelib/Array/ArrayAxioms.v b/theories/Corelib/Array/ArrayAxioms.v
index d30d2c08137f..86be8ad8377e 100644
--- a/theories/Corelib/Array/ArrayAxioms.v
+++ b/theories/Corelib/Array/ArrayAxioms.v
@@ -4,29 +4,29 @@ Set Universe Polymorphism.
 
 Local Abbreviation in_bounds i t := (PrimInt63.ltb i (length t)).
 
-Axiom get_out_of_bounds : forall A (t:array A) i,
+Axiom get_out_of_bounds@{u} : forall (A:Type@{u}) (t:array A) i,
   in_bounds i t = false -> t.[i] = default t.
 
-Axiom get_set_same : forall A t i (a:A),
+Axiom get_set_same@{u} : forall (A:Type@{u}) t i (a:A),
   in_bounds i t = true -> t.[i<-a].[i] = a.
-Axiom get_set_other : forall A t i j (a:A), i <> j -> t.[i<-a].[j] = t.[j].
-Axiom default_set : forall A t i (a:A), default t.[i<-a] = default t.
+Axiom get_set_other@{u} : forall (A:Type@{u}) t i j (a:A), i <> j -> t.[i<-a].[j] = t.[j].
+Axiom default_set@{u} : forall (A:Type@{u}) t i (a:A), default t.[i<-a] = default t.
 
 
-Axiom get_make : forall A (a:A) size i, (make size a).[i] = a.
+Axiom get_make@{u} : forall (A:Type@{u}) (a:A) size i, (make size a).[i] = a.
 
-Axiom leb_length : forall A (t:array A),
+Axiom leb_length@{u} : forall (A:Type@{u}) (t:array A),
   PrimInt63.leb (length t) max_length = true.
 
-Axiom length_make : forall A size (a:A),
+Axiom length_make@{u} : forall (A:Type@{u}) size (a:A),
   length (make size a) = if PrimInt63.leb size max_length then size else max_length.
-Axiom length_set : forall A t i (a:A),
+Axiom length_set@{u} : forall (A:Type@{u}) t i (a:A),
   length t.[i<-a] = length t.
 
-Axiom get_copy : forall A (t:array A) i, (copy t).[i] = t.[i].
-Axiom length_copy : forall A (t:array A), length (copy t) = length t.
+Axiom get_copy@{u} : forall (A:Type@{u}) (t:array A) i, (copy t).[i] = t.[i].
+Axiom length_copy@{u} : forall (A:Type@{u}) (t:array A), length (copy t) = length t.
 
-Axiom array_ext : forall A (t1 t2:array A),
+Axiom array_ext@{u} : forall (A:Type@{u}) (t1 t2:array A),
   length t1 = length t2 ->
   (forall i, in_bounds i t1 = true -> t1.[i] = t2.[i]) ->
   default t1 = default t2 ->

From 0e68ee59b18a3cebdcc7970a7570458f5bd99b07 Mon Sep 17 00:00:00 2001
From: Davide Fissore <fisso9900@gmail.com>
Date: Wed, 11 Mar 2026 14:35:39 +0100
Subject: [PATCH 230/578] Pass mode to class observer

This way the registered class compiler can retrieve the declared mode
---
 .../misc/tc_declaration_observer/main.out.reference       | 1 +
 test-suite/misc/tc_declaration_observer/main.v            | 2 +-
 test-suite/misc/tc_declaration_observer/observer.ml       | 6 ++++--
 vernac/classes.ml                                         | 6 +++---
 vernac/classes.mli                                        | 4 ++--
 vernac/record.ml                                          | 8 ++++----
 6 files changed, 15 insertions(+), 12 deletions(-)

diff --git a/test-suite/misc/tc_declaration_observer/main.out.reference b/test-suite/misc/tc_declaration_observer/main.out.reference
index 7c97d79c216b..b6c967cb2472 100644
--- a/test-suite/misc/tc_declaration_observer/main.out.reference
+++ b/test-suite/misc/tc_declaration_observer/main.out.reference
@@ -1,4 +1,5 @@
 NewClass Def
+Mode : -
 NewInstance def_nat  
 NewInstance def_bool  33 
 NewInstance def_bool2  21 local
diff --git a/test-suite/misc/tc_declaration_observer/main.v b/test-suite/misc/tc_declaration_observer/main.v
index d3218e3c1ccb..9cfc60ecfce9 100644
--- a/test-suite/misc/tc_declaration_observer/main.v
+++ b/test-suite/misc/tc_declaration_observer/main.v
@@ -1,6 +1,6 @@
 Declare ML Module "observer.plugin".
 
-Class Def (A : Type) := { default : A }.
+#[mode="-"] Class Def (A : Type) := { default : A }.
 
 Instance def_nat : Def nat := {| default := 0 |}.
 
diff --git a/test-suite/misc/tc_declaration_observer/observer.ml b/test-suite/misc/tc_declaration_observer/observer.ml
index ca7166c9ca65..3da930263c60 100644
--- a/test-suite/misc/tc_declaration_observer/observer.ml
+++ b/test-suite/misc/tc_declaration_observer/observer.ml
@@ -8,8 +8,10 @@ let observe x =
   let open Hints in
   let p = Pp.string_of_ppcmds in
   match x with
-  | NewClass { cl_impl } ->
-      Printf.fprintf o "NewClass %s\n" (p (Printer.pr_global cl_impl))
+  | NewClass (ml, { cl_impl }) ->
+      Printf.fprintf o "NewClass %s\n" (p (Printer.pr_global cl_impl));
+      let cnt = Pp.(pr_opt (prlist pp_hint_mode)) ml in
+      Printf.fprintf o "Mode :%s\n" (p cnt)
   | NewInstance { instance ; info = { hint_priority }; locality } ->
       Printf.fprintf o "NewInstance %s %s %s\n"
         (p (Printer.pr_global instance))
diff --git a/vernac/classes.ml b/vernac/classes.ml
index 850aa21de16e..c30aefd6dd02 100644
--- a/vernac/classes.ml
+++ b/vernac/classes.ml
@@ -130,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
 
@@ -254,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
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/record.ml b/vernac/record.ml
index ac19aad7c694..c30a2ebc22f7 100644
--- a/vernac/record.ml
+++ b/vernac/record.ml
@@ -994,8 +994,8 @@ 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
@@ -1061,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 =
@@ -1150,7 +1150,7 @@ let definition_structure ~flags udecl kind ~primitive_proj (records : Ast.t list
                         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

From 6c26d5b6f54655fcdacb5a0690e634c9a40c1a0c Mon Sep 17 00:00:00 2001
From: Davide Fissore <fisso9900@gmail.com>
Date: Thu, 12 Mar 2026 14:35:49 +0100
Subject: [PATCH 231/578] add overlay

---
 dev/ci/user-overlays/21742-FissoreD-mode-class.sh | 1 +
 1 file changed, 1 insertion(+)
 create mode 100644 dev/ci/user-overlays/21742-FissoreD-mode-class.sh

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

From 35abe5fd924ca0303c6388865d488d35bf58354e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Fri, 13 Mar 2026 16:12:25 +0100
Subject: [PATCH 232/578] Fix extraction with `with Definition` and fancy
 modules

Not sure the test is fully minimal but it's small enough.

Fix #21754
---
 plugins/extraction/extract_env.ml |  2 +-
 test-suite/bugs/bug_21754.v       | 19 +++++++++++++++++++
 2 files changed, 20 insertions(+), 1 deletion(-)
 create mode 100644 test-suite/bugs/bug_21754.v

diff --git a/plugins/extraction/extract_env.ml b/plugins/extraction/extract_env.ml
index 3dacb0308e6b..2f3b20cbbe76 100644
--- a/plugins/extraction/extract_env.ml
+++ b/plugins/extraction/extract_env.ml
@@ -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/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.

From 15b4c9c83e36aa00f6e9c04a69b985be5fe5f64f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Fri, 13 Mar 2026 14:23:55 +0100
Subject: [PATCH 233/578] Fix subtyping with elim constraints

Fix #21750
---
 dev/doc/critical-bugs.md    | 13 +++++++++++++
 kernel/mod_typing.ml        |  2 +-
 kernel/subtyping.ml         | 24 +++++++++++++++++++++++-
 kernel/subtyping.mli        |  5 +++++
 kernel/uGraph.ml            | 15 ---------------
 kernel/uGraph.mli           |  4 ----
 test-suite/bugs/bug_21750.v | 19 +++++++++++++++++++
 7 files changed, 61 insertions(+), 21 deletions(-)
 create mode 100644 test-suite/bugs/bug_21750.v

diff --git a/dev/doc/critical-bugs.md b/dev/doc/critical-bugs.md
index ebe9d7e6d649..0f7184a5674e 100644
--- a/dev/doc/critical-bugs.md
+++ b/dev/doc/critical-bugs.md
@@ -408,6 +408,19 @@ and lack of checking of relevance marks on constants in coqchk
 - 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
diff --git a/kernel/mod_typing.ml b/kernel/mod_typing.ml
index f136f31f5dfc..cf430b762a99 100644
--- a/kernel/mod_typing.ml
+++ b/kernel/mod_typing.ml
@@ -110,7 +110,7 @@ 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
+            if not (Subtyping.check_polymorphic_universes env uctx ctx) then
               error (WithSignatureMismatch (IncompatibleUnivConstraints { got = ctx; expect = uctx }))
           in
           (** Terms are compared in a context with De Bruijn universe indices *)
diff --git a/kernel/subtyping.ml b/kernel/subtyping.ml
index 15e9fb67c71e..5a63a9fa8176 100644
--- a/kernel/subtyping.ml
+++ b/kernel/subtyping.ml
@@ -95,11 +95,33 @@ 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 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 qs, us = Instance.to_array inst in
+    let push accu v = UGraph.add_universe v ~strict:false accu in
+    let univs = Array.fold_left push (Environ.universes env) us in
+    let univs = UGraph.merge_constraints cstT univs in
+    if not @@ UGraph.check_constraints cst univs then false
+    else
+      let qcst = UContext.elim_constraints uctx in
+      let qcstT = UContext.elim_constraints (AbstractContext.repr ctxT) in
+      let push acc q = QGraph.add_quality q acc in
+      let qgraph = Array.fold_left push (Environ.qualities env) qs in
+      let qgraph = QGraph.merge_constraints qcstT qgraph in
+      QGraph.check_constraints qcst qgraph
+
 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
+    if not (check_polymorphic_universes env auctx2 auctx1) then
       error (IncompatibleUnivConstraints { got = auctx1; expect = auctx2; } )
     else
       let () = Environ.check_ucontext (UVars.AbstractContext.repr auctx2) env in
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/uGraph.ml b/kernel/uGraph.ml
index 7cf8ceb40749..eaf5bfb73d02 100644
--- a/kernel/uGraph.ml
+++ b/kernel/uGraph.ml
@@ -208,21 +208,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 =
diff --git a/kernel/uGraph.mli b/kernel/uGraph.mli
index cc50cc978dea..3289e5404026 100644
--- a/kernel/uGraph.mli
+++ b/kernel/uGraph.mli
@@ -103,10 +103,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 =
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.

From 5f9dad7f8bb60321840d1eafae78ce9e0f3f95a0 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Fri, 13 Mar 2026 14:29:19 +0100
Subject: [PATCH 234/578] regen critical-bugs toc

---
 dev/doc/critical-bugs.md | 20 ++++++++++++--------
 1 file changed, 12 insertions(+), 8 deletions(-)

diff --git a/dev/doc/critical-bugs.md b/dev/doc/critical-bugs.md
index 0f7184a5674e..730777e45610 100644
--- a/dev/doc/critical-bugs.md
+++ b/dev/doc/critical-bugs.md
@@ -34,7 +34,10 @@ This file recollects knowledge about critical bugs found in Coq since version 8.
       - [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)
@@ -43,11 +46,11 @@ 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)
+      - [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)
     - [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)
@@ -72,9 +75,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)
+      - [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)
@@ -84,7 +88,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)

From a7105659153329784c3dd54042abf3e1ea7d4b81 Mon Sep 17 00:00:00 2001
From: Enrico Tassi <Enrico.Tassi@Inria.fr>
Date: Fri, 13 Mar 2026 16:52:21 +0100
Subject: [PATCH 235/578] ci: do not run elpi tests requiring external deps

---
 dev/ci/scripts/ci-elpi_test.sh | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

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
 )

From 18d46283cdf8551fbff87bb3edbcb789d15e4a91 Mon Sep 17 00:00:00 2001
From: Enrico Tassi <Enrico.Tassi@Inria.fr>
Date: Fri, 13 Mar 2026 16:54:23 +0100
Subject: [PATCH 236/578] overlay

---
 dev/ci/user-overlays/21758-gares-fix-ci-elpi-xml.sh | 1 +
 1 file changed, 1 insertion(+)
 create mode 100644 dev/ci/user-overlays/21758-gares-fix-ci-elpi-xml.sh

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

From 7e0bae0ffc0f6b11d36958038b3fd8cbfab1e2c9 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Thu, 12 Mar 2026 14:49:11 +0100
Subject: [PATCH 237/578] Remove redundant check in Inductive.build_recargs.

---
 kernel/inductive.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/kernel/inductive.ml b/kernel/inductive.ml
index 0b1db73f3a64..b1f3a2d3ff75 100644
--- a/kernel/inductive.ml
+++ b/kernel/inductive.ml
@@ -982,7 +982,7 @@ let get_recargs_approx cache ?evars env tree ind args =
       if WfPaths.is_inductive env (fst ind_kn) tree then
         build_recargs_nested ienv tree (ind_kn, largs)
       else mk_norec
-    | Const (c,_) when is_primitive_positive_container env c ->
+    | Const (c, _) ->
       if WfPaths.is_primitive_positive_container env c tree then
         build_recargs_nested_primitive ienv tree (c, largs)
       else mk_norec

From 53a06ff02e8e6b08c70996eceaa4b25b241ea98e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Thu, 12 Mar 2026 14:57:43 +0100
Subject: [PATCH 238/578] Remove the cache from the guard checker.

Now that we use an automaton-based algorithm, computing the subterms is O(1)
so there is no point in caching the result of the expansion.
---
 kernel/inductive.ml | 121 +++++++++++++++++---------------------------
 1 file changed, 46 insertions(+), 75 deletions(-)

diff --git a/kernel/inductive.ml b/kernel/inductive.ml
index b1f3a2d3ff75..1eb105cd72ce 100644
--- a/kernel/inductive.ml
+++ b/kernel/inductive.ml
@@ -649,14 +649,6 @@ val is_inductive : env -> inductive -> t -> bool
 val is_primitive_positive_container : env -> Constant.t -> t -> bool
 val equal : t -> t -> bool
 
-module Cache :
-sig
-  type wf_paths = t
-  type t
-  val create : unit -> t
-  val get_inductive_subterms : MutInd.t -> mutual_inductive_body -> t -> wf_paths array array array
-end
-
 end =
 struct
 
@@ -710,26 +702,6 @@ let is_primitive_positive_container env cst t = match dest_recarg t with
 let equal t1 t2 =
   Atm.equal eq_recarg t1 t2
 
-module Cache :
-sig
-  type wf_paths = t
-  type t
-  val create : unit -> t
-  val get_inductive_subterms : MutInd.t -> mutual_inductive_body -> t -> wf_paths array array array
-end =
-struct
-  type wf_paths = t
-  type ans = t array 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_automaton) mib.mind_packets in
-    let () = cache := Mindmap_env.add mind ans !cache in
-    ans
-  | Some ans -> ans
-end
-
 end
 
 (*************************************)
@@ -810,7 +782,7 @@ val on_branches : env -> inductive -> t lazy_t -> int -> t lazy_t list
 val on_projection : t -> int -> t
 val on_array : t -> t
 
-val prune_path : WfPaths.Cache.t -> ?evars:CClosure.evar_handler ->
+val prune_path : ?evars:CClosure.evar_handler ->
   env -> t -> pinductive -> types list -> t
 
 end = struct
@@ -965,7 +937,7 @@ 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
@@ -1007,7 +979,8 @@ let get_recargs_approx cache ?evars env tree ind args =
     mutually recursive containers are not supported. *)
     let trees =
       if Int.equal auxntyp 1 then [|WfPaths.dest_subterms tree|]
-      else WfPaths.Cache.get_inductive_subterms mind mib cache
+      else
+        Array.init auxntyp (fun i -> WfPaths.dest_subterms (WfPaths.lookup_subterms env (mind, i)))
     in
     let mk_irecargs j mip =
       (* The nested inductive type with parameters removed *)
@@ -1055,11 +1028,11 @@ let get_recargs_approx cache ?evars env tree ind args =
   build_recargs_nested (env,[]) tree (ind, args)
 
 
-let prune_path cache ?evars env spec 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 cache ?evars env tree ind args in
+    let recargs = get_recargs_approx ?evars env tree ind args in
     let tree = WfPaths.restrict tree recargs in
     spec_of_tree size vars tree
 
@@ -1179,7 +1152,7 @@ let has_constant_parameters env nvars k ((mind, _), _) args =
 
 (* [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
   | Subterm.NotSubterm | Subterm.Vars _ -> spec
   | _ ->
@@ -1197,12 +1170,12 @@ let restrict_spec cache ?evars env spec p =
   | Ind i ->
     if has_constant_parameters env absctxlen (List.length arctx) i args then spec
     else
-      Subterm.prune_path cache ?evars env spec i args
+      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 not_subterm ?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
@@ -1222,10 +1195,10 @@ let filter_stack_domain cache stack_element_specif not_subterm ?evars env p stac
         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 spec = stack_element_specif ?evars elt in
           if has_constant_parameters env absctxlen (k + List.length ctx) ind args then SArg spec
           else
-            SArg (lazy (Subterm.prune_path cache ?evars env (Lazy.force spec) ind args))
+            SArg (lazy (Subterm.prune_path ?evars env (Lazy.force spec) ind args))
         | _ -> SArg not_subterm
         in
         elt :: filter_stack (push_rel d env) (k + 1) c0 stack'
@@ -1240,7 +1213,7 @@ let filter_stack_domain cache stack_element_specif not_subterm ?evars env p stac
    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
@@ -1248,15 +1221,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 (lazy Subterm.not_subterm) ?evars renv.env p stack' in
-      let cases_spec = Subterm.on_branches renv.env ci.ci_ind (lazy_subterm_specif cache ?evars renv [] c) 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')
+                    subterm_specif ?evars renv stack_br br')
                   lbr in
       let spec = Subterm.inter_spec stl in
-      restrict_spec cache ?evars renv.env spec p
+      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
@@ -1294,20 +1267,20 @@ let rec subterm_specif cache ?evars renv stack t =
           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
+            let arg_spec = stack_element_specif ?evars decrArg in
               assign_var_spec renv'' (1, arg_spec) in
-          subterm_specif cache ?evars renv'' [] strippedBody)
+          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 _) -> Subterm.dead_code
 
     | Proj (p, _, c) ->
-      let subt = subterm_specif cache ?evars renv stack c in
+      let subt = subterm_specif ?evars renv stack c in
       Subterm.on_projection subt (Projection.arg p)
 
     | Const c ->
@@ -1315,7 +1288,7 @@ let rec subterm_specif cache ?evars renv stack t =
         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
+          primitive_specif ?evars renv op l
         | NotEvaluableConst _ -> Subterm.not_subterm
       end
 
@@ -1326,25 +1299,25 @@ let rec subterm_specif cache ?evars renv stack t =
 
       (* 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
+and extract_stack ?evars = function
    | [] -> lazy Subterm.not_subterm, []
-   | elt :: l -> stack_element_specif cache ?evars elt, l
+   | 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
+    let subt = subterm_specif ?evars renv [] arg in
     Subterm.on_array subt
   | _ -> Subterm.not_subterm
 
@@ -1437,7 +1410,7 @@ let drop_uniform_parameters nuniformparams bodies =
   in
   Array.mapi (fun i -> aux i 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
     | [] -> []
@@ -1445,7 +1418,7 @@ let filter_fix_stack_domain cache ?evars nr decrarg stack nuniformparams =
       let uniform, nuniformparams = if nuniformparams = 0 then false, 0 else true, nuniformparams -1 in
       let a =
         if uniform then a
-        else if Int.equal i decrarg then SArg (stack_element_specif cache ?evars 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
@@ -1456,11 +1429,11 @@ let filter_fix_stack_domain cache ?evars nr decrarg stack nuniformparams =
       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
@@ -1477,7 +1450,7 @@ let judgment_of_fixpoint (_, types, bodies) =
 (* 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
@@ -1512,7 +1485,7 @@ 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 Subterm.check (Lazy.force (stack_element_specif cache ?evars z)) trees.(glob) with
+                  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
@@ -1529,9 +1502,9 @@ 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 c_spec = Subterm.make_internal nr (lazy_subterm_specif cache ?evars renv [] c_0) 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 cache stack_element_specif (Lazy.from_val (Subterm.internal nr)) ?evars renv.env p stack 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
@@ -1572,7 +1545,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
@@ -1613,7 +1586,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
@@ -1672,7 +1645,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)
@@ -1708,7 +1681,7 @@ let check_one_fix cache ?evars renv recpos trees def =
             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
@@ -1820,7 +1793,6 @@ let sorts_of_mutfix env minds names =
 
 
 let check_fix_pre_sorts ?evars env ((nvect, _), (names, _, bodies as recdef) as fix) =
-  let cache = WfPaths.Cache.create () in
 (* 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,
@@ -1836,7 +1808,7 @@ let check_fix_pre_sorts ?evars env ((nvect, _), (names, _, bodies as recdef) as
       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
+        try check_one_fix ?evars renv nvect trees body
         with FixGuardError (err_env, err) -> raise_err err_env i err
       done
   in
@@ -1869,7 +1841,7 @@ 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 check_one_cofix ?evars env nbfix def deftype =
   let rec check_rec_call env alreadygrd n tree vlra t =
     if not (noccur_with_meta n nbfix t) then
       let c,args = decompose_app_list (whd_all ?evars env t) in
@@ -1925,7 +1897,7 @@ 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.strict_subterm tree) p with
+            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))
@@ -1959,13 +1931,12 @@ let check_one_cofix cache ?evars env nbfix def deftype =
    satisfies the guarded condition *)
 
 let check_cofix ?evars env (_bodynum,(names,types,bodies as recdef)) =
-  let cache = WfPaths.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)

From 65421e93f6da3a5b3b0cd3c0612afa244314d0f8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Thu, 12 Mar 2026 14:59:59 +0100
Subject: [PATCH 239/578] Stop computing arrays for nothing in
 Inductive.dest_subterms.

We expose a function that gives access to the precise argument given
its position in the array, without having to recompute all of the
other values.
---
 kernel/inductive.ml | 25 +++++++++++--------------
 1 file changed, 11 insertions(+), 14 deletions(-)

diff --git a/kernel/inductive.ml b/kernel/inductive.ml
index 1eb105cd72ce..202985543964 100644
--- a/kernel/inductive.ml
+++ b/kernel/inductive.ml
@@ -643,6 +643,7 @@ type t
 val lookup_subterms : env -> inductive -> t
 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
@@ -677,6 +678,10 @@ let restrict t p =
   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
@@ -871,20 +876,12 @@ let inter_spec =
   Array.fold_left inter_spec DeadCode
 
 
-let on_constructors discr =
-  (* As computing subterms is more expensive than computing discr
-     (because of dest_subterms), we put it in a single lazy block. *)
-  let subterms = lazy begin match Lazy.force discr with
-    | DeadCode | Vars _ | NotSubterm as spec ->
-      Inl spec
-    | Subterm (_, tree, vars) ->
-      let subtree = WfPaths.dest_subterms tree in
-      let subterms = Array.map (Array.map (spec_of_tree Strict vars)) subtree in
-      Inr subterms
-  end in
-  fun i j -> lazy begin match Lazy.force subterms with
-  | Inl spec -> spec
-  | Inr spec_arr -> spec_arr.(i).(j)
+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 =

From 646e7765f2f25a6c272b56ecc49d3d7c41856e0f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Thu, 12 Mar 2026 15:09:34 +0100
Subject: [PATCH 240/578] Remove the additional expanded tree argument in
 Inductive.check_cofix.

This value was always guaranteed to be dest_subterm of the previous argument.
The only reason this was duplicated in 87a60c55 was because it used to be
expensive to compute the value and sharing was thus an optimization. Now that
subterm expansion is O(1), there is no point in keeping it.
---
 kernel/inductive.ml | 48 +++++++++++++++++++++------------------------
 1 file changed, 22 insertions(+), 26 deletions(-)

diff --git a/kernel/inductive.ml b/kernel/inductive.ml
index 202985543964..7d86e359e30e 100644
--- a/kernel/inductive.ml
+++ b/kernel/inductive.ml
@@ -1825,9 +1825,6 @@ let check_fix ?evars env (_, (names, _, _ as recdef) as fix) =
 
 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
@@ -1839,7 +1836,7 @@ let rec codomain_is_coind ?evars env c =
           raise (CoFixGuardError (env, CodomainNotInductiveType b)))
 
 let check_one_cofix ?evars env nbfix def deftype =
-  let rec check_rec_call env alreadygrd n tree vlra t =
+  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
@@ -1851,30 +1848,30 @@ let check_one_cofix ?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 WfPaths.is_norec 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 (WfPaths.dest_subterms rar) t;
-                      process_args_of_constr (lr, lrar)
-                    end
-              | [],_ -> ()
-              | _ -> anomaly_ill_typed ()
-            in process_args_of_constr (realargs, Array.to_list 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))
 
@@ -1884,8 +1881,8 @@ let check_one_cofix ?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
@@ -1902,8 +1899,7 @@ let check_one_cofix ?evars env nbfix def deftype =
                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 = WfPaths.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
@@ -1914,7 +1910,7 @@ let check_one_cofix ?evars env nbfix def deftype =
 
         | Meta _ -> ()
         | 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 _ ->
@@ -1922,7 +1918,7 @@ let check_one_cofix ?evars env nbfix def deftype =
 
   let ((mind, _),_) = codomain_is_coind ?evars env deftype in
   let vlra = WfPaths.lookup_subterms env mind in
-  check_rec_call env false 1 vlra (WfPaths.dest_subterms vlra) def
+  check_rec_call env false 1 vlra def
 
 (* The  function which checks that the whole block of definitions
    satisfies the guarded condition *)

From d14fea0d744ebe6e148555b3107693993c0fdb6a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Fri, 13 Mar 2026 18:10:43 +0100
Subject: [PATCH 241/578] Small simplification in Inductive commutative cut
 API.

---
 kernel/inductive.ml | 16 ++++++++++------
 1 file changed, 10 insertions(+), 6 deletions(-)

diff --git a/kernel/inductive.ml b/kernel/inductive.ml
index 7d86e359e30e..1bcb707aa644 100644
--- a/kernel/inductive.ml
+++ b/kernel/inductive.ml
@@ -641,6 +641,7 @@ 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
@@ -661,6 +662,10 @@ 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
@@ -975,9 +980,8 @@ let get_recargs_approx ?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 [|WfPaths.dest_subterms tree|]
-      else
-        Array.init auxntyp (fun i -> WfPaths.dest_subterms (WfPaths.lookup_subterms env (mind, i)))
+      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 *)
@@ -987,7 +991,7 @@ let get_recargs_approx ?evars env tree ind args =
          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
@@ -1005,14 +1009,14 @@ let get_recargs_approx ?evars env tree ind args =
     let recargs = [| mk_paths (Mrec (RecArgPrim c)) [| paths |] |] in
     (Rtree.mk_rec recargs).(0)
 
-  and build_recargs_constructors ienv trees 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 trees.(i) 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' (i+1) (recarg::lrec) d
           | _hd ->

From b9f1b5389ecf80e9286d9dddf9a6c02547a833f2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Fri, 13 Mar 2026 15:39:04 +0100
Subject: [PATCH 242/578] Fix #21751: Engine gladly accepts to unify global and
 thus rigid sorts.

Sort unification in UState was never enforcing that we did not unify
rigid sorts, basically.
---
 engine/uState.ml                     |  6 +++++-
 test-suite/bugs/bug_21751.v          |  8 ++++++++
 test-suite/output/sort_poly_elab.out | 10 +++-------
 3 files changed, 16 insertions(+), 8 deletions(-)
 create mode 100644 test-suite/bugs/bug_21751.v

diff --git a/engine/uState.ml b/engine/uState.ml
index 595e279f9779..3dd6696b0640 100644
--- a/engine/uState.ml
+++ b/engine/uState.ml
@@ -163,7 +163,11 @@ let set q qv m =
   let q = repr_node q m in
   let q, rigid = match q with ReprVar (q, rigid) -> q, rigid | ReprConstant _ -> assert false in
   let qv = match qv with QVar qv -> repr_node qv m | QConstant qc -> ReprConstant qc in
-  let enforce_eq q1 q2 g = QGraph.enforce_eliminates_to q1 q2 (QGraph.enforce_eliminates_to q2 q1 g) 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
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/output/sort_poly_elab.out b/test-suite/output/sort_poly_elab.out
index d1f98faa00a2..d24a308a34a0 100644
--- a/test-suite/output/sort_poly_elab.out
+++ b/test-suite/output/sort_poly_elab.out
@@ -724,14 +724,10 @@ Arguments bool_to_Prop' b
 bool_to_Prop' is transparent
 Expands to: Constant sort_poly_elab.Inductives.bool_to_Prop'
 Declared in library sort_poly_elab, line 490, characters 21-34
-File "./output/sort_poly_elab.v", line 502, characters 2-80:
+File "./output/sort_poly_elab.v", line 502, characters 58-60:
 The command has indeed failed with message:
-Incorrect elimination of "true@{Test ; }" in the inductive type
-"bool@{Test ; }":
-the return type has sort "Set"
-while it should be in a sort Test eliminates to.
-Elimination of a sort polymorphic inductive object instantiated to a variable sort quality
-is only allowed on itself or with an explicit elimination constraint to the target sort.
+This expression would enforce a non-declared elimination constraint between
+Test and Prop
 unit@{α ; u} : Type@{α ; u}
 (* α ; u |=  *)
 

From fdf851d6bc291edae0a859dfdeae115fed56efef Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Mon, 16 Mar 2026 11:36:26 +0100
Subject: [PATCH 243/578] Faster implementation of remove hints internals.

Instead of computing the set of canonized globrefs many times, we do
it a single time in the toplevel caller.
---
 tactics/hints.ml | 7 +++----
 1 file changed, 3 insertions(+), 4 deletions(-)

diff --git a/tactics/hints.ml b/tactics/hints.ml
index f4082bcc6f9f..b7f40e197aaf 100644
--- a/tactics/hints.ml
+++ b/tactics/hints.ml
@@ -769,8 +769,6 @@ struct
   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,9 +777,10 @@ 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
+      match h.name with Some gr -> not (GlobRef.Set_env.mem gr grs) | None -> true in
     let hintmap = GlobRef.Map.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 }

From 874d936451cd2d0b790f7abf6dcc67cccefcbc9b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Mon, 16 Mar 2026 13:44:08 +0100
Subject: [PATCH 244/578] Cleanup check_polymorphic_universes

Co-authored-by: Yann Leray
---
 kernel/subtyping.ml | 22 ++++++----------------
 1 file changed, 6 insertions(+), 16 deletions(-)

diff --git a/kernel/subtyping.ml b/kernel/subtyping.ml
index 5a63a9fa8176..67b14efe4fb7 100644
--- a/kernel/subtyping.ml
+++ b/kernel/subtyping.ml
@@ -100,22 +100,12 @@ let check_conv_error error why state poly pb env a1 a2 =
 let check_polymorphic_universes env ctxT ctx =
   if not @@ eq_sizes (AbstractContext.size ctxT) (AbstractContext.size ctx) then false
   else
-    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 qs, us = Instance.to_array inst in
-    let push accu v = UGraph.add_universe v ~strict:false accu in
-    let univs = Array.fold_left push (Environ.universes env) us in
-    let univs = UGraph.merge_constraints cstT univs in
-    if not @@ UGraph.check_constraints cst univs then false
-    else
-      let qcst = UContext.elim_constraints uctx in
-      let qcstT = UContext.elim_constraints (AbstractContext.repr ctxT) in
-      let push acc q = QGraph.add_quality q acc in
-      let qgraph = Array.fold_left push (Environ.qualities env) qs in
-      let qgraph = QGraph.merge_constraints qcstT qgraph in
-      QGraph.check_constraints qcst qgraph
+    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

From 20e4a83f503e2e549c10b2609fb1b5980e20b719 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Mon, 16 Mar 2026 14:30:34 +0100
Subject: [PATCH 245/578] Simplify Indtyping.compute_elim_squash

We match on sorts a lot less this way.

This fixes declaring inductives in impredicative Set with large arguments.
---
 kernel/indTyping.ml | 62 ++++++++++++++++++---------------------------
 1 file changed, 24 insertions(+), 38 deletions(-)

diff --git a/kernel/indTyping.ml b/kernel/indTyping.ml
index 72c644c19b56..af9ce0798e43 100644
--- a/kernel/indTyping.ml
+++ b/kernel/indTyping.ml
@@ -82,12 +82,18 @@ 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
@@ -104,38 +110,18 @@ let compute_elim_squash ?(is_real_arg=false) env u info =
         | Prop | Set | Type _ -> { info with record_arg_info = HasRelevantArg }
   in
   if Environ.ignore_elim_constraints 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 }
+  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 Sorts.Quality.is_impredicative (Sorts.quality 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 *)
+    | QSort (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) =

From c14ce52ae7e6be621f792ec2dbada6c01873db86 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Mon, 16 Mar 2026 14:49:20 +0100
Subject: [PATCH 246/578] Fix handling of inductive squashed to set in higher
 layers

---
 engine/univGen.ml          | 11 +++++++----
 engine/univGen.mli         |  1 +
 pretyping/inductiveops.ml  |  6 +++---
 pretyping/inductiveops.mli |  6 +++---
 pretyping/typing.ml        |  4 +---
 tactics/tactics.ml         |  3 +--
 vernac/auto_ind_decl.ml    | 16 ++++++++++++----
 vernac/indschemes.ml       |  2 +-
 vernac/record.ml           |  2 +-
 9 files changed, 30 insertions(+), 21 deletions(-)

diff --git a/engine/univGen.ml b/engine/univGen.ml
index 759276d5f0fc..c48960cde543 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
diff --git a/engine/univGen.mli b/engine/univGen.mli
index 4b15ffbf2657..a1a7fe9b00a7 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
 
diff --git a/pretyping/inductiveops.ml b/pretyping/inductiveops.ml
index 28adc0d10333..7ca8d29f6d5a 100644
--- a/pretyping/inductiveops.ml
+++ b/pretyping/inductiveops.ml
@@ -342,15 +342,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)
diff --git a/pretyping/inductiveops.mli b/pretyping/inductiveops.mli
index 0a1e75b9fc6e..0b85f6f62292 100644
--- a/pretyping/inductiveops.mli
+++ b/pretyping/inductiveops.mli
@@ -126,7 +126,7 @@ val constructor_alltags : env -> constructor -> bool list
 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,9 +143,9 @@ 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. *)
diff --git a/pretyping/typing.ml b/pretyping/typing.ml
index 4da05cc1ffd0..7fb6ffa0183a 100644
--- a/pretyping/typing.ml
+++ b/pretyping/typing.ml
@@ -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' ->
diff --git a/tactics/tactics.ml b/tactics/tactics.ml
index 48fc89aa02fc..5eef0f13fcb6 100644
--- a/tactics/tactics.ml
+++ b/tactics/tactics.ml
@@ -1498,8 +1498,7 @@ let make_projection env sigma params cstr sign elim i n c (ind, u) =
         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
+        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 MatchStyle in
diff --git a/vernac/auto_ind_decl.ml b/vernac/auto_ind_decl.ml
index 745ae0fae4db..7515ce80bee2 100644
--- a/vernac/auto_ind_decl.ml
+++ b/vernac/auto_ind_decl.ml
@@ -841,8 +841,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 +855,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
 
diff --git a/vernac/indschemes.ml b/vernac/indschemes.ml
index 5805bce664e1..2598ab88b3bf 100644
--- a/vernac/indschemes.ml
+++ b/vernac/indschemes.ml
@@ -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 *)
diff --git a/vernac/record.ml b/vernac/record.ml
index c30a2ebc22f7..2c153f4b209e 100644
--- a/vernac/record.ml
+++ b/vernac/record.ml
@@ -482,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

From 78b3ce083203f2081da7615a9cc8933b25ae6940 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Mon, 16 Mar 2026 14:49:35 +0100
Subject: [PATCH 247/578] Fix declaring inductive in impredicative Set with
 large arguments

---
 kernel/indTyping.ml                    | 2 +-
 test-suite/success/impredicative_set.v | 8 ++++++++
 2 files changed, 9 insertions(+), 1 deletion(-)
 create mode 100644 test-suite/success/impredicative_set.v

diff --git a/kernel/indTyping.ml b/kernel/indTyping.ml
index af9ce0798e43..9ccfc17e502a 100644
--- a/kernel/indTyping.ml
+++ b/kernel/indTyping.ml
@@ -113,7 +113,7 @@ let compute_elim_squash ?(is_real_arg=false) env u info =
   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 Sorts.Quality.is_impredicative (Sorts.quality indu) then add_squash (Sorts.quality u) info
+    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
diff --git a/test-suite/success/impredicative_set.v b/test-suite/success/impredicative_set.v
new file mode 100644
index 000000000000..e9891203c52a
--- /dev/null
+++ b/test-suite/success/impredicative_set.v
@@ -0,0 +1,8 @@
+(* -*- coq-prog-args: ("-impredicative-set"); -*- *)
+
+Definition foo : Set := forall A : Set, A -> A.
+
+Inductive bar : Set := Bar (_:Type).
+
+Check bar_rec.
+Fail Check bar_rect.

From 688d612fe13de0b69d4493775a6f43a6b93d7f2c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Jean-Christophe=20L=C3=A9chenet?=
 <jean-christophe.lechenet@inria.fr>
Date: Wed, 11 Mar 2026 15:52:26 +0100
Subject: [PATCH 248/578] [CI] Reenable jasmin

now that the extraction problems are fixed
---
 .gitlab-ci.yml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
index e3d4517163a8..2560f0f8ff32 100644
--- a/.gitlab-ci.yml
+++ b/.gitlab-ci.yml
@@ -1060,7 +1060,7 @@ library:ci-mathcomp_word:
   - library:ci-mathcomp
   stage: build-2
 
-.library:ci-jasmin:  # disabled until repaired
+library:ci-jasmin:
   extends: .ci-template-flambda
   needs:
   - build:edge+flambda

From 61bc8996990ad10a80002cbe66124f8d186ef45f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Tue, 17 Mar 2026 12:06:25 +0100
Subject: [PATCH 249/578] Algorithmically better representation of file maps in
 coqdep.

This was observed in actual developments with many files.
---
 tools/coqdep/lib/common.ml | 24 ++++++++++++++++--------
 1 file changed, 16 insertions(+), 8 deletions(-)

diff --git a/tools/coqdep/lib/common.ml b/tools/coqdep/lib/common.ml
index 0edf791f2220..af0009bbfe98 100644
--- a/tools/coqdep/lib/common.ml
+++ b/tools/coqdep/lib/common.ml
@@ -12,7 +12,15 @@
     - 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 * string) list; map : string list CString.Map.t }
+
+let add_vAccu (f, f') vAccu =
+  let acc = (f, f') :: vAccu.acc in
+  let old = try CString.Map.find f' vAccu.map with Not_found -> [] in
+  let map = CString.Map.add f' (f :: old) vAccu.map in
+  { acc; map }
+
+let empty_vAccu = { acc = []; map = CString.Map.empty }
 
 let filename_concat ~separator_hack dir name =
   if separator_hack
@@ -28,9 +36,9 @@ let canonize ~separator_hack vAccu f =
       (Loadpath.absolute_dir (Filename.dirname f))
       (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 | Some [] -> f
+  | Some (f :: _) -> f
 
 type what = Library | External
 let str_of_what = function Library -> "library" | External -> "external file"
@@ -254,7 +262,7 @@ let rec find_dependencies ({State.vAccu; separator_hack; loadpath} as st) basena
 
 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
+  st.vAccu.acc |> CList.rev_map mk_dep
 
 let rec treat_file ~separator_hack vAccu old_dirname old_name =
   let name = Filename.basename old_name
@@ -289,7 +297,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 +331,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 name) vAccu.acc
 
 let add_include st (rc, r, ln) =
   if rc then
@@ -359,4 +367,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 }

From bc42269a1adef2df71de7f0e23a2b986bef12fe5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Fri, 6 Mar 2026 22:15:14 +0100
Subject: [PATCH 250/578] Correctly check retroknowledge in the checker.

The previous code was not checking anything, probably allowing
handcrafted proofs of False passing the checker. Since the kernel
does check retroknowledge, this would have required creating
malicious vo files. This is not easy but still a potential attack
vector.

While writing the patch, I discovered that it is legal to register
inductive types coming from a different, previous library. This
probably means that we can have weird diamond situations. I do not
even known if that makes sense and what we could do with that.
---
 checker/checkInductive.ml  |  12 +++--
 checker/checkInductive.mli |   4 +-
 checker/mod_checking.ml    | 101 +++++++++++++++++++++++++++++++++----
 checker/mod_checking.mli   |   4 +-
 checker/safe_checking.ml   |   3 +-
 kernel/safe_typing.ml      |   6 +--
 kernel/safe_typing.mli     |   1 +
 7 files changed, 110 insertions(+), 21 deletions(-)

diff --git a/checker/checkInductive.ml b/checker/checkInductive.ml
index a1c6e6b83f11..59c3c37cab88 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))
@@ -205,7 +207,7 @@ let check_packet mind ind
 
   ()
 
-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;
@@ -215,6 +217,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
@@ -243,8 +249,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/mod_checking.ml b/checker/mod_checking.ml
index 9004abfc4a8f..572667111fb5 100644
--- a/checker/mod_checking.ml
+++ b/checker/mod_checking.ml
@@ -8,12 +8,25 @@ open Environ
 
 (** {6 Checking constants } *)
 
+type opaques = Names.Cset.t Names.Cmap.t
+
+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 = Cmap.empty;
+  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
@@ -29,7 +42,7 @@ let register_opacified_constant env opac kn cb =
       (gather_consts Cset.empty cb)
       Cset.empty
   in
-  Cmap.add kn wo_body opac
+  { chkst with st_opaques = Cmap.add kn wo_body opac }
 
 exception BadConstant of Constant.t * Pp.t
 
@@ -76,17 +89,31 @@ 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
@@ -275,8 +302,8 @@ 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) Cset.empty in
   ()
 
 and check_structure_field env opac mp lab res opacify = function
@@ -287,7 +314,15 @@ and check_structure_field env opac mp lab res opacify = function
   | 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
@@ -312,8 +347,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 Cset.empty 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..1d83f6a70201 100644
--- a/checker/mod_checking.mli
+++ b/checker/mod_checking.mli
@@ -8,8 +8,10 @@
 (*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
+type opaques = Names.Cset.t Names.Cmap.t
+
 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
diff --git a/checker/safe_checking.ml b/checker/safe_checking.ml
index 8e41bedd1a5c..3f79d1aac84c 100644
--- a/checker/safe_checking.ml
+++ b/checker/safe_checking.ml
@@ -24,9 +24,8 @@ let import senv opac clib vmtab digest =
   let () = assert (Sorts.QVar.Set.for_all check_quality (fst qualities)) in
   let env = push_qualities ~rigid:true qualities env in
   let env = 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 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/kernel/safe_typing.ml b/kernel/safe_typing.ml
index 5b834ae8d8cf..c9395bbff9b3 100644
--- a/kernel/safe_typing.ml
+++ b/kernel/safe_typing.ml
@@ -1746,8 +1746,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
@@ -1856,7 +1855,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 f419ba3060ae..17e1422cf1d2 100644
--- a/kernel/safe_typing.mli
+++ b/kernel/safe_typing.mli
@@ -277,6 +277,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

From 6761516d8658d24d96b8d46c70fae3f8e5ac33e8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Wed, 18 Mar 2026 09:34:48 +0100
Subject: [PATCH 251/578] More efficient use of the lexer in rocq dep.

The rocqdep lexer is provided by ocamllex internals, and is quite
inefficient due to memory allocations and write barriers caused by
an unfortunate historical implementation. It cannot be easily changed
because of its API that leaks details that should have remained internal.
Yet in their infinite wisdom, the OCaml devs implemented a flag that
makes the lexer faster at the cost of not keeping the user-facing
locations.

Since we only use these locations for parsing error messages and that
these should be extremely rare in rocq dep invocations, we work around
this by parsing the file twice, first with the location-free algorithm
and then in case of error we reparse it a second time to get the
error location.

The slowness was actually clearly visible on large developments in the
order of 10k files. This patch makes rocqdep invocations about 30%
faster after #21765.
---
 tools/coqdep/lib/common.ml | 33 ++++++++++++++++++++++++++++++---
 1 file changed, 30 insertions(+), 3 deletions(-)

diff --git a/tools/coqdep/lib/common.ml b/tools/coqdep/lib/common.ml
index 0edf791f2220..49ed9118744a 100644
--- a/tools/coqdep/lib/common.ml
+++ b/tools/coqdep/lib/common.ml
@@ -151,6 +151,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 *)
@@ -174,14 +176,20 @@ 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
+  (* 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 = Lexing.from_channel ~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
@@ -252,6 +260,25 @@ 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

From 8bd419aef491c29b3985153451f60ff304eeedb2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Wed, 18 Mar 2026 13:16:47 +0100
Subject: [PATCH 252/578] overlay

---
 dev/ci/user-overlays/21760-SkySkimmer-simpl-indtypig.sh | 1 +
 1 file changed, 1 insertion(+)
 create mode 100644 dev/ci/user-overlays/21760-SkySkimmer-simpl-indtypig.sh

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

From 70eca980fd5de6fe725b37ba35533a5373b9a6de Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Tue, 17 Mar 2026 13:29:21 +0100
Subject: [PATCH 253/578] Simplify Reductionops.Infer sort handling

These functions would create sort pairs only to call Quality.equal on
them, we call Quality.equal directly instead.

This lets us remove is_impredicative_sort handling since qvar is never
Quality.equal to Prop/SProp.
---
 pretyping/reductionops.ml | 73 +++++++++------------------------------
 1 file changed, 17 insertions(+), 56 deletions(-)

diff --git a/pretyping/reductionops.ml b/pretyping/reductionops.ml
index 1730bb25e60e..d7fa36cdc60e 100644
--- a/pretyping/reductionops.ml
+++ b/pretyping/reductionops.ml
@@ -1670,54 +1670,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
 
@@ -1728,19 +1694,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 =

From 9390c86ea9879239c55cc5e5f10579117f1ebc8b Mon Sep 17 00:00:00 2001
From: Jason Gross <jgross@mit.edu>
Date: Mon, 16 Mar 2026 16:37:28 +0100
Subject: [PATCH 254/578] Add with_strategy tactic to Ltac2

Expose the with_strategy tactic (analogous to the Ltac1 version in
extratactics.mlg) in Ltac2 as TransparentState.with_strategy. This
allows temporarily changing the strategy level of constants during
tactic execution, with automatic restoration afterward.

Adds a strategy_level algebraic type (Expand | Opaque | Level of int)
to TransparentState and the corresponding FFI conversion for
Conv_oracle.level.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
---
 .../21762-ltac2-strategy-Added.rst            |  6 +++
 plugins/ltac2/tac2ffi.ml                      | 16 +++++++
 plugins/ltac2/tac2ffi.mli                     |  4 ++
 plugins/ltac2/tac2stdlib.ml                   |  5 ++
 plugins/ltac2/tac2tactics.ml                  |  3 ++
 plugins/ltac2/tac2tactics.mli                 |  2 +
 test-suite/ltac2/with_strategy.v              | 47 +++++++++++++++++++
 theories/Ltac2/TransparentState.v             | 20 ++++++++
 8 files changed, 103 insertions(+)
 create mode 100644 doc/changelog/06-Ltac2-language/21762-ltac2-strategy-Added.rst
 create mode 100644 test-suite/ltac2/with_strategy.v

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 <https://github.com/rocq-prover/rocq/pull/21762>`_,
+  by Jason Gross).
diff --git a/plugins/ltac2/tac2ffi.ml b/plugins/ltac2/tac2ffi.ml
index b4c3679d0af1..988d066a31d0 100644
--- a/plugins/ltac2/tac2ffi.ml
+++ b/plugins/ltac2/tac2ffi.ml
@@ -500,6 +500,22 @@ let 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", [||])
 
diff --git a/plugins/ltac2/tac2ffi.mli b/plugins/ltac2/tac2ffi.mli
index dab0e6f0f1bd..b1cb92371fb0 100644
--- a/plugins/ltac2/tac2ffi.mli
+++ b/plugins/ltac2/tac2ffi.mli
@@ -222,6 +222,10 @@ 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
diff --git a/plugins/ltac2/tac2stdlib.ml b/plugins/ltac2/tac2stdlib.ml
index c90c57a08a5e..0fa26c581a20 100644
--- a/plugins/ltac2/tac2stdlib.ml
+++ b/plugins/ltac2/tac2stdlib.ml
@@ -824,6 +824,11 @@ let () =
     (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]). *)
 
 let to_conv_pb v = match Tac2ffi.to_int v with
diff --git a/plugins/ltac2/tac2tactics.ml b/plugins/ltac2/tac2tactics.ml
index 23ca11cb2e29..29e79d142628 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 =
diff --git a/plugins/ltac2/tac2tactics.mli b/plugins/ltac2/tac2tactics.mli
index 6854b4058394..563dd8f3e01c 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 -> unit thunk -> unit tactic
+
 (** Internal *)
 
 val mk_intro_pattern : intro_pattern -> Tactypes.intro_pattern
diff --git a/test-suite/ltac2/with_strategy.v b/test-suite/ltac2/with_strategy.v
new file mode 100644
index 000000000000..4ed664f79f5d
--- /dev/null
+++ b/test-suite/ltac2/with_strategy.v
@@ -0,0 +1,47 @@
+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.
diff --git a/theories/Ltac2/TransparentState.v b/theories/Ltac2/TransparentState.v
index dec7da365743..420be95fe6e0 100644
--- a/theories/Ltac2/TransparentState.v
+++ b/theories/Ltac2/TransparentState.v
@@ -9,11 +9,23 @@
 (************************************************************************)
 
 Require Import Ltac2.Init.
+Require Import Ltac2.Std.
 
 (** 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".
@@ -86,3 +98,11 @@ Ltac2 @ external mem_proj : projection -> t -> bool :=
     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".

From 05b38ad9a9260814c71507f0eb3ec20afb002751 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Wed, 18 Mar 2026 14:22:22 +0100
Subject: [PATCH 255/578] Fix build

---
 plugins/ltac2/tac2tactics.mli | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/plugins/ltac2/tac2tactics.mli b/plugins/ltac2/tac2tactics.mli
index 563dd8f3e01c..6e0bb2618176 100644
--- a/plugins/ltac2/tac2tactics.mli
+++ b/plugins/ltac2/tac2tactics.mli
@@ -122,7 +122,7 @@ 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 -> unit thunk -> unit tactic
+val with_strategy : Conv_oracle.level -> GlobRef.t list -> 'a thunk -> 'a tactic
 
 (** Internal *)
 

From 74ef59d6e65943ef3fca316272f2d7158a81c2ec Mon Sep 17 00:00:00 2001
From: Jason Gross <jgross@mit.edu>
Date: Wed, 18 Mar 2026 14:35:52 +0100
Subject: [PATCH 256/578] Track inductives that depend on indices not mattering

Add mind_indices_matter field to one_inductive_body that records whether
an inductive relies on indices not mattering (i.e., would change behavior
under -indices-matter). This is detected by always running
check_context_univs on indices and checking if the result differs from
the input univ_info via physical equality on ind_squashed and missing.
When -indices-matter is active the field is false since the constraints
are enforced.

Print Assumptions now reports "relies on indices not mattering" for
inductives where indices_matter is false but indices would contribute.
coqchk similarly reports these in its context summary.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
---
 checker/checkInductive.ml                     |  8 +++-
 checker/check_stat.ml                         | 11 +++++-
 checker/values.ml                             |  1 +
 .../21774-track-indices-matter-Added.rst      |  6 +++
 doc/sphinx/language/core/inductive.rst        |  4 +-
 .../proof-engine/vernacular-commands.rst      |  5 +++
 kernel/declarations.mli                       |  4 ++
 kernel/declareops.ml                          |  1 +
 kernel/discharge.ml                           |  1 +
 kernel/indTyping.ml                           | 37 +++++++++++++------
 kernel/indTyping.mli                          |  3 +-
 kernel/indtypes.ml                            |  7 ++--
 printing/printer.ml                           |  8 +++-
 printing/printer.mli                          |  1 +
 test-suite/output-coqchk/bug_12845.out        |  4 ++
 test-suite/output-coqchk/bug_13324.out        |  4 ++
 test-suite/output-coqchk/bug_5030.out         |  4 ++
 test-suite/output-coqchk/indices_matter.out   | 21 +++++++++++
 test-suite/output-coqchk/indices_matter.v     | 13 +++++++
 test-suite/output/indices_matter.out          |  2 +
 test-suite/output/indices_matter.v            |  4 ++
 .../prerequisite/indices_matter_prereq.v      | 13 +++++++
 vernac/assumptions.ml                         |  7 ++++
 23 files changed, 150 insertions(+), 19 deletions(-)
 create mode 100644 doc/changelog/01-kernel/21774-track-indices-matter-Added.rst
 create mode 100644 test-suite/output-coqchk/indices_matter.out
 create mode 100644 test-suite/output-coqchk/indices_matter.v
 create mode 100644 test-suite/output/indices_matter.out
 create mode 100644 test-suite/output/indices_matter.v
 create mode 100644 test-suite/prerequisite/indices_matter_prereq.v

diff --git a/checker/checkInductive.ml b/checker/checkInductive.ml
index a1c6e6b83f11..be6821e9515b 100644
--- a/checker/checkInductive.ml
+++ b/checker/checkInductive.ml
@@ -173,7 +173,7 @@ 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_automaton; mind_relevance;
-      mind_nb_constant; mind_nb_args; mind_reloc_tbl } =
+      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 *)
@@ -199,6 +199,12 @@ let check_packet mind ind
 
   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);
diff --git a/checker/check_stat.ml b/checker/check_stat.ml
index e4bf1a999376..ddb6800e3de0 100644
--- a/checker/check_stat.ml
+++ b/checker/check_stat.ml
@@ -62,6 +62,14 @@ 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 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 =
   if !output_context then begin
     Feedback.msg_notice
@@ -73,7 +81,8 @@ let print_context env opac =
       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()))
+      str "* " ++ hov 0 (pr_nonpositive env ++ fnl()) ++ fnl() ++
+      str "* " ++ hov 0 (pr_indices_matter env ++ fnl()))
       )
   end
 
diff --git a/checker/values.ml b/checker/values.ml
index fbf3274d5ff2..820fc300c16c 100644
--- a/checker/values.ml
+++ b/checker/values.ml
@@ -464,6 +464,7 @@ let v_one_ind = v_tuple "one_inductive_body"
     v_wfp;
     v_automaton;
     v_relevance;
+    v_bool;
     v_int;
     v_int;
     v_vm_reloc_table|]
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 <https://github.com/rocq-prover/rocq/pull/21774>`_,
+  by Jason Gross).
diff --git a/doc/sphinx/language/core/inductive.rst b/doc/sphinx/language/core/inductive.rst
index 00bca1b0b1ae..feecbfbd6d8c 100644
--- a/doc/sphinx/language/core/inductive.rst
+++ b/doc/sphinx/language/core/inductive.rst
@@ -914,7 +914,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` was used, for each index the universe of its type must be smaller than :math:`s_j`.
+  When `-indices-matter` is not 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/proof-engine/vernacular-commands.rst b/doc/sphinx/proof-engine/vernacular-commands.rst
index e61401feab48..eaae608a8bb6 100644
--- a/doc/sphinx/proof-engine/vernacular-commands.rst
+++ b/doc/sphinx/proof-engine/vernacular-commands.rst
@@ -433,6 +433,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`),
+   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.
diff --git a/kernel/declarations.mli b/kernel/declarations.mli
index 02b5b0e2a9fe..387792e14817 100644
--- a/kernel/declarations.mli
+++ b/kernel/declarations.mli
@@ -255,6 +255,10 @@ type one_inductive_body = {
     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 *)
diff --git a/kernel/declareops.ml b/kernel/declareops.ml
index 7dab6c0dca99..d1361c8abede 100644
--- a/kernel/declareops.ml
+++ b/kernel/declareops.ml
@@ -251,6 +251,7 @@ let subst_mind_packet subst mbp =
     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 }
diff --git a/kernel/discharge.ml b/kernel/discharge.ml
index 466a76bb9681..89e1bb95f318 100644
--- a/kernel/discharge.ml
+++ b/kernel/discharge.ml
@@ -158,6 +158,7 @@ let cook_one_ind info cache ~params ~ntypes mip =
     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/indTyping.ml b/kernel/indTyping.ml
index 72c644c19b56..6f1b3b4c6f17 100644
--- a/kernel/indTyping.ml
+++ b/kernel/indTyping.ml
@@ -150,9 +150,24 @@ 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 =
@@ -166,7 +181,6 @@ 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
@@ -180,7 +194,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 =
@@ -214,7 +228,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
 
@@ -229,7 +244,7 @@ end
 (* Checks whether the record can have primitive projections, and if so, whether it has eta *)
 let check_record 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 *)
@@ -494,7 +509,7 @@ let get_template (mie:mutual_inductive_entry) = match mie.mind_entry_universes w
     template_defaults = default_univs;
   }
 
-let abstract_packets env usubst ((arity,lc),(indices,splayed_lc),univ_info) =
+let abstract_packets env usubst ((arity,lc),(indices,splayed_lc),univ_info,relies_on_indices_not_mattering) =
   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
@@ -522,7 +537,7 @@ let abstract_packets env usubst ((arity,lc),(indices,splayed_lc),univ_info) =
       univ_info.ind_squashed
   in
 
-  (arity,lc), (indices,splayed_lc), squashed
+  (arity,lc), (indices,splayed_lc), squashed, relies_on_indices_not_mattering
 
 let typecheck_inductive env ~sec_univs (mie:mutual_inductive_entry) =
   let () = match mie.mind_entry_inds with
@@ -565,7 +580,7 @@ let typecheck_inductive env ~sec_univs (mie:mutual_inductive_entry) =
     | Some None | None -> false
   in
   let data = List.map2 (fun ind data ->
-      check_constructors env_ar_par isrecord params ind.mind_entry_lc data)
+      check_constructors ~env_params ~env_ar_par isrecord params ind.mind_entry_lc data)
       mie.mind_entry_inds data
   in
 
@@ -579,8 +594,8 @@ let typecheck_inductive env ~sec_univs (mie:mutual_inductive_entry) =
       | 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)
+        let data = List.map (fun (a, b, univs, im) ->
+            a, b, compute_elim_squash env_ar_par Sorts.prop univs, im)
             data
         in
         data, Some None, Some reason (* back to FakeRecord with a reason why *)
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 efafbf9c066a..00240f6a54d4 100644
--- a/kernel/indtypes.ml
+++ b/kernel/indtypes.ml
@@ -426,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
 
@@ -503,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 =
@@ -564,6 +564,7 @@ let build_inductive env ~sec_univs names prv univs template variance
         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;
@@ -614,7 +615,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/printing/printer.ml b/printing/printer.ml
index 228bc269085f..5c8deab93e8e 100644
--- a/printing/printer.ml
+++ b/printing/printer.ml
@@ -1098,6 +1098,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 +1116,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 +1130,8 @@ struct
     | _, Guarded _ -> 1
     | TypeInType _, _ -> -1
     | _, TypeInType _ -> 1
+    | UIP _, _ -> -1
+    | _, UIP _ -> 1
 
   let compare x y =
     match x , y with
@@ -1192,6 +1196,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 e88e6caba771..15d6fc373cd6 100644
--- a/printing/printer.mli
+++ b/printing/printer.mli
@@ -251,6 +251,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/test-suite/output-coqchk/bug_12845.out b/test-suite/output-coqchk/bug_12845.out
index d07158c23215..7e708b998cbd 100644
--- a/test-suite/output-coqchk/bug_12845.out
+++ b/test-suite/output-coqchk/bug_12845.out
@@ -14,3 +14,7 @@ CONTEXT SUMMARY
   
 * Inductives whose positivity is assumed: <none>
   
+* Inductives relying on indices not mattering:
+    Corelib.Init.Datatypes.eq_true
+    Corelib.Init.Logic.eq
+  
diff --git a/test-suite/output-coqchk/bug_13324.out b/test-suite/output-coqchk/bug_13324.out
index d07158c23215..7e708b998cbd 100644
--- a/test-suite/output-coqchk/bug_13324.out
+++ b/test-suite/output-coqchk/bug_13324.out
@@ -14,3 +14,7 @@ CONTEXT SUMMARY
   
 * Inductives whose positivity is assumed: <none>
   
+* Inductives relying on indices not mattering:
+    Corelib.Init.Datatypes.eq_true
+    Corelib.Init.Logic.eq
+  
diff --git a/test-suite/output-coqchk/bug_5030.out b/test-suite/output-coqchk/bug_5030.out
index d07158c23215..7e708b998cbd 100644
--- a/test-suite/output-coqchk/bug_5030.out
+++ b/test-suite/output-coqchk/bug_5030.out
@@ -14,3 +14,7 @@ CONTEXT SUMMARY
   
 * Inductives whose positivity is assumed: <none>
   
+* Inductives relying on indices not mattering:
+    Corelib.Init.Datatypes.eq_true
+    Corelib.Init.Logic.eq
+  
diff --git a/test-suite/output-coqchk/indices_matter.out b/test-suite/output-coqchk/indices_matter.out
new file mode 100644
index 000000000000..6a00fb15bb04
--- /dev/null
+++ b/test-suite/output-coqchk/indices_matter.out
@@ -0,0 +1,21 @@
+
+CONTEXT SUMMARY
+===============
+
+* Theory: Set is predicative
+  
+* Theory: Rewrite rules are not allowed
+  
+* Axioms: <none>
+  
+* Constants/Inductives relying on type-in-type: <none>
+  
+* Constants/Inductives relying on unsafe (co)fixpoints: <none>
+  
+* Inductives whose positivity is assumed: <none>
+  
+* Inductives relying on indices not mattering:
+    Corelib.Init.Datatypes.eq_true
+    indices_matter.M.X
+    Corelib.Init.Logic.eq
+  
diff --git a/test-suite/output-coqchk/indices_matter.v b/test-suite/output-coqchk/indices_matter.v
new file mode 100644
index 000000000000..c5d1d29b2215
--- /dev/null
+++ b/test-suite/output-coqchk/indices_matter.v
@@ -0,0 +1,13 @@
+Module Type T.
+  Parameter T : Type.
+End T.
+
+Module F(A:T).
+  Inductive X : A.T -> Prop := .
+End F.
+
+Module A.
+  Definition T := True.
+End A.
+
+Module M := F A.
diff --git a/test-suite/output/indices_matter.out b/test-suite/output/indices_matter.out
new file mode 100644
index 000000000000..72dd0b80a73d
--- /dev/null
+++ b/test-suite/output/indices_matter.out
@@ -0,0 +1,2 @@
+Axioms:
+M.X relies on indices not mattering.
diff --git a/test-suite/output/indices_matter.v b/test-suite/output/indices_matter.v
new file mode 100644
index 000000000000..62058aa614ab
--- /dev/null
+++ b/test-suite/output/indices_matter.v
@@ -0,0 +1,4 @@
+(* -*- coq-prog-args: ("-indices-matter"); -*- *)
+Require Import TestSuite.indices_matter_prereq.
+
+Print Assumptions M.X.
diff --git a/test-suite/prerequisite/indices_matter_prereq.v b/test-suite/prerequisite/indices_matter_prereq.v
new file mode 100644
index 000000000000..c5d1d29b2215
--- /dev/null
+++ b/test-suite/prerequisite/indices_matter_prereq.v
@@ -0,0 +1,13 @@
+Module Type T.
+  Parameter T : Type.
+End T.
+
+Module F(A:T).
+  Inductive X : A.T -> Prop := .
+End F.
+
+Module A.
+  Definition T := True.
+End A.
+
+Module M := F A.
diff --git a/vernac/assumptions.ml b/vernac/assumptions.ml
index 8209d698a631..9fb173e66401 100644
--- a/vernac/assumptions.ml
+++ b/vernac/assumptions.ml
@@ -423,5 +423,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

From 7d2a2a83c2a6e112b492532d9045afb9a42dcc8e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Wed, 18 Mar 2026 18:11:05 +0100
Subject: [PATCH 257/578] Remove unused argument of reflect0 in logic_monad

I wonder if not using this argument is actually a bug?
---
 engine/logic_monad.ml | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/engine/logic_monad.ml b/engine/logic_monad.ml
index e4c597f9472d..7356bd08ba04 100644
--- a/engine/logic_monad.ml
+++ b/engine/logic_monad.ml
@@ -259,14 +259,14 @@ struct
   type ('a, 'e) reified = ('a, ('a, 'e) reified_, 'e) list_view_
   and ('a, 'e) reified_ = {r : 'e -> ('a, 'e) reified} [@@unboxed]
 
-  let rec reflect0 : type r. _ -> _ -> _ -> (_ -> r) -> (_ -> _ -> (_ -> r) -> r) -> r =
-    fun e m s0 nil cons ->
+  let rec reflect0 : type r. _ -> _ -> (_ -> r) -> (_ -> _ -> (_ -> r) -> r) -> r =
+    fun e m nil cons ->
       match m e with
       | Nil e -> nil e
-      | Cons ((x, s), {r=l}) -> cons x s (fun e -> reflect0 e l s0 nil cons)
+      | Cons ((x, s), {r=l}) -> cons x s (fun e -> reflect0 e l nil cons)
 
   let reflect (e : 'e) (m : 'e -> ('a * 'o, 'e) reified) =
-    { iolist = fun s0 nil cons -> reflect0 e m s0 nil cons }
+    { iolist = fun _ nil cons -> reflect0 e m nil cons }
 
   let split m : (_ list_view, _, _, _) t =
     let rnil e = Nil e in

From f9ad5658d77e564dba5748feb6749c4735234001 Mon Sep 17 00:00:00 2001
From: Pierre Roux <pierre.roux@onera.fr>
Date: Thu, 19 Mar 2026 13:16:54 +0100
Subject: [PATCH 258/578] [CI] MetaRocq now depends on ExtLib

---
 .gitlab-ci.yml | 1 +
 Makefile.ci    | 2 +-
 2 files changed, 2 insertions(+), 1 deletion(-)

diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
index 2560f0f8ff32..cb6971793b07 100644
--- a/.gitlab-ci.yml
+++ b/.gitlab-ci.yml
@@ -1202,6 +1202,7 @@ plugin:ci-metarocq:
   - build:edge+flambda
   - library:ci-stdlib+flambda
   - plugin:ci-equations
+  - library:ci-ext_lib
   stage: build-2
   timeout: 1h 30min
 
diff --git a/Makefile.ci b/Makefile.ci
index 8cc4d67c17ce..46933008afdf 100644
--- a/Makefile.ci
+++ b/Makefile.ci
@@ -221,7 +221,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
 

From c118c0100f7ff77f10f63ab227546c60543d7f5f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Thu, 19 Mar 2026 15:33:53 +0100
Subject: [PATCH 259/578] Add test for Ltac2 with_strategy at non unit type

---
 test-suite/ltac2/with_strategy.v | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/test-suite/ltac2/with_strategy.v b/test-suite/ltac2/with_strategy.v
index 4ed664f79f5d..84a4c0a96c05 100644
--- a/test-suite/ltac2/with_strategy.v
+++ b/test-suite/ltac2/with_strategy.v
@@ -45,3 +45,6 @@ Goal myid 0 = 0.
   unfold_myid ().
   reflexivity.
 Qed.
+
+(* test that returning non unit works *)
+Ltac2 Eval TransparentState.with_strategy TransparentState.Expand [] (fun () => Some 1).

From 010dc1b3b18542fb98a5e5e032b3166a0be8edd8 Mon Sep 17 00:00:00 2001
From: Yann Leray <yann.leray@inria.fr>
Date: Thu, 19 Mar 2026 23:00:31 +0100
Subject: [PATCH 260/578] Preserve backtrace for retyping anomalies

---
 pretyping/retyping.ml | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/pretyping/retyping.ml b/pretyping/retyping.ml
index 89532ca0ec26..408e0d941bf1 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

From 66a821a0bcf47919030fbb1d10ba9e8e2a186119 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Wed, 11 Mar 2026 14:41:10 +0100
Subject: [PATCH 261/578] Correctly return side-effects constraints in
 Subproof.build_by_tactic.

---
 proofs/subproof.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/proofs/subproof.ml b/proofs/subproof.ml
index c128ae9e081b..dc6d86335e14 100644
--- a/proofs/subproof.ml
+++ b/proofs/subproof.ml
@@ -145,7 +145,7 @@ 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_set ~sideff:true Evd.univ_rigid uctx ctx in
+  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 =

From 86cd2d3b29e430e26ddab1eaefbd0c8559fbe418 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Fri, 27 Feb 2026 13:54:51 +0100
Subject: [PATCH 262/578] Stop inlining abstracted subproofs in tactics in
 terms.

Fixes #7905: abstract in tactics in terms should not inline.
---
 proofs/subproof.ml  | 34 ++++++++++++++++++++--------------
 proofs/subproof.mli | 10 ++++++----
 2 files changed, 26 insertions(+), 18 deletions(-)

diff --git a/proofs/subproof.ml b/proofs/subproof.ml
index dc6d86335e14..bfda50273d2a 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 *)
diff --git a/proofs/subproof.mli b/proofs/subproof.mli
index 28a22efc6971..092a77f4fed4 100644
--- a/proofs/subproof.mli
+++ b/proofs/subproof.mli
@@ -11,16 +11,18 @@
 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 ->

From cd45d51bb6292e2df065adf39990d9690d9dcdb5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Fri, 13 Mar 2026 11:10:25 +0100
Subject: [PATCH 263/578] Correctly compute abstracted names when nesting term
 quotations.

The previous code was computing the fresh name at the wrong time, i.e.
before the inner quotation, which could have generated new abstracted
lemmas. This resulted in a clash.
---
 engine/evd.ml                 | 5 +++++
 engine/evd.mli                | 2 ++
 proofs/subproof.ml            | 2 ++
 test-suite/bugs/bug_21676_1.v | 1 +
 4 files changed, 10 insertions(+)
 create mode 100644 test-suite/bugs/bug_21676_1.v

diff --git a/engine/evd.ml b/engine/evd.ml
index bb675f50d72a..43a232505e5f 100644
--- a/engine/evd.ml
+++ b/engine/evd.ml
@@ -1290,6 +1290,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
 
diff --git a/engine/evd.mli b/engine/evd.mli
index e3a894c45df4..e60036f2553b 100644
--- a/engine/evd.mli
+++ b/engine/evd.mli
@@ -413,6 +413,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
diff --git a/proofs/subproof.ml b/proofs/subproof.ml
index bfda50273d2a..807bd43f37c5 100644
--- a/proofs/subproof.ml
+++ b/proofs/subproof.ml
@@ -165,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/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)).

From 6ba6b54fb6cbe46bfe991035fa0188b571a9ee6b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Fri, 13 Mar 2026 11:22:52 +0100
Subject: [PATCH 264/578] Fix Check universe bug with abstract.

It is not clear to me that the fix is really correct but at least it
behaves more nicely on the issue test.
---
 test-suite/bugs/bug_21676_2.v | 1 +
 vernac/vernacentries.ml       | 6 +++---
 2 files changed, 4 insertions(+), 3 deletions(-)
 create mode 100644 test-suite/bugs/bug_21676_2.v

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/vernac/vernacentries.ml b/vernac/vernacentries.ml
index 7d6f7363f93c..aacb7e698a99 100644
--- a/vernac/vernacentries.ml
+++ b/vernac/vernacentries.ml
@@ -2114,10 +2114,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

From ac72cffd28a4c9e935a4e3a238beed1055e54024 Mon Sep 17 00:00:00 2001
From: Enrico Tassi <Enrico.Tassi@Inria.fr>
Date: Thu, 19 Mar 2026 09:24:48 +0100
Subject: [PATCH 265/578] [ci] use elpi 3.6.2

---
 .gitlab-ci.yml                       | 2 +-
 dev/ci/docker/edge_ubuntu/Dockerfile | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
index cb6971793b07..542c27b9d6f6 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-V2026-03-04-d4fe8f0464"
+  EDGE_CACHEKEY: "edge_ubuntu-V2026-03-19-ac6c1c9705"
   BASE_IMAGE: "$CI_REGISTRY_IMAGE:$BASE_CACHEKEY"
   EDGE_IMAGE: "$CI_REGISTRY_IMAGE:$EDGE_CACHEKEY"
 
diff --git a/dev/ci/docker/edge_ubuntu/Dockerfile b/dev/ci/docker/edge_ubuntu/Dockerfile
index b8f6a7422103..35c17d233dc3 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.6.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="elpi.3.6.2 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

From 7811a348fb6f067c5379cc9b5d329582f5eeb538 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Fri, 27 Feb 2026 16:02:09 +0100
Subject: [PATCH 266/578] wit_tactic top type is tacvalue

---
 .../21680-SkySkimmer-wit-tac-value.sh         |   9 ++
 plugins/ltac/coretactics.mlg                  |   2 +-
 plugins/ltac/extraargs.mlg                    |   6 +-
 plugins/ltac/extraargs.mli                    |   2 +-
 plugins/ltac/extratactics.mlg                 |   2 +-
 plugins/ltac/internals.mli                    |   4 +-
 plugins/ltac/pptactic.ml                      |  22 +++-
 plugins/ltac/pptactic.mli                     |   6 +-
 plugins/ltac/tacarg.ml                        |  15 ++-
 plugins/ltac/tacarg.mli                       |  14 +-
 plugins/ltac/taccoerce.ml                     |  30 +----
 plugins/ltac/taccoerce.mli                    |  15 +--
 plugins/ltac/tacinterp.ml                     | 121 +++++++++---------
 plugins/ltac/tacinterp.mli                    |   8 +-
 plugins/ltac/tauto.ml                         |   4 +
 plugins/ltac2_ltac1/tac2core_ltac1.ml         |   2 +-
 plugins/micromega/zify.ml                     |   2 +-
 plugins/micromega/zify.mli                    |   2 +-
 plugins/ring/ring.ml                          |   4 +-
 plugins/ring/ring.mli                         |   4 +-
 plugins/ssr/ssrcommon.mli                     |   2 +-
 plugins/ssr/ssrfwd.mli                        |   8 +-
 plugins/ssr/ssrparser.mli                     |  26 ++--
 plugins/ssr/ssrtacs.mli                       |   2 +-
 plugins/ssr/ssrtacticals.mli                  |  10 +-
 test-suite/output/InvalidDisjunctiveIntro.out |   6 +-
 test-suite/output/bug6404.out                 |   3 +-
 27 files changed, 178 insertions(+), 153 deletions(-)
 create mode 100644 dev/ci/user-overlays/21680-SkySkimmer-wit-tac-value.sh

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/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/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..1871e9eaf1c5 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))
diff --git a/plugins/ltac/internals.mli b/plugins/ltac/internals.mli
index 4bd96aba258f..009901c9bf4c 100644
--- a/plugins/ltac/internals.mli
+++ b/plugins/ltac/internals.mli
@@ -30,7 +30,7 @@ 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
+  Locus.clause -> Tacarg.tacvalue option -> unit tactic
 val replace_term : Tacinterp.interp_sign -> bool option -> closed_glob_constr ->
   Locus.clause -> unit tactic
 
@@ -51,7 +51,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
 
diff --git a/plugins/ltac/pptactic.ml b/plugins/ltac/pptactic.ml
index 22e0aea6f7d9..05dc9b021639 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) =
@@ -1400,9 +1400,25 @@ let () =
   register_basic_print0 Stdarg.wit_pre_ident str str str;
   register_basic_print0 Stdarg.wit_string qstring qstring qstring
 
+let pr_tacvalue env = function
+  | 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 " := " ++ pr_value ltop c ++ pp)
+          ids (mt ())
+    in
+    v 0 (hov 0 (pr_glob_tactic env tac) ++ pr_env env)
+  | VRec _ -> str "<tactic closure>"
+
 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 _ _ _ _ = pr_tacvalue env in
+  declare_extra_genarg_pprule_with_level wit_tactic printer printer top_print
   ltop (LevelLe 0)
 
 let () =
diff --git a/plugins/ltac/pptactic.mli b/plugins/ltac/pptactic.mli
index a93dfb56324a..9300abee9b7d 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
diff --git a/plugins/ltac/tacarg.ml b/plugins/ltac/tacarg.ml
index ac98e78cacb1..36ccf600dfe9 100644
--- a/plugins/ltac/tacarg.ml
+++ b/plugins/ltac/tacarg.ml
@@ -13,6 +13,7 @@
 open Genarg
 open Geninterp
 open Tacexpr
+open Names
 
 let make0 ?dyn name =
   let wit = Genarg.make0 name in
@@ -27,7 +28,19 @@ 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 =
+
+(** 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 =
+  | 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
+
+let wit_tactic : (raw_tactic_expr, glob_tactic_expr, tacvalue) genarg_type =
   make0 "tactic"
 
 let wit_ltac_in_term = GenConstr.create "ltac_in_term"
diff --git a/plugins/ltac/tacarg.mli b/plugins/ltac/tacarg.mli
index cac63bb86dc5..c7db853396b4 100644
--- a/plugins/ltac/tacarg.mli
+++ b/plugins/ltac/tacarg.mli
@@ -14,6 +14,7 @@ open Constrexpr
 open Genintern
 open Tactypes
 open Tacexpr
+open Names
 
 (** Tactic related witnesses, could also live in tactics/ if other users *)
 
@@ -42,7 +43,18 @@ 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
+(** 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 =
+  | 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
+
+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
 
diff --git a/plugins/ltac/taccoerce.ml b/plugins/ltac/taccoerce.ml
index feef6ed741bd..e7f1a914e234 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 "<tactic closure>") 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
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/tacinterp.ml b/plugins/ltac/tacinterp.ml
index 59af118cb231..4c285cc222ed 100644
--- a/plugins/ltac/tacinterp.ml
+++ b/plugins/ltac/tacinterp.ml
@@ -1252,7 +1252,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 *)
@@ -1270,7 +1270,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) ->
@@ -1443,61 +1443,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
@@ -1505,6 +1454,53 @@ 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 = function
+  | 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. *)
@@ -1655,7 +1651,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 =
@@ -2003,8 +1999,11 @@ module Value = struct
 
   include Taccoerce.Value
 
+  let closure ist tac =
+    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 =
@@ -2014,17 +2013,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
 
@@ -2159,7 +2158,7 @@ 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 () =
diff --git a/plugins/ltac/tacinterp.mli b/plugins/ltac/tacinterp.mli
index 6342c33a2ae7..ff39394f29c8 100644
--- a/plugins/ltac/tacinterp.mli
+++ b/plugins/ltac/tacinterp.mli
@@ -34,10 +34,11 @@ sig
   val of_int : int -> t
   val to_int : t -> int option
   val to_list : t -> t list option
+  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 *)
@@ -117,7 +118,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 *)
 
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_ltac1/tac2core_ltac1.ml b/plugins/ltac2_ltac1/tac2core_ltac1.ml
index e70b4d67e591..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 ->
diff --git a/plugins/micromega/zify.ml b/plugins/micromega/zify.ml
index 77a4efdd0746..c5f259e08378 100644
--- a/plugins/micromega/zify.ml
+++ b/plugins/micromega/zify.ml
@@ -1432,7 +1432,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)
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/ring/ring.ml b/plugins/ring/ring.ml
index 16f4634155ab..942585fd0be6 100644
--- a/plugins/ring/ring.ml
+++ b/plugins/ring/ring.ml
@@ -688,7 +688,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
@@ -967,7 +967,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/ssr/ssrcommon.mli b/plugins/ssr/ssrcommon.mli
index 979ae0985678..eb0de8cda3d8 100644
--- a/plugins/ssr/ssrcommon.mli
+++ b/plugins/ssr/ssrcommon.mli
@@ -157,7 +157,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/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/ssrparser.mli b/plugins/ssr/ssrparser.mli
index 8a69a80558d7..a1d177156e4a 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
@@ -267,13 +267,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 +282,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.mli b/plugins/ssr/ssrtacs.mli
index 57cd2e1b3b97..4069c40ae277 100644
--- a/plugins/ssr/ssrtacs.mli
+++ b/plugins/ssr/ssrtacs.mli
@@ -17,7 +17,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/test-suite/output/InvalidDisjunctiveIntro.out b/test-suite/output/InvalidDisjunctiveIntro.out
index 277062e50c3b..361aac6f2365 100644
--- a/test-suite/output/InvalidDisjunctiveIntro.out
+++ b/test-suite/output/InvalidDisjunctiveIntro.out
@@ -12,12 +12,12 @@ The command has indeed failed with message:
 Cannot coerce to a disjunctive/conjunctive pattern.
 File "./output/InvalidDisjunctiveIntro.v", line 10, characters 32-33:
 The command has indeed failed with message:
-Ltac variable H is bound to idtac of type tacvalue which cannot be coerced to
+Ltac variable H is bound to idtac of type tactic which cannot be coerced to
 an introduction pattern.
 File "./output/InvalidDisjunctiveIntro.v", line 13, characters 2-52:
 The command has indeed failed with message:
 Disjunctive/conjunctive introduction pattern expected.
 File "./output/InvalidDisjunctiveIntro.v", line 15, characters 50-52:
 The command has indeed failed with message:
-Ltac variable H' is bound to idtac of type tacvalue which cannot be coerced
-to an introduction pattern.
+Ltac variable H' is bound to idtac of type tactic which cannot be coerced to
+an introduction pattern.
diff --git a/test-suite/output/bug6404.out b/test-suite/output/bug6404.out
index 9940f3202091..b57b9934e88f 100644
--- a/test-suite/output/bug6404.out
+++ b/test-suite/output/bug6404.out
@@ -3,5 +3,6 @@ The command has indeed failed with message:
 The term "I" has type "True"
 which should be Set, Prop or Type.
 In nested Ltac calls to "c", "abs", "transparent_abstract (tactic3)", 
-"b", "a", "pose (I : I)" and "(I : I)", last term evaluation failed.
+"$1" (bound to b ltac:(())), "b", "a", "pose (I : I)" and 
+"(I : I)", last term evaluation failed.
 

From 86b455aba2afd231709e2decfaa6dea126532ca1 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Thu, 5 Mar 2026 17:49:28 +0100
Subject: [PATCH 267/578] Hide definition of tacvalue in tacinterp

---
 plugins/ltac/pptactic.ml  | 23 +++++-------
 plugins/ltac/pptactic.mli |  4 +++
 plugins/ltac/tacarg.ml    | 29 +++++++++-------
 plugins/ltac/tacarg.mli   | 17 ++++-----
 plugins/ltac/tacinterp.ml | 73 +++++++++++++++++++++++++++++----------
 5 files changed, 89 insertions(+), 57 deletions(-)

diff --git a/plugins/ltac/pptactic.ml b/plugins/ltac/pptactic.ml
index 05dc9b021639..46a68fa762e7 100644
--- a/plugins/ltac/pptactic.ml
+++ b/plugins/ltac/pptactic.ml
@@ -1400,24 +1400,13 @@ let () =
   register_basic_print0 Stdarg.wit_pre_ident str str str;
   register_basic_print0 Stdarg.wit_string qstring qstring qstring
 
-let pr_tacvalue env = function
-  | 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 " := " ++ pr_value ltop c ++ pp)
-          ids (mt ())
-    in
-    v 0 (hov 0 (pr_glob_tactic env tac) ++ pr_env env)
-  | VRec _ -> str "<tactic closure>"
+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
-  let top_print env sigma _ _ _ _ = pr_tacvalue env in
+  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)
 
@@ -1451,3 +1440,7 @@ let () =
   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 9300abee9b7d..0f7602d255bb 100644
--- a/plugins/ltac/pptactic.mli
+++ b/plugins/ltac/pptactic.mli
@@ -165,3 +165,7 @@ val make_constr_printer : (env -> Evd.evar_map -> entry_relative_level -> 'a ->
   'a Genprint.top_printer
 
 val ssr_loaded : unit -> bool
+
+module Internal : sig
+  val pr_tacvalue_ref : (env -> Tacarg.tacvalue -> Pp.t) ref
+end
diff --git a/plugins/ltac/tacarg.ml b/plugins/ltac/tacarg.ml
index 36ccf600dfe9..aaf285cef808 100644
--- a/plugins/ltac/tacarg.ml
+++ b/plugins/ltac/tacarg.ml
@@ -13,7 +13,6 @@
 open Genarg
 open Geninterp
 open Tacexpr
-open Names
 
 let make0 ?dyn name =
   let wit = Genarg.make0 name in
@@ -28,17 +27,8 @@ let wit_open_constr_with_bindings = make0 "open_constr_with_bindings"
 let wit_bindings = make0 "bindings"
 let wit_quantified_hypothesis = wit_quant_hyp
 
-
-(** 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 =
-  | 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
+(* 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"
@@ -49,3 +39,18 @@ 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 c7db853396b4..680a515abd3e 100644
--- a/plugins/ltac/tacarg.mli
+++ b/plugins/ltac/tacarg.mli
@@ -14,7 +14,6 @@ open Constrexpr
 open Genintern
 open Tactypes
 open Tacexpr
-open Names
 
 (** Tactic related witnesses, could also live in tactics/ if other users *)
 
@@ -43,16 +42,7 @@ val wit_quantified_hypothesis : quantified_hypothesis uniform_genarg_type
 
 (** Generic arguments based on Ltac. *)
 
-(** 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 =
-  | 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
+type tacvalue
 
 val wit_tactic : (raw_tactic_expr, glob_tactic_expr, tacvalue) genarg_type
 
@@ -68,3 +58,8 @@ val wit_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/tacinterp.ml b/plugins/ltac/tacinterp.ml
index 4c285cc222ed..120854506653 100644
--- a/plugins/ltac/tacinterp.ml
+++ b/plugins/ltac/tacinterp.ml
@@ -42,6 +42,17 @@ 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
@@ -138,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 "<tactic closure>"
+
+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
 
@@ -154,9 +189,9 @@ 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
 
 let f_avoid_ids : Id.Set.t TacStore.field = TacStore.field "f_avoid_ids"
@@ -261,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
@@ -286,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
@@ -299,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 *)
@@ -312,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)
@@ -1151,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
@@ -1159,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 ();
@@ -1305,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
 
@@ -1385,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.
@@ -1432,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
@@ -1454,7 +1489,7 @@ and tactic_of_val 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 = function
+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 = {
@@ -1506,7 +1541,7 @@ 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
@@ -1536,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
@@ -1547,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
 
 
@@ -2000,7 +2035,7 @@ module Value = struct
   include Taccoerce.Value
 
   let closure ist tac =
-    VFun (UnnamedAppl, extract_trace ist, None, ist.lfun, [], tac)
+    of_tacvalue_v @@ VFun (UnnamedAppl, extract_trace ist, None, ist.lfun, [], tac)
 
   let of_closure ist tac =
     let closure = closure ist tac in

From e5d5800f01143d5d7f90a38ff9709b8136908118 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Wed, 18 Mar 2026 18:30:19 +0100
Subject: [PATCH 268/578] Add a deprecated option to restore the previous
 abstract behaviour.

---
 doc/corelib/index-list.html.template |  1 +
 plugins/ltac/tacinterp.ml            |  3 ++-
 plugins/ltac2/tac2extravals.ml       |  3 ++-
 tactics/abstract.ml                  |  7 +++++++
 tactics/abstract.mli                 |  2 ++
 theories/Corelib/Compat/Rocq91.v     |  3 +--
 theories/Corelib/Compat/Rocq92.v     | 19 +++++++++++++++++++
 7 files changed, 34 insertions(+), 4 deletions(-)
 create mode 100644 theories/Corelib/Compat/Rocq92.v

diff --git a/doc/corelib/index-list.html.template b/doc/corelib/index-list.html.template
index 2e8228ac8a98..65f493a14123 100644
--- a/doc/corelib/index-list.html.template
+++ b/doc/corelib/index-list.html.template
@@ -173,6 +173,7 @@ through the <tt>Require Import</tt> command.</p>
     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
   </dd>
diff --git a/plugins/ltac/tacinterp.ml b/plugins/ltac/tacinterp.ml
index 59af118cb231..05b4499d695c 100644
--- a/plugins/ltac/tacinterp.ml
+++ b/plugins/ltac/tacinterp.ml
@@ -2201,7 +2201,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/ltac2/tac2extravals.ml b/plugins/ltac2/tac2extravals.ml
index 18fd16748e4c..14756530b72f 100644
--- a/plugins/ltac2/tac2extravals.ml
+++ b/plugins/ltac2/tac2extravals.ml
@@ -261,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
diff --git a/tactics/abstract.ml b/tactics/abstract.ml
index 6f4267210dad..7faf77ba3973 100644
--- a/tactics/abstract.ml
+++ b/tactics/abstract.ml
@@ -106,3 +106,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/theories/Corelib/Compat/Rocq91.v b/theories/Corelib/Compat/Rocq91.v
index 5550646c4900..23839acc5ffb 100644
--- a/theories/Corelib/Compat/Rocq91.v
+++ b/theories/Corelib/Compat/Rocq91.v
@@ -10,7 +10,6 @@
 
 (** Compatibility file for making Rocq act similar to Coq v9.1 *)
 
-(* When adding Rocq92.v, uncomment the following line *)
-(* Require Export Corelib.Compat.Rocq92. *)
+Require Export Corelib.Compat.Rocq92.
 
 #[export] Set Warnings "-deprecated-since-9.2".
diff --git a/theories/Corelib/Compat/Rocq92.v b/theories/Corelib/Compat/Rocq92.v
new file mode 100644
index 000000000000..96a87763e8a7
--- /dev/null
+++ b/theories/Corelib/Compat/Rocq92.v
@@ -0,0 +1,19 @@
+(************************************************************************)
+(*         *      The Rocq Prover / The Rocq Development Team           *)
+(*  v      *         Copyright INRIA, CNRS and contributors             *)
+(* <O___,, * (see version control and CREDITS file for authors & dates) *)
+(*   \VV/  **************************************************************)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(** Compatibility file for making Rocq act similar to Coq v9.2 *)
+
+(* When adding Rocq93.v, uncomment the following line *)
+(* Require Export Corelib.Compat.Rocq93. *)
+
+#[export] Set Warnings "-deprecated-since-9.3".
+
+#[export]
+Set Inline Abstract Subproof.

From 6d9374f1fa65dbb40947a45d394c91e20a0ae2aa Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Wed, 18 Mar 2026 18:38:07 +0100
Subject: [PATCH 269/578] Document the changes.

---
 ...21676-constr-quotation-abstract-no-inline-Changed.rst | 7 +++++++
 doc/sphinx/proofs/writing-proofs/proof-mode.rst          | 9 +++++++--
 2 files changed, 14 insertions(+), 2 deletions(-)
 create mode 100644 doc/changelog/04-tactics/21676-constr-quotation-abstract-no-inline-Changed.rst

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 <https://github.com/rocq-prover/rocq/pull/21676>`_,
+  fixes `#7905 <https://github.com/rocq-prover/rocq/issues/7905>`_,
+  by Pierre-Marie Pédrot).
diff --git a/doc/sphinx/proofs/writing-proofs/proof-mode.rst b/doc/sphinx/proofs/writing-proofs/proof-mode.rst
index 24b725acbd60..c80b808c019b 100644
--- a/doc/sphinx/proofs/writing-proofs/proof-mode.rst
+++ b/doc/sphinx/proofs/writing-proofs/proof-mode.rst
@@ -1000,8 +1000,7 @@ Proving a subgoal as a separate lemma: abstract
       The abstract tactic, while very useful, still has some known
       limitations.  See `#9146 <https://github.com/rocq-prover/rocq/issues/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 +1030,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

From e328f9f5c147db8b8370f1721f64c101b046e71c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Fri, 20 Mar 2026 14:37:48 +0100
Subject: [PATCH 270/578] Faster fast path for progress failure

---
 engine/proofview.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/engine/proofview.ml b/engine/proofview.ml
index 209f313c0596..9c369974282b 100644
--- a/engine/proofview.ml
+++ b/engine/proofview.ml
@@ -988,7 +988,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 ||

From 56be642af49caf1f637ad672d16ff6c11e09985a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Fri, 20 Mar 2026 13:40:29 +0100
Subject: [PATCH 271/578] Fix has_dependent_elim to handle postponed eta

Fix #21789
Fix #21788
---
 kernel/cClosure.ml                        | 32 +++-------------
 kernel/declareops.ml                      | 22 +++++++++++
 kernel/declareops.mli                     |  2 +
 kernel/indTyping.ml                       |  7 +++-
 pretyping/inductiveops.ml                 | 45 +++++++++++++++++++----
 pretyping/inductiveops.mli                |  4 +-
 proofs/clenv.ml                           |  2 +-
 tactics/elimschemes.ml                    |  2 +-
 tactics/indrec.ml                         |  2 +-
 test-suite/bugs/bug_21788.v               | 16 ++++++++
 test-suite/bugs/bug_21789.v               | 12 ++++++
 test-suite/success/record_postponed_eta.v |  6 ++-
 vernac/himsg.ml                           |  2 +-
 vernac/indschemes.ml                      |  4 +-
 14 files changed, 116 insertions(+), 42 deletions(-)
 create mode 100644 test-suite/bugs/bug_21788.v
 create mode 100644 test-suite/bugs/bug_21789.v

diff --git a/kernel/cClosure.ml b/kernel/cClosure.ml
index 95d947515318..c24fd9879b10 100644
--- a/kernel/cClosure.ml
+++ b/kernel/cClosure.ml
@@ -939,18 +939,6 @@ let get_branch infos ci pms cterm br e =
     let ext = push (Array.length args - 1) [] ctx in
     (br, usubs_consv (Array.rev_of_list ext) e)
 
-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
-
 (** [eta_expand_ind_stack env ind c s t] computes stacks corresponding
     to the conversion of the eta expansion of t, considered as an inhabitant
     of ind, and the Constructor c of this inductive type applied to arguments
@@ -963,20 +951,13 @@ let has_valid_relevance u ind_relevance flds =
 let eta_expand_ind_stack env (ind,u) m (f, s') =
   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 ind_relevance = ind_relevance ind env in
+  (* disallow eta-exp for non-primitive records, also check postponed eta *)
+  let () = if not (Declareops.is_record_with_eta (mib,mib.mind_packets.(snd ind)) 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
-      | MaybeEta ->
-        let relevances = Array.map snd projs in
-        if not @@ has_valid_relevance u ind_relevance relevances
-        then raise Not_found
-      | AlwaysEta -> ()
-    in
+  | None -> assert false
+  | Some (projs, _) ->
     (* (Construct, pars1 .. parsm :: arg1...argn :: []) ~= (f, s') ->
            arg1..argn ~= (proj1 t...projn t) where t = zip (f,s') *)
     let pars = mib.Declarations.mind_nparams in
@@ -992,7 +973,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
diff --git a/kernel/declareops.ml b/kernel/declareops.ml
index 7dab6c0dca99..7036e2c4d490 100644
--- a/kernel/declareops.ml
+++ b/kernel/declareops.ml
@@ -311,6 +311,28 @@ let inductive_make_projections ind mib =
     in
     Some (projs, has_eta)
 
+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 } *)
 
 (** Just as for constants, this hash-consing is quite partial *)
diff --git a/kernel/declareops.mli b/kernel/declareops.mli
index 25ef2241305a..daa4d4dd5588 100644
--- a/kernel/declareops.mli
+++ b/kernel/declareops.mli
@@ -75,6 +75,8 @@ val inductive_make_projection : Names.inductive -> mutual_inductive_body -> proj
 val inductive_make_projections : Names.inductive -> mutual_inductive_body ->
   ((Names.Projection.Repr.t * Sorts.relevance) array * has_eta) option
 
+val is_record_with_eta : mind_specif -> Instance.t -> bool
+
 (** {6 Kernel flags} *)
 
 (** A default, safe set of flags for kernel type-checking *)
diff --git a/kernel/indTyping.ml b/kernel/indTyping.ml
index 9ccfc17e502a..2b39a2b08d4d 100644
--- a/kernel/indTyping.ml
+++ b/kernel/indTyping.ml
@@ -561,7 +561,12 @@ let typecheck_inductive env ~sec_univs (mie:mutual_inductive_entry) =
     | 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)
+      | 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. *)
diff --git a/pretyping/inductiveops.ml b/pretyping/inductiveops.ml
index 7ca8d29f6d5a..58bb94656575 100644
--- a/pretyping/inductiveops.ml
+++ b/pretyping/inductiveops.ml
@@ -358,10 +358,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 =
@@ -465,20 +497,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 0b85f6f62292..24ec6a25eb8a 100644
--- a/pretyping/inductiveops.mli
+++ b/pretyping/inductiveops.mli
@@ -149,7 +149,9 @@ 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 ->
diff --git a/proofs/clenv.ml b/proofs/clenv.ml
index 5638406c5112..34fedfef151e 100644
--- a/proofs/clenv.ml
+++ b/proofs/clenv.ml
@@ -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/tactics/elimschemes.ml b/tactics/elimschemes.ml
index 1575616ff39e..ac945a09e5db 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)
 
 
diff --git a/tactics/indrec.ml b/tactics/indrec.ml
index c12096eeeaf1..bdd579208fe2 100644
--- a/tactics/indrec.ml
+++ b/tactics/indrec.ml
@@ -455,7 +455,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/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/success/record_postponed_eta.v b/test-suite/success/record_postponed_eta.v
index aade41b290e2..068f585e3a7c 100644
--- a/test-suite/success/record_postponed_eta.v
+++ b/test-suite/success/record_postponed_eta.v
@@ -66,12 +66,16 @@ Proof. intros A r2. Fail reflexivity. Abort.
 
 (* Conversion when record is in Prop and field in SProp fails correctly *)
 Goal forall (A:SProp) (r2 : RSToS'@{SProp Prop;0 0} A), eq r2 {| f4 := r2.(f4 A) |}.
-Proof. intros A r2. Fail reflexivity. Abort.
+Proof.
+  intros A r2.
+  Fail reflexivity.
 (* The command has indeed failed with message:
   In environment
   A : SProp
   r2 : RSToS' A
   Unable to unify "{| f4 := f4 _ r2 |}" with "r2". *)
+  Fail destruct r2. (* prim record must have eta for dependent elim *)
+Abort.
 
 (* Conversion when record and field are instantiated to SProp checks correctly *)
 Goal forall (A:SProp) (r2 : RSToS'@{SProp SProp;0 0} A), eq r2 {| f4 := r2.(f4 A) |}.
diff --git a/vernac/himsg.ml b/vernac/himsg.ml
index 69aee8d76309..cb3b26895846 100644
--- a/vernac/himsg.ml
+++ b/vernac/himsg.ml
@@ -923,7 +923,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 =
diff --git a/vernac/indschemes.ml b/vernac/indschemes.ml
index 2598ab88b3bf..311b4e87bdfb 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
@@ -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 =

From 1150853fa09dc592e2cad848f7052ec92336cc09 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Jean-Christophe=20L=C3=A9chenet?=
 <jean-christophe.lechenet@inria.fr>
Date: Fri, 20 Mar 2026 15:39:46 +0100
Subject: [PATCH 272/578] Warning deprecated-lookup-elim-by-name: 9.1 -> 9.2

The deprecation message mentions 9.1, while the warning is introduced
in version 9.2.
---
 tactics/elimschemes.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/tactics/elimschemes.ml b/tactics/elimschemes.ml
index 1575616ff39e..1caeb5a31307 100644
--- a/tactics/elimschemes.ml
+++ b/tactics/elimschemes.ml
@@ -147,7 +147,7 @@ let lookup_eliminator_by_name env ind_sp 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.@ \

From 47c536504080376c2ef3d176a6853107176273bc Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Fri, 20 Mar 2026 16:12:56 +0100
Subject: [PATCH 273/578] Simplify types in logic_monad

---
 engine/logic_monad.ml  | 32 +++++++++++++++-----------------
 engine/logic_monad.mli |  6 ++----
 2 files changed, 17 insertions(+), 21 deletions(-)

diff --git a/engine/logic_monad.ml b/engine/logic_monad.ml
index 7356bd08ba04..5cbca3eb4970 100644
--- a/engine/logic_monad.ml
+++ b/engine/logic_monad.ml
@@ -256,38 +256,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_
-  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 reflect0 : type r. _ -> _ -> (_ -> r) -> (_ -> _ -> (_ -> r) -> r) -> r =
-    fun e m nil cons ->
-      match m e with
+  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 -> reflect0 e l nil cons)
+      | Cons ((x, s), l) -> cons x s (fun e -> reflect0 (l e) nil cons)
 
-  let reflect (e : 'e) (m : 'e -> ('a * 'o, 'e) reified) =
-    { iolist = fun _ nil cons -> reflect0 e m 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 = Nil e in
-    let rcons p s l = Cons ((p, s), {r=l}) in
+    let rcons p s l = Cons ((p, s), (fun e -> {r=l e})) in
     { iolist = fun s nil cons ->
       begin match m.iolist s rnil rcons with
       | Nil e -> cons (Nil e) s nil
-      | Cons ((x, s), {r=l}) ->
-        let l e = reflect e l in
+      | 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 = Nil e in
+    let rnil e = {r=Nil e} in
     let rcons x s l =
       let p = (x, s) in
-      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
@@ -339,7 +338,6 @@ struct
   type iexn = Exninfo.iexn
 
   type 'a reified = ('a, iexn) BackState.reified
-  type 'a reified_ = ('a, iexn) BackState.reified_
 
   (** Inherited from Backstate *)
 
@@ -392,10 +390,10 @@ struct
 
   let run m r s =
     let s = { wstate = P.wunit; ustate = P.uunit; rstate = r; sstate = s } in
-    let rnil e = 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
-      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 3a010079ab33..f8f701228930 100644
--- a/engine/logic_monad.mli
+++ b/engine/logic_monad.mli
@@ -145,9 +145,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_
+  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 +200,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_
+  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
 

From 24e9521445a7f5b616e21ef312684d928224f9a6 Mon Sep 17 00:00:00 2001
From: Thomas Lamiaux <thomas.lamiaux@gmail.com>
Date: Fri, 20 Mar 2026 18:21:58 +0100
Subject: [PATCH 274/578] make clearer filter_stack_domain return SArg

---
 kernel/inductive.ml | 12 +++++++-----
 1 file changed, 7 insertions(+), 5 deletions(-)

diff --git a/kernel/inductive.ml b/kernel/inductive.ml
index 1bcb707aa644..83810be92906 100644
--- a/kernel/inductive.ml
+++ b/kernel/inductive.ml
@@ -1181,7 +1181,8 @@ let filter_stack_domain stack_element_specif not_subterm ?evars env p stack =
   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 absctxlen ar then stack
+  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
@@ -1197,12 +1198,13 @@ let filter_stack_domain stack_element_specif not_subterm ?evars env p stack =
         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 SArg spec
+          if has_constant_parameters env absctxlen (k + List.length ctx) ind args then
+            spec
           else
-            SArg (lazy (Subterm.prune_path ?evars env (Lazy.force spec) ind args))
-        | _ -> SArg not_subterm
+            lazy (Subterm.prune_path ?evars env (Lazy.force spec) ind args)
+        | _ -> not_subterm
         in
-        elt :: filter_stack (push_rel d env) (k + 1) c0 stack'
+        SArg elt :: filter_stack (push_rel d env) (k + 1) c0 stack'
       | _ ->
         List.map (fun _ -> SArg not_subterm) stack
   in

From 77459913871af7a8d3f5e4fe8632a7cdfa8964a1 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Sat, 21 Mar 2026 19:57:37 +0100
Subject: [PATCH 275/578] Correctly analyze rec call arguments for uniformity
 check in the guard.

Hopefully this is the last of the soundness issues introduced by the
handling of uniform fixpoint parameters.

Fixes #21797: Inconsistency due to uniform parameters in the guard.
---
 dev/doc/critical-bugs.md    | 11 +++++++
 kernel/inductive.ml         |  6 ++--
 test-suite/bugs/bug_21797.v | 62 +++++++++++++++++++++++++++++++++++++
 3 files changed, 77 insertions(+), 2 deletions(-)
 create mode 100644 test-suite/bugs/bug_21797.v

diff --git a/dev/doc/critical-bugs.md b/dev/doc/critical-bugs.md
index 730777e45610..24f55ce7d6ed 100644
--- a/dev/doc/critical-bugs.md
+++ b/dev/doc/critical-bugs.md
@@ -28,6 +28,7 @@ This file recollects knowledge about critical bugs found in Coq since version 8.
       - [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)
     - [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)
@@ -312,6 +313,16 @@ and lack of checking of relevance marks on constants in coqchk
 - 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)
+
 ### Module system
 
 #### missing universe constraints in typing "with" clause of a module type
diff --git a/kernel/inductive.ml b/kernel/inductive.ml
index 83810be92906..7ad826c158d2 100644
--- a/kernel/inductive.ml
+++ b/kernel/inductive.ml
@@ -1373,6 +1373,8 @@ let find_uniform_parameters recindx nargs bodies =
     let f, l = decompose_app_list c in
     match kind f with
     | Rel n ->
+      let fold accu c = fold_constr_with_binders succ (aux i) 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 ->
@@ -1403,12 +1405,12 @@ let drop_uniform_parameters nuniformparams bodies =
     let f, l = decompose_app_list c in
     match kind f with
     | Rel n ->
+      let l = List.map (fun c -> aux i k c) l in
       (* 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
         Term.applist (f, new_args)
-      else
-        c
+      else Term.applist (f, l)
     | _ -> map_with_binders succ (aux i) k c
   in
   Array.mapi (fun i -> aux i 0) bodies
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.
+*)

From f4ba720a635c2f2978d340a1d7026355ee79ba23 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Sun, 22 Mar 2026 13:09:10 +0100
Subject: [PATCH 276/578] Slightly stricted invariant in uniform guard
 analysis.

By virtue of the uniformity invariant, recursive calls should
be applied enough times for skipn to never fail.
---
 kernel/inductive.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/kernel/inductive.ml b/kernel/inductive.ml
index 7ad826c158d2..576b74218146 100644
--- a/kernel/inductive.ml
+++ b/kernel/inductive.ml
@@ -1408,7 +1408,7 @@ let drop_uniform_parameters nuniformparams bodies =
       let l = List.map (fun c -> aux i k c) l in
       (* 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 new_args = List.skipn nuniformparams l in
         Term.applist (f, new_args)
       else Term.applist (f, l)
     | _ -> map_with_binders succ (aux i) k c

From fa9cc639d487d71dbe1e0b8d442ebea0e4ff54ff Mon Sep 17 00:00:00 2001
From: Thomas Lamiaux <thomas.lamiaux@gmail.com>
Date: Sun, 22 Mar 2026 19:02:07 +0100
Subject: [PATCH 277/578] fix implementation bug All Scheme

---
 tactics/allScheme.ml                     |  1 +
 test-suite/output/nested_eliminators.out | 56 +++++++++++++++++-------
 test-suite/output/nested_eliminators.v   | 10 +++++
 3 files changed, 50 insertions(+), 17 deletions(-)

diff --git a/tactics/allScheme.ml b/tactics/allScheme.ml
index e3522d27f309..18082fd4fb87 100644
--- a/tactics/allScheme.ml
+++ b/tactics/allScheme.ml
@@ -445,6 +445,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
diff --git a/test-suite/output/nested_eliminators.out b/test-suite/output/nested_eliminators.out
index 2fc2ba082891..f953787a84dd 100644
--- a/test-suite/output/nested_eliminators.out
+++ b/test-suite/output/nested_eliminators.out
@@ -1323,7 +1323,29 @@ adequate_all is universe polymorphic
 Arguments adequate_all L (φ Pφ)%_function_scope a
 Expands to: Inductive nested_eliminators.Template.adequate_all
 Declared in library nested_eliminators, line 295, characters 2-131
-File "./output/nested_eliminators.v", line 315, characters 13-21:
+casenat_all@{α ; u} :
+forall P : nat -> Set,
+(forall n : nat, P n -> Type@{α ; u}) -> casenat P -> Type@{max(Set,u)}
+(* α ; *u |=  *)
+
+casenat_all is universe polymorphic
+Arguments casenat_all (P PP)%_function_scope c
+Expands to: Inductive nested_eliminators.Template.casenat_all
+Declared in library nested_eliminators, line 302, characters 2-94
+casenat'_all@{α α0 ; u u0} :
+forall (A : nat -> Set) (PZ : Set),
+(PZ -> Type@{α ; u}) ->
+forall PS : forall n : nat, A n -> Set,
+(forall (n : nat) (a : A n), PS n a -> Type@{α0 ; u0}) ->
+casenat' A PZ PS -> Type@{max(Set,u,u0)}
+(* α α0 ; *u *u0 |=  *)
+
+casenat'_all is universe polymorphic
+Arguments casenat'_all A%_function_scope PZ%_type_scope
+  (PPZ PS PPS)%_function_scope c
+Expands to: Inductive nested_eliminators.Template.casenat'_all
+Declared in library nested_eliminators, line 307, characters 2-147
+File "./output/nested_eliminators.v", line 325, characters 13-21:
 The command has indeed failed with message:
 The reference True_all was not found in the current environment.
 Inductive
@@ -1349,7 +1371,7 @@ list_all_forall is universe polymorphic
 Arguments list_all_forall A%_type_scope (PA HPA)%_function_scope l
 list_all_forall is transparent
 Expands to: Constant nested_eliminators.UnivPoly.list_all_forall
-Declared in library nested_eliminators, line 318, characters 2-88
+Declared in library nested_eliminators, line 328, characters 2-88
 Inductive
 list_all_all@{α α0 ; u u0 u1} (A : Type@{u}) (PA : A -> Type@{α ; u0})
 (PPA : forall a : A, PA a -> Type@{α0 ; u1})
@@ -1381,7 +1403,7 @@ Arguments list_all_all_forall A%_type_scope (PA PPA HPPA)%_function_scope
   l l0
 list_all_all_forall is transparent
 Expands to: Constant nested_eliminators.UnivPoly.list_all_all_forall
-Declared in library nested_eliminators, line 318, characters 2-88
+Declared in library nested_eliminators, line 328, characters 2-88
 MRT_ind@{} :
 forall P : MRT -> Prop,
 (forall l : list@{Set} MRT,
@@ -1392,7 +1414,7 @@ MRT_ind is universe polymorphic
 Arguments MRT_ind (P MRTnode)%_function_scope m
 MRT_ind is transparent
 Expands to: Constant nested_eliminators.UnivPoly.MRT_ind
-Declared in library nested_eliminators, line 327, characters 2-55
+Declared in library nested_eliminators, line 337, characters 2-55
 RoseTree_ind@{u u0} :
 forall (A : Type@{u}) (P : RoseTree@{u u0} A -> Prop),
 (forall a : A, P (RTleaf@{u u0} A a)) ->
@@ -1405,7 +1427,7 @@ RoseTree_ind is universe polymorphic
 Arguments RoseTree_ind A%_type_scope (P RTleaf RTnode)%_function_scope r
 RoseTree_ind is transparent
 Expands to: Constant nested_eliminators.UnivPoly.RoseTree_ind
-Declared in library nested_eliminators, line 332, characters 2-113
+Declared in library nested_eliminators, line 342, characters 2-113
 Inductive
 RoseTree_all@{α ; u u0 u1 u2} (A : Type@{u}) (PA : A -> Type@{α ; u1})
   : RoseTree@{u u0} A -> Type@{max(u0,u1,u2)} :=
@@ -1435,7 +1457,7 @@ RoseTree_all_forall is universe polymorphic
 Arguments RoseTree_all_forall A%_type_scope (PA HPA)%_function_scope r
 RoseTree_all_forall is transparent
 Expands to: Constant nested_eliminators.UnivPoly.RoseTree_all_forall
-Declared in library nested_eliminators, line 332, characters 2-113
+Declared in library nested_eliminators, line 342, characters 2-113
 RoseRoseTree_ind@{u u0 u1} :
 forall (A : Type@{u}) (P : RoseRoseTree@{u u0} A -> Prop),
 (forall a : A, P (Nleaf@{u u0} A a)) ->
@@ -1452,7 +1474,7 @@ RoseRoseTree_ind is universe polymorphic
 Arguments RoseRoseTree_ind A%_type_scope (P Nleaf Nnode)%_function_scope r
 RoseRoseTree_ind is transparent
 Expands to: Constant nested_eliminators.UnivPoly.RoseRoseTree_ind
-Declared in library nested_eliminators, line 340, characters 2-136
+Declared in library nested_eliminators, line 350, characters 2-136
 Inductive
 RoseRoseTree_all@{α ; u u0 u1 u2} (A : Type@{u}) (PA : A -> Type@{α ; u1})
   : RoseRoseTree@{u u0} A -> Type@{max(u0,u1,u2)} :=
@@ -1486,7 +1508,7 @@ RoseRoseTree_all_forall is universe polymorphic
 Arguments RoseRoseTree_all_forall A%_type_scope (PA HPA)%_function_scope r
 RoseRoseTree_all_forall is transparent
 Expands to: Constant nested_eliminators.UnivPoly.RoseRoseTree_all_forall
-Declared in library nested_eliminators, line 340, characters 2-136
+Declared in library nested_eliminators, line 350, characters 2-136
 ArrowTree3_ind@{u u0} :
 forall (A : Type@{u}) (P : ArrowTree3@{u u0} A -> Prop),
 (forall a : A, P (ATleaf3@{u u0} A a)) ->
@@ -1503,7 +1525,7 @@ ArrowTree3_ind is universe polymorphic
 Arguments ArrowTree3_ind A%_type_scope (P ATleaf3 ATnode3)%_function_scope a
 ArrowTree3_ind is transparent
 Expands to: Constant nested_eliminators.UnivPoly.ArrowTree3_ind
-Declared in library nested_eliminators, line 348, characters 2-140
+Declared in library nested_eliminators, line 358, characters 2-140
 Inductive
 ArrowTree3_all@{α ; u u0 u1 u2} (A : Type@{u}) (PA : A -> Type@{α ; u1})
   : ArrowTree3@{u u0} A -> Type@{max(u0,u1,u2)} :=
@@ -1539,7 +1561,7 @@ ArrowTree3_all_forall is universe polymorphic
 Arguments ArrowTree3_all_forall A%_type_scope (PA HPA)%_function_scope a
 ArrowTree3_all_forall is transparent
 Expands to: Constant nested_eliminators.UnivPoly.ArrowTree3_all_forall
-Declared in library nested_eliminators, line 348, characters 2-140
+Declared in library nested_eliminators, line 358, characters 2-140
 Inductive
 list_all@{α α0 ; u u0 u1} (A : Type@{α ; u}) (PA : A -> Type@{α0 ; u1})
   : list@{α ; u u0} A -> Type@{α ; max(u0,u1)} :=
@@ -1564,7 +1586,7 @@ list_all_forall is universe polymorphic
 Arguments list_all_forall A%_type_scope (PA HPA)%_function_scope l
 list_all_forall is transparent
 Expands to: Constant nested_eliminators.SortPoly.list_all_forall
-Declared in library nested_eliminators, line 368, characters 2-22
+Declared in library nested_eliminators, line 378, characters 2-22
 Inductive
 list_all_all@{α α0 α1 ; u u0 u1 u2} (A : Type@{α ; u})
 (PA : A -> Type@{α0 ; u1}) (PPA : forall a : A, PA a -> Type@{α1 ; u2})
@@ -1598,7 +1620,7 @@ Arguments list_all_all_forall A%_type_scope (PA PPA HPPA)%_function_scope
   l l0
 list_all_all_forall is transparent
 Expands to: Constant nested_eliminators.SortPoly.list_all_all_forall
-Declared in library nested_eliminators, line 372, characters 2-26
+Declared in library nested_eliminators, line 382, characters 2-26
 MRT_ind@{} :
 forall P : MRT -> Prop,
 (forall l : list@{Type ; Set Set} MRT,
@@ -1609,7 +1631,7 @@ MRT_ind is universe polymorphic
 Arguments MRT_ind (P MRTnode)%_function_scope m
 MRT_ind is transparent
 Expands to: Constant nested_eliminators.SortPoly.MRT_ind
-Declared in library nested_eliminators, line 376, characters 2-55
+Declared in library nested_eliminators, line 386, characters 2-55
 SRT_sind@{u u0} :
 forall P : SRT@{u} -> SProp,
 (forall l : list@{SProp ; u u} SRT@{u},
@@ -1621,8 +1643,8 @@ SRT_sind is universe polymorphic
 Arguments SRT_sind (P SRTnode)%_function_scope s
 SRT_sind is transparent
 Expands to: Constant nested_eliminators.SortPoly.SRT_sind
-Declared in library nested_eliminators, line 381, characters 2-57
-File "./output/nested_eliminators.v", line 398, characters 2-60:
+Declared in library nested_eliminators, line 391, characters 2-57
+File "./output/nested_eliminators.v", line 408, characters 2-60:
 The command has indeed failed with message:
 MRT is nested using list. No scheme for list is registered as All. It can be
 generated using command "Scheme All" e.g. "Scheme All for list.".
@@ -1635,7 +1657,7 @@ MRT_ind is not universe polymorphic
 Arguments MRT_ind (P MRTnode)%_function_scope m
 MRT_ind is transparent
 Expands to: Constant nested_eliminators.TestWarning.MRT_ind
-Declared in library nested_eliminators, line 403, characters 2-55
+Declared in library nested_eliminators, line 413, characters 2-55
 Nester_all@{α ; u} :
 forall X : unit -> P unit,
 (forall u u0 : unit, X u u0 -> Type@{α ; u}) ->
@@ -1645,4 +1667,4 @@ Nester X -> Type@{max(P.u1,u)}
 Nester_all is universe polymorphic
 Arguments Nester_all (X PX)%_function_scope n
 Expands to: Inductive nested_eliminators.DeepArities.Nester_all
-Declared in library nested_eliminators, line 417, characters 2-24
+Declared in library nested_eliminators, line 427, characters 2-24
diff --git a/test-suite/output/nested_eliminators.v b/test-suite/output/nested_eliminators.v
index c14cee33815d..58f926badb94 100644
--- a/test-suite/output/nested_eliminators.v
+++ b/test-suite/output/nested_eliminators.v
@@ -298,6 +298,16 @@ Module Template.
   About adequate_ind.
   About adequate_all.
 
+  (* ISSUE 21710 *)
+  Inductive casenat (P : nat -> Set) : Set :=
+  | casenat_fold : (forall m, P m) -> casenat P.
+
+  About casenat_all.
+
+  Inductive casenat' (A : nat -> Set) (PZ : Set) (PS : forall n, A n -> Set) : Set :=
+  | casenat'_fold : (forall m a, PS m a) -> casenat' A PZ PS.
+
+  About casenat'_all.
 
 End Template.
 

From f046c9b74cc116d05a325440a02c2a0e36f295a4 Mon Sep 17 00:00:00 2001
From: Yann Leray <yann.leray@inria.fr>
Date: Tue, 17 Feb 2026 13:29:31 +0100
Subject: [PATCH 278/578] Rename evar_universe_context into ustate

---
 engine/evarutil.ml                      |  2 +-
 engine/evd.ml                           | 12 +++++++++---
 engine/evd.mli                          | 22 +++++++++++++++-------
 engine/proofview.ml                     |  2 +-
 plugins/funind/glob_term_to_relation.ml |  2 +-
 plugins/funind/recdef.ml                |  6 +++---
 plugins/ltac/leminv.ml                  |  4 ++--
 plugins/ring/ring.ml                    |  2 +-
 plugins/ssr/ssrcommon.ml                |  2 +-
 plugins/ssr/ssrequality.ml              |  6 +++---
 plugins/ssrmatching/ssrmatching.ml      |  6 +++---
 pretyping/retyping.ml                   |  2 +-
 proofs/subproof.ml                      |  4 ++--
 tactics/allScheme.ml                    |  2 +-
 tactics/rewrite.ml                      |  2 +-
 vernac/auto_ind_decl.ml                 |  8 ++++----
 vernac/comDefinition.ml                 |  2 +-
 vernac/comFixpoint.ml                   |  2 +-
 vernac/comInductive.ml                  |  2 +-
 vernac/comPrimitive.ml                  |  2 +-
 vernac/comRewriteRule.ml                |  8 ++++----
 vernac/declare.ml                       | 16 ++++++++--------
 vernac/himsg.ml                         |  2 +-
 vernac/indschemes.ml                    |  4 ++--
 vernac/prettyp.ml                       |  6 +++---
 vernac/printmod.ml                      |  4 ++--
 vernac/vernacentries.ml                 |  2 +-
 27 files changed, 74 insertions(+), 60 deletions(-)

diff --git a/engine/evarutil.ml b/engine/evarutil.ml
index 5baa9e7ac426..296868d28001 100644
--- a/engine/evarutil.ml
+++ b/engine/evarutil.ml
@@ -42,7 +42,7 @@ let finalize ?abort_on_undefined_evars ?poly 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. *)
diff --git a/engine/evd.ml b/engine/evd.ml
index 43a232505e5f..8fcce5f1278b 100644
--- a/engine/evd.ml
+++ b/engine/evd.ml
@@ -896,7 +896,9 @@ let empty = {
 
 let from_env ?binders e = { empty with universes = UState.from_env ?binders e }
 
-let from_ctx uctx = { empty with universes = uctx }
+let from_ustate uctx = { empty with universes = uctx }
+
+let from_ctx = from_ustate
 
 let has_undefined evd = not (EvMap.is_empty evd.undf_evars)
 
@@ -909,9 +911,11 @@ let merge_ustate evd uctx' =
 
 let merge_universe_context = merge_ustate
 
-let set_universe_context evd uctx' =
+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]}
@@ -1035,9 +1039,11 @@ let check_univ_decl_early ~poly ~with_obls sigma udecl terms =
   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
 
diff --git a/engine/evd.mli b/engine/evd.mli
index e60036f2553b..a3bc51d965b3 100644
--- a/engine/evd.mli
+++ b/engine/evd.mli
@@ -170,12 +170,15 @@ val from_env : ?binders:lident list -> env -> evar_map
     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_ctx : UState.t -> evar_map
+[@@deprecated "(9.3) Use [Evd.from_ustate]"]
+
 val is_empty : evar_map -> bool
 (** Whether an evarmap is empty. *)
 
@@ -559,8 +562,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
@@ -626,12 +627,19 @@ 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_universe_context : 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
 
 val merge_sort_context_set : ?loc:Loc.t -> ?sort_rigid:bool -> ?sideff:bool ->
diff --git a/engine/proofview.ml b/engine/proofview.ml
index 9c369974282b..19120151feff 100644
--- a/engine/proofview.ml
+++ b/engine/proofview.ml
@@ -1103,7 +1103,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/plugins/funind/glob_term_to_relation.ml b/plugins/funind/glob_term_to_relation.ml
index a9bdbb4a7891..22aa87dce979 100644
--- a/plugins/funind/glob_term_to_relation.ml
+++ b/plugins/funind/glob_term_to_relation.ml
@@ -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
diff --git a/plugins/funind/recdef.ml b/plugins/funind/recdef.ml
index 0cedf8d8181e..da4eadda53cd 100644
--- a/plugins/funind/recdef.ml
+++ b/plugins/funind/recdef.ml
@@ -1512,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 ->
@@ -1552,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
@@ -1689,7 +1689,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/leminv.ml b/plugins/ltac/leminv.ml
index 18b6dc880e31..5920390ea1c1 100644
--- a/plugins/ltac/leminv.ml
+++ b/plugins/ltac/leminv.ml
@@ -198,7 +198,7 @@ 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
@@ -244,7 +244,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/ring/ring.ml b/plugins/ring/ring.ml
index 942585fd0be6..7364b5eb0479 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)
diff --git a/plugins/ssr/ssrcommon.ml b/plugins/ssr/ssrcommon.ml
index 12b5fad7dab0..b8f390ca7e57 100644
--- a/plugins/ssr/ssrcommon.ml
+++ b/plugins/ssr/ssrcommon.ml
@@ -926,7 +926,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
diff --git a/plugins/ssr/ssrequality.ml b/plugins/ssr/ssrequality.ml
index 7938f5549d23..157b91c32922 100644
--- a/plugins/ssr/ssrequality.ml
+++ b/plugins/ssr/ssrequality.ml
@@ -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
@@ -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
diff --git a/plugins/ssrmatching/ssrmatching.ml b/plugins/ssrmatching/ssrmatching.ml
index c1644adc86d5..bd858fc96026 100644
--- a/plugins/ssrmatching/ssrmatching.ml
+++ b/plugins/ssrmatching/ssrmatching.ml
@@ -343,7 +343,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 +356,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
@@ -1521,7 +1521,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/pretyping/retyping.ml b/pretyping/retyping.ml
index 89532ca0ec26..1348d4aea176 100644
--- a/pretyping/retyping.ml
+++ b/pretyping/retyping.ml
@@ -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/proofs/subproof.ml b/proofs/subproof.ml
index 807bd43f37c5..b4af1fa69769 100644
--- a/proofs/subproof.ml
+++ b/proofs/subproof.ml
@@ -134,13 +134,13 @@ 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 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
diff --git a/tactics/allScheme.ml b/tactics/allScheme.ml
index e3522d27f309..6091358f6452 100644
--- a/tactics/allScheme.ml
+++ b/tactics/allScheme.ml
@@ -955,7 +955,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
diff --git a/tactics/rewrite.ml b/tactics/rewrite.ml
index 3fbddc077d7b..a4b42a69e034 100644
--- a/tactics/rewrite.ml
+++ b/tactics/rewrite.ml
@@ -1805,7 +1805,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 =
diff --git a/vernac/auto_ind_decl.ml b/vernac/auto_ind_decl.ml
index 7515ce80bee2..c01a235e720c 100644
--- a/vernac/auto_ind_decl.ml
+++ b/vernac/auto_ind_decl.ml
@@ -869,7 +869,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
@@ -1202,7 +1202,7 @@ 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 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
@@ -1335,7 +1335,7 @@ 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
     (compute_lb_tact handle ind lnamesparrec nparrec)
@@ -1531,7 +1531,7 @@ 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 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
diff --git a/vernac/comDefinition.ml b/vernac/comDefinition.ml
index 3910776213cf..6f4c9d2dd56e 100644
--- a/vernac/comDefinition.ml
+++ b/vernac/comDefinition.ml
@@ -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
diff --git a/vernac/comFixpoint.ml b/vernac/comFixpoint.ml
index d73d86123130..8af3fa4a8822 100644
--- a/vernac/comFixpoint.ml
+++ b/vernac/comFixpoint.ml
@@ -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
diff --git a/vernac/comInductive.ml b/vernac/comInductive.ml
index 8cfdc18778b8..bd0441668e32 100644
--- a/vernac/comInductive.ml
+++ b/vernac/comInductive.ml
@@ -604,7 +604,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
diff --git a/vernac/comPrimitive.ml b/vernac/comPrimitive.ml
index 88889d74d933..e2274a0060af 100644
--- a/vernac/comPrimitive.ml
+++ b/vernac/comPrimitive.ml
@@ -46,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 2c7475891177..7f72650fa954 100644
--- a/vernac/comRewriteRule.ml
+++ b/vernac/comRewriteRule.ml
@@ -48,7 +48,7 @@ let do_symbol ~poly ~unfold_fix udecl (id, typ) =
   Pretyping.check_evars_are_solved ~program_mode:false env evd;
   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
@@ -434,7 +434,7 @@ let interp_rule ~collapse_sort_variables (udecl, lhs, rhs: Constrexpr.universe_d
   let evd, lhs, typ = Pretyping.understand_tcc_ty ~flags env evd lhs 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 =
@@ -472,7 +472,7 @@ let interp_rule ~collapse_sort_variables (udecl, lhs, rhs: Constrexpr.universe_d
 
   (* 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 =
@@ -484,7 +484,7 @@ let interp_rule ~collapse_sort_variables (udecl, lhs, rhs: Constrexpr.universe_d
   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
diff --git a/vernac/declare.ml b/vernac/declare.ml
index 39626cdaab64..a4aec5e2ce3b 100644
--- a/vernac/declare.ml
+++ b/vernac/declare.ml
@@ -1018,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
@@ -1061,7 +1061,7 @@ 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 bodies_types, sigma, indexes = make_recursive_bodies ~sigma:(Evd.from_ctx uctx) 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
@@ -1537,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
@@ -1557,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
@@ -1682,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 *)
@@ -2249,7 +2249,7 @@ let save_admitted ~pm ~proof =
   let iproof = get proof 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 ~poly sigma in
@@ -2484,7 +2484,7 @@ let solve_by_tac prg obls i tac =
     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
+      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 ->
@@ -2568,7 +2568,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 =
diff --git a/vernac/himsg.ml b/vernac/himsg.ml
index cb3b26895846..f9740321db60 100644
--- a/vernac/himsg.ml
+++ b/vernac/himsg.ml
@@ -1308,7 +1308,7 @@ let explain_not_match_error = function
   | IncompatibleUnivConstraints { got; expect } ->
     let open UVars in
     let pr_auctx auctx =
-      let sigma = Evd.from_ctx
+      let sigma = Evd.from_ustate
           (UState.of_names
              (Printer.universe_binders_with_opt_names auctx None))
       in
diff --git a/vernac/indschemes.ml b/vernac/indschemes.ml
index 311b4e87bdfb..a544ce55236a 100644
--- a/vernac/indschemes.ml
+++ b/vernac/indschemes.ml
@@ -570,10 +570,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
diff --git a/vernac/prettyp.ml b/vernac/prettyp.ml
index 8f8f296ae243..2ffb490eec7e 100644
--- a/vernac/prettyp.ml
+++ b/vernac/prettyp.ml
@@ -58,7 +58,7 @@ let print_ref env reduce ref udecl =
   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_ustate (UState.of_names bl) in
   let typ =
     if reduce then
       let ctx,ccl = Reductionops.whd_decompose_prod_decls env sigma (EConstr.of_constr typ)
@@ -238,7 +238,7 @@ let print_squash env ref udecl = match ref with
       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_ustate (UState.of_names bl) in
       let inst = if fst @@ UVars.AbstractContext.size univs = 0 then mt()
         else Printer.pr_universe_instance sigma (UVars.make_abstract_instance univs)
       in
@@ -580,7 +580,7 @@ let print_constant env ~with_values with_implicit cst udecl =
     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_ustate uctx 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
diff --git a/vernac/printmod.ml b/vernac/printmod.ml
index a9dcc8270a3d..cf85288fc185 100644
--- a/vernac/printmod.ml
+++ b/vernac/printmod.ml
@@ -163,7 +163,7 @@ let pr_mutual_inductive_body env mind mib udecl =
   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 sigma = Evd.from_ustate (UState.of_names bl) in
 
   hov 0 (def keyword ++ spc () ++
          prlist_with_sep (fun () -> fnl () ++ str"  with ")
@@ -278,7 +278,7 @@ let print_body is_impl extent env mp (l,body) =
          | OnlyNames -> mt ()
          | WithContents ->
             let bl = Printer.universe_binders_with_opt_names ctx None in
-            let sigma = Evd.from_ctx (UState.of_names bl) in
+            let sigma = Evd.from_ustate (UState.of_names bl) in
             str " :" ++ spc () ++
             hov 0 (Printer.pr_ltype_env env sigma cb.const_type) ++
             (match cb.const_body with
diff --git a/vernac/vernacentries.ml b/vernac/vernacentries.ml
index aacb7e698a99..b61fc5f4a7ce 100644
--- a/vernac/vernacentries.ml
+++ b/vernac/vernacentries.ml
@@ -1853,7 +1853,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)

From 6a43910845f5f351194ab87f000160a500eba53d Mon Sep 17 00:00:00 2001
From: Yann Leray <yann.leray@inria.fr>
Date: Tue, 10 Mar 2026 17:39:49 +0100
Subject: [PATCH 279/578] Remove deprecated arguments and functions in UState

---
 engine/evd.ml     |  2 +-
 engine/evd.mli    |  8 ++++----
 engine/uState.ml  | 15 ++-------------
 engine/uState.mli | 11 ++---------
 4 files changed, 9 insertions(+), 27 deletions(-)

diff --git a/engine/evd.ml b/engine/evd.ml
index 8fcce5f1278b..470ac0be357b 100644
--- a/engine/evd.ml
+++ b/engine/evd.ml
@@ -894,7 +894,7 @@ 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 }
 
diff --git a/engine/evd.mli b/engine/evd.mli
index a3bc51d965b3..17e092726699 100644
--- a/engine/evd.mli
+++ b/engine/evd.mli
@@ -163,10 +163,10 @@ 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). *)
 
diff --git a/engine/uState.ml b/engine/uState.ml
index 3dd6696b0640..53fa3db0fa1c 100644
--- a/engine/uState.ml
+++ b/engine/uState.ml
@@ -421,7 +421,7 @@ let empty =
     initial_universes = UGraph.initial_universes;
     minim_extra = UnivMinim.empty_extra; }
 
-let make ~qualities univs =
+let make qualities univs =
   { empty with
     universes = univs;
     initial_universes = univs ;
@@ -1488,18 +1488,7 @@ let new_univ_level_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_level_variable ?loc univ_rigid (Some id) uctx))
-    uctx binders
-
-let from_env ?(binders=[]) env =
-  make_with_initial_binders
-    ~qualities:(Environ.qualities env)
-    (Environ.universes env)
-    binders
+let from_env env = make (Environ.qualities env) (Environ.universes env)
 
 let make_nonalgebraic_variable uctx u =
   { uctx with univ_variables = UnivFlex.make_nonalgebraic_variable uctx.univ_variables u }
diff --git a/engine/uState.mli b/engine/uState.mli
index c0b042c9ad59..716cdb2f8b8f 100644
--- a/engine/uState.mli
+++ b/engine/uState.mli
@@ -32,15 +32,8 @@ type t
 
 val empty : t
 
-val make : qualities:QGraph.t -> UGraph.t -> t
-[@@ocaml.deprecated "(8.13) Use from_env"]
-
-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_env : Environ.env -> t
+(** Main entry point at the beginning of a declaration. *)
 
 val of_names : (UnivNames.universe_binders * UnivNames.rev_binders) -> t
 (** Main entry point when only names matter, e.g. for printing. *)

From 568ac80e0a7cfa0dcdc97877b2326fa0df44b14e Mon Sep 17 00:00:00 2001
From: Yann Leray <yann.leray@inria.fr>
Date: Tue, 10 Mar 2026 17:40:00 +0100
Subject: [PATCH 280/578] Change univ binder printer and create
 UState.from_auctx

---
 engine/evd.ml                     |  2 +
 engine/evd.mli                    |  6 +++
 engine/uState.ml                  | 42 +++++++++------
 engine/uState.mli                 |  6 ++-
 kernel/mod_typing.ml              |  2 +-
 kernel/modops.ml                  |  2 +-
 kernel/modops.mli                 |  2 +-
 kernel/subtyping.ml               |  2 +-
 kernel/uVars.ml                   |  6 +++
 kernel/uVars.mli                  |  6 +++
 printing/printer.ml               | 85 +++++++++++++------------------
 printing/printer.mli              | 16 +++---
 test-suite/output/UnivBinders.out | 48 +++++++++--------
 test-suite/output/UnivBinders.v   | 12 ++++-
 vernac/himsg.ml                   |  9 ++--
 vernac/prettyp.ml                 | 12 ++---
 vernac/printmod.ml                | 46 ++++++++---------
 17 files changed, 164 insertions(+), 140 deletions(-)

diff --git a/engine/evd.ml b/engine/evd.ml
index 470ac0be357b..8897db09d0b7 100644
--- a/engine/evd.ml
+++ b/engine/evd.ml
@@ -900,6 +900,8 @@ let from_ustate 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)
 
 let has_given_up evd = not (Evar.Set.is_empty evd.given_up)
diff --git a/engine/evd.mli b/engine/evd.mli
index 17e092726699..7c28b237c9ac 100644
--- a/engine/evd.mli
+++ b/engine/evd.mli
@@ -176,6 +176,12 @@ val from_ustate : UState.t -> evar_map
     (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]"]
 
diff --git a/engine/uState.ml b/engine/uState.ml
index 53fa3db0fa1c..6b67effc29f0 100644
--- a/engine/uState.ml
+++ b/engine/uState.ml
@@ -421,13 +421,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
@@ -609,6 +602,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
@@ -1451,6 +1445,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
@@ -1465,14 +1467,7 @@ let add_universe ?loc name strict uctx u =
 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_level_variable ?loc rigid name uctx =
   let u = UnivGen.fresh_level () in
@@ -1488,7 +1483,22 @@ let new_univ_level_variable ?loc rigid name uctx =
 
 let add_forgotten_univ uctx u = add_universe None true uctx u
 
-let from_env env = make (Environ.qualities env) (Environ.universes env)
+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_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 }
diff --git a/engine/uState.mli b/engine/uState.mli
index 716cdb2f8b8f..636a43cb1c7a 100644
--- a/engine/uState.mli
+++ b/engine/uState.mli
@@ -35,10 +35,14 @@ val empty : t
 val from_env : Environ.env -> t
 (** Main entry point at the beginning of a declaration. *)
 
+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
diff --git a/kernel/mod_typing.ml b/kernel/mod_typing.ml
index cf430b762a99..0e05c7a7f61f 100644
--- a/kernel/mod_typing.ml
+++ b/kernel/mod_typing.ml
@@ -111,7 +111,7 @@ let rec check_with_def (cst, ustate) env struc (idl, wth) mp reso =
         | Polymorphic uctx, Polymorphic ctx ->
           let () =
             if not (Subtyping.check_polymorphic_universes env uctx ctx) then
-              error (WithSignatureMismatch (IncompatibleUnivConstraints { got = ctx; expect = uctx }))
+              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
diff --git a/kernel/modops.ml b/kernel/modops.ml
index ed2821db0205..4a999cd69d83 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
 
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/subtyping.ml b/kernel/subtyping.ml
index 67b14efe4fb7..7cb459fa7304 100644
--- a/kernel/subtyping.ml
+++ b/kernel/subtyping.ml
@@ -112,7 +112,7 @@ let check_universes error env u1 u2 =
   | Monomorphic, Monomorphic -> env
   | Polymorphic auctx1, Polymorphic auctx2 ->
     if not (check_polymorphic_universes env auctx2 auctx1) then
-      error (IncompatibleUnivConstraints { got = auctx1; expect = auctx2; } )
+      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
diff --git a/kernel/uVars.ml b/kernel/uVars.ml
index adba4cf906c2..11f9c6b7e824 100644
--- a/kernel/uVars.ml
+++ b/kernel/uVars.ml
@@ -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,6 +409,10 @@ struct
     let inst = Instance.abstract_instance (size self) in
     (names, (inst, cst))
 
+  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 prq pru ?variance ctx = UContext.pr prq pru ?variance (repr ctx)
 
 end
diff --git a/kernel/uVars.mli b/kernel/uVars.mli
index e327591d4142..cfbc297a5c43 100644
--- a/kernel/uVars.mli
+++ b/kernel/uVars.mli
@@ -195,6 +195,12 @@ sig
   val names : t -> bound_names
   (** Return the names of the bound universe variables *)
 
+  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 : (QVar.t -> Pp.t) -> (Level.t -> Pp.t) -> ?variance:Variance.t array -> t -> Pp.t
 end
 
diff --git a/printing/printer.ml b/printing/printer.ml
index 5c8deab93e8e..41daf6047d62 100644
--- a/printing/printer.ml
+++ b/printing/printer.ml
@@ -227,64 +227,49 @@ 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
diff --git a/printing/printer.mli b/printing/printer.mli
index 15d6fc373cd6..2dbcf1a553d2 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.univ_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 *)
 
diff --git a/test-suite/output/UnivBinders.out b/test-suite/output/UnivBinders.out
index adaed5cf5c93..29badc0be435 100644
--- a/test-suite/output/UnivBinders.out
+++ b/test-suite/output/UnivBinders.out
@@ -88,10 +88,10 @@ foo@{uu u v} =
 Type@{u} -> Type@{v} -> Type@{uu}
      : Type@{max(uu+1,u+1,v+1)}
 (* uu u v |=  *)
-foo@{u u IMPORTANT} =
-Type@{u} -> Type@{IMPORTANT} -> Type@{u}
-     : Type@{max(u+1,u+1,IMPORTANT+1)}
-(* u u IMPORTANT |=  *)
+foo@{uu u IMPORTANT} =
+Type@{u} -> Type@{IMPORTANT} -> Type@{uu}
+     : Type@{max(uu+1,u+1,IMPORTANT+1)}
+(* uu u IMPORTANT |=  *)
 Inductive Empty@{E} : Type@{E} :=  .
 (* E |=  *)
 Record PWrap@{E} (A : Type@{E}) : Type@{E} := pwrap
@@ -120,7 +120,15 @@ Universe instance length for mono is 0 but should be 1.
 File "./output/UnivBinders.v", line 108, characters 0-33:
 The command has indeed failed with message:
 This object does not support universe names.
-File "./output/UnivBinders.v", line 112, characters 0-50:
+insec0@{i i0} : Type@{i} -> Type@{i} -> Type@{i0} -> Type@{i}
+(* i i0 |=  *)
+
+insec0 is universe polymorphic
+Arguments insec0 (foo bar baz)%_type_scope
+insec0 is transparent
+Expands to: Constant UnivBinders.insec0
+Declared in library UnivBinders, line 114, characters 13-19
+File "./output/UnivBinders.v", line 120, characters 0-50:
 The command has indeed failed with message:
 Cannot enforce v < u because u < gU < gV < v
 insec@{v} = Type@{uu} -> Type@{v}
@@ -161,26 +169,26 @@ axfoo@{i u u0} : Type@{u} -> Type@{i}
 axfoo is universe polymorphic
 Arguments axfoo _%_type_scope
 Expands to: Constant UnivBinders.axfoo
-Declared in library UnivBinders, line 151, characters 6-11
+Declared in library UnivBinders, line 159, characters 6-11
 axbar@{i u u0} : Type@{u0} -> Type@{i}
 (* i u u0 |=  *)
 
 axbar is universe polymorphic
 Arguments axbar _%_type_scope
 Expands to: Constant UnivBinders.axbar
-Declared in library UnivBinders, line 151, characters 17-22
+Declared in library UnivBinders, line 159, characters 17-22
 axfoo' : Type@{axfoo'.u0} -> Type@{axfoo'.i}
 
 axfoo' is not universe polymorphic
 Arguments axfoo' _%_type_scope
 Expands to: Constant UnivBinders.axfoo'
-Declared in library UnivBinders, line 152, characters 18-24
+Declared in library UnivBinders, line 160, characters 18-24
 axbar' : Type@{axfoo'.u1} -> Type@{axfoo'.i}
 
 axbar' is not universe polymorphic
 Arguments axbar' _%_type_scope
 Expands to: Constant UnivBinders.axbar'
-Declared in library UnivBinders, line 152, characters 30-36
+Declared in library UnivBinders, line 160, characters 30-36
 *** [ axfoo@{i u u0} : Type@{u} -> Type@{i} ]
 (* i u u0 |=  *)
 
@@ -195,7 +203,7 @@ Arguments axfoo' _%_type_scope
 *** [ axbar' : Type@{axfoo'.u1} -> Type@{axfoo'.i} ]
 
 Arguments axbar' _%_type_scope
-File "./output/UnivBinders.v", line 158, characters 19-26:
+File "./output/UnivBinders.v", line 166, characters 19-26:
 The command has indeed failed with message:
 When declaring multiple assumptions in one command, only the first name is
 allowed to mention a universe binder (which will be shared by the whole
@@ -203,9 +211,9 @@ block).
 foo@{i} = Type@{M.i} -> Type@{i}
      : Type@{max(M.i+1,i+1)}
 (* i |=  *)
-Type@{u0} -> Type@{UnivBinders.83}
-     : Type@{max(u0+1,UnivBinders.83+1)}
-(* {UnivBinders.83} |=  *)
+Type@{u0} -> Type@{UnivBinders.85}
+     : Type@{max(u0+1,UnivBinders.85+1)}
+(* {UnivBinders.85} |=  *)
 bind_univs.mono = Type@{bind_univs.mono.u}
      : Type@{bind_univs.mono.u+1}
 bind_univs.poly@{u} = Type@{u}
@@ -255,7 +263,7 @@ Arguments MutualI1' A%_type_scope
 Arguments C1' A%_type_scope p1
 Arguments MutualI2' A%_type_scope
 Arguments C2' A%_type_scope p2
-File "./output/UnivBinders.v", line 209, characters 0-33:
+File "./output/UnivBinders.v", line 217, characters 0-33:
 The command has indeed failed with message:
 Universe inconsistency. Cannot enforce a < a because a = a.
 JMeq :
@@ -264,25 +272,25 @@ forall [A : Type@{JMeq.u0}], A -> forall [B : Type@{JMeq.u1}], B -> Prop
 JMeq is template universe polymorphic on JMeq.u0 (cannot be instantiated to Prop)
 Arguments JMeq [A]%_type_scope x [B]%_type_scope _
 Expands to: Inductive UnivBinders.PartialTemplate.JMeq
-Declared in library UnivBinders, line 219, characters 10-14
-File "./output/UnivBinders.v", line 234, characters 2-38:
+Declared in library UnivBinders, line 227, characters 10-14
+File "./output/UnivBinders.v", line 242, characters 2-38:
 The command has indeed failed with message:
 Universe u0 already exists.
-File "./output/UnivBinders.v", line 241, characters 6-26:
+File "./output/UnivBinders.v", line 249, characters 6-26:
 The command has indeed failed with message:
 Tactic failure: Not equal (due to universes).
 eq_rect
      : forall (A : Type@{eq_rect.u1}) (x : A) (P : A -> Type@{eq_rect.u0}),
        P x -> forall y : A, x = y -> P y
-File "./output/UnivBinders.v", line 259, characters 18-19:
+File "./output/UnivBinders.v", line 267, characters 18-19:
 Warning: Separating sorts from universes with "|" is deprecated.
 Use ";" instead.
 [deprecated-sort-poly-syntax,deprecated-since-9.1,deprecated,default]
-File "./output/UnivBinders.v", line 259, characters 33-34:
+File "./output/UnivBinders.v", line 267, characters 33-34:
 Warning: Separating sorts from universes with "|" is deprecated.
 Use ";" instead.
 [deprecated-sort-poly-syntax,deprecated-since-9.1,deprecated,default]
-File "./output/UnivBinders.v", line 265, characters 16-17:
+File "./output/UnivBinders.v", line 273, characters 16-17:
 Warning: Separating sorts from universes with "|" is deprecated.
 Use ";" instead.
 [deprecated-sort-poly-syntax,deprecated-since-9.1,deprecated,default]
diff --git a/test-suite/output/UnivBinders.v b/test-suite/output/UnivBinders.v
index 9a81ff63db68..af12fd328a65 100644
--- a/test-suite/output/UnivBinders.v
+++ b/test-suite/output/UnivBinders.v
@@ -90,8 +90,8 @@ Fail Definition fo@{uu uu} := Type@{uu}.
 Print foo@{E M N}.
 (* Underscores discard the name if there's one. *)
 Print foo@{_ _ _}.
-(* Can use a name for multiple universes *)
-Print foo@{u u IMPORTANT}.
+(* Can highlight a single universe *)
+Print foo@{_ _ IMPORTANT}.
 
 (* Also works for inductives and records. *)
 Print Empty@{E}.
@@ -107,6 +107,14 @@ Fail Print mono@{E}.
 (* Not everything can be printed with custom universe names. *)
 Fail Print Stdlib.Init.Logic@{E}.
 
+(* Case where a universe name appears more than one *)
+Section SomeSec0.
+  Universe i.
+  Context (foo : Type@{i}) (bar : Type@{i}).
+  Definition insec0@{i} (baz : Type@{i}) := foo -> bar.
+End SomeSec0.
+About insec0.
+
 (* Nice error when constraints are impossible. *)
 Monomorphic Universes gU gV. Monomorphic Constraint gU < gV.
 Fail Lemma foo'@{u v|u < gU, gV < v, v < u} : nat.
diff --git a/vernac/himsg.ml b/vernac/himsg.ml
index f9740321db60..fc20d314f060 100644
--- a/vernac/himsg.ml
+++ b/vernac/himsg.ml
@@ -1305,14 +1305,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_ustate
-          (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)
diff --git a/vernac/prettyp.ml b/vernac/prettyp.ml
index 2ffb490eec7e..d4f6b90320b0 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_ustate (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)
@@ -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_ustate (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
@@ -576,11 +574,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_ustate 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
diff --git a/vernac/printmod.ml b/vernac/printmod.ml
index cf85288fc185..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_ustate (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_ustate (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 ->

From 88bc5baeb7c9344aca1b8f017a764a91517746d5 Mon Sep 17 00:00:00 2001
From: Yann Leray <yann.leray@inria.fr>
Date: Fri, 13 Mar 2026 15:32:55 +0100
Subject: [PATCH 281/578] overlay

---
 dev/ci/user-overlays/21737-Yann-Leray-ustate-of-names.sh | 1 +
 1 file changed, 1 insertion(+)
 create mode 100644 dev/ci/user-overlays/21737-Yann-Leray-ustate-of-names.sh

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

From eb907d086ee6b1f75192ba2b20e89a05076a3244 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Mon, 23 Mar 2026 13:18:36 +0100
Subject: [PATCH 282/578] Fix anomaly in fix guard check reducing nested cofix

Fix #21795
---
 kernel/inductive.ml         | 24 +++++++++++-------------
 test-suite/bugs/bug_21795.v |  8 ++++++++
 2 files changed, 19 insertions(+), 13 deletions(-)
 create mode 100644 test-suite/bugs/bug_21795.v

diff --git a/kernel/inductive.ml b/kernel/inductive.ml
index 576b74218146..b1761499145e 100644
--- a/kernel/inductive.ml
+++ b/kernel/inductive.ml
@@ -1452,6 +1452,14 @@ let pop_argument ?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. *)
@@ -1518,14 +1526,9 @@ let check_one_fix ?evars renv recpos trees def =
             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 _
@@ -1622,12 +1625,7 @@ let check_one_fix ?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 _
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." *)

From a71c7061fd92fbec06feccc9d1c485b0b3e5bc99 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Mon, 23 Mar 2026 13:30:16 +0100
Subject: [PATCH 283/578] Add comment about interaction of Control.case and
 state
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

BTW this means that in the doc
`case (fun () => plus (fun () => t) f) ≡ Val (t,f)`
is incorrect.

eg

~~~coq
Ltac2 Eval match Control.case (fun () => Control.plus (fun () => ()) (fun _ => ())) with
  | Err  e => Control.zero e (* dead branch *)
  | Val ((), k) => let c := '(_ :> nat) in k Not_found; Constr.type c
  end.
~~~
gives `Anomaly "Evar ?X1 was not declared."` even though

~~~coq
Ltac2 Eval match Val ((), (fun _ => ())) with
  | Err  e => Control.zero e (* dead branch *)
  | Val ((), k) => let c := '(_ :> nat) in k Not_found; Constr.type c
  end.
~~~
is fine.
---
 theories/Ltac2/Control.v | 6 +++++-
 1 file changed, 5 insertions(+), 1 deletion(-)

diff --git a/theories/Ltac2/Control.v b/theories/Ltac2/Control.v
index 03d51bb12717..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 :=

From 77d0f01ad405f881d99b854c2eba24ef7b5af9bd Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Mon, 23 Mar 2026 13:41:21 +0100
Subject: [PATCH 284/578] Remove unused has_eta output of
 inductive_make_projections

---
 kernel/cClosure.ml        | 2 +-
 kernel/declareops.ml      | 4 ++--
 kernel/declareops.mli     | 2 +-
 kernel/environ.ml         | 2 +-
 plugins/ltac2/tac2core.ml | 1 -
 5 files changed, 5 insertions(+), 6 deletions(-)

diff --git a/kernel/cClosure.ml b/kernel/cClosure.ml
index c24fd9879b10..9e5a4e606049 100644
--- a/kernel/cClosure.ml
+++ b/kernel/cClosure.ml
@@ -957,7 +957,7 @@ let eta_expand_ind_stack env (ind,u) m (f, s') =
   in
   match Declareops.inductive_make_projections ind mib with
   | None -> assert false
-  | Some (projs, _) ->
+  | Some projs ->
     (* (Construct, pars1 .. parsm :: arg1...argn :: []) ~= (f, s') ->
            arg1..argn ~= (proj1 t...projn t) where t = zip (f,s') *)
     let pars = mib.Declarations.mind_nparams in
diff --git a/kernel/declareops.ml b/kernel/declareops.ml
index 7322ed8e39ff..0e535c1ee8d9 100644
--- a/kernel/declareops.ml
+++ b/kernel/declareops.ml
@@ -305,12 +305,12 @@ 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
diff --git a/kernel/declareops.mli b/kernel/declareops.mli
index daa4d4dd5588..980c3d4c67d0 100644
--- a/kernel/declareops.mli
+++ b/kernel/declareops.mli
@@ -73,7 +73,7 @@ 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
 
diff --git a/kernel/environ.ml b/kernel/environ.ml
index 65cd4df5fed2..e330b4369dac 100644
--- a/kernel/environ.ml
+++ b/kernel/environ.ml
@@ -808,7 +808,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 =
diff --git a/plugins/ltac2/tac2core.ml b/plugins/ltac2/tac2core.ml
index 3e779c0a8801..cec677a93d48 100644
--- a/plugins/ltac2/tac2core.ml
+++ b/plugins/ltac2/tac2core.ml
@@ -1361,7 +1361,6 @@ 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))
 
 (** Proj *)

From 5def30ce6d3a0b3363635584c7290f8f2fb71348 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Mon, 23 Mar 2026 14:35:20 +0100
Subject: [PATCH 285/578] VM/native support inductive cumulativity

Fix #21777
---
 kernel/conversion.mli       |  6 +++++-
 kernel/nativeconv.ml        | 16 +++++++++++++++-
 kernel/vconv.ml             | 18 ++++++++++++++++--
 test-suite/bugs/bug_21777.v | 23 +++++++++++++++++++++++
 4 files changed, 59 insertions(+), 4 deletions(-)
 create mode 100644 test-suite/bugs/bug_21777.v

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/nativeconv.ml b/kernel/nativeconv.ml
index 3ff5907a6257..51cc0270ff01 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,7 +110,14 @@ 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 Ind.CanOrd.equal 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
diff --git a/kernel/vconv.ml b/kernel/vconv.ml
index d675d352a8f2..91e7c645e830 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
@@ -114,7 +121,8 @@ and conv_atom env pb k a1 stk1 a2 stk2 cu =
   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
+      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,7 +131,13 @@ 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 *)
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}).

From cb2b3446b05ac7c37c422e6df9ba982db447deed Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Thu, 19 Mar 2026 13:23:56 +0100
Subject: [PATCH 286/578] Records in constant sort can have postponed eta (with
 proj in variable sort)

---
 kernel/indTyping.ml                       | 11 +++++++++--
 test-suite/success/record_postponed_eta.v | 10 ++++++++++
 2 files changed, 19 insertions(+), 2 deletions(-)

diff --git a/kernel/indTyping.ml b/kernel/indTyping.ml
index 9ccfc17e502a..c62e963c6fcd 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. *)
@@ -100,13 +102,13 @@ let compute_elim_squash ?(is_real_arg=false) env u info =
   let info = if not is_real_arg then info
     else match info.record_arg_info with
       | HasRelevantArg -> info
-      | NoRelevantArg -> match u with
+      | NoRelevantArg | MaybeRelevantArg -> match u with
         | Sorts.SProp -> info
         | QSort (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
+          else { info with record_arg_info = MaybeRelevantArg }
         | Prop | Set | Type _ -> { info with record_arg_info = HasRelevantArg }
   in
   if Environ.ignore_elim_constraints env then info else
@@ -241,6 +243,11 @@ let check_record data =
         | None -> (* Otherwise, we allow primitive projections but check if it has eta *)
             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
diff --git a/test-suite/success/record_postponed_eta.v b/test-suite/success/record_postponed_eta.v
index aade41b290e2..002337db6643 100644
--- a/test-suite/success/record_postponed_eta.v
+++ b/test-suite/success/record_postponed_eta.v
@@ -118,3 +118,13 @@ Section Sorts.
   Goal forall (A:Type@{s;0}) (r2 : RSToS'@{s s;0 0} A), eq r2 {| f4 := r2.(f4 A) |}.
   Proof. intros A r2. reflexivity. Qed.
 End Sorts.
+
+Record MaybeRelevant@{s;+} (A:Type@{s;_}) := { mayberelevant : A }.
+Definition notrelevant@{s;+} (A:Type@{s;_}) (x:MaybeRelevant A) : x = {| mayberelevant := x.(mayberelevant _) |}.
+Proof.
+  Fail reflexivity.
+Abort.
+Definition relevant (A:Prop) (x:MaybeRelevant A) : x = {| mayberelevant := x.(mayberelevant _) |}.
+Proof.
+  reflexivity.
+Qed.

From a1bd23b992ca24d74f006316949c822390380598 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Fri, 27 Feb 2026 15:06:38 +0100
Subject: [PATCH 287/578] Fix handling of configure time VM disabling

---
 sysinit/coqargs.ml                               | 16 +++++++++++-----
 sysinit/coqargs.mli                              |  1 +
 sysinit/coqinit.ml                               |  6 ++++++
 .../Corelib/Numbers/Cyclic/Int63/Sint63Axioms.v  |  2 +-
 .../Corelib/Numbers/Cyclic/Int63/Uint63Axioms.v  |  2 +-
 5 files changed, 20 insertions(+), 7 deletions(-)

diff --git a/sysinit/coqargs.ml b/sysinit/coqargs.ml
index 141e6cec5ecf..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
 
@@ -106,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;
@@ -120,8 +119,8 @@ 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;
@@ -229,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
@@ -345,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
diff --git a/sysinit/coqargs.mli b/sysinit/coqargs.mli
index fa04c49c55be..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
diff --git a/sysinit/coqinit.ml b/sysinit/coqinit.ml
index a588d88b1067..d6f777fbb8de 100644
--- a/sysinit/coqinit.ml
+++ b/sysinit/coqinit.ml
@@ -219,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," ++
@@ -253,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/theories/Corelib/Numbers/Cyclic/Int63/Sint63Axioms.v b/theories/Corelib/Numbers/Cyclic/Int63/Sint63Axioms.v
index 297b4640c0fc..0ad8ea8daee8 100644
--- a/theories/Corelib/Numbers/Cyclic/Int63/Sint63Axioms.v
+++ b/theories/Corelib/Numbers/Cyclic/Int63/Sint63Axioms.v
@@ -20,7 +20,7 @@ Local Infix "^" := Z.pow : Z_scope.
 Local Notation "x <= y" := (Z.compare x y <> Gt) : Z_scope.
 Local Notation "x < y" := (Z.compare x y = Lt) : Z_scope.
 
-Definition min_int := Eval vm_compute in (lsl 1 62).
+Definition min_int := Eval lazy in (lsl 1 62).
 
 (** Translation to and from Z *)
 Definition to_Z (i : int) :=
diff --git a/theories/Corelib/Numbers/Cyclic/Int63/Uint63Axioms.v b/theories/Corelib/Numbers/Cyclic/Int63/Uint63Axioms.v
index ba73c75c5a20..5b05142a16a9 100644
--- a/theories/Corelib/Numbers/Cyclic/Int63/Uint63Axioms.v
+++ b/theories/Corelib/Numbers/Cyclic/Int63/Uint63Axioms.v
@@ -32,7 +32,7 @@ Definition size := 63%nat.
 Definition digits := 63%uint63.
 
 (** The biggest int *)
-Definition max_int := Eval vm_compute in sub 0 1.
+Definition max_int := Eval lazy in sub 0 1.
 
 (** Access to the nth digits *)
 Definition get_digit x p := ltb 0 (land x (lsl 1 p)).

From e19db3b061f0af7acf5881c98781793f25141625 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Mon, 2 Mar 2026 14:49:17 +0100
Subject: [PATCH 288/578] Checker warn if given -bytecode-compiler and VM
 configured off

---
 checker/coqchk_main.ml | 13 ++++++++++++-
 1 file changed, 12 insertions(+), 1 deletion(-)

diff --git a/checker/coqchk_main.ml b/checker/coqchk_main.ml
index 8ec2cf428ad2..cc288948a20b 100644
--- a/checker/coqchk_main.ml
+++ b/checker/coqchk_main.ml
@@ -146,11 +146,22 @@ let indices_matter = ref false
 
 let enable_vm = 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
 

From 8aed08f147e533382663043829b9b758072f422d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Fri, 27 Feb 2026 15:11:20 +0100
Subject: [PATCH 289/578] More robust handling of env typing flags wrt
 configure VM/native disabling

---
 kernel/declareops.ml | 8 ++++++--
 kernel/environ.ml    | 7 +++++++
 2 files changed, 13 insertions(+), 2 deletions(-)

diff --git a/kernel/declareops.ml b/kernel/declareops.ml
index 0e535c1ee8d9..42dc2e517334 100644
--- a/kernel/declareops.ml
+++ b/kernel/declareops.ml
@@ -19,6 +19,10 @@ 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;
@@ -27,8 +31,8 @@ let safe_flags oracle = {
   conv_oracle = oracle;
   share_reduction = true;
   unfold_dep_heuristic = false;
-  enable_VM = true;
-  enable_native_compiler = true;
+  enable_VM = Coq_config.bytecode_compiler;
+  enable_native_compiler = configure_enabled_native;
   indices_matter = true;
   impredicative_set = false;
   sprop_allowed = true;
diff --git a/kernel/environ.ml b/kernel/environ.ml
index e330b4369dac..83d92be35e7b 100644
--- a/kernel/environ.ml
+++ b/kernel/environ.ml
@@ -598,11 +598,18 @@ 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

From 2a8f61f6b6f93ed31d77dc5815a9b74059371af4 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Fri, 27 Feb 2026 15:11:54 +0100
Subject: [PATCH 290/578] Vmbytegen.compile return None if VM disabled

---
 kernel/vmbytegen.ml | 1 +
 1 file changed, 1 insertion(+)

diff --git a/kernel/vmbytegen.ml b/kernel/vmbytegen.ml
index cef33cd6a45a..f4b05057234b 100644
--- a/kernel/vmbytegen.ml
+++ b/kernel/vmbytegen.ml
@@ -975,6 +975,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

From 5be5b7aeb13ba5f7e16edbb89d7ea87e6ecabd8b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Wed, 25 Mar 2026 14:53:55 +0100
Subject: [PATCH 291/578] reindent cbv_stack_value

for some reason the FIX reduction case was indented as though it was
part of the LAMBDA case.
---
 pretyping/cbv.ml | 174 ++++++++++++++++++++++++-----------------------
 1 file changed, 88 insertions(+), 86 deletions(-)

diff --git a/pretyping/cbv.ml b/pretyping/cbv.ml
index e228c3aab231..2df407ce7702 100644
--- a/pretyping/cbv.ml
+++ b/pretyping/cbv.ml
@@ -633,99 +633,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,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)
 
 and cbv_value_cache info ref =
   try KeyTable.find info.tab ref with

From 8cdc39bc78f39c54dd1be83ed38a345c9df81616 Mon Sep 17 00:00:00 2001
From: Matthieu Sozeau <mattam@mattam.org>
Date: Wed, 25 Mar 2026 15:11:34 +0100
Subject: [PATCH 292/578] Avoid C23 extension warning

---
 kernel/byterun/rocq_values.c | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/kernel/byterun/rocq_values.c b/kernel/byterun/rocq_values.c
index 845a703db551..ccc9d1920b50 100644
--- a/kernel/byterun/rocq_values.c
+++ b/kernel/byterun/rocq_values.c
@@ -123,7 +123,7 @@ value rocq_tcode_array(value tcodes) {
 
 #ifdef NO_NATIVE_COMPUTE
 
-value rocq_curry2_1_addr(value) {
+value rocq_curry2_1_addr(value v) {
   return Val_unit;
 }
 
@@ -152,14 +152,14 @@ asm(".align 4\n\t"
 #error "Unsupported architecture for native_compute."
 #endif
 
-value rocq_curry2_1_addr(value) {
+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) {
+value rocq_curry2_1_addr(value v) {
   extern void caml_curry2_1() __attribute__((weak));
   return (value)&caml_curry2_1;
 }

From 945fdcd0dfaba30295f3ed6654af92ec6885951d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Thu, 5 Mar 2026 14:53:37 +0100
Subject: [PATCH 293/578] QGlobal is not QVar

---
 checker/coqchk_main.ml                        |   4 +-
 checker/safe_checking.ml                      |   8 +-
 checker/values.ml                             |  19 +-
 .../21767-SkySkimmer-qglobal-not-qvar.sh      |  15 +
 dev/top_printers.ml                           |  35 ++-
 dev/vm_printers.ml                            |   3 +-
 engine/eConstr.ml                             |  17 +-
 engine/eConstr.mli                            |   3 +-
 engine/evd.ml                                 |   5 +-
 engine/evd.mli                                |   3 +
 engine/namegen.ml                             |   2 +-
 engine/termops.ml                             |  10 +-
 engine/termops.mli                            |   2 +
 engine/uState.ml                              | 121 +++++---
 engine/uState.mli                             |   4 +
 engine/univGen.ml                             |  11 +-
 engine/univGen.mli                            |   5 +-
 engine/univNames.ml                           |  19 +-
 engine/univNames.mli                          |   7 +-
 interp/constrexpr.mli                         |  11 +-
 interp/constrexpr_ops.ml                      |  14 +-
 interp/constrextern.ml                        |  17 +-
 interp/constrintern.ml                        |  27 +-
 interp/notation_ops.ml                        |   2 +-
 interp/primNotations.ml                       |   5 +-
 kernel/cClosure.ml                            |   2 +-
 kernel/constr.ml                              |   4 +-
 kernel/environ.ml                             |  19 +-
 kernel/environ.mli                            |   9 +-
 kernel/genlambda.ml                           |   9 +-
 kernel/indTyping.ml                           |  32 ++-
 kernel/inductive.ml                           |  20 +-
 kernel/pConstraints.ml                        |   4 +-
 kernel/pConstraints.mli                       |   2 +-
 kernel/qGraph.ml                              |  76 ++---
 kernel/qGraph.mli                             |  10 +-
 kernel/safe_typing.ml                         |  66 ++---
 kernel/safe_typing.mli                        |   4 +-
 kernel/section.ml                             |   3 +
 kernel/section.mli                            |   2 +
 kernel/sorts.ml                               | 262 ++++++++++++------
 kernel/sorts.mli                              |  57 +++-
 kernel/type_errors.ml                         |   2 +-
 kernel/type_errors.mli                        |   4 +-
 kernel/typeops.ml                             |  42 +--
 kernel/uGraph.ml                              |  33 ++-
 kernel/uGraph.mli                             |   6 +-
 kernel/uVars.ml                               |  26 +-
 kernel/uVars.mli                              |   8 +-
 kernel/vars.ml                                |  14 +-
 kernel/vars.mli                               |   4 +-
 kernel/vmbytecodes.ml                         |   2 +-
 kernel/vmbytegen.ml                           |   4 +-
 kernel/vmvalues.ml                            |  14 +-
 lib/acyclicGraph.ml                           |   2 +
 lib/acyclicGraph.mli                          |   2 +
 library/global.ml                             |   3 +-
 library/global.mli                            |   3 +-
 library/nametab.ml                            |   4 +-
 library/nametab.mli                           |   2 +-
 parsing/g_constr.mlg                          |   6 +-
 plugins/extraction/extraction.ml              |   2 +-
 plugins/extraction/miniml.ml                  |   3 +-
 plugins/funind/g_indfun.mlg                   |   2 +-
 plugins/funind/indfun.ml                      |   1 +
 plugins/ltac/taccoerce.ml                     |   8 +-
 pretyping/cases.ml                            |   2 +-
 pretyping/detyping.ml                         |  12 +-
 pretyping/evarsolve.ml                        |   7 +-
 pretyping/glob_ops.ml                         |  18 +-
 pretyping/glob_ops.mli                        |   3 +-
 pretyping/glob_term.mli                       |  12 +-
 pretyping/inductiveops.ml                     |   3 +
 pretyping/pretyping.ml                        |  61 ++--
 pretyping/retyping.ml                         |  11 +-
 pretyping/structures.ml                       |   2 +-
 pretyping/typing.ml                           |  42 +--
 printing/ppconstr.ml                          |  13 +-
 printing/printer.ml                           |  17 +-
 tactics/allScheme.ml                          |  14 +-
 tactics/cbn.ml                                |   5 +-
 tactics/elimschemes.ml                        |   7 +-
 tactics/eqschemes.ml                          |   2 +-
 tactics/tactics.ml                            |   2 +-
 test-suite/output/DeclareSort.out             |  14 +-
 test-suite/output/UnivNotations.out           |   2 +-
 test-suite/output/sort_poly_elab.out          | 192 +++++++------
 test-suite/output/sort_poly_elab.v            |   7 +
 test-suite/success/sort_poly_elim_csts.v      |   4 +-
 vernac/comInductive.ml                        |  36 +--
 vernac/comRewriteRule.ml                      |  55 ++--
 vernac/declareUniv.ml                         |  62 +++--
 vernac/himsg.ml                               |  27 +-
 vernac/indschemes.ml                          |   4 +-
 vernac/ppvernac.ml                            |   6 +-
 vernac/prettyp.ml                             |  12 +-
 vernac/record.ml                              |   2 +-
 vernac/vernacentries.ml                       |   7 +-
 98 files changed, 1009 insertions(+), 801 deletions(-)
 create mode 100644 dev/ci/user-overlays/21767-SkySkimmer-qglobal-not-qvar.sh

diff --git a/checker/coqchk_main.ml b/checker/coqchk_main.ml
index 8ec2cf428ad2..0023783717e3 100644
--- a/checker/coqchk_main.ml
+++ b/checker/coqchk_main.ml
@@ -256,7 +256,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 +264,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 ".")
diff --git a/checker/safe_checking.ml b/checker/safe_checking.ml
index 3f79d1aac84c..6c1a208902a2 100644
--- a/checker/safe_checking.ml
+++ b/checker/safe_checking.ml
@@ -18,11 +18,11 @@ let import senv opac clib vmtab digest =
   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 = Environ.link_vm_library vmtab env in
   let opac = Mod_checking.check_module env opac retro (Names.ModPath.MPfile dp) mb in
diff --git a/checker/values.ml b/checker/values.ml
index 820fc300c16c..6a115e9f6f91 100644
--- a/checker/values.ml
+++ b/checker/values.ml
@@ -188,11 +188,11 @@ let v_univ = v_list v_expr
 let v_qglobal = v_pair v_dp v_id
 
 (* 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|]
@@ -608,7 +610,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_retroknowledge|]
+  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/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/top_printers.ml b/dev/top_printers.ml
index 5109e6c10e75..075c5bc8bc6d 100644
--- a/dev/top_printers.ml
+++ b/dev/top_printers.ml
@@ -287,29 +287,32 @@ 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
@@ -325,13 +328,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 +435,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 +598,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)
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/engine/eConstr.ml b/engine/eConstr.ml
index f31e880d4529..8549606e84b6 100644
--- a/engine/eConstr.ml
+++ b/engine/eConstr.ml
@@ -881,19 +881,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
@@ -901,8 +896,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
@@ -913,7 +910,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
diff --git a/engine/eConstr.mli b/engine/eConstr.mli
index ef42c242fa35..9850237d7956 100644
--- a/engine/eConstr.mli
+++ b/engine/eConstr.mli
@@ -355,7 +355,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} *)
 
diff --git a/engine/evd.ml b/engine/evd.ml
index 8897db09d0b7..b7f5c199162a 100644
--- a/engine/evd.ml
+++ b/engine/evd.ml
@@ -1021,6 +1021,9 @@ 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
@@ -1077,7 +1080,7 @@ let new_sort_info ?loc ?sort_rigid ?name rigid sigma =
 
 let new_sort_variable ?loc ?sort_rigid ?name rigid sigma =
   let sigma, q, u = new_sort_info ?loc ?sort_rigid ?name rigid sigma in
-  sigma, Sorts.qsort q u
+  sigma, Sorts.vsort q u
 
 let add_forgotten_univ d u =
   { d with universes = UState.add_forgotten_univ d.universes u }
diff --git a/engine/evd.mli b/engine/evd.mli
index 7c28b237c9ac..7d345a43b52d 100644
--- a/engine/evd.mli
+++ b/engine/evd.mli
@@ -616,6 +616,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 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
 val universe_subst : evar_map -> UnivFlex.t
diff --git a/engine/namegen.ml b/engine/namegen.ml
index 108ac00b9013..5494bc998e47 100644
--- a/engine/namegen.ml
+++ b/engine/namegen.ml
@@ -145,7 +145,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 =
diff --git a/engine/termops.ml b/engine/termops.ml
index 8ba3fcb0182d..ca847f029053 100644
--- a/engine/termops.ml
+++ b/engine/termops.ml
@@ -267,8 +267,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
@@ -1033,8 +1037,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
diff --git a/engine/termops.mli b/engine/termops.mli
index 9c162ed3e7f1..4b50dfffecbb 100644
--- a/engine/termops.mli
+++ b/engine/termops.mli
@@ -235,7 +235,9 @@ 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
 
 module Internal : sig
 
diff --git a/engine/uState.ml b/engine/uState.ml
index 6b67effc29f0..ca004abb330b 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
@@ -102,7 +102,7 @@ module QState : sig
   val undefined : t -> QVar.Set.t
   val collapse_above_prop : to_prop:bool -> t -> t
   val collapse : ?except:QVar.Set.t -> ?to_type:bool -> t -> t
-  val pr : (QVar.t -> Libnames.qualid option) -> t -> Pp.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
@@ -137,32 +137,40 @@ let empty = { qmap = QMap.empty; above_prop = QSet.empty;
 let rec repr q m = match QMap.find q m.qmap with
 | Canonical _ -> QVar q
 | Equiv (QVar q) -> repr q m
-| Equiv (QConstant _ as q) -> q
+| 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 q m = match QMap.find q m.qmap with
+let rec repr_node_qvar q m = match QMap.find q m.qmap with
 | Canonical { rigid } -> ReprVar (q, rigid)
-| Equiv (QVar q) -> repr_node q m
-| Equiv (QConstant qc) -> ReprConstant qc
+| 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 = match repr_node q m with
+let is_rigid m q = match repr_node_qvar q m with
 | ReprVar (_, rigid) -> rigid
-| ReprConstant _ -> true
+| ReprConstant _ | ReprGlobal _ -> true
 
 let set q qv m =
-  let q = repr_node q m in
-  let q, rigid = match q with ReprVar (q, rigid) -> q, rigid | ReprConstant _ -> assert false in
-  let qv = match qv with QVar qv -> repr_node qv m | QConstant qc -> ReprConstant qc in
+  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
@@ -188,10 +196,18 @@ let set q qv m =
       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_node q m in
-  let q, rigid = match q with ReprVar (q, rigid) -> q, rigid | ReprConstant _ -> assert false in
+  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 }
 
@@ -199,6 +215,7 @@ 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
@@ -210,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
@@ -226,7 +244,7 @@ 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 =
@@ -284,11 +302,7 @@ let add ~check_fresh ~rigid q m =
     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 elims; initial_elims }
+  { empty with elims; initial_elims = elims }
 
 (* XXX what about qvars in the elimination graph? *)
 let undefined m =
@@ -345,13 +359,8 @@ let collapse ?(except=QSet.empty) ?(to_type = true) m =
         else if to_type then Option.get (set q qtype m) else m)
     m.qmap m
 
-let pr prqvar_opt ({ qmap; elims } as 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
   | Canonical { rigid } ->
@@ -364,13 +373,13 @@ let pr prqvar_opt ({ qmap; elims } as m) =
     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
+  let prqvar_name q = match local_name q with
   | None -> mt ()
-  | Some qid -> str " (named " ++ Libnames.pr_qualid qid ++ str ")"
+  | 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
 
@@ -383,7 +392,7 @@ 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
@@ -442,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)))
@@ -456,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
@@ -488,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
@@ -559,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))
@@ -664,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? *)
@@ -697,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
@@ -1016,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
@@ -1171,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';
@@ -1617,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
   ()
 
@@ -1630,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 636a43cb1c7a..1b9f05d361cf 100644
--- a/engine/uState.mli
+++ b/engine/uState.mli
@@ -284,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 c48960cde543..58e188f2d479 100644
--- a/engine/univGen.ml
+++ b/engine/univGen.ml
@@ -71,7 +71,7 @@ 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
 end
@@ -91,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;
@@ -215,6 +215,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 a1a7fe9b00a7..c444ebbeaee9 100644
--- a/engine/univGen.mli
+++ b/engine/univGen.mli
@@ -37,7 +37,7 @@ 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
@@ -76,8 +76,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 2689cb1e1975..bb8d51620a64 100644
--- a/engine/univNames.ml
+++ b/engine/univNames.ml
@@ -35,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 80b04c0cd07a..2daa40a957ba 100644
--- a/engine/univNames.mli
+++ b/engine/univNames.mli
@@ -27,5 +27,8 @@ 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/interp/constrexpr.mli b/interp/constrexpr.mli
index fedaac086130..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
 
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 b8b9a51d731b..9668ef64bb96 100644
--- a/interp/constrextern.ml
+++ b/interp/constrextern.ml
@@ -782,28 +782,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
@@ -1509,6 +1505,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
diff --git a/interp/constrintern.ml b/interp/constrintern.ml
index 39b4e502129d..35ff54ca4669 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
@@ -3156,15 +3153,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
@@ -3184,7 +3181,7 @@ let interp_elim_constraints env evd 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/notation_ops.ml b/interp/notation_ops.ml
index 2f5d3bec7801..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 ->
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/cClosure.ml b/kernel/cClosure.ml
index 9e5a4e606049..bbe304a4107b 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;
diff --git a/kernel/constr.ml b/kernel/constr.ml
index e8896c649382..84a87787962c 100644
--- a/kernel/constr.ml
+++ b/kernel/constr.ml
@@ -1537,7 +1537,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
@@ -1600,7 +1600,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/environ.ml b/kernel/environ.ml
index e330b4369dac..8015cf20dbff 100644
--- a/kernel/environ.ml
+++ b/kernel/environ.ml
@@ -374,7 +374,7 @@ 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
@@ -388,7 +388,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}
@@ -542,10 +541,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
@@ -553,7 +554,7 @@ 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
 
 let push_subgraph (levels, univ_csts) env =
   let add_subgraph g =
@@ -1179,7 +1180,7 @@ module Internal = struct
       env_named_context : named_context_val;
       env_rel_context   : rel_context_val;
       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;
     }
@@ -1192,7 +1193,7 @@ module Internal = struct
       env_named_context = env.env_named_context;
       env_rel_context = env.env_rel_context;
       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"]
diff --git a/kernel/environ.mli b/kernel/environ.mli
index 235ad7033de3..7b2db5101eaf 100644
--- a/kernel/environ.mli
+++ b/kernel/environ.mli
@@ -73,7 +73,6 @@ 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
@@ -393,11 +392,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
@@ -516,7 +519,7 @@ module Internal : sig
       env_named_context : named_context_val;
       env_rel_context   : rel_context_val;
       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 9500f2cbb442..6a1ac12e86e7 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
diff --git a/kernel/indTyping.ml b/kernel/indTyping.ml
index e1c017a9f4de..927b10848efe 100644
--- a/kernel/indTyping.ml
+++ b/kernel/indTyping.ml
@@ -102,14 +102,15 @@ let compute_elim_squash ?(is_real_arg=false) env u info =
   let info = if not is_real_arg then info
     else match info.record_arg_info with
       | HasRelevantArg -> info
-      | NoRelevantArg | MaybeRelevantArg -> 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 with record_arg_info = MaybeRelevantArg }
-        | Prop | Set | Type _ -> { info with record_arg_info = HasRelevantArg }
   in
   if Environ.ignore_elim_constraints env then info else
   let indu = info.ind_univ in
@@ -122,7 +123,7 @@ let compute_elim_squash ?(is_real_arg=false) env u 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 *)
-    | QSort (q, _), (SProp | Prop) when Environ.Internal.is_above_prop env q -> info
+    | 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 =
@@ -267,8 +268,8 @@ let check_record data =
               (* 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 MaybeEta (* For sort variables it depends on the instantiation *)
+              | 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
@@ -315,7 +316,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
@@ -366,7 +367,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 " ++
@@ -444,11 +448,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
@@ -479,7 +483,7 @@ let get_template (mie:mutual_inductive_entry) = match mie.mind_entry_universes w
     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
+        | (QConstant _ | QGlobal _), _ -> 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."))
diff --git a/kernel/inductive.ml b/kernel/inductive.ml
index b1761499145e..4c7dd71807b8 100644
--- a/kernel/inductive.ml
+++ b/kernel/inductive.ml
@@ -132,7 +132,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 +152,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 +245,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 +275,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
@@ -439,7 +441,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
 
@@ -1790,7 +1792,7 @@ let sorts_of_mutfix env minds names =
         let out_sort = match names.(i).Context.binder_relevance with
           | Irrelevant -> Sorts.sprop
           | Relevant -> Sorts.prop
-          | RelevanceVar q -> Sorts.qsort q u in
+          | RelevanceVar q -> Sorts.vsort q u in
         (ind_sort, out_sort) :: sorts
       ) [] minds)
 
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 55f3644d23a8..6185f1f52056 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
@@ -104,7 +105,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'.
@@ -166,40 +167,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
@@ -250,13 +247,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 =
@@ -293,6 +295,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 =
@@ -325,14 +329,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
 
diff --git a/kernel/qGraph.mli b/kernel/qGraph.mli
index 1a21bd122752..73be73f26cb4 100644
--- a/kernel/qGraph.mli
+++ b/kernel/qGraph.mli
@@ -40,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 =
@@ -96,13 +96,15 @@ 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 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/safe_typing.ml b/kernel/safe_typing.ml
index c9395bbff9b3..7f5ab8d5826e 100644
--- a/kernel/safe_typing.ml
+++ b/kernel/safe_typing.ml
@@ -176,7 +176,7 @@ 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;
@@ -193,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;
@@ -229,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;
@@ -262,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 = [];
@@ -559,25 +560,25 @@ 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 push_qualities (qs,qcsts) senv =
+  if Sorts.QGlobal.Set.is_empty qs && 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
+    let qs' =
+      Sorts.QGlobal.Set.fold (fun q acc -> Sorts.Quality.Set.add (QGlobal q) acc)
+        qs
+        Sorts.Quality.Set.empty
     in
-    let () = Sorts.QVar.Set.iter check_local (fst qs) in
+    let env = Environ.push_qualities qs' senv.env in
+    let env = Environ.merge_elim_constraints ~rigid:true qcsts env in
     { senv with
-      env = Environ.push_qualities ~rigid qs senv.env ;
-      qualities = Sorts.QContextSet.union qs senv.qualities ;
+      env;
+      qualities = Sorts.QGlobal.Set.union qs senv.qualities;
+      elims = Sorts.ElimConstraints.union qcsts senv.elims;
     }
 
 let is_curmod_library senv =
@@ -697,11 +698,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
   if not @@ Sorts.QVar.Set.for_all check_quality (fst qctx) then
-    CErrors.user_err Pp.(str "Implicit section-wide sort variables and elimination constraints are not allowed.");
+    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 _ -> ()
@@ -710,11 +711,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 } *)
 
@@ -1346,6 +1348,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 *)
@@ -1576,7 +1579,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;
@@ -1603,7 +1607,7 @@ 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_retro = senv.local_retroknowledge;
@@ -1624,11 +1628,11 @@ let import lib vmtab vodigest senv =
   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
@@ -1664,7 +1668,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;
@@ -1683,10 +1687,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)
diff --git a/kernel/safe_typing.mli b/kernel/safe_typing.mli
index 17e1422cf1d2..e01d0632fad0 100644
--- a/kernel/safe_typing.mli
+++ b/kernel/safe_typing.mli
@@ -157,7 +157,7 @@ val push_context_set :
 
 (** Adding global sort qualities *)
 
-val push_qualities : rigid:bool -> Sorts.QContextSet.t -> safe_transformer0
+val push_qualities : Sorts.QGlobal.Set.t * Sorts.ElimConstraints.t -> safe_transformer0
 
 (* (\** Generator of universes *\) *)
 (* val next_universe : int safe_transformer *)
@@ -239,7 +239,7 @@ 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
 
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 dd5cec5f0217..26bfd37d58fd 100644
--- a/kernel/sorts.ml
+++ b/kernel/sorts.ml
@@ -36,36 +36,58 @@ module QGlobal = struct
 
   let to_string { library = d ; id } =
     DirPath.to_string d ^ "." ^ Id.to_string id
+
+  let raw_pr id = Pp.str @@ Printf.sprintf "γ%s" (to_string id)
+
+  module Hstruct = struct
+    type nonrec t = t
+
+    let hashcons ({ library; id } as v) =
+      let hl, l' = DirPath.hcons library in
+      let hid, id' =  Id.hcons id in
+      let v = if l' == library && id' == id then v else { library = l'; id = id' } in
+      Hashset.Combine.combine hl hid, v
+
+    let eq a b = a.library == b.library && a.id == b.id
+  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
-
-  let name = function
-  | Global id -> Some id
-  | Var _ -> None
-  | Unif _ -> 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
@@ -74,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)
@@ -93,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 =
@@ -143,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
@@ -187,31 +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_pr q = pr QVar.raw_pr q
+  let raw_printer = {
+    prvar = QVar.raw_pr;
+    prglobal = QGlobal.raw_pr;
+  }
+
+  let raw_pr q = pr raw_printer q
 
   let all_constants = List.map (fun q -> QConstant q) Constants.all
 
   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'
 
@@ -228,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)
@@ -249,11 +286,17 @@ 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 =
@@ -262,9 +305,9 @@ module Quality = struct
   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, QVar (QVar.Global qg') -> if QGlobal.equal qg qg' 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 _ | PQGlobal _), (QConstant _ | QVar _) -> None
+    | (PQConstant _ | PQGlobal _), _ -> None
 end
 
 module ElimConstraint = struct
@@ -296,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
@@ -334,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
@@ -359,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
@@ -373,65 +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
+  | _ -> 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
 
@@ -442,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(
@@ -456,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 ()
@@ -489,14 +554,14 @@ 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
@@ -507,18 +572,34 @@ let debug_print = function
   | 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 ")")
 
-let pr prv pru = function
+type printer = {
+  prq : Quality.printer;
+  pru : Level.t -> Pp.t;
+}
+
+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 | PSGlobal of QGlobal.t * 'u | PSQSort of 'q * 'u
@@ -529,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 =
@@ -540,6 +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), QSort (QVar.Global qg', u) -> if QGlobal.equal qg qg' then Some (Partial_subst.maybe_add_univ uio (extract_level u) qusubst) else None
+  | 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 _ | PSGlobal _), _ -> None
diff --git a/kernel/sorts.mli b/kernel/sorts.mli
index 8e54b3925bb3..2edf4b21a94f 100644
--- a/kernel/sorts.mli
+++ b/kernel/sorts.mli
@@ -20,8 +20,14 @@ sig
   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 :
@@ -29,11 +35,10 @@ sig
   type t
 
   val var_index : t -> int option
-  val name : t -> QGlobal.t 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
@@ -48,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
@@ -67,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
@@ -92,15 +97,20 @@ 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
 
@@ -115,7 +125,13 @@ 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
 
@@ -136,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
+  val pr : Quality.printer -> t -> Pp.t
 
   val hcons : t Hashcons.f
 end
@@ -151,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
@@ -160,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
@@ -205,7 +223,16 @@ 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 =
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 2f837f7afbb9..3fd53a87806c 100644
--- a/kernel/typeops.ml
+++ b/kernel/typeops.ml
@@ -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. *)
 
@@ -340,30 +339,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 +407,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
@@ -675,7 +657,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 +868,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/uGraph.ml b/kernel/uGraph.ml
index eaf5bfb73d02..224dacd8c5b8 100644
--- a/kernel/uGraph.ml
+++ b/kernel/uGraph.ml
@@ -43,8 +43,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
 
@@ -148,11 +147,18 @@ let check_leq_sort qeq univs s1 s2 =
     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
@@ -251,17 +257,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"<="
@@ -273,8 +276,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 3289e5404026..8b3201924896 100644
--- a/kernel/uGraph.mli
+++ b/kernel/uGraph.mli
@@ -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
 
@@ -115,8 +114,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 11f9c6b7e824..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
@@ -413,7 +413,7 @@ struct
     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 prq pru ?variance ctx = UContext.pr prq pru ?variance (repr ctx)
+  let pr printer ?variance ctx = UContext.pr printer ?variance (repr ctx)
 
 end
 
@@ -463,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
 
@@ -488,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
@@ -519,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 cfbc297a5c43..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
@@ -201,7 +201,7 @@ sig
   val refine_names : bound_names -> t -> t
   (** Use names to name the possibly yet unnamed 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
 
 type 'a univ_abstracted = {
@@ -228,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/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..c2bbb39e7fe3 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
 
diff --git a/kernel/vmvalues.ml b/kernel/vmvalues.ml
index 71222e8c77d2..48b3630db83a 100644
--- a/kernel/vmvalues.ml
+++ b/kernel/vmvalues.ml
@@ -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)
diff --git a/lib/acyclicGraph.ml b/lib/acyclicGraph.ml
index 2c97a1090057..0719f799f870 100644
--- a/lib/acyclicGraph.ml
+++ b/lib/acyclicGraph.ml
@@ -750,6 +750,8 @@ module Make (Point:Point) = struct
           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
diff --git a/lib/acyclicGraph.mli b/lib/acyclicGraph.mli
index 0757ed0742e5..637a4b341ce3 100644
--- a/lib/acyclicGraph.mli
+++ b/lib/acyclicGraph.mli
@@ -78,6 +78,8 @@ module Make (Point:Point) : sig
 
   val constraints_for : kept:Point.Set.t -> t -> 'a constraint_fold -> 'a -> 'a
 
+  val mem : Point.t -> t -> bool
+
   val domain : t -> Point.Set.t
 
   val choose : (Point.t -> bool) -> t -> Point.t -> Point.t option
diff --git a/library/global.ml b/library/global.ml
index 0b3323a993cc..f3ac71292679 100644
--- a/library/global.ml
+++ b/library/global.ml
@@ -83,7 +83,7 @@ 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 push_qualities c = globalize0 (Safe_typing.push_qualities c)
 
 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 +163,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())
diff --git a/library/global.mli b/library/global.mli
index 13d2ac8bb12b..519d5d5c22c2 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,7 @@ 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 push_qualities : Sorts.QGlobal.Set.t * Sorts.ElimConstraints.t -> unit
 
 (** Non-interactive modules and module types *)
 
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/parsing/g_constr.mlg b/parsing/g_constr.mlg
index 00fcb117a02f..b94c3e83b5ca 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. *)
@@ -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 }
diff --git a/plugins/extraction/extraction.ml b/plugins/extraction/extraction.ml
index cb56c7d8bcba..13b09ffb04ef 100644
--- a/plugins/extraction/extraction.ml
+++ b/plugins/extraction/extraction.ml
@@ -72,7 +72,7 @@ type flag = info * scheme
 
 let info_of_quality = let open UnivGen.QualityOrSet in function
   | Qual (QConstant QSProp | QConstant QProp) -> Logic
-  | Set | Qual (QConstant QType | QVar _) -> Info
+  | Set | Qual (QConstant QType | QVar _ | QGlobal _) -> Info
 
 let info_of_sort s = info_of_quality (UnivGen.QualityOrSet.of_sort s)
 
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/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/indfun.ml b/plugins/funind/indfun.ml
index 8e63b7745166..3d2f68b6432a 100644
--- a/plugins/funind/indfun.ml
+++ b/plugins/funind/indfun.ml
@@ -65,6 +65,7 @@ let functional_induction with_clean c princl pat =
             | 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 *)
diff --git a/plugins/ltac/taccoerce.ml b/plugins/ltac/taccoerce.ml
index e7f1a914e234..6267f211c7f3 100644
--- a/plugins/ltac/taccoerce.ml
+++ b/plugins/ltac/taccoerce.ml
@@ -245,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/pretyping/cases.ml b/pretyping/cases.ml
index 5ccaaed54436..36f2de210cb7 100644
--- a/pretyping/cases.ml
+++ b/pretyping/cases.ml
@@ -1951,7 +1951,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
diff --git a/pretyping/detyping.ml b/pretyping/detyping.ml
index f5bdb4ad391a..0d17d2454ff6 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)
diff --git a/pretyping/evarsolve.ml b/pretyping/evarsolve.ml
index e197def7a93b..f74c76d69288 100644
--- a/pretyping/evarsolve.ml
+++ b/pretyping/evarsolve.ml
@@ -120,10 +120,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 +132,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
diff --git a/pretyping/glob_ops.ml b/pretyping/glob_ops.ml
index 7655d8cfbf06..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
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 57ebcf07fe98..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
 
diff --git a/pretyping/inductiveops.ml b/pretyping/inductiveops.ml
index 58bb94656575..963a2c9aa9ee 100644
--- a/pretyping/inductiveops.ml
+++ b/pretyping/inductiveops.ml
@@ -272,6 +272,9 @@ let squash_elim_sort sigma squash rtnsort =
   | SquashToQuality (QConstant QType) ->
      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) ->
      let q' = ESorts.quality sigma rtnsort in
      let g = Evd.elim_graph sigma in
diff --git a/pretyping/pretyping.ml b/pretyping/pretyping.ml
index a173b74a2d23..d286cb565309 100644
--- a/pretyping/pretyping.ml
+++ b/pretyping/pretyping.ml
@@ -197,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
@@ -245,16 +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 ->
     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
@@ -263,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
@@ -285,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
@@ -916,6 +904,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
@@ -964,10 +957,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 _ ->
@@ -1001,7 +991,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 _ ->
@@ -1015,7 +1008,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
diff --git a/pretyping/retyping.ml b/pretyping/retyping.ml
index 1348d4aea176..d0d765286788 100644
--- a/pretyping/retyping.ml
+++ b/pretyping/retyping.ml
@@ -168,10 +168,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 +282,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
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/typing.ml b/pretyping/typing.ml
index 7fb6ffa0183a..78fbf193b775 100644
--- a/pretyping/typing.ml
+++ b/pretyping/typing.ml
@@ -58,7 +58,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 ->
@@ -364,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)
@@ -504,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
@@ -602,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
diff --git a/printing/ppconstr.ml b/printing/ppconstr.ml
index e360a6020f0d..f792f9f7f252 100644
--- a/printing/ppconstr.ml
+++ b/printing/ppconstr.ml
@@ -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 "}"
 
diff --git a/printing/printer.ml b/printing/printer.ml
index 41daf6047d62..e56dcc7f2a7e 100644
--- a/printing/printer.ml
+++ b/printing/printer.ml
@@ -273,9 +273,7 @@ let fill_names ?user_names 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()
@@ -285,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()
 
@@ -294,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
@@ -314,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 " | " ++
@@ -322,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
diff --git a/tactics/allScheme.ml b/tactics/allScheme.ml
index a62b23bcffa1..cebb74bd7bd1 100644
--- a/tactics/allScheme.ml
+++ b/tactics/allScheme.ml
@@ -526,7 +526,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
 
 
@@ -623,12 +623,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 *)
@@ -913,7 +911,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
diff --git a/tactics/cbn.ml b/tactics/cbn.ml
index 77ac9bd20506..3ad64d4793ab 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
diff --git a/tactics/elimschemes.ml b/tactics/elimschemes.ml
index 307ca6bac27c..452138b974aa 100644
--- a/tactics/elimschemes.ml
+++ b/tactics/elimschemes.ml
@@ -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,7 +147,8 @@ 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 =
diff --git a/tactics/eqschemes.ml b/tactics/eqschemes.ml
index 98ce70561669..2896eb3e021d 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)
diff --git a/tactics/tactics.ml b/tactics/tactics.ml
index 5eef0f13fcb6..625c2b68c3d4 100644
--- a/tactics/tactics.ml
+++ b/tactics/tactics.ml
@@ -297,7 +297,7 @@ let id_of_name_with_default id = function
 let default_id_of_sort sigma s =
   match ESorts.kind sigma s with
   | SProp | Prop | Set -> default_small_ident
-  | Type _ | QSort _ -> default_type_ident
+  | Type _ | GSort _ | VSort _ -> default_type_ident
 
 let default_id env sigma decl =
   let open Context.Rel.Declaration in
diff --git a/test-suite/output/DeclareSort.out b/test-suite/output/DeclareSort.out
index 7a2a400fe061..38c39e98d7d9 100644
--- a/test-suite/output/DeclareSort.out
+++ b/test-suite/output/DeclareSort.out
@@ -4,14 +4,14 @@ In environment
 A : Type@{s ; _}
 The term "A" has type "Type@{s ; _}" while it is expected to have type
  "Type@{s' ; _}"
-(universe inconsistency: Cannot enforce Type@{s | Set} <=
-Type@{s' | DeclareSort.21}).
+(universe inconsistency: Cannot enforce Type@{s; Set} <=
+Type@{s'; DeclareSort.21}).
 File "./output/DeclareSort.v", line 6, characters 35-36:
 The command has indeed failed with message:
 In environment
 A : Type@{s ; _}
 The term "A" has type "Type@{s ; _}" while it is expected to have type 
-"Type" (universe inconsistency: Cannot enforce Type@{s | Set} <=
+"Type" (universe inconsistency: Cannot enforce Type@{s; Set} <=
 DeclareSort.22).
 File "./output/DeclareSort.v", line 8, characters 26-27:
 The command has indeed failed with message:
@@ -19,12 +19,12 @@ In environment
 A : Set
 The term "A" has type "Set" while it is expected to have type 
 "Type@{s ; _}" (universe inconsistency: Cannot enforce Set <=
-Type@{s | DeclareSort.23}).
+Type@{s; DeclareSort.23}).
 fun A : Type@{s ; _} => A : Type@{s ; _}
      : Type@{s ; _} -> Type@{s ; _}
 File "./output/DeclareSort.v", line 15, characters 2-15:
 The command has indeed failed with message:
-Cannot declare global sort qualities inside sections
+Cannot declare global sort qualities inside sections.
 foo
      : Type@{S1 ; _} -> Type@{S2 ; _}
 foo@{S2 ; } : Type@{S1 ; _} -> Type@{S2 ; _}
@@ -48,12 +48,12 @@ File "./output/DeclareSort.v", line 30, characters 11-14:
 The command has indeed failed with message:
 The term "foo@{α6 ; }" has type "Type@{S1 ; Set} -> Type@{α6 ; Set}"
 while it is expected to have type "SProp -> ?T"
-(universe inconsistency: Cannot enforce SProp <= Type@{S1 | Set}).
+(universe inconsistency: Cannot enforce SProp <= Type@{S1; Set}).
 File "./output/DeclareSort.v", line 31, characters 11-14:
 The command has indeed failed with message:
 The term "foo@{α8 ; }" has type "Type@{S1 ; Set} -> Type@{α8 ; Set}"
 while it is expected to have type "Set -> ?T"
-(universe inconsistency: Cannot enforce Set <= Type@{S1 | Set}).
+(universe inconsistency: Cannot enforce Set <= Type@{S1; Set}).
 foo@{Type ; } : Type@{S1 ; Set} -> Set
      : Type@{S1 ; Set} -> Set
 File "./output/DeclareSort.v", line 36, characters 4-18:
diff --git a/test-suite/output/UnivNotations.out b/test-suite/output/UnivNotations.out
index d2d25939498b..9680f515c8d6 100644
--- a/test-suite/output/UnivNotations.out
+++ b/test-suite/output/UnivNotations.out
@@ -7,7 +7,7 @@ foo Type@{s ; _} S
 File "./output/UnivNotations.v", line 20, characters 13-14:
 The command has indeed failed with message:
 The term "S" has type "Type@{s ; _}" while it is expected to have type 
-"Type" (universe inconsistency: Cannot enforce Type@{s | Set} <=
+"Type" (universe inconsistency: Cannot enforce Type@{s; Set} <=
 UnivNotations.24).
 1 goal
   
diff --git a/test-suite/output/sort_poly_elab.out b/test-suite/output/sort_poly_elab.out
index d24a308a34a0..9d36d74f87c4 100644
--- a/test-suite/output/sort_poly_elab.out
+++ b/test-suite/output/sort_poly_elab.out
@@ -232,7 +232,8 @@ In environment
 A : Type@{s ; Set}
 The term "A" has type "Type@{s ; Set}" while it is expected to have type
  "Type@{s' ; Set}"
-(universe inconsistency: Cannot enforce Type@{s | Set} <= Type@{s' | Set}).
+(universe inconsistency: Cannot enforce Type@{s; Set} <= 
+Type@{s'; Set}).
 implicit@{α ; u} : Type@{α ; u}
 (* α ; u |=  *)
 
@@ -726,8 +727,21 @@ Expands to: Constant sort_poly_elab.Inductives.bool_to_Prop'
 Declared in library sort_poly_elab, line 490, characters 21-34
 File "./output/sort_poly_elab.v", line 502, characters 58-60:
 The command has indeed failed with message:
-This expression would enforce a non-declared elimination constraint between
-Test and Prop
+The term "tt" has type "unit" while it is expected to have type
+ "?P@{b:=true@{Test ; }}"
+(unable to find a well-typed instantiation for "?P": cannot ensure that 
+"Set" is a subtype of "Type@{Test ; sort_poly_elab.350}").
+File "./output/sort_poly_elab.v", line 510, characters 58-66:
+The command has indeed failed with message:
+The term "testctor" has type "testind" while it is expected to have type
+ "?P@{b:=true@{Test ; }}"
+(unable to find a well-typed instantiation for "?P": cannot ensure that
+"Type@{Test2 ; Set}" is a subtype of "Type@{Test ; sort_poly_elab.352}").
+match true@{Test ; } return testind'@{Test ; } with
+| true => testctor'@{Test ; }
+| false => testctor'@{Test ; }
+end
+     : testind'@{Test ; }
 unit@{α ; u} : Type@{α ; u}
 (* α ; u |=  *)
 
@@ -738,7 +752,7 @@ unit@{α ; u} may only be eliminated to produce values whose type is in sort qua
   (SProp <= Prop <= Type, and all variables <= Type)
   than the instantiation of α.
 Expands to: Inductive sort_poly_elab.Inductives.unit
-Declared in library sort_poly_elab, line 511, characters 12-16
+Declared in library sort_poly_elab, line 518, characters 12-16
 FooNat@{α ; } : Type@{α ; Set}
 (* α ;  |=  *)
 
@@ -749,7 +763,7 @@ FooNat@{α ; } may only be eliminated to produce values whose type is in sort qu
   (SProp <= Prop <= Type, and all variables <= Type)
   than the instantiation of α.
 Expands to: Inductive sort_poly_elab.Inductives.FooNat
-Declared in library sort_poly_elab, line 519, characters 12-18
+Declared in library sort_poly_elab, line 526, characters 12-18
 Foo@{α α0 ; } :
 forall _ : FooNat@{α ; }, FooNat@{α0 ; }
 (* α α0 ;  |= α -> α0 *)
@@ -758,15 +772,15 @@ Foo is universe polymorphic
 Arguments Foo n
 Foo is transparent
 Expands to: Constant sort_poly_elab.Inductives.Foo
-Declared in library sort_poly_elab, line 524, characters 13-16
+Declared in library sort_poly_elab, line 531, characters 13-16
 Foo@{Type Prop ; }
      : forall _ : FooNat@{Type ; }, FooNat@{Prop ; }
-File "./output/sort_poly_elab.v", line 532, characters 2-30:
+File "./output/sort_poly_elab.v", line 539, characters 2-30:
 The command has indeed failed with message:
 The quality constraints are inconsistent: cannot enforce Prop -> Type
 because it would identify Type and Prop which is inconsistent.
 This is introduced by the constraints Prop -> Type
-File "./output/sort_poly_elab.v", line 541, characters 2-30:
+File "./output/sort_poly_elab.v", line 548, characters 2-30:
 The command has indeed failed with message:
 The record R1 could not be defined as a primitive record because it has no
 projections. [non-primitive-record,records,default]
@@ -777,7 +791,7 @@ R2 is universe polymorphic
 R2 has primitive projections with eta conversion depending on sort instantiation.
 Arguments R2 A%_type_scope
 Expands to: Inductive sort_poly_elab.Records.R2
-Declared in library sort_poly_elab, line 543, characters 9-11
+Declared in library sort_poly_elab, line 550, characters 9-11
 R3@{α α0 ; u} :
 forall _ : Type@{α ; u}, Type@{α0 ; u}
 (* α α0 ; u |= α0 -> α *)
@@ -786,7 +800,7 @@ R3 is universe polymorphic
 R3 has primitive projections with eta conversion depending on sort instantiation.
 Arguments R3 A%_type_scope
 Expands to: Inductive sort_poly_elab.Records.R3
-Declared in library sort_poly_elab, line 547, characters 9-11
+Declared in library sort_poly_elab, line 554, characters 9-11
 R4@{s ; } : forall _ : Type@{s ; Set}, Type@{s ; Set}
 (* s ;  |=  *)
 
@@ -794,8 +808,8 @@ R4 is universe polymorphic
 R4 has primitive projections with eta conversion.
 Arguments R4 A%_type_scope
 Expands to: Inductive sort_poly_elab.Records.R4
-Declared in library sort_poly_elab, line 552, characters 9-11
-File "./output/sort_poly_elab.v", line 556, characters 2-49:
+Declared in library sort_poly_elab, line 559, characters 9-11
+File "./output/sort_poly_elab.v", line 563, characters 2-49:
 The command has indeed failed with message:
 The record R5 could not be defined as a primitive record because it is
 squashed. [non-primitive-record,records,default]
@@ -806,7 +820,7 @@ R5 is universe polymorphic
 R5@{α ; u} may only be eliminated to produce values whose type is SProp.
 Arguments R5 A%_type_scope
 Expands to: Inductive sort_poly_elab.Records.R5
-Declared in library sort_poly_elab, line 558, characters 11-13
+Declared in library sort_poly_elab, line 565, characters 11-13
 R6@{s ; } : forall _ : Type@{s ; Set}, Set
 (* s ;  |=  *)
 
@@ -814,57 +828,57 @@ R6 is universe polymorphic
 R6 has primitive projections with eta conversion.
 Arguments R6 A%_type_scope
 Expands to: Inductive sort_poly_elab.Records.R6
-Declared in library sort_poly_elab, line 563, characters 9-11
+Declared in library sort_poly_elab, line 570, characters 9-11
 fun (A : SProp) (x y : R6@{SProp ; } A) =>
-@eq_refl (Conversion.Box@{SProp Type ; sort_poly_elab.361} A)
-  (Conversion.box@{SProp Type ; sort_poly_elab.361} A (R6f1 _ x))
+@eq_refl (Conversion.Box@{SProp Type ; sort_poly_elab.365} A)
+  (Conversion.box@{SProp Type ; sort_poly_elab.365} A (R6f1 _ x))
 :
-@eq (Conversion.Box@{SProp Type ; sort_poly_elab.361} A)
-  (Conversion.box@{SProp Type ; sort_poly_elab.361} A (R6f1 _ x))
-  (Conversion.box@{SProp Type ; sort_poly_elab.361} A (R6f1 _ y))
+@eq (Conversion.Box@{SProp Type ; sort_poly_elab.365} A)
+  (Conversion.box@{SProp Type ; sort_poly_elab.365} A (R6f1 _ x))
+  (Conversion.box@{SProp Type ; sort_poly_elab.365} A (R6f1 _ y))
      : forall (A : SProp) (x y : R6@{SProp ; } A),
-       @eq (Conversion.Box@{SProp Type ; sort_poly_elab.361} A)
-         (Conversion.box@{SProp Type ; sort_poly_elab.361} A (R6f1 _ x))
-         (Conversion.box@{SProp Type ; sort_poly_elab.361} A (R6f1 _ y))
-(* {sort_poly_elab.361} |=  *)
-File "./output/sort_poly_elab.v", line 569, characters 10-17:
+       @eq (Conversion.Box@{SProp Type ; sort_poly_elab.365} A)
+         (Conversion.box@{SProp Type ; sort_poly_elab.365} A (R6f1 _ x))
+         (Conversion.box@{SProp Type ; sort_poly_elab.365} A (R6f1 _ y))
+(* {sort_poly_elab.365} |=  *)
+File "./output/sort_poly_elab.v", line 576, characters 10-17:
 The command has indeed failed with message:
 In environment
 A : Prop
-x : R6@{α375 ; } A
-y : R6@{α378 ; } A
+x : R6@{α382 ; } A
+y : R6@{α385 ; } A
 The term
- "@eq_refl (Conversion.Box@{α373 Type ; sort_poly_elab.365} A)
-    (Conversion.box@{α373 Type ; sort_poly_elab.365} A (R6f1 _ x))"
+ "@eq_refl (Conversion.Box@{α380 Type ; sort_poly_elab.369} A)
+    (Conversion.box@{α380 Type ; sort_poly_elab.369} A (R6f1 _ x))"
 has type
- "@eq (Conversion.Box@{α373 Type ; sort_poly_elab.365} A)
-    (Conversion.box@{α373 Type ; sort_poly_elab.365} A (R6f1 _ x))
-    (Conversion.box@{α373 Type ; sort_poly_elab.365} A (R6f1 _ x))"
+ "@eq (Conversion.Box@{α380 Type ; sort_poly_elab.369} A)
+    (Conversion.box@{α380 Type ; sort_poly_elab.369} A (R6f1 _ x))
+    (Conversion.box@{α380 Type ; sort_poly_elab.369} A (R6f1 _ x))"
 while it is expected to have type
- "@eq (Conversion.Box@{α373 Type ; sort_poly_elab.365} A)
-    (Conversion.box@{α373 Type ; sort_poly_elab.365} A (R6f1 _ x))
-    (Conversion.box@{α373 Type ; sort_poly_elab.365} A (R6f1 _ y))"
-(cannot unify "Conversion.box@{α373 Type ; sort_poly_elab.365} A (R6f1 _ x)"
-and "Conversion.box@{α373 Type ; sort_poly_elab.365} A (R6f1 _ y)").
-File "./output/sort_poly_elab.v", line 571, characters 10-17:
+ "@eq (Conversion.Box@{α380 Type ; sort_poly_elab.369} A)
+    (Conversion.box@{α380 Type ; sort_poly_elab.369} A (R6f1 _ x))
+    (Conversion.box@{α380 Type ; sort_poly_elab.369} A (R6f1 _ y))"
+(cannot unify "Conversion.box@{α380 Type ; sort_poly_elab.369} A (R6f1 _ x)"
+and "Conversion.box@{α380 Type ; sort_poly_elab.369} A (R6f1 _ y)").
+File "./output/sort_poly_elab.v", line 578, characters 10-17:
 The command has indeed failed with message:
 In environment
 A : SProp
 x : R6@{SProp ; } A
 y : R6@{SProp ; } A
 The term
- "@eq_refl (Conversion.Box@{Type Type ; sort_poly_elab.369} nat)
-    (Conversion.box@{Type Type ; sort_poly_elab.369} nat (R6f2 _ x))"
+ "@eq_refl (Conversion.Box@{Type Type ; sort_poly_elab.373} nat)
+    (Conversion.box@{Type Type ; sort_poly_elab.373} nat (R6f2 _ x))"
 has type
- "@eq (Conversion.Box@{Type Type ; sort_poly_elab.369} nat)
-    (Conversion.box@{Type Type ; sort_poly_elab.369} nat (R6f2 _ x))
-    (Conversion.box@{Type Type ; sort_poly_elab.369} nat (R6f2 _ x))"
+ "@eq (Conversion.Box@{Type Type ; sort_poly_elab.373} nat)
+    (Conversion.box@{Type Type ; sort_poly_elab.373} nat (R6f2 _ x))
+    (Conversion.box@{Type Type ; sort_poly_elab.373} nat (R6f2 _ x))"
 while it is expected to have type
- "@eq (Conversion.Box@{Type Type ; sort_poly_elab.369} nat)
-    (Conversion.box@{Type Type ; sort_poly_elab.369} nat (R6f2 _ x))
-    (Conversion.box@{Type Type ; sort_poly_elab.369} nat (R6f2 _ y))"
-(cannot unify "Conversion.box@{Type Type ; sort_poly_elab.369} nat (R6f2 _ x)"
-and "Conversion.box@{Type Type ; sort_poly_elab.369} nat (R6f2 _ y)").
+ "@eq (Conversion.Box@{Type Type ; sort_poly_elab.373} nat)
+    (Conversion.box@{Type Type ; sort_poly_elab.373} nat (R6f2 _ x))
+    (Conversion.box@{Type Type ; sort_poly_elab.373} nat (R6f2 _ y))"
+(cannot unify "Conversion.box@{Type Type ; sort_poly_elab.373} nat (R6f2 _ x)"
+and "Conversion.box@{Type Type ; sort_poly_elab.373} nat (R6f2 _ y)").
 R7@{α α0 ; u} :
 forall _ : Type@{α ; u}, Type@{α0 ; max(Set,u)}
 (* α α0 ; u |=  *)
@@ -877,7 +891,7 @@ R7@{α α0 ; u} may only be eliminated to produce values whose type is in sort q
   than the instantiation of α0.
 Arguments R7 A%_type_scope
 Expands to: Inductive sort_poly_elab.Records.R7
-Declared in library sort_poly_elab, line 574, characters 38-40
+Declared in library sort_poly_elab, line 581, characters 38-40
 R7f1@{α α0 ; u} :
 forall (A : Type@{α ; u}) (_ : R7@{α α0 ; u} A), A
 (* α α0 ; u |= α0 -> α *)
@@ -887,7 +901,7 @@ R7f1 is a projection of R7
 Arguments R7f1 A%_type_scope r
 R7f1 is transparent
 Expands to: Constant sort_poly_elab.Records.R7f1
-Declared in library sort_poly_elab, line 574, characters 55-59
+Declared in library sort_poly_elab, line 581, characters 55-59
 R7f2@{α α0 ; u} :
 forall (A : Type@{α ; u}) (_ : R7@{α α0 ; u} A), nat
 (* α α0 ; u |= α0 -> Type *)
@@ -897,7 +911,7 @@ R7f2 is a projection of R7
 Arguments R7f2 A%_type_scope r
 R7f2 is transparent
 Expands to: Constant sort_poly_elab.Records.R7f2
-Declared in library sort_poly_elab, line 574, characters 65-69
+Declared in library sort_poly_elab, line 581, characters 65-69
 Rsigma@{s ; u v} :
 forall (A : Type@{s ; u}) (_ : forall _ : A, Type@{s ; v}),
 Type@{s ; max(u,v)}
@@ -907,7 +921,7 @@ Rsigma is universe polymorphic
 Rsigma has primitive projections with eta conversion.
 Arguments Rsigma A%_type_scope B%_function_scope
 Expands to: Inductive sort_poly_elab.Records.Rsigma
-Declared in library sort_poly_elab, line 585, characters 9-15
+Declared in library sort_poly_elab, line 592, characters 9-15
 Rsigma_srect@{α α0 ; u u0 u1} :
 forall (A : Type@{α ; u}) (B : forall _ : A, Type@{α ; u0})
   (P : forall _ : Rsigma@{α ; u u0} A B, Type@{α0 ; u1})
@@ -920,7 +934,7 @@ Rsigma_srect is universe polymorphic
 Arguments Rsigma_srect A%_type_scope (B P H)%_function_scope s
 Rsigma_srect is transparent
 Expands to: Constant sort_poly_elab.Records.Rsigma_srect
-Declared in library sort_poly_elab, line 590, characters 13-25
+Declared in library sort_poly_elab, line 597, characters 13-25
 sexists@{α ; u} :
 forall (A : Type@{α ; u}) (_ : forall _ : A, Prop), Prop
 (* α ; u |=  *)
@@ -930,14 +944,14 @@ sexists@{α ; u} may only be eliminated to produce values whose type is SProp or
   unless instantiated such that the quality α is SProp or Prop.
 Arguments sexists A%_type_scope B%_function_scope
 Expands to: Inductive sort_poly_elab.Records.sexists
-Declared in library sort_poly_elab, line 604, characters 12-19
+Declared in library sort_poly_elab, line 611, characters 12-19
 sexists_ind@{Type ;
-sort_poly_elab.392}
-     : forall (A : Type@{sort_poly_elab.392}) (B : forall _ : A, Prop)
+sort_poly_elab.396}
+     : forall (A : Type@{sort_poly_elab.396}) (B : forall _ : A, Prop)
          (P : Prop) (_ : forall (a : A) (_ : B a), P)
-         (_ : sexists@{Type ; sort_poly_elab.392} A B),
+         (_ : sexists@{Type ; sort_poly_elab.396} A B),
        P
-(* {sort_poly_elab.392} |=  *)
+(* {sort_poly_elab.396} |=  *)
 R8@{α α0 ; u} : Type@{α ; u+1}
 (* α α0 ; u |=  *)
 
@@ -948,7 +962,7 @@ R8@{α α0 ; u} may only be eliminated to produce values whose type is in sort q
   (SProp <= Prop <= Type, and all variables <= Type)
   than the instantiation of α.
 Expands to: Inductive sort_poly_elab.Records.R8
-Declared in library sort_poly_elab, line 614, characters 9-11
+Declared in library sort_poly_elab, line 621, characters 9-11
 R8f1@{α α0 ; u} :
 forall _ : R8@{α α0 ; u}, Type@{α0 ; u}
 (* α α0 ; u |= α -> Type *)
@@ -958,7 +972,7 @@ R8f1 is a projection of R8
 Arguments R8f1 r
 R8f1 is transparent
 Expands to: Constant sort_poly_elab.Records.R8f1
-Declared in library sort_poly_elab, line 615, characters 4-8
+Declared in library sort_poly_elab, line 622, characters 4-8
 R8f2@{α α0 ; u} :
 forall r : R8@{α α0 ; u}, R8f1@{α α0 ; u} r
 (* α α0 ; u |= α -> α0
@@ -969,7 +983,7 @@ R8f2 is a projection of R8
 Arguments R8f2 r
 R8f2 is transparent
 Expands to: Constant sort_poly_elab.Records.R8f2
-Declared in library sort_poly_elab, line 616, characters 4-8
+Declared in library sort_poly_elab, line 623, characters 4-8
 R9@{α α0 α1 ; } : Type@{α ; Set}
 (* α α0 α1 ;  |=  *)
 
@@ -980,7 +994,7 @@ R9@{α α0 α1 ; } may only be eliminated to produce values whose type is in sor
   (SProp <= Prop <= Type, and all variables <= Type)
   than the instantiation of α.
 Expands to: Inductive sort_poly_elab.Records.R9
-Declared in library sort_poly_elab, line 634, characters 9-11
+Declared in library sort_poly_elab, line 641, characters 9-11
 R9f1@{α α0 α1 ; } :
 forall _ : R9@{α α0 α1 ; }, bool@{α0 ; }
 (* α α0 α1 ;  |= α -> α0 *)
@@ -990,7 +1004,7 @@ R9f1 is a projection of R9
 Arguments R9f1 r
 R9f1 is transparent
 Expands to: Constant sort_poly_elab.Records.R9f1
-Declared in library sort_poly_elab, line 635, characters 4-8
+Declared in library sort_poly_elab, line 642, characters 4-8
 R9f2@{α α0 α1 ; } :
 forall _ : R9@{α α0 α1 ; }, bool@{α1 ; }
 (* α α0 α1 ;  |= α -> α1 *)
@@ -1000,7 +1014,7 @@ R9f2 is a projection of R9
 Arguments R9f2 r
 R9f2 is transparent
 Expands to: Constant sort_poly_elab.Records.R9f2
-Declared in library sort_poly_elab, line 636, characters 4-8
+Declared in library sort_poly_elab, line 643, characters 4-8
 R10@{α α0 α1 α2 ; u u0} :
 forall _ : Type@{α0 ; u}, Type@{α ; max(Set,u,u0)}
 (* α α0 α1 α2 ; u u0 |=  *)
@@ -1013,7 +1027,7 @@ R10@{α α0 α1 α2 ; u u0} may only be eliminated to produce values whose type
   than the instantiation of α.
 Arguments R10 A%_type_scope
 Expands to: Inductive sort_poly_elab.Records.R10
-Declared in library sort_poly_elab, line 648, characters 9-12
+Declared in library sort_poly_elab, line 655, characters 9-12
 R10f1@{α α0 α1 α2 ; u u0} :
 forall (A : Type@{α0 ; u}) (_ : R10@{α α0 α1 α2 ; u u0} A), A
 (* α α0 α1 α2 ; u u0 |= α -> α0 *)
@@ -1023,7 +1037,7 @@ R10f1 is a projection of R10
 Arguments R10f1 A%_type_scope r
 R10f1 is transparent
 Expands to: Constant sort_poly_elab.Records.R10f1
-Declared in library sort_poly_elab, line 649, characters 4-9
+Declared in library sort_poly_elab, line 656, characters 4-9
 R10f2@{α α0 α1 α2 ; u u0} :
 forall (A : Type@{α0 ; u}) (r : R10@{α α0 α1 α2 ; u u0} A),
 @eq@{α0 α1 ; u u0} A (R10f1@{α α0 α1 α2 ; u u0} A r)
@@ -1036,7 +1050,7 @@ R10f2 is a projection of R10
 Arguments R10f2 A%_type_scope r
 R10f2 is transparent
 Expands to: Constant sort_poly_elab.Records.R10f2
-Declared in library sort_poly_elab, line 650, characters 4-9
+Declared in library sort_poly_elab, line 657, characters 4-9
 R10f3@{α α0 α1 α2 ; u u0} :
 forall (A : Type@{α0 ; u}) (_ : R10@{α α0 α1 α2 ; u u0} A), bool@{α2 ; }
 (* α α0 α1 α2 ; u u0 |= α -> α2 *)
@@ -1046,7 +1060,7 @@ R10f3 is a projection of R10
 Arguments R10f3 A%_type_scope r
 R10f3 is transparent
 Expands to: Constant sort_poly_elab.Records.R10f3
-Declared in library sort_poly_elab, line 651, characters 4-9
+Declared in library sort_poly_elab, line 658, characters 4-9
 R11@{α α0 α1 α2 α3 α4 α5 ; u} :
 Type@{α ; Set}
 (* α α0 α1 α2 α3 α4 α5 ; u |= α0 -> α3
@@ -1059,7 +1073,7 @@ R11@{α α0 α1 α2 α3 α4 α5 ; u} may only be eliminated to produce values wh
   (SProp <= Prop <= Type, and all variables <= Type)
   than the instantiation of α.
 Expands to: Inductive sort_poly_elab.Records.R11
-Declared in library sort_poly_elab, line 667, characters 9-12
+Declared in library sort_poly_elab, line 674, characters 9-12
 R11f1@{α α0 α1 α2 α3 α4 α5 ; u} :
 forall _ : R11@{α α0 α1 α2 α3 α4 α5 ; u}, bool@{α3 ; }
 (* α α0 α1 α2 α3 α4 α5 ; u |= α -> α3
@@ -1071,7 +1085,7 @@ R11f1 is a projection of R11
 Arguments R11f1 r
 R11f1 is transparent
 Expands to: Constant sort_poly_elab.Records.R11f1
-Declared in library sort_poly_elab, line 668, characters 4-9
+Declared in library sort_poly_elab, line 675, characters 4-9
 R11f2@{α α0 α1 α2 α3 α4 α5 ; u} :
 forall r : R11@{α α0 α1 α2 α3 α4 α5 ; u},
 let r0 : R10@{α0 α1 α2 α3 ; Set u} bool@{α1 ; } :=
@@ -1093,7 +1107,7 @@ R11f2 is a projection of R11
 Arguments R11f2 r
 R11f2 is transparent
 Expands to: Constant sort_poly_elab.Records.R11f2
-Declared in library sort_poly_elab, line 669, characters 4-9
+Declared in library sort_poly_elab, line 676, characters 4-9
 R11f3@{α α0 α1 α2 α3 α4 α5 ; u} :
 forall _ : R11@{α α0 α1 α2 α3 α4 α5 ; u}, bool@{α5 ; }
 (* α α0 α1 α2 α3 α4 α5 ; u |= α -> α5
@@ -1105,7 +1119,7 @@ R11f3 is a projection of R11
 Arguments R11f3 r
 R11f3 is transparent
 Expands to: Constant sort_poly_elab.Records.R11f3
-Declared in library sort_poly_elab, line 674, characters 4-9
+Declared in library sort_poly_elab, line 681, characters 4-9
 R12@{α α0 ; } : Type@{α ; Set}
 (* α α0 ;  |= α0 -> Type *)
 
@@ -1116,7 +1130,7 @@ R12@{α α0 ; } may only be eliminated to produce values whose type is in sort q
   (SProp <= Prop <= Type, and all variables <= Type)
   than the instantiation of α.
 Expands to: Inductive sort_poly_elab.Records.R12
-Declared in library sort_poly_elab, line 693, characters 9-12
+Declared in library sort_poly_elab, line 700, characters 9-12
 R12f1@{α α0 ; } :
 forall _ : R12@{α α0 ; }, bool@{α0 ; }
 (* α α0 ;  |= α -> α0
@@ -1127,7 +1141,7 @@ R12f1 is a projection of R12
 Arguments R12f1 r
 R12f1 is transparent
 Expands to: Constant sort_poly_elab.Records.R12f1
-Declared in library sort_poly_elab, line 694, characters 4-9
+Declared in library sort_poly_elab, line 701, characters 4-9
 R12f2@{α α0 ; } :
 forall r : R12@{α α0 ; },
 let f' : forall _ : nat, nat :=
@@ -1150,7 +1164,7 @@ R12f2 is a projection of R12
 Arguments R12f2 r
 R12f2 is transparent
 Expands to: Constant sort_poly_elab.Records.R12f2
-Declared in library sort_poly_elab, line 695, characters 4-9
+Declared in library sort_poly_elab, line 702, characters 4-9
 R13@{α α0 α1 α2 ; u u0} :
 Type@{α ; max(Set,u+1,u0+1)}
 (* α α0 α1 α2 ; u u0 |= α1 -> Type
@@ -1164,7 +1178,7 @@ R13@{α α0 α1 α2 ; u u0} may only be eliminated to produce values whose type
   (SProp <= Prop <= Type, and all variables <= Type)
   than the instantiation of α.
 Expands to: Inductive sort_poly_elab.Records.R13
-Declared in library sort_poly_elab, line 710, characters 9-12
+Declared in library sort_poly_elab, line 717, characters 9-12
 R13f1@{α α0 α1 α2 ; u u0} :
 forall _ : R13@{α α0 α1 α2 ; u u0}, Type@{α0 ; u}
 (* α α0 α1 α2 ; u u0 |= α -> Type
@@ -1177,7 +1191,7 @@ R13f1 is a projection of R13
 Arguments R13f1 r
 R13f1 is transparent
 Expands to: Constant sort_poly_elab.Records.R13f1
-Declared in library sort_poly_elab, line 711, characters 4-9
+Declared in library sort_poly_elab, line 718, characters 4-9
 R13f2@{α α0 α1 α2 ; u u0} :
 forall _ : R13@{α α0 α1 α2 ; u u0}, Type@{α0 ; u0}
 (* α α0 α1 α2 ; u u0 |= α -> Type
@@ -1190,7 +1204,7 @@ R13f2 is a projection of R13
 Arguments R13f2 r
 R13f2 is transparent
 Expands to: Constant sort_poly_elab.Records.R13f2
-Declared in library sort_poly_elab, line 712, characters 4-9
+Declared in library sort_poly_elab, line 719, characters 4-9
 R13f3@{α α0 α1 α2 ; u u0} :
 forall _ : R13@{α α0 α1 α2 ; u u0}, bool@{α1 ; }
 (* α α0 α1 α2 ; u u0 |= α -> α1
@@ -1203,7 +1217,7 @@ R13f3 is a projection of R13
 Arguments R13f3 r
 R13f3 is transparent
 Expands to: Constant sort_poly_elab.Records.R13f3
-Declared in library sort_poly_elab, line 713, characters 4-9
+Declared in library sort_poly_elab, line 720, characters 4-9
 R13f4@{α α0 α1 α2 ; u u0} :
 forall (r : R13@{α α0 α1 α2 ; u u0}) (b : bool@{α2 ; }),
 match b return Type@{α0 ; u} with
@@ -1226,7 +1240,7 @@ R13f4 is a projection of R13
 Arguments R13f4 r b
 R13f4 is transparent
 Expands to: Constant sort_poly_elab.Records.R13f4
-Declared in library sort_poly_elab, line 714, characters 4-9
+Declared in library sort_poly_elab, line 721, characters 4-9
 C1@{α α0 ; u} : forall _ : Type@{α ; u}, Type@{α0 ; u}
 (* α α0 ; u |=  *)
 
@@ -1238,7 +1252,7 @@ C1@{α α0 ; u} may only be eliminated to produce values whose type is in sort q
   than the instantiation of α0.
 Arguments C1 A%_type_scope
 Expands to: Inductive sort_poly_elab.Classes.C1
-Declared in library sort_poly_elab, line 749, characters 8-10
+Declared in library sort_poly_elab, line 756, characters 8-10
 C1f1@{α α0 ; u} :
 forall {A : Type@{α ; u}} {_ : C1@{α α0 ; u} A}, A
 (* α α0 ; u |= α0 -> α *)
@@ -1248,41 +1262,41 @@ C1f1 is a projection of C1
 Arguments C1f1 {A}%_type_scope {C1}
 C1f1 is transparent
 Expands to: Constant sort_poly_elab.Classes.C1f1
-Declared in library sort_poly_elab, line 750, characters 4-8
+Declared in library sort_poly_elab, line 757, characters 4-8
 C1I1@{α α0 ; u} : C1@{α α0 ; u} unit@{α ; u}
 (* α α0 ; u |=  *)
 
 C1I1 is universe polymorphic
 C1I1 is transparent
 Expands to: Constant sort_poly_elab.Classes.C1I1
-Declared in library sort_poly_elab, line 757, characters 11-15
+Declared in library sort_poly_elab, line 764, characters 11-15
 C1ProgramI1@{α α0 ; u} : C1@{α α0 ; u} unit@{α ; u}
 (* α α0 ; u |=  *)
 
 C1ProgramI1 is universe polymorphic
 C1ProgramI1 is transparent
 Expands to: Constant sort_poly_elab.Classes.C1ProgramI1
-Declared in library sort_poly_elab, line 760, characters 19-30
+Declared in library sort_poly_elab, line 767, characters 19-30
 C1RefineI1@{α α0 ; u} : C1@{α α0 ; u} unit@{α ; u}
 (* α α0 ; u |=  *)
 
 C1RefineI1 is universe polymorphic
 C1RefineI1 is transparent
 Expands to: Constant sort_poly_elab.Classes.C1RefineI1
-Declared in library sort_poly_elab, line 767, characters 11-21
+Declared in library sort_poly_elab, line 774, characters 11-21
 C1InteractiveI1@{α α0 ; u} : C1@{α α0 ; u} unit@{α ; u}
 (* α α0 ; u |=  *)
 
 C1InteractiveI1 is universe polymorphic
 C1InteractiveI1 is transparent
 Expands to: Constant sort_poly_elab.Classes.C1InteractiveI1
-Declared in library sort_poly_elab, line 772, characters 11-26
+Declared in library sort_poly_elab, line 779, characters 11-26
 C1AxiomaticI1@{α α0 ; u} : C1@{α α0 ; u} unit@{α ; u}
 (* α α0 ; u |=  *)
 
 C1AxiomaticI1 is universe polymorphic
 Expands to: Constant sort_poly_elab.Classes.C1AxiomaticI1
-Declared in library sort_poly_elab, line 776, characters 9-22
+Declared in library sort_poly_elab, line 783, characters 9-22
 C1InductiveI1@{α ; u} : Type@{α ; u}
 (* α ; u |=  *)
 
@@ -1293,8 +1307,8 @@ C1InductiveI1@{α ; u} may only be eliminated to produce values whose type is in
   (SProp <= Prop <= Type, and all variables <= Type)
   than the instantiation of α.
 Expands to: Inductive sort_poly_elab.Classes.C1InductiveI1
-Declared in library sort_poly_elab, line 780, characters 12-25
-File "./output/sort_poly_elab.v", line 789, characters 0-76:
+Declared in library sort_poly_elab, line 787, characters 12-25
+File "./output/sort_poly_elab.v", line 796, characters 0-76:
 The command has indeed failed with message:
 Sort metavariables must be collapsed to Type in universe monomorphic constructions.
 Attr@{α ; u} : Type@{α ; u}
@@ -1307,4 +1321,4 @@ Attr@{α ; u} may only be eliminated to produce values whose type is in sort qua
   (SProp <= Prop <= Type, and all variables <= Type)
   than the instantiation of α.
 Expands to: Inductive sort_poly_elab.Attr
-Declared in library sort_poly_elab, line 793, characters 10-14
+Declared in library sort_poly_elab, line 800, characters 10-14
diff --git a/test-suite/output/sort_poly_elab.v b/test-suite/output/sort_poly_elab.v
index 9907f7cdf9ed..b5a87eb0b567 100644
--- a/test-suite/output/sort_poly_elab.v
+++ b/test-suite/output/sort_poly_elab.v
@@ -505,6 +505,13 @@ Module Inductives.
   Elimination of a sort polymorphic inductive object instantiated to a variable sort quality
   is only allowed on itself or with an explicit elimination constraint to the target sort. *)
 
+  Monomorphic Sort Test2.
+  Monomorphic Inductive testind : Type@{Test2;Set} := testctor.
+  Fail Check (match true@{Test;} return ?[P] with true => testctor | false => testctor end).
+
+  Polymorphic Inductive testind'@{s;} : Type@{s;Set} := testctor'.
+  Check (match true@{Test;} return ?[P] with true => testctor' | false => testctor' end).
+
   (*********************************************)
   (*                  UNIT                     *)
   (*********************************************)
diff --git a/test-suite/success/sort_poly_elim_csts.v b/test-suite/success/sort_poly_elim_csts.v
index 8d5783a8e690..da4bcb505348 100644
--- a/test-suite/success/sort_poly_elim_csts.v
+++ b/test-suite/success/sort_poly_elim_csts.v
@@ -23,12 +23,14 @@ Section Global.
   Fail Check t@{s Type;Set Set}.
 End Global.
 
+Definition dominant@{Exn Test;|Prop -> Test, Exn -> Test} := tt.
+
 Section Dominant.
   Sort Exn.
 
   Sort Test.
   Constraint Prop -> Test.
-  Fail Constraint Exn -> Test.
+  Succeed Constraint Exn -> Test.
 
   Fail Polymorphic Definition test@{s;l|Prop -> s, Exn -> s} (A : Type@{s;l}) : A := ad A.
 End Dominant.
diff --git a/vernac/comInductive.ml b/vernac/comInductive.ml
index bd0441668e32..5620998c55cf 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
@@ -375,18 +374,20 @@ 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
 
@@ -396,13 +397,14 @@ let non_template_levels sigma ~params ~arity ~constructors =
   (* 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, _) ->
+    | 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) ->
@@ -422,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 =
@@ -443,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
@@ -452,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
diff --git a/vernac/comRewriteRule.ml b/vernac/comRewriteRule.ml
index 7f72650fa954..12e21b847a3c 100644
--- a/vernac/comRewriteRule.ml
+++ b/vernac/comRewriteRule.ml
@@ -105,19 +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 ->
     match Sorts.QVar.repr qv with
-    | Global qg -> stateq, PQGlobal qg
-    | Var qi ->
-        update_invtblq1 ~loc evd q qi stateq, PQVar (Some qi)
+    | 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
@@ -149,21 +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 qv = match Sorts.Quality.subst_fn qsubst qold with QConstant _ -> assert false | QVar qv -> qv in
-      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
-      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.QVar.name qv with
-      | Some qg -> (st, sq, su), PSGlobal (qg, ba)
-      | None -> (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 =
@@ -508,14 +516,17 @@ let interp_rule ~collapse_sort_variables (udecl, lhs, rhs: Constrexpr.universe_d
 
   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
           Pp.(str "Sort variable " ++ Termops.pr_evd_qvar evd q ++ str " appears in the replacement but does not appear in the pattern.")
     | Some n when n < 0 || n > nvarqs' -> CErrors.anomaly Pp.(str "Unknown sort variable in rewrite rule.")
     | Some _ -> ()
-    | None when Option.has_some (Sorts.QVar.name q) -> ()
     | None ->
         if not @@ Sorts.QVar.Set.mem q (evd |> Evd.sort_context_set |> fst |> fst) then
           CErrors.user_err ?loc:rhs_loc
@@ -542,7 +553,7 @@ let interp_rule ~collapse_sort_variables (udecl, lhs, rhs: Constrexpr.universe_d
 
   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
 
diff --git a/vernac/declareUniv.ml b/vernac/declareUniv.ml
index d25d2f685bef..abae03212427 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,51 @@ 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 = UnivGen.new_sort_global id in
+      q, (id, Sorts.Quality.QGlobal q))
+      l
+  in
+  let src = UnqualifiedQuality in
+  let () = input_sort_names (src, List.map snd l) in
+  let qs = List.fold_left  (fun qs (qv, _) -> Sorts.QGlobal.(Set.add qv qs))
+      Sorts.QGlobal.Set.empty l
+  in
+  Global.push_qualities (qs, Sorts.ElimConstraints.empty)
+
+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
-    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)
+  let new_sort =
+    let n = Section.section_qvar_count @@
+      Option.get @@ Safe_typing.sections_of_safe_env @@
+      Global.safe_env ()
     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 +275,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.push_qualities (Sorts.QGlobal.Set.empty, qcst) in
     Global.push_context_set (Univ.Level.Set.empty, ucst)
   | true ->
     let uctx = UVars.UContext.make
diff --git a/vernac/himsg.ml b/vernac/himsg.ml
index fc20d314f060..1041122c1307 100644
--- a/vernac/himsg.ml
+++ b/vernac/himsg.ml
@@ -296,11 +296,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 +429,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 +893,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 +910,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 () =
@@ -1288,15 +1288,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) ->
@@ -1759,12 +1758,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
diff --git a/vernac/indschemes.ml b/vernac/indschemes.ml
index a544ce55236a..835bb013e702 100644
--- a/vernac/indschemes.ml
+++ b/vernac/indschemes.ml
@@ -345,7 +345,7 @@ let scheme_suffix_gen {sch_type; sch_sort} sort =
     | false , Qual (QConstant QSProp) -> "_scase"
     | false , Qual (QConstant QType) -> "_caset"
     | false , _ -> "_case"
-    | _     , Qual (QVar _) -> assert false in
+    | _     , 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"
@@ -415,7 +415,7 @@ 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 _) ->
+        | Set | Qual (QConstant QSProp | QVar _ | QGlobal _) ->
           (* currently we don't have standard scheme kinds for this *)
           None
     in
diff --git a/vernac/ppvernac.ml b/vernac/ppvernac.ml
index 07073ebba031..52e42939cfd6 100644
--- a/vernac/ppvernac.ml
+++ b/vernac/ppvernac.ml
@@ -445,8 +445,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
diff --git a/vernac/prettyp.ml b/vernac/prettyp.ml
index d4f6b90320b0..03ebd7bdbe97 100644
--- a/vernac/prettyp.ml
+++ b/vernac/prettyp.ml
@@ -200,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
@@ -246,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 "."
@@ -254,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() ++
@@ -270,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 " ++
diff --git a/vernac/record.ml b/vernac/record.ml
index 2c153f4b209e..6085099b5bfa 100644
--- a/vernac/record.ml
+++ b/vernac/record.ml
@@ -163,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))
diff --git a/vernac/vernacentries.ml b/vernac/vernacentries.ml
index b61fc5f4a7ce..fb1a820cced1 100644
--- a/vernac/vernacentries.ml
+++ b/vernac/vernacentries.ml
@@ -189,7 +189,7 @@ let show_universes ~proof =
   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 =
@@ -723,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
 
@@ -2159,7 +2159,8 @@ let vernac_global_check c =
   let sigma = Evd.collapse_sort_variables sigma in
   let c = EConstr.to_constr sigma c in
   let (qs, us), (qcst, ucst) as uctx = Evd.sort_context_set sigma in
-  let env = Environ.push_qualities ~rigid:false (qs, qcst) env in (* XXX always empty due to collapse? *)
+   (* 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

From 1848db45a6f02a64652fe2cb8e37a283d0247b44 Mon Sep 17 00:00:00 2001
From: Matthieu Sozeau <matthieu.sozeau@inria.fr>
Date: Mon, 23 Mar 2026 11:23:20 +0100
Subject: [PATCH 294/578] Fix bug #7672 (autorewrite* wrong semantics)

Adapt documentation (no more buggy!)

Add original example script from issue
---
 doc/sphinx/proofs/automatic-tactics/auto.rst |  4 -
 tactics/equality.ml                          |  2 +-
 test-suite/bugs/bug_7672.v                   | 82 ++++++++++++++++++++
 3 files changed, 83 insertions(+), 5 deletions(-)
 create mode 100644 test-suite/bugs/bug_7672.v

diff --git a/doc/sphinx/proofs/automatic-tactics/auto.rst b/doc/sphinx/proofs/automatic-tactics/auto.rst
index 8828000519c8..0f62a9ebdd39 100644
--- a/doc/sphinx/proofs/automatic-tactics/auto.rst
+++ b/doc/sphinx/proofs/automatic-tactics/auto.rst
@@ -203,10 +203,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.
 
diff --git a/tactics/equality.ml b/tactics/equality.ml
index 9aa1d715b553..a214b5cdb131 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
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.

From c454054ef7ea1c3ed576e1900b878d0d3ca1da4a Mon Sep 17 00:00:00 2001
From: Matthieu Sozeau <mattam@mattam.org>
Date: Wed, 25 Mar 2026 16:11:58 +0100
Subject: [PATCH 295/578] Add changelog, also fixed bug 4976

---
 .../04-tactics/21803-fix-7672-Fixed.rst        |  7 +++++++
 test-suite/bugs/bug_4976.v                     | 18 ++++++++++++++++++
 2 files changed, 25 insertions(+)
 create mode 100644 doc/changelog/04-tactics/21803-fix-7672-Fixed.rst
 create mode 100644 test-suite/bugs/bug_4976.v

diff --git a/doc/changelog/04-tactics/21803-fix-7672-Fixed.rst b/doc/changelog/04-tactics/21803-fix-7672-Fixed.rst
new file mode 100644
index 000000000000..7e3fd58c75d6
--- /dev/null
+++ b/doc/changelog/04-tactics/21803-fix-7672-Fixed.rst
@@ -0,0 +1,7 @@
+- **Fixed:**
+  :n:`autorewrite*` was failing if any of the possible rewritings
+  failed to solve its generated side-conditions
+  (`#21803 <https://github.com/rocq-prover/rocq/pull/21803>`_,
+  fixes `#7672 <https://github.com/rocq-prover/rocq/issues/7672>`_
+  and `#4976 <https://github.com/rocq-prover/rocq/issues/4976>`_,
+  by Matthieu Sozeau).
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.

From 9e4524b5329396892291f23eb80402b9a512c222 Mon Sep 17 00:00:00 2001
From: Jason Gross <jgross@mit.edu>
Date: Thu, 26 Mar 2026 11:48:46 +0100
Subject: [PATCH 296/578] Print Assumptions: also traverse types of definitions

Print Assumptions previously only traversed the body of global
definitions, not their types. However, the type of a definition
may mention references depending on axioms that are unrelated to
the body, even if the type converts to something else.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
---
 .../21825-print-assumptions-globals-types-Fixed.rst |  6 ++++++
 test-suite/output/PrintAssumptions.out              |  2 ++
 test-suite/output/PrintAssumptions.v                | 13 +++++++++++++
 vernac/assumptions.ml                               | 10 ++++++++++
 4 files changed, 31 insertions(+)
 create mode 100644 doc/changelog/08-vernac-commands-and-options/21825-print-assumptions-globals-types-Fixed.rst

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 <https://github.com/rocq-prover/rocq/pull/21825>`_,
+  by Jason Gross).
diff --git a/test-suite/output/PrintAssumptions.out b/test-suite/output/PrintAssumptions.out
index 270575ba92b3..44d5d7061450 100644
--- a/test-suite/output/PrintAssumptions.out
+++ b/test-suite/output/PrintAssumptions.out
@@ -9,6 +9,8 @@ bli : Type
 Axioms:
 seq relies on definitional UIP.
 Axioms:
+ax : nat
+Axioms:
 M.foo : False
 Closed under the global context
 Closed under the global context
diff --git a/test-suite/output/PrintAssumptions.v b/test-suite/output/PrintAssumptions.v
index ce7c33b369d3..490914b81fba 100644
--- a/test-suite/output/PrintAssumptions.v
+++ b/test-suite/output/PrintAssumptions.v
@@ -72,6 +72,19 @@ Module UIP.
   Print Assumptions UIP.
 End UIP.
 
+(** Print Assumptions should also check the type of globals even when
+    they have a body, since they may mention unrelated references. *)
+
+Module TYPES.
+
+Axiom ax : nat.
+Definition ty := (fun _ : nat => nat) ax.
+(* [foo]'s body is [0] which does not mention [ax], but its type [ty] does. *)
+Definition foo : ty := 0.
+Print Assumptions foo.
+
+End TYPES.
+
 (** Print Assumption and Include *)
 
 Module INCLUDE.
diff --git a/vernac/assumptions.ml b/vernac/assumptions.ml
index 9fb173e66401..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)

From 20557b9555cdf02622b8efef7f387193f536ba19 Mon Sep 17 00:00:00 2001
From: Jason Gross <jgross@mit.edu>
Date: Wed, 18 Mar 2026 18:31:51 +0100
Subject: [PATCH 297/578] Add Set Indices Matter vernacular option

Expose the indices_matter typing flag as a Set/Unset option,
mirroring other typing flags like Guard Checking and Positivity Checking.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
---
 test-suite/output/indices_matter.out | 3 +++
 test-suite/output/indices_matter.v   | 8 ++++++++
 vernac/vernacentries.ml              | 8 ++++++++
 3 files changed, 19 insertions(+)

diff --git a/test-suite/output/indices_matter.out b/test-suite/output/indices_matter.out
index 72dd0b80a73d..eff79ca98662 100644
--- a/test-suite/output/indices_matter.out
+++ b/test-suite/output/indices_matter.out
@@ -1,2 +1,5 @@
 Axioms:
 M.X relies on indices not mattering.
+Axioms:
+M.X relies on indices not mattering.
+Closed under the global context
diff --git a/test-suite/output/indices_matter.v b/test-suite/output/indices_matter.v
index 62058aa614ab..1a6393627f59 100644
--- a/test-suite/output/indices_matter.v
+++ b/test-suite/output/indices_matter.v
@@ -2,3 +2,11 @@
 Require Import TestSuite.indices_matter_prereq.
 
 Print Assumptions M.X.
+
+(* Test Set Indices Matter *)
+Module SetIndicesMatter.
+  Set Indices Matter.
+  Print Assumptions M.X.
+  Unset Indices Matter.
+  Print Assumptions M.X.
+End SetIndicesMatter.
diff --git a/vernac/vernacentries.ml b/vernac/vernacentries.ml
index b61fc5f4a7ce..41d6bbd9e872 100644
--- a/vernac/vernacentries.ml
+++ b/vernac/vernacentries.ml
@@ -2039,6 +2039,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;

From c309b707d4d287e3c764a4f8e269e9af2a822c53 Mon Sep 17 00:00:00 2001
From: Jason Gross <jgross@mit.edu>
Date: Thu, 19 Feb 2026 18:58:16 -0800
Subject: [PATCH 298/578] Add Ltac2 API for scheme lookup

Expose inductive scheme lookup from Ltac2 via two new functions in
Ind: scheme_lookup (returns option) and scheme_kind_exists (checks if
a builder is registered).

Closes #20987.

Co-Authored-By: Claude Opus 4.6 <noreply@anthropic.com>
---
 .../21658-ltac2-scheme-lookup-Added.rst       |  6 +++
 plugins/ltac2/tac2core.ml                     | 12 +++++
 test-suite/ltac2/scheme_lookup.v              | 53 +++++++++++++++++++
 theories/Ltac2/Ind.v                          | 16 ++++++
 4 files changed, 87 insertions(+)
 create mode 100644 doc/changelog/06-Ltac2-language/21658-ltac2-scheme-lookup-Added.rst
 create mode 100644 test-suite/ltac2/scheme_lookup.v

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..097192432b15
--- /dev/null
+++ b/doc/changelog/06-Ltac2-language/21658-ltac2-scheme-lookup-Added.rst
@@ -0,0 +1,6 @@
+- **Added:**
+  ``Ind.scheme_lookup`` and ``Ind.scheme_kind_exists`` in Ltac2
+  to look up registered inductive schemes (elimination, case analysis, etc.) by
+  scheme kind string (`#21658
+  <https://github.com/rocq-prover/rocq/pull/21658>`_, fixes `#20987
+  <https://github.com/rocq-prover/rocq/issues/20987>`_, by Jason Gross).
diff --git a/plugins/ltac2/tac2core.ml b/plugins/ltac2/tac2core.ml
index cec677a93d48..0c8a912c1b2c 100644
--- a/plugins/ltac2/tac2core.ml
+++ b/plugins/ltac2/tac2core.ml
@@ -1363,6 +1363,18 @@ let () =
   Declareops.inductive_make_projections ind mib
   |> Option.map (Array.map (fun (p,_) -> Projection.make p false))
 
+(** Ind schemes *)
+
+let () =
+  define "ind_scheme_lookup" (string @-> inductive @-> ret (option reference))
+  @@ fun kind ind ->
+  DeclareScheme.lookup_scheme_opt kind ind
+
+let () =
+  define "ind_scheme_kind_exists" (string @-> ret bool)
+  @@ fun kind ->
+  Ind_tables.is_declared_scheme_object kind
+
 (** Proj *)
 
 let () =
diff --git a/test-suite/ltac2/scheme_lookup.v b/test-suite/ltac2/scheme_lookup.v
new file mode 100644
index 000000000000..b008fe704be4
--- /dev/null
+++ b/test-suite/ltac2/scheme_lookup.v
@@ -0,0 +1,53 @@
+Require Import Ltac2.Ltac2.
+Require Import Ltac2.Option.
+
+(** Test Ind.scheme_kind_exists *)
+
+Ltac2 Eval
+  (* "rect_dep" is a standard elimination scheme kind *)
+  if Ind.scheme_kind_exists "rect_dep" then ()
+  else Control.throw Not_found.
+
+Ltac2 Eval
+  (* An invalid scheme kind should return false *)
+  if Ind.scheme_kind_exists "nonexistent_scheme_kind" then
+    Control.throw Not_found
+  else ().
+
+(** Test Ind.scheme_lookup *)
+
+Ltac2 Eval
+  let nat := Option.get (Env.get [@Corelib; @Init; @Datatypes; @nat]) in
+  let nat := match nat with
+  | Std.IndRef ind => ind
+  | _ => Control.throw Not_found
+  end in
+  (* nat should have a rect_dep scheme (i.e., nat_rect) *)
+  match Ind.scheme_lookup "rect_dep" nat with
+  | Some _ => ()
+  | None => Control.throw Not_found
+  end.
+
+Ltac2 Eval
+  let nat := Option.get (Env.get [@Corelib; @Init; @Datatypes; @nat]) in
+  let nat := match nat with
+  | Std.IndRef ind => ind
+  | _ => Control.throw Not_found
+  end in
+  (* nat should have an ind_dep scheme (i.e., nat_ind) *)
+  match Ind.scheme_lookup "ind_dep" nat with
+  | Some _ => ()
+  | None => Control.throw Not_found
+  end.
+
+Ltac2 Eval
+  let nat := Option.get (Env.get [@Corelib; @Init; @Datatypes; @nat]) in
+  let nat := match nat with
+  | Std.IndRef ind => ind
+  | _ => Control.throw Not_found
+  end in
+  (* A bogus scheme kind should return None *)
+  match Ind.scheme_lookup "nonexistent_scheme_kind" nat with
+  | Some _ => Control.throw Not_found
+  | None => ()
+  end.
diff --git a/theories/Ltac2/Ind.v b/theories/Ltac2/Ind.v
index 4c2b7d75c678..6623d134b2d9 100644
--- a/theories/Ltac2/Ind.v
+++ b/theories/Ltac2/Ind.v
@@ -9,6 +9,7 @@
 (************************************************************************)
 
 From Ltac2 Require Import Init.
+From Ltac2 Require Import Std.
 
 Ltac2 Type t := inductive.
 (** An [inductive] is a name of a mutually inductive type and the index of an
@@ -82,3 +83,18 @@ Ltac2 @external print : t -> message
   := "rocq-runtime.plugins.ltac2" "ind_print".
 (** Print the inductive using the shortest qualified identifier which refers to it.
     Does not avoid variable names in the current or global environment. *)
+
+(** {2 Scheme lookup} *)
+
+Ltac2 @ external scheme_lookup : string -> t -> Std.reference option
+  := "rocq-runtime.plugins.ltac2" "ind_scheme_lookup".
+(** [scheme_lookup kind ind] looks up the scheme registered under [kind] for
+    inductive [ind]. Returns [None] if no such scheme is registered. Common
+    scheme kind strings include ["rect_dep"], ["ind_dep"], ["rec_dep"],
+    ["sind_dep"], ["rect_nodep"], ["ind_nodep"], ["rec_nodep"], ["sind_nodep"],
+    ["case_dep"], ["case_nodep"], ["casep_dep"], ["casep_nodep"]. *)
+
+Ltac2 @ external scheme_kind_exists : string -> bool
+  := "rocq-runtime.plugins.ltac2" "ind_scheme_kind_exists".
+(** Returns [true] if a scheme builder has been registered under the given
+    kind string. *)

From c251e86624bb314391216b96fb1696eb16db3b6f Mon Sep 17 00:00:00 2001
From: Jason Gross <jgross@mit.edu>
Date: Sat, 21 Mar 2026 18:18:13 +0100
Subject: [PATCH 299/578] Replace string scheme kinds with abstract type in
 Ltac2 API

Address review feedback: scheme kind names were exposed as raw strings,
which is not future-proof and leaks implementation details. Replace with
an abstract `scheme_kind` type and explicitly exposed values for all
registered scheme kinds (elimination, case analysis, equality, and
decidability schemes). Remove `scheme_kind_exists` which is no longer
needed.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
---
 plugins/ltac2/tac2core.ml        |  34 +++++++--
 plugins/ltac2/tac2ffi.ml         |   5 ++
 plugins/ltac2/tac2ffi.mli        |   4 +
 test-suite/ltac2/scheme_lookup.v |  29 +-------
 theories/Ltac2/Ind.v             | 124 ++++++++++++++++++++++++++++---
 5 files changed, 154 insertions(+), 42 deletions(-)

diff --git a/plugins/ltac2/tac2core.ml b/plugins/ltac2/tac2core.ml
index 0c8a912c1b2c..83c26d218e9a 100644
--- a/plugins/ltac2/tac2core.ml
+++ b/plugins/ltac2/tac2core.ml
@@ -1366,14 +1366,38 @@ let () =
 (** Ind schemes *)
 
 let () =
-  define "ind_scheme_lookup" (string @-> inductive @-> ret (option reference))
+  define "ind_scheme_lookup" (scheme_kind @-> inductive @-> ret (option reference))
   @@ fun kind ind ->
   DeclareScheme.lookup_scheme_opt kind ind
 
-let () =
-  define "ind_scheme_kind_exists" (string @-> ret bool)
-  @@ fun kind ->
-  Ind_tables.is_declared_scheme_object kind
+let define_scheme_kind name =
+  define ("ind_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 "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 *)
 
diff --git a/plugins/ltac2/tac2ffi.ml b/plugins/ltac2/tac2ffi.ml
index 988d066a31d0..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
@@ -477,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
diff --git a/plugins/ltac2/tac2ffi.mli b/plugins/ltac2/tac2ffi.mli
index b1cb92371fb0..93b8f67ea58d 100644
--- a/plugins/ltac2/tac2ffi.mli
+++ b/plugins/ltac2/tac2ffi.mli
@@ -230,6 +230,10 @@ 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
diff --git a/test-suite/ltac2/scheme_lookup.v b/test-suite/ltac2/scheme_lookup.v
index b008fe704be4..819e355e8e1a 100644
--- a/test-suite/ltac2/scheme_lookup.v
+++ b/test-suite/ltac2/scheme_lookup.v
@@ -1,19 +1,6 @@
 Require Import Ltac2.Ltac2.
 Require Import Ltac2.Option.
 
-(** Test Ind.scheme_kind_exists *)
-
-Ltac2 Eval
-  (* "rect_dep" is a standard elimination scheme kind *)
-  if Ind.scheme_kind_exists "rect_dep" then ()
-  else Control.throw Not_found.
-
-Ltac2 Eval
-  (* An invalid scheme kind should return false *)
-  if Ind.scheme_kind_exists "nonexistent_scheme_kind" then
-    Control.throw Not_found
-  else ().
-
 (** Test Ind.scheme_lookup *)
 
 Ltac2 Eval
@@ -23,7 +10,7 @@ Ltac2 Eval
   | _ => Control.throw Not_found
   end in
   (* nat should have a rect_dep scheme (i.e., nat_rect) *)
-  match Ind.scheme_lookup "rect_dep" nat with
+  match Ind.scheme_lookup Ind.rect_dep nat with
   | Some _ => ()
   | None => Control.throw Not_found
   end.
@@ -35,19 +22,7 @@ Ltac2 Eval
   | _ => Control.throw Not_found
   end in
   (* nat should have an ind_dep scheme (i.e., nat_ind) *)
-  match Ind.scheme_lookup "ind_dep" nat with
+  match Ind.scheme_lookup Ind.ind_dep nat with
   | Some _ => ()
   | None => Control.throw Not_found
   end.
-
-Ltac2 Eval
-  let nat := Option.get (Env.get [@Corelib; @Init; @Datatypes; @nat]) in
-  let nat := match nat with
-  | Std.IndRef ind => ind
-  | _ => Control.throw Not_found
-  end in
-  (* A bogus scheme kind should return None *)
-  match Ind.scheme_lookup "nonexistent_scheme_kind" nat with
-  | Some _ => Control.throw Not_found
-  | None => ()
-  end.
diff --git a/theories/Ltac2/Ind.v b/theories/Ltac2/Ind.v
index 6623d134b2d9..a7eb5fad2e93 100644
--- a/theories/Ltac2/Ind.v
+++ b/theories/Ltac2/Ind.v
@@ -86,15 +86,119 @@ Ltac2 @external print : t -> message
 
 (** {2 Scheme lookup} *)
 
-Ltac2 @ external scheme_lookup : string -> t -> Std.reference option
+Ltac2 Type scheme_kind.
+(** An abstract type representing a scheme kind. Use the predefined values
+    below to refer to specific scheme kinds. *)
+
+Ltac2 @ external scheme_lookup : scheme_kind -> t -> Std.reference option
   := "rocq-runtime.plugins.ltac2" "ind_scheme_lookup".
 (** [scheme_lookup kind ind] looks up the scheme registered under [kind] for
-    inductive [ind]. Returns [None] if no such scheme is registered. Common
-    scheme kind strings include ["rect_dep"], ["ind_dep"], ["rec_dep"],
-    ["sind_dep"], ["rect_nodep"], ["ind_nodep"], ["rec_nodep"], ["sind_nodep"],
-    ["case_dep"], ["case_nodep"], ["casep_dep"], ["casep_nodep"]. *)
-
-Ltac2 @ external scheme_kind_exists : string -> bool
-  := "rocq-runtime.plugins.ltac2" "ind_scheme_kind_exists".
-(** Returns [true] if a scheme builder has been registered under the given
-    kind string. *)
+    inductive [ind]. Returns [None] if no such scheme is registered. *)
+
+(** {3 Elimination schemes} *)
+
+Ltac2 @ external rect_dep : scheme_kind
+  := "rocq-runtime.plugins.ltac2" "ind_scheme_kind_rect_dep".
+(** Dependent recursion scheme for Type. *)
+
+Ltac2 @ external rec_dep : scheme_kind
+  := "rocq-runtime.plugins.ltac2" "ind_scheme_kind_rec_dep".
+(** Dependent recursion scheme for Set. *)
+
+Ltac2 @ external ind_dep : scheme_kind
+  := "rocq-runtime.plugins.ltac2" "ind_scheme_kind_ind_dep".
+(** Dependent induction scheme for Prop. *)
+
+Ltac2 @ external sind_dep : scheme_kind
+  := "rocq-runtime.plugins.ltac2" "ind_scheme_kind_sind_dep".
+(** Dependent induction scheme for SProp. *)
+
+Ltac2 @ external rect_nodep : scheme_kind
+  := "rocq-runtime.plugins.ltac2" "ind_scheme_kind_rect_nodep".
+(** Non-dependent recursion scheme for Type. *)
+
+Ltac2 @ external rec_nodep : scheme_kind
+  := "rocq-runtime.plugins.ltac2" "ind_scheme_kind_rec_nodep".
+(** Non-dependent recursion scheme for Set. *)
+
+Ltac2 @ external ind_nodep : scheme_kind
+  := "rocq-runtime.plugins.ltac2" "ind_scheme_kind_ind_nodep".
+(** Non-dependent induction scheme for Prop. *)
+
+Ltac2 @ external sind_nodep : scheme_kind
+  := "rocq-runtime.plugins.ltac2" "ind_scheme_kind_sind_nodep".
+(** Non-dependent induction scheme for SProp. *)
+
+(** {3 Case analysis schemes} *)
+
+Ltac2 @ external case_dep : scheme_kind
+  := "rocq-runtime.plugins.ltac2" "ind_scheme_kind_case_dep".
+(** Dependent case analysis scheme for Type. *)
+
+Ltac2 @ external case_nodep : scheme_kind
+  := "rocq-runtime.plugins.ltac2" "ind_scheme_kind_case_nodep".
+(** Non-dependent case analysis scheme for Type. *)
+
+Ltac2 @ external casep_dep : scheme_kind
+  := "rocq-runtime.plugins.ltac2" "ind_scheme_kind_casep_dep".
+(** Dependent case analysis scheme for Prop. *)
+
+Ltac2 @ external casep_nodep : scheme_kind
+  := "rocq-runtime.plugins.ltac2" "ind_scheme_kind_casep_nodep".
+(** Non-dependent case analysis scheme for Prop. *)
+
+(** {3 Equality schemes} *)
+
+Ltac2 @ external sym : scheme_kind
+  := "rocq-runtime.plugins.ltac2" "ind_scheme_kind_sym".
+(** Symmetry scheme. *)
+
+Ltac2 @ external sym_involutive : scheme_kind
+  := "rocq-runtime.plugins.ltac2" "ind_scheme_kind_sym_involutive".
+(** Involutive symmetry scheme. *)
+
+Ltac2 @ external rew : scheme_kind
+  := "rocq-runtime.plugins.ltac2" "ind_scheme_kind_rew".
+(** Right-to-left rewriting scheme. *)
+
+Ltac2 @ external rew_dep : scheme_kind
+  := "rocq-runtime.plugins.ltac2" "ind_scheme_kind_rew_dep".
+(** Right-to-left dependent rewriting scheme. *)
+
+Ltac2 @ external rew_fwd_dep : scheme_kind
+  := "rocq-runtime.plugins.ltac2" "ind_scheme_kind_rew_fwd_dep".
+(** Right-to-left forward dependent rewriting scheme. *)
+
+Ltac2 @ external rew_r : scheme_kind
+  := "rocq-runtime.plugins.ltac2" "ind_scheme_kind_rew_r".
+(** Left-to-right rewriting scheme. *)
+
+Ltac2 @ external rew_r_dep : scheme_kind
+  := "rocq-runtime.plugins.ltac2" "ind_scheme_kind_rew_r_dep".
+(** Left-to-right dependent rewriting scheme. *)
+
+Ltac2 @ external rew_fwd_r_dep : scheme_kind
+  := "rocq-runtime.plugins.ltac2" "ind_scheme_kind_rew_fwd_r_dep".
+(** Left-to-right forward dependent rewriting scheme. *)
+
+Ltac2 @ external congr : scheme_kind
+  := "rocq-runtime.plugins.ltac2" "ind_scheme_kind_congr".
+(** Congruence scheme. *)
+
+(** {3 Boolean equality and decidability schemes} *)
+
+Ltac2 @ external beq : scheme_kind
+  := "rocq-runtime.plugins.ltac2" "ind_scheme_kind_beq".
+(** Boolean equality scheme. *)
+
+Ltac2 @ external dec_bl : scheme_kind
+  := "rocq-runtime.plugins.ltac2" "ind_scheme_kind_dec_bl".
+(** Boolean to Leibniz equality scheme. *)
+
+Ltac2 @ external dec_lb : scheme_kind
+  := "rocq-runtime.plugins.ltac2" "ind_scheme_kind_dec_lb".
+(** Leibniz to boolean equality scheme. *)
+
+Ltac2 @ external eq_dec : scheme_kind
+  := "rocq-runtime.plugins.ltac2" "ind_scheme_kind_eq_dec".
+(** Decidable equality scheme. *)

From 5f70220ca20584df39b3da95555d7c443be8658a Mon Sep 17 00:00:00 2001
From: Jason Gross <jgross@mit.edu>
Date: Sun, 22 Mar 2026 01:36:24 +0100
Subject: [PATCH 300/578] Wrap Scheme lookup in Module Scheme

---
 .../21658-ltac2-scheme-lookup-Added.rst       |   5 +-
 test-suite/ltac2/scheme_lookup.v              |   6 +-
 theories/Ltac2/Ind.v                          | 111 +++++++++---------
 3 files changed, 61 insertions(+), 61 deletions(-)

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
index 097192432b15..db62e13e69fc 100644
--- a/doc/changelog/06-Ltac2-language/21658-ltac2-scheme-lookup-Added.rst
+++ b/doc/changelog/06-Ltac2-language/21658-ltac2-scheme-lookup-Added.rst
@@ -1,6 +1,5 @@
 - **Added:**
-  ``Ind.scheme_lookup`` and ``Ind.scheme_kind_exists`` in Ltac2
-  to look up registered inductive schemes (elimination, case analysis, etc.) by
-  scheme kind string (`#21658
+  ``Ind.Scheme.lookup`` in Ltac2 to look up registered inductive schemes
+  (elimination, case analysis, etc.) by scheme kind (`#21658
   <https://github.com/rocq-prover/rocq/pull/21658>`_, fixes `#20987
   <https://github.com/rocq-prover/rocq/issues/20987>`_, by Jason Gross).
diff --git a/test-suite/ltac2/scheme_lookup.v b/test-suite/ltac2/scheme_lookup.v
index 819e355e8e1a..18843e4c6c59 100644
--- a/test-suite/ltac2/scheme_lookup.v
+++ b/test-suite/ltac2/scheme_lookup.v
@@ -1,7 +1,7 @@
 Require Import Ltac2.Ltac2.
 Require Import Ltac2.Option.
 
-(** Test Ind.scheme_lookup *)
+(** Test Ind.Scheme.lookup *)
 
 Ltac2 Eval
   let nat := Option.get (Env.get [@Corelib; @Init; @Datatypes; @nat]) in
@@ -10,7 +10,7 @@ Ltac2 Eval
   | _ => Control.throw Not_found
   end in
   (* nat should have a rect_dep scheme (i.e., nat_rect) *)
-  match Ind.scheme_lookup Ind.rect_dep nat with
+  match Ind.Scheme.lookup Ind.Scheme.rect_dep nat with
   | Some _ => ()
   | None => Control.throw Not_found
   end.
@@ -22,7 +22,7 @@ Ltac2 Eval
   | _ => Control.throw Not_found
   end in
   (* nat should have an ind_dep scheme (i.e., nat_ind) *)
-  match Ind.scheme_lookup Ind.ind_dep nat with
+  match Ind.Scheme.lookup Ind.Scheme.ind_dep nat with
   | Some _ => ()
   | None => Control.throw Not_found
   end.
diff --git a/theories/Ltac2/Ind.v b/theories/Ltac2/Ind.v
index a7eb5fad2e93..32ac63621793 100644
--- a/theories/Ltac2/Ind.v
+++ b/theories/Ltac2/Ind.v
@@ -85,120 +85,121 @@ Ltac2 @external print : t -> message
     Does not avoid variable names in the current or global environment. *)
 
 (** {2 Scheme lookup} *)
-
-Ltac2 Type scheme_kind.
+Module Scheme.
+Ltac2 Type kind.
 (** An abstract type representing a scheme kind. Use the predefined values
     below to refer to specific scheme kinds. *)
 
-Ltac2 @ external scheme_lookup : scheme_kind -> t -> Std.reference option
-  := "rocq-runtime.plugins.ltac2" "ind_scheme_lookup".
-(** [scheme_lookup kind ind] looks up the scheme registered under [kind] for
+Ltac2 @ external lookup : kind -> t -> Std.reference option
+:= "rocq-runtime.plugins.ltac2" "ind_scheme_lookup".
+(** [Scheme.lookup kind ind] looks up the scheme registered under [kind] for
     inductive [ind]. Returns [None] if no such scheme is registered. *)
 
 (** {3 Elimination schemes} *)
 
-Ltac2 @ external rect_dep : scheme_kind
-  := "rocq-runtime.plugins.ltac2" "ind_scheme_kind_rect_dep".
+Ltac2 @ external rect_dep : kind
+:= "rocq-runtime.plugins.ltac2" "ind_scheme_kind_rect_dep".
 (** Dependent recursion scheme for Type. *)
 
-Ltac2 @ external rec_dep : scheme_kind
-  := "rocq-runtime.plugins.ltac2" "ind_scheme_kind_rec_dep".
+Ltac2 @ external rec_dep : kind
+:= "rocq-runtime.plugins.ltac2" "ind_scheme_kind_rec_dep".
 (** Dependent recursion scheme for Set. *)
 
-Ltac2 @ external ind_dep : scheme_kind
-  := "rocq-runtime.plugins.ltac2" "ind_scheme_kind_ind_dep".
+Ltac2 @ external ind_dep : kind
+:= "rocq-runtime.plugins.ltac2" "ind_scheme_kind_ind_dep".
 (** Dependent induction scheme for Prop. *)
 
-Ltac2 @ external sind_dep : scheme_kind
-  := "rocq-runtime.plugins.ltac2" "ind_scheme_kind_sind_dep".
+Ltac2 @ external sind_dep : kind
+:= "rocq-runtime.plugins.ltac2" "ind_scheme_kind_sind_dep".
 (** Dependent induction scheme for SProp. *)
 
-Ltac2 @ external rect_nodep : scheme_kind
-  := "rocq-runtime.plugins.ltac2" "ind_scheme_kind_rect_nodep".
+Ltac2 @ external rect_nodep : kind
+:= "rocq-runtime.plugins.ltac2" "ind_scheme_kind_rect_nodep".
 (** Non-dependent recursion scheme for Type. *)
 
-Ltac2 @ external rec_nodep : scheme_kind
-  := "rocq-runtime.plugins.ltac2" "ind_scheme_kind_rec_nodep".
+Ltac2 @ external rec_nodep : kind
+:= "rocq-runtime.plugins.ltac2" "ind_scheme_kind_rec_nodep".
 (** Non-dependent recursion scheme for Set. *)
 
-Ltac2 @ external ind_nodep : scheme_kind
-  := "rocq-runtime.plugins.ltac2" "ind_scheme_kind_ind_nodep".
+Ltac2 @ external ind_nodep : kind
+:= "rocq-runtime.plugins.ltac2" "ind_scheme_kind_ind_nodep".
 (** Non-dependent induction scheme for Prop. *)
 
-Ltac2 @ external sind_nodep : scheme_kind
-  := "rocq-runtime.plugins.ltac2" "ind_scheme_kind_sind_nodep".
+Ltac2 @ external sind_nodep : kind
+:= "rocq-runtime.plugins.ltac2" "ind_scheme_kind_sind_nodep".
 (** Non-dependent induction scheme for SProp. *)
 
 (** {3 Case analysis schemes} *)
 
-Ltac2 @ external case_dep : scheme_kind
-  := "rocq-runtime.plugins.ltac2" "ind_scheme_kind_case_dep".
+Ltac2 @ external case_dep : kind
+:= "rocq-runtime.plugins.ltac2" "ind_scheme_kind_case_dep".
 (** Dependent case analysis scheme for Type. *)
 
-Ltac2 @ external case_nodep : scheme_kind
-  := "rocq-runtime.plugins.ltac2" "ind_scheme_kind_case_nodep".
+Ltac2 @ external case_nodep : kind
+:= "rocq-runtime.plugins.ltac2" "ind_scheme_kind_case_nodep".
 (** Non-dependent case analysis scheme for Type. *)
 
-Ltac2 @ external casep_dep : scheme_kind
-  := "rocq-runtime.plugins.ltac2" "ind_scheme_kind_casep_dep".
+Ltac2 @ external casep_dep : kind
+:= "rocq-runtime.plugins.ltac2" "ind_scheme_kind_casep_dep".
 (** Dependent case analysis scheme for Prop. *)
 
-Ltac2 @ external casep_nodep : scheme_kind
-  := "rocq-runtime.plugins.ltac2" "ind_scheme_kind_casep_nodep".
+Ltac2 @ external casep_nodep : kind
+:= "rocq-runtime.plugins.ltac2" "ind_scheme_kind_casep_nodep".
 (** Non-dependent case analysis scheme for Prop. *)
 
 (** {3 Equality schemes} *)
 
-Ltac2 @ external sym : scheme_kind
-  := "rocq-runtime.plugins.ltac2" "ind_scheme_kind_sym".
+Ltac2 @ external sym : kind
+:= "rocq-runtime.plugins.ltac2" "ind_scheme_kind_sym".
 (** Symmetry scheme. *)
 
-Ltac2 @ external sym_involutive : scheme_kind
-  := "rocq-runtime.plugins.ltac2" "ind_scheme_kind_sym_involutive".
+Ltac2 @ external sym_involutive : kind
+:= "rocq-runtime.plugins.ltac2" "ind_scheme_kind_sym_involutive".
 (** Involutive symmetry scheme. *)
 
-Ltac2 @ external rew : scheme_kind
-  := "rocq-runtime.plugins.ltac2" "ind_scheme_kind_rew".
+Ltac2 @ external rew : kind
+:= "rocq-runtime.plugins.ltac2" "ind_scheme_kind_rew".
 (** Right-to-left rewriting scheme. *)
 
-Ltac2 @ external rew_dep : scheme_kind
-  := "rocq-runtime.plugins.ltac2" "ind_scheme_kind_rew_dep".
+Ltac2 @ external rew_dep : kind
+:= "rocq-runtime.plugins.ltac2" "ind_scheme_kind_rew_dep".
 (** Right-to-left dependent rewriting scheme. *)
 
-Ltac2 @ external rew_fwd_dep : scheme_kind
-  := "rocq-runtime.plugins.ltac2" "ind_scheme_kind_rew_fwd_dep".
+Ltac2 @ external rew_fwd_dep : kind
+:= "rocq-runtime.plugins.ltac2" "ind_scheme_kind_rew_fwd_dep".
 (** Right-to-left forward dependent rewriting scheme. *)
 
-Ltac2 @ external rew_r : scheme_kind
-  := "rocq-runtime.plugins.ltac2" "ind_scheme_kind_rew_r".
+Ltac2 @ external rew_r : kind
+:= "rocq-runtime.plugins.ltac2" "ind_scheme_kind_rew_r".
 (** Left-to-right rewriting scheme. *)
 
-Ltac2 @ external rew_r_dep : scheme_kind
-  := "rocq-runtime.plugins.ltac2" "ind_scheme_kind_rew_r_dep".
+Ltac2 @ external rew_r_dep : kind
+:= "rocq-runtime.plugins.ltac2" "ind_scheme_kind_rew_r_dep".
 (** Left-to-right dependent rewriting scheme. *)
 
-Ltac2 @ external rew_fwd_r_dep : scheme_kind
-  := "rocq-runtime.plugins.ltac2" "ind_scheme_kind_rew_fwd_r_dep".
+Ltac2 @ external rew_fwd_r_dep : kind
+:= "rocq-runtime.plugins.ltac2" "ind_scheme_kind_rew_fwd_r_dep".
 (** Left-to-right forward dependent rewriting scheme. *)
 
-Ltac2 @ external congr : scheme_kind
-  := "rocq-runtime.plugins.ltac2" "ind_scheme_kind_congr".
+Ltac2 @ external congr : kind
+:= "rocq-runtime.plugins.ltac2" "ind_scheme_kind_congr".
 (** Congruence scheme. *)
 
 (** {3 Boolean equality and decidability schemes} *)
 
-Ltac2 @ external beq : scheme_kind
-  := "rocq-runtime.plugins.ltac2" "ind_scheme_kind_beq".
+Ltac2 @ external beq : kind
+:= "rocq-runtime.plugins.ltac2" "ind_scheme_kind_beq".
 (** Boolean equality scheme. *)
 
-Ltac2 @ external dec_bl : scheme_kind
-  := "rocq-runtime.plugins.ltac2" "ind_scheme_kind_dec_bl".
+Ltac2 @ external dec_bl : kind
+:= "rocq-runtime.plugins.ltac2" "ind_scheme_kind_dec_bl".
 (** Boolean to Leibniz equality scheme. *)
 
-Ltac2 @ external dec_lb : scheme_kind
-  := "rocq-runtime.plugins.ltac2" "ind_scheme_kind_dec_lb".
+Ltac2 @ external dec_lb : kind
+:= "rocq-runtime.plugins.ltac2" "ind_scheme_kind_dec_lb".
 (** Leibniz to boolean equality scheme. *)
 
-Ltac2 @ external eq_dec : scheme_kind
-  := "rocq-runtime.plugins.ltac2" "ind_scheme_kind_eq_dec".
+Ltac2 @ external eq_dec : kind
+:= "rocq-runtime.plugins.ltac2" "ind_scheme_kind_eq_dec".
 (** Decidable equality scheme. *)
+End Scheme.

From e26b6c008091f02abfc21294464428d8b275348a Mon Sep 17 00:00:00 2001
From: Jason Gross <jgross@mit.edu>
Date: Thu, 26 Mar 2026 15:17:34 +0100
Subject: [PATCH 301/578] Move Scheme to Ltac2/Scheme.v and accept
 Std.reference in lookup

Move the Scheme module from Ind.v to its own Scheme.v file.
Also change lookup to accept Std.reference (returning None for
non-inductive references) instead of requiring an inductive.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
---
 .../21658-ltac2-scheme-lookup-Added.rst       |   2 +-
 doc/corelib/index-list.html.template          |   1 +
 plugins/ltac2/tac2core.ml                     |  12 +-
 test-suite/ltac2/scheme_lookup.v              |  14 +-
 theories/Ltac2/Ind.v                          | 121 ----------------
 theories/Ltac2/Ltac2.v                        |   1 +
 theories/Ltac2/Scheme.v                       | 130 ++++++++++++++++++
 7 files changed, 143 insertions(+), 138 deletions(-)
 create mode 100644 theories/Ltac2/Scheme.v

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
index db62e13e69fc..b90f492724a5 100644
--- a/doc/changelog/06-Ltac2-language/21658-ltac2-scheme-lookup-Added.rst
+++ b/doc/changelog/06-Ltac2-language/21658-ltac2-scheme-lookup-Added.rst
@@ -1,5 +1,5 @@
 - **Added:**
-  ``Ind.Scheme.lookup`` in Ltac2 to look up registered inductive schemes
+  ``Scheme.lookup`` in Ltac2 to look up registered inductive schemes
   (elimination, case analysis, etc.) by scheme kind (`#21658
   <https://github.com/rocq-prover/rocq/pull/21658>`_, fixes `#20987
   <https://github.com/rocq-prover/rocq/issues/20987>`_, by Jason Gross).
diff --git a/doc/corelib/index-list.html.template b/doc/corelib/index-list.html.template
index 65f493a14123..6923703a666c 100644
--- a/doc/corelib/index-list.html.template
+++ b/doc/corelib/index-list.html.template
@@ -157,6 +157,7 @@ through the <tt>Require Import</tt> command.</p>
     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
diff --git a/plugins/ltac2/tac2core.ml b/plugins/ltac2/tac2core.ml
index 83c26d218e9a..7d278ef57372 100644
--- a/plugins/ltac2/tac2core.ml
+++ b/plugins/ltac2/tac2core.ml
@@ -1363,15 +1363,17 @@ let () =
   Declareops.inductive_make_projections ind mib
   |> Option.map (Array.map (fun (p,_) -> Projection.make p false))
 
-(** Ind schemes *)
+(** Schemes *)
 
 let () =
-  define "ind_scheme_lookup" (scheme_kind @-> inductive @-> ret (option reference))
-  @@ fun kind ind ->
-  DeclareScheme.lookup_scheme_opt kind ind
+  define "scheme_lookup" (scheme_kind @-> reference @-> ret (option reference))
+  @@ fun kind ref ->
+  match ref with
+  | GlobRef.IndRef ind -> DeclareScheme.lookup_scheme_opt kind ind
+  | _ -> None
 
 let define_scheme_kind name =
-  define ("ind_scheme_kind_" ^ name) (ret scheme_kind) name
+  define ("scheme_kind_" ^ name) (ret scheme_kind) name
 
 let () = define_scheme_kind "rect_dep"
 let () = define_scheme_kind "rec_dep"
diff --git a/test-suite/ltac2/scheme_lookup.v b/test-suite/ltac2/scheme_lookup.v
index 18843e4c6c59..442e0469826a 100644
--- a/test-suite/ltac2/scheme_lookup.v
+++ b/test-suite/ltac2/scheme_lookup.v
@@ -1,28 +1,20 @@
 Require Import Ltac2.Ltac2.
 Require Import Ltac2.Option.
 
-(** Test Ind.Scheme.lookup *)
+(** Test Scheme.lookup *)
 
 Ltac2 Eval
   let nat := Option.get (Env.get [@Corelib; @Init; @Datatypes; @nat]) in
-  let nat := match nat with
-  | Std.IndRef ind => ind
-  | _ => Control.throw Not_found
-  end in
   (* nat should have a rect_dep scheme (i.e., nat_rect) *)
-  match Ind.Scheme.lookup Ind.Scheme.rect_dep nat with
+  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
-  let nat := match nat with
-  | Std.IndRef ind => ind
-  | _ => Control.throw Not_found
-  end in
   (* nat should have an ind_dep scheme (i.e., nat_ind) *)
-  match Ind.Scheme.lookup Ind.Scheme.ind_dep nat with
+  match Scheme.lookup Scheme.ind_dep nat with
   | Some _ => ()
   | None => Control.throw Not_found
   end.
diff --git a/theories/Ltac2/Ind.v b/theories/Ltac2/Ind.v
index 32ac63621793..4c2b7d75c678 100644
--- a/theories/Ltac2/Ind.v
+++ b/theories/Ltac2/Ind.v
@@ -9,7 +9,6 @@
 (************************************************************************)
 
 From Ltac2 Require Import Init.
-From Ltac2 Require Import Std.
 
 Ltac2 Type t := inductive.
 (** An [inductive] is a name of a mutually inductive type and the index of an
@@ -83,123 +82,3 @@ Ltac2 @external print : t -> message
   := "rocq-runtime.plugins.ltac2" "ind_print".
 (** Print the inductive using the shortest qualified identifier which refers to it.
     Does not avoid variable names in the current or global environment. *)
-
-(** {2 Scheme lookup} *)
-Module Scheme.
-Ltac2 Type kind.
-(** An abstract type representing a scheme kind. Use the predefined values
-    below to refer to specific scheme kinds. *)
-
-Ltac2 @ external lookup : kind -> t -> Std.reference option
-:= "rocq-runtime.plugins.ltac2" "ind_scheme_lookup".
-(** [Scheme.lookup kind ind] looks up the scheme registered under [kind] for
-    inductive [ind]. Returns [None] if no such scheme is registered. *)
-
-(** {3 Elimination schemes} *)
-
-Ltac2 @ external rect_dep : kind
-:= "rocq-runtime.plugins.ltac2" "ind_scheme_kind_rect_dep".
-(** Dependent recursion scheme for Type. *)
-
-Ltac2 @ external rec_dep : kind
-:= "rocq-runtime.plugins.ltac2" "ind_scheme_kind_rec_dep".
-(** Dependent recursion scheme for Set. *)
-
-Ltac2 @ external ind_dep : kind
-:= "rocq-runtime.plugins.ltac2" "ind_scheme_kind_ind_dep".
-(** Dependent induction scheme for Prop. *)
-
-Ltac2 @ external sind_dep : kind
-:= "rocq-runtime.plugins.ltac2" "ind_scheme_kind_sind_dep".
-(** Dependent induction scheme for SProp. *)
-
-Ltac2 @ external rect_nodep : kind
-:= "rocq-runtime.plugins.ltac2" "ind_scheme_kind_rect_nodep".
-(** Non-dependent recursion scheme for Type. *)
-
-Ltac2 @ external rec_nodep : kind
-:= "rocq-runtime.plugins.ltac2" "ind_scheme_kind_rec_nodep".
-(** Non-dependent recursion scheme for Set. *)
-
-Ltac2 @ external ind_nodep : kind
-:= "rocq-runtime.plugins.ltac2" "ind_scheme_kind_ind_nodep".
-(** Non-dependent induction scheme for Prop. *)
-
-Ltac2 @ external sind_nodep : kind
-:= "rocq-runtime.plugins.ltac2" "ind_scheme_kind_sind_nodep".
-(** Non-dependent induction scheme for SProp. *)
-
-(** {3 Case analysis schemes} *)
-
-Ltac2 @ external case_dep : kind
-:= "rocq-runtime.plugins.ltac2" "ind_scheme_kind_case_dep".
-(** Dependent case analysis scheme for Type. *)
-
-Ltac2 @ external case_nodep : kind
-:= "rocq-runtime.plugins.ltac2" "ind_scheme_kind_case_nodep".
-(** Non-dependent case analysis scheme for Type. *)
-
-Ltac2 @ external casep_dep : kind
-:= "rocq-runtime.plugins.ltac2" "ind_scheme_kind_casep_dep".
-(** Dependent case analysis scheme for Prop. *)
-
-Ltac2 @ external casep_nodep : kind
-:= "rocq-runtime.plugins.ltac2" "ind_scheme_kind_casep_nodep".
-(** Non-dependent case analysis scheme for Prop. *)
-
-(** {3 Equality schemes} *)
-
-Ltac2 @ external sym : kind
-:= "rocq-runtime.plugins.ltac2" "ind_scheme_kind_sym".
-(** Symmetry scheme. *)
-
-Ltac2 @ external sym_involutive : kind
-:= "rocq-runtime.plugins.ltac2" "ind_scheme_kind_sym_involutive".
-(** Involutive symmetry scheme. *)
-
-Ltac2 @ external rew : kind
-:= "rocq-runtime.plugins.ltac2" "ind_scheme_kind_rew".
-(** Right-to-left rewriting scheme. *)
-
-Ltac2 @ external rew_dep : kind
-:= "rocq-runtime.plugins.ltac2" "ind_scheme_kind_rew_dep".
-(** Right-to-left dependent rewriting scheme. *)
-
-Ltac2 @ external rew_fwd_dep : kind
-:= "rocq-runtime.plugins.ltac2" "ind_scheme_kind_rew_fwd_dep".
-(** Right-to-left forward dependent rewriting scheme. *)
-
-Ltac2 @ external rew_r : kind
-:= "rocq-runtime.plugins.ltac2" "ind_scheme_kind_rew_r".
-(** Left-to-right rewriting scheme. *)
-
-Ltac2 @ external rew_r_dep : kind
-:= "rocq-runtime.plugins.ltac2" "ind_scheme_kind_rew_r_dep".
-(** Left-to-right dependent rewriting scheme. *)
-
-Ltac2 @ external rew_fwd_r_dep : kind
-:= "rocq-runtime.plugins.ltac2" "ind_scheme_kind_rew_fwd_r_dep".
-(** Left-to-right forward dependent rewriting scheme. *)
-
-Ltac2 @ external congr : kind
-:= "rocq-runtime.plugins.ltac2" "ind_scheme_kind_congr".
-(** Congruence scheme. *)
-
-(** {3 Boolean equality and decidability schemes} *)
-
-Ltac2 @ external beq : kind
-:= "rocq-runtime.plugins.ltac2" "ind_scheme_kind_beq".
-(** Boolean equality scheme. *)
-
-Ltac2 @ external dec_bl : kind
-:= "rocq-runtime.plugins.ltac2" "ind_scheme_kind_dec_bl".
-(** Boolean to Leibniz equality scheme. *)
-
-Ltac2 @ external dec_lb : kind
-:= "rocq-runtime.plugins.ltac2" "ind_scheme_kind_dec_lb".
-(** Leibniz to boolean equality scheme. *)
-
-Ltac2 @ external eq_dec : kind
-:= "rocq-runtime.plugins.ltac2" "ind_scheme_kind_eq_dec".
-(** Decidable equality scheme. *)
-End Scheme.
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/Scheme.v b/theories/Ltac2/Scheme.v
new file mode 100644
index 000000000000..f846eba23034
--- /dev/null
+++ b/theories/Ltac2/Scheme.v
@@ -0,0 +1,130 @@
+(************************************************************************)
+(*         *      The Rocq Prover / The Rocq Development Team           *)
+(*  v      *         Copyright INRIA, CNRS and contributors             *)
+(* <O___,, * (see version control and CREDITS file for authors & dates) *)
+(*   \VV/  **************************************************************)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+From Ltac2 Require Import Init.
+From Ltac2 Require Import Std.
+
+Ltac2 Type kind.
+(** An abstract type representing a scheme kind. Use the predefined values
+    below to refer to specific scheme kinds. *)
+
+Ltac2 @ external lookup : kind -> 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. *)
+
+(** {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. *)

From 1dd3e60c4425a721b8cbb680ac991e9fa609b67f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Tue, 24 Feb 2026 18:40:53 +0100
Subject: [PATCH 302/578] Inline binder_constr

cf #21670

Mostly backwards compatible
---
 doc/tools/docgram/common.edit_mlg        |  3 +-
 doc/tools/docgram/fullGrammar            | 24 ++++----
 lib/deprecation.ml                       |  1 +
 lib/deprecation.mli                      |  1 +
 parsing/g_constr.mlg                     | 73 ++++++++++++------------
 parsing/notation_gram.mli                |  1 +
 parsing/procq.ml                         |  1 -
 parsing/procq.mli                        |  1 -
 plugins/ssr/ssrvernac.mlg                |  4 +-
 test-suite/output/Notations4.out         |  6 +-
 test-suite/output/PrintGrammar.out       | 50 ++++++++--------
 test-suite/output/PrintGrammarConstr.out | 32 +++++------
 test-suite/output/PrintNotation.out      | 12 ++--
 theories/Corelib/Compat/Rocq92.v         |  3 +-
 vernac/egramrocq.ml                      | 38 ++++++------
 vernac/metasyntax.ml                     | 54 ++++++++++++++++--
 16 files changed, 168 insertions(+), 136 deletions(-)

diff --git a/doc/tools/docgram/common.edit_mlg b/doc/tools/docgram/common.edit_mlg
index 786b3a648e6f..92116172fefc 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
@@ -2314,7 +2314,6 @@ SPLICE: [
 | ext_module_expr
 | ext_module_type
 | test
-| binder_constr
 | atomic_constr
 | let_type_cstr
 | name_colon
diff --git a/doc/tools/docgram/fullGrammar b/doc/tools/docgram/fullGrammar
index b8017b485a5d..dae9f38810e8 100644
--- a/doc/tools/docgram/fullGrammar
+++ b/doc/tools/docgram/fullGrammar
@@ -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,19 +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 OPT [ "in" pattern200 ] ":=" term200 OPT 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 ")"
diff --git a/lib/deprecation.ml b/lib/deprecation.ml
index 67c8b345ba47..41ed5fd5cf78 100644
--- a/lib/deprecation.ml
+++ b/lib/deprecation.ml
@@ -99,6 +99,7 @@ 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 *)
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/parsing/g_constr.mlg b/parsing/g_constr.mlg
index 00fcb117a02f..029d7c225b8e 100644
--- a/parsing/g_constr.mlg
+++ b/parsing/g_constr.mlg
@@ -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
@@ -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,42 +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"; 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) } ] ]
-  ;
   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)) }
diff --git a/parsing/notation_gram.mli b/parsing/notation_gram.mli
index 40722d4690c5..42ebf6230085 100644
--- a/parsing/notation_gram.mli
+++ b/parsing/notation_gram.mli
@@ -20,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 1af149145240..fe11bd0075b9 100644
--- a/parsing/procq.ml
+++ b/parsing/procq.ml
@@ -345,7 +345,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 02756096bf71..6de4d6739fe0 100644
--- a/parsing/procq.mli
+++ b/parsing/procq.mli
@@ -173,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/plugins/ssr/ssrvernac.mlg b/plugins/ssr/ssrvernac.mlg
index d93101b33c13..d7995bd31af5 100644
--- a/plugins/ssr/ssrvernac.mlg
+++ b/plugins/ssr/ssrvernac.mlg
@@ -84,7 +84,7 @@ 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: [
@@ -95,7 +95,7 @@ GRAMMAR EXTEND Gram
   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 [
+  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 ->
diff --git a/test-suite/output/Notations4.out b/test-suite/output/Notations4.out
index 198d6500d6d7..3cbe2d8cd175 100644
--- a/test-suite/output/Notations4.out
+++ b/test-suite/output/Notations4.out
@@ -286,9 +286,9 @@ where
      : nat
 File "./output/Notations4.v", line 542, characters 0-78:
 The command has indeed failed with message:
-Notation "func _ .. _ , _" is already defined at level 200 with arguments
-binder, constr at next level while it is now required to be at level 200
-with arguments constr, constr at next level.
+Notation "func _ .. _ , _" is already defined at level 10 with arguments
+binder, constr at level below 200 while it is now required to be at level 10
+with arguments constr, constr at level below 200.
 File "./output/Notations4.v", line 547, characters 0-57:
 The command has indeed failed with message:
 Notation "[[ _ ]]" is already defined at level 0 with arguments custom foo
diff --git a/test-suite/output/PrintGrammar.out b/test-suite/output/PrintGrammar.out
index 6ac58ee6b468..1724e7df811f 100644
--- a/test-suite/output/PrintGrammar.out
+++ b/test-suite/output/PrintGrammar.out
@@ -1,29 +1,3 @@
-Entry binder_constr is
-[ LEFTA
-  [ "exists2"; "'"; pattern LEVEL "0"; ":"; term LEVEL "200"; ","; term LEVEL
-    "200"; "&"; term LEVEL "200"
-  | "exists2"; "'"; pattern LEVEL "0"; ","; term LEVEL "200"; "&"; term LEVEL
-    "200"
-  | "exists2"; name; ":"; term LEVEL "200"; ","; term LEVEL "200"; "&"; term
-    LEVEL "200"
-  | "exists2"; name; ","; term LEVEL "200"; "&"; term LEVEL "200"
-  | "exists"; "!"; open_binders; ","; term LEVEL "200"
-  | "exists"; open_binders; ","; term LEVEL "200"
-  | "forall"; open_binders; ","; term LEVEL "200"
-  | "fun"; open_binders; "=>"; term LEVEL "200"
-  | "let"; "fix"; fix_decl; "in"; term LEVEL "200"
-  | "let"; "cofix"; cofix_body; "in"; term LEVEL "200"
-  | "let"; "'"; pattern LEVEL "200"; OPT [ "in"; pattern LEVEL "200" ]; ":=";
-    term LEVEL "200"; OPT case_type; "in"; term LEVEL "200"
-  | "let"; name; binders; let_type_cstr; ":="; term LEVEL "200"; "in"; term
-    LEVEL "200"
-  | "let"; [ "("; LIST0 name SEP ","; ")" | "()" ]; as_return_type; ":=";
-    term LEVEL "200"; "in"; term LEVEL "200"
-  | "if"; term LEVEL "200"; as_return_type; "then"; term LEVEL "200"; "else";
-    term LEVEL "200"
-  | "fix"; fix_decls
-  | "cofix"; cofix_decls ] ]
-
 Entry constr is
 [ LEFTA
   [ "@"; global; univ_annot
@@ -85,9 +59,31 @@ Entry term is
   [ SELF; "^"; term LEVEL "30" ]
 | "10" LEFTA
   [ SELF; LIST1 arg
+  | "exists2"; "'"; pattern LEVEL "0"; ":"; term LEVEL "200"; ","; term LEVEL
+    "200"; "&"; term LEVEL "200"
+  | "exists2"; "'"; pattern LEVEL "0"; ","; term LEVEL "200"; "&"; term LEVEL
+    "200"
+  | "exists2"; name; ":"; term LEVEL "200"; ","; term LEVEL "200"; "&"; term
+    LEVEL "200"
+  | "exists2"; name; ","; term LEVEL "200"; "&"; term LEVEL "200"
+  | "exists"; "!"; open_binders; ","; term LEVEL "200"
+  | "exists"; open_binders; ","; term LEVEL "200"
   | "@"; global; univ_annot; LIST0 NEXT
   | "@"; pattern_ident; LIST1 identref
-  | binder_constr ]
+  | "forall"; open_binders; ","; term LEVEL "200"
+  | "fun"; open_binders; "=>"; term LEVEL "200"
+  | "let"; "fix"; fix_decl; "in"; term LEVEL "200"
+  | "let"; "cofix"; cofix_body; "in"; term LEVEL "200"
+  | "let"; "'"; pattern LEVEL "200"; OPT [ "in"; pattern LEVEL "200" ]; ":=";
+    term LEVEL "200"; OPT case_type; "in"; term LEVEL "200"
+  | "let"; name; binders; let_type_cstr; ":="; term LEVEL "200"; "in"; term
+    LEVEL "200"
+  | "let"; [ "("; LIST0 name SEP ","; ")" | "()" ]; as_return_type; ":=";
+    term LEVEL "200"; "in"; term LEVEL "200"
+  | "if"; term LEVEL "200"; as_return_type; "then"; term LEVEL "200"; "else";
+    term LEVEL "200"
+  | "fix"; fix_decls
+  | "cofix"; cofix_decls ]
 | "9" LEFTA
   [ ".."; term LEVEL "0"; ".." ]
 | "8" LEFTA
diff --git a/test-suite/output/PrintGrammarConstr.out b/test-suite/output/PrintGrammarConstr.out
index 9b230f711812..43647dab85cb 100644
--- a/test-suite/output/PrintGrammarConstr.out
+++ b/test-suite/output/PrintGrammarConstr.out
@@ -1,20 +1,3 @@
-Entry binder_constr is
-[ LEFTA
-  [ "forall"; open_binders; ","; term LEVEL "200"
-  | "fun"; open_binders; "=>"; term LEVEL "200"
-  | "let"; "fix"; fix_decl; "in"; term LEVEL "200"
-  | "let"; "cofix"; cofix_body; "in"; term LEVEL "200"
-  | "let"; "'"; pattern LEVEL "200"; OPT [ "in"; pattern LEVEL "200" ]; ":=";
-    term LEVEL "200"; OPT case_type; "in"; term LEVEL "200"
-  | "let"; name; binders; let_type_cstr; ":="; term LEVEL "200"; "in"; term
-    LEVEL "200"
-  | "let"; [ "("; LIST0 name SEP ","; ")" | "()" ]; as_return_type; ":=";
-    term LEVEL "200"; "in"; term LEVEL "200"
-  | "if"; term LEVEL "200"; as_return_type; "then"; term LEVEL "200"; "else";
-    term LEVEL "200"
-  | "fix"; fix_decls
-  | "cofix"; cofix_decls ] ]
-
 Entry constr is
 [ LEFTA
   [ "@"; global; univ_annot
@@ -40,7 +23,20 @@ Entry term is
   [ SELF; LIST1 arg
   | "@"; global; univ_annot; LIST0 NEXT
   | "@"; pattern_ident; LIST1 identref
-  | binder_constr ]
+  | "forall"; open_binders; ","; term LEVEL "200"
+  | "fun"; open_binders; "=>"; term LEVEL "200"
+  | "let"; "fix"; fix_decl; "in"; term LEVEL "200"
+  | "let"; "cofix"; cofix_body; "in"; term LEVEL "200"
+  | "let"; "'"; pattern LEVEL "200"; OPT [ "in"; pattern LEVEL "200" ]; ":=";
+    term LEVEL "200"; OPT case_type; "in"; term LEVEL "200"
+  | "let"; name; binders; let_type_cstr; ":="; term LEVEL "200"; "in"; term
+    LEVEL "200"
+  | "let"; [ "("; LIST0 name SEP ","; ")" | "()" ]; as_return_type; ":=";
+    term LEVEL "200"; "in"; term LEVEL "200"
+  | "if"; term LEVEL "200"; as_return_type; "then"; term LEVEL "200"; "else";
+    term LEVEL "200"
+  | "fix"; fix_decls
+  | "cofix"; cofix_decls ]
 | "9" LEFTA
   [ ".."; term LEVEL "0"; ".." ]
 | "8" LEFTA
diff --git a/test-suite/output/PrintNotation.out b/test-suite/output/PrintNotation.out
index 7b0eb01c8495..6b7fdce553f7 100644
--- a/test-suite/output/PrintNotation.out
+++ b/test-suite/output/PrintNotation.out
@@ -166,8 +166,8 @@ Notation "{ ' _ : _ & _ }" at level 0 with arguments strict pattern
 at level 0, constr, constr, no associativity.
 Notation "{ ' _ : _ & _ & _ }" at level 0 with arguments strict pattern
 at level 0, constr, constr, constr, no associativity.
-Notation "if _ is _ then _ else _" at level 200 with arguments constr,
-pattern at level 100 at level 100, constr, constr at next level,
+Notation "if _ is _ then _ else _" at level 10 with arguments constr, pattern
+at level 100 at level 100, constr, constr at level below 200,
 no associativity.
 Notation "_ -> _" at level 99 with arguments constr at next level, constr
 at level 200, no associativity.
@@ -263,8 +263,8 @@ Notation "{ ' _ : _ & _ }" at level 0 with arguments strict pattern
 at level 0, constr, constr, no associativity.
 Notation "{ ' _ : _ & _ & _ }" at level 0 with arguments strict pattern
 at level 0, constr, constr, constr, no associativity.
-Notation "if _ is _ then _ else _" at level 200 with arguments constr,
-pattern at level 100 at level 100, constr, constr at next level,
+Notation "if _ is _ then _ else _" at level 10 with arguments constr, pattern
+at level 100 at level 100, constr, constr at level below 200,
 no associativity.
 Notation "{{ _ }}" in Foo at level 0 with arguments custom Foo,
 no associativity.
@@ -325,9 +325,9 @@ The command has indeed failed with message:
 "exists x .. y , p" cannot be interpreted as a known notation. Make sure that
 symbols are surrounded by spaces and that holes are explicitly denoted by
 "_".
-Notation "exists _ .. _ , _" at level 200 with arguments binder, constr
+Notation "exists _ .. _ , _" at level 10 with arguments binder, constr
 at level 200, right associativity.
-Notation "exists _ .. _ , _" at level 200 with arguments binder, constr
+Notation "exists _ .. _ , _" at level 10 with arguments binder, constr
 at level 200, right associativity.
 File "./output/PrintNotation.v", line 193, characters 2-37:
 The command has indeed failed with message:
diff --git a/theories/Corelib/Compat/Rocq92.v b/theories/Corelib/Compat/Rocq92.v
index 96a87763e8a7..377a995a6e0b 100644
--- a/theories/Corelib/Compat/Rocq92.v
+++ b/theories/Corelib/Compat/Rocq92.v
@@ -15,5 +15,4 @@
 
 #[export] Set Warnings "-deprecated-since-9.3".
 
-#[export]
-Set Inline Abstract Subproof.
+#[export] Set Inline Abstract Subproof.
diff --git a/vernac/egramrocq.ml b/vernac/egramrocq.ml
index 1e8511a3b6a9..562da2bed195 100644
--- a/vernac/egramrocq.ml
+++ b/vernac/egramrocq.ml
@@ -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 ->
@@ -563,16 +562,23 @@ 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
diff --git a/vernac/metasyntax.ml b/vernac/metasyntax.ml
index 341fd43d4f16..4d7c53c50511 100644
--- a/vernac/metasyntax.ml
+++ b/vernac/metasyntax.ml
@@ -102,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" ->
@@ -915,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;
@@ -998,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
@@ -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 ~default:Disabled
+    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

From ed6b98ca3384c801fdf5717e811b6d69cc4d608d Mon Sep 17 00:00:00 2001
From: Jason Gross <jgross@mit.edu>
Date: Thu, 26 Mar 2026 18:08:52 +0100
Subject: [PATCH 303/578] Add doc and changelog for Set Indices Matter flag

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
---
 .../21779-set-indices-matter-Added.rst                |  6 ++++++
 doc/sphinx/language/core/inductive.rst                |  4 ++--
 doc/sphinx/proof-engine/vernacular-commands.rst       | 11 ++++++++++-
 3 files changed, 18 insertions(+), 3 deletions(-)
 create mode 100644 doc/changelog/08-vernac-commands-and-options/21779-set-indices-matter-Added.rst

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 <https://github.com/rocq-prover/rocq/pull/21779>`_,
+  by Jason Gross).
diff --git a/doc/sphinx/language/core/inductive.rst b/doc/sphinx/language/core/inductive.rst
index feecbfbd6d8c..393e5dc3b8a5 100644
--- a/doc/sphinx/language/core/inductive.rst
+++ b/doc/sphinx/language/core/inductive.rst
@@ -914,8 +914,8 @@ 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`.
-  When `-indices-matter` is not used, inductives whose indices would contribute
+- 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,
diff --git a/doc/sphinx/proof-engine/vernacular-commands.rst b/doc/sphinx/proof-engine/vernacular-commands.rst
index eaae608a8bb6..00bbf92681b6 100644
--- a/doc/sphinx/proof-engine/vernacular-commands.rst
+++ b/doc/sphinx/proof-engine/vernacular-commands.rst
@@ -434,7 +434,7 @@ 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`),
+   (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`.
@@ -1149,6 +1149,15 @@ 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`).
+   Inductives that rely on indices not mattering are printed by
+   :cmd:`Print Assumptions`.
+
 .. flag:: Universe Checking
 
    This :term:`flag` can be used to enable/disable the checking of universes, providing a

From 1dca86096dac4cb36a1247525709148605ec99e9 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Thu, 26 Feb 2026 15:36:08 +0100
Subject: [PATCH 304/578] Fix test suite & refman to stop using the
 binder_constr hack

---
 doc/sphinx/practical-tools/coqide.rst         |  4 +-
 .../user-extensions/syntax-extensions.rst     | 22 +++++-----
 ide/rocqide/FAQ                               |  4 +-
 test-suite/bugs/bug_12467.v                   | 10 ++---
 test-suite/bugs/bug_14221.v                   |  2 +-
 test-suite/bugs/bug_16975.v                   |  6 +--
 test-suite/bugs/bug_16995_2.v                 |  4 +-
 test-suite/bugs/bug_17860.v                   |  4 +-
 test-suite/bugs/bug_20902_1.v                 |  2 +-
 test-suite/bugs/bug_4780.v                    |  2 +-
 test-suite/bugs/bug_5522.v                    |  2 +-
 test-suite/bugs/bug_5608.v                    |  2 +-
 test-suite/bugs/bug_5696.v                    |  6 +--
 test-suite/bugs/bug_6661.v                    |  6 +--
 test-suite/bugs/bug_7059.v                    |  4 +-
 test-suite/bugs/bug_8739.v                    |  2 +-
 test-suite/bugs/bug_9640.v                    |  4 +-
 test-suite/output-coqtop/DependentEvars3.out  |  2 +-
 test-suite/output-coqtop/DependentEvars3.v    |  2 +-
 test-suite/output/ImplicitTypes.v             |  2 +-
 test-suite/output/Naming.v                    |  2 +-
 test-suite/output/Notations2.v                | 12 +++--
 test-suite/output/Notations3.out              | 10 ++---
 test-suite/output/Notations3.v                | 44 +++++++++----------
 test-suite/output/Notations4.out              |  8 ++--
 test-suite/output/Notations4.v                | 34 +++++++-------
 test-suite/output/PrintNotation.out           | 10 ++---
 test-suite/output/PrintNotation.v             |  2 +-
 test-suite/output/UnexpectedType.v            |  4 +-
 test-suite/output/Utf8Impargs.v               |  2 +-
 test-suite/output/bug_15221.v                 |  2 +-
 test-suite/output/bug_9403.v                  |  4 +-
 test-suite/output/bug_9682.v                  |  2 +-
 test-suite/prerequisite/hurkens.v             | 16 +++----
 test-suite/ssr/rew_polyuniv.v                 |  2 +-
 test-suite/success/BidirectionalityHints.v    |  4 +-
 test-suite/success/CaseInClause.v             |  2 +-
 test-suite/success/Notations.v                |  7 +--
 test-suite/success/Notations2.v               |  6 +--
 theories/Corelib/Init/Logic.v                 | 12 ++---
 theories/Corelib/Init/Notations.v             |  2 +-
 theories/Corelib/ssr/ssrbool.v                |  2 +-
 theories/Corelib/ssr/ssreflect.v              |  6 +--
 theories/Corelib/ssr/ssrfun.v                 |  2 +-
 44 files changed, 143 insertions(+), 146 deletions(-)

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/user-extensions/syntax-extensions.rst b/doc/sphinx/user-extensions/syntax-extensions.rst
index 782af8c1634d..aaacd625632a 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
@@ -877,7 +877,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 +905,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 +928,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 +1020,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 +1148,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 +1181,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 +1190,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 +1200,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
 ~~~~~~~~~~~~~~~~~~
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/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_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_20902_1.v b/test-suite/bugs/bug_20902_1.v
index 805746465308..5c71741ab67b 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).
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_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_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_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_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/output-coqtop/DependentEvars3.out b/test-suite/output-coqtop/DependentEvars3.out
index 0ff81618a6e7..fc07b7cfae0e 100644
--- a/test-suite/output-coqtop/DependentEvars3.out
+++ b/test-suite/output-coqtop/DependentEvars3.out
@@ -3,7 +3,7 @@ Rocq <
 Rocq < 1 goal
   
   ============================
-  (exists n : nat, n = 5 \/ True) /\ (exists m : nat, m = 6 \/ True)
+  (exists n : nat, n = 5 \/ True) /\ exists m : nat, m = 6 \/ True
 
 (dependent evars: ; in current goal:)
 
diff --git a/test-suite/output-coqtop/DependentEvars3.v b/test-suite/output-coqtop/DependentEvars3.v
index af236bb6ff98..d181862b1fd1 100644
--- a/test-suite/output-coqtop/DependentEvars3.v
+++ b/test-suite/output-coqtop/DependentEvars3.v
@@ -1,5 +1,5 @@
 Set Printing Dependent Evars Line.
-Lemma x : (exists(n : nat), n = 5 \/ True) /\ (exists(m : nat), m = 6 \/ True).
+Lemma x : (exists(n : nat), n = 5 \/ True) /\ exists(m : nat), m = 6 \/ True.
 Proof using.
   split.
     eexists.
diff --git a/test-suite/output/ImplicitTypes.v b/test-suite/output/ImplicitTypes.v
index 205c6a67bf55..ac319237a41b 100644
--- a/test-suite/output/ImplicitTypes.v
+++ b/test-suite/output/ImplicitTypes.v
@@ -33,7 +33,7 @@ Check fix f b n := match n with 0 => b | S p => f b p end.
 (* Check in notations *)
 Module Notation.
   Notation "∀ x .. y , P" := (forall x, .. (forall y, P) ..)
-    (at level 200, x binder, y binder, right associativity,
+    (at level 10, P at level 200, x binder, y binder,
     format "'[  ' '[  ' ∀  x  ..  y ']' ,  '/' P ']'") : type_scope.
   Check forall b c, b = c.
   Check forall b1 b2, b1 = b2.
diff --git a/test-suite/output/Naming.v b/test-suite/output/Naming.v
index 610fa48c0c60..4c35296d7c1f 100644
--- a/test-suite/output/Naming.v
+++ b/test-suite/output/Naming.v
@@ -106,7 +106,7 @@ Definition h1 := fun x:nat => (fun {x} => x) 0.
 Definition h2 := let g := forall {y}, y=0 in g.
 
 Notation "∀ x .. y , P" := (forall x, .. (forall y, P) ..)
-  (at level 200, x binder, y binder, right associativity,
+  (at level 10, P at level 200, x binder, y binder, right associativity,
   format "'[  ' '[  ' ∀  x  ..  y ']' ,  '/' P ']'") : type_scope.
 
 Definition l1 := ∀ {x:nat} {y:nat}, x=0.
diff --git a/test-suite/output/Notations2.v b/test-suite/output/Notations2.v
index 9db2c19d7f6c..4433c30986ad 100644
--- a/test-suite/output/Notations2.v
+++ b/test-suite/output/Notations2.v
@@ -38,7 +38,7 @@ Check fun P:nat->nat->Prop => fun x:nat => ex (P x).
 (* Test notations with binders *)
 
 Notation "∃ x .. y , P":= (ex (fun x => .. (ex (fun y => P)) ..))
-  (x binder, y binder, at level 200, right associativity,
+  (x binder, y binder, at level 10, P at level 200,
   format "'[  ' ∃  x  ..  y ']' ,  P").
 
 Check (∃ n p, n+p=0).
@@ -46,12 +46,12 @@ Check (∃ n p, n+p=0).
 Check ∃ (a:=0) (x:nat) y (b:=1) (c:=b) (d:=2) z (e:=3) (f:=4), x+y = z+d.
 
 Notation "∀  x .. y , P":= (forall x, .. (forall y, P) ..)
-  (x binder, at level 200, right associativity).
+  (x binder, at level 10, P at level 200).
 
 Check (∀ n p, n+p=0).
 
 Notation "'λ'  x .. y , P":= (fun x => .. (fun y => P) ..)
-  (y binder, at level 200, right associativity).
+  (y binder, at level 10, P at level 200).
 
 Check (λ n p, n+p=0).
 
@@ -63,8 +63,7 @@ Check `(∀ n p : A, n=p).
 
 Notation "'let'' f x .. y  :=  t 'in' u":=
   (let f := fun x => .. (fun y => t) .. in u)
-  (f name, x closed binder, y closed binder, at level 200,
-   right associativity).
+  (f name, x closed binder, y closed binder, at level 10, u at level 200).
 
 Check let' f x y (a:=0) z (b:bool) := x+y+z+1 in f 0 1 2.
 
@@ -95,8 +94,7 @@ End A.
 
 Notation "'mylet' f [ x ; .. ; y ]  :=  t 'in' u":=
   (let f := fun x => .. (fun y => t) .. in u)
-  (f name, x closed binder, y closed binder, at level 200,
-   right associativity).
+  (f name, x closed binder, y closed binder, at level 10, u at level 200).
 
 Check mylet f [x;y;z;(a:bool)] := x+y+z+1 in f 0 1 2.
 *)
diff --git a/test-suite/output/Notations3.out b/test-suite/output/Notations3.out
index 07a48e551db1..20e22e6f144b 100644
--- a/test-suite/output/Notations3.out
+++ b/test-suite/output/Notations3.out
@@ -87,15 +87,15 @@ fun n : nat => {|n, fun _ : nat => 0 = 0 |}_3
      : nat -> Prop
 fun n : nat => {|n, fun _ : nat => n = 0 |}_3
      : nat -> Prop
-fun n : nat => foo3 n (fun x _ : nat => ETA z : nat, (fun _ : nat => x = 0))
+fun n : nat => foo3 n (fun x _ : nat => ETA z : nat, fun _ : nat => x = 0)
      : nat -> Prop
 fun n : nat => {|n, fun _ : nat => 0 = 0 |}_4
      : nat -> Prop
 fun n : nat => {|n, fun _ : nat => n = 0 |}_4
      : nat -> Prop
-fun n : nat => foo4 n (fun _ _ : nat => ETA z : nat, (fun _ : nat => z = 0))
+fun n : nat => foo4 n (fun _ _ : nat => ETA z : nat, fun _ : nat => z = 0)
      : nat -> Prop
-fun n : nat => foo4 n (fun _ y : nat => ETA z : nat, (fun _ : nat => y = 0))
+fun n : nat => foo4 n (fun _ y : nat => ETA z : nat, fun _ : nat => y = 0)
      : nat -> Prop
 tele (t : Type) '(y, z) (x : t) := tt
      : forall t : Type, nat * nat -> t -> fpack
@@ -118,7 +118,7 @@ where
      : nat * (nat * nat)
 {{0, 1, 2, 3}}
      : nat * (nat * (nat * nat))
-File "./output/Notations3.v", line 179, characters 0-174:
+File "./output/Notations3.v", line 179, characters 0-173:
 Warning: Closed notations (i.e. starting and ending with a terminal symbol)
 should usually be at level 0 (default).
 [closed-notation-not-level-0,parsing,default]
@@ -142,7 +142,7 @@ exists_mixed (x y : nat) '{{z, t}}, x.y = 0 /\ z.t = 0
 exists_true '{{x, y}} (u := 0) '{{z, t}}, x.y = 0 /\ z.t = 0
      : Prop
 exists_true (A : Type) (R : A -> A -> Prop) (_ : Reflexive R),
-(forall x : A, R x x)
+forall x : A, R x x
      : Prop
 exists_true (x : nat) (A : Type) (R : A -> A -> Prop) 
 (_ : Reflexive R) (y : nat), x.y = 0 -> forall z : A, R z z
diff --git a/test-suite/output/Notations3.v b/test-suite/output/Notations3.v
index 18e96731c6b9..cbd1aa43fbe6 100644
--- a/test-suite/output/Notations3.v
+++ b/test-suite/output/Notations3.v
@@ -30,7 +30,7 @@ Set Printing Notations.
 
 Notation "'ETA' x .. y , f" :=
   (fun x => .. (fun y => (.. (f x) ..) y ) ..)
-  (at level 200, x binder, y binder).
+  (at level 10, f at level 200, x binder, y binder).
 Check ETA (x:nat) (y:nat), Nat.add.
 Check ETA (x y:nat), Nat.add.
 Check ETA x y, Nat.add.
@@ -40,19 +40,19 @@ Set Printing Notations.
 Check ETA x y, le_S.
 
 Notation "'CURRY' x .. y , f" := (fun x => .. (fun y => f (x, .. (y,tt) ..)) ..)
-  (at level 200, x binder, y binder).
+  (at level 10, f at level 200, x binder, y binder).
 Check fun f => CURRY (x:nat) (y:bool), f.
 
 Notation "'CURRYINV' x .. y , f" := (fun x => .. (fun y => f (y, .. (x,tt) ..)) ..)
-  (at level 200, x binder, y binder).
+  (at level 10, f at level 200, x binder, y binder).
 Check fun f => CURRYINV (x:nat) (y:bool), f.
 
 Notation "'CURRYLEFT' x .. y , f" := (fun x => .. (fun y => f (.. (tt,x) .., y)) ..)
-  (at level 200, x binder, y binder).
+  (at level 10, f at level 200, x binder, y binder).
 Check fun f => CURRYLEFT (x:nat) (y:bool), f.
 
 Notation "'CURRYINVLEFT' x .. y , f" := (fun x => .. (fun y => f (.. (tt,y) .., x)) ..)
-  (at level 200, x binder, y binder).
+  (at level 10, f at level 200, x binder, y binder).
 Check fun f => CURRYINVLEFT (x:nat) (y:bool), f.
 
 (**********************************************************************)
@@ -177,7 +177,7 @@ Check {{0,1,2,3}}.
 (* Test printing of #5608                                             *)
 
 Reserved Notation "'letpair' x [1] = { A } ; 'return' ( b0 , b1 , .. , b2 )"
-  (at level 200, format "'letpair'  x  [1]  =  { A } ; '//' 'return'  ( b0 ,  b1 ,  .. ,  b2 )").
+  (at level 10, format "'letpair'  x  [1]  =  { A } ; '//' 'return'  ( b0 ,  b1 ,  .. ,  b2 )").
 Notation "'letpair' x [1] = { a } ; 'return' ( b0 , b1 , .. , b2 )" :=
   (let x:=a in ( .. (b0,b1) .., b2)).
 Check letpair x [1] = {0}; return (1,2,3,4).
@@ -196,23 +196,23 @@ Notation "{ { xL | xR // xcut } }" := (xL+xR+xcut)
 Check 1+1+1.
 
 (* Test presence of notation variables in the recursive parts (introduced in dfdaf4de) *)
-Notation "!!! x .. y , b" := ((fun x => b), .. ((fun y => b), True) ..) (at level 200, x binder).
+Notation "!!! x .. y , b" := ((fun x => b), .. ((fun y => b), True) ..) (at level 10, b at level 200, x binder).
 Check !!! (x y:nat), True.
 
 (* Test contraction of "forall x, let 'pat := x in ..." into "forall 'pat, ..." *)
 (* for isolated "forall" (was not working already in 8.6) *)
-Notation "! x .. y , A" := (id (forall x, .. (id (forall y, A)) .. )) (at level 200, x binder).
+Notation "! x .. y , A" := (id (forall x, .. (id (forall y, A)) .. )) (at level 10, A at level 200, x binder).
 Check ! '(x,y), x+y=0.
 
 (* Check that the terminator of a recursive pattern is interpreted in
    the correct environment of bindings *)
-Notation "'exists_mixed' x .. y , P" := (ex (fun x => forall z:nat, .. (ex (fun y => forall z:nat, z=0 /\ P)) ..)) (at level 200, x binder).
+Notation "'exists_mixed' x .. y , P" := (ex (fun x => forall z:nat, .. (ex (fun y => forall z:nat, z=0 /\ P)) ..)) (at level 10, P at level 200, x binder).
 Check exists_mixed x y '(u,t), x+y=0/\u+t=0.
 Check exists_mixed x y '(z,t), x+y=0/\z+t=0.
 
 (* Check that intermediary let-in are inserted in between instances of
    the repeated pattern *)
-Notation "'exists_true' x .. y , P" := (exists x, True /\ .. (exists y, True /\ P) ..) (at level 200, x binder).
+Notation "'exists_true' x .. y , P" := (exists x, True /\ .. (exists y, True /\ P) ..) (at level 10, P at level 200, x binder).
 Check exists_true '(x,y) (u:=0) '(z,t), x+y=0/\z+t=0.
 
 (* Check that generalized binders are correctly interpreted *)
@@ -236,7 +236,7 @@ Check {{D 1, 2 }}.
 #[warning="-closed-notation-not-level-0"]
 Notation "! x .. y # A #" :=
   ((forall x, x=x), .. ((forall y, y=y), A) ..)
-  (at level 200, x binder).
+  (at level 10, x binder).
 Check ! a b : nat # True #.
 Check ((forall x, x=0), nat). (* should not use the notation *)
 
@@ -252,12 +252,12 @@ Check @@ a b : nat # a=b # b=a #.
 
 Notation "'exists_non_null' x .. y  , P" :=
   (ex (fun x => x <> 0 /\ .. (ex (fun y => y <> 0 /\ P)) ..))
-  (at level 200, x binder).
+  (at level 10, P at level 200, x binder).
 Check exists_non_null x y z t , x=y/\z=t.
 
 Notation "'forall_non_null' x .. y  , P" :=
   (forall x, x <> 0 -> .. (forall y, y <> 0 -> P) ..)
-  (at level 200, x binder).
+  (at level 10, P at level 200, x binder).
 Check forall_non_null x y z t , x=y/\z=t.
 
 (* Examples where the recursive pattern is in reverse order *)
@@ -284,7 +284,7 @@ Set Printing Notations.
 Module IfPat.
 Notation "'if' t 'is' n .+ 1 'then' p 'else' q" :=
   (match t with S n => p | 0 => q end)
-  (at level 200).
+  (at level 10, q at level 200).
 Check fun x => if x is n.+1 then n else 1.
 End IfPat.
 
@@ -294,7 +294,7 @@ Check {'(x,y)|x+y=0}.
 
 Module D.
 Notation "'exists2'' x , p & q" := (ex2 (fun x => p) (fun x => q))
-  (at level 200, x pattern, p at level 200, right associativity,
+  (at level 10, x pattern, p at level 200, q at level 200,
     format "'[' 'exists2''  '/  ' x ,  '/  ' '[' p  &  '/' q ']' ']'")
   : type_scope.
 
@@ -308,7 +308,7 @@ Module E.
 Inductive myex2 {A:Type} (P Q:A -> Prop) : Prop :=
   myex_intro2 : forall x:A, P x -> Q x -> myex2 P Q.
 Notation "'myexists2' x : A , p & q" := (myex2 (A:=A) (fun x => p) (fun x => q))
-  (at level 200, x name, A at level 200, p at level 200, right associativity,
+  (at level 10, x name, A at level 200, p, q at level 200,
     format "'[' 'myexists2'  '/  ' x  :  A ,  '/  ' '[' p  &  '/' q ']' ']'")
   : type_scope.
 Check myex2 (fun x => let '(y,z) := x in y>z) (fun x => let '(y,z) := x in z>y).
@@ -318,12 +318,12 @@ End E.
 
 Parameter myex : forall {A}, (A -> Prop) -> Prop.
 Notation "'myexists' x , p" := (myex (fun x => p))
-  (at level 200, x pattern, p at level 200, right associativity).
+  (at level 10, x pattern, p at level 200).
 
 (* A canonical example of a notation with recursive binders *)
 
 Notation "∀  x .. y , P" := (forall x, .. (forall y, P) ..)
-  (at level 200, x binder, y binder, right associativity) : type_scope.
+  (at level 10, x binder, y binder, P at level 200) : type_scope.
 
 (* Check that printing 'pat uses an "as" when the variable bound to
    the pattern is dependent. We check it for the three kinds of
@@ -346,7 +346,7 @@ Check ∀ '(((x,y),true)|((x,y),false)), x>y.
 Module IfPat2.
 Notation "'if' c 'is' p 'then' u 'else' v" :=
   (match c with p => u | _ => v end)
-  (at level 200, p pattern at level 100).
+  (at level 10, v at level 200, p pattern at level 100).
 Check fun p => if p is S n then n else 0.
 Check fun p => if p is Lt then 1 else 0.
 End IfPat2.
@@ -444,7 +444,7 @@ End GoalConclBox.
 Module PartOfIssue17094.
 
 Notation "'FORALL' 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 "'[  ' '[  ' 'FORALL'  x  ..  y ']' ,  '/' P ']'") : type_scope.
 Notation "[[ x , y ]]" := (x, y).
 Check FORALL [[a , b]], a - b = 0.
@@ -481,7 +481,7 @@ Module PartOfIssue17094Pattern.
 (* The same but referring this time to a pattern *)
 
 Notation "'FORALL' 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 "'[  ' '[  ' 'FORALL'  x  ..  y ']' ,  '/' P ']'") : type_scope.
 Notation "[[ x , y ]]" := (x,y) (x pattern, y pattern).
 Check FORALL [[a , b]], a - b = 0.
@@ -495,7 +495,7 @@ Module PartOfIssue17094Ident.
 Declare Custom Entry quoted_binder'.
 Notation "x" := x (in custom quoted_binder' at level 0, x ident).
 Notation "'FORALL' x .. y , P" := (forall x , .. (forall y , P) .. )
-  (at level 200, x custom quoted_binder' as pattern, right associativity,
+  (at level 10, x custom quoted_binder' as pattern, P at level 200,
    format "'[  ' '[  ' 'FORALL'  x  ..  y ']' ,  '/' P ']'") : type_scope.
 
 (* Note: notation not used for printing because no rule to print "a:nat" and "b:nat" *)
diff --git a/test-suite/output/Notations4.out b/test-suite/output/Notations4.out
index 3cbe2d8cd175..97299b600dce 100644
--- a/test-suite/output/Notations4.out
+++ b/test-suite/output/Notations4.out
@@ -120,7 +120,7 @@ fun x : nat => [x]
      : nat -> nat
 ∀ x : nat, x = x
      : Prop
-File "./output/Notations4.v", line 193, characters 0-160:
+File "./output/Notations4.v", line 193, characters 0-154:
 Warning: Notation "∀ _ .. _ , _" was already defined with a different format
 in scope type_scope. [notation-incompatible-format,parsing,default]
 ∀x : nat,x = x
@@ -284,11 +284,11 @@ where
 ?A : [ |- Type]
 0
      : nat
-File "./output/Notations4.v", line 542, characters 0-78:
+File "./output/Notations4.v", line 542, characters 0-77:
 The command has indeed failed with message:
 Notation "func _ .. _ , _" is already defined at level 10 with arguments
-binder, constr at level below 200 while it is now required to be at level 10
-with arguments constr, constr at level below 200.
+binder, constr at level 200 while it is now required to be at level 10
+with arguments constr, constr at next level.
 File "./output/Notations4.v", line 547, characters 0-57:
 The command has indeed failed with message:
 Notation "[[ _ ]]" is already defined at level 0 with arguments custom foo
diff --git a/test-suite/output/Notations4.v b/test-suite/output/Notations4.v
index f363b1e41057..6a0fcd87fa51 100644
--- a/test-suite/output/Notations4.v
+++ b/test-suite/output/Notations4.v
@@ -185,13 +185,13 @@ End Bug_6082.
 Module Bug_7766.
 
 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,
   format "'[  ' ∀  x  ..  y ']' ,  P") : type_scope.
 
 Check forall (x : nat), x = x.
 
 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,
    format "∀ x .. y , P") : type_scope.
 
 Check forall (x : nat), x = x.
@@ -399,13 +399,13 @@ Module P.
 
   Module NotationBinderNotMixedWithTerms.
 
-  Notation "!! x , P" := (forall x, P) (at level 200, x pattern).
+  Notation "!! x , P" := (forall x, P) (at level 10, x pattern, P at level 200).
   Check !! nat, nat = true.
 
-  Notation "!!! x , P" := (forall x, P) (at level 200).
+  Notation "!!! x , P" := (forall x, P) (at level 10, P at level 200).
   Check !!! nat, nat = true.
 
-  Notation "!!!! x , P" := (forall x, P) (at level 200, x strict pattern).
+  Notation "!!!! x , P" := (forall x, P) (at level 10, P at level 200, x strict pattern).
   Check !!!! (nat,id), nat = true /\ id = false.
 
   End NotationBinderNotMixedWithTerms.
@@ -418,18 +418,18 @@ Module MorePrecise1.
    notation with unlimited iteration *)
 
 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,
   format "'[  ' '[  ' ∀  x  ..  y ']' ,  '/' P ']'") : type_scope.
 
 Check forall x, x = 0.
 
 Notation "∀₁ z , P" := (forall z, P)
-  (at level 200, right associativity) : type_scope.
+  (at level 10, P at level 200) : type_scope.
 
 Check forall x, x = 0.
 
 Notation "∀₂ y x , P" := (forall y x, P)
-  (at level 200, right associativity) : type_scope.
+  (at level 10, P at level 200) : type_scope.
 
 Check forall x, x = 0.
 Check forall x y, x + y = 0.
@@ -450,10 +450,10 @@ Notation "%%% [ y ]" := (forall x : nat, x = y) (at level 0).
 
 (* Check that the two previous notations are indeed finer *)
 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,
   format "'[  ' '[  ' ∀  x  ..  y ']' ,  '/' P ']'").
 Notation "∀' x .. y , P" := (forall y, .. (forall x, P) ..)
-  (at level 200, x binder, y binder, right associativity,
+  (at level 10, x binder, y binder, P at level 200,
   format "'[  ' '[  ' ∀'  x  ..  y ']' ,  '/' P ']'").
 
 Check %% [x == 1].
@@ -478,7 +478,7 @@ Module MorePrecise3.
 Notation "%%%" := (forall x, x) (at level 0).
 
 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,
   format "'[  ' '[  ' ∀  x  ..  y ']' ,  '/' P ']'").
 
 Check %%%.
@@ -538,8 +538,8 @@ End LeadingNumber.
 
 Module Incompatibility.
 
-Notation "'func' x .. y , P" := (fun x => .. (fun y => P) ..) (x binder, y binder, at level 200).
-Fail Notation "'func' x .. y , P" := (pair x .. (pair y P) ..) (at level 200).
+Notation "'func' x .. y , P" := (fun x => .. (fun y => P) ..) (x binder, y binder, at level 10, P at level 200).
+Fail Notation "'func' x .. y , P" := (pair x .. (pair y P) ..) (at level 10).
 
 Declare Custom Entry foo.
 Declare Custom Entry bar.
@@ -551,10 +551,10 @@ End Incompatibility.
 Module RecursivePatternsArgumentsInRecursiveNotations.
 
 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,
   format "'[  ' '[  ' 'λ'  x  ..  y ']' ,  '/' t ']'").
 
-Notation "'lambda' x .. y , t" := (λ x .. y, t) (at level 200, x binder, y binder).
+Notation "'lambda' x .. y , t" := (λ x .. y, t) (at level 10, x binder, y binder, t at level 200).
 
 Check lambda x y, x+y=0.
 
@@ -594,7 +594,7 @@ Unset Printing Matching.
 
 Notation "'uncurryλ' x1 .. xn => body"
   := (fun x => match x with (pair x x1) => .. (match x with (pair x xn) => let 'tt := x in body end) .. end)
-     (at level 200, x1 binder, xn binder, right associativity).
+     (at level 10, x1 binder, xn binder, body at level 200).
 
 Check uncurryλ a b c => a + b + c.
 
@@ -610,7 +610,7 @@ Check uncurryλ '(a,b) => a + b.
 
 Notation "'lets' x1 .. xn := c 'in' body"
   := (let x1 := c in .. (let xn := c in body) ..)
-     (at level 200, x1 binder, xn binder, right associativity).
+     (at level 10, x1 binder, xn binder, body at level 200).
 
 Check lets a b c := 0 in a + b + c.
 
diff --git a/test-suite/output/PrintNotation.out b/test-suite/output/PrintNotation.out
index 6b7fdce553f7..353f4c191900 100644
--- a/test-suite/output/PrintNotation.out
+++ b/test-suite/output/PrintNotation.out
@@ -167,8 +167,7 @@ at level 0, constr, constr, no associativity.
 Notation "{ ' _ : _ & _ & _ }" at level 0 with arguments strict pattern
 at level 0, constr, constr, constr, no associativity.
 Notation "if _ is _ then _ else _" at level 10 with arguments constr, pattern
-at level 100 at level 100, constr, constr at level below 200,
-no associativity.
+at level 100 at level 100, constr, constr at level 200, no associativity.
 Notation "_ -> _" at level 99 with arguments constr at next level, constr
 at level 200, no associativity.
 Notation "_ <-> _" at level 95 with arguments constr at next level, constr
@@ -264,8 +263,7 @@ at level 0, constr, constr, no associativity.
 Notation "{ ' _ : _ & _ & _ }" at level 0 with arguments strict pattern
 at level 0, constr, constr, constr, no associativity.
 Notation "if _ is _ then _ else _" at level 10 with arguments constr, pattern
-at level 100 at level 100, constr, constr at level below 200,
-no associativity.
+at level 100 at level 100, constr, constr at level 200, no associativity.
 Notation "{{ _ }}" in Foo at level 0 with arguments custom Foo,
 no associativity.
 Notation "{{ _ }}" in Foo at level 0 with arguments custom Foo,
@@ -326,9 +324,9 @@ The command has indeed failed with message:
 symbols are surrounded by spaces and that holes are explicitly denoted by
 "_".
 Notation "exists _ .. _ , _" at level 10 with arguments binder, constr
-at level 200, right associativity.
+at level 200, no associativity.
 Notation "exists _ .. _ , _" at level 10 with arguments binder, constr
-at level 200, right associativity.
+at level 200, no associativity.
 File "./output/PrintNotation.v", line 193, characters 2-37:
 The command has indeed failed with message:
 "exists _ , _" cannot be interpreted as a known notation. Make sure that
diff --git a/test-suite/output/PrintNotation.v b/test-suite/output/PrintNotation.v
index 434d9ccf6c92..b36b27e712f6 100644
--- a/test-suite/output/PrintNotation.v
+++ b/test-suite/output/PrintNotation.v
@@ -185,7 +185,7 @@ End SingleQuotes.
 
 Module Recursive.
   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 ']'").
   Fail Print Notation "exists x .. y , p".
   Print Notation "'exists' x .. y , p".
diff --git a/test-suite/output/UnexpectedType.v b/test-suite/output/UnexpectedType.v
index db7fca750d91..a86920687804 100644
--- a/test-suite/output/UnexpectedType.v
+++ b/test-suite/output/UnexpectedType.v
@@ -1,7 +1,7 @@
 
 
 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).
   (* type this in emacs in agda-input method with \lambda *)
 
 Notation "x → y" := (x -> y)
@@ -24,7 +24,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.
   (* type this in emacs in agda-input method with \sum *)
 
 Section Test.
diff --git a/test-suite/output/Utf8Impargs.v b/test-suite/output/Utf8Impargs.v
index cab9f2213e96..d29023719764 100644
--- a/test-suite/output/Utf8Impargs.v
+++ b/test-suite/output/Utf8Impargs.v
@@ -1,5 +1,5 @@
 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,
   format "'[  ' '[  ' ∀  x  ..  y ']' ,  '/' P ']'") : type_scope.
 (* from Utf8_core.v *)
 
diff --git a/test-suite/output/bug_15221.v b/test-suite/output/bug_15221.v
index 3e8cc1cf8252..a44a90546868 100644
--- a/test-suite/output/bug_15221.v
+++ b/test-suite/output/bug_15221.v
@@ -5,7 +5,7 @@ Definition bar{A}(a b: nat)(k: nat -> A): A :=
   k (a - b).
 
 Notation "'let/c' x := r 'in' b" := (r (fun x => b))
-  (x binder, at level 200, right associativity,
+  (x binder, at level 10, b at level 200, right associativity,
    format "'[hv' 'let/c'  x  :=  r  'in'  '//' b ']'").
 
 Definition chain(x y: nat): Prop :=
diff --git a/test-suite/output/bug_9403.v b/test-suite/output/bug_9403.v
index c6d5c51c8554..7921d5d50963 100644
--- a/test-suite/output/bug_9403.v
+++ b/test-suite/output/bug_9403.v
@@ -67,7 +67,7 @@ Notation "t $ r" := (t r)
   (at level 65, right associativity, only parsing).
 Notation "'λ..' x .. y , e" :=
   (tele_app $ tele_bind (fun x => .. (tele_app $ tele_bind (fun y => e)) .. ))
-  (at level 200, x binder, y binder, right associativity,
+  (at level 10, e at level 200, x binder, y binder,
    format "'[  ' 'λ..'  x  ..  y ']' ,  e").
 
 (** Telescopic quantifiers *)
@@ -76,7 +76,7 @@ Definition texist {TT : tele} (Ψ : TT -> Prop) : Prop :=
 Arguments texist {!_} _ /.
 
 Notation "'∃..' x .. y , P" := (texist (fun x => .. (texist (fun y => P)) .. ))
-  (at level 200, x binder, y binder, right associativity,
+  (at level 10, P at level 200, x binder, y binder,
   format "∃..  x  ..  y ,  P").
 End tele.
 Import tele.
diff --git a/test-suite/output/bug_9682.v b/test-suite/output/bug_9682.v
index 4de735351a74..489068e9f877 100644
--- a/test-suite/output/bug_9682.v
+++ b/test-suite/output/bug_9682.v
@@ -6,7 +6,7 @@ Axiom consumer : forall {A} (B : A -> Type) (E:Type) (x : A) (ls : list nat), un
 Notation "|  p1  |  ..  |  pn" := (@cons _ p1 .. (@cons _ pn nil) ..) (at level 91) : blafu.
 Notation "'mmatch_do_not_write' x 'in' T 'as' y 'return' 'M' p 'with_do_not_write' ls" :=
     (@consumer _ (fun y : T => p%type) DoesNotMatch x ls%B)
-      (at level 200, ls at level 91, only parsing).
+      (at level 10, ls at level 91, only parsing).
 Notation "'mmatch' x 'in' T 'as' y 'return' 'M' p 'with' ls 'end'" :=
   (mmatch_do_not_write x in T as y return M p with_do_not_write ls)
     (at level 0, ls at level 91, p at level 10, only parsing).
diff --git a/test-suite/prerequisite/hurkens.v b/test-suite/prerequisite/hurkens.v
index 375fd7313549..4a64cc5d4d38 100644
--- a/test-suite/prerequisite/hurkens.v
+++ b/test-suite/prerequisite/hurkens.v
@@ -96,20 +96,20 @@ Module Generic.
 (* begin hide *)
 (* Notations used in the proof. Hidden in coqdoc. *)
 
-Reserved Notation "'∀₁' x : A , B" (at level 200, x name, A at level 200,right associativity).
+Reserved Notation "'∀₁' x : A , B" (at level 10, x name, A, B at level 200).
 Reserved Notation "A '⟶₁' B" (at level 99, right associativity, B at level 200).
-Reserved Notation "'λ₁' x , u" (at level 200, x name, right associativity).
+Reserved Notation "'λ₁' x , u" (at level 10, x name, u at level 200).
 Reserved Notation "f '·₁' x" (at level 5, left associativity).
-Reserved Notation "'∀₂' A , F" (at level 200, A name, right associativity).
-Reserved Notation "'λ₂' x , u" (at level 200, x name, right associativity).
+Reserved Notation "'∀₂' A , F" (at level 10, A name, F at level 200).
+Reserved Notation "'λ₂' x , u" (at level 10, x name, u at level 200).
 #[warning="-postfix-notation-not-level-1"]
 Reserved Notation "f '·₁' [ A ]" (at level 5, left associativity).
-Reserved Notation "'∀₀' x : A , B" (at level 200, x name, A at level 200,right associativity).
+Reserved Notation "'∀₀' x : A , B" (at level 10, x name, A, B at level 200).
 Reserved Notation "A '⟶₀' B" (at level 99, right associativity, B at level 200).
-Reserved Notation "'λ₀' x , u" (at level 200, x name, right associativity).
+Reserved Notation "'λ₀' x , u" (at level 10, x name, u at level 200).
 Reserved Notation "f '·₀' x" (at level 5, left associativity).
-Reserved Notation "'∀₀¹' A : U , F" (at level 200, A name, right associativity).
-Reserved Notation "'λ₀¹' x , u" (at level 200, x name, right associativity).
+Reserved Notation "'∀₀¹' A : U , F" (at level 10, A name, F at level 200).
+Reserved Notation "'λ₀¹' x , u" (at level 10, x name, u at level 200).
 #[warning="-postfix-notation-not-level-1"]
 Reserved Notation "f '·₀' [ A ]" (at level 5, left associativity).
 
diff --git a/test-suite/ssr/rew_polyuniv.v b/test-suite/ssr/rew_polyuniv.v
index d01c632bf2cb..f498cc2175b6 100644
--- a/test-suite/ssr/rew_polyuniv.v
+++ b/test-suite/ssr/rew_polyuniv.v
@@ -76,7 +76,7 @@ Qed.
    notations involving telescopes. *)
 Notation "'λ..' x .. y , e" :=
   (tele_app (tele_bind (fun x => .. (tele_app (tele_bind (fun y => e))) .. )))
-  (at level 200, x binder, y binder, right associativity,
+  (at level 10, x binder, y binder, e at level 200,
    format "'[  ' 'λ..'  x  ..  y ']' ,  e").
 
 (* The testcase *)
diff --git a/test-suite/success/BidirectionalityHints.v b/test-suite/success/BidirectionalityHints.v
index 36767ba3abb1..b657e29ed0a0 100644
--- a/test-suite/success/BidirectionalityHints.v
+++ b/test-suite/success/BidirectionalityHints.v
@@ -86,10 +86,10 @@ Definition texist {TT : tele} (Ψ : TT -> Prop) : Prop :=
 Arguments texist {!_} _ /.
 
 Notation "'∀..' x .. y , P" := (tforall (fun x => .. (tforall (fun y => P)) .. ))
-  (at level 200, x binder, y binder, right associativity,
+  (at level 10, x binder, y binder, P at level 200,
   format "∀..  x  ..  y ,  P").
 Notation "'∃..' x .. y , P" := (texist (fun x => .. (texist (fun y => P)) .. ))
-  (at level 200, x binder, y binder, right associativity,
+  (at level 10, x binder, y binder, P at level 200,
   format "∃..  x  ..  y ,  P").
 
 (** The actual test case *)
diff --git a/test-suite/success/CaseInClause.v b/test-suite/success/CaseInClause.v
index 64f45b2335b6..2d30bf405557 100644
--- a/test-suite/success/CaseInClause.v
+++ b/test-suite/success/CaseInClause.v
@@ -6,7 +6,7 @@ Check (fun n (x: Vector.t True (S n)) =>
   end).
 
 (* Notation *)
-Notation "A \dots n" := (Vector.t A n) (at level 200).
+Notation "A \dots n" := (Vector.t A n) (at level 10).
 Check (fun m (x: Vector.t nat m) =>
   match x in _ \dots k return Vector.t nat (S k) with
     | Vector.nil _ => Vector.cons _ 0 _ (Vector.nil _)
diff --git a/test-suite/success/Notations.v b/test-suite/success/Notations.v
index 000a9c9a7f36..4672d28bcdef 100644
--- a/test-suite/success/Notations.v
+++ b/test-suite/success/Notations.v
@@ -42,14 +42,15 @@ Check ($ 5).
 (* Check regression of bug #2087 *)
 
 Notation "'exists' x , P" := (x, P)
-   (at level 200, x ident, right associativity,	only parsing).
+   (at level 10, x ident, P at level 200, only parsing).
 
 Definition foo P := let '(exists x, Q) := P in x = Q :> nat.
 
 (* Check empty levels when extending binder_constr *)
+(* XXX this may be nonsense now that binder_constr doesn't exist *)
 
 Notation "'exists' x >= y , P" := (exists x, x >= y /\ P)%nat
-   (at level 200, x ident, right associativity, y at level 69).
+   (at level 10, x ident, P at level 200, y at level 69).
 
 (* This used to loop at some time before r12491 *)
 
@@ -93,7 +94,7 @@ Abort.
    used in cases pattern (bug #2724 in 8.3 and 8.4beta) *)
 
 Notation "'FORALL'  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.
 
 Fail Check fun x => match x with S (FORALL x, _) => 0 end.
 
diff --git a/test-suite/success/Notations2.v b/test-suite/success/Notations2.v
index 3207346181e9..6f3dadd8659a 100644
--- a/test-suite/success/Notations2.v
+++ b/test-suite/success/Notations2.v
@@ -93,8 +93,8 @@ Check fun A (x :prod' bool A) => match x with ##### 0 y 0 => 2 | _ => 1 end.
 
 (* 10. Check computation of binding variable through other notations *)
 (* it should be detected as binding variable and the scopes not being checked *)
-Notation "'FUNNAT' i => t" := (fun i : nat => i = t) (at level 200).
-Notation "'Funnat' i => t" := (FUNNAT i => t + i%nat) (at level 200).
+Notation "'FUNNAT' i => t" := (fun i : nat => i = t) (at level 10, t at level 200).
+Notation "'Funnat' i => t" := (FUNNAT i => t + i%nat) (at level 10, t at level 200).
 
 (* 11. Notations with needed factorization of a recursive pattern *)
 (* See https://github.com/rocq-prover/rocq/issues/6078#issuecomment-342287412 *)
@@ -123,7 +123,7 @@ End M13.
 (* 14. Check that a notation with a "ident" binder does not include a pattern *)
 Module M14.
 Notation "'myexists' x , p" := (ex (fun x => p))
-  (at level 200, x ident, p at level 200, right associativity) : type_scope.
+  (at level 10, x ident, p at level 200) : type_scope.
 Check myexists I, I = 0. (* Should not be seen as a constructor *)
 End M14.
 
diff --git a/theories/Corelib/Init/Logic.v b/theories/Corelib/Init/Logic.v
index d89b2e54c8fb..ff3f97dc9a18 100644
--- a/theories/Corelib/Init/Logic.v
+++ b/theories/Corelib/Init/Logic.v
@@ -328,21 +328,21 @@ Register all as core.all.
 (* Rule order is important to give printing priority to fully typed exists *)
 
 Notation "'exists' x .. y , p" := (ex (fun x => .. (ex (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.
 
 Notation "'exists2' x , p & q" := (ex2 (fun x => p) (fun x => q))
-  (at level 200, x name, p at level 200, right associativity) : type_scope.
+  (at level 10, x name, p at level 200, q at level 200) : type_scope.
 Notation "'exists2' x : A , p & q" := (ex2 (A:=A) (fun x => p) (fun x => q))
-  (at level 200, x name, A at level 200, p at level 200, right associativity,
+  (at level 10, x name, A at level 200, p at level 200, q at level 200,
     format "'[' 'exists2'  '/  ' x  :  A ,  '/  ' '[' p  &  '/' q ']' ']'")
   : type_scope.
 
 Notation "'exists2' ' x , p & q" := (ex2 (fun x => p) (fun x => q))
-  (at level 200, x strict pattern, p at level 200, right associativity) : type_scope.
+  (at level 10, x strict pattern, p at level 200, q at level 200) : type_scope.
 Notation "'exists2' ' x : A , p & q" := (ex2 (A:=A) (fun x => p) (fun x => q))
-  (at level 200, x strict pattern, A at level 200, p at level 200, right associativity,
+  (at level 10, x strict pattern, A at level 200, p at level 200, q at level 200,
     format "'[' 'exists2'  '/  ' ' x  :  A ,  '/  ' '[' p  &  '/' q ']' ']'")
   : type_scope.
 
@@ -787,7 +787,7 @@ Definition uniqueness (A:Type) (P:A->Prop) := forall x y, P x -> P y -> x = y.
 
 Notation "'exists' ! x .. y , p" :=
   (ex (unique (fun x => .. (ex (unique (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.
 
diff --git a/theories/Corelib/Init/Notations.v b/theories/Corelib/Init/Notations.v
index b97e86a166d5..39e5157a4ae8 100644
--- a/theories/Corelib/Init/Notations.v
+++ b/theories/Corelib/Init/Notations.v
@@ -112,7 +112,7 @@ Module IfNotations.
 
 Notation "'if' c 'is' p 'then' u 'else' v" :=
   (match c with p => u | _ => v end)
-  (at level 200, p pattern at level 100).
+  (at level 10, v at level 200, p pattern at level 100).
 
 End IfNotations.
 
diff --git a/theories/Corelib/ssr/ssrbool.v b/theories/Corelib/ssr/ssrbool.v
index a3275d7dcefc..514a9b427541 100644
--- a/theories/Corelib/ssr/ssrbool.v
+++ b/theories/Corelib/ssr/ssrbool.v
@@ -388,7 +388,7 @@ Reserved Notation "[ 'predC' A ]" (at level 0,
 Reserved Notation "[ 'preim' f 'of' A ]" (at level 0,
   format "[ 'preim'  f  'of'  A ]").
 
-Reserved Notation "\unless C , P" (at level 200, C at level 100,
+Reserved Notation "\unless C , P" (at level 10, C at level 100, P at level 200,
   format "'[hv' \unless  C , '/ '  P ']'").
 
 Reserved Notation "{ 'for' x , P }" (at level 0,
diff --git a/theories/Corelib/ssr/ssreflect.v b/theories/Corelib/ssr/ssreflect.v
index ee59e60a7753..0b36894e488d 100644
--- a/theories/Corelib/ssr/ssreflect.v
+++ b/theories/Corelib/ssr/ssreflect.v
@@ -105,11 +105,11 @@ 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,
+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,
diff --git a/theories/Corelib/ssr/ssrfun.v b/theories/Corelib/ssr/ssrfun.v
index 2a1809c8718d..e5e5d1376680 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 ] ']'").

From a4b00c81f2729ec85f18d73d21fcf9477c280987 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Thu, 26 Feb 2026 15:36:28 +0100
Subject: [PATCH 305/578] Enable binder_constr hack warning

---
 vernac/metasyntax.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/vernac/metasyntax.ml b/vernac/metasyntax.ml
index 4d7c53c50511..0edc11a29957 100644
--- a/vernac/metasyntax.ml
+++ b/vernac/metasyntax.ml
@@ -1956,7 +1956,7 @@ let make_notation_interpretation ~local main_data notation_symbols ntn syntax_ru
 
 (* close #21670 once this hack is removed *)
 let warn_at_level_200 =
-  CWarnings.create ~name:"at-level-200-changed" ~category:Deprecation.Version.v9_3 ~default:Disabled
+  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() ++

From ccd4fc13529f514999a24f2ad3eb42935a980cd5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Fri, 27 Feb 2026 14:48:03 +0100
Subject: [PATCH 306/578] add backwards compat test

---
 test-suite/bugs/bug_21671_1.v | 22 ++++++++++++++++++++++
 1 file changed, 22 insertions(+)
 create mode 100644 test-suite/bugs/bug_21671_1.v

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.

From ec072003fa9e59d0e45ed38b9f229d5b8a2c3fa5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Tue, 24 Mar 2026 14:50:57 +0100
Subject: [PATCH 307/578] Add test from fcl

---
 test-suite/bugs/bug_21671_2.v | 7 +++++++
 1 file changed, 7 insertions(+)
 create mode 100644 test-suite/bugs/bug_21671_2.v

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 *)

From 3c9704ebdf1e00b315ca17fbc98d158514c30d6f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Thu, 26 Feb 2026 15:55:17 +0100
Subject: [PATCH 308/578] changelog

---
 .../21671-binder-constr-Changed.rst           | 34 +++++++++++++++++++
 1 file changed, 34 insertions(+)
 create mode 100644 doc/changelog/03-notations/21671-binder-constr-Changed.rst

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
+  <https://github.com/rocq-prover/rocq/pull/21671>`_, by Gaëtan
+  Gilbert).

From b22fa27814c9f4ba4215b9c74c4e5629583fe5b0 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Thu, 26 Mar 2026 23:15:37 +0100
Subject: [PATCH 309/578] git_download ls-remote use --branches

git ls-remote https://github.com/CertiRocq/certirocq refs/heads/master
gives 2 results:
~~~
a8267f799d826bd411ad3382574f17253704716e        refs/heads/master
59920824db8ba2f0cfdff7e934473873136f1f39        refs/original/refs/heads/master
~~~
filtering to only branches seems to work enough to prevent over matching.
---
 dev/ci/scripts/ci-common.sh | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

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"

From 03577cc666cee4ae06d4d3d541ea2b855b02122f Mon Sep 17 00:00:00 2001
From: nicolas tabareau <nicolas.tabareau@gmail.com>
Date: Fri, 27 Mar 2026 09:43:42 +0100
Subject: [PATCH 310/578] update changes.rst

---
 .../01-kernel/21684-master-Fixed.rst          |  7 -------
 .../04-tactics/21803-fix-7672-Fixed.rst       |  7 -------
 .../11-corelib/21744-arrayaxioms-Fixed.rst    |  5 -----
 doc/sphinx/changes.rst                        | 19 +++++++++++++++++++
 4 files changed, 19 insertions(+), 19 deletions(-)
 delete mode 100644 doc/changelog/01-kernel/21684-master-Fixed.rst
 delete mode 100644 doc/changelog/04-tactics/21803-fix-7672-Fixed.rst
 delete mode 100644 doc/changelog/11-corelib/21744-arrayaxioms-Fixed.rst

diff --git a/doc/changelog/01-kernel/21684-master-Fixed.rst b/doc/changelog/01-kernel/21684-master-Fixed.rst
deleted file mode 100644
index 75c838eab031..000000000000
--- a/doc/changelog/01-kernel/21684-master-Fixed.rst
+++ /dev/null
@@ -1,7 +0,0 @@
-- **Fixed:**
-  Fix the detection and treatment of uniform arguments of nested fixpoints
-  (`#21684 <https://github.com/rocq-prover/rocq/pull/21684>`_,
-  fixes `#21682 <https://github.com/rocq-prover/rocq/issues/21682>`_
-  and `#21683 <https://github.com/rocq-prover/rocq/issues/21683>`_
-  and `#21701 <https://github.com/rocq-prover/rocq/issues/21701>`_,
-  by Yann Leray).
diff --git a/doc/changelog/04-tactics/21803-fix-7672-Fixed.rst b/doc/changelog/04-tactics/21803-fix-7672-Fixed.rst
deleted file mode 100644
index 7e3fd58c75d6..000000000000
--- a/doc/changelog/04-tactics/21803-fix-7672-Fixed.rst
+++ /dev/null
@@ -1,7 +0,0 @@
-- **Fixed:**
-  :n:`autorewrite*` was failing if any of the possible rewritings
-  failed to solve its generated side-conditions
-  (`#21803 <https://github.com/rocq-prover/rocq/pull/21803>`_,
-  fixes `#7672 <https://github.com/rocq-prover/rocq/issues/7672>`_
-  and `#4976 <https://github.com/rocq-prover/rocq/issues/4976>`_,
-  by Matthieu Sozeau).
diff --git a/doc/changelog/11-corelib/21744-arrayaxioms-Fixed.rst b/doc/changelog/11-corelib/21744-arrayaxioms-Fixed.rst
deleted file mode 100644
index d985a6abcc1d..000000000000
--- a/doc/changelog/11-corelib/21744-arrayaxioms-Fixed.rst
+++ /dev/null
@@ -1,5 +0,0 @@
-- **Fixed:**
-  primitive array axioms (in `ArrayAxioms`) are universe polymorphic
-  (they were inadvertently turned monomorphic in the stdlib split)
-  (`#21744 <https://github.com/rocq-prover/rocq/pull/21744>`_,
-  by Gaëtan Gilbert).
diff --git a/doc/sphinx/changes.rst b/doc/sphinx/changes.rst
index 6450a6b721e3..065b455998b3 100644
--- a/doc/sphinx/changes.rst
+++ b/doc/sphinx/changes.rst
@@ -148,6 +148,13 @@ Kernel
   the ability to define monomorphic sorts within sections
   (`#21451 <https://github.com/rocq-prover/rocq/pull/21451>`_,
   by Pierre-Marie Pédrot).
+- **Fixed:**
+  Fix the detection and treatment of uniform arguments of nested fixpoints
+  (`#21684 <https://github.com/rocq-prover/rocq/pull/21684>`_,
+  fixes `#21682 <https://github.com/rocq-prover/rocq/issues/21682>`_
+  and `#21683 <https://github.com/rocq-prover/rocq/issues/21683>`_
+  and `#21701 <https://github.com/rocq-prover/rocq/issues/21701>`_,
+  by Yann Leray).
 
 Specification language, type inference
 ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
@@ -296,6 +303,13 @@ Tactics
   :tacn:`destruct` and :tacn:`eapply` by using the :flag:`Generate Goal Names` flag
   (`#20809 <https://github.com/rocq-prover/rocq/pull/20809>`_,
   by Dario Halilovic).
+- **Fixed:**
+  :n:`autorewrite*` was failing if any of the possible rewritings
+  failed to solve its generated side-conditions
+  (`#21803 <https://github.com/rocq-prover/rocq/pull/21803>`_,
+  fixes `#7672 <https://github.com/rocq-prover/rocq/issues/7672>`_
+  and `#4976 <https://github.com/rocq-prover/rocq/issues/4976>`_,
+  by Matthieu Sozeau).
 
 Ltac2 language
 ^^^^^^^^^^^^^^
@@ -590,6 +604,11 @@ Corelib
   a slightly more general variant of Fix_eq which is sometimes more convenient
   (`#20018 <https://github.com/rocq-prover/rocq/pull/20018>`_,
   by Owen Conoly).
+- **Fixed:**
+  primitive array axioms (in `ArrayAxioms`) are universe polymorphic
+  (they were inadvertently turned monomorphic in the stdlib split)
+  (`#21744 <https://github.com/rocq-prover/rocq/pull/21744>`_,
+  by Gaëtan Gilbert).
 
 Infrastructure and dependencies
 ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

From 2df15a2c6e77d4afab8bf4d8387b7294db3d6d01 Mon Sep 17 00:00:00 2001
From: Pierre Roux <pierre.roux@onera.fr>
Date: Tue, 17 Mar 2026 08:19:32 +0100
Subject: [PATCH 311/578] Update comment

---
 lib/deprecation.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/lib/deprecation.ml b/lib/deprecation.ml
index 41ed5fd5cf78..ad1c81abc2b7 100644
--- a/lib/deprecation.ml
+++ b/lib/deprecation.ml
@@ -102,6 +102,6 @@ module Version = struct
   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

From 32259453768fa542fa40286996a4c741fc4da4ff Mon Sep 17 00:00:00 2001
From: Pierre Roux <pierre.roux@onera.fr>
Date: Wed, 7 Jan 2026 10:28:42 +0100
Subject: [PATCH 312/578] [ssreflect] Cleanup old vim vars

---
 plugins/ssr/ssrparser.mlg | 2 --
 plugins/ssr/ssrtacs.mlg   | 2 --
 plugins/ssr/ssrvernac.mlg | 2 --
 3 files changed, 6 deletions(-)

diff --git a/plugins/ssr/ssrparser.mlg b/plugins/ssr/ssrparser.mlg
index 57ccbf298144..7578b83eb112 100644
--- a/plugins/ssr/ssrparser.mlg
+++ b/plugins/ssr/ssrparser.mlg
@@ -1752,5 +1752,3 @@ module Internal = struct
 end
 
 }
-
-(* vim: set filetype=ocaml foldmethod=marker: *)
diff --git a/plugins/ssr/ssrtacs.mlg b/plugins/ssr/ssrtacs.mlg
index eb63b42f655b..ef00626ee8f0 100644
--- a/plugins/ssr/ssrtacs.mlg
+++ b/plugins/ssr/ssrtacs.mlg
@@ -1050,5 +1050,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/ssrvernac.mlg b/plugins/ssr/ssrvernac.mlg
index d7995bd31af5..b3d1f80a7f2e 100644
--- a/plugins/ssr/ssrvernac.mlg
+++ b/plugins/ssr/ssrvernac.mlg
@@ -345,5 +345,3 @@ GRAMMAR EXTEND Gram
     [ IDENT "type"; "of"; c = Constr.constr -> { Tacexpr.ConstrTypeOf c }]
   ];
 END
-
-(* vim: set filetype=ocaml foldmethod=marker: *)

From 8a048a15b837b51e770245187a1ea5e5e24cfa66 Mon Sep 17 00:00:00 2001
From: Pierre Roux <pierre.roux@onera.fr>
Date: Thu, 19 Mar 2026 09:43:15 +0100
Subject: [PATCH 313/578] [ssreflect] Cleanup old compat code

---
 plugins/ssr/ssrvernac.mlg | 55 ---------------------------------------
 1 file changed, 55 deletions(-)

diff --git a/plugins/ssr/ssrvernac.mlg b/plugins/ssr/ssrvernac.mlg
index b3d1f80a7f2e..128dc66c199d 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_
@@ -291,57 +290,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

From db2107cbb5d586999fbd323465c148dfd5f1d742 Mon Sep 17 00:00:00 2001
From: Pierre Roux <pierre.roux@onera.fr>
Date: Thu, 19 Mar 2026 10:13:30 +0100
Subject: [PATCH 314/578] [ssreflect] Update outdated comment

---
 plugins/ssr/ssrparser.mlg | 9 +++------
 1 file changed, 3 insertions(+), 6 deletions(-)

diff --git a/plugins/ssr/ssrparser.mlg b/plugins/ssr/ssrparser.mlg
index 7578b83eb112..a23cfbe34fee 100644
--- a/plugins/ssr/ssrparser.mlg
+++ b/plugins/ssr/ssrparser.mlg
@@ -43,14 +43,11 @@ open Libobject
 
 (** Ssreflect load check. *)
 
-(* To allow ssrcoq to be fully compatible with the "plain" Rocq, we only *)
+(* 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.                        *)
+(* has actually been imported. This is done thanks to the "SSR Loaded"  *)
+(* option.                                                              *)
 
 let is_ssr_loaded = Pptactic.ssr_loaded
 

From 139adb2321bf9f07be8c409b57bd7cbf60688b23 Mon Sep 17 00:00:00 2001
From: Pierre Roux <pierre.roux@onera.fr>
Date: Thu, 19 Mar 2026 09:39:23 +0100
Subject: [PATCH 315/578] =?UTF-8?q?[ssreflect]=20Use=20=E2=80=97=20instead?=
 =?UTF-8?q?=20of=20=5F=20for=20reserved=20identifiers?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Using double-low-line rather than underscore, i.e., `‗foo‗` instead of
`_foo_`, will cause less conflicts and is not an issue since, by
definition, we never type these identifiers by hand.
---
 clib/unicode.ml                               |  1 +
 .../proof-engine/ssreflect-proof-language.rst | 13 ------
 plugins/ssr/ssrcommon.ml                      | 45 ++++++++++---------
 plugins/ssr/ssrcommon.mli                     |  3 ++
 plugins/ssr/ssrparser.mlg                     | 36 +++++----------
 5 files changed, 41 insertions(+), 57 deletions(-)

diff --git a/clib/unicode.ml b/clib/unicode.ml
index 266059bd5e7a..6465e399de2d 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
diff --git a/doc/sphinx/proof-engine/ssreflect-proof-language.rst b/doc/sphinx/proof-engine/ssreflect-proof-language.rst
index f947b7a21f29..084877a27cf3 100644
--- a/doc/sphinx/proof-engine/ssreflect-proof-language.rst
+++ b/doc/sphinx/proof-engine/ssreflect-proof-language.rst
@@ -121,8 +121,6 @@ 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.
-+ 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`
@@ -165,17 +163,6 @@ compatible with the rest of Rocq, up to a few discrepancies.
    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
 --------------------
 
diff --git a/plugins/ssr/ssrcommon.ml b/plugins/ssr/ssrcommon.ml
index b8f390ca7e57..bfbad25e5cc8 100644
--- a/plugins/ssr/ssrcommon.ml
+++ b/plugins/ssr/ssrcommon.ml
@@ -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)))
 
@@ -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)
diff --git a/plugins/ssr/ssrcommon.mli b/plugins/ssr/ssrcommon.mli
index eb0de8cda3d8..309fd844cd7f 100644
--- a/plugins/ssr/ssrcommon.mli
+++ b/plugins/ssr/ssrcommon.mli
@@ -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
diff --git a/plugins/ssr/ssrparser.mlg b/plugins/ssr/ssrparser.mlg
index a23cfbe34fee..d414a5faa150 100644
--- a/plugins/ssr/ssrparser.mlg
+++ b/plugins/ssr/ssrparser.mlg
@@ -44,10 +44,9 @@ 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 imported. This is done thanks to the "SSR Loaded"  *)
-(* option.                                                              *)
+(* turn on its incompatible features (the new rewrite syntax) when the  *)
+(* theory library (ssreflect.v) has actually been imported.             *)
+(* This is done thanks to the "SSR Loaded" option.                      *)
 
 let is_ssr_loaded = Pptactic.ssr_loaded
 
@@ -1623,31 +1622,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 () })
 
@@ -1660,7 +1648,7 @@ END
 
 {
 
-let perm_tag = "_perm_Hyp_"
+let perm_tag = "‗perm_Hyp_"
 let _ = add_internal_name (is_tagged perm_tag)
 
 }

From 3d594176ef918d8bfbc48ad870448ba17adeeb8a Mon Sep 17 00:00:00 2001
From: Pierre Roux <pierre.roux@onera.fr>
Date: Thu, 19 Mar 2026 10:25:58 +0100
Subject: [PATCH 316/578] [ssreflect] Rename SSR Loaded to SSRRewriteLoaded

---
 plugins/ltac/pptactic.ml         | 6 +++---
 plugins/ltac/pptactic.mli        | 2 +-
 plugins/ssr/ssrparser.mlg        | 6 +++---
 plugins/ssr/ssrparser.mli        | 2 +-
 plugins/ssr/ssrtacs.mlg          | 2 +-
 theories/Corelib/ssr/ssreflect.v | 4 ++--
 6 files changed, 11 insertions(+), 11 deletions(-)

diff --git a/plugins/ltac/pptactic.ml b/plugins/ltac/pptactic.ml
index 46a68fa762e7..b3575c44833c 100644
--- a/plugins/ltac/pptactic.ml
+++ b/plugins/ltac/pptactic.ml
@@ -500,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 ()
diff --git a/plugins/ltac/pptactic.mli b/plugins/ltac/pptactic.mli
index 0f7602d255bb..5dfe18498fb7 100644
--- a/plugins/ltac/pptactic.mli
+++ b/plugins/ltac/pptactic.mli
@@ -164,7 +164,7 @@ 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
diff --git a/plugins/ssr/ssrparser.mlg b/plugins/ssr/ssrparser.mlg
index d414a5faa150..4cf14fa7fd5d 100644
--- a/plugins/ssr/ssrparser.mlg
+++ b/plugins/ssr/ssrparser.mlg
@@ -46,9 +46,9 @@ open Libobject
 (* To allow ssrcoq to be fully compatible with the "plain" Rocq, we only*)
 (* turn on its incompatible features (the new rewrite syntax) when the  *)
 (* theory library (ssreflect.v) has actually been imported.             *)
-(* This is done thanks to the "SSR Loaded" option.                      *)
+(* This is done thanks to the "SSRRewriteLoaded" option.                *)
 
-let is_ssr_loaded = Pptactic.ssr_loaded
+let is_ssr_rewrite_loaded = Pptactic.ssr_rewrite_loaded
 
 }
 
@@ -1725,7 +1725,7 @@ 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 is_ssr_rewrite_loaded = is_ssr_rewrite_loaded
   let pr_hpats = pr_hpats
   let pr_fwd = pr_fwd
   let pr_hint = pr_hint
diff --git a/plugins/ssr/ssrparser.mli b/plugins/ssr/ssrparser.mli
index a1d177156e4a..6ae33a82c73d 100644
--- a/plugins/ssr/ssrparser.mli
+++ b/plugins/ssr/ssrparser.mli
@@ -188,7 +188,7 @@ module Internal : sig
 
   val pr_mult : ssrmult -> Pp.t
 
-  val is_ssr_loaded : unit -> bool
+  val is_ssr_rewrite_loaded : unit -> bool
 
   val pr_hpats : ssrhpats -> Pp.t
 
diff --git a/plugins/ssr/ssrtacs.mlg b/plugins/ssr/ssrtacs.mlg
index ef00626ee8f0..5f7e899f857d 100644
--- a/plugins/ssr/ssrtacs.mlg
+++ b/plugins/ssr/ssrtacs.mlg
@@ -758,7 +758,7 @@ let lbrace = Char.chr 123
 let test_ssr_rw_syntax =
   let test kwstate strm =
     if not !ssr_rw_syntax then Error () else
-    if is_ssr_loaded () then Ok () else
+    if is_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
diff --git a/theories/Corelib/ssr/ssreflect.v b/theories/Corelib/ssr/ssreflect.v
index 0b36894e488d..4770682bd3e1 100644
--- a/theories/Corelib/ssr/ssreflect.v
+++ b/theories/Corelib/ssr/ssreflect.v
@@ -86,8 +86,8 @@ Module SsrSyntax.
 
 Reserved Notation "(* x 'is' y 'of' z 'isn't' // /= //= *)".
 
-(** Enable SSR features **)
-#[export] Set SSR Loaded.
+(** Enable SSR rewrite compat **)
+#[export] Set SSRRewriteLoaded.
 
 Reserved Notation "<hidden n >" (at level 0, n at level 0,
   format "<hidden  n >").

From 3d24d7ada30c608bc0626c3d592e312502eda49f Mon Sep 17 00:00:00 2001
From: Pierre Roux <pierre.roux@onera.fr>
Date: Fri, 20 Mar 2026 08:07:58 +0100
Subject: [PATCH 317/578] [ssreflect] Use tactic name 'rw' instead of 'rewrite'

Since this was the major cause of conflict with legacy tactics,
ssreflect can now be loaded in the Prelude. For backward
compatibility

From Corelib Require Import ssreflect.

still loads a 'rewrite' wrapper to 'rw'. This compatibility layer
also includes the `if _ is _ then _ else _`
and the `if _ isn't _ then _ else _` notations.
---
 doc/Makefile.docgram                 |   2 +-
 doc/corelib/index-list.html.template |   1 +
 plugins/ssr/ssrparser.mlg            |  12 +-
 plugins/ssr/ssrparser.mli            |   2 -
 plugins/ssr/ssrtacs.mlg              |  34 +-
 plugins/ssr/ssrtacs.mli              |   2 +
 plugins/ssr/ssrvernac.mlg            |  22 +-
 plugins/ssrrewrite/dune              |  11 +
 plugins/ssrrewrite/ssrrewrite.mlg    | 130 ++++++
 plugins/ssrrewrite/ssrrewrite.mli    |   0
 test-suite/bugs/bug_4966.v           |   2 +-
 theories/Corelib/ssr/ssreflect.v     | 643 +--------------------------
 theories/Corelib/ssr/ssreflect_rw.v  | 643 +++++++++++++++++++++++++++
 13 files changed, 812 insertions(+), 692 deletions(-)
 create mode 100644 plugins/ssrrewrite/dune
 create mode 100644 plugins/ssrrewrite/ssrrewrite.mlg
 create mode 100644 plugins/ssrrewrite/ssrrewrite.mli
 create mode 100644 theories/Corelib/ssr/ssreflect_rw.v

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/corelib/index-list.html.template b/doc/corelib/index-list.html.template
index 6923703a666c..43b5d3498687 100644
--- a/doc/corelib/index-list.html.template
+++ b/doc/corelib/index-list.html.template
@@ -113,6 +113,7 @@ through the <tt>Require Import</tt> command.</p>
   <dd>
     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
diff --git a/plugins/ssr/ssrparser.mlg b/plugins/ssr/ssrparser.mlg
index 4cf14fa7fd5d..3ab565e3dd48 100644
--- a/plugins/ssr/ssrparser.mlg
+++ b/plugins/ssr/ssrparser.mlg
@@ -41,15 +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) when the  *)
-(* theory library (ssreflect.v) has actually been imported.             *)
-(* This is done thanks to the "SSRRewriteLoaded" option.                *)
-
-let is_ssr_rewrite_loaded = Pptactic.ssr_rewrite_loaded
-
 }
 
 DECLARE PLUGIN "rocq-runtime.plugins.ssreflect"
@@ -1579,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 =
@@ -1725,7 +1716,6 @@ module Internal = struct
   let pr_intros = pr_intros
   let pr_view = pr_view
   let pr_mult = pr_mult
-  let is_ssr_rewrite_loaded = is_ssr_rewrite_loaded
   let pr_hpats = pr_hpats
   let pr_fwd = pr_fwd
   let pr_hint = pr_hint
diff --git a/plugins/ssr/ssrparser.mli b/plugins/ssr/ssrparser.mli
index 6ae33a82c73d..04d1096784b5 100644
--- a/plugins/ssr/ssrparser.mli
+++ b/plugins/ssr/ssrparser.mli
@@ -188,8 +188,6 @@ module Internal : sig
 
   val pr_mult : ssrmult -> Pp.t
 
-  val is_ssr_rewrite_loaded : unit -> bool
-
   val pr_hpats : ssrhpats -> Pp.t
 
   val pr_fwd : (Ssrast.ssrfwdkind * Ssrast.ssrbindfmt list) * Ssrast.ast_closure_term -> Pp.t
diff --git a/plugins/ssr/ssrtacs.mlg b/plugins/ssr/ssrtacs.mlg
index 5f7e899f857d..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_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_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
 
diff --git a/plugins/ssr/ssrtacs.mli b/plugins/ssr/ssrtacs.mli
index 4069c40ae277..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
diff --git a/plugins/ssr/ssrvernac.mlg b/plugins/ssr/ssrvernac.mlg
index 128dc66c199d..ccd46159c1d5 100644
--- a/plugins/ssr/ssrvernac.mlg
+++ b/plugins/ssr/ssrvernac.mlg
@@ -46,8 +46,6 @@ IGNORE KEYWORDS
 (** Alternative notations for "match" and anonymous arguments. *)(* ************)
 
 (* Syntax:                                                        *)
-(*  if <term> is <pattern> then ... else ...                      *)
-(*  if <term> is <pattern> [in ..] return ... then ... else ...   *)
 (*  let: <pattern> := <term> in ...                               *)
 (*  let: <pattern> [in ...] := <term> return ... in ...           *)
 (* The scope of a top-level 'as' in the pattern extends over the  *)
@@ -75,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)
@@ -86,25 +83,8 @@ 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]) }
-    | "let"; ":"; mp = ssr_mpat; ":="; c = lconstr; "in"; c1 = lconstr ->
+    [ "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 ->
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..c6d7feb5423a
--- /dev/null
+++ b/plugins/ssrrewrite/ssrrewrite.mlg
@@ -0,0 +1,130 @@
+(************************************************************************)
+(*         *      The Rocq Prover / The Rocq Development Team           *)
+(*  v      *         Copyright INRIA, CNRS and contributors             *)
+(* <O___,, * (see version control and CREDITS file for authors & dates) *)
+(*   \VV/  **************************************************************)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+{
+
+open Constrexpr
+open Procq.Constr
+open Ltac_plugin
+open Ssreflect_plugin.Ssrtacticals
+open Ssreflect_plugin.Ssrequality
+open Ssreflect_plugin.Ssrparser
+open Ssreflect_plugin.Ssrtacs
+
+}
+
+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
+  | [ "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 <term> is <pattern> then ... else ...                      *)
+(*  if <term> is <pattern> [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/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/theories/Corelib/ssr/ssreflect.v b/theories/Corelib/ssr/ssreflect.v
index 4770682bd3e1..284e34b14631 100644
--- a/theories/Corelib/ssr/ssreflect.v
+++ b/theories/Corelib/ssr/ssreflect.v
@@ -8,103 +8,29 @@
 (*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
-(* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *)
+Require Export ssreflect_rw.
+Declare ML Module "rocq-runtime.plugins.ssreflect_rewrite".
 
-(** #<style> .doc { font-family: monospace; white-space: pre; } </style># **)
+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.                           **)
+End SsrIsSyntax.
 
-Set Implicit Arguments.
-Unset Strict Implicit.
-Unset Printing Implicit Defensive.
+Export SsrIsSyntax.
 
-Module SsrSyntax.
-
-(** Declare Ssr keywords: "is" "isn't" "of" "//" "/=" and "//=". **)
-
-Reserved Notation "(* x 'is' y 'of' z 'isn't' // /= //= *)".
-
-(** Enable SSR rewrite compat **)
+(** Signal that we have ssreflect version of rewrite (meaning
+ "rewrite a" must be printed "rewrite -> a" for compatibility). **)
 #[export] Set SSRRewriteLoaded.
 
-Reserved Notation "<hidden n >" (at level 0, n at level 0,
-  format "<hidden  n >").
-#[warning="-postfix-notation-not-level-1"]
-Reserved Notation "T (* n *)" (at level 200, format "T  (* n *)").
-
-End SsrSyntax.
-
-Export SsrMatchingSyntax.
-Export SsrSyntax.
-
 (** 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. **)
+(** 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 10,
@@ -112,28 +38,6 @@ Reserved Notation "'if' c 'return' R 'then' vT 'else' vF" (at level 10,
 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 "<hidden n >" := (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 & 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             *)
+(* <O___,, * (see version control and CREDITS file for authors & dates) *)
+(*   \VV/  **************************************************************)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
+(************************************************************************)
+
+(* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *)
+
+(** #<style> .doc { font-family: monospace; white-space: pre; } </style># **)
+
+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 "<hidden n >" (at level 0, n at level 0, only printing,
+  format "<hidden  n >").
+#[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 "<hidden n >" := (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.

From 9e9afe18beff2b86d769c109c6530c7965f295e2 Mon Sep 17 00:00:00 2001
From: Pierre Roux <pierre.roux@onera.fr>
Date: Fri, 20 Mar 2026 08:09:39 +0100
Subject: [PATCH 318/578] [ssreflect] Renaming rewrite -> rw

---
 test-suite/output/ssr_under.v  |  2 +-
 theories/Corelib/ssr/ssrbool.v | 98 +++++++++++++++++-----------------
 theories/Corelib/ssr/ssrfun.v  | 26 ++++-----
 3 files changed, 63 insertions(+), 63 deletions(-)

diff --git a/test-suite/output/ssr_under.v b/test-suite/output/ssr_under.v
index 5328f35d70fc..d100488d0abb 100644
--- a/test-suite/output/ssr_under.v
+++ b/test-suite/output/ssr_under.v
@@ -10,7 +10,7 @@ Axiom eq_G :
 Ltac show := match goal with [|-?g] => idtac g end.
 
 Lemma example_G (n : nat) : G (fun n => n - n) n >= 0.
-under eq_G => m do [show; rewrite subnn].
+under eq_G => m do [show; rw subnn].
 show.
 Abort.
 
diff --git a/theories/Corelib/ssr/ssrbool.v b/theories/Corelib/ssr/ssrbool.v
index 514a9b427541..a1d23ba841a8 100644
--- a/theories/Corelib/ssr/ssrbool.v
+++ b/theories/Corelib/ssr/ssrbool.v
@@ -557,7 +557,7 @@ Lemma contraTnot (b : bool) (P : Prop) : (P -> ~~ b) -> (b -> ~ P).
 Proof. by case: b; auto. Qed.
 
 Lemma contraNnot (P : Prop) (b : bool) : (P -> b) -> (~~ b -> ~ P).
-Proof. rewrite -{1}[b]negbK; exact: contraTnot. Qed.
+Proof. rw -{1}[b]negbK; exact: contraTnot. Qed.
 
 Lemma contraPT (P : Prop) (b : bool) : (~~ b -> ~ P) -> P -> b.
 Proof. by case: b => //= /(_ isT) nP /nP. Qed.
@@ -566,7 +566,7 @@ Lemma contra_notT (P : Prop) (b : bool) : (~~ b -> P) -> ~ P -> b.
 Proof. by case: b => //= /(_ isT) HP /(_ HP). Qed.
 
 Lemma contra_notN (P : Prop) (b : bool) : (b -> P) -> ~ P -> ~~ b.
-Proof. rewrite -{1}[b]negbK; exact: contra_notT. Qed.
+Proof. rw -{1}[b]negbK; exact: contra_notT. Qed.
 
 Lemma contraPN (P : Prop) (b : bool) : (b -> ~ P) -> (P -> ~~ b).
 Proof. by case: b => //=; move/(_ isT) => HP /HP. Qed.
@@ -620,7 +620,7 @@ Lemma ifP : if_spec (b = false) b (if b then vT else vF).
 Proof. by case def_b: b; constructor. Qed.
 
 Lemma ifPn : if_spec (~~ b) b (if b then vT else vF).
-Proof. by case def_b: b; constructor; rewrite ?def_b. Qed.
+Proof. by case def_b: b; constructor; rw ?def_b. Qed.
 
 Lemma ifT : b -> (if b then vT else vF) = vT. Proof. by move->. Qed.
 Lemma ifF : b = false -> (if b then vT else vF) = vF. Proof. by move->. Qed.
@@ -686,10 +686,10 @@ Lemma elimTFn : b = c -> if c then ~ P else P.
 Proof. by move <-; apply: (elimNTF Hb); case b. Qed.
 
 Lemma equivPifn : (Q -> P) -> (P -> Q) -> if b then ~ Q else Q.
-Proof. by rewrite -if_neg; apply: equivPif. Qed.
+Proof. by rw -if_neg; apply: equivPif. Qed.
 
 Lemma xorPifn : Q \/ P -> ~ (Q /\ P) -> if b then Q else ~ Q.
-Proof. by rewrite -if_neg; apply: xorPif. Qed.
+Proof. by rw -if_neg; apply: xorPif. Qed.
 
 End ReflectNegCore.
 
@@ -746,7 +746,7 @@ Variant alt_spec : bool -> Type :=
   | AltFalse of ~~ b : alt_spec false.
 
 Lemma altP : alt_spec b.
-Proof. by case def_b: b / Pb; constructor; rewrite ?def_b. Qed.
+Proof. by case def_b: b / Pb; constructor; rw ?def_b. Qed.
 
 Lemma eqbLR (b1 b2 : bool) : b1 = b2 -> b1 -> b2.
 Proof. by move->. Qed.
@@ -1159,13 +1159,13 @@ Arguments addbP {a b}.
 Ltac bool_congr :=
   match goal with
   | |- (?X1 && ?X2 = ?X3) => first
-  [ symmetry; rewrite -1?(andbC X1) -?(andbCA X1); congr 1 (andb X1); symmetry
-  | case: (X1); [ rewrite ?andTb ?andbT // | by rewrite ?andbF /= ] ]
+  [ symmetry; rw -1?(andbC X1) -?(andbCA X1); congr 1 (andb X1); symmetry
+  | case: (X1); [ rw ?andTb ?andbT // | by rw ?andbF /= ] ]
   | |- (?X1 || ?X2 = ?X3) => first
-  [ symmetry; rewrite -1?(orbC X1) -?(orbCA X1); congr 1 (orb X1); symmetry
-  | case: (X1); [ by rewrite ?orbT //= | rewrite ?orFb ?orbF ] ]
+  [ symmetry; rw -1?(orbC X1) -?(orbCA X1); congr 1 (orb X1); symmetry
+  | case: (X1); [ by rw ?orbT //= | rw ?orFb ?orbF ] ]
   | |- (?X1 (+) ?X2 = ?X3) =>
-    symmetry; rewrite -1?(addbC X1) -?(addbCA X1); congr 1 (addb X1); symmetry
+    symmetry; rw -1?(addbC X1) -?(addbCA X1); congr 1 (addb X1); symmetry
   | |- (~~ ?X1 = ?X2) => congr 1 negb
   end.
 
@@ -1580,7 +1580,7 @@ Lemma mem_topred pT (pp : pT) : mem (topred pp) = mem pp.
 Proof. by case: pT pp. Qed.
 
 Lemma topredE pT x (pp : pT) : topred pp x = (x \in pp).
-Proof. by rewrite -mem_topred. Qed.
+Proof. by rw -mem_topred. Qed.
 
 Lemma app_predE x p (ap : registered_applicative_pred p) : ap x = (x \in p).
 Proof. by case: ap => _ /= ->. Qed.
@@ -1776,10 +1776,10 @@ Section PER.
 Hypotheses (symR : symmetric) (trR : transitive).
 
 Lemma sym_left_transitive : left_transitive.
-Proof. by move=> x y Rxy z; apply/idP/idP; apply: trR; rewrite // symR. Qed.
+Proof. by move=> x y Rxy z; apply/idP/idP; apply: trR; rw // symR. Qed.
 
 Lemma sym_right_transitive : right_transitive.
-Proof. by move=> x y /sym_left_transitive Rxy z; rewrite !(symR z) Rxy. Qed.
+Proof. by move=> x y /sym_left_transitive Rxy z; rw !(symR z) Rxy. Qed.
 
 End PER.
 
@@ -1792,7 +1792,7 @@ Definition equivalence_rel := forall x y z, R z z * (R x y -> R x z = R y z).
 Lemma equivalence_relP : equivalence_rel <-> reflexive /\ left_transitive.
 Proof.
 split=> [eqiR | [Rxx trR] x y z]; last by split=> [|/trR->].
-by split=> [x | x y Rxy z]; [rewrite (eqiR x x x) | rewrite (eqiR x y z)].
+by split=> [x | x y Rxy z]; [rw (eqiR x x x) | rw (eqiR x y z)].
 Qed.
 
 End RelationProperties.
@@ -1966,19 +1966,19 @@ Lemma can_in_inj : {in D1, cancel f g} -> {in D1 &, injective f}.
 Proof. by move=> fK x y /fK{2}<- /fK{2}<- ->. Qed.
 
 Lemma canLR_in x y : {in D1, cancel f g} -> y \in D1 -> x = f y -> g x = y.
-Proof. by move=> fK D1y ->; rewrite fK. Qed.
+Proof. by move=> fK D1y ->; rw fK. Qed.
 
 Lemma canRL_in x y : {in D1, cancel f g} -> x \in D1 -> f x = y -> x = g y.
-Proof. by move=> fK D1x <-; rewrite fK. Qed.
+Proof. by move=> fK D1x <-; rw fK. Qed.
 
 Lemma on_can_inj : {on D2, cancel f & g} -> {on D2 &, injective f}.
 Proof. by move=> fK x y /fK{2}<- /fK{2}<- ->. Qed.
 
 Lemma canLR_on x y : {on D2, cancel f & g} -> f y \in D2 -> x = f y -> g x = y.
-Proof. by move=> fK D2fy ->; rewrite fK. Qed.
+Proof. by move=> fK D2fy ->; rw fK. Qed.
 
 Lemma canRL_on x y : {on D2, cancel f & g} -> f x \in D2 -> f x = y -> x = g y.
-Proof. by move=> fK D2fx <-; rewrite fK. Qed.
+Proof. by move=> fK D2fx <-; rw fK. Qed.
 
 Lemma inW_bij : bijective f -> {in D1, bijective f}.
 Proof. by case=> g' fK g'K; exists g' => * ? *; auto. Qed.
@@ -2007,21 +2007,21 @@ Qed.
 Lemma in_on1P : {in D1, {on D2, allQ1 f}} <->
                 {in [pred x in D1 | f x \in D2], allQ1 f}.
 Proof.
-split => allf x; have := allf x; rewrite inE => Q1f; first by case/andP.
+split => allf x; have := allf x; rw inE => Q1f; first by case/andP.
 by move=> ? ?; apply: Q1f; apply/andP.
 Qed.
 
 Lemma in_on1lP : {in D1, {on D2, allQ1l f & h}} <->
                 {in [pred x in D1 | f x \in D2], allQ1l f h}.
 Proof.
-split => allf x; have := allf x; rewrite inE => Q1f; first by case/andP.
+split => allf x; have := allf x; rw inE => Q1f; first by case/andP.
 by move=> ? ?; apply: Q1f; apply/andP.
 Qed.
 
 Lemma in_on2P : {in D1 &, {on D2 &, allQ2 f}} <->
                 {in [pred x in D1 | f x \in D2] &, allQ2 f}.
 Proof.
-split => allf x y; have := allf x y; rewrite !inE => Q2f.
+split => allf x y; have := allf x y; rw !inE => Q2f.
   by move=> /andP[? ?] /andP[? ?]; apply: Q2f.
 by move=> ? ? ? ?; apply: Q2f; apply/andP.
 Qed.
@@ -2098,12 +2098,12 @@ Arguments in_on2S  {T1 T2} D2 {f Q2}.
 
 Lemma can_in_pcan [rT aT : Type] (A : {pred aT}) [f : aT -> rT] [g : rT -> aT] :
   {in A, cancel f g} -> {in A, pcancel f (fun y : rT => Some (g y))}.
-Proof. by move=> fK x Ax; rewrite fK. Qed.
+Proof. by move=> fK x Ax; rw fK. Qed.
 
 Lemma pcan_in_inj [rT aT : Type] [A : {pred aT}]
   [f : aT -> rT] [g : rT -> option aT] :
   {in A, pcancel f g} -> {in A &, injective f}.
-Proof. by move=> fK x y Ax Ay /(congr1 g); rewrite !fK// => -[]. Qed.
+Proof. by move=> fK x y Ax Ay /(congr1 g); rw !fK// => -[]. Qed.
 
 Lemma in_inj_comp A B C (f : B -> A) (h : C -> B) (P : pred B) (Q : pred C) :
   {in P &, injective f} -> {in Q &, injective h} -> {homo h : x / Q x >-> P x} ->
@@ -2117,14 +2117,14 @@ Lemma can_in_comp [A B C : Type] (D : {pred B}) (D' : {pred C})
   {homo h : x / x \in D' >-> x \in D} ->
   {in D, cancel f f'} -> {in D', cancel h h'} ->
   {in D', cancel (f \o h) (h' \o f')}.
-Proof. by move=> hD fK hK c cD /=; rewrite fK ?hK ?hD. Qed.
+Proof. by move=> hD fK hK c cD /=; rw fK ?hK ?hD. Qed.
 
 Lemma pcan_in_comp [A B C : Type] (D : {pred B}) (D' : {pred C})
   [f : B -> A] [h : C -> B] [f' : A -> option B] [h' : B -> option C] :
   {homo h : x / x \in D' >-> x \in D} ->
   {in D, pcancel f f'} -> {in D', pcancel h h'} ->
   {in D', pcancel (f \o h) (obind h' \o f')}.
-Proof. by move=> hD fK hK c cD /=; rewrite fK/= ?hK ?hD. Qed.
+Proof. by move=> hD fK hK c cD /=; rw fK/= ?hK ?hD. Qed.
 
 Definition pred_oapp T (D : {pred T}) : pred (option T) :=
   [pred x | oapp (mem D) false x].
@@ -2135,9 +2135,9 @@ Lemma ocan_in_comp [A B C : Type] (D : {pred B}) (D' : {pred C})
   {in D, ocancel f f'} -> {in D', ocancel h h'} ->
   {in D', ocancel (obind f \o h) (h' \o f')}.
 Proof.
-move=> hD fK hK c cD /=; rewrite -[RHS]hK/=; case hcE : (h c) => [b|]//=.
-have bD : b \in D by have := hD _ cD; rewrite hcE inE.
-by rewrite -[b in RHS]fK; case: (f b) => //=; have /hK := cD; rewrite hcE.
+move=> hD fK hK c cD /=; rw -[RHS]hK/=; case hcE : (h c) => [b|]//=.
+have bD : b \in D by have := hD _ cD; rw hcE inE.
+by rw -[b in RHS]fK; case: (f b) => //=; have /hK := cD; rw hcE.
 Qed.
 
 Section in_sig.
@@ -2187,7 +2187,7 @@ Lemma equivalence_relP_in T (R : rel T) (A : pred T) :
    <-> {in A, reflexive R} /\ {in A &, forall x y, R x y -> {in A, R x =1 R y}}.
 Proof.
 split=> [eqiR | [Rxx trR] x y z *]; last by split=> [|/trR-> //]; apply: Rxx.
-by split=> [x Ax|x y Ax Ay Rxy z Az]; [rewrite (eqiR x x) | rewrite (eqiR x y)].
+by split=> [x Ax|x y Ax Ay Rxy z Az]; [rw (eqiR x x) | rw (eqiR x y)].
 Qed.
 
 Section MonoHomoMorphismTheory.
@@ -2196,41 +2196,41 @@ Variables (aT rT sT : Type) (f : aT -> rT) (g : rT -> aT).
 Variables (aP : pred aT) (rP : pred rT) (aR : rel aT) (rR : rel rT).
 
 Lemma monoW : {mono f : x / aP x >-> rP x} -> {homo f : x / aP x >-> rP x}.
-Proof. by move=> hf x ax; rewrite hf. Qed.
+Proof. by move=> hf x ax; rw hf. Qed.
 
 Lemma mono2W :
   {mono f : x y / aR x y >-> rR x y} -> {homo f : x y / aR x y >-> rR x y}.
-Proof. by move=> hf x y axy; rewrite hf. Qed.
+Proof. by move=> hf x y axy; rw hf. Qed.
 
 Hypothesis fgK : cancel g f.
 
 Lemma homoRL :
   {homo f : x y / aR x y >-> rR x y} -> forall x y, aR (g x) y -> rR x (f y).
-Proof. by move=> Hf x y /Hf; rewrite fgK. Qed.
+Proof. by move=> Hf x y /Hf; rw fgK. Qed.
 
 Lemma homoLR :
   {homo f : x y / aR x y >-> rR x y} -> forall x y, aR x (g y) -> rR (f x) y.
-Proof. by move=> Hf x y /Hf; rewrite fgK. Qed.
+Proof. by move=> Hf x y /Hf; rw fgK. Qed.
 
 Lemma homo_mono :
     {homo f : x y / aR x y >-> rR x y} -> {homo g : x y / rR x y >-> aR x y} ->
   {mono g : x y / rR x y >-> aR x y}.
 Proof.
 move=> mf mg x y; case: (boolP (rR _ _))=> [/mg //|].
-by apply: contraNF=> /mf; rewrite !fgK.
+by apply: contraNF=> /mf; rw !fgK.
 Qed.
 
 Lemma monoLR :
   {mono f : x y / aR x y >-> rR x y} -> forall x y, rR (f x) y = aR x (g y).
-Proof. by move=> mf x y; rewrite -{1}[y]fgK mf. Qed.
+Proof. by move=> mf x y; rw -{1}[y]fgK mf. Qed.
 
 Lemma monoRL :
   {mono f : x y / aR x y >-> rR x y} -> forall x y, rR x (f y) = aR (g x) y.
-Proof. by move=> mf x y; rewrite -{1}[x]fgK mf. Qed.
+Proof. by move=> mf x y; rw -{1}[x]fgK mf. Qed.
 
 Lemma can_mono :
   {mono f : x y / aR x y >-> rR x y} -> {mono g : x y / rR x y >-> aR x y}.
-Proof. by move=> mf x y /=; rewrite -mf !fgK. Qed.
+Proof. by move=> mf x y /=; rw -mf !fgK. Qed.
 
 End MonoHomoMorphismTheory.
 
@@ -2243,14 +2243,14 @@ Variable (aP : pred aT) (rP : pred rT) (aR : rel aT) (rR : rel rT).
 Lemma mono1W_in :
     {in aD, {mono f : x / aP x >-> rP x}} ->
   {in aD, {homo f : x / aP x >-> rP x}}.
-Proof. by move=> hf x hx ax; rewrite hf. Qed.
+Proof. by move=> hf x hx ax; rw hf. Qed.
 #[deprecated(since="Coq 8.16", note="Use mono1W_in instead.")]
 Abbreviation mono2W_in := mono1W_in.
 
 Lemma monoW_in :
     {in aD &, {mono f : x y / aR x y >-> rR x y}} ->
   {in aD &, {homo f : x y / aR x y >-> rR x y}}.
-Proof. by move=> hf x y hx hy axy; rewrite hf. Qed.
+Proof. by move=> hf x y hx hy axy; rw hf. Qed.
 
 Hypothesis fgK : {in rD, {on aD, cancel g & f}}.
 Hypothesis mem_g : {homo g : x / x \in rD >-> x \in aD}.
@@ -2258,12 +2258,12 @@ Hypothesis mem_g : {homo g : x / x \in rD >-> x \in aD}.
 Lemma homoRL_in :
     {in aD &, {homo f : x y / aR x y >-> rR x y}} ->
   {in rD & aD, forall x y, aR (g x) y -> rR x (f y)}.
-Proof. by move=> Hf x y hx hy /Hf; rewrite fgK ?mem_g// ?inE; apply. Qed.
+Proof. by move=> Hf x y hx hy /Hf; rw fgK ?mem_g// ?inE; apply. Qed.
 
 Lemma homoLR_in :
     {in aD &, {homo f : x y / aR x y >-> rR x y}} ->
   {in aD & rD, forall x y, aR x (g y) -> rR (f x) y}.
-Proof. by move=> Hf x y hx hy /Hf; rewrite fgK ?mem_g// ?inE; apply. Qed.
+Proof. by move=> Hf x y hx hy /Hf; rw fgK ?mem_g// ?inE; apply. Qed.
 
 Lemma homo_mono_in :
     {in aD &, {homo f : x y / aR x y >-> rR x y}} ->
@@ -2271,23 +2271,23 @@ Lemma homo_mono_in :
   {in rD &, {mono g : x y / rR x y >-> aR x y}}.
 Proof.
 move=> mf mg x y hx hy; case: (boolP (rR _ _))=> [/mg //|]; first exact.
-by apply: contraNF=> /mf; rewrite !fgK ?mem_g//; apply.
+by apply: contraNF=> /mf; rw !fgK ?mem_g//; apply.
 Qed.
 
 Lemma monoLR_in :
     {in aD &, {mono f : x y / aR x y >-> rR x y}} ->
   {in aD & rD, forall x y, rR (f x) y = aR x (g y)}.
-Proof. by move=> mf x y hx hy; rewrite -{1}[y]fgK ?mem_g// mf ?mem_g. Qed.
+Proof. by move=> mf x y hx hy; rw -{1}[y]fgK ?mem_g// mf ?mem_g. Qed.
 
 Lemma monoRL_in :
     {in aD &, {mono f : x y / aR x y >-> rR x y}} ->
   {in rD & aD, forall x y, rR x (f y) = aR (g x) y}.
-Proof. by move=> mf x y hx hy; rewrite -{1}[x]fgK ?mem_g// mf ?mem_g. Qed.
+Proof. by move=> mf x y hx hy; rw -{1}[x]fgK ?mem_g// mf ?mem_g. Qed.
 
 Lemma can_mono_in :
     {in aD &, {mono f : x y / aR x y >-> rR x y}} ->
   {in rD &, {mono g : x y / rR x y >-> aR x y}}.
-Proof. by move=> mf x y hx hy; rewrite -mf ?mem_g// !fgK ?mem_g. Qed.
+Proof. by move=> mf x y hx hy; rw -mf ?mem_g// !fgK ?mem_g. Qed.
 
 End MonoHomoMorphismTheory_in.
 Arguments homoRL_in {aT rT f g aD rD aR rR}.
@@ -2373,15 +2373,15 @@ Variables (f : aT -> rT) (g : rT -> aT).
 Lemma inj_can_sym_in_on :
     {homo f : x / x \in aD >-> x \in rD} -> {in aD, {on rD, cancel f & g}} ->
   {in rD &, {on aD &, injective g}} -> {in rD, {on aD, cancel g & f}}.
-Proof. by move=> fD fK gI x x_rD gx_aD; apply: gI; rewrite ?inE ?fK ?fD. Qed.
+Proof. by move=> fD fK gI x x_rD gx_aD; apply: gI; rw ?inE ?fK ?fD. Qed.
 
 Lemma inj_can_sym_on : {in aD, cancel f g} ->
   {on aD &, injective g} -> {on aD, cancel g & f}.
-Proof. by move=> fK gI x gx_aD; apply: gI; rewrite ?inE ?fK. Qed.
+Proof. by move=> fK gI x gx_aD; apply: gI; rw ?inE ?fK. Qed.
 
 Lemma inj_can_sym_in : {homo f \o g : x / x \in rD} -> {on rD, cancel f & g} ->
   {in rD &, injective g} ->  {in rD, cancel g f}.
-Proof. by move=> fgD fK gI x x_rD; apply: gI; rewrite ?fK ?fgD. Qed.
+Proof. by move=> fgD fK gI x x_rD; apply: gI; rw ?fK ?fgD. Qed.
 
 End inj_can_sym_in_on.
 Arguments inj_can_sym_in_on {aT rT aD rD f g}.
diff --git a/theories/Corelib/ssr/ssrfun.v b/theories/Corelib/ssr/ssrfun.v
index e5e5d1376680..fa714ce2f55c 100644
--- a/theories/Corelib/ssr/ssrfun.v
+++ b/theories/Corelib/ssr/ssrfun.v
@@ -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''.

From c4a7ced9d945fadcf8e2a1db048d8ef6581c800c Mon Sep 17 00:00:00 2001
From: Pierre Roux <pierre.roux@onera.fr>
Date: Fri, 20 Mar 2026 08:13:20 +0100
Subject: [PATCH 319/578] [ssreflect] Deprecate rewrite

---
 plugins/ltac/tacinterp.mli        |  1 +
 plugins/ssrrewrite/ssrrewrite.mlg | 10 +++++++++-
 2 files changed, 10 insertions(+), 1 deletion(-)

diff --git a/plugins/ltac/tacinterp.mli b/plugins/ltac/tacinterp.mli
index ff39394f29c8..d9394b101ccb 100644
--- a/plugins/ltac/tacinterp.mli
+++ b/plugins/ltac/tacinterp.mli
@@ -48,6 +48,7 @@ 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
diff --git a/plugins/ssrrewrite/ssrrewrite.mlg b/plugins/ssrrewrite/ssrrewrite.mlg
index c6d7feb5423a..cf1667041ffa 100644
--- a/plugins/ssrrewrite/ssrrewrite.mlg
+++ b/plugins/ssrrewrite/ssrrewrite.mlg
@@ -18,6 +18,11 @@ open Ssreflect_plugin.Ssrequality
 open Ssreflect_plugin.Ssrparser
 open Ssreflect_plugin.Ssrtacs
 
+let warn_deprecated_rewrite =
+  CWarnings.create ~name:"rewrite-rw" ~category:Deprecation.Version.v9_3
+    ~quickfix:(fun ~loc () -> [Quickfix.make ~loc (Pp.str "rw")])
+    (fun () -> Pp.str "The 'rewrite' tactic has been renamed 'rw'.")
+
 }
 
 DECLARE PLUGIN "rocq-runtime.plugins.ssreflect_rewrite"
@@ -67,7 +72,10 @@ END
 
 TACTIC EXTEND ssrrewrite
   | [ "rewrite" ssrrewriteargs(args) ssrclauses(clauses) ] ->
-    { tclCLAUSES (ssrrewritetac ist args) clauses }
+    { let loc = Tacinterp.extract_loc ist
+        |> Option.map (fun l -> Loc.sub l 0 7) in
+      warn_deprecated_rewrite ?loc ();
+      tclCLAUSES (ssrrewritetac ist args) clauses }
 END
 
 {

From 90ad5409bc7adf3bae5ae0a49e0b803ce97a801d Mon Sep 17 00:00:00 2001
From: Pierre Roux <pierre.roux@onera.fr>
Date: Fri, 20 Mar 2026 07:56:45 +0100
Subject: [PATCH 320/578] Update doc

---
 doc/sphinx/addendum/generalized-rewriting.rst |   2 +-
 doc/sphinx/changes.rst                        |   4 +-
 .../proof-engine/ssreflect-proof-language.rst | 573 +++++++++---------
 3 files changed, 295 insertions(+), 284 deletions(-)

diff --git a/doc/sphinx/addendum/generalized-rewriting.rst b/doc/sphinx/addendum/generalized-rewriting.rst
index 5bb8b9770bdf..0c6366c5dd7d 100644
--- a/doc/sphinx/addendum/generalized-rewriting.rst
+++ b/doc/sphinx/addendum/generalized-rewriting.rst
@@ -484,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``.
 
diff --git a/doc/sphinx/changes.rst b/doc/sphinx/changes.rst
index 6450a6b721e3..73e7fab18dea 100644
--- a/doc/sphinx/changes.rst
+++ b/doc/sphinx/changes.rst
@@ -10079,7 +10079,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 <rewrite (ssreflect)>`, 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
@@ -11109,7 +11109,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 <rewrite (ssreflect)>` compatible with the HoTT
+  This makes :tacn:`rw` compatible with the HoTT
   library https://github.com/HoTT/HoTT
   (`#10305 <https://github.com/rocq-prover/rocq/pull/10305>`_,
   fixes `#9336 <https://github.com/rocq-prover/rocq/issues/9336>`_,
diff --git a/doc/sphinx/proof-engine/ssreflect-proof-language.rst b/doc/sphinx/proof-engine/ssreflect-proof-language.rst
index 084877a27cf3..a94a6d1cdd2d 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 <rewrite (ssreflect)>` 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 <rewrite (ssreflect)>` 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 <term> is <pattern then _ else _``
+   and ``if <term> isn't <pattern then _ else _`` syntactic sugars for matches
+   and an ``if <term> 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,64 +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.
-+ 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.
-
 Gallina extensions
 --------------------
 
@@ -204,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.
@@ -244,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::
@@ -262,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.
@@ -298,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.
 
@@ -363,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.
@@ -388,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.
@@ -433,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:
+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.
 
-.. prodn::
-   binder += {| & @term | of @term }
-
-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:
@@ -451,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
@@ -505,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.
@@ -620,7 +566,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.
@@ -668,7 +614,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,7 +635,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,7 +656,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.
@@ -730,7 +676,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.
@@ -763,7 +709,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,7 +731,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.
@@ -806,7 +752,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.
@@ -837,7 +783,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.
@@ -854,7 +800,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.
@@ -885,7 +831,7 @@ 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
 
@@ -901,7 +847,7 @@ 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
 
@@ -1017,7 +963,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.
@@ -1078,7 +1024,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.
@@ -1173,7 +1119,7 @@ The move tactic.
 
       .. rocqtop:: reset all
 
-         Require Import ssreflect.
+         From Corelib Require Import ssreflect_rw.
          Goal not False.
          move.
 
@@ -1243,7 +1189,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.
@@ -1283,7 +1229,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.
@@ -1430,7 +1376,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
@@ -1463,7 +1409,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.
@@ -1701,7 +1647,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` * ``]``
@@ -1755,13 +1701,15 @@ 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.
       move=> {x} ->.
 
@@ -1816,7 +1764,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.
@@ -1869,7 +1817,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.
@@ -1888,7 +1836,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.
@@ -1955,7 +1903,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.
@@ -2061,20 +2009,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.
     ...
 
 
@@ -2109,7 +2057,7 @@ with a ``by``, like in:
 
 .. rocqdoc::
 
-   by apply/eqP; rewrite -dvdn1.
+   by apply/eqP; rw -dvdn1.
 
 .. tacn:: done
    :name: done
@@ -2128,7 +2076,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 ].
 
@@ -2174,19 +2122,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:
@@ -2256,7 +2204,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.
@@ -2322,14 +2270,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
@@ -2354,7 +2302,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`).
 
@@ -2375,14 +2323,14 @@ 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.
      do [mytac H2] in H1 *.
@@ -2393,7 +2341,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 ) } } {? * }
 
@@ -2450,7 +2398,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.
@@ -2464,7 +2412,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.
@@ -2482,7 +2430,7 @@ 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.
@@ -2526,7 +2474,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,
@@ -2535,7 +2483,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.
@@ -2563,7 +2511,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.
@@ -2590,7 +2538,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.
@@ -2610,16 +2558,18 @@ 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:: all extra-mathcomp extra-mczify
 
+     From Corelib Require Import ssreflect_rw.
+     From mathcomp Require Import ssrfun ssrbool ssrnat zify.
+
      Lemma test : True.
      have H x (y : nat) : 2 * x + y = x + x + y by lia.
 
@@ -2732,7 +2682,7 @@ typeclass inference.
 
   .. rocqtop:: reset none
 
-     From Corelib Require Import ssreflect.
+     From Corelib Require Import ssreflect_rw.
 
      Axiom ty : Type.
      Axiom t : ty.
@@ -2877,16 +2827,19 @@ 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).
      wlog: q1 q2 r1 r2 / q1 <= q2.
@@ -2908,7 +2861,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.
@@ -2958,7 +2911,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.
@@ -2977,7 +2930,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.
@@ -3002,7 +2955,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.
 
 
@@ -3021,8 +2974,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
@@ -3072,7 +3024,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.
 
@@ -3084,16 +3036,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.
@@ -3103,15 +3055,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.
@@ -3121,7 +3073,7 @@ 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.
+        rw [ddouble _]/double.
 
   .. warning::
 
@@ -3135,13 +3087,13 @@ A :token:`r_item` can be one of the following.
 
      .. 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
@@ -3172,7 +3124,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.
@@ -3215,7 +3167,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
@@ -3230,7 +3182,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.
@@ -3242,11 +3194,11 @@ 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.
+     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.
+     by rw -{1}[n]addn0 addnCA addn0.
      Qed.
 
 Note the use of the ``?`` switch for parallel rewrite operations in the
@@ -3266,7 +3218,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.
@@ -3274,7 +3226,7 @@ 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.
+     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
@@ -3286,7 +3238,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.
@@ -3294,7 +3246,7 @@ 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.
+     Fail rw [x + _]H.
 
   Indeed, the left-hand side of ``H`` does not match
   the redex identified by the pattern ``x + y * 4``.
@@ -3309,7 +3261,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.
@@ -3317,7 +3269,7 @@ 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).
+     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
@@ -3338,7 +3290,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.
@@ -3346,7 +3298,7 @@ repetition.
   .. rocqtop:: all
 
      Lemma test x y (z : nat) : x + 1 = x + y + 1.
-     rewrite 2!(_ : _ + 1 = z).
+     rw 2!(_ : _ + 1 = z).
 
 This last tactic generates *three* subgoals because
 the second rewrite operation specified with the ``2!`` multiplier
@@ -3368,7 +3320,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.
@@ -3382,7 +3334,7 @@ rewrite operations prescribed by the rules on the current goal.
      Hypothesis eqac : a = c.
 
      Lemma test : a = a.
-     rewrite (eqab, eqac).
+     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
@@ -3393,8 +3345,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
@@ -3412,7 +3364,7 @@ literal matches have priority.
       Definition multi2 := (eqab, eqd0).
 
       Lemma test : d = b.
-      rewrite multi2.
+      rw multi2.
 
    Indeed, rule ``eqd0`` applies without unfolding the
    definition of ``d``.
@@ -3430,7 +3382,7 @@ repeated anew.
      Definition multi3 := (eq_adda_b, eq_adda_c, eqb0).
 
      Lemma test : 1 + a = 12 + a.
-     rewrite 2!multi3.
+     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``.
@@ -3441,7 +3393,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::
 
@@ -3484,7 +3436,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.
 
@@ -3493,16 +3445,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.
@@ -3512,13 +3464,13 @@ Anyway this tactic is *not* equivalent to
   .. rocqtop:: all
 
      Lemma test y z : y * 0 + y * (z * 0) = 0.
-     rewrite (_ : _ * 0 = 0).
+     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
@@ -3552,7 +3504,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.
@@ -3567,7 +3519,7 @@ cases.
 
        Lemma test : f 3 + f 3 = f 6.
        (* 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
@@ -3575,23 +3527,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
@@ -3610,7 +3562,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.
@@ -3618,6 +3569,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.
@@ -3630,11 +3583,11 @@ 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.
+     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.
@@ -3642,7 +3595,7 @@ 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.
+     rw insubT.
 
 
 As a temporary limitation, this behavior is available only if the
@@ -3667,7 +3620,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.
@@ -3690,7 +3643,7 @@ complete terms, as shown by the simple example below.
 
    .. 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
@@ -3699,8 +3652,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:
@@ -3708,7 +3661,7 @@ 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.
+      under eq_map => m do rw subnn.
 
 
 The under tactic
@@ -3746,7 +3699,7 @@ Let us redo the running example in interactive mode.
 
       Lemma example_map l : sumlist (map (fun m => m - m) l) = 0.
       under eq_map => m.
-        rewrite subnn.
+        rw subnn.
         over.
 
 The execution of the Ltac expression:
@@ -3755,8 +3708,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.
 
@@ -3774,7 +3727,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.
@@ -3858,7 +3812,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.
@@ -3922,7 +3876,7 @@ Notes:
         \sum_(0 <= i < m | prime i) \sum_(0 <= j < n | odd j) (j + i).
       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.
@@ -3965,21 +3919,22 @@ 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.
+     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
@@ -3989,7 +3944,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.
@@ -4000,7 +3955,7 @@ definition.
       Definition lid := locked (fun x : nat => x).
 
       Lemma test : lid 3 = 3.
-      rewrite /=.
+      rw /=.
       unlock lid.
 
 .. tacn:: unlock {? @occ_switch } @ident
@@ -4060,7 +4015,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.
 
@@ -4102,11 +4057,10 @@ 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
 
@@ -4129,14 +4083,14 @@ 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.
@@ -4152,18 +4106,17 @@ 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.
+         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``.
 
@@ -4173,11 +4126,10 @@ 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
 
@@ -4240,7 +4192,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::
@@ -4274,11 +4226,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).
 
@@ -4353,17 +4305,16 @@ 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).
      set t := (X in _ = X).
-     rewrite {}/t.
+     rw {}/t.
      set t := (a + _ in X in _ = X).
 
 
@@ -4392,11 +4343,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
 
@@ -4408,7 +4358,7 @@ 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.
+     rw [in f _ _]addSn.
 
   Note: the simplification rule ``addSn`` is applied only under the ``f``
   symbol.
@@ -4416,7 +4366,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
@@ -4429,13 +4379,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
@@ -4455,7 +4405,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
@@ -4482,7 +4432,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).
 
 
@@ -4556,14 +4506,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.
@@ -4631,7 +4582,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.
@@ -4645,10 +4596,10 @@ Here is an example of a regular, but nontrivial, eliminator.
                                      end -> P _x m) -> forall n : nat, P n (plus m n).
      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.
 
@@ -4669,10 +4620,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 +4651,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.
@@ -4735,11 +4687,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::
 
@@ -4799,7 +4750,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.
@@ -4820,7 +4771,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.
@@ -4855,7 +4806,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.
@@ -4888,7 +4839,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.
@@ -4932,11 +4883,10 @@ 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
 
@@ -4961,14 +4911,16 @@ 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.
 
@@ -5017,7 +4969,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.
@@ -5034,14 +4986,15 @@ 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.
      by case: b.
 
@@ -5124,7 +5077,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.
@@ -5165,14 +5118,15 @@ 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.
      apply/andP.
 
@@ -5283,14 +5237,15 @@ 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
@@ -5316,16 +5271,17 @@ 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.
+     have /andP [pa ->] : (a && b) by rw andbC.
 
 Interpreting goals
 ``````````````````
@@ -5379,14 +5335,15 @@ 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.
      apply/idP/idP.
 
@@ -5395,14 +5352,15 @@ 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.
      apply/norP/idP.
 
@@ -5471,15 +5429,17 @@ 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.
 
@@ -5504,8 +5464,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
@@ -5641,7 +5601,7 @@ respectively.
 
    case analysis (see :ref:`the_defective_tactics_ssr`)
 
-.. tacv:: rewrite {+ @r_step }
+.. tacv:: rw {+ @r_step }
 
    rewrite (see :ref:`rewriting_ssr`)
 
@@ -5774,3 +5734,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.``.

From 72cca582742d19a10856d94ce091c5ce28271b35 Mon Sep 17 00:00:00 2001
From: Pierre Roux <pierre.roux@onera.fr>
Date: Fri, 20 Mar 2026 07:56:02 +0100
Subject: [PATCH 321/578] Add changelog

---
 .../07-ssreflect/21478-ssreflect-rw-Changed.rst      | 12 ++++++++++++
 1 file changed, 12 insertions(+)
 create mode 100644 doc/changelog/07-ssreflect/21478-ssreflect-rw-Changed.rst

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 <term> is <pattern> then <term> else <term>``
+  and ``if <term> isn't <pattern> then <term> else <term>``
+  syntactic sugars for match
+  (`#21478 <https://github.com/rocq-prover/rocq/pull/21478>`_,
+  by Pierre Roux).

From 02882ea290577d517c44fba6ac1159b773b92b97 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Tue, 10 Mar 2026 17:45:09 +0100
Subject: [PATCH 322/578] VM error when encountering non compiled constant
 (from disabled VM)

The code also puts "BCuncompiled" for symbols and primitives, but
symbols can only be declared when rewrite rules are on so VM is
disabled and cannot be reenabled, and the const_body_code for
primitives is not accessed as genlambda produces Lprim instead of Lconst.
---
 checker/values.ml                 |  4 ++--
 engine/evd.ml                     |  5 ++---
 kernel/cClosure.ml                |  7 +++----
 kernel/declarations.mli           |  2 +-
 kernel/declareops.ml              |  3 +--
 kernel/genlambda.ml               |  2 +-
 kernel/mod_typing.ml              |  4 ++--
 kernel/mod_typing.mli             |  2 +-
 kernel/modops.ml                  |  2 +-
 kernel/safe_typing.ml             | 10 ++++------
 kernel/vmbytegen.ml               | 22 ++++++++++------------
 kernel/vmbytegen.mli              |  2 +-
 kernel/vmemitcodes.ml             |  2 ++
 kernel/vmemitcodes.mli            |  1 +
 kernel/vmsymtable.ml              |  8 ++++++++
 plugins/extraction/extract_env.ml |  2 +-
 vernac/declaremods.ml             |  4 ++--
 17 files changed, 43 insertions(+), 39 deletions(-)

diff --git a/checker/values.ml b/checker/values.ml
index 820fc300c16c..443355af355a 100644
--- a/checker/values.ml
+++ b/checker/values.ml
@@ -389,7 +389,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 +417,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|]
diff --git a/engine/evd.ml b/engine/evd.ml
index 8897db09d0b7..0c8b0d8a17bf 100644
--- a/engine/evd.ml
+++ b/engine/evd.ml
@@ -814,11 +814,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
diff --git a/kernel/cClosure.ml b/kernel/cClosure.ml
index 9e5a4e606049..3598d412556f 100644
--- a/kernel/cClosure.ml
+++ b/kernel/cClosure.ml
@@ -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
@@ -430,7 +429,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)
diff --git a/kernel/declarations.mli b/kernel/declarations.mli
index 387792e14817..b7129551bcc5 100644
--- a/kernel/declarations.mli
+++ b/kernel/declarations.mli
@@ -128,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 } *)
 
diff --git a/kernel/declareops.ml b/kernel/declareops.ml
index 42dc2e517334..138b54d4ac4c 100644
--- a/kernel/declareops.ml
+++ b/kernel/declareops.ml
@@ -111,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;
diff --git a/kernel/genlambda.ml b/kernel/genlambda.ml
index 9500f2cbb442..3039717336d5 100644
--- a/kernel/genlambda.ml
+++ b/kernel/genlambda.ml
@@ -543,7 +543,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 *)
diff --git a/kernel/mod_typing.ml b/kernel/mod_typing.ml
index 0e05c7a7f61f..168b49b6e6f9 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 =
@@ -239,7 +239,7 @@ let rec check_with_mod (cst, ustate) env struc (idl,new_mp) mp reso =
   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
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 4a999cd69d83..6a025b9a0237 100644
--- a/kernel/modops.ml
+++ b/kernel/modops.ml
@@ -219,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 ->
diff --git a/kernel/safe_typing.ml b/kernel/safe_typing.ml
index c9395bbff9b3..c25607c28004 100644
--- a/kernel/safe_typing.ml
+++ b/kernel/safe_typing.ml
@@ -424,7 +424,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
@@ -498,12 +498,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
 
diff --git a/kernel/vmbytegen.ml b/kernel/vmbytegen.ml
index f4b05057234b..d011ca095fb0 100644
--- a/kernel/vmbytegen.ml
+++ b/kernel/vmbytegen.ml
@@ -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 *)
@@ -987,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 =
@@ -1004,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..af273b69cd07 100644
--- a/kernel/vmemitcodes.ml
+++ b/kernel/vmemitcodes.ml
@@ -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 c577eebc1a39..ea728e7b3a1e 100644
--- a/kernel/vmsymtable.ml
+++ b/kernel/vmsymtable.ml
@@ -265,6 +265,11 @@ 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 =
@@ -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/plugins/extraction/extract_env.ml b/plugins/extraction/extract_env.ml
index 2f3b20cbbe76..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 =
diff --git a/vernac/declaremods.ml b/vernac/declaremods.ml
index 560f598a62bb..f3fd9b24f7c1 100644
--- a/vernac/declaremods.ml
+++ b/vernac/declaremods.ml
@@ -823,7 +823,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 +1010,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

From d9f20faccae45df9da8c2733a80436dc3c632a49 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Tue, 24 Mar 2026 15:45:45 +0100
Subject: [PATCH 323/578] debug printer for genlambda

---
 dev/top_printers.dbg | 1 +
 dev/top_printers.ml  | 2 ++
 dev/top_printers.mli | 2 ++
 3 files changed, 5 insertions(+)

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 5109e6c10e75..e7413d3c8424 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"<genarg:" ++ pr_argument_type(genarg_tag arg) ++ str">") l
 
diff --git a/dev/top_printers.mli b/dev/top_printers.mli
index 1c11f4707460..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

From b7a70019a23d4408d44766ed9d026599d949b829 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Fri, 27 Mar 2026 14:46:11 +0100
Subject: [PATCH 324/578] Slightly clarify doc about indices matter flag vs
 print assumptions

---
 doc/sphinx/proof-engine/vernacular-commands.rst | 6 ++++--
 1 file changed, 4 insertions(+), 2 deletions(-)

diff --git a/doc/sphinx/proof-engine/vernacular-commands.rst b/doc/sphinx/proof-engine/vernacular-commands.rst
index 00bbf92681b6..156d9d20bfaa 100644
--- a/doc/sphinx/proof-engine/vernacular-commands.rst
+++ b/doc/sphinx/proof-engine/vernacular-commands.rst
@@ -1155,8 +1155,10 @@ Controlling Typing Flags
    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`).
-   Inductives that rely on indices not mattering are printed by
-   :cmd:`Print Assumptions`.
+
+   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
 

From 4e6b799f02ceccbb02a7f03520a5c350e1d63588 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Wed, 25 Mar 2026 16:01:44 +0100
Subject: [PATCH 325/578] collapse_sort_variables rename and flip to_type
 argument to only_above_prop

This is easier to understand and more accurate to what the flag does IMO.
---
 engine/evd.ml          |  8 ++++----
 engine/evd.mli         |  2 +-
 engine/uState.ml       | 10 +++++-----
 engine/uState.mli      |  2 +-
 vernac/comInductive.ml |  2 +-
 vernac/declare.ml      |  2 +-
 6 files changed, 13 insertions(+), 13 deletions(-)

diff --git a/engine/evd.ml b/engine/evd.ml
index b7f5c199162a..f3a4573bc294 100644
--- a/engine/evd.ml
+++ b/engine/evd.ml
@@ -1040,7 +1040,7 @@ 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 ~to_type:(PolyFlags.collapse_sort_variables poly) 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)
 
@@ -1222,8 +1222,8 @@ let nf_univ_variables evd =
   let uctx = UState.normalize_variables evd.universes in
   {evd with universes = uctx}
 
-let collapse_sort_variables ?except ?(to_type = true) evd =
-  let universes = UState.collapse_sort_variables ?except ~to_type evd.universes in
+let collapse_sort_variables ?except ?(only_above_prop = false) evd =
+  let universes = UState.collapse_sort_variables ?except ~only_above_prop evd.universes in
   { evd with universes }
 
 let minimize_universes_no_collapse evd =
@@ -1234,7 +1234,7 @@ let minimize_universes_no_collapse evd =
 let minimize_universes ?(poly=PolyFlags.default) evd =
   let collapse_sort_variables = PolyFlags.collapse_sort_variables poly in
   let uctx' =
-    UState.collapse_sort_variables ~to_type:collapse_sort_variables evd.universes
+    UState.collapse_sort_variables ~only_above_prop:(not collapse_sort_variables) evd.universes
   in
   minimize_universes_no_collapse {evd with universes = uctx'}
 
diff --git a/engine/evd.mli b/engine/evd.mli
index 7d345a43b52d..69b1a15a4d9b 100644
--- a/engine/evd.mli
+++ b/engine/evd.mli
@@ -659,7 +659,7 @@ 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 -> ?to_type:bool -> 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
 
diff --git a/engine/uState.ml b/engine/uState.ml
index ca004abb330b..2cf341bdfe1d 100644
--- a/engine/uState.ml
+++ b/engine/uState.ml
@@ -101,7 +101,7 @@ 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 -> ?to_type:bool -> t -> 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
@@ -324,7 +324,7 @@ let collapse_above_prop ~to_prop m =
          )
          m.qmap m
 
-let collapse ?(except=QSet.empty) ?(to_type = true) m =
+let collapse ?(except=QSet.empty) ?(only_above_prop = false) m =
   let free_qualities = QMap.fold (fun q v fqs ->
       match v with
       | Equiv _ -> fqs
@@ -356,7 +356,7 @@ let collapse ?(except=QSet.empty) ?(to_type = true) m =
           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 to_type then Option.get (set q qtype m) else 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) =
@@ -1561,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 ?(to_type = true) uctx =
-  let sorts = QState.collapse ?except ~to_type uctx.sort_variables in
+let collapse_sort_variables ?except ?(only_above_prop = false) uctx =
+  let sorts = QState.collapse ?except ~only_above_prop uctx.sort_variables in
   normalize_quality_variables { uctx with sort_variables = sorts }
 
 let minimize uctx =
diff --git a/engine/uState.mli b/engine/uState.mli
index 1b9f05d361cf..d35969af83ad 100644
--- a/engine/uState.mli
+++ b/engine/uState.mli
@@ -240,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 -> ?to_type:bool -> 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;
diff --git a/vernac/comInductive.ml b/vernac/comInductive.ml
index 5620998c55cf..af3c24915144 100644
--- a/vernac/comInductive.ml
+++ b/vernac/comInductive.ml
@@ -524,7 +524,7 @@ type should_template =
   | NotTemplate
 
 let nontemplate_univ_entry ~poly sigma udecl =
-  let sigma = Evd.collapse_sort_variables ~to_type:(PolyFlags.collapse_sort_variables poly) 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
diff --git a/vernac/declare.ml b/vernac/declare.ml
index a4aec5e2ce3b..621e48732b6c 100644
--- a/vernac/declare.ml
+++ b/vernac/declare.ml
@@ -1212,7 +1212,7 @@ module ProgramDecl = struct
       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 ~to_type:(PolyFlags.collapse_sort_variables poly) 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

From 5cebf70b8cafc3bc98d9739022188aa8ff80f5f4 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Wed, 25 Mar 2026 16:03:46 +0100
Subject: [PATCH 326/578] Make only_above_prop argument to
 collapse_sort_variables non implicit

---
 engine/evd.ml           | 2 +-
 engine/evd.mli          | 2 +-
 engine/uState.ml        | 6 +++---
 engine/uState.mli       | 2 +-
 vernac/comInductive.ml  | 2 +-
 vernac/vernacentries.ml | 2 +-
 6 files changed, 8 insertions(+), 8 deletions(-)

diff --git a/engine/evd.ml b/engine/evd.ml
index f3a4573bc294..f41373020915 100644
--- a/engine/evd.ml
+++ b/engine/evd.ml
@@ -1222,7 +1222,7 @@ let nf_univ_variables evd =
   let uctx = UState.normalize_variables evd.universes in
   {evd with universes = uctx}
 
-let collapse_sort_variables ?except ?(only_above_prop = false) evd =
+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 }
 
diff --git a/engine/evd.mli b/engine/evd.mli
index 69b1a15a4d9b..333d770811ba 100644
--- a/engine/evd.mli
+++ b/engine/evd.mli
@@ -659,7 +659,7 @@ 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 -> ?only_above_prop:bool -> 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
 
diff --git a/engine/uState.ml b/engine/uState.ml
index 2cf341bdfe1d..bb9a46ea7d37 100644
--- a/engine/uState.ml
+++ b/engine/uState.ml
@@ -101,7 +101,7 @@ 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 -> ?only_above_prop:bool -> t -> 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
@@ -324,7 +324,7 @@ let collapse_above_prop ~to_prop m =
          )
          m.qmap m
 
-let collapse ?(except=QSet.empty) ?(only_above_prop = false) m =
+let collapse ?(except=QSet.empty) ~only_above_prop m =
   let free_qualities = QMap.fold (fun q v fqs ->
       match v with
       | Equiv _ -> fqs
@@ -1561,7 +1561,7 @@ 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 ?(only_above_prop = false) uctx =
+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 }
 
diff --git a/engine/uState.mli b/engine/uState.mli
index d35969af83ad..a025f47be8ad 100644
--- a/engine/uState.mli
+++ b/engine/uState.mli
@@ -240,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 -> ?only_above_prop:bool -> 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;
diff --git a/vernac/comInductive.ml b/vernac/comInductive.ml
index af3c24915144..079881019fe9 100644
--- a/vernac/comInductive.ml
+++ b/vernac/comInductive.ml
@@ -537,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
diff --git a/vernac/vernacentries.ml b/vernac/vernacentries.ml
index 00e726f37cb2..b8bfad5de0f9 100644
--- a/vernac/vernacentries.ml
+++ b/vernac/vernacentries.ml
@@ -2164,7 +2164,7 @@ let vernac_global_check c =
   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 sigma = Evd.collapse_sort_variables ~only_above_prop:false sigma in
   let c = EConstr.to_constr sigma c in
   let (qs, us), (qcst, ucst) as uctx = Evd.sort_context_set sigma in
    (* always empty due to collapse *)

From 3579ee0f7611c544e59490fbb47c69525c39adef Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Thu, 26 Mar 2026 13:50:47 +0100
Subject: [PATCH 327/578] overlay

---
 dev/ci/user-overlays/21820-SkySkimmer-only-above.sh | 9 +++++++++
 1 file changed, 9 insertions(+)
 create mode 100644 dev/ci/user-overlays/21820-SkySkimmer-only-above.sh

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

From 5013cd98ff1244b287271ea5f6a72b9eabe7bebd Mon Sep 17 00:00:00 2001
From: Thomas Lamiaux <thomas.lamiaux@gmail.com>
Date: Mon, 23 Mar 2026 17:14:39 +0100
Subject: [PATCH 328/578] Generalize DeclareScheme to use GlobRef instead of
 inductive

prevent registering scheme for section variables without the local attribute
---
 .../21811-thomas-lamiaux-genScheme.sh         |  1 +
 .../04-tactics/21811-genScheme-Changed.rst    |  5 +++
 plugins/ltac2/tac2core.ml                     |  5 +--
 tactics/allScheme.ml                          | 12 +++----
 tactics/declareScheme.ml                      | 36 +++++++++++--------
 tactics/declareScheme.mli                     |  8 ++---
 tactics/ind_tables.ml                         |  6 ++--
 test-suite/success/SchemeSectionVariable.v    | 10 ++++++
 vernac/comSearch.ml                           |  2 +-
 vernac/declare.ml                             |  2 +-
 vernac/g_vernac.mlg                           |  2 +-
 vernac/indschemes.ml                          |  6 ++--
 vernac/ppvernac.ml                            |  4 +--
 vernac/vernacentries.ml                       | 18 +++++-----
 vernac/vernacexpr.mli                         |  2 +-
 15 files changed, 70 insertions(+), 49 deletions(-)
 create mode 100644 dev/ci/user-overlays/21811-thomas-lamiaux-genScheme.sh
 create mode 100644 doc/changelog/04-tactics/21811-genScheme-Changed.rst
 create mode 100644 test-suite/success/SchemeSectionVariable.v

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/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 <https://github.com/rocq-prover/rocq/pull/21811>`_,
+  by Thomas Lamiaux).
diff --git a/plugins/ltac2/tac2core.ml b/plugins/ltac2/tac2core.ml
index 7d278ef57372..a72953263d1e 100644
--- a/plugins/ltac2/tac2core.ml
+++ b/plugins/ltac2/tac2core.ml
@@ -1367,10 +1367,7 @@ let () =
 
 let () =
   define "scheme_lookup" (scheme_kind @-> reference @-> ret (option reference))
-  @@ fun kind ref ->
-  match ref with
-  | GlobRef.IndRef ind -> DeclareScheme.lookup_scheme_opt kind ind
-  | _ -> None
+  @@ DeclareScheme.lookup_scheme_opt
 
 let define_scheme_kind name =
   define ("scheme_kind_" ^ name) (ret scheme_kind) name
diff --git a/tactics/allScheme.ml b/tactics/allScheme.ml
index cebb74bd7bd1..abca924ce4e2 100644
--- a/tactics/allScheme.ml
+++ b/tactics/allScheme.ml
@@ -293,22 +293,22 @@ let warn_lookup_not_found =
     Raise a warning if none is found. *)
 let lookup_all ind ind_nested 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 (GlobRef.IndRef ind_nested) 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 (GlobRef.IndRef ind_nested) with
         | Some ref_pred -> Some (false, ref_pred)
         | None -> warn_lookup_not_found (pred, ind, ind_nested); None
 
 (** Lookup the [all] predicate, and its theorem *)
 let lookup_all_theorem_aux ind ind_nested =
   let (_, (pred, thm)) = default_suffix in
-  match DeclareScheme.lookup_scheme_opt pred ind_nested with
+  match DeclareScheme.lookup_scheme_opt pred (GlobRef.IndRef ind_nested) with
   | None -> warn_lookup_not_found (pred, ind, ind_nested); None
   | Some ref_pred ->
-      match DeclareScheme.lookup_scheme_opt thm ind_nested with
+      match DeclareScheme.lookup_scheme_opt thm (GlobRef.IndRef ind_nested) with
       | None -> warn_lookup_not_found (thm, ind, ind_nested); None
       | Some ref_thm -> Some (false, ref_pred, ref_thm)
 
@@ -318,10 +318,10 @@ let lookup_all_theorem_aux ind ind_nested =
     Raise a warning if none is found. *)
 let lookup_all_theorem ind ind_nested args_are_nested =
   let (_, (pred, thm)) = partial_suffix args_are_nested in
-  match DeclareScheme.lookup_scheme_opt pred ind_nested with
+  match DeclareScheme.lookup_scheme_opt pred (GlobRef.IndRef ind_nested) with
   | None -> lookup_all_theorem_aux ind ind_nested
   | Some ref_pred ->
-      match DeclareScheme.lookup_scheme_opt  thm ind_nested with
+      match DeclareScheme.lookup_scheme_opt thm (GlobRef.IndRef ind_nested) with
       | Some ref_thm ->
           Some (true, ref_pred, ref_thm)
       | None ->
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/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/test-suite/success/SchemeSectionVariable.v b/test-suite/success/SchemeSectionVariable.v
new file mode 100644
index 000000000000..5ff886c8a324
--- /dev/null
+++ b/test-suite/success/SchemeSectionVariable.v
@@ -0,0 +1,10 @@
+(** Test that scheme registrations for section variables require #[local]. *)
+
+Axiom foo : Type.
+
+Section S1.
+  Variable A : Type.
+  Fail #[export] Register Scheme foo as rew_r_dep for A.
+  Fail Global Register Scheme foo as rew_r_dep for A.
+  #[local] Register Scheme foo as rew_r_dep for A.
+End S1.
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 a4aec5e2ce3b..2480c64fe0d3 100644
--- a/vernac/declare.ml
+++ b/vernac/declare.ml
@@ -484,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
diff --git a/vernac/g_vernac.mlg b/vernac/g_vernac.mlg
index 5a5189fb8253..6353224e16cb 100644
--- a/vernac/g_vernac.mlg
+++ b/vernac/g_vernac.mlg
@@ -296,7 +296,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 ->
diff --git a/vernac/indschemes.ml b/vernac/indschemes.ml
index 835bb013e702..8a5999588fda 100644
--- a/vernac/indschemes.ml
+++ b/vernac/indschemes.ml
@@ -423,7 +423,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
@@ -555,7 +555,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
 
@@ -581,7 +581,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 =
diff --git a/vernac/ppvernac.ml b/vernac/ppvernac.ml
index 52e42939cfd6..6cc62cc72803 100644
--- a/vernac/ppvernac.ml
+++ b/vernac/ppvernac.ml
@@ -1280,11 +1280,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 (
diff --git a/vernac/vernacentries.ml b/vernac/vernacentries.ml
index 00e726f37cb2..f959ddcf1fc6 100644
--- a/vernac/vernacentries.ml
+++ b/vernac/vernacentries.ml
@@ -375,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
@@ -2380,7 +2380,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 *)
@@ -2395,9 +2395,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
diff --git a/vernac/vernacexpr.mli b/vernac/vernacexpr.mli
index f1d6e80d11ab..6b29f49bf38b 100644
--- a/vernac/vernacexpr.mli
+++ b/vernac/vernacexpr.mli
@@ -304,7 +304,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} *)
 

From a623b4aa99ee2800df014e8346ab4757ba6d58f7 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Sat, 28 Mar 2026 20:16:02 +0100
Subject: [PATCH 329/578] remove unused argument in ltac2 type normalization

---
 plugins/ltac2/tac2typing_env.ml | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/plugins/ltac2/tac2typing_env.ml b/plugins/ltac2/tac2typing_env.ml
index 1c64acf0fac4..a50be8688de4 100644
--- a/plugins/ltac2/tac2typing_env.ml
+++ b/plugins/ltac2/tac2typing_env.ml
@@ -254,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
@@ -273,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 *)

From 412bbd8c24dbe16ba3c45ae6ae949818373da8ee Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Sat, 28 Mar 2026 20:26:51 +0100
Subject: [PATCH 330/578] Simpler implementation of with_strategy

Now that we don't need to modify the global env and only do
backtrackable state effects we don't need WRAPFINALLY.
---
 tactics/tactics.ml | 52 ++++++++--------------------------------------
 1 file changed, 9 insertions(+), 43 deletions(-)

diff --git a/tactics/tactics.ml b/tactics/tactics.ml
index 625c2b68c3d4..e03e6fccf858 100644
--- a/tactics/tactics.ml
+++ b/tactics/tactics.ml
@@ -3199,38 +3199,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
@@ -3254,17 +3222,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 *)

From fb484c4db8c48047917f6a7b62714ca9329544a2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Mon, 30 Mar 2026 13:54:18 +0200
Subject: [PATCH 331/578] Declaremods remove "typexpr" from staging functors

It was only used in places which could be polymorphic.
---
 vernac/declaremods.ml | 19 +++++--------------
 1 file changed, 5 insertions(+), 14 deletions(-)

diff --git a/vernac/declaremods.ml b/vernac/declaremods.ml
index 560f598a62bb..548e8487af0b 100644
--- a/vernac/declaremods.ml
+++ b/vernac/declaremods.ml
@@ -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
@@ -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} *)

From 9a10b0bde54075c73f896d92b8933892c862a9e6 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Mon, 30 Mar 2026 15:21:46 +0200
Subject: [PATCH 332/578] Fix staging of Inline Level goption

It's used in synterp.
---
 vernac/declaremods.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/vernac/declaremods.ml b/vernac/declaremods.ml
index 560f598a62bb..abf7f24893bf 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())
 

From 2eaea0cee3f07c6fcf143d2447f9e9ae681e5109 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Fri, 27 Mar 2026 11:42:46 +0100
Subject: [PATCH 333/578] Stop accepting non-globref hints from Hints.

We now perform this check at the level of the tactics that call the underlying
Hints API and simply ignore the hints when they are not globals. For backwards
compatibility syntax-wise, we still allow expressions that evaluate to globrefs
up to implicits.
---
 tactics/auto.ml   | 20 +++++++++++++++
 tactics/auto.mli  |  2 ++
 tactics/eauto.ml  |  3 +++
 tactics/hints.ml  | 62 ++++-------------------------------------------
 tactics/hints.mli |  3 +--
 5 files changed, 31 insertions(+), 59 deletions(-)

diff --git a/tactics/auto.ml b/tactics/auto.ml
index 0cf97a2563f9..ad80ce49bd24 100644
--- a/tactics/auto.ml
+++ b/tactics/auto.ml
@@ -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/eauto.ml b/tactics/eauto.ml
index 89249b4e7a0e..ca3e4b9902c5 100644
--- a/tactics/eauto.ml
+++ b/tactics/eauto.ml
@@ -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
diff --git a/tactics/hints.ml b/tactics/hints.ml
index b7f40e197aaf..5bd71da9ac09 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
@@ -128,7 +126,6 @@ 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;
@@ -899,7 +896,6 @@ let make_exact_entry env sigma info ?name (c, cty, ctx) =
 
 let name_of_hint = function
 | IsGlobRef gr -> Some gr
-| IsConstr _ -> None
 
 let make_apply_entry env sigma hnf info ?name (c, cty, ctx) =
   let cty = if hnf then hnf_constr0 env sigma cty else cty in
@@ -943,7 +939,6 @@ let fresh_global_or_constr env sigma cr = match cr with
   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
@@ -1470,42 +1465,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.")
@@ -1546,26 +1505,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
+    | GlobRef.ConstRef cst -> [IsGlobRef (GlobRef.ConstRef cst)]
+    | GlobRef.VarRef id -> [IsGlobRef (GlobRef.VarRef id)]
+    | GlobRef.ConstructRef cstr -> [IsGlobRef (GlobRef.ConstructRef cstr)]) lems
 (* builds a hint database from a constr signature *)
 (* typically used with (lid, ltyp) = pf_hyps_types <some goal> *)
 
diff --git a/tactics/hints.mli b/tactics/hints.mli
index 19dc0bae1f3e..7d9ad323c735 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. } *)
@@ -218,7 +217,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
 

From 1f584df35a29167c7eab816bb7ad83f00bc2c93e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Mon, 30 Mar 2026 20:26:27 +0200
Subject: [PATCH 334/578] Document the removal of the non-reference using
 clauses.

---
 .../04-tactics/21833-rm-non-global-hint-Removed.rst       | 5 +++++
 doc/sphinx/proofs/automatic-tactics/auto.rst              | 8 ++++++++
 2 files changed, 13 insertions(+)
 create mode 100644 doc/changelog/04-tactics/21833-rm-non-global-hint-Removed.rst

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 <https://github.com/rocq-prover/rocq/pull/21833>`_,
+  by Pierre-Marie Pédrot).
diff --git a/doc/sphinx/proofs/automatic-tactics/auto.rst b/doc/sphinx/proofs/automatic-tactics/auto.rst
index 0f62a9ebdd39..4d57b51e0432 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

From 35f36f7730569d80e8d9558a3f568e529a8ccab0 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Mon, 30 Mar 2026 18:23:36 +0200
Subject: [PATCH 335/578] Add overlays.

---
 dev/ci/user-overlays/21833-ppedrot-rm-non-global-hint.sh | 1 +
 1 file changed, 1 insertion(+)
 create mode 100644 dev/ci/user-overlays/21833-ppedrot-rm-non-global-hint.sh

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

From e175de8cde3ab2032f0c6fe252bcf45936884f6c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Tue, 31 Mar 2026 11:02:35 +0200
Subject: [PATCH 336/578] Add test for #19971.

Fix #19971: Anomaly "File "kernel/indTyping.ml", line 345.
---
 test-suite/bugs/bug_19971.v | 3 +++
 1 file changed, 3 insertions(+)
 create mode 100644 test-suite/bugs/bug_19971.v

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 := .

From d7bd6cb4c2c6d15cb9680ed6e96672739bc83204 Mon Sep 17 00:00:00 2001
From: Pierre Roux <pierre.roux@onera.fr>
Date: Tue, 31 Mar 2026 11:25:59 +0200
Subject: [PATCH 337/578] [CI] Cleanup elpi script

That make dune-files thing is no longer necessary
---
 dev/ci/scripts/ci-elpi.sh | 1 -
 1 file changed, 1 deletion(-)

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"
 )

From fbf7a266e71531f473deae4a8274f39a1b4b7d89 Mon Sep 17 00:00:00 2001
From: Pierre Roux <pierre.roux@onera.fr>
Date: Tue, 31 Mar 2026 10:37:52 +0200
Subject: [PATCH 338/578] Remove the deprecated nonuniform attribute

This was deprecated since 8.18.
---
 doc/sphinx/addendum/implicit-coercions.rst |  8 --------
 doc/sphinx/changes.rst                     |  4 ++--
 test-suite/output/coercions_nonuniform.v   |  2 +-
 vernac/comCoercion.ml                      |  2 --
 vernac/comCoercion.mli                     |  4 ----
 vernac/synterp.ml                          | 12 ------------
 6 files changed, 3 insertions(+), 29 deletions(-)

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/changes.rst b/doc/sphinx/changes.rst
index 6450a6b721e3..bfb8aa7ae9f8 100644
--- a/doc/sphinx/changes.rst
+++ b/doc/sphinx/changes.rst
@@ -4095,7 +4095,7 @@ Commands and options
   (`#17333 <https://github.com/rocq-prover/rocq/pull/17333>`_,
   by Gaëtan Gilbert).
 - **Deprecated:**
-  the :attr:`nonuniform` attribute,
+  the ``nonuniform`` attribute,
   now subsumed by :attr:`warnings` with "-uniform-inheritance"
   (`#17716 <https://github.com/rocq-prover/rocq/pull/17716>`_,
   by Pierre Roux).
@@ -5640,7 +5640,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 <https://github.com/rocq-prover/rocq/pull/15853>`_,
diff --git a/test-suite/output/coercions_nonuniform.v b/test-suite/output/coercions_nonuniform.v
index 583029ebc6cc..9278927c5411 100644
--- a/test-suite/output/coercions_nonuniform.v
+++ b/test-suite/output/coercions_nonuniform.v
@@ -1,4 +1,4 @@
-(* Test the nonuniform attribute to silence warnings on coercions
+(* Test the uniform-inheritance warning to silence warnings on coercions
    not satisfying the non uniform inheritance condition. *)
 
 Module Test0.
diff --git a/vernac/comCoercion.ml b/vernac/comCoercion.ml
index 944889b8b7d0..21e137aa4ec6 100644
--- a/vernac/comCoercion.ml
+++ b/vernac/comCoercion.ml
@@ -374,8 +374,6 @@ let subclass_hook ~poly ~reversible = Declare.Hook.make @@ fun { scope; dref; _
   let loc = Nametab.cci_src_loc (TrueGlobal dref) in
   try_add_new_coercion_subclass ?loc cl ~local:stre ~poly ~reversible
 
-let nonuniform = Attributes.bool_attribute ~name:"nonuniform"
-
 let warn_reverse_no_change =
   CWarnings.create ~name:"reversible-no-change" ~category:CWarnings.CoreCategories.coercions
     (fun () -> str "The reversible attribute is unchanged.")
diff --git a/vernac/comCoercion.mli b/vernac/comCoercion.mli
index bf2bed078870..73c7200a3171 100644
--- a/vernac/comCoercion.mli
+++ b/vernac/comCoercion.mli
@@ -54,8 +54,4 @@ 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/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 ->

From 1b6e88c1d349af4ad188c84df79fad3a4bc58aa8 Mon Sep 17 00:00:00 2001
From: Yann Leray <yann.leray@inria.fr>
Date: Tue, 31 Mar 2026 12:00:06 +0200
Subject: [PATCH 339/578] Fix guard environments in subterm_specif on fixpoints

---
 kernel/inductive.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/kernel/inductive.ml b/kernel/inductive.ml
index 4c7dd71807b8..8204e00fe48c 100644
--- a/kernel/inductive.ml
+++ b/kernel/inductive.ml
@@ -1264,7 +1264,7 @@ let rec subterm_specif ?evars renv stack t =
         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
+        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

From cc1ae2e5f98c501e51362d971b3f5f7325663b50 Mon Sep 17 00:00:00 2001
From: Yann Leray <yann.leray@inria.fr>
Date: Mon, 30 Mar 2026 15:44:23 +0200
Subject: [PATCH 340/578] Test, changelog

---
 dev/doc/critical-bugs.md                              | 11 +++++++++++
 .../01-kernel/21845-guard-fix-subterm-Fixed.rst       |  5 +++++
 test-suite/bugs/bug_21839.v                           |  5 +++++
 3 files changed, 21 insertions(+)
 create mode 100644 doc/changelog/01-kernel/21845-guard-fix-subterm-Fixed.rst
 create mode 100644 test-suite/bugs/bug_21839.v

diff --git a/dev/doc/critical-bugs.md b/dev/doc/critical-bugs.md
index 24f55ce7d6ed..d263ad98207b 100644
--- a/dev/doc/critical-bugs.md
+++ b/dev/doc/critical-bugs.md
@@ -29,6 +29,7 @@ This file recollects knowledge about critical bugs found in Coq since version 8.
       - [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)
     - [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)
@@ -323,6 +324,16 @@ and lack of checking of relevance marks on constants in coqchk
 - 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)
+
 ### Module system
 
 #### missing universe constraints in typing "with" clause of a module type
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 <https://github.com/rocq-prover/rocq/pull/21845>`_,
+  fixes `#21839 <https://github.com/rocq-prover/rocq/issues/21839>`_,
+  by Yann Leray).
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.

From c0bd2ec627e51011bc82ea31f0147ba5a770e683 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Tue, 31 Mar 2026 14:46:40 +0200
Subject: [PATCH 341/578] Add a test for #9714.

Fixes #9714: Error: Anomaly "File "pretyping/cases.ml", line 1694.
---
 test-suite/bugs/bug_9714.v | 27 +++++++++++++++++++++++++++
 1 file changed, 27 insertions(+)
 create mode 100644 test-suite/bugs/bug_9714.v

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/. *)

From aade9d8a932e6a8f8938525fd8958b638b584312 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Tue, 31 Mar 2026 15:37:58 +0200
Subject: [PATCH 342/578] Add `.` at end of warning message

---
 tactics/auto.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/tactics/auto.ml b/tactics/auto.ml
index ad80ce49bd24..85ca53b315e9 100644
--- a/tactics/auto.ml
+++ b/tactics/auto.ml
@@ -337,7 +337,7 @@ and tac_of_hint dbg db_list local_db concl =
 
 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")
+    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 =

From cabc0d0fd0a940ec111fa862250d871dc0b4617b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Tue, 31 Mar 2026 15:35:17 +0200
Subject: [PATCH 343/578] Stop relying on canonical names in VM internals.

The only possible effect is on efficiency, but even for that it should not
matter that much since it is unlikely we spam the VM with aliased references.
---
 kernel/vmemitcodes.ml | 4 ++--
 kernel/vmvalues.ml    | 8 ++++----
 2 files changed, 6 insertions(+), 6 deletions(-)

diff --git a/kernel/vmemitcodes.ml b/kernel/vmemitcodes.ml
index af273b69cd07..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
diff --git a/kernel/vmvalues.ml b/kernel/vmvalues.ml
index 48b3630db83a..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)
@@ -252,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
@@ -443,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)

From 1b1092923559ec968bf41c682cfc5fa5619f65be Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Mon, 30 Mar 2026 15:27:25 +0200
Subject: [PATCH 344/578] Use regular recursion instead of hook for missing
 substobjs

---
 vernac/declaremods.ml | 84 +++++++++++++++++++++----------------------
 1 file changed, 41 insertions(+), 43 deletions(-)

diff --git a/vernac/declaremods.ml b/vernac/declaremods.ml
index 560f598a62bb..6dd4f55c66a5 100644
--- a/vernac/declaremods.ml
+++ b/vernac/declaremods.ml
@@ -310,37 +310,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 +688,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

From 5eb9423c24be9ac9dca8d9bd8c73fe295b2ea6ef Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Tue, 31 Mar 2026 17:28:48 +0200
Subject: [PATCH 345/578] Fix relevances in identity coercions

Fix #21799
---
 test-suite/bugs/bug_21799.v | 29 +++++++++++++++++++++++++++++
 vernac/comCoercion.ml       | 30 ++++++++++++++++--------------
 2 files changed, 45 insertions(+), 14 deletions(-)
 create mode 100644 test-suite/bugs/bug_21799.v

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/vernac/comCoercion.ml b/vernac/comCoercion.ml
index 944889b8b7d0..737efd8478ad 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

From 9c1cbecf8fcae2e76c14a05f29fc4df295f68df8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Tue, 31 Mar 2026 17:37:26 +0200
Subject: [PATCH 346/578] More specific anomalies in contract_case

Close #21824
---
 kernel/inductive.ml | 11 +++++++++--
 kernel/term.ml      | 13 +++++++++----
 kernel/term.mli     |  1 +
 3 files changed, 19 insertions(+), 6 deletions(-)

diff --git a/kernel/inductive.ml b/kernel/inductive.ml
index 8204e00fe48c..f8ab860b5f65 100644
--- a/kernel/inductive.ml
+++ b/kernel/inductive.ml
@@ -525,7 +525,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 *)
@@ -544,7 +547,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
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) *)

From dd76ede2c8c1fc4abbb34defa49d127b70a52d38 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Wed, 1 Apr 2026 14:30:44 +0200
Subject: [PATCH 347/578] Remove calls to CanOrd module in rewrite rule
 CClosure implementation.

---
 kernel/cClosure.ml | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/kernel/cClosure.ml b/kernel/cClosure.ml
index 43d429154dfc..ce7ad0d8e58b 100644
--- a/kernel/cClosure.ml
+++ b/kernel/cClosure.ml
@@ -1666,7 +1666,7 @@ and match_elim : 'a. ('a, 'a depth) reduction -> _ -> _ -> pat_state:'a depth ->
       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
@@ -1683,7 +1683,7 @@ and match_elim : 'a. ('a, 'a depth) reduction -> _ -> _ -> pat_state:'a depth ->
       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
@@ -1719,7 +1719,7 @@ and match_head red info tab ~pat_state next context states patterns t stk =
   | 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
@@ -1729,7 +1729,7 @@ and match_head red info tab ~pat_state next context states patterns t stk =
   | 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
@@ -1755,7 +1755,7 @@ and match_head red info tab ~pat_state next context states patterns t stk =
   | 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

From ed0485d705ded9720d1d79f4e34af915e0ff1368 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Wed, 1 Apr 2026 13:52:09 +0200
Subject: [PATCH 348/578] Move the dubious compare and hash functions from
 Constr to a Termops submodule.

These functions make very little sense in general as they mostly ignore most
invariants about terms. They are only used by plugins and thankfully never
in the kernel. Their main use seems to treat constr as a first-order data
type with an otherwise unspecified representation.
---
 engine/termops.ml               | 150 ++++++++++++++++++++++++++++++++
 engine/termops.mli              |  10 +++
 kernel/constr.ml                | 135 ----------------------------
 kernel/constr.mli               |   5 --
 plugins/btauto/refl_btauto.ml   |   2 +-
 plugins/cc/ccalgo.ml            |   4 +-
 plugins/firstorder/formula.ml   |   2 +-
 plugins/firstorder/instances.ml |   2 +-
 plugins/firstorder/unify.ml     |   2 +-
 plugins/micromega/zify.ml       |   4 +-
 plugins/ring/ring.ml            |   2 +-
 plugins/syntax/number_string.ml |   4 +-
 12 files changed, 171 insertions(+), 151 deletions(-)

diff --git a/engine/termops.ml b/engine/termops.ml
index ca847f029053..5d83d3ad1029 100644
--- a/engine/termops.ml
+++ b/engine/termops.ml
@@ -1282,3 +1282,153 @@ 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.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
+
+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.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
+
+end
diff --git a/engine/termops.mli b/engine/termops.mli
index 4b50dfffecbb..6b31af098160 100644
--- a/engine/termops.mli
+++ b/engine/termops.mli
@@ -239,6 +239,16 @@ 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
 
 (** NOTE: to print terms you always want to use functions in
diff --git a/kernel/constr.ml b/kernel/constr.ml
index 84a87787962c..a05c35c581e6 100644
--- a/kernel/constr.ml
+++ b/kernel/constr.ml
@@ -1012,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   *)
 (*******************)
@@ -1212,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
diff --git a/kernel/constr.mli b/kernel/constr.mli
index 53e10fccb545..c578e1d29798 100644
--- a/kernel/constr.mli
+++ b/kernel/constr.mli
@@ -426,9 +426,6 @@ 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
@@ -621,8 +618,6 @@ val eq_invert : ('a -> 'a -> bool)
 
 (** {6 Hashconsing} *)
 
-val hash : constr -> int
-
 (*********************************************************************)
 
 module GenHCons(C:sig
diff --git a/plugins/btauto/refl_btauto.ml b/plugins/btauto/refl_btauto.ml
index 7a1bb77ee2fb..40dbe50395a5 100644
--- a/plugins/btauto/refl_btauto.ml
+++ b/plugins/btauto/refl_btauto.ml
@@ -49,7 +49,7 @@ end
 
 module Env = struct
 
-  module ConstrHashtbl = Hashtbl.Make (Constr)
+  module ConstrHashtbl = Hashtbl.Make (Termops.ConstrData)
 
   type t = (int ConstrHashtbl.t * int ref)
 
diff --git a/plugins/cc/ccalgo.ml b/plugins/cc/ccalgo.ml
index c6f223563de4..3724149b3c1f 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
 
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/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/micromega/zify.ml b/plugins/micromega/zify.ml
index c5f259e08378..59e74b546bcb 100644
--- a/plugins/micromega/zify.ml
+++ b/plugins/micromega/zify.ml
@@ -120,7 +120,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
@@ -788,7 +788,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)
 
diff --git a/plugins/ring/ring.ml b/plugins/ring/ring.ml
index 7364b5eb0479..1eb530a77c39 100644
--- a/plugins/ring/ring.ml
+++ b/plugins/ring/ring.ml
@@ -330,7 +330,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"
 
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

From 050910bffd09c55edfd5408300649bc094547fd9 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Wed, 1 Apr 2026 15:07:25 +0200
Subject: [PATCH 349/578] Add overlays.

---
 .../21863-ppedrot-constr-type-as-first-order-data.sh  | 11 +++++++++++
 1 file changed, 11 insertions(+)
 create mode 100644 dev/ci/user-overlays/21863-ppedrot-constr-type-as-first-order-data.sh

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

From 980d5874390c4f8db659afca3dce78ccb4e331b8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Wed, 1 Apr 2026 16:58:22 +0200
Subject: [PATCH 350/578] coqdev.el regexp parser for rocqtop errors in refman

---
 dev/tools/coqdev.el | 10 ++++++++++
 1 file changed, 10 insertions(+)

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 ()

From cb504f4583ad471fc9eedaa4d64aeb22f64a44e7 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Wed, 1 Apr 2026 19:19:33 +0200
Subject: [PATCH 351/578] Added APIs for coqlsp

---
 pretyping/genConstr.ml  |  6 ++++++
 pretyping/genConstr.mli |  4 ++++
 tactics/gentactic.ml    | 31 ++++++++++++++++++++++++++++---
 tactics/gentactic.mli   | 24 +++++++++++++++++++++---
 4 files changed, 59 insertions(+), 6 deletions(-)

diff --git a/pretyping/genConstr.ml b/pretyping/genConstr.ml
index 0c6b14f750f4..c2254dcbf009 100644
--- a/pretyping/genConstr.ml
+++ b/pretyping/genConstr.ml
@@ -18,6 +18,12 @@ let eq t1 t2 = D.eq t1 t2
 
 let repr tag = D.repr tag
 
+type any_tag = Any : _ tag -> 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
diff --git a/pretyping/genConstr.mli b/pretyping/genConstr.mli
index 1858bb1c0fc0..4555266fda20 100644
--- a/pretyping/genConstr.mli
+++ b/pretyping/genConstr.mli
@@ -28,6 +28,10 @@ val eq : ('raw1, 'glb1) tag -> ('raw2, 'glb2) tag -> ('raw1 * 'glb1, 'raw2 * 'gl
 
 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
diff --git a/tactics/gentactic.ml b/tactics/gentactic.ml
index 66176796190a..585a15eafd58 100644
--- a/tactics/gentactic.ml
+++ b/tactics/gentactic.ml
@@ -12,12 +12,37 @@ open Names
 
 module TDyn = Dyn.Make()
 
+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)
+
+  type t = Self.t
+
+  let empty = Self.empty
+
+  let add tag x m = Self.add tag (V x) m
+
+  let mem tag m = Self.mem tag m
+
+  let find tag m = let V x = Self.find tag m in x
+end
+
 type ('raw, 'glb) tag = ('raw * 'glb) TDyn.tag
 
 type raw_generic_tactic = Raw : ('raw, _) tag * 'raw -> raw_generic_tactic
 
 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"
@@ -26,13 +51,13 @@ let of_raw (type a) (tag:(a, _) tag) (x:a) : raw_generic_tactic =
   Raw (tag, x)
 
 module Print = struct
-  type _ t = Print : {
+  type ('raw,'glb) t = Print of {
       raw_print : 'raw Genprint.printer;
       glb_print : 'glb Genprint.printer;
-    } -> ('raw * 'glb) t
+    }
 end
 
-module PrintMap = TDyn.Map(Print)
+module PrintMap = Map(Print)
 
 let printers = ref PrintMap.empty
 
diff --git a/tactics/gentactic.mli b/tactics/gentactic.mli
index 99018ad40337..ef93af6a0ec2 100644
--- a/tactics/gentactic.mli
+++ b/tactics/gentactic.mli
@@ -13,11 +13,20 @@ open Names
 
 (** 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
 
-type ('raw, 'glob) tag
+val repr : _ tag -> string
+
+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
@@ -49,3 +58,12 @@ val register_interp : (_, 'glb) tag -> (Geninterp.Val.t Id.Map.t -> 'glb -> 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
+
+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

From d80b6c5e4164098e9faa69fa394f4315672db8a6 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Wed, 1 Apr 2026 17:56:22 +0200
Subject: [PATCH 352/578] Stop relying on CanOrd in VM conversion.

We also fix a potential completeness bug introduced in #21856, after which
the VM would consider aliased but different constants to be non-convertible.
I was not able to expose it though, since all module constructions I tried
actually define aliases with a body set to their aliased value.
---
 kernel/vconv.ml | 11 +++++++++--
 1 file changed, 9 insertions(+), 2 deletions(-)

diff --git a/kernel/vconv.ml b/kernel/vconv.ml
index 91e7c645e830..c999836ecba5 100644
--- a/kernel/vconv.ml
+++ b/kernel/vconv.ml
@@ -51,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
@@ -120,7 +127,7 @@ 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 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
@@ -144,7 +151,7 @@ and conv_atom env pb k a1 stk1 a2 stk2 cu =
       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

From bb6b5a856397f149d5efd24fc04bfd4a28bfdc9f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Wed, 25 Mar 2026 22:19:17 +0100
Subject: [PATCH 353/578] Add a debug command to print information about
 delta-resolvers.

---
 dev/top_printers.ml     |  2 +-
 kernel/mod_subst.ml     | 22 +++++++++++-----------
 kernel/mod_subst.mli    |  2 +-
 vernac/g_vernac.mlg     |  1 +
 vernac/ppvernac.ml      |  6 ++++++
 vernac/vernacentries.ml | 25 +++++++++++++++++++++++++
 vernac/vernacexpr.mli   |  1 +
 7 files changed, 46 insertions(+), 13 deletions(-)

diff --git a/dev/top_printers.ml b/dev/top_printers.ml
index 8b16b69acbf0..e4a2c7717b12 100644
--- a/dev/top_printers.ml
+++ b/dev/top_printers.ml
@@ -224,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)
diff --git a/kernel/mod_subst.ml b/kernel/mod_subst.ml
index b05bf957ce20..f42cd75cfe4f 100644
--- a/kernel/mod_subst.ml
+++ b/kernel/mod_subst.ml
@@ -160,20 +160,23 @@ let is_empty_subst = Umap.is_empty
 
 (* <debug> *)
 
-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
+    (KerName.print kn ++ str " => " ++ string_of_hint pr hint) :: l
   in
   let mp_to_string mp mp' l =
-    (ModPath.to_string mp ^ "=>" ^ ModPath.to_string mp') :: l
+    (ModPath.print mp ++ str " => " ++ ModPath.print mp') :: l
   in
   let l = Deltamap.fold mp_to_string kn_to_string resolve [] in
-  String.concat ", " (List.rev l)
+  prlist_with_sep (fun () -> str ", ") (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 ++
diff --git a/kernel/mod_subst.mli b/kernel/mod_subst.mli
index d3bcf483120d..6d5b6e7cff07 100644
--- a/kernel/mod_subst.mli
+++ b/kernel/mod_subst.mli
@@ -111,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/vernac/g_vernac.mlg b/vernac/g_vernac.mlg
index 6353224e16cb..ce80d2ee3c02 100644
--- a/vernac/g_vernac.mlg
+++ b/vernac/g_vernac.mlg
@@ -1188,6 +1188,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 }
diff --git a/vernac/ppvernac.ml b/vernac/ppvernac.ml
index 6cc62cc72803..ccdf088cdf48 100644
--- a/vernac/ppvernac.ml
+++ b/vernac/ppvernac.ml
@@ -637,6 +637,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 ->
diff --git a/vernac/vernacentries.ml b/vernac/vernacentries.ml
index f6b1174d288e..2e2826a7dae3 100644
--- a/vernac/vernacentries.ml
+++ b/vernac/vernacentries.ml
@@ -2223,6 +2223,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 ()))
@@ -2266,6 +2290,7 @@ let vernac_print =
     v 0 (prlist_with_sep cut str paths )
   | PrintMLModules -> no_state Mltop.print_ml_modules
   | PrintDebugGC -> no_state Mltop.print_gc
+  | PrintDebugDelta qid -> no_state @@ fun () -> vernac_print_debug_delta qid
   | PrintName (qid,udecl) -> with_proof_env_and_opaques @@ fun ~opaque_access env sigma ->
     Prettyp.print_name opaque_access env sigma qid udecl
   | PrintGraph -> no_state Prettyp.print_graph
diff --git a/vernac/vernacexpr.mli b/vernac/vernacexpr.mli
index 6b29f49bf38b..bc9d6fd5e77a 100644
--- a/vernac/vernacexpr.mli
+++ b/vernac/vernacexpr.mli
@@ -53,6 +53,7 @@ type printable =
   | PrintMLLoadPath
   | PrintMLModules
   | PrintDebugGC
+  | PrintDebugDelta of qualid option
   | PrintName of qualid or_by_notation * UnivNames.univ_name_list option
   | PrintGraph
   | PrintClasses

From 5a6c0f89c0c0cc0f8afbbf491c59fe9b9e3ecdd9 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Wed, 1 Apr 2026 22:43:37 +0200
Subject: [PATCH 354/578] Document the new command.

---
 .../21867-pr-debug-delta-resolver-Added.rst                  | 5 +++++
 doc/sphinx/language/core/modules.rst                         | 5 +++++
 doc/tools/docgram/fullGrammar                                | 1 +
 doc/tools/docgram/orderedGrammar                             | 1 +
 4 files changed, 12 insertions(+)
 create mode 100644 doc/changelog/08-vernac-commands-and-options/21867-pr-debug-delta-resolver-Added.rst

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 <https://github.com/rocq-prover/rocq/pull/21867>`_,
+  by Pierre-Marie Pédrot).
diff --git a/doc/sphinx/language/core/modules.rst b/doc/sphinx/language/core/modules.rst
index 0bd74ebec5b6..6af63eb29f3a 100644
--- a/doc/sphinx/language/core/modules.rst
+++ b/doc/sphinx/language/core/modules.rst
@@ -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
diff --git a/doc/tools/docgram/fullGrammar b/doc/tools/docgram/fullGrammar
index dae9f38810e8..54fe8892b8a5 100644
--- a/doc/tools/docgram/fullGrammar
+++ b/doc/tools/docgram/fullGrammar
@@ -1423,6 +1423,7 @@ printable: [
 | "ML" "Path"
 | "ML" "Modules"
 | "Debug" "GC"
+| "Debug" "Delta" OPT qualid
 | "Graph"
 | "Classes"
 | "Typeclasses"
diff --git a/doc/tools/docgram/orderedGrammar b/doc/tools/docgram/orderedGrammar
index 2e7466bc2702..86852d2d0b00 100644
--- a/doc/tools/docgram/orderedGrammar
+++ b/doc/tools/docgram/orderedGrammar
@@ -767,6 +767,7 @@ command: [
 | "Print" "ML" "Path"
 | "Print" "ML" "Modules"
 | "Print" "Debug" "GC"
+| "Print" "Debug" "Delta" OPT qualid
 | "Print" "Graph"
 | "Print" "Classes"
 | "Print" "Typeclasses"

From 1acf082d947809f148b31f62274681d238a479f4 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Thu, 2 Apr 2026 11:39:34 +0200
Subject: [PATCH 355/578] VM/native Fix substitution of qualities in relevances
 of match branch binders

(non kernel bug, only in reification)

Fix #21871
---
 pretyping/nativenorm.ml     |  4 ++++
 pretyping/vnorm.ml          |  1 +
 test-suite/bugs/bug_21871.v | 40 +++++++++++++++++++++++++++++++++++++
 3 files changed, 45 insertions(+)
 create mode 100644 test-suite/bugs/bug_21871.v

diff --git a/pretyping/nativenorm.ml b/pretyping/nativenorm.ml
index c983c941768a..4803fd0dad69 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)
diff --git a/pretyping/vnorm.ml b/pretyping/vnorm.ml
index 631c09c72da5..a2316f1ba2e2 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)
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.

From fe79abf01d92437b65a9b0cb7a3ac0eee6e8494a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Thu, 2 Apr 2026 11:40:11 +0200
Subject: [PATCH 356/578] Clarify that expand_arity doesn't care about the
 relevances in its binder_annot argument

- by making the type polymorphic so it's enforced by parametricity
- add comment where it's important in vnorm/nativenorm
---
 kernel/environ.mli      | 10 ++++++----
 pretyping/nativenorm.ml |  1 +
 pretyping/vnorm.ml      |  1 +
 3 files changed, 8 insertions(+), 4 deletions(-)

diff --git a/kernel/environ.mli b/kernel/environ.mli
index 7b2db5101eaf..58c43725e226 100644
--- a/kernel/environ.mli
+++ b/kernel/environ.mli
@@ -271,11 +271,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
diff --git a/pretyping/nativenorm.ml b/pretyping/nativenorm.ml
index 4803fd0dad69..fea696a3867a 100644
--- a/pretyping/nativenorm.ml
+++ b/pretyping/nativenorm.ml
@@ -329,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
diff --git a/pretyping/vnorm.ml b/pretyping/vnorm.ml
index a2316f1ba2e2..12cefb981803 100644
--- a/pretyping/vnorm.ml
+++ b/pretyping/vnorm.ml
@@ -288,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

From 277c8272638174ef41e8d922cb4f2604c652fcc0 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Thu, 2 Apr 2026 13:46:46 +0200
Subject: [PATCH 357/578] Improve breaks in print debug delta

---
 kernel/mod_subst.ml | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/kernel/mod_subst.ml b/kernel/mod_subst.ml
index f42cd75cfe4f..29cc29c3657b 100644
--- a/kernel/mod_subst.ml
+++ b/kernel/mod_subst.ml
@@ -167,13 +167,13 @@ let string_of_hint pr = function
 
 let debug_pr_delta pr resolve =
   let kn_to_string kn hint l =
-    (KerName.print kn ++ str " => " ++ string_of_hint pr hint) :: l
+    hov 2 (KerName.print kn ++ str " =>" ++ spc() ++ string_of_hint pr hint) :: l
   in
   let mp_to_string mp mp' l =
-    (ModPath.print mp ++ str " => " ++ ModPath.print 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
-  prlist_with_sep (fun () -> str ", ") (fun p -> p) (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

From 2c3c1c4cb097b9b74c6317d572afeeff0177733b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Thu, 2 Apr 2026 15:19:28 +0200
Subject: [PATCH 358/578] Add CODEOWNERS entry for ssrrewrite

---
 .github/CODEOWNERS | 1 +
 1 file changed, 1 insertion(+)

diff --git a/.github/CODEOWNERS b/.github/CODEOWNERS
index bb20bb8e54dc..b954b5420f51 100644
--- a/.github/CODEOWNERS
+++ b/.github/CODEOWNERS
@@ -167,6 +167,7 @@ LICENSE                     @rocq-prover/contributing-process-maintainers
 /theories/Corelib/ssrmatching/  @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

From 8b5007b88de2acebe98679c08c4ffd6f67a55eb6 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Mon, 30 Mar 2026 19:15:41 +0200
Subject: [PATCH 359/578] Further internal cleanups in Hints.

Now that we only accept references in databases, we can simplify some
internals of the Hints module.
---
 tactics/hints.ml | 30 +++++++++++-------------------
 1 file changed, 11 insertions(+), 19 deletions(-)

diff --git a/tactics/hints.ml b/tactics/hints.ml
index 5bd71da9ac09..e89d56d5be73 100644
--- a/tactics/hints.ml
+++ b/tactics/hints.ml
@@ -124,9 +124,6 @@ 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
-
 type 'a with_uid = {
   obj : 'a;
   uid : KerName.t;
@@ -894,9 +891,6 @@ let make_exact_entry env sigma info ?name (c, cty, ctx) =
            db = (); secvars;
            code = with_uid (Give_exact h); })
 
-let name_of_hint = function
-| IsGlobRef gr -> Some gr
-
 let make_apply_entry env sigma hnf info ?name (c, cty, ctx) =
   let cty = if hnf then hnf_constr0 env sigma cty else cty in
   match EConstr.kind sigma cty with
@@ -934,15 +928,13 @@ 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 fresh_global_hint env sigma 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)
 
 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 c, ctx = fresh_global_hint env sigma cr in
   let cty = Retyping.get_type_of env sigma c in
   let try_apply f =
     try
@@ -953,8 +945,8 @@ let make_resolves env sigma (eapply, hnf) info ~check cr =
     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 ~name:cr;
+                              make_apply_entry env sigma hnf info ~name:cr]
   in
   if check && List.is_empty ents then
     user_err
@@ -1018,7 +1010,7 @@ let make_mode ref 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, 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 hd = head_constr sigma t in
@@ -1378,7 +1370,7 @@ 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 } ->
@@ -1510,10 +1502,10 @@ let expand_constructor_hints env sigma lems =
     match lem with
     | GlobRef.IndRef ind ->
         List.init (nconstructors env ind)
-                  (fun i -> IsGlobRef (GlobRef.ConstructRef ((ind,i+1))))
-    | GlobRef.ConstRef cst -> [IsGlobRef (GlobRef.ConstRef cst)]
-    | GlobRef.VarRef id -> [IsGlobRef (GlobRef.VarRef id)]
-    | GlobRef.ConstructRef cstr -> [IsGlobRef (GlobRef.ConstructRef cstr)]) 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 <some goal> *)
 
@@ -1555,7 +1547,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 =

From 35c04a88d498c91ec4afcda9805ac7cd902965f7 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Tue, 31 Mar 2026 16:41:31 +0200
Subject: [PATCH 360/578] Inline global instance generation in Hints internals.

This changes an output test because we generate two different
instances for apply and eapply hints, and the names matter for
printing.
---
 tactics/hints.ml                  | 49 ++++++++++++++-----------------
 test-suite/output/UnivBinders.out |  6 ++--
 2 files changed, 25 insertions(+), 30 deletions(-)

diff --git a/tactics/hints.ml b/tactics/hints.ml
index e89d56d5be73..2a4b0b7af3ea 100644
--- a/tactics/hints.ml
+++ b/tactics/hints.ml
@@ -29,8 +29,6 @@ open Patternops
 open Tacred
 open Printer
 
-module NamedDecl = Context.Named.Declaration
-
 (****************************************)
 (* General functions                    *)
 (****************************************)
@@ -870,7 +868,15 @@ let secvars_of_constr env sigma c =
 let secvars_of_global env gr =
   secvars_of_idset (vars_of_global env gr)
 
-let make_exact_entry env sigma info ?name (c, cty, ctx) =
+let fresh_global_hint env sigma gr =
+  let (c, ctx) = UnivGen.fresh_global_instance env gr in
+  let c = EConstr.of_constr c in
+  let ctx = if Environ.is_polymorphic env gr then Some ctx else None in
+  let cty = Retyping.get_type_of env sigma c in
+  (c, cty, ctx)
+
+let make_exact_entry env sigma info gr =
+  let (c, cty, ctx) = fresh_global_hint env sigma gr in
   let secvars = secvars_of_constr env sigma c in
   let cty = strip_outer_cast sigma cty in
     match EConstr.kind sigma cty with
@@ -887,11 +893,12 @@ 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 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 _ ->
@@ -913,13 +920,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"
@@ -928,41 +935,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_hint env sigma 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)
-
 let make_resolves env sigma (eapply, hnf) info ~check cr =
-  let c, ctx = fresh_global_hint 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:cr;
-                              make_apply_entry env sigma hnf info ~name:cr]
+                             [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.")
@@ -1009,16 +1005,15 @@ let make_mode ref m =
     else m'
 
 let make_trivial env sigma r =
-  let name = Some r in
-  let c, ctx = fresh_global_hint env sigma 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;
      code= with_uid (Res_pf_THEN_trivial_fail h) })
diff --git a/test-suite/output/UnivBinders.out b/test-suite/output/UnivBinders.out
index 29badc0be435..b700a2f8393d 100644
--- a/test-suite/output/UnivBinders.out
+++ b/test-suite/output/UnivBinders.out
@@ -211,9 +211,9 @@ block).
 foo@{i} = Type@{M.i} -> Type@{i}
      : Type@{max(M.i+1,i+1)}
 (* i |=  *)
-Type@{u0} -> Type@{UnivBinders.85}
-     : Type@{max(u0+1,UnivBinders.85+1)}
-(* {UnivBinders.85} |=  *)
+Type@{u0} -> Type@{UnivBinders.86}
+     : Type@{max(u0+1,UnivBinders.86+1)}
+(* {UnivBinders.86} |=  *)
 bind_univs.mono = Type@{bind_univs.mono.u}
      : Type@{bind_univs.mono.u+1}
 bind_univs.poly@{u} = Type@{u}

From 2c3d893c754a094833e60fdc655af73dd84e4149 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Wed, 1 Apr 2026 12:17:42 +0200
Subject: [PATCH 361/578] Finer global invariants in Hints.

We know that all hints are now global references, so we enforce this
here and there.

This changes a little bit the output of some tests because references
are not printed through notations.
---
 tactics/hints.ml                   | 44 ++++++++++++++----------------
 test-suite/output/HintLocality.out |  8 +++---
 2 files changed, 25 insertions(+), 27 deletions(-)

diff --git a/tactics/hints.ml b/tactics/hints.ml
index 2a4b0b7af3ea..298a4dfb209b 100644
--- a/tactics/hints.ml
+++ b/tactics/hints.ml
@@ -128,14 +128,14 @@ type 'a with_uid = {
 }
 
 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;
@@ -188,7 +188,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
@@ -385,7 +385,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
@@ -862,22 +862,20 @@ let secvars_of_idset s =
         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)
 
 let fresh_global_hint env sigma gr =
   let (c, ctx) = UnivGen.fresh_global_instance env gr in
-  let c = EConstr.of_constr c 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 c in
-  (c, cty, ctx)
+  let cty = Retyping.get_type_of env sigma (mkRef (gr, u)) in
+  ((gr, u), cty, ctx)
 
 let make_exact_entry env sigma info gr =
   let (c, cty, ctx) = fresh_global_hint env sigma gr in
-  let secvars = secvars_of_constr env sigma c 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"
@@ -904,14 +902,14 @@ let make_apply_entry env sigma hnf info gr =
   | 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)
@@ -1015,7 +1013,7 @@ let make_trivial env sigma r =
      pat = Some DefaultPattern;
      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) })
 
 
@@ -1194,10 +1192,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
@@ -1370,15 +1368,15 @@ let add_resolves env sigma clist ~locality dbnames =
       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 "."
@@ -1553,7 +1551,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)
@@ -1756,11 +1754,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/test-suite/output/HintLocality.out b/test-suite/output/HintLocality.out
index 87c0347c3078..cba590b8db29 100644
--- a/test-suite/output/HintLocality.out
+++ b/test-suite/output/HintLocality.out
@@ -40,7 +40,7 @@ Unfoldable constant definitions: all
 Unfoldable projection definitions: all
 Cut: emp
 For any goal ->   
-For nat ->   simple apply 0 ; trivial (cost 1, pattern nat, id 0)
+For nat ->   simple apply O ; trivial (cost 1, pattern nat, id 0)
 
 Non-discriminated database
 Unfoldable variable definitions: all
@@ -48,7 +48,7 @@ Unfoldable constant definitions: all
 Unfoldable projection definitions: all
 Cut: emp
 For any goal ->   
-For nat ->   simple apply 0 ; trivial (cost 1, pattern nat, id 0)
+For nat ->   simple apply O ; trivial (cost 1, pattern nat, id 0)
 
 Non-discriminated database
 Unfoldable variable definitions: all
@@ -65,7 +65,7 @@ Unfoldable constant definitions: all
 Unfoldable projection definitions: all
 Cut: emp
 For any goal ->   
-For nat ->   simple apply 0 ; trivial (cost 1, pattern nat, id 0)
+For nat ->   simple apply O ; trivial (cost 1, pattern nat, id 0)
 
 Non-discriminated database
 Unfoldable variable definitions: all
@@ -95,7 +95,7 @@ Unfoldable projection definitions: all
 Cut: _
 For any goal ->   
 For S (modes !) ->   
-For nat ->   simple apply 0 ; trivial (cost 1, pattern nat, id 0)
+For nat ->   simple apply O ; trivial (cost 1, pattern nat, id 0)
 
 File "./output/HintLocality.v", line 92, characters 0-39:
 Warning: This hint is not local but depends on a section variable. It will

From 5acce278e907bb85116a2c7493bd360ba6a7374e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Thu, 2 Apr 2026 15:28:25 +0200
Subject: [PATCH 362/578] Document the changes and add a test.

---
 .../21862-cleanup-hints-globref-Changed.rst   |  9 ++++++
 test-suite/bugs/bug_21862.v                   | 30 +++++++++++++++++++
 2 files changed, 39 insertions(+)
 create mode 100644 doc/changelog/04-tactics/21862-cleanup-hints-globref-Changed.rst
 create mode 100644 test-suite/bugs/bug_21862.v

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 <https://github.com/rocq-prover/rocq/pull/21862>`_,
+  by Pierre-Marie Pédrot).
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.

From 5813811338527d57ac152ce0cc57409bebf62274 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Thu, 2 Apr 2026 15:45:24 +0200
Subject: [PATCH 363/578] Make it possible to warn when interning a TACTIC
 EXTEND + use for ssr rewrite

---
 coqpp/coqpp_ast.mli                    |  6 +++++-
 coqpp/coqpp_lex.mll                    |  1 +
 coqpp/coqpp_main.ml                    |  3 ++-
 coqpp/coqpp_parse.mly                  |  5 +++--
 plugins/ltac/tacentries.ml             | 15 +++++++++++----
 plugins/ltac/tacentries.mli            |  1 +
 plugins/ltac/tacenv.ml                 | 15 ++++++++++++---
 plugins/ltac/tacenv.mli                |  6 +++++-
 plugins/ltac/tacintern.ml              |  7 ++++++-
 plugins/ssr/ssrparser.mlg              |  2 +-
 plugins/ssrrewrite/ssrrewrite.mlg      | 12 +++++++-----
 test-suite/output/warn_ssr_rewrite.out | 10 ++++++++++
 test-suite/output/warn_ssr_rewrite.v   | 13 +++++++++++++
 13 files changed, 77 insertions(+), 19 deletions(-)
 create mode 100644 test-suite/output/warn_ssr_rewrite.out
 create mode 100644 test-suite/output/warn_ssr_rewrite.v

diff --git a/coqpp/coqpp_ast.mli b/coqpp/coqpp_ast.mli
index 471d2d9f28e2..d63843d63260 100644
--- a/coqpp/coqpp_ast.mli
+++ b/coqpp/coqpp_ast.mli
@@ -94,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;
 }
 
diff --git a/coqpp/coqpp_lex.mll b/coqpp/coqpp_lex.mll
index 36008855f1e7..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 }
diff --git a/coqpp/coqpp_main.ml b/coqpp/coqpp_main.ml
index 31868f245f54..ff3c74100ca7 100644
--- a/coqpp/coqpp_main.ml
+++ b/coqpp/coqpp_main.ml
@@ -547,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
diff --git a/coqpp/coqpp_parse.mly b/coqpp/coqpp_parse.mly
index 5b8bd248c99e..b2129bc8e1cf 100644
--- a/coqpp/coqpp_parse.mly
+++ b/coqpp/coqpp_parse.mly
@@ -67,7 +67,7 @@ let rhs_loc n =
 %token <string> IDENT QUALID
 %token <string> STRING
 %token <int> 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
@@ -279,7 +279,8 @@ tactic_extend:
 
 tactic_deprecated:
 | { None }
-| DEPRECATED CODE { Some $2 }
+| DEPRECATED CODE { Some (Depr $2) }
+| WARN CODE { Some (Warn $2) }
 ;
 
 tactic_level:
diff --git a/plugins/ltac/tacentries.ml b/plugins/ltac/tacentries.ml
index e8381ae1a2bb..8b28a88024bc 100644
--- a/plugins/ltac/tacentries.ml
+++ b/plugins/ltac/tacentries.ml
@@ -331,7 +331,10 @@ 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 =
@@ -410,7 +413,9 @@ let synterp_add_ml_tactic_notation name ~level ?deprecation prods =
     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 }
+    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
@@ -719,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;
@@ -745,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)
@@ -753,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 =
diff --git a/plugins/ltac/tacentries.mli b/plugins/ltac/tacentries.mli
index 91cca039aebf..7afc5483b6b3 100644
--- a/plugins/ltac/tacentries.mli
+++ b/plugins/ltac/tacentries.mli
@@ -102,6 +102,7 @@ type _ 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 :
diff --git a/plugins/ltac/tacenv.ml b/plugins/ltac/tacenv.ml
index 8a545c314a81..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"
@@ -85,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
@@ -93,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 660fd865c0f4..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 *)
 
@@ -95,8 +96,11 @@ type ml_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/tacintern.ml b/plugins/ltac/tacintern.ml
index ce18836e782c..b9c3762ac797 100644
--- a/plugins/ltac/tacintern.ml
+++ b/plugins/ltac/tacintern.ml
@@ -605,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) ->
diff --git a/plugins/ssr/ssrparser.mlg b/plugins/ssr/ssrparser.mlg
index 3ab565e3dd48..30e70f5f6e33 100644
--- a/plugins/ssr/ssrparser.mlg
+++ b/plugins/ssr/ssrparser.mlg
@@ -86,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
diff --git a/plugins/ssrrewrite/ssrrewrite.mlg b/plugins/ssrrewrite/ssrrewrite.mlg
index cf1667041ffa..c50cf3fe7dfd 100644
--- a/plugins/ssrrewrite/ssrrewrite.mlg
+++ b/plugins/ssrrewrite/ssrrewrite.mlg
@@ -23,6 +23,11 @@ let warn_deprecated_rewrite =
     ~quickfix:(fun ~loc () -> [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"
@@ -70,12 +75,9 @@ END
 
 (** The "rewrite" tactic *)
 
-TACTIC EXTEND ssrrewrite
+TACTIC EXTEND ssrrewrite WARN { warn_deprecated_rewrite }
   | [ "rewrite" ssrrewriteargs(args) ssrclauses(clauses) ] ->
-    { let loc = Tacinterp.extract_loc ist
-        |> Option.map (fun l -> Loc.sub l 0 7) in
-      warn_deprecated_rewrite ?loc ();
-      tclCLAUSES (ssrrewritetac ist args) clauses }
+    { tclCLAUSES (ssrrewritetac ist args) clauses }
 END
 
 {
diff --git a/test-suite/output/warn_ssr_rewrite.out b/test-suite/output/warn_ssr_rewrite.out
new file mode 100644
index 000000000000..2f490db00c07
--- /dev/null
+++ b/test-suite/output/warn_ssr_rewrite.out
@@ -0,0 +1,10 @@
+File "./output/warn_ssr_rewrite.v", line 4, characters 14-21:
+Warning: The 'rewrite' tactic has been renamed 'rw'.
+[rewrite-rw,deprecated-since-9.3,deprecated,default]
+Quickfix:
+Replace File "./output/warn_ssr_rewrite.v", line 4, characters 14-21 with rw
+File "./output/warn_ssr_rewrite.v", line 12, characters 2-9:
+Warning: The 'rewrite' tactic has been renamed 'rw'.
+[rewrite-rw,deprecated-since-9.3,deprecated,default]
+Quickfix:
+Replace File "./output/warn_ssr_rewrite.v", line 12, characters 2-9 with rw
diff --git a/test-suite/output/warn_ssr_rewrite.v b/test-suite/output/warn_ssr_rewrite.v
new file mode 100644
index 000000000000..240301281a19
--- /dev/null
+++ b/test-suite/output/warn_ssr_rewrite.v
@@ -0,0 +1,13 @@
+Require Import ssreflect.
+
+(* warns *)
+Ltac foo H := rewrite H.
+
+Goal forall x, x = x + 1 -> x = x + 2.
+Proof.
+  intros x H.
+  (* doesn't warn *)
+  foo H.
+  (* warns *)
+  rewrite H.
+Abort.

From 6571d1346fce4e7b585ea851673737c5bef177c0 Mon Sep 17 00:00:00 2001
From: Yann Leray <yann.leray@inria.fr>
Date: Mon, 30 Mar 2026 14:56:55 +0200
Subject: [PATCH 364/578] Clean up guard environments in subterm_specif on
 fixpoints

---
 kernel/inductive.ml | 23 ++++++++++++-----------
 1 file changed, 12 insertions(+), 11 deletions(-)

diff --git a/kernel/inductive.ml b/kernel/inductive.ml
index f8ab860b5f65..35f04bef7898 100644
--- a/kernel/inductive.ml
+++ b/kernel/inductive.ml
@@ -1259,29 +1259,30 @@ let rec subterm_specif ?evars renv stack t =
         (match oind with
         | 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 = 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'
+          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
+        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 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)
+            assign_var_spec renv (1, arg_spec)
+        in
+        subterm_specif ?evars renv [] strippedBody)
 
     | Lambda (x,a,b) ->
       let () = assert (List.is_empty l) in

From 83e2fe6bd65ef359062551461bf1ea7651b8d579 Mon Sep 17 00:00:00 2001
From: Yann Leray <yann.leray@inria.fr>
Date: Mon, 30 Mar 2026 15:12:15 +0200
Subject: [PATCH 365/578] Stop passing stack to projection argument in
 subterm_specif

---
 kernel/inductive.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/kernel/inductive.ml b/kernel/inductive.ml
index 35f04bef7898..c3e08ace7475 100644
--- a/kernel/inductive.ml
+++ b/kernel/inductive.ml
@@ -1293,7 +1293,7 @@ let rec subterm_specif ?evars renv stack t =
     | (Meta _|Evar _) -> Subterm.dead_code
 
     | Proj (p, _, c) ->
-      let subt = subterm_specif ?evars renv stack c in
+      let subt = subterm_specif ?evars renv [] c in
       Subterm.on_projection subt (Projection.arg p)
 
     | Const c ->

From 9d722489a620d8251d5cba3af72a3cc983cf741f Mon Sep 17 00:00:00 2001
From: Yann Leray <yann.leray@inria.fr>
Date: Mon, 30 Mar 2026 14:24:29 +0200
Subject: [PATCH 366/578] Strictify guard environment lookups

---
 kernel/inductive.ml | 7 ++++++-
 1 file changed, 6 insertions(+), 1 deletion(-)

diff --git a/kernel/inductive.ml b/kernel/inductive.ml
index c3e08ace7475..576afdd2e0ad 100644
--- a/kernel/inductive.ml
+++ b/kernel/inductive.ml
@@ -1084,7 +1084,12 @@ let push_var_renv renv n (x,ty) =
 (* 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 *) Subterm.not_subterm
+  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

From a46bbfb1eec7128f55d6e36f97c199aa3c7bb240 Mon Sep 17 00:00:00 2001
From: Yann Leray <yann.leray@inria.fr>
Date: Mon, 30 Mar 2026 14:36:26 +0200
Subject: [PATCH 367/578] Reorder and cleanup in inductive_of_mutfix.find_ind

---
 kernel/inductive.ml | 51 +++++++++++++++++++++++----------------------
 1 file changed, 26 insertions(+), 25 deletions(-)

diff --git a/kernel/inductive.ml b/kernel/inductive.ml
index 576afdd2e0ad..fd7eef015bf6 100644
--- a/kernel/inductive.ml
+++ b/kernel/inductive.ml
@@ -1758,33 +1758,34 @@ let inductive_of_mutfix ?evars env ((nvect, bodynum), (names, types, bodies as r
   then anomaly (Pp.str "Ill-formed fix term.");
   let fixenv = push_rec_types recdef env in
   let raise_err = raise_fix_guard_err_fn env recdef names 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
-    check_occur fixenv 1 def
+  (* 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
+        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 find_ind nvect bodies in
+  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

From a1b255be0301058fa57a3d09cf155f4cc632ec88 Mon Sep 17 00:00:00 2001
From: Yann Leray <yann.leray@inria.fr>
Date: Mon, 30 Mar 2026 14:47:05 +0200
Subject: [PATCH 368/578] Stop accepting Metas in guard checker

---
 kernel/inductive.ml | 15 +++++++++------
 1 file changed, 9 insertions(+), 6 deletions(-)

diff --git a/kernel/inductive.ml b/kernel/inductive.ml
index fd7eef015bf6..3f1774c2c9ae 100644
--- a/kernel/inductive.ml
+++ b/kernel/inductive.ml
@@ -1294,8 +1294,8 @@ let rec subterm_specif ?evars renv stack t =
       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 _) -> Subterm.dead_code
+      (* Evars are considered OK *)
+    | Evar _ -> Subterm.dead_code
 
     | Proj (p, _, c) ->
       let subt = subterm_specif ?evars renv [] c in
@@ -1310,6 +1310,8 @@ let rec subterm_specif ?evars renv stack t =
         | NotEvaluableConst _ -> Subterm.not_subterm
       end
 
+    | Meta _ -> assert false
+
     | Var _ | Sort _ | Cast _ | Prod _ | LetIn _ | App _ | Ind _
       | Construct _ | CoFix _ | Int _ | Float _ | String _
       | Array _ -> Subterm.not_subterm
@@ -1685,9 +1687,10 @@ let check_one_fix ?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
@@ -1930,7 +1933,7 @@ let check_one_cofix ?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) args
         | Rel _ | Var _ | Sort _ | Cast _ | Prod _ | LetIn _ | App _ | Const _

From 2de0b3bef55944df8703606d09f667b02421302a Mon Sep 17 00:00:00 2001
From: Yann Leray <yann.leray@inria.fr>
Date: Thu, 2 Apr 2026 17:30:53 +0200
Subject: [PATCH 369/578] Print full goal names in RocqIDE

---
 engine/termops.ml       | 5 +++++
 engine/termops.mli      | 1 +
 ide/rocqide/idetop.ml   | 4 ++--
 printing/proof_diffs.ml | 2 +-
 4 files changed, 9 insertions(+), 3 deletions(-)

diff --git a/engine/termops.ml b/engine/termops.ml
index 5d83d3ad1029..ad3f3f799e7f 100644
--- a/engine/termops.ml
+++ b/engine/termops.ml
@@ -132,6 +132,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
diff --git a/engine/termops.mli b/engine/termops.mli
index 6b31af098160..67557a374484 100644
--- a/engine/termops.mli
+++ b/engine/termops.mli
@@ -226,6 +226,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
 
diff --git a/ide/rocqide/idetop.ml b/ide/rocqide/idetop.ml
index 5578834cbe5e..de01bb3d7fae 100644
--- a/ide/rocqide/idetop.ml
+++ b/ide/rocqide/idetop.ml
@@ -195,7 +195,7 @@ 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
@@ -215,7 +215,7 @@ let process_goal short sigma g =
 
 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
diff --git a/printing/proof_diffs.ml b/printing/proof_diffs.ml
index bf6dd6fd68fe..54f84dd6357a 100644
--- a/printing/proof_diffs.ml
+++ b/printing/proof_diffs.ml
@@ -346,7 +346,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
 

From 2f5d725efe45bbf62b9df777faa7f4184b88be92 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Thu, 27 Nov 2025 22:48:52 +0100
Subject: [PATCH 370/578] Check typing flags in private constants.

We are a bit laxer than just requiring the flags to be kept unchanged across
environments, as we also allow for "stricter" flags.

Fixes #20550: Side effects lose track of typing flags leading to inconsistency.
---
 kernel/safe_typing.ml | 59 ++++++++++++++++++++++++++++++++++++++++---
 1 file changed, 55 insertions(+), 4 deletions(-)

diff --git a/kernel/safe_typing.ml b/kernel/safe_typing.ml
index feb90d9f8501..de79cd6269d0 100644
--- a/kernel/safe_typing.ml
+++ b/kernel/safe_typing.ml
@@ -364,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 :
@@ -379,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
@@ -388,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
@@ -400,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

From cf2b0f6e8c3e43d49a51cbc9ae0707088b065882 Mon Sep 17 00:00:00 2001
From: Jason Gross <jgross@mit.edu>
Date: Thu, 2 Apr 2026 13:54:38 -0700
Subject: [PATCH 371/578] Add SProp case analysis scheme kinds (scase_dep,
 scase_nodep)

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
---
 .../21881-sprop-case-scheme-Added.rst         |  6 ++++++
 plugins/ltac2/tac2core.ml                     |  2 ++
 tactics/elimschemes.ml                        |  8 ++++++++
 tactics/elimschemes.mli                       |  2 ++
 test-suite/ltac2/scheme_lookup.v              | 19 +++++++++++++++++++
 theories/Ltac2/Scheme.v                       |  8 ++++++++
 vernac/indschemes.ml                          |  3 ++-
 7 files changed, 47 insertions(+), 1 deletion(-)
 create mode 100644 doc/changelog/06-Ltac2-language/21881-sprop-case-scheme-Added.rst

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 <https://github.com/rocq-prover/rocq/pull/21881>`_,
+  by Jason Gross).
diff --git a/plugins/ltac2/tac2core.ml b/plugins/ltac2/tac2core.ml
index a72953263d1e..a31622747735 100644
--- a/plugins/ltac2/tac2core.ml
+++ b/plugins/ltac2/tac2core.ml
@@ -1384,6 +1384,8 @@ 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"
diff --git a/tactics/elimschemes.ml b/tactics/elimschemes.ml
index 452138b974aa..51dbc3d6a368 100644
--- a/tactics/elimschemes.ml
+++ b/tactics/elimschemes.ml
@@ -211,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/test-suite/ltac2/scheme_lookup.v b/test-suite/ltac2/scheme_lookup.v
index 442e0469826a..083732453fae 100644
--- a/test-suite/ltac2/scheme_lookup.v
+++ b/test-suite/ltac2/scheme_lookup.v
@@ -18,3 +18,22 @@ Ltac2 Eval
   | 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/theories/Ltac2/Scheme.v b/theories/Ltac2/Scheme.v
index f846eba23034..9899ae40e88b 100644
--- a/theories/Ltac2/Scheme.v
+++ b/theories/Ltac2/Scheme.v
@@ -73,6 +73,14 @@ 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
diff --git a/vernac/indschemes.ml b/vernac/indschemes.ml
index 8a5999588fda..889d32f9928f 100644
--- a/vernac/indschemes.ml
+++ b/vernac/indschemes.ml
@@ -415,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 _ | QGlobal _) ->
+        | 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

From 8749a748b2674c79e406591b32b60e706093bb4e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Fri, 3 Apr 2026 08:31:06 +0200
Subject: [PATCH 372/578] Add test that the kernel checks relevances in Case
 binders

Before 6fae78cd19aeb1f83beb0fd30865d26e9b8a84f0 (8.17) relevance of
Case binders was checked by checking the lambdas produced by expand_case.

Before 0cfe16a47599ac49ee059b521b206cfcb6473f59 (8.18)
expand_case would use the relevance from the Case instead of
from the inductive data (after it used the relevance from the
inductive unsubstituted by the univ instance until
269daf2bbe091842ec5a13139d87a7c11a8e0d56 (9.0)).

If we had skipped 6fae78cd19aeb1f83beb0fd30865d26e9b8a84f0 the later
patches would have introduced an inconsstency as typechecking would
have trusted the Case relevances, but they would be used in
conversion.

I think it's worth a test to ensure we don't introduce this possible
bug by mistake.

To make testing practical the check is turned into a regular error
instead of assert failure.
---
 kernel/typeops.ml                          | 11 ++++++-----
 test-suite/output/check_case_relevance.out |  4 ++++
 test-suite/output/check_case_relevance.v   | 10 ++++++++++
 3 files changed, 20 insertions(+), 5 deletions(-)
 create mode 100644 test-suite/output/check_case_relevance.out
 create mode 100644 test-suite/output/check_case_relevance.v

diff --git a/kernel/typeops.ml b/kernel/typeops.ml
index 3fd53a87806c..cef4fa076b0c 100644
--- a/kernel/typeops.ml
+++ b/kernel/typeops.ml
@@ -90,9 +90,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 +112,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,7 +120,7 @@ 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
diff --git a/test-suite/output/check_case_relevance.out b/test-suite/output/check_case_relevance.out
new file mode 100644
index 000000000000..a8f1709ccb13
--- /dev/null
+++ b/test-suite/output/check_case_relevance.out
@@ -0,0 +1,4 @@
+File "./output/check_case_relevance.v", line 10, characters 0-92:
+The command has indeed failed with message:
+Binder (_ : "nat") has relevance mark set to irrelevant but was expected to
+be relevant (maybe a bugged tactic).
diff --git a/test-suite/output/check_case_relevance.v b/test-suite/output/check_case_relevance.v
new file mode 100644
index 000000000000..7c373190e7a5
--- /dev/null
+++ b/test-suite/output/check_case_relevance.v
@@ -0,0 +1,10 @@
+From Ltac2 Require Import Ltac2 Constr.
+Import Constr.Unsafe.
+
+Ltac2 bad p i :=
+  let badx := Binder.unsafe_make None Relevance.irrelevant 'nat in
+  let br := make (Lambda badx (make (Lambda badx i))) in
+  let ind := match reference:(prod) with Std.IndRef ind => ind | _ => Control.throw Assertion_failure end in
+  make (Case (case ind) ('(fun (_:nat * nat) => nat), Relevance.relevant) NoInvert p [|br|]).
+
+Fail Definition badfst (p:nat * nat) := ltac2:(let x := bad '&p (make (Rel 2)) in exact $x).

From f6449fc19c7b904a4dc41395129b6a134b7bca14 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Mon, 20 Feb 2023 15:12:10 +0100
Subject: [PATCH 373/578] Experiment: command modifier and tactic for
 allocation limits

using https://guillaume.munch.name/software/ocaml/memprof-limits
---
 clib/memprof_coq.memprof.ml                   |  4 +++
 clib/memprof_coq.mli                          |  4 +++
 clib/memprof_coq.std.ml                       |  4 +++
 .../proof-engine/vernacular-commands.rst      |  8 +++++
 doc/tools/docgram/common.edit_mlg             |  6 ++++
 doc/tools/docgram/fullGrammar                 |  7 ++++
 doc/tools/docgram/orderedGrammar              |  2 ++
 engine/logic_monad.ml                         |  3 ++
 engine/logic_monad.mli                        |  2 ++
 engine/proofview.ml                           | 31 +++++++++++++++++
 engine/proofview.mli                          |  2 ++
 lib/control.ml                                |  7 ++++
 lib/control.mli                               |  4 +++
 plugins/ltac/extratactics.mlg                 | 22 +++++++++++++
 plugins/ltac/internals.ml                     |  3 ++
 plugins/ltac/internals.mli                    |  2 ++
 sysinit/coqinit.ml                            |  1 +
 test-suite/output-coqtop/LevelTolerance.out   |  2 ++
 vernac/g_vernac.mlg                           |  2 ++
 vernac/ppvernac.ml                            |  1 +
 vernac/vernacControl.ml                       | 33 +++++++++++++++++++
 vernac/vernacexpr.mli                         |  1 +
 22 files changed, 151 insertions(+)

diff --git a/clib/memprof_coq.memprof.ml b/clib/memprof_coq.memprof.ml
index 72fac052d846..0dd07c929047 100644
--- a/clib/memprof_coq.memprof.ml
+++ b/clib/memprof_coq.memprof.ml
@@ -2,6 +2,10 @@
 
 let is_interrupted () = Memprof_limits.is_interrupted () [@@inline]
 
+let limit_allocations = Memprof_limits.limit_allocations
+
+let start_memprof_limits = Memprof_limits.start_memprof_limits
+
 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..5f3634717100 100644
--- a/clib/memprof_coq.mli
+++ b/clib/memprof_coq.mli
@@ -1,6 +1,10 @@
 (* From memprof-limits *)
 val is_interrupted : unit -> bool
 
+val limit_allocations : limit:Int64.t -> (unit -> 'a) -> ('a * Int64.t, exn) result
+
+val start_memprof_limits : unit -> unit
+
 module Masking : sig
 
   val with_resource :
diff --git a/clib/memprof_coq.std.ml b/clib/memprof_coq.std.ml
index 4b58c1e45087..58c97480f856 100644
--- a/clib/memprof_coq.std.ml
+++ b/clib/memprof_coq.std.ml
@@ -1,5 +1,9 @@
 let is_interrupted _ = false [@@inline]
 
+let limit_allocations ~limit:_ f = Ok (f(), 0L)
+
+let start_memprof_limits () = ()
+
 module Resource_bind = struct
   let ( let& ) f scope = f ~scope
 end
diff --git a/doc/sphinx/proof-engine/vernacular-commands.rst b/doc/sphinx/proof-engine/vernacular-commands.rst
index 156d9d20bfaa..fd0fd627e8b5 100644
--- a/doc/sphinx/proof-engine/vernacular-commands.rst
+++ b/doc/sphinx/proof-engine/vernacular-commands.rst
@@ -944,6 +944,14 @@ 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.
+
+.. tacn:: alloc_limit @natural {| Mw | kw } @ltac_expr
+
+   :cmd:`AllocLimit` as a tactical.
 
 .. cmd:: Fail @sentence
 
diff --git a/doc/tools/docgram/common.edit_mlg b/doc/tools/docgram/common.edit_mlg
index 92116172fefc..dcdc67f87500 100644
--- a/doc/tools/docgram/common.edit_mlg
+++ b/doc/tools/docgram/common.edit_mlg
@@ -951,6 +951,10 @@ simple_occurrences: [
 (* placeholder (yuck) *)
 ]
 
+SPLICE: [
+| memory_unit
+]
+
 simple_tactic: [
 | REPLACE "assert" "(" identref ":" lconstr ")" by_tactic
 | WITH "assert" "(" identref ":" type ")" by_tactic
@@ -1574,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"
diff --git a/doc/tools/docgram/fullGrammar b/doc/tools/docgram/fullGrammar
index dae9f38810e8..7fef6ff31fad 100644
--- a/doc/tools/docgram/fullGrammar
+++ b/doc/tools/docgram/fullGrammar
@@ -828,6 +828,7 @@ control_flag: [
 | "Profile" OPT STRING
 | "Redirect" ne_string
 | "Timeout" natural
+| "AllocLimit" natural [ "Mw" | "kw" ]
 | "Fail"
 | "Succeed"
 ]
@@ -1840,6 +1841,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
@@ -2112,6 +2114,11 @@ test: [
 | int_or_var comparison int_or_var
 ]
 
+memory_unit: [
+| "Mw"
+| "kw"
+]
+
 hintbases: [
 | "with" "*"
 | "with" LIST1 preident
diff --git a/doc/tools/docgram/orderedGrammar b/doc/tools/docgram/orderedGrammar
index 2e7466bc2702..2daec6c6466e 100644
--- a/doc/tools/docgram/orderedGrammar
+++ b/doc/tools/docgram/orderedGrammar
@@ -1037,6 +1037,7 @@ command: [
 | "Profile" OPT string sentence
 | "Redirect" string sentence
 | "Timeout" natural sentence
+| "AllocLimit" natural [ "Mw" | "kw" ] sentence
 | "Fail" sentence
 | "Succeed" sentence
 | "Drop"
@@ -1512,6 +1513,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"
diff --git a/engine/logic_monad.ml b/engine/logic_monad.ml
index 5cbca3eb4970..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 ->
diff --git a/engine/logic_monad.mli b/engine/logic_monad.mli
index f8f701228930..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
diff --git a/engine/proofview.ml b/engine/proofview.ml
index 19120151feff..10e28d719656 100644
--- a/engine/proofview.ml
+++ b/engine/proofview.ml
@@ -1037,6 +1037,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 =
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/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/plugins/ltac/extratactics.mlg b/plugins/ltac/extratactics.mlg
index 1871e9eaf1c5..fc0cb6611fe0 100644
--- a/plugins/ltac/extratactics.mlg
+++ b/plugins/ltac/extratactics.mlg
@@ -675,6 +675,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/plugins/ltac/internals.ml b/plugins/ltac/internals.ml
index bab239eed096..5706c1a53468 100644
--- a/plugins/ltac/internals.ml
+++ b/plugins/ltac/internals.ml
@@ -168,6 +168,9 @@ let unshelve ist t =
   Proofview.Unsafe.tclGETGOALS >>= fun ogls ->
   Proofview.Unsafe.tclSETGOALS (gls @ ogls)
 
+let alloc_limit ist n tac =
+  Proofview.tclALLOCLIMIT n (Tacinterp.tactic_of_value ist tac)
+
 (** tactic analogous to "OPTIMIZE HEAP" *)
 
 let tclOPTIMIZE_HEAP =
diff --git a/plugins/ltac/internals.mli b/plugins/ltac/internals.mli
index 009901c9bf4c..7086692cc590 100644
--- a/plugins/ltac/internals.mli
+++ b/plugins/ltac/internals.mli
@@ -67,3 +67,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 : Tacinterp.interp_sign -> Control.kilowords -> Tacarg.tacvalue -> unit tactic
diff --git a/sysinit/coqinit.ml b/sysinit/coqinit.ml
index d6f777fbb8de..a133ed9cc036 100644
--- a/sysinit/coqinit.ml
+++ b/sysinit/coqinit.ml
@@ -153,6 +153,7 @@ let init_runtime ~usage opts =
   let open Coqargs in
   Vernacextend.static_linking_done ();
   Option.iter (fun file -> init_profile ~file) opts.config.profile;
+  Memprof_coq.start_memprof_limits ();
   Lib.init ();
   if opts.post.memory_stat then at_exit print_memory_stat;
 
diff --git a/test-suite/output-coqtop/LevelTolerance.out b/test-suite/output-coqtop/LevelTolerance.out
index 1518a522a9a1..63ba8c2e2312 100644
--- a/test-suite/output-coqtop/LevelTolerance.out
+++ b/test-suite/output-coqtop/LevelTolerance.out
@@ -681,6 +681,7 @@ Entry simple_tactic is
   | IDENT "exact"; uconstr
   | IDENT "with_strategy"; strategy_level_or_var; "["; LIST1 smart_global;
     "]"; ltac_expr LEVEL "3"
+  | IDENT "alloc_limit"; natural; memory_unit; tactic
   | IDENT "guard"; test
   | IDENT "swap"; int_or_var; int_or_var
   | IDENT "cycle"; int_or_var
@@ -902,6 +903,7 @@ Entry simple_tactic is
 Entry tactic_value is
 [ LEFTA
   [ IDENT "firstorder_using"; ":"; "("; firstorder_using; ")"
+  | IDENT "memory_unit"; ":"; "("; memory_unit; ")"
   | IDENT "test"; ":"; "("; test; ")"
   | IDENT "comparison"; ":"; "("; comparison; ")"
   | IDENT "opthints"; ":"; "("; opthints; ")"
diff --git a/vernac/g_vernac.mlg b/vernac/g_vernac.mlg
index 5a5189fb8253..00d91f0a9411 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 }
     ] ]
diff --git a/vernac/ppvernac.ml b/vernac/ppvernac.ml
index 52e42939cfd6..652fdce9df38 100644
--- a/vernac/ppvernac.ml
+++ b/vernac/ppvernac.ml
@@ -1457,6 +1457,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/vernacControl.ml b/vernac/vernacControl.ml
index 60dab2866421..19a39ac955c1 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,33 @@ let with_timeout ~timeout:n f =
     else Some (ControlTimeout { remaining }, v)
   end
 
+exception AllocLimit
+
+let () = CErrors.register_handler @@ function
+  | AllocLimit -> Some Pp.(str "Alloc limit!")
+  | _ -> 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
+  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 *)
+  if allocated >= 1000L then
+    str "Allocated " ++ int64 (Int64.div allocated 1000L) ++ str "Mw."
+  else str "Allocated " ++ int64 allocated ++ str "kw."
+
 let real_error_loc ~cmdloc ~eloc =
   if Loc.finer eloc cmdloc then eloc
   else cmdloc
@@ -203,6 +231,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 +266,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 +308,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/vernacexpr.mli b/vernac/vernacexpr.mli
index f1d6e80d11ab..f4dc85dbdd7d 100644
--- a/vernac/vernacexpr.mli
+++ b/vernac/vernacexpr.mli
@@ -528,6 +528,7 @@ type control_flag_r =
   | ControlProfile of string option
   | ControlRedirect of string
   | ControlTimeout of int
+  | ControlAllocLimit of Control.kilowords
   | ControlFail
   | ControlSucceed
 

From b723ab9253a5baeba06fc02689bb50506fe3cf95 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Tue, 28 Oct 2025 15:02:18 +0100
Subject: [PATCH 374/578] warning for AllocLimit when memprof-limits not
 installed

---
 clib/memprof_coq.memprof.ml                     | 2 ++
 clib/memprof_coq.mli                            | 2 ++
 clib/memprof_coq.std.ml                         | 2 ++
 doc/sphinx/proof-engine/vernacular-commands.rst | 6 ++++++
 lib/cWarnings.ml                                | 3 +++
 lib/cWarnings.mli                               | 3 +++
 plugins/ltac/internals.ml                       | 9 +++++++--
 plugins/ltac/internals.mli                      | 2 +-
 vernac/vernacControl.ml                         | 1 +
 9 files changed, 27 insertions(+), 3 deletions(-)

diff --git a/clib/memprof_coq.memprof.ml b/clib/memprof_coq.memprof.ml
index 0dd07c929047..ad3728bb00c9 100644
--- a/clib/memprof_coq.memprof.ml
+++ b/clib/memprof_coq.memprof.ml
@@ -1,5 +1,7 @@
 (* 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
diff --git a/clib/memprof_coq.mli b/clib/memprof_coq.mli
index 5f3634717100..8396bd1a0c5a 100644
--- a/clib/memprof_coq.mli
+++ b/clib/memprof_coq.mli
@@ -1,4 +1,6 @@
 (* 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
diff --git a/clib/memprof_coq.std.ml b/clib/memprof_coq.std.ml
index 58c97480f856..4bf5ec7f77c0 100644
--- a/clib/memprof_coq.std.ml
+++ b/clib/memprof_coq.std.ml
@@ -1,3 +1,5 @@
+let is_real_memprof = false
+
 let is_interrupted _ = false [@@inline]
 
 let limit_allocations ~limit:_ f = Ok (f(), 0L)
diff --git a/doc/sphinx/proof-engine/vernacular-commands.rst b/doc/sphinx/proof-engine/vernacular-commands.rst
index fd0fd627e8b5..c3b86e977eab 100644
--- a/doc/sphinx/proof-engine/vernacular-commands.rst
+++ b/doc/sphinx/proof-engine/vernacular-commands.rst
@@ -949,6 +949,12 @@ Quitting and debugging
    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.
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/plugins/ltac/internals.ml b/plugins/ltac/internals.ml
index 5706c1a53468..7bf5ab378113 100644
--- a/plugins/ltac/internals.ml
+++ b/plugins/ltac/internals.ml
@@ -168,8 +168,13 @@ let unshelve ist t =
   Proofview.Unsafe.tclGETGOALS >>= fun ogls ->
   Proofview.Unsafe.tclSETGOALS (gls @ ogls)
 
-let alloc_limit ist n tac =
-  Proofview.tclALLOCLIMIT n (Tacinterp.tactic_of_value ist tac)
+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" *)
 
diff --git a/plugins/ltac/internals.mli b/plugins/ltac/internals.mli
index 7086692cc590..027debcc3ac8 100644
--- a/plugins/ltac/internals.mli
+++ b/plugins/ltac/internals.mli
@@ -68,4 +68,4 @@ 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 : Tacinterp.interp_sign -> Control.kilowords -> Tacarg.tacvalue -> unit tactic
+val alloc_limit : ?loc:Loc.t -> Tacinterp.interp_sign -> Control.kilowords -> Tacarg.tacvalue -> unit tactic
diff --git a/vernac/vernacControl.ml b/vernac/vernacControl.ml
index 19a39ac955c1..5414cd1d70db 100644
--- a/vernac/vernacControl.ml
+++ b/vernac/vernacControl.ml
@@ -157,6 +157,7 @@ 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}) ->

From b0e8db34b97bde488638355f50fd0a652d389308 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Tue, 28 Oct 2025 15:03:34 +0100
Subject: [PATCH 375/578] changelog

---
 .../17266-alloc-limit-Added.rst                               | 4 ++++
 1 file changed, 4 insertions(+)
 create mode 100644 doc/changelog/08-vernac-commands-and-options/17266-alloc-limit-Added.rst

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 <https://github.com/rocq-prover/rocq/pull/17266>`_,
+  by Gaëtan Gilbert).

From 726aa9ce5b18811a3c95b0a7e8d5f017ac157b83 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Fri, 3 Apr 2026 14:44:16 +0200
Subject: [PATCH 376/578] Validate Proof: detect missing constraints, error if
 any issues found

---
 clib/cSig.mli                      |  1 +
 kernel/qGraph.ml                   |  8 ++++
 kernel/qGraph.mli                  |  2 +
 kernel/sorts.ml                    |  2 +-
 kernel/sorts.mli                   |  2 +-
 test-suite/success/ValidateProof.v | 21 ++++++++++
 vernac/vernacentries.ml            | 61 ++++++++++++++++++++++++++++--
 7 files changed, 91 insertions(+), 6 deletions(-)

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/kernel/qGraph.ml b/kernel/qGraph.ml
index 6185f1f52056..754238f09823 100644
--- a/kernel/qGraph.ml
+++ b/kernel/qGraph.ml
@@ -344,6 +344,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 73be73f26cb4..3db2b7e83c95 100644
--- a/kernel/qGraph.mli
+++ b/kernel/qGraph.mli
@@ -103,6 +103,8 @@ val qvar_domain : t -> QVar.Set.t
 
 val is_empty : t -> bool
 
+val constraints_for : kept:Quality.Set.t -> t -> ElimConstraints.t
+
 val pr_qualities : Quality.printer -> t -> Pp.t
 
 val explain_quality_inconsistency : Quality.printer -> explanation option -> Pp.t
diff --git a/kernel/sorts.ml b/kernel/sorts.ml
index 26bfd37d58fd..a2cfc79737fa 100644
--- a/kernel/sorts.ml
+++ b/kernel/sorts.ml
@@ -358,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) ->
diff --git a/kernel/sorts.mli b/kernel/sorts.mli
index 2edf4b21a94f..02fbc8899107 100644
--- a/kernel/sorts.mli
+++ b/kernel/sorts.mli
@@ -157,7 +157,7 @@ module ElimConstraint : sig
   val raw_pr : t -> Pp.t
 end
 
-module ElimConstraints : sig include Stdlib.Set.S with type elt = ElimConstraint.t
+module ElimConstraints : sig include CSet.ExtS with type elt = ElimConstraint.t
   val pr : Quality.printer -> t -> Pp.t
 
   val hcons : t Hashcons.f
diff --git a/test-suite/success/ValidateProof.v b/test-suite/success/ValidateProof.v
index 4cb74a55ad62..6386182306a1 100644
--- a/test-suite/success/ValidateProof.v
+++ b/test-suite/success/ValidateProof.v
@@ -20,3 +20,24 @@ Proof.
   Fail Validate Proof.
 
 Abort.
+
+Goal Type.
+Proof.
+  exact_no_check Type.
+  Fail Validate Proof.
+Abort.
+
+Polymorphic Record Box@{s;} (A:Prop) : Type@{s;Set} := box { unbox : A }.
+Arguments box {_}. Arguments unbox {_}.
+
+From Ltac2 Require Import Ltac2 Constr.
+Import Constr.Unsafe.
+
+Polymorphic Lemma foo@{s;} (A:Prop) (x:Box@{s;} A) : A.
+Proof.
+  let ind := match reference:(Box) with Std.IndRef ind => ind | _ => Control.throw Assertion_failure end in
+  let case := Constr.Unsafe.case ind in
+  let c := make (Case case ('(fun _:Box@{s;} A => A), Relevance.relevant) NoInvert '&x [|'(fun (b:A) => b)|]) in
+  exact $c.
+  Fail Validate Proof.
+Abort.
diff --git a/vernac/vernacentries.ml b/vernac/vernacentries.ml
index 2e2826a7dae3..343c248b5405 100644
--- a/vernac/vernacentries.ml
+++ b/vernac/vernacentries.ml
@@ -2555,11 +2555,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
@@ -2953,7 +3006,7 @@ 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 ->
     unsupported_attributes atts;

From 9b55118e4f3531d0cbb301a5241f491da6dae40f Mon Sep 17 00:00:00 2001
From: Enrico Tassi <Enrico.Tassi@Inria.fr>
Date: Fri, 3 Apr 2026 15:43:30 +0200
Subject: [PATCH 377/578] make Set Default Proof Using available at synterp
 time

---
 vernac/proof_using.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/vernac/proof_using.ml b/vernac/proof_using.ml
index 40b70df96322..c8f7bc6cc4bb 100644
--- a/vernac/proof_using.ml
+++ b/vernac/proof_using.ml
@@ -223,7 +223,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);

From 6b58c3cf0fe03fc9b3250a3e53cf1dd8aba5ede0 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Fri, 3 Apr 2026 16:24:21 +0200
Subject: [PATCH 378/578] update messages

---
 vernac/vernacControl.ml | 13 ++++++++-----
 1 file changed, 8 insertions(+), 5 deletions(-)

diff --git a/vernac/vernacControl.ml b/vernac/vernacControl.ml
index 5414cd1d70db..da9678a64324 100644
--- a/vernac/vernacControl.ml
+++ b/vernac/vernacControl.ml
@@ -150,7 +150,7 @@ let with_timeout ~timeout:n f =
 exception AllocLimit
 
 let () = CErrors.register_handler @@ function
-  | AllocLimit -> Some Pp.(str "Alloc limit!")
+  | AllocLimit -> Some Pp.(str "Allocation limit exceeded.")
   | _ -> None
 
 let with_alloc_limit ~limit ~allocated f =
@@ -170,10 +170,13 @@ let with_alloc_limit ~limit ~allocated f =
 
 let fmt_allocated { Control.kilowords = allocated } =
   let open Pp in
-  (* XXX print a few more digits for low Mw allocated *)
-  if allocated >= 1000L then
-    str "Allocated " ++ int64 (Int64.div allocated 1000L) ++ str "Mw."
-  else str "Allocated " ++ int64 allocated ++ str "kw."
+  (* 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

From 40477020558ff491b3b42c0bff99d8f12b0c34f4 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Thu, 2 Apr 2026 15:31:43 +0200
Subject: [PATCH 379/578] Removed unused deprecation arguments in tacentries

Deprecation is handled in Interp not Synterp
---
 plugins/ltac/g_ltac.mlg     | 2 +-
 plugins/ltac/tacentries.ml  | 8 ++++----
 plugins/ltac/tacentries.mli | 2 +-
 3 files changed, 6 insertions(+), 6 deletions(-)

diff --git a/plugins/ltac/g_ltac.mlg b/plugins/ltac/g_ltac.mlg
index 3e158f651c6f..2267b7579996 100644
--- a/plugins/ltac/g_ltac.mlg
+++ b/plugins/ltac/g_ltac.mlg
@@ -423,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/tacentries.ml b/plugins/ltac/tacentries.ml
index 8b28a88024bc..8119414ebae1 100644
--- a/plugins/ltac/tacentries.ml
+++ b/plugins/ltac/tacentries.ml
@@ -337,7 +337,7 @@ let add_glob_tactic_notation ?deprecation tacobj ids tac =
   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;
@@ -356,9 +356,9 @@ let add_tactic_notation ?deprecation tacobj e =
   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                                                  *)
@@ -412,7 +412,7 @@ 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
+    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;
             }
diff --git a/plugins/ltac/tacentries.mli b/plugins/ltac/tacentries.mli
index 7afc5483b6b3..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
 

From 6695a986a577da3255487cbf71331758cf157503 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Fri, 3 Apr 2026 17:36:40 +0200
Subject: [PATCH 380/578] Fix delta resolver propagation with Require in Module

Fix #21749
---
 kernel/safe_typing.ml                | 32 ++++++++++++++--------------
 test-suite/prerequisite/modalias.v   |  4 ++++
 test-suite/success/RequireInModule.v |  4 ++++
 3 files changed, 24 insertions(+), 16 deletions(-)
 create mode 100644 test-suite/prerequisite/modalias.v
 create mode 100644 test-suite/success/RequireInModule.v

diff --git a/kernel/safe_typing.ml b/kernel/safe_typing.ml
index feb90d9f8501..efd967b2b89b 100644
--- a/kernel/safe_typing.ml
+++ b/kernel/safe_typing.ml
@@ -1304,13 +1304,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 =
@@ -1403,11 +1396,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) *)
@@ -1437,7 +1436,8 @@ let propagate_senv newdef newenv newresolver senv oldsenv =
   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
+  propagate_loads senv.loads {
+    oldsenv with
     env = newenv;
     modresolver = newresolver;
     revstruct = newdef::oldsenv.revstruct;
@@ -1446,7 +1446,7 @@ let propagate_senv newdef newenv newresolver senv oldsenv =
     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;
@@ -1464,7 +1464,7 @@ let end_module l restype senv =
   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 newenv = Modops.add_retroknowledge senv.local_retroknowledge newenv in
-  let senv' = propagate_loads { senv with env = newenv } in
+  let senv' = { senv with env = newenv } in
   let newenv = Modops.add_module mp mb senv'.env in
   let newresolver = match mod_global_delta mb with
   | None -> oldsenv.modresolver
@@ -1485,7 +1485,7 @@ 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 senv' = {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
diff --git a/test-suite/prerequisite/modalias.v b/test-suite/prerequisite/modalias.v
new file mode 100644
index 000000000000..b94f7b58b89b
--- /dev/null
+++ b/test-suite/prerequisite/modalias.v
@@ -0,0 +1,4 @@
+Module M.
+  Variant test := .
+End M.
+Module N := M.
diff --git a/test-suite/success/RequireInModule.v b/test-suite/success/RequireInModule.v
new file mode 100644
index 000000000000..1add78570f92
--- /dev/null
+++ b/test-suite/success/RequireInModule.v
@@ -0,0 +1,4 @@
+Module X.
+  Require TestSuite.modalias.
+End X.
+Definition test := modalias.N.test.

From 88a0040254fb8c1bc4af0fbd139dab980f25a801 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Fri, 3 Apr 2026 18:28:17 +0200
Subject: [PATCH 381/578] Stop relying on canonical names in Native conversion.

---
 kernel/nativeconv.ml | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/kernel/nativeconv.ml b/kernel/nativeconv.ml
index 51cc0270ff01..0b40d61b78e9 100644
--- a/kernel/nativeconv.ml
+++ b/kernel/nativeconv.ml
@@ -110,7 +110,7 @@ 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
+      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).
 
@@ -120,14 +120,14 @@ and conv_atom env pb lvl a1 a2 cu =
         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
@@ -157,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 _, _

From 4100dbeeff176729950b41e364e334e2ca1d2db5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Sat, 4 Apr 2026 11:41:58 +0200
Subject: [PATCH 382/578] Cleaner code in Safe_typing module closure.

This reduces the risk of accidental value capture, since we now have only
a single environment that contains all the necessary data.
---
 kernel/safe_typing.ml | 16 +++++++---------
 1 file changed, 7 insertions(+), 9 deletions(-)

diff --git a/kernel/safe_typing.ml b/kernel/safe_typing.ml
index efd967b2b89b..128b6b3fce92 100644
--- a/kernel/safe_typing.ml
+++ b/kernel/safe_typing.ml
@@ -1430,7 +1430,7 @@ 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
@@ -1438,8 +1438,8 @@ let propagate_senv newdef newenv newresolver senv oldsenv =
       Pp.(str "True Future.t were created for opaque constants even if -async-proofs is off");
   propagate_loads senv.loads {
     oldsenv with
-    env = newenv;
-    modresolver = newresolver;
+    env = senv.env;
+    modresolver = senv.modresolver;
     revstruct = newdef::oldsenv.revstruct;
     modlabels = Id.Set.add (fst newdef) oldsenv.modlabels;
     univ = senv.univ;
@@ -1464,15 +1464,14 @@ let end_module l restype senv =
   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 newenv = Modops.add_retroknowledge senv.local_retroknowledge newenv in
-  let senv' = { senv with env = newenv } in
-  let newenv = Modops.add_module mp mb senv'.env 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
 
@@ -1485,14 +1484,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' = {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 } *)
 

From 3ba4a7c666de56da6026a28e8259179a40f743d5 Mon Sep 17 00:00:00 2001
From: Yann Leray <yann.leray@inria.fr>
Date: Tue, 7 Apr 2026 16:01:34 +0200
Subject: [PATCH 383/578] Fix regression that prevented some mutual fixpoints
 involving nested inductives

---
 .../01-kernel/21896-guard-incl-wf-paths-Fixed.rst        | 5 +++++
 kernel/inductive.ml                                      | 9 +++++++--
 test-suite/bugs/bug_21892.v                              | 7 +++++++
 3 files changed, 19 insertions(+), 2 deletions(-)
 create mode 100644 doc/changelog/01-kernel/21896-guard-incl-wf-paths-Fixed.rst
 create mode 100644 test-suite/bugs/bug_21892.v

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 <https://github.com/rocq-prover/rocq/pull/21896>`_,
+  fixes `#21892 <https://github.com/rocq-prover/rocq/issues/21892>`_,
+  by Yann Leray).
diff --git a/kernel/inductive.ml b/kernel/inductive.ml
index 3f1774c2c9ae..c75101758a04 100644
--- a/kernel/inductive.ml
+++ b/kernel/inductive.ml
@@ -658,7 +658,7 @@ 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 equal : t -> t -> bool
+val incl : t -> t -> bool
 
 end =
 struct
@@ -721,6 +721,11 @@ let is_primitive_positive_container env cst t = match dest_recarg t with
 let equal t1 t2 =
   Atm.equal eq_recarg t1 t2
 
+let incl t1 t2 =
+  equal t1 t2 ||
+  let t12 = inter t1 t2 in
+  equal t1 t12
+
 end
 
 (*************************************)
@@ -868,7 +873,7 @@ let check t tree =
   | DeadCode -> NeedReduce Int.Set.empty
   | Vars l ->   NeedReduce l
   | Subterm (Strict, tree', l) ->
-    if WfPaths.equal tree tree' then
+    if WfPaths.incl tree tree' then
       NeedReduce l
     else
       InvalidSubterm
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.

From 90fa557349c3068a173b0621a1ad63da4123f300 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Wed, 8 Apr 2026 19:05:15 +0200
Subject: [PATCH 384/578] Fix #21902: Incorrect path constraint in with Module
 construct.

This is seemingly not a soundness issue but it is still problematic enough.
---
 kernel/mod_typing.ml        |  3 +--
 test-suite/bugs/bug_21902.v | 27 +++++++++++++++++++++++++++
 2 files changed, 28 insertions(+), 2 deletions(-)
 create mode 100644 test-suite/bugs/bug_21902.v

diff --git a/kernel/mod_typing.ml b/kernel/mod_typing.ml
index 168b49b6e6f9..46d563687e4b 100644
--- a/kernel/mod_typing.ml
+++ b/kernel/mod_typing.ml
@@ -231,8 +231,7 @@ 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
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.

From 1d9294ec11ca439748d6854e66bc42a1aa527c58 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Thu, 9 Apr 2026 11:14:03 +0200
Subject: [PATCH 385/578] Correctly handle module arguments in module inclusion
 check.

We were analyzing the body of a functor in an environment that did not
make sense, as this body could very well be algebraically defined as
one of the arguments.

Fix #16024: Anomaly "Uncaught exception Not_found."
---
 kernel/mod_typing.ml        | 14 +++++++++-----
 test-suite/bugs/bug_16024.v |  7 +++++++
 2 files changed, 16 insertions(+), 5 deletions(-)
 create mode 100644 test-suite/bugs/bug_16024.v

diff --git a/kernel/mod_typing.ml b/kernel/mod_typing.ml
index 168b49b6e6f9..d9285df125a8 100644
--- a/kernel/mod_typing.ml
+++ b/kernel/mod_typing.ml
@@ -388,9 +388,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
@@ -401,9 +403,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/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.

From a6ee84ee69919f09567eec0ce3d7532dbb3f1ff5 Mon Sep 17 00:00:00 2001
From: Yann Leray <yann.leray@inria.fr>
Date: Thu, 9 Apr 2026 14:14:29 +0200
Subject: [PATCH 386/578] Add support for unfolding projections with
 occurrences

---
 pretyping/tacred.ml | 27 ++++++++++-----------------
 1 file changed, 10 insertions(+), 17 deletions(-)

diff --git a/pretyping/tacred.ml b/pretyping/tacred.ml
index 0b174425dbbc..67e746b58ef7 100644
--- a/pretyping/tacred.ml
+++ b/pretyping/tacred.ml
@@ -75,15 +75,6 @@ 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 evaluable_of_global_reference ?loc = function
   | GlobRef.ConstRef cst ->
     begin
@@ -1248,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 _ () -> ())

From 7a92adb260e18ea597a08a81fe537b81448f24b1 Mon Sep 17 00:00:00 2001
From: Yann Leray <yann.leray@inria.fr>
Date: Thu, 9 Apr 2026 14:16:36 +0200
Subject: [PATCH 387/578] Add test

---
 test-suite/bugs/bug_21096.v | 6 ++++++
 1 file changed, 6 insertions(+)
 create mode 100644 test-suite/bugs/bug_21096.v

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.

From 9864be558bdfffbcfe6d94dd400a0659c6e84b4d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Thu, 9 Apr 2026 17:00:15 +0200
Subject: [PATCH 388/578] Change the default name of RocqIDE project files to
 _RocqProject.

See also #21756 for a motivation.
---
 ide/rocqide/preferences.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

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)

From 019c9200075f371423972c40797242526db4a22a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Thu, 9 Apr 2026 17:01:31 +0200
Subject: [PATCH 389/578] Fix the mention of _CoqProject in RocqIDE CLI
 message.

---
 ide/rocqide/rocqide.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/ide/rocqide/rocqide.ml b/ide/rocqide/rocqide.ml
index 91c1e29321c2..e5ccc88833ba 100644
--- a/ide/rocqide/rocqide.ml
+++ b/ide/rocqide/rocqide.ml
@@ -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\

From ad4a9627d549c18bbe2238063bab1ec036b54e83 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Thu, 9 Apr 2026 19:15:46 +0200
Subject: [PATCH 390/578] Correctly check that a constant has a body in unfold
 at.

Fix #16380: Uncaught exception occurs when an opaque term is unfolded.
---
 pretyping/tacred.ml         | 6 +++++-
 test-suite/bugs/bug_16380.v | 9 +++++++++
 2 files changed, 14 insertions(+), 1 deletion(-)
 create mode 100644 test-suite/bugs/bug_16380.v

diff --git a/pretyping/tacred.ml b/pretyping/tacred.ml
index 67e746b58ef7..14739547910c 100644
--- a/pretyping/tacred.ml
+++ b/pretyping/tacred.ml
@@ -1295,11 +1295,14 @@ let unfold_red kn =
   in
   mkflags flags
 
+let error_opaque_evaluable env ref =
+  user_err Pp.(str (string_of_evaluable_ref env ref ^ " is opaque."))
+
 let unfold env sigma name c =
   if is_evaluable env sigma name then
     clos_norm_flags (unfold_red name) env sigma c
   else
-    user_err Pp.(str (string_of_evaluable_ref env name^" is opaque."))
+    error_opaque_evaluable env name
 
 (** [unfoldoccs : (readable_constraints -> (int list * full_path) -> constr -> constr)]
     unfolds the constant name in a term c following a list of occurrences occl.
@@ -1311,6 +1314,7 @@ let unfoldoccs env sigma (occs,name) c =
   | NoOccurrences -> c
   | AllOccurrences -> unfold env sigma name c
   | OnlyOccurrences _ | AllOccurrencesBut _ | AtLeastOneOccurrence ->
+    let () = if not (is_evaluable env sigma name) then error_opaque_evaluable env name in
     let (occ,uc) = substlin env sigma name occs c in
     if Int.equal occ 0 then
       user_err Pp.(str ((string_of_evaluable_ref env name)^" does not occur."));
diff --git a/test-suite/bugs/bug_16380.v b/test-suite/bugs/bug_16380.v
new file mode 100644
index 000000000000..c30e39dd7e94
--- /dev/null
+++ b/test-suite/bugs/bug_16380.v
@@ -0,0 +1,9 @@
+Theorem a : nat.
+Proof.
+apply O.
+Qed.
+
+Theorem b : a <> a.
+Proof.
+Fail unfold a at 2.
+Abort.

From 297bf16ca03336eb3ecfe2e443d341e6e0f63d36 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Thu, 9 Apr 2026 19:31:32 +0200
Subject: [PATCH 391/578] Be more resilient to garbage arguments passed to rocq
 check.

We print a proper error rather than dying with an anomaly.

Fix #14397: coqchk should handle the empty string gracefully.
---
 checker/coqchk_main.ml | 16 ++++++++++------
 1 file changed, 10 insertions(+), 6 deletions(-)

diff --git a/checker/coqchk_main.ml b/checker/coqchk_main.ml
index 185ce2762fd3..a4c5c29bad3f 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
@@ -165,17 +165,21 @@ let make_senv () =
   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]

From 6e34eb9820027f47ca46e9132affaecc0a213d19 Mon Sep 17 00:00:00 2001
From: Yann Leray <yann.leray@inria.fr>
Date: Mon, 13 Apr 2026 18:28:54 +0200
Subject: [PATCH 392/578] QLeq has nothing to do with elimination

---
 engine/univProblem.ml | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

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
 

From c8f938496168da334b761b9560720cda36f31f85 Mon Sep 17 00:00:00 2001
From: Leonid Znamenok <respublica@altlinux.org>
Date: Mon, 13 Apr 2026 20:29:29 +0400
Subject: [PATCH 393/578] ide: ignore SIGUSR1 by default in idetop

The IDE's Break button sends SIGUSR1 to the idetop worker to enter the
Ltac debugger. A handler for this signal is installed only by
db_initialize in tactic_debug.ml, so pressing Break before the debugger
has ever been initialized caused the worker to be killed by the Unix
default action for SIGUSR1.
---
 ide/rocqide/idetop.ml | 7 ++++++-
 1 file changed, 6 insertions(+), 1 deletion(-)

diff --git a/ide/rocqide/idetop.ml b/ide/rocqide/idetop.ml
index 5578834cbe5e..e12689047333 100644
--- a/ide/rocqide/idetop.ml
+++ b/ide/rocqide/idetop.ml
@@ -40,7 +40,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
 

From 48539af252fae7a0676dde9a38644f1c60eb742d Mon Sep 17 00:00:00 2001
From: Enrico Tassi <Enrico.Tassi@inria.fr>
Date: Fri, 13 Mar 2026 16:05:09 +0100
Subject: [PATCH 394/578] Replace more occurrences of Coq with Rocq

---
 doc/sphinx/practical-tools/utilities.rst | 201 ++++++++++++-----------
 1 file changed, 102 insertions(+), 99 deletions(-)

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 <https://github.com/coq/platform>`_, which relies
+`Rocq Platform <https://github.com/rocq-prover/platform>`_, which relies
 on the `opam package manager <https://rocq-prover.org/using-opam>`_.
 
-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 <https://rocq-prover.org/packages>`_ 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 <package name>` 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 <https://proofgeneral.github.io/>`_,
-`vsCoq <https://github.com/coq-community/vscoq>`_
+`vsRocq <https://github.com/rocq-prover/vsrocq>`_
 and `Coqtail <https://github.com/whonore/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 <directory path of B> 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 . <project directory>` in
-  `user-contrib/<project directory>`.  In this case, the `_CoqProject` doesn't
+  to create a `_RocqProject` file containing the line `-R . <project directory>` in
+  `user-contrib/<project directory>`.  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 <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
 <https://www.gnu.org/software/make/manual/html_node/Secondary-Expansion.html>`_
 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 ``"``

From 76c97171fa2a8a5b3f54a71ab51fc7fd6d05b04c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Wed, 15 Apr 2026 22:02:30 +0200
Subject: [PATCH 395/578] More structured version handling in configure

The version string for 9.2.0 is missing the `.0` and in previous
version the magic number didn't get updated for patch versions, this
should fix that for the future.
---
 dev/doc/release-process.md   |  6 ++++--
 tools/configure/configure.ml | 28 ++++++++++++++++++++++++----
 2 files changed, 28 insertions(+), 6 deletions(-)

diff --git a/dev/doc/release-process.md b/dev/doc/release-process.md
index 89b349e5f654..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 ##
@@ -48,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: <url of current milestone for 8.20>); backport to v8.20 (move rejected PRs to: <URL of current milestone for 8.21>); ...`.
 - [ ] 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/tools/configure/configure.ml b/tools/configure/configure.ml
index 97b92b7b6968..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.3+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 = 90299
+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 *)

From a3c4ca643a4a6cde78d251a197325ddb68cb9a56 Mon Sep 17 00:00:00 2001
From: Pierre Roux <pierre.roux@onera.fr>
Date: Tue, 31 Mar 2026 10:48:55 +0200
Subject: [PATCH 396/578] Make argument-scope-delimiter error by default

In order to actually handle this 8.19 deprecation in 9.4.
---
 test-suite/bugs/bug_4955.v | 2 +-
 vernac/comArguments.ml     | 1 +
 2 files changed, 2 insertions(+), 1 deletion(-)

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/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 " ++

From d87ca4ea14b0a189870449d3c6df0c8c025a780a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Mon, 20 Apr 2026 12:42:26 +0200
Subject: [PATCH 397/578] Rename ci-coq_lsp -> ci-rocq_lsp and update repo url

---
 Makefile.ci                                      | 4 ++--
 dev/ci/ci-basic-overlay.sh                       | 6 +++---
 dev/ci/scripts/{ci-coq_lsp.sh => ci-rocq_lsp.sh} | 4 ++--
 3 files changed, 7 insertions(+), 7 deletions(-)
 rename dev/ci/scripts/{ci-coq_lsp.sh => ci-rocq_lsp.sh} (91%)

diff --git a/Makefile.ci b/Makefile.ci
index 46933008afdf..e263604d6ed4 100644
--- a/Makefile.ci
+++ b/Makefile.ci
@@ -61,7 +61,7 @@ CI_TARGETS= \
     ci-coqtail \
     ci-coqutil \
     ci-cross_crypto \
-    ci-coq_lsp \
+    ci-rocq_lsp \
     ci-coq_performance_tests \
     ci-coq_tools \
     ci-deriving \
@@ -236,7 +236,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/dev/ci/ci-basic-overlay.sh b/dev/ci/ci-basic-overlay.sh
index a16ddf5de664..5c593493dc5e 100644
--- a/dev/ci/ci-basic-overlay.sh
+++ b/dev/ci/ci-basic-overlay.sh
@@ -266,10 +266,10 @@ 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
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

From 8aa7479419410331e6cd5fe90bebe5e0de0e3a1b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Mon, 20 Apr 2026 12:51:26 +0200
Subject: [PATCH 398/578] CI: reactivate rocq-lsp job

---
 .gitlab-ci.yml | 12 +++++-------
 1 file changed, 5 insertions(+), 7 deletions(-)

diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
index 542c27b9d6f6..91a51978b883 100644
--- a/.gitlab-ci.yml
+++ b/.gitlab-ci.yml
@@ -1297,13 +1297,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

From 9d9f9104ec2ced471fd0475fe42be6e49edb3caa Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Mon, 20 Apr 2026 15:15:43 +0200
Subject: [PATCH 399/578] Revert "Correctly check that a constant has a body in
 unfold at." (#21909)

It broke equations.

This reverts commit ad4a9627d549c18bbe2238063bab1ec036b54e83.
---
 pretyping/tacred.ml         | 6 +-----
 test-suite/bugs/bug_16380.v | 9 ---------
 2 files changed, 1 insertion(+), 14 deletions(-)
 delete mode 100644 test-suite/bugs/bug_16380.v

diff --git a/pretyping/tacred.ml b/pretyping/tacred.ml
index 14739547910c..67e746b58ef7 100644
--- a/pretyping/tacred.ml
+++ b/pretyping/tacred.ml
@@ -1295,14 +1295,11 @@ let unfold_red kn =
   in
   mkflags flags
 
-let error_opaque_evaluable env ref =
-  user_err Pp.(str (string_of_evaluable_ref env ref ^ " is opaque."))
-
 let unfold env sigma name c =
   if is_evaluable env sigma name then
     clos_norm_flags (unfold_red name) env sigma c
   else
-    error_opaque_evaluable env name
+    user_err Pp.(str (string_of_evaluable_ref env name^" is opaque."))
 
 (** [unfoldoccs : (readable_constraints -> (int list * full_path) -> constr -> constr)]
     unfolds the constant name in a term c following a list of occurrences occl.
@@ -1314,7 +1311,6 @@ let unfoldoccs env sigma (occs,name) c =
   | NoOccurrences -> c
   | AllOccurrences -> unfold env sigma name c
   | OnlyOccurrences _ | AllOccurrencesBut _ | AtLeastOneOccurrence ->
-    let () = if not (is_evaluable env sigma name) then error_opaque_evaluable env name in
     let (occ,uc) = substlin env sigma name occs c in
     if Int.equal occ 0 then
       user_err Pp.(str ((string_of_evaluable_ref env name)^" does not occur."));
diff --git a/test-suite/bugs/bug_16380.v b/test-suite/bugs/bug_16380.v
deleted file mode 100644
index c30e39dd7e94..000000000000
--- a/test-suite/bugs/bug_16380.v
+++ /dev/null
@@ -1,9 +0,0 @@
-Theorem a : nat.
-Proof.
-apply O.
-Qed.
-
-Theorem b : a <> a.
-Proof.
-Fail unfold a at 2.
-Abort.

From 20013afed571f746d76be23168e86c7c408a7704 Mon Sep 17 00:00:00 2001
From: Pierre Roux <pierre.roux@onera.fr>
Date: Tue, 31 Mar 2026 11:09:00 +0200
Subject: [PATCH 400/578] Remove legacy-loading-removed

Deprecated since 9.0
---
 ...21852-warnerror-legacy-loading-Removed.rst |  6 ++
 test-suite/bugs/bug_20902_1.v                 |  4 +-
 vernac/mltop.ml                               | 56 ++-----------------
 3 files changed, 12 insertions(+), 54 deletions(-)
 create mode 100644 doc/changelog/14-misc/21852-warnerror-legacy-loading-Removed.rst

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 <https://github.com/rocq-prover/rocq/pull/21852>`_,
+  by Pierre Roux).
diff --git a/test-suite/bugs/bug_20902_1.v b/test-suite/bugs/bug_20902_1.v
index 5c71741ab67b..a7272764056f 100644
--- a/test-suite/bugs/bug_20902_1.v
+++ b/test-suite/bugs/bug_20902_1.v
@@ -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/vernac/mltop.ml b/vernac/mltop.ml
index fda6db5febb5..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
 
@@ -464,7 +416,7 @@ 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

From a594288301b34ba196b038c93d2a67f1dc663270 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Mon, 20 Apr 2026 16:01:11 +0200
Subject: [PATCH 401/578] Move doc of refine attribute next to doc of
 Definition instead of Instance

---
 doc/sphinx/addendum/type-classes.rst     | 14 +-------------
 doc/sphinx/language/core/definitions.rst | 11 +++++++++++
 2 files changed, 12 insertions(+), 13 deletions(-)

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/language/core/definitions.rst b/doc/sphinx/language/core/definitions.rst
index 5a232d88b26c..e5d7dc440d3c 100644
--- a/doc/sphinx/language/core/definitions.rst
+++ b/doc/sphinx/language/core/definitions.rst
@@ -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

From f7cd0194828b4cd0d27254889cb6718419c0f702 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Mon, 20 Apr 2026 16:37:30 +0200
Subject: [PATCH 402/578] Infrastructure for printing non-flattened grammar
 structure

---
 gramlib/grammar.ml      | 155 ++++++++++++++++++++++------------------
 gramlib/grammar.mli     |   2 +-
 parsing/procq.ml        |   3 +-
 vernac/metasyntax.ml    |  20 +++---
 vernac/metasyntax.mli   |   4 +-
 vernac/vernacentries.ml |   4 +-
 6 files changed, 101 insertions(+), 87 deletions(-)

diff --git a/gramlib/grammar.ml b/gramlib/grammar.ml
index b09b167eed2e..6c6b9913b62a 100644
--- a/gramlib/grammar.ml
+++ b/gramlib/grammar.ml
@@ -69,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
@@ -771,15 +771,23 @@ let levels_of_rules entry edata st =
     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
@@ -819,65 +827,73 @@ 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) ->
+    | 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 ->
+    | 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 "@[<hov 0>";
-  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 "@[<hov 0>[ ";
-  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 "@[<hov 0>";
+    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 "@[<hov 0>[ ";
+    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 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 kwstate ppf elev =
+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 "@[<hov 2>";
        begin match lev.lname with
            Some n -> fprintf ppf "%a@;<1 2>" print_str n
@@ -890,13 +906,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 "@[<v 0>[ ";
   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 "<parser>"
   end;
   fprintf ppf " ]@]"
@@ -1639,7 +1655,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"
@@ -1647,12 +1663,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
@@ -1664,17 +1680,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')
diff --git a/gramlib/grammar.mli b/gramlib/grammar.mli
index 532fd02caaae..24c2f1decd30 100644
--- a/gramlib/grammar.mli
+++ b/gramlib/grammar.mli
@@ -73,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
diff --git a/parsing/procq.ml b/parsing/procq.ml
index fe11bd0075b9..7242d8a8be35 100644
--- a/parsing/procq.ml
+++ b/parsing/procq.ml
@@ -189,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
diff --git a/vernac/metasyntax.ml b/vernac/metasyntax.ml
index 0edc11a29957..fc81b0761298 100644
--- a/vernac/metasyntax.ml
+++ b/vernac/metasyntax.ml
@@ -79,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
@@ -134,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
@@ -166,7 +166,7 @@ let pr_grammar = function
           grammar)
         grammar known
     in
-    pr_grammar_subset grammar
+    pr_grammar_subset ~flatten grammar
 
 let custom_grammars = ref []
 
@@ -186,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)
@@ -194,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())))
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/vernacentries.ml b/vernac/vernacentries.ml
index 2e2826a7dae3..0f41f6b794fc 100644
--- a/vernac/vernacentries.ml
+++ b/vernac/vernacentries.ml
@@ -2277,8 +2277,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 ent -> no_state @@ fun () -> Metasyntax.pr_grammar ~flatten:true ent
+  | PrintCustomGrammar ent -> no_state @@ fun () -> Metasyntax.pr_custom_grammar ~flatten:true ent
   | PrintKeywords -> no_state Metasyntax.pr_keywords
   | PrintLoadPath dir -> (* For compatibility ? *) no_state @@ fun () -> print_loadpath dir
   | PrintLibraries -> no_state print_libraries

From 6f8c8e6408e1730d293854556d29c3cb462bf465 Mon Sep 17 00:00:00 2001
From: Jan-Oliver Kaiser <janno@skylabs-ai.com>
Date: Wed, 25 Mar 2026 15:09:49 +0100
Subject: [PATCH 403/578] Ltac2: Add `@@` and `|>` notation

---
 .../21819-janno-ltac2-syntax-Added.rst        |  4 +
 test-suite/ltac2/operator_notations.v         | 85 +++++++++++++++++++
 theories/Ltac2/Notations.v                    |  8 ++
 3 files changed, 97 insertions(+)
 create mode 100644 doc/changelog/06-Ltac2-language/21819-janno-ltac2-syntax-Added.rst
 create mode 100644 test-suite/ltac2/operator_notations.v

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 <https://github.com/rocq-prover/rocq/pull/21819>`_,
+  by Jan-Oliver Kaiser).
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/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 *)

From f0b1996b4acdaf7b4868d7d5e9d44a18c1908894 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Mon, 20 Apr 2026 15:16:50 +0200
Subject: [PATCH 404/578] Update repo URL for equations

---
 dev/ci/ci-basic-overlay.sh | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/dev/ci/ci-basic-overlay.sh b/dev/ci/ci-basic-overlay.sh
index a16ddf5de664..f5de8946c295 100644
--- a/dev/ci/ci-basic-overlay.sh
+++ b/dev/ci/ci-basic-overlay.sh
@@ -274,7 +274,7 @@ project coq_lsp "https://github.com/ejgallego/coq-lsp" "main"
 ########################################################################
 # Equations
 ########################################################################
-project equations "https://github.com/mattam82/Coq-Equations" "main"
+project equations "https://github.com/rocq-prover/equations" "main"
 # Contact @mattam82 on github
 
 ########################################################################

From b34d48ef6d1803dbe3d25cd15c561e573d5bab1c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Mon, 20 Apr 2026 16:44:15 +0200
Subject: [PATCH 405/578] Print Grammar Tree: print non flattened grammar

---
 .../21934-print-flat-Added.rst                |  4 ++
 .../user-extensions/syntax-extensions.rst     | 21 +++++-
 doc/tools/docgram/fullGrammar                 |  4 +-
 doc/tools/docgram/orderedGrammar              |  4 +-
 test-suite/output/PrintGrammarTree.out        | 69 +++++++++++++++++++
 test-suite/output/PrintGrammarTree.v          |  4 ++
 vernac/g_vernac.mlg                           |  8 +--
 vernac/ppvernac.ml                            |  9 +--
 vernac/vernacentries.ml                       |  4 +-
 vernac/vernacexpr.mli                         |  4 +-
 10 files changed, 113 insertions(+), 18 deletions(-)
 create mode 100644 doc/changelog/08-vernac-commands-and-options/21934-print-flat-Added.rst
 create mode 100644 test-suite/output/PrintGrammarTree.out
 create mode 100644 test-suite/output/PrintGrammarTree.v

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 <https://github.com/rocq-prover/rocq/pull/21934>`_,
+  by Gaëtan Gilbert).
diff --git a/doc/sphinx/user-extensions/syntax-extensions.rst b/doc/sphinx/user-extensions/syntax-extensions.rst
index aaacd625632a..ac5c8c1f5b07 100644
--- a/doc/sphinx/user-extensions/syntax-extensions.rst
+++ b/doc/sphinx/user-extensions/syntax-extensions.rst
@@ -719,7 +719,7 @@ Displaying information about notations
    Prints the current reserved :ref:`keywords <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
@@ -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/tools/docgram/fullGrammar b/doc/tools/docgram/fullGrammar
index 54fe8892b8a5..13a698a5ba37 100644
--- a/doc/tools/docgram/fullGrammar
+++ b/doc/tools/docgram/fullGrammar
@@ -1413,8 +1413,8 @@ printable: [
 | "Term" smart_global OPT univ_name_list
 | "All"
 | "Section" global
-| "Grammar" LIST0 IDENT
-| "Custom" "Grammar" qualid
+| "Grammar" OPT "Tree" LIST0 IDENT
+| "Custom" "Grammar" OPT "Tree" qualid
 | "Keywords"
 | "LoadPath" OPT dirpath
 | "Libraries"
diff --git a/doc/tools/docgram/orderedGrammar b/doc/tools/docgram/orderedGrammar
index 86852d2d0b00..49aded275900 100644
--- a/doc/tools/docgram/orderedGrammar
+++ b/doc/tools/docgram/orderedGrammar
@@ -759,8 +759,8 @@ 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"
diff --git a/test-suite/output/PrintGrammarTree.out b/test-suite/output/PrintGrammarTree.out
new file mode 100644
index 000000000000..41985b93f377
--- /dev/null
+++ b/test-suite/output/PrintGrammarTree.out
@@ -0,0 +1,69 @@
+Entry constr is
+[ LEFTA
+  [ "@"; global; univ_annot
+  | term LEVEL "8" ] ]
+
+Entry lconstr is
+[ LEFTA
+  [ term LEVEL "200" ] ]
+
+Entry term is
+[ "200" RIGHTA
+  [  ]
+| "100" RIGHTA
+  [ SELF;
+    [ "<:"; term LEVEL "200"
+    | "<<:"; term LEVEL "200"
+    | ":>"; term LEVEL "200"
+    | ":"; term LEVEL "200" ] ]
+| "99" RIGHTA
+  [  ]
+| "90" RIGHTA
+  [  ]
+| "10" LEFTA
+  [ SELF; LIST1 arg
+  | "@"; [ global; univ_annot; LIST0 NEXT
+         | pattern_ident; LIST1 identref ]
+  | "forall"; open_binders; ","; term LEVEL "200"
+  | "fun"; open_binders; "=>"; term LEVEL "200"
+  | "let";
+    [ "fix"; fix_decl; "in"; term LEVEL "200"
+    | "cofix"; cofix_body; "in"; term LEVEL "200"
+    | "'"; pattern LEVEL "200"; OPT [ "in"; pattern LEVEL "200" ]; ":="; term
+      LEVEL "200"; OPT case_type; "in"; term LEVEL "200"
+    | name; binders; let_type_cstr; ":="; term LEVEL "200"; "in"; term LEVEL
+      "200"
+    | [ "("; LIST0 name SEP ","; ")" | "()" ]; as_return_type; ":="; term
+      LEVEL "200"; "in"; term LEVEL "200" ]
+  | "if"; term LEVEL "200"; as_return_type; "then"; term LEVEL "200"; "else";
+    term LEVEL "200"
+  | "fix"; fix_decls
+  | "cofix"; cofix_decls ]
+| "9" LEFTA
+  [ ".."; term LEVEL "0"; ".." ]
+| "8" LEFTA
+  [  ]
+| "1" LEFTA
+  [ SELF;
+    [ ".(";
+      [ "@"; global; univ_annot; LIST0 (term LEVEL "9"); ")"
+      | global; univ_annot; LIST0 arg; ")" ]
+    | "%"; IDENT
+    | "%_"; IDENT ] ]
+| "0" LEFTA
+  [ "["; term LEVEL "10";
+    [ "+"; "+"; "*"; LIST1 (term LEVEL "10") SEP ["+"; "+"; "*"]; "|"; term
+      LEVEL "200"; "]"
+    | "|"; term LEVEL "200"; "]" ]
+  | "("; term LEVEL "200"; ")"
+  | "{|"; record_declaration; '|}'
+  | "`{"; term LEVEL "200"; "}"
+  | "`("; term LEVEL "200"; ")"
+  | NUMBER
+  | atomic_constr
+  | term_match
+  | reference; univ_annot
+  | string
+  | test_array_opening; "["; "|"; array_elems; "|"; lconstr; type_cstr;
+    test_array_closing; "|"; "]"; univ_annot ] ]
+
diff --git a/test-suite/output/PrintGrammarTree.v b/test-suite/output/PrintGrammarTree.v
new file mode 100644
index 000000000000..c74da1abf387
--- /dev/null
+++ b/test-suite/output/PrintGrammarTree.v
@@ -0,0 +1,4 @@
+(* coq-prog-args: ("-nois") *)
+
+Notation "[ a + + * .. + + * c | d ]" := (forall _ : a, .. (forall _ : c, d) ..) (a at level 10).
+Print Grammar Tree constr.
diff --git a/vernac/g_vernac.mlg b/vernac/g_vernac.mlg
index ce80d2ee3c02..38cf3478ee85 100644
--- a/vernac/g_vernac.mlg
+++ b/vernac/g_vernac.mlg
@@ -1169,12 +1169,12 @@ GRAMMAR EXTEND Gram
     [ [ IDENT "Term"; qid = smart_global; l = OPT univ_name_list -> { PrintName (qid,l) }
       | 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 }
diff --git a/vernac/ppvernac.ml b/vernac/ppvernac.ml
index ccdf088cdf48..f9a153f80aee 100644
--- a/vernac/ppvernac.ml
+++ b/vernac/ppvernac.ml
@@ -620,11 +620,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 ->
diff --git a/vernac/vernacentries.ml b/vernac/vernacentries.ml
index 0f41f6b794fc..c5ac4dde661d 100644
--- a/vernac/vernacentries.ml
+++ b/vernac/vernacentries.ml
@@ -2277,8 +2277,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 ~flatten:true ent
-  | PrintCustomGrammar ent -> no_state @@ fun () -> Metasyntax.pr_custom_grammar ~flatten:true 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
diff --git a/vernac/vernacexpr.mli b/vernac/vernacexpr.mli
index bc9d6fd5e77a..31e949f584e6 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

From 811245e44597298067d13dac60e7adde35c5630a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Mon, 20 Apr 2026 16:57:45 +0200
Subject: [PATCH 406/578] Print Grammar: no breaking spaces in `entry LEVEL
 "lev"`

---
 gramlib/grammar.ml                          |  3 +-
 test-suite/output-coqtop/LevelTolerance.out |  4 +-
 test-suite/output/PrintGrammar.out          | 44 ++++++++++-----------
 test-suite/output/PrintGrammarConstr.out    |  4 +-
 test-suite/output/PrintGrammarTree.out      | 16 ++++----
 5 files changed, 35 insertions(+), 36 deletions(-)

diff --git a/gramlib/grammar.ml b/gramlib/grammar.ml
index 6c6b9913b62a..b7bf677d6bb4 100644
--- a/gramlib/grammar.ml
+++ b/gramlib/grammar.ml
@@ -842,8 +842,7 @@ let print_level ~flatten =
     | 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
+      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 ->
diff --git a/test-suite/output-coqtop/LevelTolerance.out b/test-suite/output-coqtop/LevelTolerance.out
index 1518a522a9a1..7800991c74e0 100644
--- a/test-suite/output-coqtop/LevelTolerance.out
+++ b/test-suite/output-coqtop/LevelTolerance.out
@@ -598,8 +598,8 @@ Rocq < Rocq < Entry ltac_expr is
 | "1" RIGHTA
   [ "atom1"
   | "fun"; LIST1 input_fun; "=>"; ltac_expr LEVEL "5"
-  | "let"; [ IDENT "rec" |  ]; LIST1 let_clause SEP "with"; "in"; ltac_expr
-    LEVEL "5"
+  | "let"; [ IDENT "rec" |  ]; LIST1 let_clause SEP "with"; "in";
+    ltac_expr LEVEL "5"
   | IDENT "first"; "["; LIST0 ltac_expr SEP "|"; "]"
   | IDENT "solve"; "["; LIST0 ltac_expr SEP "|"; "]"
   | IDENT "idtac"; LIST0 message_token
diff --git a/test-suite/output/PrintGrammar.out b/test-suite/output/PrintGrammar.out
index 1724e7df811f..41bf76008457 100644
--- a/test-suite/output/PrintGrammar.out
+++ b/test-suite/output/PrintGrammar.out
@@ -59,12 +59,12 @@ Entry term is
   [ SELF; "^"; term LEVEL "30" ]
 | "10" LEFTA
   [ SELF; LIST1 arg
-  | "exists2"; "'"; pattern LEVEL "0"; ":"; term LEVEL "200"; ","; term LEVEL
-    "200"; "&"; term LEVEL "200"
-  | "exists2"; "'"; pattern LEVEL "0"; ","; term LEVEL "200"; "&"; term LEVEL
-    "200"
-  | "exists2"; name; ":"; term LEVEL "200"; ","; term LEVEL "200"; "&"; term
-    LEVEL "200"
+  | "exists2"; "'"; pattern LEVEL "0"; ":"; term LEVEL "200"; ",";
+    term LEVEL "200"; "&"; term LEVEL "200"
+  | "exists2"; "'"; pattern LEVEL "0"; ","; term LEVEL "200"; "&";
+    term LEVEL "200"
+  | "exists2"; name; ":"; term LEVEL "200"; ","; term LEVEL "200"; "&";
+    term LEVEL "200"
   | "exists2"; name; ","; term LEVEL "200"; "&"; term LEVEL "200"
   | "exists"; "!"; open_binders; ","; term LEVEL "200"
   | "exists"; open_binders; ","; term LEVEL "200"
@@ -76,8 +76,8 @@ Entry term is
   | "let"; "cofix"; cofix_body; "in"; term LEVEL "200"
   | "let"; "'"; pattern LEVEL "200"; OPT [ "in"; pattern LEVEL "200" ]; ":=";
     term LEVEL "200"; OPT case_type; "in"; term LEVEL "200"
-  | "let"; name; binders; let_type_cstr; ":="; term LEVEL "200"; "in"; term
-    LEVEL "200"
+  | "let"; name; binders; let_type_cstr; ":="; term LEVEL "200"; "in";
+    term LEVEL "200"
   | "let"; [ "("; LIST0 name SEP ","; ")" | "()" ]; as_return_type; ":=";
     term LEVEL "200"; "in"; term LEVEL "200"
   | "if"; term LEVEL "200"; as_return_type; "then"; term LEVEL "200"; "else";
@@ -96,19 +96,19 @@ Entry term is
   | SELF; "%"; IDENT
   | SELF; "%_"; IDENT ]
 | "0" LEFTA
-  [ "{"; "'"; pattern LEVEL "0"; "&"; term LEVEL "200"; "&"; term LEVEL
-    "200"; "}"
+  [ "{"; "'"; pattern LEVEL "0"; "&"; term LEVEL "200"; "&";
+    term LEVEL "200"; "}"
   | "{"; "'"; pattern LEVEL "0"; "&"; term LEVEL "200"; "}"
-  | "{"; "'"; pattern LEVEL "0"; ":"; term LEVEL "200"; "&"; term LEVEL
-    "200"; "&"; term LEVEL "200"; "}"
-  | "{"; "'"; pattern LEVEL "0"; ":"; term LEVEL "200"; "&"; term LEVEL
-    "200"; "}"
-  | "{"; "'"; pattern LEVEL "0"; ":"; term LEVEL "200"; "|"; term LEVEL
-    "200"; "&"; term LEVEL "200"; "}"
-  | "{"; "'"; pattern LEVEL "0"; ":"; term LEVEL "200"; "|"; term LEVEL
-    "200"; "}"
-  | "{"; "'"; pattern LEVEL "0"; "|"; term LEVEL "200"; "&"; term LEVEL
-    "200"; "}"
+  | "{"; "'"; pattern LEVEL "0"; ":"; term LEVEL "200"; "&";
+    term LEVEL "200"; "&"; term LEVEL "200"; "}"
+  | "{"; "'"; pattern LEVEL "0"; ":"; term LEVEL "200"; "&";
+    term LEVEL "200"; "}"
+  | "{"; "'"; pattern LEVEL "0"; ":"; term LEVEL "200"; "|";
+    term LEVEL "200"; "&"; term LEVEL "200"; "}"
+  | "{"; "'"; pattern LEVEL "0"; ":"; term LEVEL "200"; "|";
+    term LEVEL "200"; "}"
+  | "{"; "'"; pattern LEVEL "0"; "|"; term LEVEL "200"; "&";
+    term LEVEL "200"; "}"
   | "{"; "'"; pattern LEVEL "0"; "|"; term LEVEL "200"; "}"
   | "{"; term LEVEL "99"; "&"; term LEVEL "200"; "&"; term LEVEL "200"; "}"
   | "{"; term LEVEL "99"; "&"; term LEVEL "200"; "}"
@@ -122,8 +122,8 @@ Entry term is
   | "{"; term LEVEL "99"; "|"; term LEVEL "200"; "}"
   | "{"; term LEVEL "99"; "}"
   | IDENT "ltac"; ":"; "("; ltac_expr; ")"
-  | "("; term LEVEL "200"; ","; term LEVEL "200"; ","; LIST1 (term LEVEL
-    "200") SEP ","; ")"
+  | "("; term LEVEL "200"; ","; term LEVEL "200"; ",";
+    LIST1 (term LEVEL "200") SEP ","; ")"
   | "("; term LEVEL "200"; ","; term LEVEL "200"; ")"
   | "("; term LEVEL "200"; ")"
   | "{|"; record_declaration; '|}'
diff --git a/test-suite/output/PrintGrammarConstr.out b/test-suite/output/PrintGrammarConstr.out
index 43647dab85cb..206ceaf73b30 100644
--- a/test-suite/output/PrintGrammarConstr.out
+++ b/test-suite/output/PrintGrammarConstr.out
@@ -29,8 +29,8 @@ Entry term is
   | "let"; "cofix"; cofix_body; "in"; term LEVEL "200"
   | "let"; "'"; pattern LEVEL "200"; OPT [ "in"; pattern LEVEL "200" ]; ":=";
     term LEVEL "200"; OPT case_type; "in"; term LEVEL "200"
-  | "let"; name; binders; let_type_cstr; ":="; term LEVEL "200"; "in"; term
-    LEVEL "200"
+  | "let"; name; binders; let_type_cstr; ":="; term LEVEL "200"; "in";
+    term LEVEL "200"
   | "let"; [ "("; LIST0 name SEP ","; ")" | "()" ]; as_return_type; ":=";
     term LEVEL "200"; "in"; term LEVEL "200"
   | "if"; term LEVEL "200"; as_return_type; "then"; term LEVEL "200"; "else";
diff --git a/test-suite/output/PrintGrammarTree.out b/test-suite/output/PrintGrammarTree.out
index 41985b93f377..9721f5a454d8 100644
--- a/test-suite/output/PrintGrammarTree.out
+++ b/test-suite/output/PrintGrammarTree.out
@@ -29,12 +29,12 @@ Entry term is
   | "let";
     [ "fix"; fix_decl; "in"; term LEVEL "200"
     | "cofix"; cofix_body; "in"; term LEVEL "200"
-    | "'"; pattern LEVEL "200"; OPT [ "in"; pattern LEVEL "200" ]; ":="; term
-      LEVEL "200"; OPT case_type; "in"; term LEVEL "200"
-    | name; binders; let_type_cstr; ":="; term LEVEL "200"; "in"; term LEVEL
-      "200"
-    | [ "("; LIST0 name SEP ","; ")" | "()" ]; as_return_type; ":="; term
-      LEVEL "200"; "in"; term LEVEL "200" ]
+    | "'"; pattern LEVEL "200"; OPT [ "in"; pattern LEVEL "200" ]; ":=";
+      term LEVEL "200"; OPT case_type; "in"; term LEVEL "200"
+    | name; binders; let_type_cstr; ":="; term LEVEL "200"; "in";
+      term LEVEL "200"
+    | [ "("; LIST0 name SEP ","; ")" | "()" ]; as_return_type; ":=";
+      term LEVEL "200"; "in"; term LEVEL "200" ]
   | "if"; term LEVEL "200"; as_return_type; "then"; term LEVEL "200"; "else";
     term LEVEL "200"
   | "fix"; fix_decls
@@ -52,8 +52,8 @@ Entry term is
     | "%_"; IDENT ] ]
 | "0" LEFTA
   [ "["; term LEVEL "10";
-    [ "+"; "+"; "*"; LIST1 (term LEVEL "10") SEP ["+"; "+"; "*"]; "|"; term
-      LEVEL "200"; "]"
+    [ "+"; "+"; "*"; LIST1 (term LEVEL "10") SEP ["+"; "+"; "*"]; "|";
+      term LEVEL "200"; "]"
     | "|"; term LEVEL "200"; "]" ]
   | "("; term LEVEL "200"; ")"
   | "{|"; record_declaration; '|}'

From 926aa6ecbf1a8968dad1fb05b9306ebe458f05b8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Tue, 21 Apr 2026 14:42:24 +0200
Subject: [PATCH 407/578] rocqmakefile avoid using make's filter on full source
 lists

We do this by changing the interface of `-sources-of` to include the
specific expected extension.

Fix #21894
---
 .../coq-makefile/expand-directories/a/g.mli   |  0
 .../coq-makefile/expand-directories/run.sh    | 17 ++++++---
 .../coq-makefile/expand-directories2/run.sh   |  2 +-
 tools/rocqmakefile.ml                         | 35 ++++++++++---------
 4 files changed, 32 insertions(+), 22 deletions(-)
 create mode 100644 test-suite/coq-makefile/expand-directories/a/g.mli

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/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

From 3c45c58280dea045b0a513a9afab7b464ae2ed58 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Tue, 21 Apr 2026 14:47:54 +0200
Subject: [PATCH 408/578] Take simpl output test back from stdlib test suite

AFAICT it was there because it uses strings to print some separators
with Check, but we can just use primitive strings from corelib for that.

We could also use ltac idtacs if we wanted to avoid primstring.
---
 test-suite/output/simpl.out | 443 ++++++++++++++++++++++++++++++++++++
 test-suite/output/simpl.v   | 321 ++++++++++++++++++++++++++
 2 files changed, 764 insertions(+)
 create mode 100644 test-suite/output/simpl.out
 create mode 100644 test-suite/output/simpl.v

diff --git a/test-suite/output/simpl.out b/test-suite/output/simpl.out
new file mode 100644
index 000000000000..174282c91b19
--- /dev/null
+++ b/test-suite/output/simpl.out
@@ -0,0 +1,443 @@
+1 goal
+  
+  x : nat
+  ============================
+  x = S x
+1 goal
+  
+  x : nat
+  ============================
+  0 + x = S x
+1 goal
+  
+  x : nat
+  ============================
+  x = 1 + x
+"** NonRecursiveDefinition"
+     : string
+     = true
+     : bool
+     = true
+     : bool
+     = true
+     : bool
+     = true && true
+     : bool
+     = true && true
+     : bool
+     = true
+     : bool
+"** RecursiveDefinition"
+     : string
+     = 0
+     : nat
+     = 0
+     : nat
+     = 0
+     : nat
+     = 0 + 0
+     : nat
+     = 0 + 0
+     : nat
+     = 0
+     : nat
+"** NonPrimitiveProjection"
+     : string
+"DirectTuple (NonPrimitiveProjection)"
+     : string
+     = 0
+     : nat
+     = 0
+     : nat
+     = 0
+     : nat
+     = TUPLE.(p)
+     : nat
+     = TUPLE.(p)
+     : nat
+     = 0
+     : nat
+"NamedTuple (NonPrimitiveProjection)"
+     : string
+     = 0
+     : nat
+     = 0
+     : nat
+     = 0
+     : nat
+     = a.(p)
+     : nat
+     = a.(p)
+     : nat
+     = 0
+     : nat
+     = 0
+     : nat
+     = a.(p)
+     : nat
+     = 0
+     : nat
+"DirectCoFix (NonPrimitiveProjection)"
+     : string
+     = COFIX
+     : U
+     = COFIX
+     : U
+     = COFIX
+     : U
+     = COFIX.(p)
+     : U
+     = COFIX.(p)
+     : U
+     = COFIX
+     : U
+"NamedCoFix (NonPrimitiveProjection)"
+     : string
+     = a
+     : U
+     = a
+     : U
+     = a
+     : U
+     = a.(p)
+     : U
+     = a.(p)
+     : U
+     = a
+     : U
+     = a
+     : U
+     = a.(p)
+     : U
+     = a
+     : U
+"** PrimitiveProjectionFolded"
+     : string
+"DirectTuple (PrimitiveProjectionFolded)"
+     : string
+     = 0
+     : nat
+     = 0
+     : nat
+     = 0
+     : nat
+     = TUPLE.(p)
+     : nat
+     = TUPLE.(p)
+     : nat
+     = 0
+     : nat
+"NamedTuple (PrimitiveProjectionFolded)"
+     : string
+     = 0
+     : nat
+     = 0
+     : nat
+     = 0
+     : nat
+     = a.(p)
+     : nat
+     = a.(p)
+     : nat
+     = 0
+     : nat
+     = 0
+     : nat
+     = a.(p)
+     : nat
+     = 0
+     : nat
+"DirectCoFix (PrimitiveProjectionFolded)"
+     : string
+     = COFIX
+     : U
+     = COFIX
+     : U
+     = COFIX
+     : U
+     = COFIX.(p)
+     : U
+     = COFIX.(p)
+     : U
+     = COFIX
+     : U
+"NamedCoFix (PrimitiveProjectionFolded)"
+     : string
+     = a
+     : U
+     = a
+     : U
+     = a
+     : U
+     = a.(p)
+     : U
+     = a.(p)
+     : U
+     = a
+     : U
+     = a
+     : U
+     = a.(p)
+     : U
+     = a
+     : U
+"** PrimitiveProjectionUnfolded"
+     : string
+"DirectTuple (PrimitiveProjectionUnfolded)"
+     : string
+1 goal
+  
+  ============================
+  P 0
+1 goal
+  
+  ============================
+  P 0
+1 goal
+  
+  ============================
+  P 0
+1 goal
+  
+  ============================
+  P 0
+1 goal
+  
+  ============================
+  P {| p := 0 |}.(p)
+1 goal
+  
+  ============================
+  P 0
+"NamedTuple (PrimitiveProjectionUnfolded)"
+     : string
+1 goal
+  
+  ============================
+  P 0
+1 goal
+  
+  ============================
+  P 0
+1 goal
+  
+  ============================
+  P a.(p)
+1 goal
+  
+  ============================
+  P 0
+1 goal
+  
+  ============================
+  P a.(p)
+1 goal
+  
+  ============================
+  P a.(p)
+1 goal
+  
+  ============================
+  P 0
+1 goal
+  
+  ============================
+  P a.(p)
+1 goal
+  
+  ============================
+  P a.(p)
+"DirectCoFix (PrimitiveProjectionUnfolded)"
+     : string
+1 goal
+  
+  ============================
+  P COFIX
+1 goal
+  
+  ============================
+  P COFIX
+1 goal
+  
+  ============================
+  P COFIX
+1 goal
+  
+  ============================
+  P COFIX
+1 goal
+  
+  ============================
+  P COFIX.(q)
+1 goal
+  
+  ============================
+  P COFIX
+"NamedCoFix (PrimitiveProjectionUnfolded)"
+     : string
+1 goal
+  
+  ============================
+  P a
+1 goal
+  
+  ============================
+  P a
+1 goal
+  
+  ============================
+  P a.(q)
+1 goal
+  
+  ============================
+  P a
+1 goal
+  
+  ============================
+  P a.(q)
+1 goal
+  
+  ============================
+  P a.(q)
+1 goal
+  
+  ============================
+  P a
+1 goal
+  
+  ============================
+  P a.(q)
+1 goal
+  
+  ============================
+  P a.(q)
+"** PrimitiveProjectionConstant"
+     : string
+"DirectTuple (PrimitiveProjectionConstant)"
+     : string
+1 goal
+  
+  ============================
+  P 0
+1 goal
+  
+  ============================
+  P 0
+1 goal
+  
+  ============================
+  P TUPLE.(p)
+1 goal
+  
+  ============================
+  P TUPLE.(p)
+1 goal
+  
+  ============================
+  P TUPLE.(p)
+1 goal
+  
+  ============================
+  P TUPLE.(p)
+"NamedTuple (PrimitiveProjectionConstant)"
+     : string
+1 goal
+  
+  ============================
+  P 0
+1 goal
+  
+  ============================
+  P 0
+1 goal
+  
+  ============================
+  P a.(p)
+1 goal
+  
+  ============================
+  P a.(p)
+1 goal
+  
+  ============================
+  P a.(p)
+1 goal
+  
+  ============================
+  P a.(p)
+1 goal
+  
+  ============================
+  P 0
+1 goal
+  
+  ============================
+  P a.(p)
+1 goal
+  
+  ============================
+  P a.(p)
+"DirectCoFix (PrimitiveProjectionConstant)"
+     : string
+1 goal
+  
+  ============================
+  P COFIX
+1 goal
+  
+  ============================
+  P COFIX
+1 goal
+  
+  ============================
+  P COFIX.(q)
+1 goal
+  
+  ============================
+  P COFIX.(q)
+1 goal
+  
+  ============================
+  P COFIX.(q)
+1 goal
+  
+  ============================
+  P COFIX.(q)
+"NamedCoFix (PrimitiveProjectionConstant)"
+     : string
+1 goal
+  
+  ============================
+  P a
+1 goal
+  
+  ============================
+  P a
+1 goal
+  
+  ============================
+  P a.(q)
+1 goal
+  
+  ============================
+  P a.(q)
+1 goal
+  
+  ============================
+  P a.(q)
+1 goal
+  
+  ============================
+  P a.(q)
+1 goal
+  
+  ============================
+  P a
+1 goal
+  
+  ============================
+  P a.(q)
+1 goal
+  
+  ============================
+  P a.(q)
diff --git a/test-suite/output/simpl.v b/test-suite/output/simpl.v
new file mode 100644
index 000000000000..fe52528d358d
--- /dev/null
+++ b/test-suite/output/simpl.v
@@ -0,0 +1,321 @@
+(* Simpl with patterns *)
+
+Goal forall x, 0+x = 1+x.
+Proof.
+intro x.
+simpl (_ + x).
+Show.
+change (0+x = 1+x).
+simpl (_ + x) at 2.
+Show.
+change (0+x = 1+x).
+simpl (0 + _).
+Show.
+Abort.
+
+Require Import PrimString.
+Open Scope pstring_scope.
+Module NonRecursiveDefinition.
+Check "** NonRecursiveDefinition".
+Open Scope bool_scope.
+Eval simpl in true && true.  (* -> true *)
+Eval cbn in true && true.    (* -> true *)
+Eval hnf in true && true.    (* -> true *)
+Arguments andb : simpl never.
+Eval simpl in true && true.  (* -> true && true *)
+Eval cbn in true && true.    (* -> true && true *)
+Eval hnf in true && true.    (* -> true *)
+End NonRecursiveDefinition.
+
+Module RecursiveDefinition.
+Check "** RecursiveDefinition".
+Eval simpl in 0 + 0.  (* -> 0 *)
+Eval cbn in 0 + 0.    (* -> 0 *)
+Eval hnf in 0 + 0.    (* -> 0 *)
+Arguments Nat.add : simpl never.
+Eval simpl in 0 + 0.  (* -> 0 + 0 *)
+Eval cbn in 0 + 0.    (* -> 0 + 0 *)
+Eval hnf in 0 + 0.    (* -> 0 + 0 *) (* hnf modified by simpl never, bug never 2 *)
+End RecursiveDefinition.
+
+Set Printing Projections.
+
+Module NonPrimitiveProjection.
+Check "** NonPrimitiveProjection".
+Module DirectTuple.
+Check "DirectTuple (NonPrimitiveProjection)".
+Record T := {p:nat}.
+Abbreviation TUPLE := {|p:=0|}.
+Eval simpl in TUPLE.(p).  (* -> 0 *)
+Eval cbn in TUPLE.(p).    (* -> 0 *)
+Eval hnf in TUPLE.(p).    (* -> 0 *)
+Arguments p : simpl never.
+Eval simpl in TUPLE.(p).  (* -> TUPLE.(p) *)
+Eval cbn in TUPLE.(p).    (* -> TUPLE.(p) *)
+Eval hnf in TUPLE.(p).    (* -> 0 *)
+End DirectTuple.
+
+Module NamedTuple.
+Check "NamedTuple (NonPrimitiveProjection)".
+Record T := {p:nat}.
+Definition a := {|p:=0|}.
+Eval simpl in a.(p).  (* -> 0 *)
+Eval cbn in a.(p).    (* -> 0 *)
+Eval hnf in a.(p).    (* -> 0 *)
+Arguments p : simpl never.
+Eval simpl in a.(p).  (* -> a.(p) *)
+Eval cbn in a.(p).    (* -> a.(p) *)
+Eval hnf in a.(p).    (* -> 0 *)
+Arguments p : simpl nomatch.
+Arguments a : simpl never.
+Eval simpl in a.(p).  (* -> 0 *) (* never not respected on purpose [*] *)
+Eval cbn in a.(p).    (* -> a.(p) *)
+Eval hnf in a.(p).    (* -> 0 *)
+End NamedTuple.
+(* [*] Enrico: https://github.com/coq/coq/pull/18581#issuecomment-1914325999 *)
+
+Module DirectCoFix.
+Check "DirectCoFix (NonPrimitiveProjection)".
+CoInductive U := {p:U}.
+Abbreviation COFIX := (cofix a := {|p:=a|}).
+Eval simpl in COFIX.(p).  (* -> COFIX *)
+Eval cbn in COFIX.(p).    (* -> COFIX *)
+Eval hnf in COFIX.(p).    (* -> COFIX *)
+Arguments p : simpl never.
+Eval simpl in COFIX.(p).  (* -> COFIX.(p) *)
+Eval cbn in COFIX.(p).    (* -> COFIX.(p) *)
+Eval hnf in COFIX.(p).    (* -> COFIX *)
+End DirectCoFix.
+
+Module NamedCoFix.
+Check "NamedCoFix (NonPrimitiveProjection)".
+CoInductive U := {p:U}.
+CoFixpoint a := {|p:=a|}.
+Eval simpl in a.(p).  (* -> a *)
+Eval cbn in a.(p).    (* -> a *)
+Eval hnf in a.(p).    (* -> a *)
+Arguments p : simpl never.
+Eval simpl in a.(p).  (* -> a.(p) *)
+Eval cbn in a.(p).    (* -> a.(p) *)
+Eval hnf in a.(p).    (* -> a *)
+Arguments p : simpl nomatch.
+Arguments a : simpl never.
+Eval simpl in a.(p).  (* -> a *) (* never not respected on purpose *)
+Eval cbn in a.(p).    (* -> a.(p) *)
+Eval hnf in a.(p).    (* -> a *)
+End NamedCoFix.
+End NonPrimitiveProjection.
+
+Module PrimitiveProjectionFolded.
+Check "** PrimitiveProjectionFolded".
+Set Primitive Projections.
+
+Module DirectTuple.
+Check "DirectTuple (PrimitiveProjectionFolded)".
+Record T := {p:nat}.
+Abbreviation TUPLE := {|p:=0|}.
+Eval simpl in TUPLE.(p).  (* -> 0 *)
+Eval cbn in TUPLE.(p).    (* -> 0 *)
+Eval hnf in TUPLE.(p).    (* -> 0 *)
+Arguments p : simpl never.
+Eval simpl in TUPLE.(p).  (* -> TUPLE.(p) *)
+Eval cbn in TUPLE.(p).    (* -> TUPLE.(p) *)
+Eval hnf in TUPLE.(p).    (* -> 0 *)
+End DirectTuple.
+
+Module NamedTuple.
+Check "NamedTuple (PrimitiveProjectionFolded)".
+Record T := {p:nat}.
+Definition a := {|p:=0|}.
+Eval simpl in a.(p).  (* -> 0 *)
+Eval cbn in a.(p).    (* -> 0 *)
+Eval hnf in a.(p).    (* -> 0 *)
+Arguments p : simpl never.
+Eval simpl in a.(p).  (* -> a.(p) *)
+Eval cbn in a.(p).    (* -> a.(p) *)
+Eval hnf in a.(p).    (* -> 0 *)
+Arguments p : simpl nomatch.
+Arguments a : simpl never.
+Eval simpl in a.(p).  (* -> ) *) (* never not respected on purpose *)
+Eval cbn in a.(p).    (* -> a.(p) *)
+Eval hnf in a.(p).    (* -> 0 *)
+End NamedTuple.
+
+Module DirectCoFix.
+Check "DirectCoFix (PrimitiveProjectionFolded)".
+CoInductive U := {p:U}.
+Abbreviation COFIX := (cofix a := {|p:=a|}).
+Eval simpl in COFIX.(p).  (* -> COFIX *)
+Eval cbn in COFIX.(p).    (* -> COFIX *)
+Eval hnf in COFIX.(p).    (* -> COFIX *)
+Arguments p : simpl never.
+Eval simpl in COFIX.(p).  (* -> COFIX.(p) *)
+Eval cbn in COFIX.(p).    (* -> COFIX.(p) *)
+Eval hnf in COFIX.(p).    (* -> COFIX *)
+End DirectCoFix.
+
+Module NamedCoFix.
+Check "NamedCoFix (PrimitiveProjectionFolded)".
+CoInductive U := {p:U}.
+CoFixpoint a := {|p:=a|}.
+Eval simpl in a.(p).     (* -> a *)
+Eval cbn in a.(p).       (* -> a *)
+Eval hnf in a.(p).       (* -> a *)
+Arguments p : simpl never.
+Eval simpl in a.(p).     (* -> a.(p) *)
+Eval cbn in a.(p).       (* -> a.(p) *)
+Eval hnf in a.(p).       (* -> a *)
+Arguments p : simpl nomatch.
+Arguments a : simpl never.
+Eval simpl in a.(p).     (* -> a *) (* never not respected on purpose *)
+Eval cbn in a.(p).       (* -> a.(p) *)
+Eval hnf in a.(p).       (* -> a *)
+End NamedCoFix.
+End PrimitiveProjectionFolded.
+
+Module PrimitiveProjectionUnfolded.
+Check "** PrimitiveProjectionUnfolded".
+(* we use an unfold trick to create an unfolded projection *)
+Set Primitive Projections.
+
+Module DirectTuple.
+Check "DirectTuple (PrimitiveProjectionUnfolded)".
+Record T := {p:nat}.
+Definition a := {|p:=0|}.
+Axiom P : nat -> Prop.
+Goal P a.(p). Proof. unfold p. cbv delta [a]. simpl. Show. Abort. (* -> 0 *)
+Goal P a.(p). Proof. unfold p. cbv delta [a]. cbn. Show. Abort.   (* -> 0 *)
+Goal P a.(p). Proof. unfold p. cbv delta [a]. hnf. Show. Abort.   (* -> 0 *)
+Arguments p : simpl never.
+Goal P a.(p). Proof. unfold p. cbv delta [a]. simpl. Show. Abort. (* -> 0 *) (* bug never 3 *)
+Goal P a.(p). Proof. unfold p. cbv delta [a]. cbn. Show. Abort.   (* -> {| p := 0 |}.(p) *)
+Goal P a.(p). Proof. unfold p. cbv delta [a]. hnf. Show. Abort.   (* -> 0 *)
+End DirectTuple.
+
+Module NamedTuple.
+Check "NamedTuple (PrimitiveProjectionUnfolded)".
+Record T := {p:nat}.
+Definition a := {|p:=0|}.
+Axiom P : nat -> Prop.
+Goal P a.(p). Proof. unfold p. simpl. Show. Abort. (* -> 0 *)
+Goal P a.(p). Proof. unfold p. cbn. Show. Abort.   (* -> 0 *)
+Goal P a.(p). Proof. unfold p. hnf. Show. Abort.   (* -> a.(p) *) (* bug primproj 2 *)
+Arguments p : simpl never.
+Goal P a.(p). Proof. unfold p. simpl. Show. Abort. (* -> 0 *)     (* bug never 3 *)
+Goal P a.(p). Proof. unfold p. cbn. Show. Abort.   (* -> a.(p) *)
+Goal P a.(p). Proof. unfold p. hnf. Show. Abort.   (* -> a.(p) *) (* bug primproj 2 *)
+Arguments p : simpl nomatch.
+Arguments a : simpl never.
+Goal P a.(p). Proof. unfold p. simpl. Show. Abort.  (* -> 0 *)     (* bug never 1 *)
+Goal P a.(p). Proof. unfold p. cbn. Show. Abort.    (* -> a.(p) *)
+Goal P a.(p). Proof. unfold p. hnf. Show. Abort.    (* -> a.(p) *) (* bug primproj 2 *)
+End NamedTuple.
+
+Module DirectCoFix.
+Check "DirectCoFix (PrimitiveProjectionUnfolded)".
+CoInductive U := {q:U}.
+CoFixpoint a := {|q:=a|}.
+Abbreviation COFIX := (cofix a := {|q:=a|}).
+Axiom P : U -> Prop.
+Goal P a.(q). Proof. unfold q. cbv delta [a]. simpl. Show. Abort. (* -> COFIX *)
+Goal P a.(q). Proof. unfold q. cbv delta [a]. cbn. Show. Abort.   (* -> COFIX *)
+Goal P a.(q). Proof. unfold q. cbv delta [a]. hnf. Show. Abort.   (* -> COFIX *)
+Arguments q : simpl never.
+Goal P a.(q). Proof. unfold q. cbv delta [a]. simpl. Show. Abort. (* -> COFIX *) (* never not respected on purpose *)
+Goal P a.(q). Proof. unfold q. cbv delta [a]. cbn. Show. Abort.   (* -> COFIX.(q) *)
+Goal P a.(q). Proof. unfold q. cbv delta [a]. hnf. Show. Abort.   (* -> COFIX *)
+End DirectCoFix.
+
+Module NamedCoFix.
+Check "NamedCoFix (PrimitiveProjectionUnfolded)".
+CoInductive U := {q:U}.
+CoFixpoint a := {|q:=a|}.
+Abbreviation COFIX := (cofix a := {|q:=a|}).
+Axiom P : U -> Prop.
+Goal P a.(q). Proof. unfold q. simpl. Show. Abort.  (* -> a *)
+Goal P a.(q). Proof. unfold q. cbn. Show. Abort.    (* -> a *)
+Goal P a.(q). Proof. unfold q. hnf. Show. Abort.    (* -> a.(q) *) (* bug primproj 4 *)
+Arguments q : simpl never.
+Goal P a.(q). Proof. unfold q. simpl. Show. Abort.  (* -> a *)
+Goal P a.(q). Proof. unfold q. cbn. Show. Abort.    (* -> a.(q) *)
+Goal P a.(q). Proof. unfold q. hnf. Show. Abort.    (* -> a.(q) *) (* bug primproj 4 *)
+Arguments q : simpl nomatch.
+Arguments a : simpl never.
+Goal P a.(q). Proof. unfold q. simpl. Show. Abort.  (* -> a *)
+Goal P a.(q). Proof. unfold q. cbn. Show. Abort.    (* -> a.(q) *)
+Goal P a.(q). Proof. unfold q. hnf. Show. Abort.    (* -> a.(q) *) (* bug primproj 4 *)
+End NamedCoFix.
+End PrimitiveProjectionUnfolded.
+
+Module PrimitiveProjectionConstant.
+Check "** PrimitiveProjectionConstant".
+(* we use a partial application to create a projection constant *)
+Set Primitive Projections.
+
+Module DirectTuple.
+Check "DirectTuple (PrimitiveProjectionConstant)".
+Record T := {p:nat}.
+Abbreviation TUPLE := {|p:=0|}.
+Definition a := {|p:=0|}.
+Axiom P : nat -> Prop.
+Goal P (id p a). Proof. unfold id. cbv delta [a]. simpl. Show. Abort. (* -> 0 *)
+Goal P (id p a). Proof. unfold id. cbv delta [a]. cbn. Show. Abort.   (* -> 0 *)
+Goal P (id p a). Proof. unfold id. cbv delta [a]. hnf. Show. Abort.   (* -> TUPLE.(p) *) (* bug primproj 1 *)
+Arguments p : simpl never.
+Goal P (id p a). Proof. unfold id. cbv delta [a]. simpl. Show. Abort. (* -> TUPLE.(p) *)
+Goal P (id p a). Proof. unfold id. cbv delta [a]. cbn. Show. Abort.   (* -> TUPLE.(p) *)
+Goal P (id p a). Proof. unfold id. cbv delta [a]. hnf. Show. Abort.   (* -> TUPLE.(p) *) (* bug primproj 1 *)
+End DirectTuple.
+
+Module NamedTuple.
+Check "NamedTuple (PrimitiveProjectionConstant)".
+Record T := {p:nat}.
+Definition a := {|p:=0|}.
+Axiom P : nat -> Prop.
+Goal P (id p a). Proof. unfold id. simpl. Show. Abort. (* -> 0 *)
+Goal P (id p a). Proof. unfold id. cbn. Show. Abort.   (* -> 0 *)
+Goal P (id p a). Proof. unfold id. hnf. Show. Abort.   (* -> a.(p) *) (* bug primproj 2 *)
+Arguments p : simpl never.
+Goal P (id p a). Proof. unfold id. simpl. Show. Abort. (* -> a.(p) *)
+Goal P (id p a). Proof. unfold id. cbn. Show. Abort.   (* -> a.(p) *)
+Goal P (id p a). Proof. unfold id. hnf. Show. Abort.   (* -> a.(p) *) (* bug primproj 2 *)
+Arguments p : simpl nomatch.
+Arguments a : simpl never.
+Goal P (id p a). Proof. unfold id. simpl. Show. Abort.  (* -> 0 *) (* never not respected on purpose *)
+Goal P (id p a). Proof. unfold id. cbn. Show. Abort.    (* -> a.(p) *)
+Goal P (id p a). Proof. unfold id. hnf. Show. Abort.    (* -> a.(p) *)
+End NamedTuple.
+
+Module DirectCoFix.
+Check "DirectCoFix (PrimitiveProjectionConstant)".
+CoInductive U := {q:U}.
+Abbreviation COFIX := (cofix a := {|q:=a|}).
+Axiom P : U -> Prop.
+Goal P (id q COFIX). Proof. unfold id. simpl. Show. Abort.  (* -> COFIX *)
+Goal P (id q COFIX). Proof. unfold id. cbn. Show. Abort.    (* -> COFIX *)
+Goal P (id q COFIX). Proof. unfold id. hnf. Show. Abort.    (* -> COFIX.(q) *) (* bug primproj 3 *)
+Arguments q : simpl never.
+Goal P (id q COFIX). Proof. unfold id. simpl. Show. Abort.  (* -> COFIX.(q) *)
+Goal P (id q COFIX). Proof. unfold id. cbn. Show. Abort.    (* -> COFIX.(q) *)
+Goal P (id q COFIX). Proof. unfold id. hnf. Show. Abort.    (* -> COFIX.(q) *) (* bug primproj 3 *)
+End DirectCoFix.
+
+Module NamedCoFix.
+Check "NamedCoFix (PrimitiveProjectionConstant)".
+CoInductive U := {q:U}.
+CoFixpoint a := {|q:=a|}.
+Axiom P : U -> Prop.
+Goal P (id q a). Proof. unfold id. simpl. Show. Abort.  (* -> a *)
+Goal P (id q a). Proof. unfold id. cbn. Show. Abort.    (* -> a *)
+Goal P (id q a). Proof. unfold id. hnf. Show. Abort.    (* -> a.(q) *) (* bug primproj 4 *)
+Arguments q : simpl never.
+Goal P (id q a). Proof. unfold id. simpl. Show. Abort.  (* -> a.(q) *)
+Goal P (id q a). Proof. unfold id. cbn. Show. Abort.    (* -> a.(q) *)
+Goal P (id q a). Proof. unfold id. hnf. Show. Abort.    (* -> a.(q) *) (* bug primproj 4 *)
+Arguments q : simpl nomatch.
+Arguments a : simpl never.
+Goal P (id q a). Proof. unfold id. simpl. Show. Abort.  (* -> a *) (* never not respected on purpose *)
+Goal P (id q a). Proof. unfold id. cbn. Show. Abort.    (* -> a.(q) *)
+Goal P (id q a). Proof. unfold id. hnf. Show. Abort.    (* -> a.(q) *) (* bug primproj 4 *)
+End NamedCoFix.
+End PrimitiveProjectionConstant.

From 77f6b61f07696f4cc00208e90fb34e6c7c5b7e9a Mon Sep 17 00:00:00 2001
From: Yann Leray <yann.leray@inria.fr>
Date: Tue, 21 Apr 2026 16:57:19 +0200
Subject: [PATCH 409/578] Add test for #5679

---
 test-suite/bugs/bug_5679.v | 11 +++++++++++
 1 file changed, 11 insertions(+)
 create mode 100644 test-suite/bugs/bug_5679.v

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.

From e9976206b239202aa4e2ea15fedf7559896c6304 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Wed, 22 Apr 2026 15:23:53 +0200
Subject: [PATCH 410/578] rocq makefile renaming for COQNATIVE prints

---
 tools/CoqMakefile.in | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/tools/CoqMakefile.in b/tools/CoqMakefile.in
index bf72a055a1ab..44ac85b49f4b 100644
--- a/tools/CoqMakefile.in
+++ b/tools/CoqMakefile.in
@@ -787,7 +787,7 @@ define globvorule=
 	$$(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
 
@@ -800,7 +800,7 @@ $(VOFILES): %.vo: %.v | $(VDFILE)
 	$(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
 

From c177643b65173b223859c2be36fcf8ac4376c489 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Tue, 21 Apr 2026 14:16:56 +0200
Subject: [PATCH 411/578] Don't call sphinx through dune rule

This avoids needing to to sed hacks on dune files.

It also makes ci-refman work in local builds (where the dependencies
are installed in _build so dune deletes them).
---
 .gitignore                  |  3 +++
 .gitlab-ci.yml              | 11 +++++-----
 Makefile                    | 17 +++++++++++----
 dev/ci/scripts/ci-refman.sh | 18 ++++++++++++----
 doc/dune                    | 41 -------------------------------------
 5 files changed, 35 insertions(+), 55 deletions(-)
 delete mode 100644 doc/dune

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 542c27b9d6f6..bce48c331505 100644
--- a/.gitlab-ci.yml
+++ b/.gitlab-ci.yml
@@ -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
@@ -492,7 +492,7 @@ doc:refman:deploy:
     - 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
     - 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
@@ -1340,9 +1340,8 @@ doc:ci-refman:
   stage: build-3+
   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/Makefile b/Makefile
index b9286c32576e..f6ab5e85341f 100644
--- a/Makefile
+++ b/Makefile
@@ -175,11 +175,20 @@ 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 > $@
 
-refman-pdf: dunestrap
-	dune build --no-buffer @refman-pdf
+WITHPYPATH:=PYTHONPATH=_build/default/config:doc/tools:$$PYTHONPATH
+
+refman-html: world doc/unreleased.rst
+	rm -rf doc/refman-html
+	$(WITHPYPATH) 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) 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/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/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)))))

From c25dc04bbb1fdbf9df86d46357f7b97b67a74e9d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Wed, 22 Apr 2026 16:33:31 +0200
Subject: [PATCH 412/578] Use lists instead of arrays in cbv values

avoid converting back and forth between lists and arrays
---
 pretyping/cbv.ml | 132 ++++++++++++++++++++++-------------------------
 1 file changed, 63 insertions(+), 69 deletions(-)

diff --git a/pretyping/cbv.ml b/pretyping/cbv.ml
index 2df407ce7702..b7c6bedbb1bd 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)
@@ -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
@@ -649,19 +643,19 @@ and cbv_stack_value info env = function
     apply env nlams args
 
   (* a Fix applied enough -> IOTA *)
-  | (FIX(fix,env,[||]), stk)
+  | (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)
+  | (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)))
+  | (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 =
@@ -675,7 +669,7 @@ and cbv_stack_value info env = function
     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))
+  | (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 *)
@@ -688,18 +682,18 @@ and cbv_stack_value info env = function
     cbv_stack_term info stk env (snd br.(n-1))
 
   (* constructor in a Projection -> IOTA *)
-  | (CONSTRUCT(((sp,n),u),[||]), APP(args,PROJ(p,_,stk)))
+  | (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)
+  | (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)) ->
+  | (PRIMITIVE(op,(_,u as c),[]), APP(appl,stk)) ->
     let nargs = CPrimitives.arity op in
     begin match List.chop nargs appl with
     | (args, appl) ->
@@ -707,14 +701,14 @@ and cbv_stack_value info env = function
       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)
+        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,Array.of_list args), stk)
+      | None -> mkSTACK(PRIMITIVE(op,c, args), stk)
       end
     | exception Failure _ ->
       (* partial application *)
       (assert (stk = TOP);
-       PRIMITIVE(op,c,Array.of_list appl))
+       PRIMITIVE(op,c, appl))
     end
 
   | SYMBOL ({ cst; rules; stk } as s ), stk' ->
@@ -806,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
@@ -975,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

From e06fbbe29f303284065ef25cbbe303955af7ea2a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Wed, 22 Apr 2026 16:36:09 +0200
Subject: [PATCH 413/578] Refman don't display output of mathcomp Requires

It prints a bunch of "Loading ML file"s which don't see useful to show.
---
 doc/sphinx/proof-engine/ssreflect-proof-language.rst | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/doc/sphinx/proof-engine/ssreflect-proof-language.rst b/doc/sphinx/proof-engine/ssreflect-proof-language.rst
index a94a6d1cdd2d..96bc91695e7c 100644
--- a/doc/sphinx/proof-engine/ssreflect-proof-language.rst
+++ b/doc/sphinx/proof-engine/ssreflect-proof-language.rst
@@ -2565,11 +2565,13 @@ The following example requires the mathcomp and mczify libraries.
      Unset Printing Implicit Defensive.
      Set Warnings "-notation-overridden".
 
-  .. rocqtop:: all extra-mathcomp extra-mczify
+  .. 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.
      have H x (y : nat) : 2 * x + y = x + x + y by lia.
 

From 58e7aa542ba8e992a4d14ee7d2be4eab83bc6d60 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Tue, 21 Apr 2026 11:49:34 +0200
Subject: [PATCH 414/578] Cache normalized directory in rocqdep filename type.

We kept recomputing the normalized form of the absolute dirpath of files
in the canonize function. This was quite costly, as it required three
syscalls to switch directories. It turns out this was useless since
we already computed the absolute path for virtually all arguments beforehand.
Thus instead of recomputing it on the fly, we simply store this data in
the Filename.t type for O(1) access.

This reduces the runtime of rocqdep by about a third on file-heavy runs.
---
 tools/coqdep/lib/common.ml    | 24 ++++++++++++++++--------
 tools/coqdep/lib/loadpath.ml  | 22 +++++++++++++++-------
 tools/coqdep/lib/loadpath.mli |  5 ++++-
 3 files changed, 35 insertions(+), 16 deletions(-)

diff --git a/tools/coqdep/lib/common.ml b/tools/coqdep/lib/common.ml
index 27f0d4d0e8ad..8a90554fbe76 100644
--- a/tools/coqdep/lib/common.ml
+++ b/tools/coqdep/lib/common.ml
@@ -32,8 +32,10 @@ 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 CString.Map.find_opt f' vAccu.map with
@@ -90,19 +92,23 @@ let safe_assoc ?(warn_clashes=true) st ?(what=Library) from file k =
   match search ?from k with
   | None -> None
   | Some (Loadpath.ExactMatches fs) ->
-    let f = fs.Loadpath.point in
+    let f = Loadpath.Filename.repr 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
     if warn_clashes then warn_if_clash ~what true file k f l;
-    Some [f]
+    Some [fs.Loadpath.point]
   | 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
+    (match List.sort sort l with [] -> assert false | f :: l as all ->
     (* 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;
+    let () = if warn_clashes then
+      let f = Loadpath.Filename.repr f in
+      let l = List.map Loadpath.Filename.repr l in
+      warn_if_clash ~what false file k f l
+    in
     Some all)
 
 let file_name ~separator_hack s = function
@@ -244,12 +250,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
@@ -358,7 +366,7 @@ let sort {State.vAccu; separator_hack; loadpath} =
         Format.printf "%s.v " file
     end
   in
-  List.iter (fun (name, _) -> loop name) vAccu.acc
+  List.iter (fun (name, _) -> loop (Loadpath.Filename.make name)) vAccu.acc
 
 let add_include st (rc, r, ln) =
   if rc then
diff --git a/tools/coqdep/lib/loadpath.ml b/tools/coqdep/lib/loadpath.ml
index c5a84bf79a22..e8bf5bc74371 100644
--- a/tools/coqdep/lib/loadpath.ml
+++ b/tools/coqdep/lib/loadpath.ml
@@ -139,24 +139,28 @@ struct
 
 type t = {
   user : filename;
+  dir : string; (* absolute path, normalized through absolute_dir *)
   absolute : filename;
 }
 
-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 absolute = Filename.concat dir (Filename.basename s) in
+  { user = s; dir; absolute }
 
 let compare f1 f2 = String.compare f1.absolute f2.absolute
 
 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 +198,12 @@ 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 =
+  let f = Filename.make f in
+  { point = f; files = FileSet.singleton f }
+let add_set f l =
+  let f = Filename.make f in
+  { point = f; files = FileSet.add f l.files }
 
 let insert_key root (full,f) m =
   (* An exact match takes precedence over non-exact matches *)
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] *)
 }
 

From 1f83c2561a94da033a02caa4b53e24593b268dd5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Tue, 7 Apr 2026 21:01:22 +0200
Subject: [PATCH 415/578] Do not store recursive trees anymore in inductive
 blocks.

This data is now useless as it can be recovered from the compiled automaton.
---
 checker/checkInductive.ml       |  3 +--
 checker/values.ml               |  9 ---------
 kernel/declarations.mli         |  4 +---
 kernel/declareops.ml            |  7 -------
 kernel/declareops.mli           |  3 ---
 kernel/discharge.ml             |  1 -
 kernel/indtypes.ml              |  1 -
 plugins/funind/gen_principle.ml |  3 +--
 pretyping/inductiveops.ml       | 27 +++++++++------------------
 pretyping/inductiveops.mli      |  1 -
 tactics/tacticals.ml            | 11 ++++++-----
 vernac/auto_ind_decl.ml         |  6 ++----
 12 files changed, 20 insertions(+), 56 deletions(-)

diff --git a/checker/checkInductive.ml b/checker/checkInductive.ml
index 75820a54a00f..b7f2019c6869 100644
--- a/checker/checkInductive.ml
+++ b/checker/checkInductive.ml
@@ -174,7 +174,7 @@ 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_automaton; mind_relevance;
+      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
 
@@ -196,7 +196,6 @@ 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);
diff --git a/checker/values.ml b/checker/values.ml
index c8646c6e9943..b0c9ed65e9f7 100644
--- a/checker/values.ml
+++ b/checker/values.ml
@@ -430,14 +430,6 @@ 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)))|]
@@ -463,7 +455,6 @@ 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;
diff --git a/kernel/declarations.mli b/kernel/declarations.mli
index b7129551bcc5..74f058237583 100644
--- a/kernel/declarations.mli
+++ b/kernel/declarations.mli
@@ -248,9 +248,7 @@ 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 above *)
+    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? *)
diff --git a/kernel/declareops.ml b/kernel/declareops.ml
index 138b54d4ac4c..192aad1e7c0c 100644
--- a/kernel/declareops.ml
+++ b/kernel/declareops.ml
@@ -218,12 +218,6 @@ 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
 
@@ -251,7 +245,6 @@ 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;
diff --git a/kernel/declareops.mli b/kernel/declareops.mli
index 980c3d4c67d0..acc2c23b9f87 100644
--- a/kernel/declareops.mli
+++ b/kernel/declareops.mli
@@ -51,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
 
diff --git a/kernel/discharge.ml b/kernel/discharge.ml
index 89e1bb95f318..1d96131582eb 100644
--- a/kernel/discharge.ml
+++ b/kernel/discharge.ml
@@ -155,7 +155,6 @@ let cook_one_ind info cache ~params ~ntypes mip =
     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;
diff --git a/kernel/indtypes.ml b/kernel/indtypes.ml
index 00240f6a54d4..b51a1ad500a6 100644
--- a/kernel/indtypes.ml
+++ b/kernel/indtypes.ml
@@ -561,7 +561,6 @@ 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;
diff --git a/plugins/funind/gen_principle.ml b/plugins/funind/gen_principle.ml
index 185d22809aeb..04a8ece16bfd 100644
--- a/plugins/funind/gen_principle.ml
+++ b/plugins/funind/gen_principle.ml
@@ -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.")
diff --git a/pretyping/inductiveops.ml b/pretyping/inductiveops.ml
index 963a2c9aa9ee..110f9468aa55 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
@@ -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 =
   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
+      Array.exists (fun tr ->
+        match Rtree.Automaton.data ra tr with
         | Mrec (RecArgInd (kni, _)) -> not @@ MutInd.CanOrd.equal 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) =
@@ -239,12 +236,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
diff --git a/pretyping/inductiveops.mli b/pretyping/inductiveops.mli
index 24ec6a25eb8a..35eae77ed867 100644
--- a/pretyping/inductiveops.mli
+++ b/pretyping/inductiveops.mli
@@ -123,7 +123,6 @@ 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 : UnivGen.QualityOrSet.t -> UnivGen.QualityOrSet.t list
diff --git a/tactics/tacticals.ml b/tactics/tacticals.ml
index 6f957f4ac8a4..251a3c14d454 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 ()
 
diff --git a/vernac/auto_ind_decl.ml b/vernac/auto_ind_decl.ml
index c01a235e720c..20e350e443ae 100644
--- a/vernac/auto_ind_decl.ml
+++ b/vernac/auto_ind_decl.ml
@@ -676,10 +676,8 @@ let build_beq_scheme env handle kn =
   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

From 2261746ea3165e804dc1aca4bf2e69a6c631eb0b Mon Sep 17 00:00:00 2001
From: Dario Halilovic <dario.halilovic@epfl.ch>
Date: Thu, 23 Apr 2026 18:37:09 +0200
Subject: [PATCH 416/578] Implement Alectryon backend for Coqdoc

---
 tools/coqdoc/cmdArgs.ml      |   2 +
 tools/coqdoc/common.ml       |   2 +-
 tools/coqdoc/common.mli      |   2 +-
 tools/coqdoc/output.ml       | 226 +++++++++++++++++++++++++++--------
 tools/coqdoc/rocqdoc_main.ml |   3 +-
 5 files changed, 179 insertions(+), 56 deletions(-)

diff --git a/tools/coqdoc/cmdArgs.ml b/tools/coqdoc/cmdArgs.ml
index ded51e9aeca1..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 }
diff --git a/tools/coqdoc/common.ml b/tools/coqdoc/common.ml
index 1b70dbb05ae7..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
diff --git a/tools/coqdoc/common.mli b/tools/coqdoc/common.mli
index 58a6759659f9..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
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].

From 1c4af9da37d9d1b162c96ccdc53008efd8f59a6c Mon Sep 17 00:00:00 2001
From: Dario Halilovic <dario.halilovic@epfl.ch>
Date: Thu, 23 Apr 2026 19:24:36 +0200
Subject: [PATCH 417/578] Add tests for Coqdoc Alectryon backend

---
 test-suite/Makefile                       |   2 +
 test-suite/coqdoc/Context.myst.out        |   6 ++
 test-suite/coqdoc/Record.myst.out         |   4 +
 test-suite/coqdoc/binder.myst.out         |   7 ++
 test-suite/coqdoc/bug11194.myst.out       |   7 ++
 test-suite/coqdoc/bug11353.myst.out       |   8 ++
 test-suite/coqdoc/bug12742.myst.out       |  26 ++++++
 test-suite/coqdoc/bug5648.myst.out        |  21 +++++
 test-suite/coqdoc/bug5700.myst.out        |  11 +++
 test-suite/coqdoc/details.myst.out        |  23 +++++
 test-suite/coqdoc/links.myst.out          | 106 ++++++++++++++++++++++
 test-suite/coqdoc/multiple_links.myst.out |   5 +
 test-suite/coqdoc/typeclasses.myst.out    |  13 +++
 test-suite/coqdoc/verbatim.myst.out       |  52 +++++++++++
 14 files changed, 291 insertions(+)
 create mode 100644 test-suite/coqdoc/Context.myst.out
 create mode 100644 test-suite/coqdoc/Record.myst.out
 create mode 100644 test-suite/coqdoc/binder.myst.out
 create mode 100644 test-suite/coqdoc/bug11194.myst.out
 create mode 100644 test-suite/coqdoc/bug11353.myst.out
 create mode 100644 test-suite/coqdoc/bug12742.myst.out
 create mode 100644 test-suite/coqdoc/bug5648.myst.out
 create mode 100644 test-suite/coqdoc/bug5700.myst.out
 create mode 100644 test-suite/coqdoc/details.myst.out
 create mode 100644 test-suite/coqdoc/links.myst.out
 create mode 100644 test-suite/coqdoc/multiple_links.myst.out
 create mode 100644 test-suite/coqdoc/typeclasses.myst.out
 create mode 100644 test-suite/coqdoc/verbatim.myst.out

diff --git a/test-suite/Makefile b/test-suite/Makefile
index 08118e3f1874..d376a66d1571 100644
--- a/test-suite/Makefile
+++ b/test-suite/Makefile
@@ -767,7 +767,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/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/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}
+```

From b03dbcd4cb937395d5cd87c21fe72b8b1d9f1427 Mon Sep 17 00:00:00 2001
From: Dario Halilovic <dario.halilovic@epfl.ch>
Date: Fri, 24 Apr 2026 09:28:38 +0200
Subject: [PATCH 418/578] Add Markdown files to approve-coqdoc Makefile target

---
 test-suite/Makefile | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/test-suite/Makefile b/test-suite/Makefile
index d376a66d1571..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!"; \

From 45e537630494f6425945747bba595712fc7b3ba7 Mon Sep 17 00:00:00 2001
From: Dario Halilovic <dario.halilovic@epfl.ch>
Date: Fri, 24 Apr 2026 09:29:34 +0200
Subject: [PATCH 419/578] Create test file for all of rocq doc's features

---
 test-suite/coqdoc/reference.html.out | 140 +++++++++++++++++++++++++++
 test-suite/coqdoc/reference.myst.out |  84 ++++++++++++++++
 test-suite/coqdoc/reference.tex.out  | 125 ++++++++++++++++++++++++
 test-suite/coqdoc/reference.v        |  62 ++++++++++++
 4 files changed, 411 insertions(+)
 create mode 100644 test-suite/coqdoc/reference.html.out
 create mode 100644 test-suite/coqdoc/reference.myst.out
 create mode 100644 test-suite/coqdoc/reference.tex.out
 create mode 100644 test-suite/coqdoc/reference.v

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 @@
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
+"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml">
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
+<link href="coqdoc.css" rel="stylesheet" type="text/css" />
+<title>Coqdoc.reference</title>
+</head>
+
+<body>
+
+<div id="page">
+
+<div id="header">
+</div>
+
+<div id="main">
+
+<h1 class="libtitle">Library Coqdoc.reference</h1>
+
+<div class="code">
+</div>
+
+<div class="doc">
+This is a reference file that tests most of rocq doc's features. 
+<div class="paragraph"> </div>
+
+<a id="lab1"></a><h1 class="section">Here's a heading</h1>
+
+
+<div class="paragraph"> </div>
+
+    The number of asterisks in front of the heading determine the level of the
+    heading. For example: 
+<div class="paragraph"> </div>
+
+<a id="lab2"></a><h2 class="section">Here's a subheading</h2>
+<a id="lab3"></a><h3 class="section">Here's a subsubheading</h3>
+<a id="lab4"></a><h4 class="section">Here's the lowest possible heading</h4>
+
+<div class="paragraph"> </div>
+
+ Rocq doc comments are placed between <code>(** </code> and <code>*) </code>. Contrary to regular
+    comments, the comment starts with two asterisks instead of one.
+
+<div class="paragraph"> </div>
+
+    Above, we have used angle brackets to present verbatim material. Verbatim material
+    can also take multiple lines:
+<pre>
+    let rec fact n =
+      if n &lt;= 1 then 1 else n * fact (n - 1)
+</pre>
+
+<div class="paragraph"> </div>
+
+ Rocq material can be quoted inline using square brackets, as follows: <span class="inlinecode"><span class="id" title="keyword">∀</span></span> <span class="inlinecode"><span class="id" title="var">n</span></span> <span class="inlinecode">:</span> <span class="inlinecode"><span class="id" title="var">nat</span>,</span> <span class="inlinecode"><span class="id" title="var">fact</span></span> <span class="inlinecode"><span class="id" title="var">n</span></span> <span class="inlinecode">≥</span> <span class="inlinecode"><span class="id" title="var">n</span></span>.
+    For vernacular material, we double the square brackets, and place them on separate lines, like so:
+    <br/>
+<span class="inlinecode">&nbsp;&nbsp;&nbsp;&nbsp;<span class="id" title="keyword">From</span> <span class="id" title="var">Stdlib</span> <span class="id" title="keyword">Require</span> <span class="id" title="keyword">Import</span> <span class="id" title="var">Lia</span>.<br/>
+&nbsp;&nbsp;&nbsp;&nbsp;
+<div class="paragraph"> </div>
+
+</span>
+<div class="paragraph"> </div>
+
+ Let's implement the <span class="inlinecode"><span class="id" title="var">fact</span></span> OCaml function in Rocq! 
+</div>
+<div class="code">
+
+<br/>
+<span class="id" title="keyword">Fixpoint</span> <a id="fact" class="idref" href="#fact"><span class="id" title="definition">fact</span></a> (<a id="n:1" class="idref" href="#n:1"><span class="id" title="binder">n</span></a> : <a class="idref" href="http://coq.inria.fr/stdlib/Corelib.Init.Datatypes.html#nat"><span class="id" title="inductive">nat</span></a>) : <a class="idref" href="http://coq.inria.fr/stdlib/Corelib.Init.Datatypes.html#nat"><span class="id" title="inductive">nat</span></a> :=<br/>
+&nbsp;&nbsp;<span class="id" title="keyword">match</span> <a class="idref" href="Coqdoc.reference.html#n:1"><span class="id" title="variable">n</span></a> <span class="id" title="keyword">with</span><br/>
+&nbsp;&nbsp;| 0 ⇒ 1<br/>
+&nbsp;&nbsp;| <a class="idref" href="http://coq.inria.fr/stdlib/Corelib.Init.Datatypes.html#S"><span class="id" title="constructor">S</span></a> <span class="id" title="var">n'</span> ⇒<br/>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<br/>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<a class="idref" href="Coqdoc.reference.html#n:1"><span class="id" title="variable">n</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Corelib.Init.Peano.html#ea2ff3d561159081cea6fb2e8113cc54"><span class="id" title="notation">×</span></a> <a class="idref" href="Coqdoc.reference.html#fact:2"><span class="id" title="definition">fact</span></a> <span class="id" title="var">n'</span><br/>
+&nbsp;&nbsp;<span class="id" title="keyword">end</span>.<br/>
+
+<br/>
+</div>
+
+<div class="doc">
+Here's the rest of the formatting rules:
+<ul class="doclist">
+<li> To emphasize text, place it between underscores, <i>like so</i>.
+
+</li>
+<li> To insert LaTeX math:
+<ul class="doclist">
+<li> Use dollar signs for LaTeX in math mode: 
+
+</li>
+<li> Use percent signs for other LaTeX materials: 
+
+</li>
+</ul>
+
+</li>
+</ul>
+
+<div class="paragraph"> </div>
+
+    To create (nested) lists, use bullets, as we have done above! 
+<div class="paragraph"> </div>
+
+<hr/>
+ 
+<div class="paragraph"> </div>
+
+ Finally, some parts of the code can be hidden from the output, or placed in a dropdown. 
+</div>
+<div class="code">
+
+<br/>
+
+<br/>
+</div>
+<details><div class="code">
+<span class="id" title="keyword">Definition</span> <a id="this_definition_is_in_a_dropdown" class="idref" href="#this_definition_is_in_a_dropdown"><span class="id" title="definition">this_definition_is_in_a_dropdown</span></a> : <a class="idref" href="http://coq.inria.fr/stdlib/Corelib.Init.Datatypes.html#unit"><span class="id" title="inductive">unit</span></a> := <a class="idref" href="http://coq.inria.fr/stdlib/Corelib.Init.Datatypes.html#tt"><span class="id" title="constructor">tt</span></a>.<br/>
+</div>
+</details><div class="code">
+
+<br/>
+</div>
+<details><summary>Some summary </summary><div class="code">
+<span class="id" title="keyword">Definition</span> <a id="this_definition_is_in_a_dropdown_with_a_summary" class="idref" href="#this_definition_is_in_a_dropdown_with_a_summary"><span class="id" title="definition">this_definition_is_in_a_dropdown_with_a_summary</span></a> : <a class="idref" href="http://coq.inria.fr/stdlib/Corelib.Init.Datatypes.html#unit"><span class="id" title="inductive">unit</span></a> := <a class="idref" href="http://coq.inria.fr/stdlib/Corelib.Init.Datatypes.html#tt"><span class="id" title="constructor">tt</span></a>.<br/>
+</div>
+</details><div class="code">
+</div>
+</div>
+
+<div id="footer">
+<hr/><a href="index.html">Index</a><hr/>This page has been generated by <a href="http://rocq-prover.org/">coqdoc</a>
+</div>
+
+</div>
+
+</body>
+</html>
\ 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 *)

From 182df329bed643b25900a905164512d3e67a4b90 Mon Sep 17 00:00:00 2001
From: Dario Halilovic <dario.halilovic@epfl.ch>
Date: Fri, 24 Apr 2026 09:44:14 +0200
Subject: [PATCH 420/578] Add documentation for Alectryon Markdown support in
 rocq doc

---
 doc/sphinx/using/tools/coqdoc.rst | 4 ++++
 1 file changed, 4 insertions(+)

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’

From 60fd60ef87dd81c5f9f84e8c2ab4db0251a763fe Mon Sep 17 00:00:00 2001
From: Dario Halilovic <dario.halilovic@epfl.ch>
Date: Fri, 24 Apr 2026 09:49:05 +0200
Subject: [PATCH 421/578] Add changelog entry for #21950

---
 doc/changelog/09-cli-tools/21950-coqdoc-alectryon-Added.rst | 4 ++++
 1 file changed, 4 insertions(+)
 create mode 100644 doc/changelog/09-cli-tools/21950-coqdoc-alectryon-Added.rst

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 <https://github.com/rocq-prover/rocq/pull/21950>`_,
+  by Dario Halilovic).

From 43c9dd2547854d36dc12179b87c516a5d46f5009 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?L=C3=A9o=20Soudant?= <soudant.leo@gmail.com>
Date: Mon, 20 Apr 2026 14:35:41 +0200
Subject: [PATCH 422/578] Added an argument to ArgIsNested so it output
 relevant uparams in preparation to remove mib_nested

Change two arguments of ArfIsNested into a single GlobRef one

remove inductive related arguments from argisnested to prepare for primitive array
---
 tactics/allScheme.ml  | 95 ++++++++++++++++++++-----------------------
 tactics/allScheme.mli |  6 +--
 tactics/indrec.ml     | 26 +++++-------
 3 files changed, 59 insertions(+), 68 deletions(-)

diff --git a/tactics/allScheme.ml b/tactics/allScheme.ml
index abca924ce4e2..495937c80f73 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)
 
@@ -183,7 +183,8 @@ and compute_params_rec_strpos_aux cache env kn uparams nuparams nparams_rec npar
   dbg_strpos Pp.(fun () -> MutInd.print kn ++ str ": Final Result = " ++ pp_strpos res);
   res
 
-and compute_params_rec_strpos cache env kn mib = match Mindmap_env.find_opt kn cache.Cache.uniform with
+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
@@ -244,7 +245,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)
@@ -273,17 +274,17 @@ 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) ->
          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 ++  strbrk ". "
       ++ strbrk "It can be generated using command \"Scheme All\" e.g. \"Scheme All for "
-      ++ Nametab.XRefs.pr (TrueGlobal (IndRef ind_nested))
+      ++ Nametab.XRefs.pr (TrueGlobal nested_container)
       ++ str ".\"."
     )
 
@@ -291,42 +292,42 @@ let warn_lookup_not_found =
     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 args_are_nested =
     let (_, (pred, _)) = partial_suffix args_are_nested in
-    match DeclareScheme.lookup_scheme_opt pred (GlobRef.IndRef ind_nested) with
+    match DeclareScheme.lookup_scheme_opt pred nested with
     | Some ref_pred ->
         Some (true, ref_pred)
     | None ->
         let (_, (pred, _)) = default_suffix in
-        match DeclareScheme.lookup_scheme_opt pred (GlobRef.IndRef ind_nested) with
+        match DeclareScheme.lookup_scheme_opt pred nested 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); 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 (GlobRef.IndRef 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 (GlobRef.IndRef 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].
     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 (GlobRef.IndRef 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 (GlobRef.IndRef 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 } *)
@@ -432,8 +433,8 @@ type head_argument =
   (** constant context, 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
+  | ArgIsNested of GlobRef.t * bool list
+                    * rel_context * 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 *)
   | ArgIsCst
@@ -461,7 +462,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
@@ -473,13 +474,15 @@ 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)
   | _ -> return @@ (cxt, ArgIsCst)
@@ -497,7 +500,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  *)
@@ -540,9 +543,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
@@ -558,9 +559,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
@@ -814,27 +813,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
@@ -1023,27 +1020,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
diff --git a/tactics/allScheme.mli b/tactics/allScheme.mli
index 42e71877529c..6134642f6453 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 } *)
 
@@ -61,8 +61,8 @@ type head_argument =
   (** constant context, 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
+  | ArgIsNested of GlobRef.t * bool list
+                    * rel_context * 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 *)
   | ArgIsCst
diff --git a/tactics/indrec.ml b/tactics/indrec.ml
index bdd579208fe2..c84306d47410 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

From 5308955bf2574413328a716b20b532e653e2ac40 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Fri, 24 Apr 2026 12:13:19 +0200
Subject: [PATCH 423/578] Compute rocqdep dependencies on demand.

In the compute_deps function, we now return a Seq.t rather than a list.
This does not change the behaviour since elements are still processed in
the same order and the state becomes irrelevant after the function has
returned. Yet, this is much better for memory consumption as the main
caller only looks at elements pointwise and discards them immediately.

On huge repositories this prevents the memory to grow linearly once
the init phase is over, i.e. very quickly w.r.t. the rest of the
computation. In particular, on the 700k file example by Jason Gross,
this reduces the memory peak from ~10Gio to ~2.5Gio. We could do
better, but as a 4-line patch I think this is not bad.
---
 tools/coqdep/lib/common.ml       | 2 +-
 tools/coqdep/lib/common.mli      | 2 +-
 tools/coqdep/lib/rocqdep_main.ml | 2 +-
 tools/dune_rule_gen/dep_info.ml  | 2 +-
 4 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/tools/coqdep/lib/common.ml b/tools/coqdep/lib/common.ml
index 27f0d4d0e8ad..68ae8e2e7587 100644
--- a/tools/coqdep/lib/common.ml
+++ b/tools/coqdep/lib/common.ml
@@ -289,7 +289,7 @@ let find_dependencies st basename =
 
 let compute_deps st =
   let mk_dep (name, _orig_path) = Dep_info.make ~name ~deps:(find_dependencies st name) in
-  st.vAccu.acc |> CList.rev_map mk_dep
+  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
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/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/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

From d6c0f74a1ec8da83c38766573d2c2103a0af117c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Fri, 24 Apr 2026 13:47:34 +0200
Subject: [PATCH 424/578] Less redendant data in coqdep Loadpath.Filename

still a bit redundant since basename can be gotten from the user name
---
 tools/coqdep/lib/loadpath.ml | 10 ++++++----
 1 file changed, 6 insertions(+), 4 deletions(-)

diff --git a/tools/coqdep/lib/loadpath.ml b/tools/coqdep/lib/loadpath.ml
index e8bf5bc74371..651b619a5def 100644
--- a/tools/coqdep/lib/loadpath.ml
+++ b/tools/coqdep/lib/loadpath.ml
@@ -140,16 +140,18 @@ struct
 type t = {
   user : filename;
   dir : string; (* absolute path, normalized through absolute_dir *)
-  absolute : filename;
+  basename : string;
 }
 
 let make s =
   let dir = absolute_dir (Filename.dirname s) in
   (* See the proviso in {!absolute_file_name} *)
-  let absolute = Filename.concat dir (Filename.basename s) in
-  { user = s; dir; absolute }
+  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
 

From 0de845e143414206ab81eb1733db797ea2d72a18 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?L=C3=A9o=20Soudant?= <soudant.leo@gmail.com>
Date: Mon, 20 Apr 2026 17:59:43 +0200
Subject: [PATCH 425/578] Extend generation of eliminators to handle nesting
 with Primitive Arrays

- Updated view_argument with a case for arrays.

- Changed compute_params_rec_strpos_arg so that Scheme All would work propely.
---
 .../04-tactics/21928-arrayall-Changed.rst     |   4 +
 .../writing-proofs/reasoning-inductives.rst   |  41 ++-
 tactics/allScheme.ml                          |  52 +++-
 tactics/allScheme.mli                         |   8 +-
 tactics/indrec.ml                             |   1 +
 test-suite/output/nested_eliminators.out      | 293 +++++++++++++-----
 test-suite/output/nested_eliminators.v        |  38 +++
 7 files changed, 346 insertions(+), 91 deletions(-)
 create mode 100644 doc/changelog/04-tactics/21928-arrayall-Changed.rst

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 <https://github.com/rocq-prover/rocq/pull/21928>`_,
+  by Léo Soudant).
diff --git a/doc/sphinx/proofs/writing-proofs/reasoning-inductives.rst b/doc/sphinx/proofs/writing-proofs/reasoning-inductives.rst
index e03dfd42f305..37e8d183ae78 100644
--- a/doc/sphinx/proofs/writing-proofs/reasoning-inductives.rst
+++ b/doc/sphinx/proofs/writing-proofs/reasoning-inductives.rst
@@ -1322,7 +1322,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. It can be generated using command "Scheme All" e.g. "Scheme All 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 +1331,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 +1436,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
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
diff --git a/tactics/allScheme.ml b/tactics/allScheme.ml
index 495937c80f73..c14757e0fc2d 100644
--- a/tactics/allScheme.ml
+++ b/tactics/allScheme.ml
@@ -92,7 +92,7 @@ let rec compute_params_rec_strpos_arg cache env kn uparams nparams_rec nparams i
   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 *)
@@ -115,7 +115,8 @@ let rec compute_params_rec_strpos_arg cache env kn uparams nparams_rec nparams i
         else begin
           let mib_nested = lookup_mind kn_nested env 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 (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
@@ -132,9 +133,14 @@ let rec compute_params_rec_strpos_arg cache env kn uparams nparams_rec nparams i
           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 *)
 and compute_params_rec_strpos_ctor cache env kn uparams nparams_rec nparams init_value (args, hd) =
@@ -275,6 +281,7 @@ let compute_positive_uparams_and_suffix env kn mib user_id =
 let warn_lookup_not_found =
   CWarnings.create ~name:"register-all" ~category:CWarnings.CoreCategories.automation
   Pp.(fun (key, ind, nested_container) ->
+      let generic_message =
          Nametab.XRefs.pr (TrueGlobal (IndRef ind))
       ++ strbrk " is nested using "
       ++ Nametab.XRefs.pr (TrueGlobal nested_container)
@@ -282,26 +289,30 @@ let warn_lookup_not_found =
       ++ strbrk "No scheme for "
       ++ Nametab.XRefs.pr (TrueGlobal nested_container)
       ++ strbrk " is registered as "
-      ++ strbrk key ++  strbrk ". "
-      ++ strbrk "It can be generated using command \"Scheme All\" e.g. \"Scheme All for "
+      ++ 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 ".\"."
+      ++ 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 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 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 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, 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 nested_container =
@@ -313,7 +324,7 @@ let lookup_all_theorem_aux ind nested_container =
       | 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. *)
@@ -430,13 +441,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 *)
+  (** position of the one_inductive body, inst_nuparams, inst_indices *)
   | ArgIsNested of GlobRef.t * bool list
                     * rel_context * 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 *)
+  (** 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
@@ -485,6 +496,15 @@ let view_argument kn mib key_uparams strpos t =
                           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)
 
 
diff --git a/tactics/allScheme.mli b/tactics/allScheme.mli
index 6134642f6453..b6e46713ae78 100644
--- a/tactics/allScheme.mli
+++ b/tactics/allScheme.mli
@@ -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 *)
+  (** position of the one_inductive body, inst_nuparams, inst_indices *)
   | ArgIsNested of GlobRef.t * bool list
                     * rel_context * 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 *)
+  (** 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/indrec.ml b/tactics/indrec.ml
index c84306d47410..69666db34651 100644
--- a/tactics/indrec.ml
+++ b/tactics/indrec.ml
@@ -379,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
diff --git a/test-suite/output/nested_eliminators.out b/test-suite/output/nested_eliminators.out
index f953787a84dd..1c2f4157f404 100644
--- a/test-suite/output/nested_eliminators.out
+++ b/test-suite/output/nested_eliminators.out
@@ -1,4 +1,4 @@
-File "./output/nested_eliminators.v", line 30, characters 13-21:
+File "./output/nested_eliminators.v", line 33, characters 13-21:
 The command has indeed failed with message:
 The reference True_all was not found in the current environment.
 Inductive
@@ -24,7 +24,7 @@ list_all_forall is universe polymorphic
 Arguments list_all_forall A%_type_scope (PA HPA)%_function_scope l
 list_all_forall is transparent
 Expands to: Constant nested_eliminators.Template.list_all_forall
-Declared in library nested_eliminators, line 33, characters 2-88
+Declared in library nested_eliminators, line 36, characters 2-88
 Inductive
 list_all_all@{α α0 ; u u0 u1} (A : Type@{u}) (PA : A -> Type@{α ; u0})
 (PPA : forall a : A, PA a -> Type@{α0 ; u1})
@@ -55,7 +55,7 @@ Arguments list_all_all_forall A%_type_scope (PA PPA HPPA)%_function_scope
   l l0
 list_all_all_forall is transparent
 Expands to: Constant nested_eliminators.Template.list_all_all_forall
-Declared in library nested_eliminators, line 33, characters 2-88
+Declared in library nested_eliminators, line 36, characters 2-88
 MRT_ind :
 forall P : MRT -> Prop,
 (forall l : list MRT, list_all@{Prop ; Set Set} MRT P l -> P (MRTnode l)) ->
@@ -65,7 +65,7 @@ MRT_ind is not universe polymorphic
 Arguments MRT_ind (P MRTnode)%_function_scope m
 MRT_ind is transparent
 Expands to: Constant nested_eliminators.Template.MRT_ind
-Declared in library nested_eliminators, line 45, characters 2-55
+Declared in library nested_eliminators, line 48, characters 2-55
 RoseTree_ind :
 forall (A : Type@{RoseTree_ind.u0}) (P : RoseTree A -> Prop),
 (forall a : A, P (RTleaf A a)) ->
@@ -77,7 +77,7 @@ RoseTree_ind is not universe polymorphic
 Arguments RoseTree_ind A%_type_scope (P RTleaf RTnode)%_function_scope r
 RoseTree_ind is transparent
 Expands to: Constant nested_eliminators.Template.RoseTree_ind
-Declared in library nested_eliminators, line 50, characters 2-113
+Declared in library nested_eliminators, line 53, characters 2-113
 Inductive
 RoseTree_all@{α ; u u0 u1 u2} (A : Type@{u}) (PA : A -> Type@{α ; u0})
   : RoseTree A -> Type@{max(Set,u,u0,u1)} :=
@@ -110,7 +110,7 @@ RoseTree_all_forall is universe polymorphic
 Arguments RoseTree_all_forall A%_type_scope (PA HPA)%_function_scope r
 RoseTree_all_forall is transparent
 Expands to: Constant nested_eliminators.Template.RoseTree_all_forall
-Declared in library nested_eliminators, line 50, characters 2-113
+Declared in library nested_eliminators, line 53, characters 2-113
 Inductive
 RoseTreeMut_all@{α ; u} (A : Type@{RoseTreeMut.u0}) 
 (PA : A -> Type@{α ; u})
@@ -144,7 +144,7 @@ RoseTreeMut_all_forall is universe polymorphic
 Arguments RoseTreeMut_all_forall A%_type_scope (PA HPA)%_function_scope r
 RoseTreeMut_all_forall is transparent
 Expands to: Constant nested_eliminators.Template.RoseTreeMut_all_forall
-Declared in library nested_eliminators, line 58, characters 2-164
+Declared in library nested_eliminators, line 61, characters 2-164
 Inductive
 RoseTreeMut_all_all@{α α0 ; u u0} (A : Type@{RoseTreeMut.u0})
 (PA : A -> Type@{α ; u}) (PPA : forall a : A, PA a -> Type@{α0 ; u0})
@@ -189,7 +189,7 @@ Arguments RoseTreeMut_all_all_forall A%_type_scope
   (PA PPA HPPA)%_function_scope r r0
 RoseTreeMut_all_all_forall is transparent
 Expands to: Constant nested_eliminators.Template.RoseTreeMut_all_all_forall
-Declared in library nested_eliminators, line 58, characters 2-164
+Declared in library nested_eliminators, line 61, characters 2-164
 Inductive
 RoseTreeMut_all@{α ; u} (A : Type@{RoseTreeMut.u0}) 
 (PA : A -> Type@{α ; u})
@@ -222,7 +222,7 @@ forest_all_forall is universe polymorphic
 Arguments forest_all_forall A%_type_scope (PA HPA)%_function_scope f
 forest_all_forall is transparent
 Expands to: Constant nested_eliminators.Template.forest_all_forall
-Declared in library nested_eliminators, line 58, characters 2-164
+Declared in library nested_eliminators, line 61, characters 2-164
 Inductive
 RoseTreeMut_all_all@{α α0 ; u u0} (A : Type@{RoseTreeMut.u0})
 (PA : A -> Type@{α ; u}) (PPA : forall a : A, PA a -> Type@{α0 ; u0})
@@ -267,7 +267,7 @@ Arguments forest_all_all_forall A%_type_scope (PA PPA HPPA)%_function_scope
   f f0
 forest_all_all_forall is transparent
 Expands to: Constant nested_eliminators.Template.forest_all_all_forall
-Declared in library nested_eliminators, line 58, characters 2-164
+Declared in library nested_eliminators, line 61, characters 2-164
 RoseRoseTree_ind :
 forall (A : Type@{RoseRoseTree_ind.u0}) (P : RoseRoseTree A -> Prop),
 (forall a : A, P (Nleaf A a)) ->
@@ -282,7 +282,7 @@ RoseRoseTree_ind is not universe polymorphic
 Arguments RoseRoseTree_ind A%_type_scope (P Nleaf Nnode)%_function_scope r
 RoseRoseTree_ind is transparent
 Expands to: Constant nested_eliminators.Template.RoseRoseTree_ind
-Declared in library nested_eliminators, line 74, characters 2-136
+Declared in library nested_eliminators, line 77, characters 2-136
 Inductive
 RoseRoseTree_all@{α ; u u0 u1 u2} (A : Type@{u}) (PA : A -> Type@{α ; u0})
   : RoseRoseTree A -> Type@{max(Set,u,u0,u1)} :=
@@ -317,7 +317,7 @@ RoseRoseTree_all_forall is universe polymorphic
 Arguments RoseRoseTree_all_forall A%_type_scope (PA HPA)%_function_scope r
 RoseRoseTree_all_forall is transparent
 Expands to: Constant nested_eliminators.Template.RoseRoseTree_all_forall
-Declared in library nested_eliminators, line 74, characters 2-136
+Declared in library nested_eliminators, line 77, characters 2-136
 ArrowTree1_ind :
 forall (A : Type@{ArrowTree1_ind.u0}) (P : ArrowTree1 A -> Prop),
 (forall a : A, P (ATleaf1 A a)) ->
@@ -331,7 +331,7 @@ ArrowTree1_ind is not universe polymorphic
 Arguments ArrowTree1_ind A%_type_scope (P ATleaf1 ATnode1)%_function_scope a
 ArrowTree1_ind is transparent
 Expands to: Constant nested_eliminators.Template.ArrowTree1_ind
-Declared in library nested_eliminators, line 82, characters 2-133
+Declared in library nested_eliminators, line 85, characters 2-133
 Inductive
 ArrowTree1_all@{α ; u u0 u1 u2} (A : Type@{u}) (PA : A -> Type@{α ; u0})
   : ArrowTree1 A -> Type@{max(Set,u,u0,u1)} :=
@@ -366,7 +366,7 @@ ArrowTree1_all_forall is universe polymorphic
 Arguments ArrowTree1_all_forall A%_type_scope (PA HPA)%_function_scope a
 ArrowTree1_all_forall is transparent
 Expands to: Constant nested_eliminators.Template.ArrowTree1_all_forall
-Declared in library nested_eliminators, line 82, characters 2-133
+Declared in library nested_eliminators, line 85, characters 2-133
 ArrowTree2_ind :
 forall (A : Type@{ArrowTree2_ind.u0}) (P : ArrowTree2 A -> Prop),
 (forall a : A, P (ATleaf2 A a)) ->
@@ -380,7 +380,7 @@ ArrowTree2_ind is not universe polymorphic
 Arguments ArrowTree2_ind A%_type_scope (P ATleaf2 ATnode2)%_function_scope a
 ArrowTree2_ind is transparent
 Expands to: Constant nested_eliminators.Template.ArrowTree2_ind
-Declared in library nested_eliminators, line 90, characters 2-130
+Declared in library nested_eliminators, line 93, characters 2-130
 Inductive
 ArrowTree2_all@{α ; u u0 u1 u2} (A : Type@{u}) (PA : A -> Type@{α ; u0})
   : ArrowTree2 A -> Type@{max(Set,u,u0,u1)} :=
@@ -416,7 +416,7 @@ ArrowTree2_all_forall is universe polymorphic
 Arguments ArrowTree2_all_forall A%_type_scope (PA HPA)%_function_scope a
 ArrowTree2_all_forall is transparent
 Expands to: Constant nested_eliminators.Template.ArrowTree2_all_forall
-Declared in library nested_eliminators, line 90, characters 2-130
+Declared in library nested_eliminators, line 93, characters 2-130
 ArrowTree3_ind :
 forall (A : Type@{ArrowTree3_ind.u0}) (P : ArrowTree3 A -> Prop),
 (forall a : A, P (ATleaf3 A a)) ->
@@ -432,7 +432,7 @@ ArrowTree3_ind is not universe polymorphic
 Arguments ArrowTree3_ind A%_type_scope (P ATleaf3 ATnode3)%_function_scope a
 ArrowTree3_ind is transparent
 Expands to: Constant nested_eliminators.Template.ArrowTree3_ind
-Declared in library nested_eliminators, line 98, characters 2-140
+Declared in library nested_eliminators, line 101, characters 2-140
 Inductive
 ArrowTree3_all@{α ; u u0 u1 u2} (A : Type@{u}) (PA : A -> Type@{α ; u0})
   : ArrowTree3 A -> Type@{max(Set,u,u0,u1)} :=
@@ -469,7 +469,7 @@ ArrowTree3_all_forall is universe polymorphic
 Arguments ArrowTree3_all_forall A%_type_scope (PA HPA)%_function_scope a
 ArrowTree3_all_forall is transparent
 Expands to: Constant nested_eliminators.Template.ArrowTree3_all_forall
-Declared in library nested_eliminators, line 98, characters 2-140
+Declared in library nested_eliminators, line 101, characters 2-140
 Inductive
 prod_all@{α α0 ; u u0 u1 u2} (A : Type@{u}) (PA : A -> Type@{α ; u1})
 (B : Type@{u0}) (PB : B -> Type@{α0 ; u2})
@@ -497,7 +497,7 @@ Arguments prod_all_forall A%_type_scope (PA HPA)%_function_scope
   B%_type_scope (PB HPB)%_function_scope p
 prod_all_forall is transparent
 Expands to: Constant nested_eliminators.Template.prod_all_forall
-Declared in library nested_eliminators, line 108, characters 2-70
+Declared in library nested_eliminators, line 111, characters 2-70
 Inductive
 prod_all_all@{α α0 α1 α2 ; u u0 u1 u2 u3 u4} (A : Type@{u})
 (PA : A -> Type@{α ; u1}) (PPA : forall a : A, PA a -> Type@{α1 ; u3})
@@ -535,7 +535,7 @@ Arguments prod_all_all_forall A%_type_scope (PA PPA HPPA)%_function_scope
   B%_type_scope (PB PPB HPPB)%_function_scope p p0
 prod_all_all_forall is transparent
 Expands to: Constant nested_eliminators.Template.prod_all_all_forall
-Declared in library nested_eliminators, line 108, characters 2-70
+Declared in library nested_eliminators, line 111, characters 2-70
 PairTree_ind :
 forall (A : Type@{PairTree_ind.u0}) (P : PairTree A -> Prop),
 (forall a : A, P (Pleaf A a)) ->
@@ -549,7 +549,7 @@ PairTree_ind is not universe polymorphic
 Arguments PairTree_ind A%_type_scope (P Pleaf Pnode)%_function_scope p
 PairTree_ind is transparent
 Expands to: Constant nested_eliminators.Template.PairTree_ind
-Declared in library nested_eliminators, line 118, characters 2-124
+Declared in library nested_eliminators, line 121, characters 2-124
 Inductive
 PairTree_all@{α ; u u0 u1 u2} (A : Type@{u}) (PA : A -> Type@{α ; u0})
   : PairTree A -> Type@{max(Set,u,u0,u1)} :=
@@ -583,7 +583,7 @@ PairTree_all_forall is universe polymorphic
 Arguments PairTree_all_forall A%_type_scope (PA HPA)%_function_scope p
 PairTree_all_forall is transparent
 Expands to: Constant nested_eliminators.Template.PairTree_all_forall
-Declared in library nested_eliminators, line 118, characters 2-124
+Declared in library nested_eliminators, line 121, characters 2-124
 LeftTree_ind :
 forall (A : Type@{LeftTree_ind.u0}) (P : LeftTree A -> Prop),
 (forall a : A, P (Lleaf A a)) ->
@@ -598,7 +598,7 @@ Arguments LeftTree_ind A%_type_scope (P Lleaf Lnode)%_function_scope l
 LeftTree_ind is transparent
 Expands to: Constant
             nested_eliminators.Template.AutoGeneratedScheme.LeftTree_ind
-Declared in library nested_eliminators, line 128, characters 4-121
+Declared in library nested_eliminators, line 131, characters 4-121
 Inductive
 LeftTree_all@{α ; u u0 u1 u2} (A : Type@{u}) (PA : A -> Type@{α ; u0})
   : LeftTree A -> Type@{max(Set,u,u0,u1)} :=
@@ -633,7 +633,7 @@ Arguments LeftTree_all_forall A%_type_scope (PA HPA)%_function_scope l
 LeftTree_all_forall is transparent
 Expands to: Constant
             nested_eliminators.Template.AutoGeneratedScheme.LeftTree_all_forall
-Declared in library nested_eliminators, line 128, characters 4-121
+Declared in library nested_eliminators, line 131, characters 4-121
 LeftTree_ind :
 forall (A : Type@{LeftTree_ind.u0}) (P : LeftTree A -> Prop),
 (forall a : A, P (Lleaf A a)) ->
@@ -647,7 +647,7 @@ LeftTree_ind is not universe polymorphic
 Arguments LeftTree_ind A%_type_scope (P Lleaf Lnode)%_function_scope l
 LeftTree_ind is transparent
 Expands to: Constant nested_eliminators.Template.Scheme.LeftTree_ind
-Declared in library nested_eliminators, line 146, characters 4-44
+Declared in library nested_eliminators, line 149, characters 4-44
 Inductive
 LeftTree_all@{α ; u u0 u1 u2} (A : Type@{u}) (PA : A -> Type@{α ; u0})
   : LeftTree A -> Type@{max(Set,u,u0,u1)} :=
@@ -681,7 +681,7 @@ LeftTree_all_forall is universe polymorphic
 Arguments LeftTree_all_forall A%_type_scope (PA HPA)%_function_scope l
 LeftTree_all_forall is transparent
 Expands to: Constant nested_eliminators.Template.Scheme.LeftTree_all_forall
-Declared in library nested_eliminators, line 142, characters 4-121
+Declared in library nested_eliminators, line 145, characters 4-121
 Inductive
 prod_all_10@{α ; u u0 u1} (A : Type@{u}) (PA : A -> Type@{α ; u1})
 (B : Type@{u0}) : prod A B -> Type@{max(u,u0,u1)} :=
@@ -704,7 +704,7 @@ Arguments prod_all_forall_10 A%_type_scope (PA HPA)%_function_scope
 prod_all_forall_10 is transparent
 Expands to: Constant
             nested_eliminators.Template.PartialAll.prod_all_forall_10
-Declared in library nested_eliminators, line 156, characters 4-31
+Declared in library nested_eliminators, line 159, characters 4-31
 Inductive
 prod_all_10_all@{α α0 ; u u0 u1 u2} (A : Type@{u}) 
 (PA : A -> Type@{α ; u1}) (PPA : forall a : A, PA a -> Type@{α0 ; u2})
@@ -737,7 +737,7 @@ Arguments prod_all_10_all_forall A%_type_scope (PA PPA HPPA)%_function_scope
 prod_all_10_all_forall is transparent
 Expands to: Constant
             nested_eliminators.Template.PartialAll.prod_all_10_all_forall
-Declared in library nested_eliminators, line 156, characters 4-31
+Declared in library nested_eliminators, line 159, characters 4-31
 LeftTree_ind :
 forall (A : Type@{LeftTree_ind.u0}) (P : LeftTree A -> Prop),
 (forall a : A, P (Lleaf A a)) ->
@@ -750,7 +750,7 @@ LeftTree_ind is not universe polymorphic
 Arguments LeftTree_ind A%_type_scope (P Lleaf Lnode)%_function_scope l
 LeftTree_ind is transparent
 Expands to: Constant nested_eliminators.Template.PartialAll.LeftTree_ind
-Declared in library nested_eliminators, line 162, characters 4-121
+Declared in library nested_eliminators, line 165, characters 4-121
 Inductive
 LeftTree_all@{α ; u u0 u1 u2} (A : Type@{u}) (PA : A -> Type@{α ; u0})
   : LeftTree A -> Type@{max(Set,u,u0,u1)} :=
@@ -784,7 +784,7 @@ Arguments LeftTree_all_forall A%_type_scope (PA HPA)%_function_scope l
 LeftTree_all_forall is transparent
 Expands to: Constant
             nested_eliminators.Template.PartialAll.LeftTree_all_forall
-Declared in library nested_eliminators, line 162, characters 4-121
+Declared in library nested_eliminators, line 165, characters 4-121
 RightTree_ind :
 forall (A : Type@{RightTree_ind.u0}) (P : RightTree A -> Prop),
 (forall a : A, P (Rleaf A a)) ->
@@ -798,7 +798,7 @@ RightTree_ind is not universe polymorphic
 Arguments RightTree_ind A%_type_scope (P Rleaf Rnode)%_function_scope r
 RightTree_ind is transparent
 Expands to: Constant nested_eliminators.Template.RightTree_ind
-Declared in library nested_eliminators, line 172, characters 2-119
+Declared in library nested_eliminators, line 175, characters 2-119
 Inductive
 RightTree_all@{α ; u u0 u1 u2} (A : Type@{u}) (PA : A -> Type@{α ; u0})
   : RightTree A -> Type@{max(Set,u,u0,u1)} :=
@@ -832,7 +832,7 @@ RightTree_all_forall is universe polymorphic
 Arguments RightTree_all_forall A%_type_scope (PA HPA)%_function_scope r
 RightTree_all_forall is transparent
 Expands to: Constant nested_eliminators.Template.RightTree_all_forall
-Declared in library nested_eliminators, line 172, characters 2-119
+Declared in library nested_eliminators, line 175, characters 2-119
 Inductive
 vec_all@{α ; u u0} (A : Type@{u}) (PA : A -> Type@{α ; u0})
   : forall n : nat, vec A n -> Type@{max(Set,u,u0)} :=
@@ -857,7 +857,7 @@ vec_all_forall is universe polymorphic
 Arguments vec_all_forall A%_type_scope (PA HPA)%_function_scope n v
 vec_all_forall is transparent
 Expands to: Constant nested_eliminators.Template.vec_all_forall
-Declared in library nested_eliminators, line 182, characters 2-107
+Declared in library nested_eliminators, line 185, characters 2-107
 Inductive
 vec_all_all@{α α0 ; u u0 u1} (A : Type@{u}) (PA : A -> Type@{α ; u0})
 (PPA : forall a : A, PA a -> Type@{α0 ; u1})
@@ -891,7 +891,7 @@ Arguments vec_all_all_forall A%_type_scope (PA PPA HPPA)%_function_scope
   n v v0
 vec_all_all_forall is transparent
 Expands to: Constant nested_eliminators.Template.vec_all_all_forall
-Declared in library nested_eliminators, line 182, characters 2-107
+Declared in library nested_eliminators, line 185, characters 2-107
 VecTree_ind :
 forall (A : Type@{VecTree_ind.u0}) (P : VecTree A -> Prop),
 (forall a : A, P (VNleaf A a)) ->
@@ -903,7 +903,7 @@ VecTree_ind is not universe polymorphic
 Arguments VecTree_ind A%_type_scope (P VNleaf VNnode)%_function_scope v
 VecTree_ind is transparent
 Expands to: Constant nested_eliminators.Template.VecTree_ind
-Declared in library nested_eliminators, line 191, characters 2-112
+Declared in library nested_eliminators, line 194, characters 2-112
 Inductive
 VecTree_all@{α ; u u0 u1 u2} (A : Type@{u}) (PA : A -> Type@{α ; u0})
   : VecTree A -> Type@{max(Set,u,u0,u1)} :=
@@ -936,7 +936,7 @@ VecTree_all_forall is universe polymorphic
 Arguments VecTree_all_forall A%_type_scope (PA HPA)%_function_scope v
 VecTree_all_forall is transparent
 Expands to: Constant nested_eliminators.Template.VecTree_all_forall
-Declared in library nested_eliminators, line 191, characters 2-112
+Declared in library nested_eliminators, line 194, characters 2-112
 Inductive
 All2i_all@{α ; u u0 u1 u2} (A : Type@{u}) (B : Type@{u0})
 (R : nat -> A -> B -> Type@{u1})
@@ -973,7 +973,7 @@ Arguments All2i_all_forall (A B)%_type_scope (R PR HPR)%_function_scope
   n l l a
 All2i_all_forall is transparent
 Expands to: Constant nested_eliminators.Template.All2i_all_forall
-Declared in library nested_eliminators, line 202, characters 2-304
+Declared in library nested_eliminators, line 205, characters 2-304
 Inductive
 All2i_all_all@{α α0 ; u u0 u1 u2 u3} (A : Type@{u}) 
 (B : Type@{u0}) (R : nat -> A -> B -> Type@{u1})
@@ -1025,8 +1025,8 @@ Arguments All2i_all_all_forall (A B)%_type_scope
   (R PR PPR HPPR)%_function_scope n l l a a0
 All2i_all_all_forall is transparent
 Expands to: Constant nested_eliminators.Template.All2i_all_all_forall
-Declared in library nested_eliminators, line 202, characters 2-304
-File "./output/nested_eliminators.v", line 212, characters 2-35:
+Declared in library nested_eliminators, line 205, characters 2-304
+File "./output/nested_eliminators.v", line 215, characters 2-35:
 The command has indeed failed with message:
 The variable A is not included in the uniform parameters that are strictly positive and can be nested on.
 Allowed parameters are R.
@@ -1046,7 +1046,7 @@ Arguments typing_ind (A B)%_type_scope (P typ_nil typ_cons)%_function_scope
   n a b t
 typing_ind is transparent
 Expands to: Constant nested_eliminators.Template.typing_ind
-Declared in library nested_eliminators, line 214, characters 2-218
+Declared in library nested_eliminators, line 217, characters 2-218
 Inductive
 All2i_bis_all@{α α0 ; u u0 u1 u2 u3 u4} (A : Type@{u}) 
 (B : Type@{u0}) (C : Type@{u1}) (PC : C -> Type@{α ; u3})
@@ -1091,7 +1091,7 @@ Arguments All2i_bis_all_forall (A B C)%_type_scope
   (PC HPC R PR HPR)%_function_scope n l l a
 All2i_bis_all_forall is transparent
 Expands to: Constant nested_eliminators.Template.All2i_bis_all_forall
-Declared in library nested_eliminators, line 223, characters 2-341
+Declared in library nested_eliminators, line 226, characters 2-341
 Inductive
 All2i_bis_all_all@{α α0 α1 α2 ; u u0 u1 u2 u3 u4 u5 u6} 
 (A : Type@{u}) (B : Type@{u0}) (C : Type@{u1}) (PC : C -> Type@{α ; u3})
@@ -1159,7 +1159,7 @@ Arguments All2i_bis_all_all_forall (A B C)%_type_scope
   l a a0
 All2i_bis_all_all_forall is transparent
 Expands to: Constant nested_eliminators.Template.All2i_bis_all_all_forall
-Declared in library nested_eliminators, line 223, characters 2-341
+Declared in library nested_eliminators, line 226, characters 2-341
 triv_All2_bis_ind :
 forall P : triv_All2_bis -> Prop,
 (forall
@@ -1175,7 +1175,7 @@ triv_All2_bis_ind is not universe polymorphic
 Arguments triv_All2_bis_ind (P ctriv_All2_bis)%_function_scope t
 triv_All2_bis_ind is transparent
 Expands to: Constant nested_eliminators.Template.triv_All2_bis_ind
-Declared in library nested_eliminators, line 233, characters 2-176
+Declared in library nested_eliminators, line 236, characters 2-176
 Inductive
 sig_all@{α α0 ; u u0 u1} (A : Type@{u}) (PA : A -> Type@{α ; u0})
 (P : A -> Prop) (PP : forall a : A, P a -> Type@{α0 ; u1})
@@ -1200,7 +1200,7 @@ sig_all_forall is universe polymorphic
 Arguments sig_all_forall A%_type_scope (PA HPA P PP HPP)%_function_scope s
 sig_all_forall is transparent
 Expands to: Constant nested_eliminators.Template.sig_all_forall
-Declared in library nested_eliminators, line 241, characters 2-94
+Declared in library nested_eliminators, line 244, characters 2-94
 Inductive
 sig_all_10@{α ; u u0} (A : Type@{u}) (PA : A -> Type@{α ; u0})
 (P : A -> Prop) : sig A P -> Type@{max(u,u0)} :=
@@ -1222,7 +1222,7 @@ sig_all_forall_10 is universe polymorphic
 Arguments sig_all_forall_10 A%_type_scope (PA HPA P)%_function_scope s
 sig_all_forall_10 is transparent
 Expands to: Constant nested_eliminators.Template.sig_all_forall_10
-Declared in library nested_eliminators, line 247, characters 2-28
+Declared in library nested_eliminators, line 250, characters 2-28
 Inductive
 sig_all_01@{α ; u u0} (A : Type@{u}) (P : A -> Prop)
 (PP : forall a : A, P a -> Type@{α ; u0}) : sig A P -> Type@{max(u,u0)} :=
@@ -1243,7 +1243,7 @@ sig_all_forall_01 is universe polymorphic
 Arguments sig_all_forall_01 A%_type_scope (P PP HPP)%_function_scope s
 sig_all_forall_01 is transparent
 Expands to: Constant nested_eliminators.Template.sig_all_forall_01
-Declared in library nested_eliminators, line 251, characters 2-28
+Declared in library nested_eliminators, line 254, characters 2-28
 Inductive
 NestRel_all@{α α0 ; u u0 u1 u2} (A : Type@{u}) (PA : A -> Type@{α ; u0})
 (R : A -> A -> Prop) (PR : forall a a0 : A, R a a0 -> Type@{α0 ; u1})
@@ -1272,8 +1272,8 @@ Arguments NestRel_all_forall A%_type_scope (PA HPA R PR HPR)%_function_scope
   n
 NestRel_all_forall is transparent
 Expands to: Constant nested_eliminators.Template.NestRel_all_forall
-Declared in library nested_eliminators, line 264, characters 2-111
-File "./output/nested_eliminators.v", line 278, characters 4-26:
+Declared in library nested_eliminators, line 267, characters 2-111
+File "./output/nested_eliminators.v", line 281, characters 4-26:
 The command has indeed failed with message:
 Not implemented for primitive records.
 Inductive
@@ -1301,7 +1301,7 @@ ex_all_forall is universe polymorphic
 Arguments ex_all_forall A%_type_scope (PA HPA P PP HPP)%_function_scope e
 ex_all_forall is transparent
 Expands to: Constant nested_eliminators.Template.ex_all_forall
-Declared in library nested_eliminators, line 284, characters 2-87
+Declared in library nested_eliminators, line 287, characters 2-87
 adequate_ind :
 forall (L : language) (φ : unit -> Type@{adequate_ind.u0})
   (P : adequate L φ -> Prop),
@@ -1313,7 +1313,7 @@ adequate_ind is not universe polymorphic
 Arguments adequate_ind L (φ P cadequate)%_function_scope a
 adequate_ind is transparent
 Expands to: Constant nested_eliminators.Template.adequate_ind
-Declared in library nested_eliminators, line 295, characters 2-131
+Declared in library nested_eliminators, line 298, characters 2-131
 adequate_all@{α ; u u0} :
 forall (L : language) (φ : unit -> Type@{u}),
 (forall u : unit, φ u -> Type@{α ; u0}) -> adequate L φ -> Prop
@@ -1322,7 +1322,7 @@ forall (L : language) (φ : unit -> Type@{u}),
 adequate_all is universe polymorphic
 Arguments adequate_all L (φ Pφ)%_function_scope a
 Expands to: Inductive nested_eliminators.Template.adequate_all
-Declared in library nested_eliminators, line 295, characters 2-131
+Declared in library nested_eliminators, line 298, characters 2-131
 casenat_all@{α ; u} :
 forall P : nat -> Set,
 (forall n : nat, P n -> Type@{α ; u}) -> casenat P -> Type@{max(Set,u)}
@@ -1331,7 +1331,7 @@ forall P : nat -> Set,
 casenat_all is universe polymorphic
 Arguments casenat_all (P PP)%_function_scope c
 Expands to: Inductive nested_eliminators.Template.casenat_all
-Declared in library nested_eliminators, line 302, characters 2-94
+Declared in library nested_eliminators, line 305, characters 2-94
 casenat'_all@{α α0 ; u u0} :
 forall (A : nat -> Set) (PZ : Set),
 (PZ -> Type@{α ; u}) ->
@@ -1344,8 +1344,8 @@ casenat'_all is universe polymorphic
 Arguments casenat'_all A%_function_scope PZ%_type_scope
   (PPZ PS PPS)%_function_scope c
 Expands to: Inductive nested_eliminators.Template.casenat'_all
-Declared in library nested_eliminators, line 307, characters 2-147
-File "./output/nested_eliminators.v", line 325, characters 13-21:
+Declared in library nested_eliminators, line 310, characters 2-147
+File "./output/nested_eliminators.v", line 328, characters 13-21:
 The command has indeed failed with message:
 The reference True_all was not found in the current environment.
 Inductive
@@ -1371,7 +1371,7 @@ list_all_forall is universe polymorphic
 Arguments list_all_forall A%_type_scope (PA HPA)%_function_scope l
 list_all_forall is transparent
 Expands to: Constant nested_eliminators.UnivPoly.list_all_forall
-Declared in library nested_eliminators, line 328, characters 2-88
+Declared in library nested_eliminators, line 331, characters 2-88
 Inductive
 list_all_all@{α α0 ; u u0 u1} (A : Type@{u}) (PA : A -> Type@{α ; u0})
 (PPA : forall a : A, PA a -> Type@{α0 ; u1})
@@ -1403,7 +1403,7 @@ Arguments list_all_all_forall A%_type_scope (PA PPA HPPA)%_function_scope
   l l0
 list_all_all_forall is transparent
 Expands to: Constant nested_eliminators.UnivPoly.list_all_all_forall
-Declared in library nested_eliminators, line 328, characters 2-88
+Declared in library nested_eliminators, line 331, characters 2-88
 MRT_ind@{} :
 forall P : MRT -> Prop,
 (forall l : list@{Set} MRT,
@@ -1414,7 +1414,7 @@ MRT_ind is universe polymorphic
 Arguments MRT_ind (P MRTnode)%_function_scope m
 MRT_ind is transparent
 Expands to: Constant nested_eliminators.UnivPoly.MRT_ind
-Declared in library nested_eliminators, line 337, characters 2-55
+Declared in library nested_eliminators, line 340, characters 2-55
 RoseTree_ind@{u u0} :
 forall (A : Type@{u}) (P : RoseTree@{u u0} A -> Prop),
 (forall a : A, P (RTleaf@{u u0} A a)) ->
@@ -1427,7 +1427,7 @@ RoseTree_ind is universe polymorphic
 Arguments RoseTree_ind A%_type_scope (P RTleaf RTnode)%_function_scope r
 RoseTree_ind is transparent
 Expands to: Constant nested_eliminators.UnivPoly.RoseTree_ind
-Declared in library nested_eliminators, line 342, characters 2-113
+Declared in library nested_eliminators, line 345, characters 2-113
 Inductive
 RoseTree_all@{α ; u u0 u1 u2} (A : Type@{u}) (PA : A -> Type@{α ; u1})
   : RoseTree@{u u0} A -> Type@{max(u0,u1,u2)} :=
@@ -1457,7 +1457,7 @@ RoseTree_all_forall is universe polymorphic
 Arguments RoseTree_all_forall A%_type_scope (PA HPA)%_function_scope r
 RoseTree_all_forall is transparent
 Expands to: Constant nested_eliminators.UnivPoly.RoseTree_all_forall
-Declared in library nested_eliminators, line 342, characters 2-113
+Declared in library nested_eliminators, line 345, characters 2-113
 RoseRoseTree_ind@{u u0 u1} :
 forall (A : Type@{u}) (P : RoseRoseTree@{u u0} A -> Prop),
 (forall a : A, P (Nleaf@{u u0} A a)) ->
@@ -1474,7 +1474,7 @@ RoseRoseTree_ind is universe polymorphic
 Arguments RoseRoseTree_ind A%_type_scope (P Nleaf Nnode)%_function_scope r
 RoseRoseTree_ind is transparent
 Expands to: Constant nested_eliminators.UnivPoly.RoseRoseTree_ind
-Declared in library nested_eliminators, line 350, characters 2-136
+Declared in library nested_eliminators, line 353, characters 2-136
 Inductive
 RoseRoseTree_all@{α ; u u0 u1 u2} (A : Type@{u}) (PA : A -> Type@{α ; u1})
   : RoseRoseTree@{u u0} A -> Type@{max(u0,u1,u2)} :=
@@ -1508,7 +1508,7 @@ RoseRoseTree_all_forall is universe polymorphic
 Arguments RoseRoseTree_all_forall A%_type_scope (PA HPA)%_function_scope r
 RoseRoseTree_all_forall is transparent
 Expands to: Constant nested_eliminators.UnivPoly.RoseRoseTree_all_forall
-Declared in library nested_eliminators, line 350, characters 2-136
+Declared in library nested_eliminators, line 353, characters 2-136
 ArrowTree3_ind@{u u0} :
 forall (A : Type@{u}) (P : ArrowTree3@{u u0} A -> Prop),
 (forall a : A, P (ATleaf3@{u u0} A a)) ->
@@ -1525,7 +1525,7 @@ ArrowTree3_ind is universe polymorphic
 Arguments ArrowTree3_ind A%_type_scope (P ATleaf3 ATnode3)%_function_scope a
 ArrowTree3_ind is transparent
 Expands to: Constant nested_eliminators.UnivPoly.ArrowTree3_ind
-Declared in library nested_eliminators, line 358, characters 2-140
+Declared in library nested_eliminators, line 361, characters 2-140
 Inductive
 ArrowTree3_all@{α ; u u0 u1 u2} (A : Type@{u}) (PA : A -> Type@{α ; u1})
   : ArrowTree3@{u u0} A -> Type@{max(u0,u1,u2)} :=
@@ -1561,7 +1561,160 @@ ArrowTree3_all_forall is universe polymorphic
 Arguments ArrowTree3_all_forall A%_type_scope (PA HPA)%_function_scope a
 ArrowTree3_all_forall is transparent
 Expands to: Constant nested_eliminators.UnivPoly.ArrowTree3_all_forall
-Declared in library nested_eliminators, line 358, characters 2-140
+Declared in library nested_eliminators, line 361, characters 2-140
+trie_rect@{u u0 u1 u2} =
+fun (A : Type@{u}) (P : trie@{u u0} A -> Type@{u1})
+  (TLeaf : P (TLeaf@{u u0} A))
+  (TNode : forall (a : A) (a0 : array@{u0} (trie@{u u0} A)),
+           array_all@{Type ; u0 u1 u2} (trie@{u u0} A) P a0 ->
+           P (TNode@{u u0} A a a0)) =>
+fix F (t : trie@{u u0} A) : P t :=
+  match t as t0 return P t0 with
+  | Array.TLeaf _ => TLeaf
+  | Array.TNode _ a a0 =>
+      TNode a a0 (array_all_forall@{Type ; u0 u1 u2} (trie@{u u0} A) P F a0)
+  end
+     : forall (A : Type@{u}) (P : trie@{u u0} A -> Type@{u1}),
+       P (TLeaf@{u u0} A) ->
+       (forall (a : A) (a0 : array@{u0} (trie@{u u0} A)),
+        array_all@{Type ; u0 u1 u2} (trie@{u u0} A) P a0 ->
+        P (TNode@{u u0} A a a0)) ->
+       forall t : trie@{u u0} A, P t
+(* u u0 u1 u2 |= Set <= u2
+                 u <= u0
+                 u1 <= u2 *)
+
+Arguments trie_rect A%_type_scope P%_function_scope 
+  TLeaf TNode%_function_scope t
+Inductive
+trie_all@{α ; u u0 u1 u2} (A : Type@{u}) (PA : A -> Type@{α ; u1})
+  : trie@{u u0} A -> Type@{max(u0,u1,u2)} :=
+    TLeaf_all : trie_all@{α ; u u0 u1 u2} A PA (TLeaf@{u u0} A)
+  | TNode_all : forall a : A,
+                PA a ->
+                forall a0 : array@{u0} (trie@{u u0} A),
+                array_all@{Type ; u0 u2 u2} (trie@{u u0} A)
+                  (trie_all@{α ; u u0 u1 u2} A PA) a0 ->
+                trie_all@{α ; u u0 u1 u2} A PA (TNode@{u u0} A a a0).
+(* α ; =u =u0 *u1 *u2 |= Set <= u2
+                         u <= u0
+                         u0 <= u2
+                         u1 <= u2 *)
+
+Arguments trie_all A%_type_scope PA%_function_scope t
+Arguments TLeaf_all A%_type_scope PA%_function_scope
+Arguments TNode_all A%_type_scope PA%_function_scope a _ a _
+ArrowTrie_rect@{u u0 u1 u2} =
+fun (A : Type@{u}) (P : ArrowTrie@{u u0} A -> Type@{u1})
+  (ATLeaf : P (ATLeaf@{u u0} A))
+  (ATNode : forall (a : A)
+              (l : bool -> list@{u0} (array@{u0} (ArrowTrie@{u u0} A))),
+            (forall H : bool,
+             list_all@{Type ; u0 u2} (array@{u0} (ArrowTrie@{u u0} A))
+               (array_all@{Type ; u0 u1 u2} (ArrowTrie@{u u0} A) P) 
+               (l H)) ->
+            P (ATNode@{u u0} A a l)) =>
+fix F (a : ArrowTrie@{u u0} A) : P a :=
+  match a as a0 return P a0 with
+  | Array.ATLeaf _ => ATLeaf
+  | Array.ATNode _ a0 l =>
+      ATNode a0 l
+        (fun H : bool =>
+         list_all_forall@{Type ; u0 u2} (array@{u0} (ArrowTrie@{u u0} A))
+           (array_all@{Type ; u0 u1 u2} (ArrowTrie@{u u0} A) P)
+           (array_all_forall@{Type ; u0 u1 u2} (ArrowTrie@{u u0} A) P F)
+           (l H))
+  end
+     : forall (A : Type@{u}) (P : ArrowTrie@{u u0} A -> Type@{u1}),
+       P (ATLeaf@{u u0} A) ->
+       (forall (a : A)
+          (l : bool -> list@{u0} (array@{u0} (ArrowTrie@{u u0} A))),
+        (forall H : bool,
+         list_all@{Type ; u0 u2} (array@{u0} (ArrowTrie@{u u0} A))
+           (array_all@{Type ; u0 u1 u2} (ArrowTrie@{u u0} A) P) 
+           (l H)) ->
+        P (ATNode@{u u0} A a l)) ->
+       forall a : ArrowTrie@{u u0} A, P a
+(* u u0 u1 u2 |= Set <= u2
+                 u <= u0
+                 u1 <= u2 *)
+
+Arguments ArrowTrie_rect A%_type_scope P%_function_scope 
+  ATLeaf ATNode%_function_scope a
+Inductive
+ArrowTrie_all@{α ; u u0 u1 u2} (A : Type@{u}) (PA : A -> Type@{α ; u1})
+  : ArrowTrie@{u u0} A -> Type@{max(u0,u1,u2)} :=
+    ATLeaf_all : ArrowTrie_all@{α ; u u0 u1 u2} A PA (ATLeaf@{u u0} A)
+  | ATNode_all : forall a : A,
+                 PA a ->
+                 forall
+                   l : bool -> list@{u0} (array@{u0} (ArrowTrie@{u u0} A)),
+                 (forall H : bool,
+                  list_all@{Type ; u0 u2} (array@{u0} (ArrowTrie@{u u0} A))
+                    (array_all@{Type ; u0 u2 u2} (ArrowTrie@{u u0} A)
+                       (ArrowTrie_all@{α ; u u0 u1 u2} A PA))
+                    (l H)) ->
+                 ArrowTrie_all@{α ; u u0 u1 u2} A PA (ATNode@{u u0} A a l).
+(* α ; =u =u0 *u1 *u2 |= Set <= u2
+                         u <= u0
+                         u0 <= u2
+                         u1 <= u2 *)
+
+Arguments ArrowTrie_all A%_type_scope PA%_function_scope a
+Arguments ATLeaf_all A%_type_scope PA%_function_scope
+Arguments ATNode_all A%_type_scope PA%_function_scope 
+  a _ (l _)%_function_scope
+ArrayTrie_rect@{u u0 u1 u2} =
+fun (A : Type@{u}) (P : ArrayTrie@{u u0} A -> Type@{u1})
+  (AyTLeaf : P (AyTLeaf@{u u0} A))
+  (AyTNode : forall (a : A)
+               (a0 : array@{u0} (array@{u0} (ArrayTrie@{u u0} A))),
+             array_all@{Type ; u0 u2 u2} (array@{u0} (ArrayTrie@{u u0} A))
+               (array_all@{Type ; u0 u1 u2} (ArrayTrie@{u u0} A) P) a0 ->
+             P (AyTNode@{u u0} A a a0)) =>
+fix F (a : ArrayTrie@{u u0} A) : P a :=
+  match a as a0 return P a0 with
+  | Array.AyTLeaf _ => AyTLeaf
+  | Array.AyTNode _ a0 a1 =>
+      AyTNode a0 a1
+        (array_all_forall@{Type ; u0 u2 u2} (array@{u0} (ArrayTrie@{u u0} A))
+           (array_all@{Type ; u0 u1 u2} (ArrayTrie@{u u0} A) P)
+           (array_all_forall@{Type ; u0 u1 u2} (ArrayTrie@{u u0} A) P F) a1)
+  end
+     : forall (A : Type@{u}) (P : ArrayTrie@{u u0} A -> Type@{u1}),
+       P (AyTLeaf@{u u0} A) ->
+       (forall (a : A) (a0 : array@{u0} (array@{u0} (ArrayTrie@{u u0} A))),
+        array_all@{Type ; u0 u2 u2} (array@{u0} (ArrayTrie@{u u0} A))
+          (array_all@{Type ; u0 u1 u2} (ArrayTrie@{u u0} A) P) a0 ->
+        P (AyTNode@{u u0} A a a0)) ->
+       forall a : ArrayTrie@{u u0} A, P a
+(* u u0 u1 u2 |= Set <= u2
+                 u <= u0
+                 u1 <= u2 *)
+
+Arguments ArrayTrie_rect A%_type_scope P%_function_scope 
+  AyTLeaf AyTNode%_function_scope a
+Inductive
+ArrayTrie_all@{α ; u u0 u1 u2} (A : Type@{u}) (PA : A -> Type@{α ; u1})
+  : ArrayTrie@{u u0} A -> Type@{max(u0,u1,u2)} :=
+    AyTLeaf_all : ArrayTrie_all@{α ; u u0 u1 u2} A PA (AyTLeaf@{u u0} A)
+  | AyTNode_all : forall a : A,
+                  PA a ->
+                  forall a0 : array@{u0} (array@{u0} (ArrayTrie@{u u0} A)),
+                  array_all@{Type ; u0 u2 u2}
+                    (array@{u0} (ArrayTrie@{u u0} A))
+                    (array_all@{Type ; u0 u2 u2} (ArrayTrie@{u u0} A)
+                       (ArrayTrie_all@{α ; u u0 u1 u2} A PA))
+                    a0 ->
+                  ArrayTrie_all@{α ; u u0 u1 u2} A PA (AyTNode@{u u0} A a a0).
+(* α ; =u =u0 *u1 *u2 |= Set <= u2
+                         u <= u0
+                         u0 <= u2
+                         u1 <= u2 *)
+
+Arguments ArrayTrie_all A%_type_scope PA%_function_scope a
+Arguments AyTLeaf_all A%_type_scope PA%_function_scope
+Arguments AyTNode_all A%_type_scope PA%_function_scope a _ a _
 Inductive
 list_all@{α α0 ; u u0 u1} (A : Type@{α ; u}) (PA : A -> Type@{α0 ; u1})
   : list@{α ; u u0} A -> Type@{α ; max(u0,u1)} :=
@@ -1586,7 +1739,7 @@ list_all_forall is universe polymorphic
 Arguments list_all_forall A%_type_scope (PA HPA)%_function_scope l
 list_all_forall is transparent
 Expands to: Constant nested_eliminators.SortPoly.list_all_forall
-Declared in library nested_eliminators, line 378, characters 2-22
+Declared in library nested_eliminators, line 416, characters 2-22
 Inductive
 list_all_all@{α α0 α1 ; u u0 u1 u2} (A : Type@{α ; u})
 (PA : A -> Type@{α0 ; u1}) (PPA : forall a : A, PA a -> Type@{α1 ; u2})
@@ -1620,7 +1773,7 @@ Arguments list_all_all_forall A%_type_scope (PA PPA HPPA)%_function_scope
   l l0
 list_all_all_forall is transparent
 Expands to: Constant nested_eliminators.SortPoly.list_all_all_forall
-Declared in library nested_eliminators, line 382, characters 2-26
+Declared in library nested_eliminators, line 420, characters 2-26
 MRT_ind@{} :
 forall P : MRT -> Prop,
 (forall l : list@{Type ; Set Set} MRT,
@@ -1631,7 +1784,7 @@ MRT_ind is universe polymorphic
 Arguments MRT_ind (P MRTnode)%_function_scope m
 MRT_ind is transparent
 Expands to: Constant nested_eliminators.SortPoly.MRT_ind
-Declared in library nested_eliminators, line 386, characters 2-55
+Declared in library nested_eliminators, line 424, characters 2-55
 SRT_sind@{u u0} :
 forall P : SRT@{u} -> SProp,
 (forall l : list@{SProp ; u u} SRT@{u},
@@ -1643,8 +1796,8 @@ SRT_sind is universe polymorphic
 Arguments SRT_sind (P SRTnode)%_function_scope s
 SRT_sind is transparent
 Expands to: Constant nested_eliminators.SortPoly.SRT_sind
-Declared in library nested_eliminators, line 391, characters 2-57
-File "./output/nested_eliminators.v", line 408, characters 2-60:
+Declared in library nested_eliminators, line 429, characters 2-57
+File "./output/nested_eliminators.v", line 446, characters 2-60:
 The command has indeed failed with message:
 MRT is nested using list. No scheme for list is registered as All. It can be
 generated using command "Scheme All" e.g. "Scheme All for list.".
@@ -1657,7 +1810,7 @@ MRT_ind is not universe polymorphic
 Arguments MRT_ind (P MRTnode)%_function_scope m
 MRT_ind is transparent
 Expands to: Constant nested_eliminators.TestWarning.MRT_ind
-Declared in library nested_eliminators, line 413, characters 2-55
+Declared in library nested_eliminators, line 451, characters 2-55
 Nester_all@{α ; u} :
 forall X : unit -> P unit,
 (forall u u0 : unit, X u u0 -> Type@{α ; u}) ->
@@ -1667,4 +1820,4 @@ Nester X -> Type@{max(P.u1,u)}
 Nester_all is universe polymorphic
 Arguments Nester_all (X PX)%_function_scope n
 Expands to: Inductive nested_eliminators.DeepArities.Nester_all
-Declared in library nested_eliminators, line 427, characters 2-24
+Declared in library nested_eliminators, line 465, characters 2-24
diff --git a/test-suite/output/nested_eliminators.v b/test-suite/output/nested_eliminators.v
index 58f926badb94..54a2a6b2e4da 100644
--- a/test-suite/output/nested_eliminators.v
+++ b/test-suite/output/nested_eliminators.v
@@ -17,6 +17,9 @@ Inductive unit : Set :=
 Register unit as core.unit.type.
 Register tt as core.unit.tt.
 
+From Corelib Require Import PrimInt63 PrimArray ArrayAxioms.
+
+
 Set Printing Universes.
 
 Module Template.
@@ -363,6 +366,41 @@ Module UnivPoly.
   Print ArrowTree3_all.
   About ArrowTree3_all_forall.
 
+  (* Nesting with array *)
+  Module Array.
+
+    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 _.
+
+    Register Scheme array_all as All for array.
+    Register Scheme array_all_forall as AllForall for array.
+
+    Inductive trie A := TLeaf : trie A | TNode : A -> array (trie A) -> (trie A).
+
+    Print trie_rect.
+    Print trie_all.
+
+    Inductive ArrowTrie A :=
+    | ATLeaf : ArrowTrie A
+    | ATNode : A -> (bool -> list (array (ArrowTrie A))) -> ArrowTrie A.
+
+    Print ArrowTrie_rect.
+    Print ArrowTrie_all.
+
+    Inductive ArrayTrie A :=
+    | AyTLeaf : ArrayTrie A
+    | AyTNode : A -> (array (array (ArrayTrie A))) -> ArrayTrie A.
+
+    Print ArrayTrie_rect.
+    Print ArrayTrie_all.
+
+  End Array.
+
 End UnivPoly.
 
 

From 69cf8d3a76c69681d4e6f25836859da59f00f978 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Fri, 24 Apr 2026 11:02:26 +0200
Subject: [PATCH 426/578] Use native OCaml lexer engine for rocqdep library.

This patch simply calls ocamllex with the -ml flag to generate the rocqdep
lexer. Contrarily to the default behaviour, this compiles the lexer directly
to OCaml code rather than going through a runtime implemented in C.

As explained by the ocamllex documentation, "this option improves performance
when using the native compiler, but decreases it when using the bytecode
compiler". As in practice we never use the bytecode version of rocqdep,
OCaml lexer compilation is thus a better choice for the standard Rocq usage.

On the typewise-isomorphism repository, this makes rocqdep about twice as fast,
which means that the native engine is about 4 times as fast than the C engine.
---
 tools/coqdep/lib/dune | 6 +++++-
 1 file changed, 5 insertions(+), 1 deletion(-)

diff --git a/tools/coqdep/lib/dune b/tools/coqdep/lib/dune
index 87bbd6d28536..69c504f9f527 100644
--- a/tools/coqdep/lib/dune
+++ b/tools/coqdep/lib/dune
@@ -3,4 +3,8 @@
  (public_name rocq-runtime.coqdeplib)
  (libraries rocq-runtime.boot rocq-runtime.lib findlib.internal))
 
-(ocamllex lexer)
+(rule
+ (target lexer.ml)
+ (deps   lexer.mll)
+ (action (chdir %{workspace_root}
+          (run %{bin:ocamllex} -ml -q -o %{target} %{deps}))))

From b1e7202722a460bd41770e8731c09bccd5a7a3e9 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Tue, 21 Apr 2026 10:06:22 +0200
Subject: [PATCH 427/578] Stop using structural comparison in coqdep internals.

OCaml built-in structural comparison is bad for performance, it causes
non-trivial runtime overhead. In rocqdep this was observable for sets
used to cache dependency traversal. We simply flesh out the correct
comparison function instead of relying on the structural one.
---
 tools/coqdep/lib/common.ml | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/tools/coqdep/lib/common.ml b/tools/coqdep/lib/common.ml
index 8a90554fbe76..178873bc92d3 100644
--- a/tools/coqdep/lib/common.ml
+++ b/tools/coqdep/lib/common.ml
@@ -117,7 +117,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)

From 2f477fa4edf8bffd17ce602fcb5b22c71f2d9753 Mon Sep 17 00:00:00 2001
From: Dario Halilovic <dario.halilovic@epfl.ch>
Date: Thu, 23 Apr 2026 19:54:30 +0200
Subject: [PATCH 428/578] Set test_suite_config.inc mode to promote

---
 test-suite/dune | 1 +
 1 file changed, 1 insertion(+)

diff --git a/test-suite/dune b/test-suite/dune
index d6bd66718e93..26f74ac5ecc3 100644
--- a/test-suite/dune
+++ b/test-suite/dune
@@ -9,6 +9,7 @@
 
 (rule
  (targets test_suite_config.inc)
+ (mode (promote (until-clean)))
  (action (with-stdout-to %{targets} (run tools/coq_config_to_make.exe %{bin:coqc}))))
 
 (rule

From bc4c3298b66e89faf3349f9aef7a1ecd9ffc4a80 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Fri, 24 Apr 2026 12:47:13 +0200
Subject: [PATCH 429/578] Optimize the algorithm for unicode validation.

The main change is that we now split the function producing the unicode
point into one computing the UTF8 size and one actually producing the
code point. This allows making the code allocation-free, which is
important for this kind of low-level functions.
---
 clib/unicode.ml | 93 +++++++++++++++++++++++++++++++++++--------------
 1 file changed, 67 insertions(+), 26 deletions(-)

diff --git a/clib/unicode.ml b/clib/unicode.ml
index 6465e399de2d..59ca54c3f4e6 100644
--- a/clib/unicode.ml
+++ b/clib/unicode.ml
@@ -148,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
 
@@ -218,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^"\".")
 
@@ -229,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^"\".")
 
@@ -251,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
@@ -279,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
@@ -322,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

From 899890236ed8d07043f9c2039f700a5c4749b2b7 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Fri, 24 Apr 2026 18:06:46 +0200
Subject: [PATCH 430/578] dune test_suite_config.inc rule use rocq instead of
 coqc

(we only use it for its directory so it doesn't matter which one we use)
---
 test-suite/dune                        |  2 +-
 test-suite/tools/coq_config_to_make.ml | 10 +++++-----
 2 files changed, 6 insertions(+), 6 deletions(-)

diff --git a/test-suite/dune b/test-suite/dune
index 26f74ac5ecc3..eacf93cb714c 100644
--- a/test-suite/dune
+++ b/test-suite/dune
@@ -10,7 +10,7 @@
 (rule
  (targets test_suite_config.inc)
  (mode (promote (until-clean)))
- (action (with-stdout-to %{targets} (run tools/coq_config_to_make.exe %{bin:coqc}))))
+ (action (with-stdout-to %{targets} (run tools/coq_config_to_make.exe %{bin:rocq}))))
 
 (rule
  (targets summary.log)
diff --git a/test-suite/tools/coq_config_to_make.ml b/test-suite/tools/coq_config_to_make.ml
index 65eb83d91cb3..6c2d6c17a687 100644
--- a/test-suite/tools/coq_config_to_make.ml
+++ b/test-suite/tools/coq_config_to_make.ml
@@ -25,7 +25,7 @@ let write_makefile coqprefix coqlibinstall best_compiler ocamlfind caml_flags co
   pr "OCAMLFIND=%S\n" ocamlfind;
   pr "# Caml flags\n";
   pr "CAMLFLAGS=%s %s\n" caml_flags coq_caml_flags;
-  pr "# coqc was said to be '%s'\n" Sys.argv.(1);
+  pr "# rocq was said to be '%s'\n" Sys.argv.(1);
   pr "ARCH=%s\n" Coq_config.arch;
   ()
 
@@ -57,14 +57,14 @@ let find_in_PATH f =
 
 let main () =
   if Array.length Sys.argv < 2 then die "usage: %s ROCQ_EXE [OUT_FILE]" Sys.argv.(0);
-  let coqc = Sys.argv.(1) in
+  let rocq = Sys.argv.(1) in
 
-  let coqc = match find_in_PATH coqc with
+  let rocq = match find_in_PATH rocq with
     | Some f -> f
-    | None -> die "Could not find %s in PATH." coqc
+    | None -> die "Could not find %s in PATH." rocq
   in
 
-  let coqbin = canonical_path_name (Filename.dirname coqc) in
+  let coqbin = canonical_path_name (Filename.dirname rocq) in
   let coqroot = Filename.dirname coqbin in
 
   let relocate = function

From b378d8201041b4dcae993423cdafdb40b53b36a5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Mon, 27 Apr 2026 14:07:02 +0200
Subject: [PATCH 431/578] Fix ci-refman artifact handling

on master _build_ci got moved to saved_build_ci so the path in the
deploy job was incorrect.

Alternatively we could set save_build_ci and change the path in the
deploy job.
---
 .gitlab-ci.yml | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
index a586d26a41ce..4cc9f62f983a 100644
--- a/.gitlab-ci.yml
+++ b/.gitlab-ci.yml
@@ -492,7 +492,7 @@ doc:refman:deploy:
     - 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_ci/refman/refman-html _deploy/$CI_COMMIT_REF_NAME/refman
+    - cp -rv saved_build_ci/refman/refman-html _deploy/$CI_COMMIT_REF_NAME/refman
     - cp -rv _build/default/doc/corelib/html _deploy/$CI_COMMIT_REF_NAME/corelib
     - 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
@@ -1336,6 +1336,7 @@ doc:ci-refman:
   - library:ci-mathcomp
   - library:ci-mczify
   stage: build-3+
+  after_script: [] # disable save build_ci
   artifacts:
     paths:
       - _build_ci/refman/refman-html

From ed0115c17122183fa8602c28ba4d12310e80425e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Fri, 24 Apr 2026 15:20:16 +0200
Subject: [PATCH 432/578] Avoid conflict between global sorts defined in
 separate modules

We add a int uid to QGlobal.t, generated by safe_typing when adding
the sort.

The id is then useless so we remove it.

The APIs change from combined
`Global.push_qualities : QGlobal.Set.t * ElimConstraints.t -> unit`
to separate `Global.new_global_sort : unit -> QGlobal.t` and
`Global.merge_elim_constraints : ElimConstraints.t -> unit`.

Fix #21717
---
 checker/values.ml                             |  2 +-
 .../21957-SkySkimmer-sort-conflict.sh         |  1 +
 engine/univGen.ml                             |  7 ++--
 engine/univGen.mli                            |  1 -
 kernel/safe_typing.ml                         | 36 +++++++++++--------
 kernel/safe_typing.mli                        |  4 ++-
 kernel/sorts.ml                               | 26 +++++++-------
 kernel/sorts.mli                              |  4 +--
 library/global.ml                             |  3 +-
 library/global.mli                            |  3 +-
 test-suite/bugs/bug_21717.v                   | 11 ++++++
 vernac/declareUniv.ml                         | 10 ++----
 12 files changed, 62 insertions(+), 46 deletions(-)
 create mode 100644 dev/ci/user-overlays/21957-SkySkimmer-sort-conflict.sh
 create mode 100644 test-suite/bugs/bug_21717.v

diff --git a/checker/values.ml b/checker/values.ml
index b0c9ed65e9f7..a41559712549 100644
--- a/checker/values.ml
+++ b/checker/values.ml
@@ -185,7 +185,7 @@ 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_int|];[|v_string;v_int|]|]
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/engine/univGen.ml b/engine/univGen.ml
index 58e188f2d479..611d08df7b98 100644
--- a/engine/univGen.ml
+++ b/engine/univGen.ml
@@ -134,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
diff --git a/engine/univGen.mli b/engine/univGen.mli
index c444ebbeaee9..111cbefea5bf 100644
--- a/engine/univGen.mli
+++ b/engine/univGen.mli
@@ -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
 
diff --git a/kernel/safe_typing.ml b/kernel/safe_typing.ml
index 128b6b3fce92..85f8eda665d9 100644
--- a/kernel/safe_typing.ml
+++ b/kernel/safe_typing.ml
@@ -558,24 +558,36 @@ let push_context_set ~strict cst senv =
       univ = Univ.ContextSet.union cst senv.univ;
       sections }
 
-let push_qualities (qs,qcsts) senv =
-  if Sorts.QGlobal.Set.is_empty qs && Sorts.ElimConstraints.is_empty qcsts 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.")
   else
-    let qs' =
-      Sorts.QGlobal.Set.fold (fun q acc -> Sorts.Quality.Set.add (QGlobal q) acc)
-        qs
-        Sorts.Quality.Set.empty
-    in
-    let env = Environ.push_qualities qs' senv.env in
-    let env = Environ.merge_elim_constraints ~rigid:true qcsts env in
+    let env = Environ.merge_elim_constraints ~rigid:true qcsts senv.env in
     { senv with
       env;
-      qualities = Sorts.QGlobal.Set.union qs senv.qualities;
       elims = Sorts.ElimConstraints.union qcsts senv.elims;
     }
 
@@ -1547,10 +1559,6 @@ let univs_of_library lib = lib.comp_sorts, lib.comp_univs
 
 let retroknowledge_of_library lib = lib.comp_retro
 
-(** FIXME: MS: remove?*)
-let current_modpath senv = senv.modpath
-let current_dirpath senv = Names.ModPath.dp (current_modpath senv)
-
 let start_library dir senv =
   (* When starting a library, the current environment should be initial
      i.e. only composed of Require's *)
diff --git a/kernel/safe_typing.mli b/kernel/safe_typing.mli
index e01d0632fad0..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 : Sorts.QGlobal.Set.t * Sorts.ElimConstraints.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 *)
diff --git a/kernel/sorts.ml b/kernel/sorts.ml
index 26bfd37d58fd..86dc8e1f8574 100644
--- a/kernel/sorts.ml
+++ b/kernel/sorts.ml
@@ -15,40 +15,40 @@ 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; id } as v) =
+    let hashcons ({ library; uid } as v) =
       let hl, l' = DirPath.hcons library in
-      let hid, id' =  Id.hcons id in
-      let v = if l' == library && id' == id then v else { library = l'; id = id' } in
-      Hashset.Combine.combine hl hid, v
+      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.id == b.id
+    let eq a b = a.library == b.library && a.uid == b.uid
   end
 
   module Hasher = Hashcons.Make(Hstruct)
diff --git a/kernel/sorts.mli b/kernel/sorts.mli
index 2edf4b21a94f..7b921c40e4a3 100644
--- a/kernel/sorts.mli
+++ b/kernel/sorts.mli
@@ -15,8 +15,8 @@ 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
diff --git a/library/global.ml b/library/global.ml
index f3ac71292679..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 c = globalize0 (Safe_typing.push_qualities 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)
diff --git a/library/global.mli b/library/global.mli
index 519d5d5c22c2..459b6fb8b061 100644
--- a/library/global.mli
+++ b/library/global.mli
@@ -68,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 : Sorts.QGlobal.Set.t * Sorts.ElimConstraints.t -> unit
+val new_global_sort : unit -> Sorts.QGlobal.t
+val merge_elim_constraints : Sorts.ElimConstraints.t -> unit
 
 (** Non-interactive modules and module types *)
 
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/vernac/declareUniv.ml b/vernac/declareUniv.ml
index abae03212427..f06f95f63b5b 100644
--- a/vernac/declareUniv.ml
+++ b/vernac/declareUniv.ml
@@ -216,16 +216,12 @@ let do_universe ~poly l =
 
 let do_sort_mono l =
   let l = List.map (fun {CAst.v=id} ->
-      let q = UnivGen.new_sort_global id in
+      let q = Global.new_global_sort () in
       q, (id, Sorts.Quality.QGlobal q))
       l
   in
   let src = UnqualifiedQuality in
-  let () = input_sort_names (src, List.map snd l) in
-  let qs = List.fold_left  (fun qs (qv, _) -> Sorts.QGlobal.(Set.add qv qs))
-      Sorts.QGlobal.Set.empty l
-  in
-  Global.push_qualities (qs, Sorts.ElimConstraints.empty)
+  input_sort_names (src, List.map snd l)
 
 let do_sort_poly l =
   let in_section = Lib.sections_are_opened () in
@@ -275,7 +271,7 @@ let do_constraint ~poly l =
   match poly with
   | false ->
     let qcst, ucst = constraints in
-    let () = Global.push_qualities (Sorts.QGlobal.Set.empty, qcst) in
+    let () = Global.merge_elim_constraints qcst in
     Global.push_context_set (Univ.Level.Set.empty, ucst)
   | true ->
     let uctx = UVars.UContext.make

From e7cf080270188f451a826457bae0ad37bfdbe52d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Sat, 11 Apr 2026 17:35:24 +0200
Subject: [PATCH 433/578] push_subgraph avoid looking at irrelevant parts of
 the graph

We only need the constraints between the preexisting universes which
are mentioned by new constraints (including implicit Set >= new univ
constraints).

Close #17523 (tested on the artificial example)
---
 kernel/environ.ml | 49 +++++++++++++++++++++++++++++++++++++++++++----
 1 file changed, 45 insertions(+), 4 deletions(-)

diff --git a/kernel/environ.ml b/kernel/environ.ml
index b50ffbecf8fc..54d4ded25492 100644
--- a/kernel/environ.ml
+++ b/kernel/environ.ml
@@ -556,18 +556,59 @@ let merge_elim_constraints ~rigid qcsts env =
   in
   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;

From 7a06dbbce9cadf4f5193978bb345b933c6cd2b01 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Tue, 21 Apr 2026 17:19:37 +0200
Subject: [PATCH 434/578] Some Makefile targets integrate with make jobserver

Using a shell script to greedily consume jobserver tokens.

In principle we could also use it for dune build and remake calls in CI jobs.
---
 Makefile               | 10 +++---
 dev/tools/with-jobs.sh | 77 ++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 83 insertions(+), 4 deletions(-)
 create mode 100755 dev/tools/with-jobs.sh

diff --git a/Makefile b/Makefile
index f6ab5e85341f..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
@@ -183,11 +186,10 @@ WITHPYPATH:=PYTHONPATH=_build/default/config:doc/tools:$$PYTHONPATH
 
 refman-html: world doc/unreleased.rst
 	rm -rf doc/refman-html
-	$(WITHPYPATH) dune exec -- sphinx-build -q -W -b html doc/sphinx 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) dune exec -- sphinx-build -q -W -b latex doc/sphinx 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
diff --git a/dev/tools/with-jobs.sh b/dev/tools/with-jobs.sh
new file mode 100755
index 000000000000..bd18b9fff7b7
--- /dev/null
+++ b/dev/tools/with-jobs.sh
@@ -0,0 +1,77 @@
+#!/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
+    exec "$@" -j "$(nproc)"
+  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

From 3a26bca1391e1fd7933fb6310354676f6ff77ad3 Mon Sep 17 00:00:00 2001
From: Will Thomas <52861844+Durbatuluk1701@users.noreply.github.com>
Date: Sun, 26 Apr 2026 08:03:35 +0200
Subject: [PATCH 435/578] Add note to Ltac2 docs for sequence and dispatching

---
 doc/sphinx/proof-engine/ltac2.rst | 10 ++++++++++
 1 file changed, 10 insertions(+)

diff --git a/doc/sphinx/proof-engine/ltac2.rst b/doc/sphinx/proof-engine/ltac2.rst
index e5a5dae3406e..a60a6fac998a 100644
--- a/doc/sphinx/proof-engine/ltac2.rst
+++ b/doc/sphinx/proof-engine/ltac2.rst
@@ -2058,6 +2058,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:

From 84f874a0bef23175d911e8358a6ed96097a47572 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Sun, 26 Apr 2026 22:16:09 +0200
Subject: [PATCH 436/578] Minor cleanup in rocqdep internal data structures.

Some of the data stored was never used.
---
 tools/coqdep/lib/common.ml | 15 +++++++--------
 1 file changed, 7 insertions(+), 8 deletions(-)

diff --git a/tools/coqdep/lib/common.ml b/tools/coqdep/lib/common.ml
index eb74a9534d44..a2bba44d8ae2 100644
--- a/tools/coqdep/lib/common.ml
+++ b/tools/coqdep/lib/common.ml
@@ -12,12 +12,11 @@
     - first string is the full filename, with only its extension removed
     - second string is the absolute version of the previous (via getcwd)
 *)
-type vAccu = { acc : (string * string) list; map : string list CString.Map.t }
+type vAccu = { acc : string list; map : string CString.Map.t }
 
 let add_vAccu (f, f') vAccu =
-  let acc = (f, f') :: vAccu.acc in
-  let old = try CString.Map.find f' vAccu.map with Not_found -> [] in
-  let map = CString.Map.add f' (f :: old) vAccu.map in
+  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 }
@@ -39,8 +38,8 @@ let canonize ~separator_hack vAccu f =
       (Filename.basename f)
   in
   match CString.Map.find_opt f' vAccu.map with
-  | None | Some [] -> f
-  | Some (f :: _) -> f
+  | None -> f
+  | Some f -> f
 
 type what = Library | External
 let str_of_what = function Library -> "library" | External -> "external file"
@@ -299,7 +298,7 @@ let find_dependencies st basename =
     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
+  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 =
@@ -369,7 +368,7 @@ let sort {State.vAccu; separator_hack; loadpath} =
         Format.printf "%s.v " file
     end
   in
-  List.iter (fun (name, _) -> loop (Loadpath.Filename.make name)) vAccu.acc
+  List.iter (fun name -> loop (Loadpath.Filename.make name)) vAccu.acc
 
 let add_include st (rc, r, ln) =
   if rc then

From 1ba814e3ae41cdc5fa8d327dd2c7a7d61c824ad5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Mon, 27 Apr 2026 17:36:20 +0200
Subject: [PATCH 437/578] Purify the internals of Loadpath.add_directory.

This function was using spaghetti mutable code to simply carry along some
well-scoped data. The new code is still not perfect and in particular, not
efficient, but at least it is more readable. Up to involutary bugs, this
commit should be semantic-preserving.
---
 tools/coqdep/lib/loadpath.ml | 42 ++++++++++++++++--------------------
 1 file changed, 18 insertions(+), 24 deletions(-)

diff --git a/tools/coqdep/lib/loadpath.ml b/tools/coqdep/lib/loadpath.ml
index 651b619a5def..8dca3438e4e0 100644
--- a/tools/coqdep/lib/loadpath.ml
+++ b/tools/coqdep/lib/loadpath.ml
@@ -77,34 +77,28 @@ let register_dir_logpath, find_dir_logpath =
 
 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 [] in
+      let f = function
+      | System.FileDir (phys_f,f) ->
+        if recur then
+          let (ncurdirfiles, nsubdirfiles) = aux phys_f (log_dir @ [f]) in
+          subdirfiles := !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
+      ([], [])
   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
+  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
 
 (** [get_extension f l] checks whether [f] has one of the extensions
     listed in [l]. It returns [f] without its extension, alongside with

From 64ea87c58afd68df3030475924f3f3dddb491f2b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Mon, 27 Apr 2026 18:28:32 +0200
Subject: [PATCH 438/578] Clean up internals of rocqdep around warn_if_clash.

We avoid useless translations of data structures.
---
 tools/coqdep/lib/common.ml | 26 +++++++++++++-------------
 1 file changed, 13 insertions(+), 13 deletions(-)

diff --git a/tools/coqdep/lib/common.ml b/tools/coqdep/lib/common.ml
index a2bba44d8ae2..5dad3252a430 100644
--- a/tools/coqdep/lib/common.ml
+++ b/tools/coqdep/lib/common.ml
@@ -55,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"
@@ -91,24 +95,20 @@ let safe_assoc ?(warn_clashes=true) st ?(what=Library) from file k =
   match search ?from k with
   | None -> None
   | Some (Loadpath.ExactMatches fs) ->
-    let f = Loadpath.Filename.repr 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 f = fs.Loadpath.point 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 [fs.Loadpath.point]
+    Some [f]
   | Some (Loadpath.PartialMatchesInSameRoot (root, l)) ->
     let l = Loadpath.FileSet.elements l.files in
     let sort f1 f2 = String.compare (Loadpath.Filename.repr f1) (Loadpath.Filename.repr f2) in
-    (match List.sort sort l with [] -> assert false | f :: l as all ->
+    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 *)
-    let () = if warn_clashes then
-      let f = Loadpath.Filename.repr f in
-      let l = List.map Loadpath.Filename.repr l in
-      warn_if_clash ~what false file k f l
-    in
-    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

From 0b934b6b3e6279741f0c5b110160e84c6606a9a4 Mon Sep 17 00:00:00 2001
From: Enrico Tassi <Enrico.Tassi@Inria.fr>
Date: Thu, 16 Apr 2026 20:45:16 +0200
Subject: [PATCH 439/578] ci: use Elpi 3.7.0

---
 .gitlab-ci.yml                                    | 2 +-
 dev/ci/docker/edge_ubuntu/Dockerfile              | 2 +-
 dev/ci/user-overlays/21924-gares-bump-elpi-3.7.sh | 4 ++++
 3 files changed, 6 insertions(+), 2 deletions(-)
 create mode 100644 dev/ci/user-overlays/21924-gares-bump-elpi-3.7.sh

diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
index 542c27b9d6f6..ba6d7829d07d 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-V2026-03-19-ac6c1c9705"
+  EDGE_CACHEKEY: "edge_ubuntu-V2026-04-25-40c2707b7f"
   BASE_IMAGE: "$CI_REGISTRY_IMAGE:$BASE_CACHEKEY"
   EDGE_IMAGE: "$CI_REGISTRY_IMAGE:$EDGE_CACHEKEY"
 
diff --git a/dev/ci/docker/edge_ubuntu/Dockerfile b/dev/ci/docker/edge_ubuntu/Dockerfile
index 35c17d233dc3..6f80dc011513 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.6.2 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="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/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

From f43cf8f08c5d1a522b359084fa4a8e1106b45250 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Tue, 28 Apr 2026 12:55:53 +0200
Subject: [PATCH 440/578] Fix ci-refman artifact handling (for real this time?)

The previous attempt changed both the copied path and the saved path
so they continued to disagree. This commit only changes 1 of them so
now they should agree.
---
 .gitlab-ci.yml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
index 4cc9f62f983a..24dfb36ab8f6 100644
--- a/.gitlab-ci.yml
+++ b/.gitlab-ci.yml
@@ -492,7 +492,7 @@ doc:refman:deploy:
     - 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 saved_build_ci/refman/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
     - 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

From c6d2a48f1ceb2fb1c1423903a757f72bd7bd1122 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Wed, 1 Apr 2026 14:29:06 +0200
Subject: [PATCH 441/578] Warning for missing "Proof" command and error on
 duplicate or late "Proof"

---
 .../21865-warn-missing-proof-Added.rst        |  4 +
 doc/sphinx/addendum/generalized-rewriting.rst |  2 +
 doc/sphinx/addendum/ring.rst                  |  6 ++
 doc/sphinx/addendum/universe-polymorphism.rst |  1 +
 doc/sphinx/language/core/conversion.rst       |  2 +
 doc/sphinx/language/core/inductive.rst        |  2 +
 doc/sphinx/language/core/modules.rst          |  2 +
 doc/sphinx/language/core/records.rst          |  1 +
 doc/sphinx/language/extensions/canonical.rst  |  9 +-
 doc/sphinx/language/extensions/evars.rst      |  3 +
 doc/sphinx/proof-engine/ltac.rst              | 24 +++++
 doc/sphinx/proof-engine/ltac2.rst             |  7 ++
 .../proof-engine/ssreflect-proof-language.rst | 98 ++++++++++++++++++-
 doc/sphinx/proof-engine/tactics.rst           | 35 ++++++-
 doc/sphinx/proofs/automatic-tactics/auto.rst  | 17 +++-
 doc/sphinx/proofs/automatic-tactics/logic.rst | 12 ++-
 doc/sphinx/proofs/writing-proofs/equality.rst |  8 ++
 .../proofs/writing-proofs/proof-mode.rst      | 31 +++++-
 .../writing-proofs/reasoning-inductives.rst   | 32 +++++-
 doc/sphinx/using/libraries/funind.rst         |  3 +
 doc/tools/rocqrst/rocqdomain.py               |  1 +
 test-suite/ide/reopen1.fake                   |  2 +-
 test-suite/output-coqtop/BracketLoc.out       |  7 +-
 test-suite/output-coqtop/BracketLoc.v         |  3 +-
 test-suite/output-coqtop/bug_16462.out        |  1 +
 test-suite/output-coqtop/bug_16462.v          |  1 +
 .../output-coqtop/diffs_in_show_cmd.out       |  1 +
 test-suite/output-coqtop/diffs_in_show_cmd.v  |  1 +
 test-suite/output/Arguments_renaming.out      | 22 ++---
 test-suite/output/Arguments_renaming.v        |  1 +
 test-suite/output/CantApplyBadType.out        |  2 +-
 test-suite/output/CantApplyBadType.v          |  1 +
 test-suite/output/Cases.out                   | 30 +++---
 test-suite/output/Cases.v                     |  5 +
 test-suite/output/DebugRelevances.v           |  1 +
 test-suite/output/Deprecation.out             | 12 +--
 test-suite/output/Deprecation.v               |  4 +
 test-suite/output/ErrorLocation_12152.out     |  4 +-
 test-suite/output/ErrorLocation_12152.v       |  1 +
 test-suite/output/ErrorLocation_12255.out     |  2 +-
 test-suite/output/ErrorLocation_12255.v       |  1 +
 test-suite/output/ErrorLocation_12774.out     |  6 +-
 test-suite/output/ErrorLocation_12774.v       |  1 +
 test-suite/output/ErrorLocation_13241.out     |  4 +-
 test-suite/output/ErrorLocation_13241.v       |  2 +
 test-suite/output/ErrorLocation_ltac.out      |  8 +-
 test-suite/output/ErrorLocation_ltac.v        |  1 +
 .../output/ErrorLocation_tac_in_term.out      |  4 +-
 test-suite/output/ErrorLocation_tac_in_term.v |  1 +
 test-suite/output/Errors.out                  | 16 +--
 test-suite/output/Errors.v                    |  4 +
 test-suite/output/Existentials.v              |  1 +
 test-suite/output/InvalidDisjunctiveIntro.out | 14 +--
 test-suite/output/InvalidDisjunctiveIntro.v   |  1 +
 test-suite/output/Match_subterm.v             |  1 +
 test-suite/output/MissingProof.out            | 30 ++++++
 test-suite/output/MissingProof.v              | 26 +++++
 test-suite/output/Naming.out                  | 10 +-
 test-suite/output/Naming.v                    |  3 +
 test-suite/output/PrintInfos.out              |  6 +-
 test-suite/output/PrintInfos.v                |  2 +
 test-suite/output/Search.out                  |  6 +-
 test-suite/output/Search.v                    |  2 +
 test-suite/output/SearchPattern.v             |  2 +
 test-suite/output/SearchRewrite.v             |  1 +
 test-suite/output/Search_bug17963.v           |  1 +
 test-suite/output/Search_headconcl.v          |  2 +
 test-suite/output/ShowUnivs.v                 |  1 +
 test-suite/output/Tactics.out                 |  4 +-
 test-suite/output/Tactics.v                   |  3 +
 test-suite/output/TypeclassDebug.out          |  2 +-
 test-suite/output/TypeclassDebug.v            |  1 +
 test-suite/output/UnivBinders.out             |  8 +-
 test-suite/output/UnivBinders.v               |  1 +
 test-suite/output/UnivNotations.v             |  2 +
 test-suite/output/apply_with.out              | 12 +--
 test-suite/output/apply_with.v                |  2 +
 test-suite/output/auto.v                      |  2 +
 test-suite/output/auto_order.out              |  2 +-
 test-suite/output/auto_order.v                |  1 +
 test-suite/output/bug5778.out                 |  2 +-
 test-suite/output/bug5778.v                   |  1 +
 test-suite/output/bug6404.out                 |  2 +-
 test-suite/output/bug6404.v                   |  1 +
 test-suite/output/bug_11608.out               |  6 ++
 test-suite/output/bug_13857.out               |  6 +-
 test-suite/output/bug_13857.v                 |  1 +
 test-suite/output/bug_14899.v                 |  1 +
 test-suite/output/bug_15106.v                 |  5 +-
 test-suite/output/bug_17372.out               |  2 +-
 test-suite/output/bug_17372.v                 |  1 +
 test-suite/output/bug_17386.v                 |  1 +
 test-suite/output/bug_17594.out               | 16 +--
 test-suite/output/bug_17594.v                 |  1 +
 test-suite/output/bug_18368.v                 |  1 +
 test-suite/output/bug_19138.v                 |  2 +
 test-suite/output/bug_21288.out               |  2 +-
 test-suite/output/bug_21288.v                 |  1 +
 test-suite/output/bug_3810.v                  |  1 +
 test-suite/output/idtac.v                     | 17 +++-
 test-suite/output/injection.out               |  4 +-
 test-suite/output/injection.v                 |  1 +
 test-suite/output/ltac.out                    | 14 +--
 test-suite/output/ltac.v                      | 10 +-
 test-suite/output/ltac2_bt.v                  |  1 +
 test-suite/output/ltac_missing_args.out       | 20 ++--
 test-suite/output/ltac_missing_args.v         |  1 +
 test-suite/output/names.v                     |  1 +
 test-suite/output/optimize_heap.v             |  1 +
 test-suite/output/print_hintdb_metas.v        |  1 +
 test-suite/output/rewrite_in_err.out          |  2 +-
 test-suite/output/rewrite_in_err.v            |  1 +
 test-suite/output/set.v                       |  1 +
 test-suite/output/sort_poly_elab.out          | 96 +++++++++---------
 test-suite/output/sort_poly_elab.v            |  2 +
 .../ssr_error_multiple_intro_after_case.out   |  2 +-
 .../ssr_error_multiple_intro_after_case.v     |  1 +
 test-suite/output/ssr_explain_match.out       |  2 +-
 test-suite/output/ssr_explain_match.v         |  1 +
 test-suite/output/ssr_under.v                 |  1 +
 test-suite/output/subst.v                     |  4 +
 test-suite/output/unidecls.out                |  8 +-
 test-suite/output/unidecls.v                  |  5 +-
 test-suite/output/unifconstraints.out         |  4 +-
 test-suite/output/unifconstraints.v           |  3 +
 test-suite/output/unification.v               |  4 +
 theories/Corelib/Floats/FloatAxioms.v         |  9 +-
 theories/Corelib/Init/Logic.v                 |  3 +
 theories/Corelib/Init/Wf.v                    |  3 +-
 theories/Corelib/ssr/ssrbool.v                |  3 +-
 vernac/declare.ml                             | 11 +++
 vernac/declare.mli                            |  7 ++
 vernac/vernacentries.ml                       | 17 +++-
 vernac/vernacinterp.ml                        |  2 +-
 vernac/vernactypes.ml                         | 50 +++++++---
 vernac/vernactypes.mli                        | 10 +-
 136 files changed, 735 insertions(+), 239 deletions(-)
 create mode 100644 doc/changelog/08-vernac-commands-and-options/21865-warn-missing-proof-Added.rst
 create mode 100644 test-suite/output/MissingProof.out
 create mode 100644 test-suite/output/MissingProof.v

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 <https://github.com/rocq-prover/rocq/pull/21865>`_,
+  by Gaëtan Gilbert).
diff --git a/doc/sphinx/addendum/generalized-rewriting.rst b/doc/sphinx/addendum/generalized-rewriting.rst
index 0c6366c5dd7d..d89d5866ecaa 100644
--- a/doc/sphinx/addendum/generalized-rewriting.rst
+++ b/doc/sphinx/addendum/generalized-rewriting.rst
@@ -1235,12 +1235,14 @@ subterm selection choices.
       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/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/universe-polymorphism.rst b/doc/sphinx/addendum/universe-polymorphism.rst
index 0d14c1259ee1..671955f64fa5 100644
--- a/doc/sphinx/addendum/universe-polymorphism.rst
+++ b/doc/sphinx/addendum/universe-polymorphism.rst
@@ -838,6 +838,7 @@ witness these temporary variables.
 .. rocqtop:: in
 
    Goal True.
+   Proof.
    Set Printing Universes.
 
 .. rocqtop:: all abort
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/inductive.rst b/doc/sphinx/language/core/inductive.rst
index 393e5dc3b8a5..665e630eee9d 100644
--- a/doc/sphinx/language/core/inductive.rst
+++ b/doc/sphinx/language/core/inductive.rst
@@ -560,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
@@ -569,6 +570,7 @@ constructions.
       .. rocqtop:: all
 
          Goal forall n:nat, n + 0 = 0 + n.
+         Proof.
          intros; simpl.  (* n + 0 not reducible *)
 
       .. rocqtop:: none
diff --git a/doc/sphinx/language/core/modules.rst b/doc/sphinx/language/core/modules.rst
index 6af63eb29f3a..4f494559530f 100644
--- a/doc/sphinx/language/core/modules.rst
+++ b/doc/sphinx/language/core/modules.rst
@@ -405,6 +405,7 @@ Examples
     .. rocqtop:: all
 
        Definition y : bool.
+       Proof.
        exact true.
 
     .. rocqtop:: in
@@ -452,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.
diff --git a/doc/sphinx/language/core/records.rst b/doc/sphinx/language/core/records.rst
index 2c8978ba0370..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 *)
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/proof-engine/ltac.rst b/doc/sphinx/proof-engine/ltac.rst
index 311c4304bfdb..f88e0ad5775f 100644
--- a/doc/sphinx/proof-engine/ltac.rst
+++ b/doc/sphinx/proof-engine/ltac.rst
@@ -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
@@ -1710,6 +1727,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 +1745,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 +1782,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 +1869,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 +2109,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 +2120,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 +2401,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 a60a6fac998a..0fc9a6cfa6df 100644
--- a/doc/sphinx/proof-engine/ltac2.rst
+++ b/doc/sphinx/proof-engine/ltac2.rst
@@ -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
 
@@ -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 : _ |- _ ] =>
@@ -1316,6 +1321,7 @@ Notations
       .. rocqtop:: none
 
          Goal True.
+         Proof.
 
       .. rocqtop:: all
 
@@ -2028,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.
diff --git a/doc/sphinx/proof-engine/ssreflect-proof-language.rst b/doc/sphinx/proof-engine/ssreflect-proof-language.rst
index 96bc91695e7c..de877918ebc1 100644
--- a/doc/sphinx/proof-engine/ssreflect-proof-language.rst
+++ b/doc/sphinx/proof-engine/ssreflect-proof-language.rst
@@ -459,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
@@ -575,6 +576,7 @@ where:
    .. rocqtop:: all
 
       Lemma test x :  f x + f x = f x.
+      Proof.
       set t := f _.
 
    .. rocqtop:: all restart
@@ -622,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
@@ -643,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
@@ -664,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
@@ -684,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
@@ -718,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
@@ -740,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}``.
@@ -761,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).
 
 
@@ -791,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
@@ -808,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}(_ + _).
 
 
@@ -836,6 +847,7 @@ context of a goal thanks to the ``in`` tactical.
      .. rocqtop:: all
 
         Lemma test x t (Hx : x = 3) : x + t = 4.
+        Proof.
         set z := 3 in Hx.
 
 .. tacv:: set @ident := @term in {+ @ident} *
@@ -852,6 +864,7 @@ context of a goal thanks to the ``in`` tactical.
      .. 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).
@@ -971,6 +984,7 @@ constants to the goal.
    .. rocqtop:: all
 
       Lemma subnK : forall m n, n <= m -> m - n + n = m.
+      Proof.
 
    might start with
 
@@ -1032,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].
 
@@ -1121,6 +1136,7 @@ The move tactic.
 
          From Corelib Require Import ssreflect_rw.
          Goal not False.
+         Proof.
          move.
 
    More precisely, the :tacn:`move <move (ssreflect)>` tactic inspects the goal and does nothing
@@ -1197,6 +1213,7 @@ The elim tactic
       .. rocqtop:: all
 
          Lemma test m : forall n : nat, m <= n.
+         Proof.
          elim.
 
 
@@ -1238,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.
@@ -1419,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
@@ -1711,6 +1730,7 @@ Clears are deferred until the end of the intro pattern.
       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
@@ -1825,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
@@ -1844,6 +1865,7 @@ under fresh |SSR| names.
    .. rocqtop:: all
 
       Lemma test (a b :nat) : a <> b.
+      Proof.
       case E : a => H.
       Show 2.
 
@@ -1929,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``.
@@ -1936,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)``
@@ -1965,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.
 
@@ -2218,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.
 
 
@@ -2333,6 +2359,7 @@ between standard Ltac ``in`` and the |SSR| tactical in.
      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
@@ -2406,6 +2433,7 @@ the holes are abstracted in term.
   .. rocqtop:: all
 
      Lemma test : True.
+     Proof.
      have: _ * 0 = 0.
 
   The invocation of ``have`` is equivalent to:
@@ -2417,6 +2445,7 @@ the holes are abstracted in term.
      Unset Strict Implicit.
      Unset Printing Implicit Defensive.
      Lemma test : True.
+     Proof.
 
   .. rocqtop:: all
 
@@ -2435,6 +2464,7 @@ tactic:
      Unset Strict Implicit.
      Unset Printing Implicit Defensive.
      Lemma test : True.
+     Proof.
 
   .. rocqtop:: all
 
@@ -2491,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.
@@ -2519,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
@@ -2546,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
@@ -2573,6 +2606,7 @@ The following example requires the mathcomp and mczify libraries.
   .. 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
@@ -2626,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
@@ -2638,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
@@ -2651,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.
 
@@ -2670,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
@@ -2690,6 +2728,7 @@ typeclass inference.
      Axiom t : ty.
 
      Goal True.
+     Proof.
 
   .. rocqtop:: all
 
@@ -2769,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
@@ -2844,6 +2884,7 @@ The following example requires the mathcomp library.
 
      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.
 
@@ -2878,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.
 
 
@@ -2924,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
@@ -2941,6 +2984,7 @@ illustrated in the following example.
      Variable x : nat.
      Definition addx z := z + x.
      Lemma test : x <= addx x.
+     Proof.
 
   .. rocqtop:: all
 
@@ -3075,6 +3119,7 @@ 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.
+        Proof.
         rw [ddouble _]/double.
 
   .. warning::
@@ -3086,6 +3131,7 @@ 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
 
@@ -3196,10 +3242,12 @@ 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).
+     Proof.
      by elim: m p => [ | m Hrec] p; rw ?addSnnS -?addnS.
      Qed.
 
      Lemma addnC n m : m + n = n + m.
+     Proof.
      by rw -{1}[n]addn0 addnCA addn0.
      Qed.
 
@@ -3228,6 +3276,7 @@ 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.
+     Proof.
      rw [y + _]H.
 
 Note that if this first pattern matching is not compatible with the
@@ -3248,6 +3297,7 @@ the equality.
   .. rocqtop:: all
 
      Lemma test (H : forall t u, t + u * 0 = t) x y : x + y * 4 + 2 * 0 = x + 2 * 0.
+     Proof.
      Fail rw [x + _]H.
 
   Indeed, the left-hand side of ``H`` does not match
@@ -3271,6 +3321,7 @@ Occurrence switches and redex switches
   .. rocqtop:: all
 
      Lemma test x y : x + y + 0 = x + y + y + 0 + 0 + (x + y + 0).
+     Proof.
      rw {2}[_ + y + 0](_: forall z, z + 0 = z).
 
 The second subgoal is generated by the use of an anonymous lemma in
@@ -3300,6 +3351,7 @@ repetition.
   .. rocqtop:: all
 
      Lemma test x y (z : nat) : x + 1 = x + y + 1.
+     Proof.
      rw 2!(_ : _ + 1 = z).
 
 This last tactic generates *three* subgoals because
@@ -3336,6 +3388,7 @@ rewrite operations prescribed by the rules on the current goal.
      Hypothesis eqac : a = c.
 
      Lemma test : a = a.
+     Proof.
      rw (eqab, eqac).
 
   Indeed, rule ``eqab`` is the first to apply among the ones
@@ -3366,6 +3419,7 @@ literal matches have priority.
       Definition multi2 := (eqab, eqd0).
 
       Lemma test : d = b.
+      Proof.
       rw multi2.
 
    Indeed, rule ``eqd0`` applies without unfolding the
@@ -3384,6 +3438,7 @@ repeated anew.
      Definition multi3 := (eq_adda_b, eq_adda_c, eqb0).
 
      Lemma test : 1 + a = 12 + a.
+     Proof.
      rw 2!multi3.
 
   It uses ``eq_adda_b`` then ``eqb0`` on the left-hand
@@ -3466,6 +3521,7 @@ Anyway this tactic is *not* equivalent to
   .. rocqtop:: all
 
      Lemma test y z : y * 0 + y * (z * 0) = 0.
+     Proof.
      rw (_ : _ * 0 = 0).
 
   while the other tactic results in
@@ -3520,6 +3576,7 @@ 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.
 
@@ -3585,6 +3642,7 @@ 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.
+     Proof.
      rw insubT.
 
   Since the argument corresponding to ``Px`` is not supplied by the user, the
@@ -3597,6 +3655,7 @@ corresponding new goals will be generated.
   .. rocqtop:: all abort
 
      Lemma test (x : 'I_2) y (H : y < 2) : Some x = insub 2 y.
+     Proof.
      rw insubT.
 
 
@@ -3640,6 +3699,7 @@ 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``:
 
@@ -3663,6 +3723,7 @@ complete terms, as shown by the simple example below.
    .. rocqtop:: all abort
 
       Lemma example_map l : sumlist (map (fun m => m - m) l) = 0.
+      Proof.
       under eq_map => m do rw subnn.
 
 
@@ -3700,6 +3761,7 @@ 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.
         rw subnn.
         over.
@@ -3876,6 +3938,7 @@ 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
           [ rw (muln1 j) | rw (addnC i j) ].
@@ -3936,6 +3999,7 @@ selective rewriting, blocking on the fly the reduction in the term ``t``.
        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.
+     Proof.
      rw {2}[cons]lock /= -lock.
 
 It is sometimes desirable to globally prevent a definition from being
@@ -3957,6 +4021,7 @@ definition.
       Definition lid := locked (fun x : nat => x).
 
       Lemma test : lid 3 = 3.
+      Proof.
       rw /=.
       unlock lid.
 
@@ -4067,10 +4132,12 @@ which the function is supplied:
       .. 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
@@ -4098,6 +4165,7 @@ which the function is supplied:
          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``
@@ -4116,6 +4184,7 @@ which the function is supplied:
       .. rocqtop:: all
 
          Lemma test n m (Hnm : m <= n) : S m + (S n - S m) = S n.
+         Proof.
          congr S; rw -/plus.
 
       The tactic ``rw -/plus`` folds back the expansion of ``plus``,
@@ -4136,6 +4205,7 @@ which the function is supplied:
       .. rocqtop:: all
 
          Lemma test x y : x + (y * (y + x - x)) = x * 1 + (y + 0) * y.
+         Proof.
          congr ( _ + (_ * _)).
 
 .. _contextual_patterns_ssr:
@@ -4315,6 +4385,7 @@ parentheses are required around more complex patterns.
   .. rocqtop:: all
 
      Lemma test a b : a + b + 1 = b + (a + 1).
+     Proof.
      set t := (X in _ = X).
      rw {}/t.
      set t := (a + _ in X in _ = X).
@@ -4360,6 +4431,7 @@ 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.
+     Proof.
      rw [in f _ _]addSn.
 
   Note: the simplification rule ``addSn`` is applied only under the ``f``
@@ -4537,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.
 
 
@@ -4596,6 +4669,7 @@ 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.
 
   .. rocqtop:: all
@@ -4608,6 +4682,7 @@ Here is an example of a regular, but nontrivial, eliminator.
      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.
@@ -4639,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
 
@@ -4671,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
 
@@ -4764,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
@@ -4783,6 +4861,7 @@ disjunction.
      Hypothesis P2Q : forall a b, P (a || b) -> Q a.
 
      Lemma test a : P (a || a) -> True.
+     Proof.
 
   .. rocqtop:: all
 
@@ -4820,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:
@@ -4853,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.
@@ -4893,6 +4974,7 @@ assumption to some given arguments.
   .. rocqtop:: all
 
      Lemma test z : (forall x y, x + y = z -> z = x) -> z = 0.
+     Proof.
      move/(_ 0 z).
 
 
@@ -4927,6 +5009,7 @@ bookkeeping steps.
      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
@@ -4998,6 +5081,7 @@ analysis
      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
@@ -5089,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).
 
@@ -5130,6 +5211,7 @@ The view mechanism is compatible with reflect predicates.
      From Corelib Require Import ssrbool.
 
      Lemma test (a b : bool) (Ha : a) (Hb : b) : a /\ b.
+     Proof.
      apply/andP.
 
   Conversely
@@ -5137,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,
@@ -5253,6 +5336,7 @@ but they also allow complex transformation, involving negations.
   .. rocqtop:: all
 
      Lemma test (a b : bool) (Ha : a) (Hb : b) : ~~ (a && b).
+     Proof.
      apply/andP.
 
   In fact, this last script does not
@@ -5283,6 +5367,7 @@ actually uses its propositional interpretation.
      From Corelib Require Import ssrbool.
 
      Lemma test (a b : bool) (pab : b && a) : b.
+     Proof.
      have /andP [pa ->] : (a && b) by rw andbC.
 
 Interpreting goals
@@ -5347,6 +5432,7 @@ In this context, the identity view can be used when no view has to be applied:
      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
@@ -5364,6 +5450,7 @@ In this context, the identity view can be used when no view has to be applied:
      From Corelib Require Import ssrbool.
 
      Lemma test (b1 b2 b3 : bool) : ~~ (b1 || b2) = b3.
+     Proof.
      apply/norP/idP.
 
 
@@ -5446,6 +5533,7 @@ pass a given hypothesis to a lemma.
      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
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/proofs/automatic-tactics/auto.rst b/doc/sphinx/proofs/automatic-tactics/auto.rst
index 4d57b51e0432..7d20a3988dcc 100644
--- a/doc/sphinx/proofs/automatic-tactics/auto.rst
+++ b/doc/sphinx/proofs/automatic-tactics/auto.rst
@@ -118,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)." *)
 
@@ -171,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.
@@ -273,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
@@ -304,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
 
@@ -320,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
 
@@ -656,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.
@@ -664,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 *)
@@ -684,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" *)
@@ -692,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.
@@ -718,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
 
@@ -787,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 } }
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 a91d26c81fe1..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.
@@ -782,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):
@@ -813,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).
 
@@ -1130,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.
 
@@ -1174,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.
 
@@ -1187,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.
 
@@ -1204,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 c80b808c019b..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
@@ -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 *)
 
@@ -1064,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 37e8d183ae78..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
 
@@ -1663,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
@@ -1704,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.
 
@@ -1739,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
 
@@ -1772,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
 
@@ -1804,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/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/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/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/output-coqtop/BracketLoc.out b/test-suite/output-coqtop/BracketLoc.out
index 89345bc2e5b6..5919ad77dff5 100644
--- a/test-suite/output-coqtop/BracketLoc.out
+++ b/test-suite/output-coqtop/BracketLoc.out
@@ -4,9 +4,10 @@ Rocq < 1 goal
   ============================
   True
 
-Toplevel input, characters 11-12:
-> Goal True. }
->            ^
+Unnamed_thm < 
+Toplevel input, characters 7-8:
+> Proof. }
+>        ^
 Error: The proof is not focused
 
 Unnamed_thm < Toplevel input, characters 2-3:
diff --git a/test-suite/output-coqtop/BracketLoc.v b/test-suite/output-coqtop/BracketLoc.v
index 9a5c142649b8..648f9fadf474 100644
--- a/test-suite/output-coqtop/BracketLoc.v
+++ b/test-suite/output-coqtop/BracketLoc.v
@@ -1,4 +1,5 @@
-Goal True. }
+Goal True.
+Proof. }
   }  
   }
   exact 0.
diff --git a/test-suite/output-coqtop/bug_16462.out b/test-suite/output-coqtop/bug_16462.out
index 57ed0d4eb48b..c8f837bfa0be 100644
--- a/test-suite/output-coqtop/bug_16462.out
+++ b/test-suite/output-coqtop/bug_16462.out
@@ -11,6 +11,7 @@ Rocq < 1 goal
   ============================
   True
 
+Unnamed_thm < 
 Unnamed_thm < Unnamed_thm_subproof
 Unnamed_thm_subproof
 Toplevel input, characters 2-7:
diff --git a/test-suite/output-coqtop/bug_16462.v b/test-suite/output-coqtop/bug_16462.v
index 2f1ba4054f90..c97ff6709695 100644
--- a/test-suite/output-coqtop/bug_16462.v
+++ b/test-suite/output-coqtop/bug_16462.v
@@ -9,4 +9,5 @@ Ltac baz x := let H := fresh in
                 f F () () ].
 Set Ltac Backtrace.
 Goal True.
+Proof.
   baz I.
diff --git a/test-suite/output-coqtop/diffs_in_show_cmd.out b/test-suite/output-coqtop/diffs_in_show_cmd.out
index a1d6a61b567b..e43da8b9f417 100644
--- a/test-suite/output-coqtop/diffs_in_show_cmd.out
+++ b/test-suite/output-coqtop/diffs_in_show_cmd.out
@@ -4,6 +4,7 @@ Rocq < Rocq < 1 goal
   ============================
   forall n m : nat, n = m
 
+Unnamed_thm < 
 Unnamed_thm < 1 goal (?foo)
   
   ============================
diff --git a/test-suite/output-coqtop/diffs_in_show_cmd.v b/test-suite/output-coqtop/diffs_in_show_cmd.v
index 7847caa32e07..bf629ecad2f6 100644
--- a/test-suite/output-coqtop/diffs_in_show_cmd.v
+++ b/test-suite/output-coqtop/diffs_in_show_cmd.v
@@ -1,5 +1,6 @@
 (* -*- coq-prog-args: ("-color" "on"); -*- *)
 Goal forall n m:nat, n = m.
+Proof.
 refine ?[foo].
 intros.
 
diff --git a/test-suite/output/Arguments_renaming.out b/test-suite/output/Arguments_renaming.out
index 44d996320118..01f06468bd8f 100644
--- a/test-suite/output/Arguments_renaming.out
+++ b/test-suite/output/Arguments_renaming.out
@@ -36,7 +36,7 @@ Arguments myrefl {C}%_type_scope x _
   (where some original arguments have been renamed)
 myrefl uses section variable A.
 Expands to: Constructor Arguments_renaming.Test1.myrefl
-Declared in library Arguments_renaming, line 25, characters 40-46
+Declared in library Arguments_renaming, line 26, characters 40-46
 myplus =
 fix myplus (T : Type) (t : T) (n m : nat) {struct n} : nat :=
   match n with
@@ -56,7 +56,7 @@ The reduction tactics unfold myplus when the 2nd and
   3rd arguments evaluate to a constructor
 myplus is transparent
 Expands to: Constant Arguments_renaming.Test1.myplus
-Declared in library Arguments_renaming, line 31, characters 9-15
+Declared in library Arguments_renaming, line 32, characters 9-15
 @myplus
      : forall Z : Type, Z -> nat -> nat -> nat
 Inductive myEq (A B : Type) (x : A) : A -> Prop :=
@@ -71,7 +71,7 @@ myrefl is template universe polymorphic
 Arguments myrefl A%_type_scope {C}%_type_scope x _
   (where some original arguments have been renamed)
 Expands to: Constructor Arguments_renaming.myrefl
-Declared in library Arguments_renaming, line 25, characters 40-46
+Declared in library Arguments_renaming, line 26, characters 40-46
 myrefl
      : forall (A C : Type) (x : A), C -> myEq A C x x
 myplus =
@@ -93,29 +93,29 @@ The reduction tactics unfold myplus when the 2nd and
   3rd arguments evaluate to a constructor
 myplus is transparent
 Expands to: Constant Arguments_renaming.myplus
-Declared in library Arguments_renaming, line 31, characters 9-15
+Declared in library Arguments_renaming, line 32, characters 9-15
 @myplus
      : forall Z : Type, Z -> nat -> nat -> nat
-File "./output/Arguments_renaming.v", line 49, characters 0-36:
+File "./output/Arguments_renaming.v", line 50, characters 0-36:
 The command has indeed failed with message:
 Argument lists should agree on the names they provide.
-File "./output/Arguments_renaming.v", line 50, characters 0-41:
+File "./output/Arguments_renaming.v", line 51, characters 0-41:
 The command has indeed failed with message:
 Sequences of implicit arguments must be of different lengths.
-File "./output/Arguments_renaming.v", line 51, characters 0-37:
+File "./output/Arguments_renaming.v", line 52, characters 0-37:
 The command has indeed failed with message:
 Argument number 3 is a trailing implicit, so it can't be declared non
 maximal. Please use { } instead of [ ].
-File "./output/Arguments_renaming.v", line 52, characters 0-37:
+File "./output/Arguments_renaming.v", line 53, characters 0-37:
 The command has indeed failed with message:
 Argument z is a trailing implicit, so it can't be declared non maximal.
 Please use { } instead of [ ].
-File "./output/Arguments_renaming.v", line 53, characters 0-28:
+File "./output/Arguments_renaming.v", line 54, characters 0-28:
 The command has indeed failed with message:
 Extra arguments: y.
-File "./output/Arguments_renaming.v", line 54, characters 0-26:
+File "./output/Arguments_renaming.v", line 55, characters 0-26:
 The command has indeed failed with message:
 Flag "rename" expected to rename A into R.
-File "./output/Arguments_renaming.v", line 58, characters 2-36:
+File "./output/Arguments_renaming.v", line 59, characters 2-36:
 The command has indeed failed with message:
 Arguments of section variables such as allTrue may not be renamed.
diff --git a/test-suite/output/Arguments_renaming.v b/test-suite/output/Arguments_renaming.v
index 0be5b9d1578f..ddd020f82158 100644
--- a/test-suite/output/Arguments_renaming.v
+++ b/test-suite/output/Arguments_renaming.v
@@ -10,6 +10,7 @@ Print eq_refl.
 About eq_refl.
 
 Goal 3 = 3.
+Proof.
 Succeed apply @eq_refl with (B := nat).
 
 Succeed apply @eq_refl with (y := 3).
diff --git a/test-suite/output/CantApplyBadType.out b/test-suite/output/CantApplyBadType.out
index ca34e43809b8..803e22e36eda 100644
--- a/test-suite/output/CantApplyBadType.out
+++ b/test-suite/output/CantApplyBadType.out
@@ -11,7 +11,7 @@ cannot be applied to the term
  "Type" : "Type"
 This term has type "Type@{u+1}" which should be a subtype of 
 "Type@{u1}".
-File "./output/CantApplyBadType.v", line 27, characters 2-108:
+File "./output/CantApplyBadType.v", line 28, characters 2-108:
 The command has indeed failed with message:
 Illegal application: 
 The term "idu1" of type "Type -> Type"
diff --git a/test-suite/output/CantApplyBadType.v b/test-suite/output/CantApplyBadType.v
index 97151e5ed2ee..2206050e5c89 100644
--- a/test-suite/output/CantApplyBadType.v
+++ b/test-suite/output/CantApplyBadType.v
@@ -24,6 +24,7 @@ This term has type "Type@{u+1}" which should be coercible to
 
 (* typing.ml error *)
 Goal True.
+Proof.
   Fail let c := constr:(ltac:(refine (idu1 _); exact_no_check Type@{u})) in
   let _ := type of c in
   idtac.
diff --git a/test-suite/output/Cases.out b/test-suite/output/Cases.out
index 226918e1e256..5d1a3dfb321c 100644
--- a/test-suite/output/Cases.out
+++ b/test-suite/output/Cases.out
@@ -175,7 +175,7 @@ fun x : K => match x with
              | _ => 2
              end
      : K -> nat
-File "./output/Cases.v", line 224, characters 38-86:
+File "./output/Cases.v", line 229, characters 38-86:
 The command has indeed failed with message:
 Pattern "S _, _" is redundant in this clause.
 stray =
@@ -192,21 +192,21 @@ end
      : Tree -> Tree
 
 Arguments stray N
-File "./output/Cases.v", line 253, characters 4-5:
+File "./output/Cases.v", line 258, characters 4-5:
 Warning: Unused variable B might be a misspelled constructor. Use _ or _B to
 silence this warning. [unused-pattern-matching-variable,default]
-File "./output/Cases.v", line 266, characters 33-40:
+File "./output/Cases.v", line 271, characters 33-40:
 The command has indeed failed with message:
 Application of arguments to a recursive notation not supported in patterns.
-File "./output/Cases.v", line 267, characters 33-43:
+File "./output/Cases.v", line 272, characters 33-43:
 The command has indeed failed with message:
 The constructor cons (in type list) is expected to be applied to 2 arguments
 while it is actually applied to 3 arguments.
-File "./output/Cases.v", line 268, characters 33-39:
+File "./output/Cases.v", line 273, characters 33-39:
 The command has indeed failed with message:
 The constructor cons (in type list) is expected to be applied to 2 arguments
 while it is actually applied to 1 argument.
-File "./output/Cases.v", line 271, characters 33-45:
+File "./output/Cases.v", line 276, characters 33-45:
 The command has indeed failed with message:
 The constructor D' (in type J') is expected to be applied to 4 arguments (or
 6 arguments when including variables for local definitions) while it is
@@ -220,23 +220,23 @@ fun x : J' bool (true, true) => match x with
                                 | D' _ _ _ n p _ => n + p
                                 end
      : J' bool (true, true) -> nat
-File "./output/Cases.v", line 277, characters 33-40:
+File "./output/Cases.v", line 282, characters 33-40:
 The command has indeed failed with message:
 Application of arguments to a recursive notation not supported in patterns.
-File "./output/Cases.v", line 278, characters 33-43:
+File "./output/Cases.v", line 283, characters 33-43:
 The command has indeed failed with message:
 The constructor cons (in type list) is expected to be applied to 2 arguments
 while it is actually applied to 3 arguments.
-File "./output/Cases.v", line 279, characters 33-39:
+File "./output/Cases.v", line 284, characters 33-39:
 The command has indeed failed with message:
 The constructor cons (in type list) is expected to be applied to 2 arguments
 while it is actually applied to 1 argument.
-File "./output/Cases.v", line 281, characters 33-39:
+File "./output/Cases.v", line 286, characters 33-39:
 The command has indeed failed with message:
 The constructor D' (in type J') is expected to be applied to 3 arguments (or
 4 arguments when including variables for local definitions) while it is
 actually applied to 2 arguments.
-File "./output/Cases.v", line 282, characters 33-45:
+File "./output/Cases.v", line 287, characters 33-45:
 The command has indeed failed with message:
 The constructor D' (in type J') is expected to be applied to 3 arguments (or
 4 arguments when including variables for local definitions) while it is
@@ -251,16 +251,16 @@ match x with
 | @D' _ _ _ _ n _ p _ => (n, p)
 end
      : J' bool (true, true) -> nat * nat
-File "./output/Cases.v", line 313, characters 3-4:
+File "./output/Cases.v", line 318, characters 3-4:
 Warning: Unused variable x might be a misspelled constructor. Use _ or _x to
 silence this warning. [unused-pattern-matching-variable,default]
-File "./output/Cases.v", line 314, characters 6-7:
+File "./output/Cases.v", line 319, characters 6-7:
 Warning: Unused variable y might be a misspelled constructor. Use _ or _y to
 silence this warning. [unused-pattern-matching-variable,default]
-File "./output/Cases.v", line 314, characters 3-4:
+File "./output/Cases.v", line 319, characters 3-4:
 Warning: Unused variable x might be a misspelled constructor. Use _ or _x to
 silence this warning. [unused-pattern-matching-variable,default]
-File "./output/Cases.v", line 325, characters 4-12:
+File "./output/Cases.v", line 330, characters 4-12:
 The command has indeed failed with message:
 Once notations are expanded, the resulting constructor true (in type bool) is
 expected to be applied to no arguments while it is actually applied to
diff --git a/test-suite/output/Cases.v b/test-suite/output/Cases.v
index 8cca5ef8909f..98ee85518031 100644
--- a/test-suite/output/Cases.v
+++ b/test-suite/output/Cases.v
@@ -128,6 +128,7 @@ Fail Check fun x : J => let '{{n, m, _}} p := x in n + m + p.
 (* Test use of idents bound to ltac names in a "match" *)
 
 Lemma lem1 : forall k, k=k :>nat * nat.
+Proof.
 let x := fresh "aa" in
 let y := fresh "bb" in
 let z := fresh "cc" in
@@ -137,6 +138,7 @@ Qed.
 Print lem1.
 
 Lemma lem2 : forall k, k=k :> bool.
+Proof.
 let x := fresh "aa" in
 let y := fresh "bb" in
 let z := fresh "cc" in
@@ -146,6 +148,7 @@ Qed.
 Print lem2.
 
 Lemma lem3 : forall k, k=k :>nat * nat.
+Proof.
 let x := fresh "aa" in
 let y := fresh "bb" in
 let z := fresh "cc" in
@@ -155,6 +158,7 @@ Qed.
 Print lem3.
 
 Lemma lem4 x : x+0=0.
+Proof.
 match goal with |- ?y = _ => pose (match y with 0 => 0 | S n => 0 end) end.
 match goal with |- ?y = _ => pose (match y as y with 0 => 0 | S n => 0 end) end.
 match goal with |- ?y = _ => pose (match y as y return y=y with 0 => eq_refl | S n => eq_refl end) end.
@@ -167,6 +171,7 @@ Show.
 Abort.
 
 Lemma lem5 (p:nat) : eq_refl p = eq_refl p.
+Proof.
 let y := fresh "n" in (* Checking that y is hidden *)
   let z := fresh "e" in (* Checking that z is hidden *)
   match goal with
diff --git a/test-suite/output/DebugRelevances.v b/test-suite/output/DebugRelevances.v
index 0d853a3cfd69..1e22f5f55fbd 100644
--- a/test-suite/output/DebugRelevances.v
+++ b/test-suite/output/DebugRelevances.v
@@ -22,6 +22,7 @@ Print boz.
 Inductive sFalse : SProp := .
 
 Goal True.
+Proof.
   Unset Printing Notations. (* arrow notation has no binder so relevance isn't printed *)
   pose (f:=fun A (a:A) => A).
   Show.
diff --git a/test-suite/output/Deprecation.out b/test-suite/output/Deprecation.out
index 2063c7e82973..7a985117f16d 100644
--- a/test-suite/output/Deprecation.out
+++ b/test-suite/output/Deprecation.out
@@ -2,26 +2,26 @@ File "./output/Deprecation.v", line 4, characters 33-48:
 The command has indeed failed with message:
 This command does not support this attribute: why.
 [unsupported-attributes,parsing,default]
-File "./output/Deprecation.v", line 7, characters 0-3:
+File "./output/Deprecation.v", line 8, characters 0-3:
 Warning: Tactic foo is deprecated since X.Y. Use idtac instead.
 [deprecated-tactic-since-X.Y,deprecated-since-X.Y,deprecated-tactic,deprecated,default]
-File "./output/Deprecation.v", line 19, characters 5-8:
+File "./output/Deprecation.v", line 22, characters 5-8:
 The command has indeed failed with message:
 Tactic foo is deprecated since X.Y. Use idtac instead.
 [deprecated-tactic-since-X.Y,deprecated-since-X.Y,deprecated-tactic,deprecated,default]
-File "./output/Deprecation.v", line 26, characters 0-3:
+File "./output/Deprecation.v", line 30, characters 0-3:
 Warning: Tactic bar is deprecated since library X.Y. Use baz instead.
 [deprecated-tactic-since-library-X.Y,deprecated-since-library-X.Y,deprecated-tactic,deprecated,default]
-File "./output/Deprecation.v", line 31, characters 6-9:
+File "./output/Deprecation.v", line 35, characters 6-9:
 Warning: hello [warn-reference,user-warn,default]
 bar
      : nat
-File "./output/Deprecation.v", line 36, characters 6-13:
+File "./output/Deprecation.v", line 40, characters 6-13:
 Warning: use less +s
 [warn-notation-fragile-too-many-plus,too-many-plus,fragile,warn-notation,user-warn,default]
 1 ++ 2
      : nat
-File "./output/Deprecation.v", line 37, characters 6-12:
+File "./output/Deprecation.v", line 41, characters 6-12:
 Warning: use less +s 2
 [warn-notation-too-many-plus,too-many-plus,warn-notation,user-warn,default]
 1 ++ 2
diff --git a/test-suite/output/Deprecation.v b/test-suite/output/Deprecation.v
index 7b273f00556a..a78bbbcd0ee0 100644
--- a/test-suite/output/Deprecation.v
+++ b/test-suite/output/Deprecation.v
@@ -4,18 +4,21 @@
 Fail #[deprecated(since="today", why="I said so")] Definition foo := 1.
 
 Goal True.
+Proof.
 foo.
 Abort.
 
 Set Warnings "-deprecated-since-X.Y".
 
 Goal True.
+Proof.
 foo.
 Abort.
 
 Set Warnings "+deprecated-since-X.Y".
 
 Goal True.
+Proof.
 Fail foo.
 Abort.
 
@@ -23,6 +26,7 @@ Abort.
  Ltac bar := idtac.
 
 Goal True.
+Proof.
 bar.
 Abort.
 
diff --git a/test-suite/output/ErrorLocation_12152.out b/test-suite/output/ErrorLocation_12152.out
index 9cddd411564d..dd663c5a7348 100644
--- a/test-suite/output/ErrorLocation_12152.out
+++ b/test-suite/output/ErrorLocation_12152.out
@@ -1,6 +1,6 @@
-File "./output/ErrorLocation_12152.v", line 3, characters 5-12:
+File "./output/ErrorLocation_12152.v", line 4, characters 5-12:
 The command has indeed failed with message:
 No product even after head-reduction.
-File "./output/ErrorLocation_12152.v", line 4, characters 5-13:
+File "./output/ErrorLocation_12152.v", line 5, characters 5-13:
 The command has indeed failed with message:
 No product even after head-reduction.
diff --git a/test-suite/output/ErrorLocation_12152.v b/test-suite/output/ErrorLocation_12152.v
index e65c6820b34d..99063da38f03 100644
--- a/test-suite/output/ErrorLocation_12152.v
+++ b/test-suite/output/ErrorLocation_12152.v
@@ -1,5 +1,6 @@
 (* Reported in #12152 *)
 Goal True.
+Proof.
 Fail intro H; auto.
 Fail intros H; auto.
 Abort.
diff --git a/test-suite/output/ErrorLocation_12255.out b/test-suite/output/ErrorLocation_12255.out
index 078147255011..a225c6c07fa8 100644
--- a/test-suite/output/ErrorLocation_12255.out
+++ b/test-suite/output/ErrorLocation_12255.out
@@ -1,4 +1,4 @@
-File "./output/ErrorLocation_12255.v", line 4, characters 5-21:
+File "./output/ErrorLocation_12255.v", line 5, characters 5-21:
 The command has indeed failed with message:
 Ltac variable x is bound to i > 0 of type constr which cannot be coerced to
 an evaluable reference.
diff --git a/test-suite/output/ErrorLocation_12255.v b/test-suite/output/ErrorLocation_12255.v
index 865bce34b262..a60eac165b1c 100644
--- a/test-suite/output/ErrorLocation_12255.v
+++ b/test-suite/output/ErrorLocation_12255.v
@@ -1,5 +1,6 @@
 Ltac can_unfold x := let b := eval cbv delta [x] in x in idtac.
 Definition i := O.
 Goal False.
+Proof.
 Fail can_unfold (i>0).
 Abort.
diff --git a/test-suite/output/ErrorLocation_12774.out b/test-suite/output/ErrorLocation_12774.out
index 651c776e7c2e..28c8f579ffd7 100644
--- a/test-suite/output/ErrorLocation_12774.out
+++ b/test-suite/output/ErrorLocation_12774.out
@@ -1,9 +1,9 @@
-File "./output/ErrorLocation_12774.v", line 5, characters 18-19:
+File "./output/ErrorLocation_12774.v", line 6, characters 18-19:
 The command has indeed failed with message:
 The term "0" has type "nat" while it is expected to have type "Type".
-File "./output/ErrorLocation_12774.v", line 6, characters 14-15:
+File "./output/ErrorLocation_12774.v", line 7, characters 14-15:
 The command has indeed failed with message:
 The term "0" has type "nat" while it is expected to have type "Type".
-File "./output/ErrorLocation_12774.v", line 7, characters 5-6:
+File "./output/ErrorLocation_12774.v", line 8, characters 5-6:
 The command has indeed failed with message:
 No product even after head-reduction.
diff --git a/test-suite/output/ErrorLocation_12774.v b/test-suite/output/ErrorLocation_12774.v
index d5039f767651..411220b0c4de 100644
--- a/test-suite/output/ErrorLocation_12774.v
+++ b/test-suite/output/ErrorLocation_12774.v
@@ -2,6 +2,7 @@ Ltac f := simpl.
 Ltac g := auto; intro.
 
 Goal Type.
+Proof.
 Fail simpl; exact 0.
 Fail f; exact 0.
 Fail g.
diff --git a/test-suite/output/ErrorLocation_13241.out b/test-suite/output/ErrorLocation_13241.out
index 2c697a88d9b9..ca366e44869f 100644
--- a/test-suite/output/ErrorLocation_13241.out
+++ b/test-suite/output/ErrorLocation_13241.out
@@ -1,6 +1,6 @@
-File "./output/ErrorLocation_13241.v", line 5, characters 5-6:
+File "./output/ErrorLocation_13241.v", line 6, characters 5-6:
 The command has indeed failed with message:
 No product even after head-reduction.
-File "./output/ErrorLocation_13241.v", line 13, characters 5-6:
+File "./output/ErrorLocation_13241.v", line 15, characters 5-6:
 The command has indeed failed with message:
 No product even after head-reduction.
diff --git a/test-suite/output/ErrorLocation_13241.v b/test-suite/output/ErrorLocation_13241.v
index 05120a5d46d5..1fb40cc97f97 100644
--- a/test-suite/output/ErrorLocation_13241.v
+++ b/test-suite/output/ErrorLocation_13241.v
@@ -2,6 +2,7 @@ Module Direct.
 Ltac a := intro.
 Ltac b := a.
 Goal True.
+Proof.
 Fail b.
 Abort.
 End Direct.
@@ -10,6 +11,7 @@ Module Thunked.
 Ltac a _ := intro.
 Ltac b := a ().
 Goal True.
+Proof.
 Fail b.
 Abort.
 End Thunked.
diff --git a/test-suite/output/ErrorLocation_ltac.out b/test-suite/output/ErrorLocation_ltac.out
index be2519b8c434..7db15421dda0 100644
--- a/test-suite/output/ErrorLocation_ltac.out
+++ b/test-suite/output/ErrorLocation_ltac.out
@@ -1,12 +1,12 @@
-File "./output/ErrorLocation_ltac.v", line 5, characters 12-16:
+File "./output/ErrorLocation_ltac.v", line 6, characters 12-16:
 The command has indeed failed with message:
 Tactic failure: Cannot solve this goal.
-File "./output/ErrorLocation_ltac.v", line 6, characters 12-13:
+File "./output/ErrorLocation_ltac.v", line 7, characters 12-13:
 The command has indeed failed with message:
 Tactic failure.
-File "./output/ErrorLocation_ltac.v", line 7, characters 12-15:
+File "./output/ErrorLocation_ltac.v", line 8, characters 12-15:
 The command has indeed failed with message:
 Not a negated primitive equality.
-File "./output/ErrorLocation_ltac.v", line 8, characters 27-28:
+File "./output/ErrorLocation_ltac.v", line 9, characters 27-28:
 The command has indeed failed with message:
 Tactic failure.
diff --git a/test-suite/output/ErrorLocation_ltac.v b/test-suite/output/ErrorLocation_ltac.v
index 6de9d9047d99..07c887fc4f18 100644
--- a/test-suite/output/ErrorLocation_ltac.v
+++ b/test-suite/output/ErrorLocation_ltac.v
@@ -2,6 +2,7 @@ Ltac f := fail.
 Ltac inj := injection.
 
 Goal False.
+Proof.
 Fail idtac; easy.
 Fail idtac; f.
 Fail idtac; inj.
diff --git a/test-suite/output/ErrorLocation_tac_in_term.out b/test-suite/output/ErrorLocation_tac_in_term.out
index 5424ea92fa10..96d01a0f75c4 100644
--- a/test-suite/output/ErrorLocation_tac_in_term.out
+++ b/test-suite/output/ErrorLocation_tac_in_term.out
@@ -13,9 +13,9 @@ The command has indeed failed with message:
 Illegal application (Non-functional construction): 
 The expression "I" of type "True" cannot be applied to the term
  "I" : "True"
-File "./output/ErrorLocation_tac_in_term.v", line 17, characters 26-30:
+File "./output/ErrorLocation_tac_in_term.v", line 18, characters 26-30:
 The command has indeed failed with message:
 The term "true" has type "bool" while it is expected to have type "nat".
-File "./output/ErrorLocation_tac_in_term.v", line 18, characters 17-25:
+File "./output/ErrorLocation_tac_in_term.v", line 19, characters 17-25:
 The command has indeed failed with message:
 The term "true" has type "bool" while it is expected to have type "nat".
diff --git a/test-suite/output/ErrorLocation_tac_in_term.v b/test-suite/output/ErrorLocation_tac_in_term.v
index bd78bfb611e6..c33d1cefeaff 100644
--- a/test-suite/output/ErrorLocation_tac_in_term.v
+++ b/test-suite/output/ErrorLocation_tac_in_term.v
@@ -14,6 +14,7 @@ Fail Check baz (I I).
 Ltac f x y := apply (x y).
 
 Goal True.
+Proof.
 Fail apply ltac:(apply (S true)).
 Fail apply ltac:(f S true).
 Abort.
diff --git a/test-suite/output/Errors.out b/test-suite/output/Errors.out
index e336d7230e74..e126c2e1db72 100644
--- a/test-suite/output/Errors.out
+++ b/test-suite/output/Errors.out
@@ -1,39 +1,39 @@
 File "./output/Errors.v", line 12, characters 0-11:
 The command has indeed failed with message:
 The field t is missing in Errors.M.
-File "./output/Errors.v", line 19, characters 18-19:
+File "./output/Errors.v", line 20, characters 18-19:
 The command has indeed failed with message:
 Unable to unify "nat" with "True".
 
-File "./output/Errors.v", line 20, characters 12-15:
+File "./output/Errors.v", line 21, characters 12-15:
 The command has indeed failed with message:
 Unable to unify "nat" with
  "True".
 In nested Ltac calls to "f" and "apply x", last call failed.
 
-File "./output/Errors.v", line 29, characters 21-30:
+File "./output/Errors.v", line 31, characters 21-30:
 The command has indeed failed with message:
 Instance is not well-typed in the environment of ?x.
 Ltac call to "instantiate ( (ident) := (lglob) )" failed.
 
-File "./output/Errors.v", line 34, characters 19-20:
+File "./output/Errors.v", line 36, characters 19-20:
 The command has indeed failed with message:
 Cannot infer ?T in the partial instance "?T -> nat" found for the type of f.
-File "./output/Errors.v", line 35, characters 22-24:
+File "./output/Errors.v", line 37, characters 22-24:
 The command has indeed failed with message:
 Cannot infer ?T in the partial instance "?T -> nat" found for the implicit
 parameter A of id whose type is "Type".
-File "./output/Errors.v", line 36, characters 17-18:
+File "./output/Errors.v", line 38, characters 17-18:
 The command has indeed failed with message:
 Cannot infer ?T in the partial instance "forall x : nat, ?T" found for the
 type of f in environment:
 x : nat
-File "./output/Errors.v", line 44, characters 5-23:
+File "./output/Errors.v", line 47, characters 5-23:
 The command has indeed failed with message:
 The first term has type "nat" while the second term has incompatible type
 "bool".
 
-File "./output/Errors.v", line 49, characters 7-24:
+File "./output/Errors.v", line 53, characters 7-24:
 The command has indeed failed with message:
 Replacement would lead to an ill-typed term: Illegal application: 
 The term "@eq" of type "forall A : Type, A -> A -> Prop"
diff --git a/test-suite/output/Errors.v b/test-suite/output/Errors.v
index 4ee12a18ac39..d94d5ddaa0ca 100644
--- a/test-suite/output/Errors.v
+++ b/test-suite/output/Errors.v
@@ -16,6 +16,7 @@ Fail End M.
 
 Ltac f x := apply x.
 Goal True.
+Proof.
 Fail simpl; apply 0.
 Fail simpl; f 0.
 Abort.
@@ -23,6 +24,7 @@ Abort.
 (* Test instantiate error messages *)
 
 Goal forall T1 (P1 : T1 -> Type), sigT P1 -> sigT P1.
+Proof.
 intros T1 P1 H1.
 eexists ?[x].
 destruct H1 as [x1 H1].
@@ -41,10 +43,12 @@ End M.
 Module Change.
 
 Goal 0 = 0.
+Proof.
 Fail change 0 with true.
 Abort.
 
 Goal nat = nat.
+Proof.
   pose (nat : Type) as n.
   Fail change nat with n. (* Error: Replacement would lead to an ill-typed term. *)
 Abort.
diff --git a/test-suite/output/Existentials.v b/test-suite/output/Existentials.v
index 924f1f559264..b118b1d2c359 100644
--- a/test-suite/output/Existentials.v
+++ b/test-suite/output/Existentials.v
@@ -6,6 +6,7 @@ Variable p:nat.
 Let q := S p.
 
 Goal forall n m:nat, n = m.
+Proof.
 intros.
 eapply eq_trans.
 clearbody q.
diff --git a/test-suite/output/InvalidDisjunctiveIntro.out b/test-suite/output/InvalidDisjunctiveIntro.out
index 361aac6f2365..d80cffe08cfa 100644
--- a/test-suite/output/InvalidDisjunctiveIntro.out
+++ b/test-suite/output/InvalidDisjunctiveIntro.out
@@ -1,23 +1,23 @@
-File "./output/InvalidDisjunctiveIntro.v", line 2, characters 31-32:
+File "./output/InvalidDisjunctiveIntro.v", line 3, characters 31-32:
 The command has indeed failed with message:
 Cannot coerce to a disjunctive/conjunctive pattern.
-File "./output/InvalidDisjunctiveIntro.v", line 4, characters 2-32:
+File "./output/InvalidDisjunctiveIntro.v", line 5, characters 2-32:
 The command has indeed failed with message:
 Disjunctive/conjunctive introduction pattern expected.
-File "./output/InvalidDisjunctiveIntro.v", line 6, characters 48-49:
+File "./output/InvalidDisjunctiveIntro.v", line 7, characters 48-49:
 The command has indeed failed with message:
 Cannot coerce to a disjunctive/conjunctive pattern.
-File "./output/InvalidDisjunctiveIntro.v", line 8, characters 49-50:
+File "./output/InvalidDisjunctiveIntro.v", line 9, characters 49-50:
 The command has indeed failed with message:
 Cannot coerce to a disjunctive/conjunctive pattern.
-File "./output/InvalidDisjunctiveIntro.v", line 10, characters 32-33:
+File "./output/InvalidDisjunctiveIntro.v", line 11, characters 32-33:
 The command has indeed failed with message:
 Ltac variable H is bound to idtac of type tactic which cannot be coerced to
 an introduction pattern.
-File "./output/InvalidDisjunctiveIntro.v", line 13, characters 2-52:
+File "./output/InvalidDisjunctiveIntro.v", line 14, characters 2-52:
 The command has indeed failed with message:
 Disjunctive/conjunctive introduction pattern expected.
-File "./output/InvalidDisjunctiveIntro.v", line 15, characters 50-52:
+File "./output/InvalidDisjunctiveIntro.v", line 16, characters 50-52:
 The command has indeed failed with message:
 Ltac variable H' is bound to idtac of type tactic which cannot be coerced to
 an introduction pattern.
diff --git a/test-suite/output/InvalidDisjunctiveIntro.v b/test-suite/output/InvalidDisjunctiveIntro.v
index 4febdf034490..b5c31b559e5e 100644
--- a/test-suite/output/InvalidDisjunctiveIntro.v
+++ b/test-suite/output/InvalidDisjunctiveIntro.v
@@ -1,4 +1,5 @@
 Theorem test (A:Prop) : A \/ A -> A.
+Proof.
   Fail intros H; destruct H as H.
   (* Cannot coerce to a disjunctive/conjunctive pattern. *)
   Fail intro H; destruct H as H.
diff --git a/test-suite/output/Match_subterm.v b/test-suite/output/Match_subterm.v
index bf862c946d5b..7a0e9d90328a 100644
--- a/test-suite/output/Match_subterm.v
+++ b/test-suite/output/Match_subterm.v
@@ -1,4 +1,5 @@
 Goal 0 = 1.
+Proof.
 match goal with
 | |- context [?v] =>
   idtac v ; fail
diff --git a/test-suite/output/MissingProof.out b/test-suite/output/MissingProof.out
new file mode 100644
index 000000000000..7989a41d20f3
--- /dev/null
+++ b/test-suite/output/MissingProof.out
@@ -0,0 +1,30 @@
+File "./output/MissingProof.v", line 2, characters 2-8:
+Warning: This interactive proof is not started by the "Proof" command.
+[missing-proof-command,fragile,default]
+Quickfix:
+Replace File "./output/MissingProof.v", line 2, characters 2-2 with Proof.
+
+File "./output/MissingProof.v", line 7, characters 2-3:
+Warning: This interactive proof is not started by the "Proof" command.
+[missing-proof-command,fragile,default]
+Quickfix:
+Replace File "./output/MissingProof.v", line 7, characters 2-2 with Proof.
+
+File "./output/MissingProof.v", line 11, characters 0-9:
+Warning: This interactive proof is not started by the "Proof" command.
+[missing-proof-command,fragile,default]
+Quickfix:
+Replace File "./output/MissingProof.v", line 11, characters 0-0 with Proof.
+
+File "./output/MissingProof.v", line 20, characters 2-13:
+The command has indeed failed with message:
+Multiple "Proof" commands not supported.
+File "./output/MissingProof.v", line 24, characters 2-8:
+Warning: This interactive proof is not started by the "Proof" command.
+[missing-proof-command,fragile,default]
+Quickfix:
+Replace File "./output/MissingProof.v", line 24, characters 2-2 with Proof.
+
+File "./output/MissingProof.v", line 25, characters 2-13:
+The command has indeed failed with message:
+"Proof" must be the first command in an interactive proof.
diff --git a/test-suite/output/MissingProof.v b/test-suite/output/MissingProof.v
new file mode 100644
index 000000000000..16573025ddc8
--- /dev/null
+++ b/test-suite/output/MissingProof.v
@@ -0,0 +1,26 @@
+Goal True.
+  idtac.
+  idtac. (* second command doesn't repeat the warning *)
+Abort.
+
+Goal True.
+  {
+Abort.
+
+Goal True.
+Admitted.
+
+(* abort doesn't warn (NB it would be very annoying to make it warn
+   because the stm sends the proof data from the proof opening command to Abort) *)
+Goal True.
+Abort.
+
+Goal True.
+Proof.
+  Fail Proof.
+Abort.
+
+Goal True.
+  idtac.
+  Fail Proof.
+Abort.
diff --git a/test-suite/output/Naming.out b/test-suite/output/Naming.out
index ecb93f428ece..0c5b7b113abb 100644
--- a/test-suite/output/Naming.out
+++ b/test-suite/output/Naming.out
@@ -63,18 +63,18 @@
   H : a = 0 -> forall a : nat, a = 0
   ============================
   a = 0
-File "./output/Naming.v", line 101, characters 47-48:
+File "./output/Naming.v", line 104, characters 47-48:
 Warning: Ignoring implicit binder declaration in unexpected position.
 [unexpected-implicit-declaration,syntax,default]
-File "./output/Naming.v", line 105, characters 36-37:
+File "./output/Naming.v", line 108, characters 36-37:
 Warning: Ignoring implicit binder declaration in unexpected position.
 [unexpected-implicit-declaration,syntax,default]
-File "./output/Naming.v", line 106, characters 34-35:
+File "./output/Naming.v", line 109, characters 34-35:
 Warning: Ignoring implicit binder declaration in unexpected position.
 [unexpected-implicit-declaration,syntax,default]
-File "./output/Naming.v", line 112, characters 22-23:
+File "./output/Naming.v", line 115, characters 22-23:
 Warning: Ignoring implicit binder declaration in unexpected position.
 [unexpected-implicit-declaration,syntax,default]
-File "./output/Naming.v", line 112, characters 30-31:
+File "./output/Naming.v", line 115, characters 30-31:
 Warning: Ignoring implicit binder declaration in unexpected position.
 [unexpected-implicit-declaration,syntax,default]
diff --git a/test-suite/output/Naming.v b/test-suite/output/Naming.v
index 4c35296d7c1f..ea03673d3bb5 100644
--- a/test-suite/output/Naming.v
+++ b/test-suite/output/Naming.v
@@ -7,6 +7,7 @@ Section A.
 Variable x3:nat.
 Goal forall x x1 x2 x3:nat,
   (forall x x3:nat, x+x1 = x2+x3) -> x+x1 = x2+x3.
+Proof.
 Show.
 intros.
 Show.
@@ -39,6 +40,7 @@ Abort.
 Goal forall x x1 x2 x3:nat,
   (forall x x3:nat, x+x1 = x2+x3 -> foo (S x + x1)) ->
    x+x1 = x2+x3 -> foo (S x).
+Proof.
 Show.
 unfold foo.
 Show.
@@ -84,6 +86,7 @@ Abort.
 (* Check naming in hypotheses *)
 
 Goal forall a, (a = 0 -> forall a, a = 0) -> a = 0.
+Proof.
 intros.
 Show.
 apply H with (a:=a). (* test compliance with printing *)
diff --git a/test-suite/output/PrintInfos.out b/test-suite/output/PrintInfos.out
index aa8a989b7526..e59623a8e3d7 100644
--- a/test-suite/output/PrintInfos.out
+++ b/test-suite/output/PrintInfos.out
@@ -84,7 +84,7 @@ Arguments bar {x}
 Module Corelib.Init.Peano
 Notation sym_eq := eq_sym
 Expands to: Notation Corelib.Init.Logic.sym_eq
-Declared in library Corelib.Init.Logic, line 764, characters 0-45
+Declared in library Corelib.Init.Logic, line 767, characters 0-45
 
 eq_sym : forall [A : Type] [x y : A], x = y -> y = x
 
@@ -140,7 +140,7 @@ fst is a projection of prod
 Arguments fst (A B)%_type_scope p
 fst is transparent
 Expands to: Constant PrintInfos.AboutProj.fst
-Declared in library PrintInfos, line 57, characters 21-24
+Declared in library PrintInfos, line 59, characters 21-24
 fst : forall A B : Type, prod A B -> A
 
 fst is not universe polymorphic
@@ -148,4 +148,4 @@ fst is a primitive projection of prod
 Arguments fst (A B)%_type_scope p
 fst is transparent
 Expands to: Constant PrintInfos.AboutPrimProj.fst
-Declared in library PrintInfos, line 63, characters 21-24
+Declared in library PrintInfos, line 65, characters 21-24
diff --git a/test-suite/output/PrintInfos.v b/test-suite/output/PrintInfos.v
index b32628ee28bf..e2ea98e45b0f 100644
--- a/test-suite/output/PrintInfos.v
+++ b/test-suite/output/PrintInfos.v
@@ -36,12 +36,14 @@ Print eq_refl.
 Definition newdef := fun x:nat => x.
 
 Goal forall n:nat, n <> newdef n -> newdef n <> n -> False.
+Proof.
   intros n h h'.
   About n.                              (* search hypothesis *)
   About h.                              (* search hypothesis *)
 Abort.
 
 Goal forall n:nat, let g := newdef in n <> newdef n -> newdef n <> n -> False.
+Proof.
   intros n g h h'.
   About g.                              (* search hypothesis *)
   About h.                              (* search hypothesis *)
diff --git a/test-suite/output/Search.out b/test-suite/output/Search.out
index 1e5d2617bee9..b88bb362732e 100644
--- a/test-suite/output/Search.out
+++ b/test-suite/output/Search.out
@@ -326,13 +326,13 @@ h: n <> newdef n
 h: n <> newdef n
 h: n <> newdef n
 h': newdef n <> n
-File "./output/Search.v", line 23, characters 2-23:
+File "./output/Search.v", line 24, characters 2-23:
 The command has indeed failed with message:
 [Focus] No such goal.
-File "./output/Search.v", line 24, characters 2-25:
+File "./output/Search.v", line 25, characters 2-25:
 The command has indeed failed with message:
 Query commands only support the single numbered goal selector.
-File "./output/Search.v", line 25, characters 2-25:
+File "./output/Search.v", line 26, characters 2-25:
 The command has indeed failed with message:
 Query commands only support the single numbered goal selector.
 h: P n
diff --git a/test-suite/output/Search.v b/test-suite/output/Search.v
index 0cfec9581f0e..7e405244df40 100644
--- a/test-suite/output/Search.v
+++ b/test-suite/output/Search.v
@@ -10,6 +10,7 @@ Search (@eq _ _ _) true -false "prop" -"intro".  (* andb_prop *)
 Definition newdef := fun x:nat => x.
 
 Goal forall n:nat, n <> newdef n -> newdef n <> n -> False.
+Proof.
   cut False.
   intros _ n h h'.
   Search n.                             (* search hypothesis *)
@@ -26,6 +27,7 @@ Goal forall n:nat, n <> newdef n -> newdef n <> n -> False.
 Abort.
 
 Goal forall n (P:nat -> Prop), P n -> ~P n -> False.
+Proof.
   intros n P h h'.
   Search P.                 (* search hypothesis also for patterns *)
   Search (P _).             (* search hypothesis also for patterns *)
diff --git a/test-suite/output/SearchPattern.v b/test-suite/output/SearchPattern.v
index de9f48873a03..866ed34c5d2b 100644
--- a/test-suite/output/SearchPattern.v
+++ b/test-suite/output/SearchPattern.v
@@ -21,12 +21,14 @@ SearchPattern (Exc _).
 Definition newdef := fun x:nat => x.
 
 Goal forall n:nat, n <> newdef n -> False.
+Proof.
   intros n h.
   SearchPattern ( _ <> newdef _).          (* search hypothesis *)
   SearchPattern ( n <> newdef _).          (* search hypothesis *)
 Abort.
 
 Goal forall n (P:nat -> Prop), P n -> ~P n -> False.
+Proof.
   intros n P h h'.
   SearchPattern (P _).      (* search hypothesis also for patterns *)
   Search (~P n).          (* search hypothesis also for patterns *)
diff --git a/test-suite/output/SearchRewrite.v b/test-suite/output/SearchRewrite.v
index 53d043c6816d..eed5801faf20 100644
--- a/test-suite/output/SearchRewrite.v
+++ b/test-suite/output/SearchRewrite.v
@@ -6,6 +6,7 @@ SearchRewrite (0+_). 			(* right *)
 Definition newdef := fun x:nat => x.
 
 Goal forall n:nat, n = newdef n -> False.
+Proof.
   intros n h.
   SearchRewrite (newdef _).
   SearchRewrite n.                (* use hypothesis for patterns *)
diff --git a/test-suite/output/Search_bug17963.v b/test-suite/output/Search_bug17963.v
index 3ab78ef37ea7..42cfaa697aff 100644
--- a/test-suite/output/Search_bug17963.v
+++ b/test-suite/output/Search_bug17963.v
@@ -1,4 +1,5 @@
 Goal exists y, Some y = Some y :> option nat -> True.
+Proof.
 eexists. intro H.
 Search Some eq.
 Abort.
diff --git a/test-suite/output/Search_headconcl.v b/test-suite/output/Search_headconcl.v
index 8b168dcd25a5..4b0a22e60cac 100644
--- a/test-suite/output/Search_headconcl.v
+++ b/test-suite/output/Search_headconcl.v
@@ -7,12 +7,14 @@ Search headconcl: (@eq nat).			(* complex pattern *)
 Definition newdef := fun x:nat => x = x.
 
 Goal forall n:nat, newdef n -> False.
+Proof.
   intros n h.
   Search headconcl: newdef.             (* search hypothesis *)
 Abort.
 
 
 Goal forall n (P:nat -> Prop), P n -> False.
+Proof.
   intros n P h.
   Search headconcl: P.                  (* search hypothesis also for patterns *)
 Abort.
diff --git a/test-suite/output/ShowUnivs.v b/test-suite/output/ShowUnivs.v
index 39abd31ee731..8367ad4f68c2 100644
--- a/test-suite/output/ShowUnivs.v
+++ b/test-suite/output/ShowUnivs.v
@@ -4,6 +4,7 @@ Show Universes.
 Abort.
 
 Goal True.
+Proof.
   pose (fun x => let y := Type in x y :y).
   Show Universes.
 Abort.
diff --git a/test-suite/output/Tactics.out b/test-suite/output/Tactics.out
index 25f68dc74c74..833f131cd088 100644
--- a/test-suite/output/Tactics.out
+++ b/test-suite/output/Tactics.out
@@ -9,10 +9,10 @@ File "./output/Tactics.v", line 23, characters 20-26:
 The command has indeed failed with message:
 H is already used.
 a
-File "./output/Tactics.v", line 36, characters 29-34:
+File "./output/Tactics.v", line 38, characters 29-34:
 The command has indeed failed with message:
 The term "False" has type "Prop" while it is expected to have type "True".
-File "./output/Tactics.v", line 42, characters 16-17:
+File "./output/Tactics.v", line 45, characters 16-17:
 The command has indeed failed with message:
 This variable is used in hypothesis H.
 Ltac test a b c d e := apply a, b in c as [], d, e as ->
diff --git a/test-suite/output/Tactics.v b/test-suite/output/Tactics.v
index a038df046be1..36a1972f6915 100644
--- a/test-suite/output/Tactics.v
+++ b/test-suite/output/Tactics.v
@@ -27,18 +27,21 @@ Abort.
 (* Test that assert_succeeds only runs a tactic once *)
 Ltac should_not_loop := idtac + should_not_loop.
 Goal True.
+Proof.
   assert_succeeds should_not_loop.
   assert_succeeds (idtac "a" + idtac "b"). (* should only output "a" *)
 Abort.
 
 (* assert_succeeds preserves the error *)
 Goal True.
+Proof.
   Fail assert_succeeds exact False.
 Abort.
 
 Module IntroWildcard.
 
 Theorem foo : { p:nat*nat & p = (0,0) } -> True.
+Proof.
 Fail intros ((n,_),H).
 Abort.
 
diff --git a/test-suite/output/TypeclassDebug.out b/test-suite/output/TypeclassDebug.out
index 434ac396538f..289f95aff1f5 100644
--- a/test-suite/output/TypeclassDebug.out
+++ b/test-suite/output/TypeclassDebug.out
@@ -13,6 +13,6 @@ Debug: 1.1-1.1-1.1-1.1-1 : foo
 Debug: 1.1-1.1-1.1-1.1-1: looking for foo without backtracking
 Debug: 1.1-1.1-1.1-1.1-1.1: simple apply H on foo, 1 subgoal(s)
 Debug: 1.1-1.1-1.1-1.1-1.1-1 : foo
-File "./output/TypeclassDebug.v", line 13, characters 5-33:
+File "./output/TypeclassDebug.v", line 14, characters 5-33:
 The command has indeed failed with message:
 Tactic failure: Proof search reached its limit.
diff --git a/test-suite/output/TypeclassDebug.v b/test-suite/output/TypeclassDebug.v
index 092307f4e13e..1593b1592c67 100644
--- a/test-suite/output/TypeclassDebug.v
+++ b/test-suite/output/TypeclassDebug.v
@@ -9,6 +9,7 @@ Create HintDb foo.
 #[global]
 Hint Resolve H : foo.
 Goal foo.
+Proof.
 Typeclasses eauto := debug.
 Fail typeclasses eauto 5 with foo.
 Abort.
diff --git a/test-suite/output/UnivBinders.out b/test-suite/output/UnivBinders.out
index b700a2f8393d..22a1095b6e20 100644
--- a/test-suite/output/UnivBinders.out
+++ b/test-suite/output/UnivBinders.out
@@ -276,21 +276,21 @@ Declared in library UnivBinders, line 227, characters 10-14
 File "./output/UnivBinders.v", line 242, characters 2-38:
 The command has indeed failed with message:
 Universe u0 already exists.
-File "./output/UnivBinders.v", line 249, characters 6-26:
+File "./output/UnivBinders.v", line 250, characters 6-26:
 The command has indeed failed with message:
 Tactic failure: Not equal (due to universes).
 eq_rect
      : forall (A : Type@{eq_rect.u1}) (x : A) (P : A -> Type@{eq_rect.u0}),
        P x -> forall y : A, x = y -> P y
-File "./output/UnivBinders.v", line 267, characters 18-19:
+File "./output/UnivBinders.v", line 268, characters 18-19:
 Warning: Separating sorts from universes with "|" is deprecated.
 Use ";" instead.
 [deprecated-sort-poly-syntax,deprecated-since-9.1,deprecated,default]
-File "./output/UnivBinders.v", line 267, characters 33-34:
+File "./output/UnivBinders.v", line 268, characters 33-34:
 Warning: Separating sorts from universes with "|" is deprecated.
 Use ";" instead.
 [deprecated-sort-poly-syntax,deprecated-since-9.1,deprecated,default]
-File "./output/UnivBinders.v", line 273, characters 16-17:
+File "./output/UnivBinders.v", line 274, characters 16-17:
 Warning: Separating sorts from universes with "|" is deprecated.
 Use ";" instead.
 [deprecated-sort-poly-syntax,deprecated-since-9.1,deprecated,default]
diff --git a/test-suite/output/UnivBinders.v b/test-suite/output/UnivBinders.v
index af12fd328a65..79a8d948a78d 100644
--- a/test-suite/output/UnivBinders.v
+++ b/test-suite/output/UnivBinders.v
@@ -243,6 +243,7 @@ Module Collision.
   Definition x := Type.
 
   Goal True.
+  Proof.
     Fail
       let a := eval cbv in x.a in
       let b := eval cbv in x in
diff --git a/test-suite/output/UnivNotations.v b/test-suite/output/UnivNotations.v
index 6235358847fd..86d97350f72f 100644
--- a/test-suite/output/UnivNotations.v
+++ b/test-suite/output/UnivNotations.v
@@ -20,6 +20,7 @@ Check foo _ S.
 Fail Check ! S.
 
 Goal True.
+Proof.
   (* sort unification variable matches Type (and is printed as Type in the [forall] annotation) *)
   (* NB don't use Check here as it collapses before printing (maybe this will change someday?) *)
   assert (forall A, A -> foo _ A). 2:trivial.
@@ -36,6 +37,7 @@ Check ! nat.
 Check foo _ S.
 
 Goal True.
+Proof.
   (* sort unif variable doesn't match Type *)
   assert (forall A, A -> foo _ A). 2:trivial.
   Show.
diff --git a/test-suite/output/apply_with.out b/test-suite/output/apply_with.out
index 32e3c4a4f82a..de8e0ce35f98 100644
--- a/test-suite/output/apply_with.out
+++ b/test-suite/output/apply_with.out
@@ -1,18 +1,18 @@
-File "./output/apply_with.v", line 3, characters 11-26:
+File "./output/apply_with.v", line 4, characters 11-26:
 The command has indeed failed with message:
 No such bound variable d (possible names are: a, b and c).
-File "./output/apply_with.v", line 4, characters 11-26:
+File "./output/apply_with.v", line 5, characters 11-26:
 The command has indeed failed with message:
 Unable to find an instance for the variable b.
-File "./output/apply_with.v", line 5, characters 24-25:
+File "./output/apply_with.v", line 6, characters 24-25:
 The command has indeed failed with message:
 No such bound variable d (possible names are: a, b and c).
-File "./output/apply_with.v", line 6, characters 5-31:
+File "./output/apply_with.v", line 7, characters 5-31:
 The command has indeed failed with message:
 Unable to find an instance for the variables b, c.
-File "./output/apply_with.v", line 14, characters 23-24:
+File "./output/apply_with.v", line 16, characters 23-24:
 The command has indeed failed with message:
 No such bound variable c (possible names are: a and b).
-File "./output/apply_with.v", line 15, characters 5-16:
+File "./output/apply_with.v", line 17, characters 5-16:
 The command has indeed failed with message:
 Unable to find an instance for the variables a, b.
diff --git a/test-suite/output/apply_with.v b/test-suite/output/apply_with.v
index 827fa7a8267c..361737508ba8 100644
--- a/test-suite/output/apply_with.v
+++ b/test-suite/output/apply_with.v
@@ -1,5 +1,6 @@
 Axiom f : forall a b c, a + b = 0 -> c = 0.
 Goal 0 = 0.
+Proof.
 Fail apply f with (d := 0).
 Fail apply f with (a := 0).
 Fail rewrite <- f with (d := 0).
@@ -10,6 +11,7 @@ Qed.
 
 Axiom g : forall a b, S a = S b.
 Goal forall n, n = 0.
+Proof.
 intros n.
 Fail injection g with (c := 0).
 Fail injection g.
diff --git a/test-suite/output/auto.v b/test-suite/output/auto.v
index 08d3cdb514a4..5c8b019983ea 100644
--- a/test-suite/output/auto.v
+++ b/test-suite/output/auto.v
@@ -1,6 +1,7 @@
 (* testing info_*/debug auto/eauto *)
 
 Goal False \/ (True -> True).
+Proof.
 Succeed info_auto.
 Succeed debug auto.
 Succeed info_eauto.
@@ -8,5 +9,6 @@ debug eauto.
 Defined.
 
 Goal True.
+Proof.
 info_trivial.
 Defined.
diff --git a/test-suite/output/auto_order.out b/test-suite/output/auto_order.out
index c38488d7d714..9a2c2a389997 100644
--- a/test-suite/output/auto_order.out
+++ b/test-suite/output/auto_order.out
@@ -27,6 +27,6 @@ first
 fifth, different hintDb
 fourth
 third
-File "./output/auto_order.v", line 26, characters 5-45:
+File "./output/auto_order.v", line 27, characters 5-45:
 The command has indeed failed with message:
 Tactic failure: Proof search failed.
diff --git a/test-suite/output/auto_order.v b/test-suite/output/auto_order.v
index 26381f2fda05..8f8c4b740344 100644
--- a/test-suite/output/auto_order.v
+++ b/test-suite/output/auto_order.v
@@ -19,6 +19,7 @@ Hint Extern 1 => idtac "fifth, different hintDb"; fail : plus2.
 Print HintDb plus.
 
 Goal False.
+Proof.
 (* auto tries hintdbs in order, ignoring cost.
 the others apply cost across hintdbs *)
 info_auto with plus plus2 nocore.
diff --git a/test-suite/output/bug5778.out b/test-suite/output/bug5778.out
index b90ffd82a71f..9d6b9e7daaaf 100644
--- a/test-suite/output/bug5778.out
+++ b/test-suite/output/bug5778.out
@@ -1,4 +1,4 @@
-File "./output/bug5778.v", line 7, characters 7-11:
+File "./output/bug5778.v", line 8, characters 7-11:
 The command has indeed failed with message:
 The term "I" has type "True"
 which should be Set, Prop or Type.
diff --git a/test-suite/output/bug5778.v b/test-suite/output/bug5778.v
index 441e87af84bf..6bd16c94e519 100644
--- a/test-suite/output/bug5778.v
+++ b/test-suite/output/bug5778.v
@@ -4,5 +4,6 @@ Ltac b _ := a ().
 Ltac abs _ := abstract b ().
 Ltac c _ := abs ().
 Goal True.
+Proof.
   Fail c ().
 Abort.
diff --git a/test-suite/output/bug6404.out b/test-suite/output/bug6404.out
index b57b9934e88f..33c5126a276f 100644
--- a/test-suite/output/bug6404.out
+++ b/test-suite/output/bug6404.out
@@ -1,4 +1,4 @@
-File "./output/bug6404.v", line 7, characters 7-11:
+File "./output/bug6404.v", line 8, characters 7-11:
 The command has indeed failed with message:
 The term "I" has type "True"
 which should be Set, Prop or Type.
diff --git a/test-suite/output/bug6404.v b/test-suite/output/bug6404.v
index d9e5e20b6653..c9186f00f7b5 100644
--- a/test-suite/output/bug6404.v
+++ b/test-suite/output/bug6404.v
@@ -4,5 +4,6 @@ Ltac b _ := a ().
 Ltac abs _ := transparent_abstract b ().
 Ltac c _ := abs ().
 Goal True.
+Proof.
   Fail c ().
 Abort.
diff --git a/test-suite/output/bug_11608.out b/test-suite/output/bug_11608.out
index 793ff768d40b..074a66154abe 100644
--- a/test-suite/output/bug_11608.out
+++ b/test-suite/output/bug_11608.out
@@ -1 +1,7 @@
+File "./output/bug_11608.v", line 10, characters 4-40:
+Warning: This interactive proof is not started by the "Proof" command.
+[missing-proof-command,fragile,default]
+Quickfix:
+Replace File "./output/bug_11608.v", line 10, characters 4-4 with Proof.
+
 creating x without [Proof.]
diff --git a/test-suite/output/bug_13857.out b/test-suite/output/bug_13857.out
index 18abb4a0ba28..4d63a4a4fdb3 100644
--- a/test-suite/output/bug_13857.out
+++ b/test-suite/output/bug_13857.out
@@ -1,9 +1,9 @@
-File "./output/bug_13857.v", line 6, characters 13-16:
+File "./output/bug_13857.v", line 7, characters 13-16:
 The command has indeed failed with message:
 Unable to find an instance for the variable x.
-File "./output/bug_13857.v", line 7, characters 13-17:
+File "./output/bug_13857.v", line 8, characters 13-17:
 The command has indeed failed with message:
 Unable to unify "foo2" with "foo".
-File "./output/bug_13857.v", line 8, characters 13-17:
+File "./output/bug_13857.v", line 9, characters 13-17:
 The command has indeed failed with message:
 Unable to unify "foo3" with "foo".
diff --git a/test-suite/output/bug_13857.v b/test-suite/output/bug_13857.v
index 9578b18c6ef7..4fdaa6e64700 100644
--- a/test-suite/output/bug_13857.v
+++ b/test-suite/output/bug_13857.v
@@ -3,6 +3,7 @@ Inductive foo2 := Foo2 (x : nat).
 Inductive foo3 := Foo3 (f : foo2).
 
 Goal foo.
+Proof.
   Fail apply Foo.
   Fail apply Foo2.
   Fail apply Foo3.
diff --git a/test-suite/output/bug_14899.v b/test-suite/output/bug_14899.v
index 9355239296a8..b95fc83f7147 100644
--- a/test-suite/output/bug_14899.v
+++ b/test-suite/output/bug_14899.v
@@ -1,4 +1,5 @@
 Definition a : { x | 0 < x }.
+Proof.
   exists 3. eauto.
 Defined.
 
diff --git a/test-suite/output/bug_15106.v b/test-suite/output/bug_15106.v
index c971370850df..365aa73f7008 100644
--- a/test-suite/output/bug_15106.v
+++ b/test-suite/output/bug_15106.v
@@ -6,4 +6,7 @@ Axiom P : Prop. Axiom p : P.
 Program Definition foo := (fun (x : P) (y : True) => I) _ _.
 Fail Obligation 2.
 
-Obligation 1. exact p. Qed.
+Obligation 1.
+Proof.
+  exact p.
+Qed.
diff --git a/test-suite/output/bug_17372.out b/test-suite/output/bug_17372.out
index b96da0b6c40d..3af74abb0ba6 100644
--- a/test-suite/output/bug_17372.out
+++ b/test-suite/output/bug_17372.out
@@ -1,3 +1,3 @@
-File "./output/bug_17372.v", line 2, characters 13-16:
+File "./output/bug_17372.v", line 3, characters 13-16:
 The command has indeed failed with message:
 The reference bar was not found in the current environment.
diff --git a/test-suite/output/bug_17372.v b/test-suite/output/bug_17372.v
index a82059322d02..de80642e8038 100644
--- a/test-suite/output/bug_17372.v
+++ b/test-suite/output/bug_17372.v
@@ -1,3 +1,4 @@
 Goal Prop.
+Proof.
 Fail refine (bar (A := nat)).
 Abort.
diff --git a/test-suite/output/bug_17386.v b/test-suite/output/bug_17386.v
index 280c3eba5339..4c6e6531a1a3 100644
--- a/test-suite/output/bug_17386.v
+++ b/test-suite/output/bug_17386.v
@@ -1,4 +1,5 @@
 Goal True.
+Proof.
 evar (x:nat).
 pose (y:=1).
 let _ := constr:(eq_refl : x = 1) in idtac.
diff --git a/test-suite/output/bug_17594.out b/test-suite/output/bug_17594.out
index 3c378791af12..fb934f1c2117 100644
--- a/test-suite/output/bug_17594.out
+++ b/test-suite/output/bug_17594.out
@@ -2,47 +2,47 @@
 3
 2
 3
-File "./output/bug_17594.v", line 12, characters 19-20:
+File "./output/bug_17594.v", line 13, characters 19-20:
 The command has indeed failed with message:
 The term "0" has type "nat" while it is expected to have type "True".
 1
 3
 2
 3
-File "./output/bug_17594.v", line 17, characters 26-27:
+File "./output/bug_17594.v", line 18, characters 26-27:
 The command has indeed failed with message:
 The term "0" has type "nat" while it is expected to have type "True".
 1
 3
 2
 3
-File "./output/bug_17594.v", line 23, characters 19-20:
+File "./output/bug_17594.v", line 24, characters 19-20:
 The command has indeed failed with message:
 The term "0" has type "nat" while it is expected to have type "True".
 1
 3
 2
 3
-File "./output/bug_17594.v", line 28, characters 26-27:
+File "./output/bug_17594.v", line 29, characters 26-27:
 The command has indeed failed with message:
 The term "0" has type "nat" while it is expected to have type "True".
 1
 3
-File "./output/bug_17594.v", line 31, characters 2-106:
+File "./output/bug_17594.v", line 32, characters 2-106:
 The command has indeed failed with message:
 Uncaught Ltac2 exception: Match_failure
 1
 3
-File "./output/bug_17594.v", line 37, characters 2-113:
+File "./output/bug_17594.v", line 38, characters 2-113:
 The command has indeed failed with message:
 No matching clauses for match.
 1
 3
-File "./output/bug_17594.v", line 42, characters 2-119:
+File "./output/bug_17594.v", line 43, characters 2-119:
 The command has indeed failed with message:
 No matching clauses for match.
 1
 3
-File "./output/bug_17594.v", line 48, characters 2-119:
+File "./output/bug_17594.v", line 49, characters 2-119:
 The command has indeed failed with message:
 No matching clauses for match.
diff --git a/test-suite/output/bug_17594.v b/test-suite/output/bug_17594.v
index f46e2e5fde56..2d711a58540d 100644
--- a/test-suite/output/bug_17594.v
+++ b/test-suite/output/bug_17594.v
@@ -4,6 +4,7 @@ From Ltac2 Require Import Message.
 Ltac2 msg s := print (of_string s).
 
 Goal True.
+Proof.
   (* should be the exact error *)
   Fail multi_match! 'True with
     | True => msg "1"
diff --git a/test-suite/output/bug_18368.v b/test-suite/output/bug_18368.v
index 950df239d38c..de549354e34a 100644
--- a/test-suite/output/bug_18368.v
+++ b/test-suite/output/bug_18368.v
@@ -2,5 +2,6 @@ Tactic Notation (at level 4) "test" := idtac "A".
 Tactic Notation (at level 5) "test" := idtac "B".
 
 Goal True.
+Proof.
 test.
 Abort.
diff --git a/test-suite/output/bug_19138.v b/test-suite/output/bug_19138.v
index e8ba77411071..64cce835567f 100644
--- a/test-suite/output/bug_19138.v
+++ b/test-suite/output/bug_19138.v
@@ -2,6 +2,7 @@ From Ltac2 Require Import Ltac2 Constr.
 Import Constr.Unsafe.
 
 Goal True.
+Proof.
   let t := open_constr:(_ :> False) in
   match kind t with
   | Evar e _ => Control.new_goal e > [refine 'I|]
@@ -11,6 +12,7 @@ Goal True.
 Abort.
 
 Goal True.
+Proof.
   let t := unshelve open_constr:(_ :> False) in
   Control.extend [Control.shelve] (fun () => ()) [];
   match kind t with
diff --git a/test-suite/output/bug_21288.out b/test-suite/output/bug_21288.out
index 3d81633abf32..04dbead50214 100644
--- a/test-suite/output/bug_21288.out
+++ b/test-suite/output/bug_21288.out
@@ -1,5 +1,5 @@
 Ltac foo := (intuition idtac) || fail "boom"
 Ltac bar := intuition idtac || fail "baam"
-File "./output/bug_21288.v", line 12, characters 7-10:
+File "./output/bug_21288.v", line 13, characters 7-10:
 The command has indeed failed with message:
 Tactic failure: baam.
diff --git a/test-suite/output/bug_21288.v b/test-suite/output/bug_21288.v
index b57625a37237..0f17a63a93fc 100644
--- a/test-suite/output/bug_21288.v
+++ b/test-suite/output/bug_21288.v
@@ -7,6 +7,7 @@ Print Ltac foo.
 Print Ltac bar.
 
 Goal True -> 2 = 3.
+Proof.
   (* yet foo is not equivalent to bar ( "||" runs the second tactic if the first doesn't make progress) *)
   Succeed foo.
   Fail bar.
diff --git a/test-suite/output/bug_3810.v b/test-suite/output/bug_3810.v
index 906b0f37d479..78cbd558f969 100644
--- a/test-suite/output/bug_3810.v
+++ b/test-suite/output/bug_3810.v
@@ -1,6 +1,7 @@
 Class Foo.
 
 Fixpoint test (H : Foo) (n : nat) {A : Type} {struct n} : A.
+Proof.
 Admitted.
 
 About test.
diff --git a/test-suite/output/idtac.v b/test-suite/output/idtac.v
index ac60ea91759c..4ff7e65ea2b2 100644
--- a/test-suite/output/idtac.v
+++ b/test-suite/output/idtac.v
@@ -2,37 +2,46 @@
 
 Tactic Notation "myidtac" string(v) := idtac v.
 Goal True.
+Proof.
 myidtac "foo".
 Abort.
 
 Tactic Notation "myidtac2" ref(c) := idtac c.
 Goal True.
+Proof.
 myidtac2 True.
 Abort.
 
 Tactic Notation "myidtac3" preident(s) := idtac s.
 Goal True.
+Proof.
 myidtac3 foo.
 Abort.
 
 Tactic Notation "myidtac4" int_or_var(n) := idtac n.
 Goal True.
+Proof.
 myidtac4 3.
 Abort.
 
 Tactic Notation "myidtac5" ident(id) := idtac id.
 Goal True.
+Proof.
 myidtac5 foo.
 Abort.
 
 (* Checking non focussing of idtac for integers *)
-Goal True/\True. split.
+Goal True/\True.
+Proof.
+split.
 all:let c:=numgoals in idtac c.
 Abort.
 
 (* Checking printing of lists and its focussing *)
 Tactic Notation "myidtac6" constr_list(l) := idtac "<" l ">".
-Goal True/\True. split.
+Goal True/\True.
+Proof.
+split.
 all:myidtac6 True False Prop.
 (* An empty list is focussing because of interp_genarg of a constr *)
 (* even if it is not focussing on printing *)
@@ -40,6 +49,8 @@ all:myidtac6.
 Abort.
 
 Tactic Notation "myidtac7" int_list(l) := idtac "<<" l ">>".
-Goal True/\True. split.
+Goal True/\True.
+Proof.
+split.
 all:myidtac7 1 2 3.
 Abort.
diff --git a/test-suite/output/injection.out b/test-suite/output/injection.out
index f0c48c95efb8..555ef6872b61 100644
--- a/test-suite/output/injection.out
+++ b/test-suite/output/injection.out
@@ -1,6 +1,6 @@
-File "./output/injection.v", line 4, characters 39-42:
+File "./output/injection.v", line 5, characters 39-42:
 The command has indeed failed with message:
 Unexpected pattern.
-File "./output/injection.v", line 5, characters 35-42:
+File "./output/injection.v", line 6, characters 35-42:
 The command has indeed failed with message:
 Unexpected injection pattern.
diff --git a/test-suite/output/injection.v b/test-suite/output/injection.v
index bfd5a67bf549..c7015c5349a3 100644
--- a/test-suite/output/injection.v
+++ b/test-suite/output/injection.v
@@ -1,6 +1,7 @@
 (* Test error messages *)
 
 Goal forall x, (x,0) = (0, S x) -> x = 0.
+Proof.
 Fail intros x H; injection H as [= H'] H''.
 Fail intros x H; injection H as H' [= H''].
 intros x H; injection H as [= H' H''].
diff --git a/test-suite/output/ltac.out b/test-suite/output/ltac.out
index c6c2f7d97824..e60d33a1f27b 100644
--- a/test-suite/output/ltac.out
+++ b/test-suite/output/ltac.out
@@ -1,40 +1,40 @@
-File "./output/ltac.v", line 8, characters 13-31:
+File "./output/ltac.v", line 9, characters 13-31:
 The command has indeed failed with message:
 Ltac variable y depends on pattern variable name z which is not bound in current context.
 
 Ltac f x y z :=
   symmetry in x, y; auto with z; auto; intros; clearbody x;
    generalize dependent z
-File "./output/ltac.v", line 38, characters 5-9:
+File "./output/ltac.v", line 41, characters 5-9:
 The command has indeed failed with message:
 The term "I" has type "True" while it is expected to have type "False".
 In nested Ltac calls to "g1" and "refine (uconstr)", last call failed.
 
-File "./output/ltac.v", line 39, characters 5-9:
+File "./output/ltac.v", line 42, characters 5-9:
 The command has indeed failed with message:
 The term "I" has type "True" while it is expected to have type "False".
 In nested Ltac calls to "f1 (constr)" and "refine (uconstr)", last call
 failed.
 
-File "./output/ltac.v", line 40, characters 5-9:
+File "./output/ltac.v", line 43, characters 5-9:
 The command has indeed failed with message:
 The term "I" has type "True" while it is expected to have type "False".
 In nested Ltac calls to "g2 (constr)", "g1" and "refine (uconstr)", last call
 failed.
 
-File "./output/ltac.v", line 41, characters 5-9:
+File "./output/ltac.v", line 44, characters 5-9:
 The command has indeed failed with message:
 The term "I" has type "True" while it is expected to have type "False".
 In nested Ltac calls to "f2", "f1 (constr)" and "refine (uconstr)", last call
 failed.
 
-File "./output/ltac.v", line 46, characters 5-8:
+File "./output/ltac.v", line 50, characters 5-8:
 The command has indeed failed with message:
 No primitive equality found.
 In nested Ltac calls to "h" and "injection (destruction_arg)", last call
 failed.
 
-File "./output/ltac.v", line 48, characters 5-8:
+File "./output/ltac.v", line 52, characters 5-8:
 The command has indeed failed with message:
 No primitive equality found.
 In nested Ltac calls to "h" and "injection (destruction_arg)", last call
diff --git a/test-suite/output/ltac.v b/test-suite/output/ltac.v
index fcd5dd05f04a..2cfa2eec71a0 100644
--- a/test-suite/output/ltac.v
+++ b/test-suite/output/ltac.v
@@ -2,6 +2,7 @@ Set Ltac Backtrace.
 
 (* This used to refer to b instead of z sometimes between 8.4 and 8.5beta3 *)
 Goal True.
+Proof.
 Fail let T := constr:((fun a b : nat => a+b) 1 1) in
   lazymatch T with
   | (fun x z => ?y) 1 1
@@ -11,6 +12,7 @@ Abort.
 
 (* This should not raise a warning (see #4317) *)
 Goal True.
+Proof.
 assert (H:= eq_refl ((fun x => x) 1)).
 let HT := type of H in
 lazymatch goal with
@@ -35,6 +37,7 @@ Tactic Notation "g2" constr(x) := g1 x.
 Tactic Notation "f1" constr(x) := refine x.
 Ltac f2 x := f1 x.
 Goal False.
+Proof.
 Fail g1 I.
 Fail f1 I.
 Fail g2 I.
@@ -43,6 +46,7 @@ Abort.
 
 Ltac h x := injection x.
 Goal True -> False.
+Proof.
 Fail h I.
 intro H.
 Fail h H.
@@ -51,12 +55,15 @@ Abort.
 (* Check printing of the "var" argument "Hx" *)
 Ltac m H := idtac H; exact H.
 Goal True.
+Proof.
 let a:=constr:(let Hx := 0 in ltac:(m Hx)) in idtac.
 Abort.
 
 (* Check consistency of interpretation scopes (#4398) *)
 
-Goal nat*(0*0=0) -> nat*(0*0=0). intro.
+Goal nat*(0*0=0) -> nat*(0*0=0).
+Proof.
+intro.
 match goal with H: ?x*?y |- _ => idtac x end.
 match goal with |- ?x*?y => idtac x end.
 match goal with H: context [?x*?y] |- _ => idtac x end.
@@ -77,6 +84,7 @@ Print Ltac foo.
 (* Ltac renaming was not applied to "fix" and "cofix" *)
 
 Goal forall a, a = 0.
+Proof.
 match goal with
 |- (forall x, x = _) => assert (forall n, (fix x n := match n with O => O | S n => x n end) n = n)
 end.
diff --git a/test-suite/output/ltac2_bt.v b/test-suite/output/ltac2_bt.v
index 67e75f85c396..dcda47ce54c8 100644
--- a/test-suite/output/ltac2_bt.v
+++ b/test-suite/output/ltac2_bt.v
@@ -18,5 +18,6 @@ Ltac2 g () := print_stack ().
 Ltac2 h () := g ().
 
 Goal True.
+Proof.
   h ().
 Abort.
diff --git a/test-suite/output/ltac_missing_args.out b/test-suite/output/ltac_missing_args.out
index f08e9f855f56..f13c326b1bfa 100644
--- a/test-suite/output/ltac_missing_args.out
+++ b/test-suite/output/ltac_missing_args.out
@@ -1,39 +1,39 @@
-File "./output/ltac_missing_args.v", line 11, characters 2-11:
+File "./output/ltac_missing_args.v", line 12, characters 2-11:
 The command has indeed failed with message:
 The user-defined tactic "foo" was not fully applied:
 There is a missing argument for variable x,
 no arguments at all were provided.
 Ltac call to "foo" failed.
 
-File "./output/ltac_missing_args.v", line 12, characters 2-11:
+File "./output/ltac_missing_args.v", line 13, characters 2-11:
 The command has indeed failed with message:
 The user-defined tactic "bar" was not fully applied:
 There is a missing argument for variable x,
 no arguments at all were provided.
 Ltac call to "bar" failed.
 
-File "./output/ltac_missing_args.v", line 13, characters 2-16:
+File "./output/ltac_missing_args.v", line 14, characters 2-16:
 The command has indeed failed with message:
 The user-defined tactic "bar" was not fully applied:
 There is a missing argument for variable y and 1 more,
 1 argument was provided.
 Ltac call to "bar" failed.
 
-File "./output/ltac_missing_args.v", line 14, characters 2-11:
+File "./output/ltac_missing_args.v", line 15, characters 2-11:
 The command has indeed failed with message:
 The user-defined tactic "baz" was not fully applied:
 There is a missing argument for variable x,
 no arguments at all were provided.
 In nested Ltac calls to "baz" and "foo", last call failed.
 
-File "./output/ltac_missing_args.v", line 15, characters 2-11:
+File "./output/ltac_missing_args.v", line 16, characters 2-11:
 The command has indeed failed with message:
 The user-defined tactic "qux" was not fully applied:
 There is a missing argument for variable x,
 no arguments at all were provided.
 In nested Ltac calls to "qux" and "bar", last call failed.
 
-File "./output/ltac_missing_args.v", line 16, characters 2-36:
+File "./output/ltac_missing_args.v", line 17, characters 2-36:
 The command has indeed failed with message:
 The user-defined tactic "mydo" was not fully applied:
 There is a missing argument for variable _,
@@ -41,25 +41,25 @@ no arguments at all were provided.
 In nested Ltac calls to "mydo" and "tac" (bound to 
 fun _ _ => idtac), last call failed.
 
-File "./output/ltac_missing_args.v", line 17, characters 2-42:
+File "./output/ltac_missing_args.v", line 18, characters 2-42:
 The command has indeed failed with message:
 An unnamed user-defined tactic was not fully applied:
 There is a missing argument for variable _,
 no arguments at all were provided.
 
-File "./output/ltac_missing_args.v", line 18, characters 2-24:
+File "./output/ltac_missing_args.v", line 19, characters 2-24:
 The command has indeed failed with message:
 An unnamed user-defined tactic was not fully applied:
 There is a missing argument for variable _,
 no arguments at all were provided.
-File "./output/ltac_missing_args.v", line 19, characters 2-16:
+File "./output/ltac_missing_args.v", line 20, characters 2-16:
 The command has indeed failed with message:
 The user-defined tactic "rec" was not fully applied:
 There is a missing argument for variable x,
 no arguments at all were provided.
 In nested Ltac calls to "rec" and "rec", last call failed.
 
-File "./output/ltac_missing_args.v", line 20, characters 2-40:
+File "./output/ltac_missing_args.v", line 21, characters 2-40:
 The command has indeed failed with message:
 An unnamed user-defined tactic was not fully applied:
 There is a missing argument for variable x, 1 argument was provided.
diff --git a/test-suite/output/ltac_missing_args.v b/test-suite/output/ltac_missing_args.v
index e30c97aac664..b111d0616fcb 100644
--- a/test-suite/output/ltac_missing_args.v
+++ b/test-suite/output/ltac_missing_args.v
@@ -8,6 +8,7 @@ Ltac mydo tac := tac ().
 Ltac rec x := rec.
 
 Goal True.
+Proof.
   Fail foo.
   Fail bar.
   Fail bar True.
diff --git a/test-suite/output/names.v b/test-suite/output/names.v
index e9033bd73280..7856c5d4e13d 100644
--- a/test-suite/output/names.v
+++ b/test-suite/output/names.v
@@ -5,6 +5,7 @@ Parameter a : forall x, {y:nat|x=y}.
 Fail Definition b y : {x:nat|x=y} := a y.
 
 Goal (forall n m, n <= m -> m <= n -> n = m) -> True.
+Proof.
 intro H; epose proof (H _ 3) as H.
 Show.
 Abort.
diff --git a/test-suite/output/optimize_heap.v b/test-suite/output/optimize_heap.v
index 31b451039776..15c47e9d2e58 100644
--- a/test-suite/output/optimize_heap.v
+++ b/test-suite/output/optimize_heap.v
@@ -1,6 +1,7 @@
 (* optimize_heap should not affect the proof state *)
 
 Goal True.
+Proof.
   idtac.
   Show.
   optimize_heap.
diff --git a/test-suite/output/print_hintdb_metas.v b/test-suite/output/print_hintdb_metas.v
index 36410050537c..c35bb449d11d 100644
--- a/test-suite/output/print_hintdb_metas.v
+++ b/test-suite/output/print_hintdb_metas.v
@@ -1,4 +1,5 @@
 Theorem x : forall n m:nat, n = 1 /\ forall n : nat, n = m.
+Proof.
 Admitted.
 Create HintDb foo.
 Hint Resolve x : foo.
diff --git a/test-suite/output/rewrite_in_err.out b/test-suite/output/rewrite_in_err.out
index c32d4838f84d..16ae621c7149 100644
--- a/test-suite/output/rewrite_in_err.out
+++ b/test-suite/output/rewrite_in_err.out
@@ -1,3 +1,3 @@
-File "./output/rewrite_in_err.v", line 6, characters 7-23:
+File "./output/rewrite_in_err.v", line 7, characters 7-23:
 The command has indeed failed with message:
 Found no subterm matching "i" in H.
diff --git a/test-suite/output/rewrite_in_err.v b/test-suite/output/rewrite_in_err.v
index 85db8edbca32..3cc9022b8eac 100644
--- a/test-suite/output/rewrite_in_err.v
+++ b/test-suite/output/rewrite_in_err.v
@@ -3,6 +3,7 @@ Require Export Morphisms.
 Axiom T : nat -> Prop.
 
 Lemma test i j (Hle : i <= j) (H : T j) : T j.
+Proof.
   Fail rewrite Hle in H.
 (* The command has indeed failed with message:
    Found no subterm matching "i" in the current goal. *)
diff --git a/test-suite/output/set.v b/test-suite/output/set.v
index 0e745354ab3a..28737aadf6a4 100644
--- a/test-suite/output/set.v
+++ b/test-suite/output/set.v
@@ -1,4 +1,5 @@
 Goal let x:=O+O in x=x.
+Proof.
 intro.
 set (y1:=O) in (type of x).
 Show.
diff --git a/test-suite/output/sort_poly_elab.out b/test-suite/output/sort_poly_elab.out
index 9d36d74f87c4..12897bc7161c 100644
--- a/test-suite/output/sort_poly_elab.out
+++ b/test-suite/output/sort_poly_elab.out
@@ -775,12 +775,12 @@ Expands to: Constant sort_poly_elab.Inductives.Foo
 Declared in library sort_poly_elab, line 531, characters 13-16
 Foo@{Type Prop ; }
      : forall _ : FooNat@{Type ; }, FooNat@{Prop ; }
-File "./output/sort_poly_elab.v", line 539, characters 2-30:
+File "./output/sort_poly_elab.v", line 540, characters 2-30:
 The command has indeed failed with message:
 The quality constraints are inconsistent: cannot enforce Prop -> Type
 because it would identify Type and Prop which is inconsistent.
 This is introduced by the constraints Prop -> Type
-File "./output/sort_poly_elab.v", line 548, characters 2-30:
+File "./output/sort_poly_elab.v", line 549, characters 2-30:
 The command has indeed failed with message:
 The record R1 could not be defined as a primitive record because it has no
 projections. [non-primitive-record,records,default]
@@ -791,7 +791,7 @@ R2 is universe polymorphic
 R2 has primitive projections with eta conversion depending on sort instantiation.
 Arguments R2 A%_type_scope
 Expands to: Inductive sort_poly_elab.Records.R2
-Declared in library sort_poly_elab, line 550, characters 9-11
+Declared in library sort_poly_elab, line 551, characters 9-11
 R3@{α α0 ; u} :
 forall _ : Type@{α ; u}, Type@{α0 ; u}
 (* α α0 ; u |= α0 -> α *)
@@ -800,7 +800,7 @@ R3 is universe polymorphic
 R3 has primitive projections with eta conversion depending on sort instantiation.
 Arguments R3 A%_type_scope
 Expands to: Inductive sort_poly_elab.Records.R3
-Declared in library sort_poly_elab, line 554, characters 9-11
+Declared in library sort_poly_elab, line 555, characters 9-11
 R4@{s ; } : forall _ : Type@{s ; Set}, Type@{s ; Set}
 (* s ;  |=  *)
 
@@ -808,8 +808,8 @@ R4 is universe polymorphic
 R4 has primitive projections with eta conversion.
 Arguments R4 A%_type_scope
 Expands to: Inductive sort_poly_elab.Records.R4
-Declared in library sort_poly_elab, line 559, characters 9-11
-File "./output/sort_poly_elab.v", line 563, characters 2-49:
+Declared in library sort_poly_elab, line 560, characters 9-11
+File "./output/sort_poly_elab.v", line 564, characters 2-49:
 The command has indeed failed with message:
 The record R5 could not be defined as a primitive record because it is
 squashed. [non-primitive-record,records,default]
@@ -820,7 +820,7 @@ R5 is universe polymorphic
 R5@{α ; u} may only be eliminated to produce values whose type is SProp.
 Arguments R5 A%_type_scope
 Expands to: Inductive sort_poly_elab.Records.R5
-Declared in library sort_poly_elab, line 565, characters 11-13
+Declared in library sort_poly_elab, line 566, characters 11-13
 R6@{s ; } : forall _ : Type@{s ; Set}, Set
 (* s ;  |=  *)
 
@@ -828,7 +828,7 @@ R6 is universe polymorphic
 R6 has primitive projections with eta conversion.
 Arguments R6 A%_type_scope
 Expands to: Inductive sort_poly_elab.Records.R6
-Declared in library sort_poly_elab, line 570, characters 9-11
+Declared in library sort_poly_elab, line 571, characters 9-11
 fun (A : SProp) (x y : R6@{SProp ; } A) =>
 @eq_refl (Conversion.Box@{SProp Type ; sort_poly_elab.365} A)
   (Conversion.box@{SProp Type ; sort_poly_elab.365} A (R6f1 _ x))
@@ -841,7 +841,7 @@ fun (A : SProp) (x y : R6@{SProp ; } A) =>
          (Conversion.box@{SProp Type ; sort_poly_elab.365} A (R6f1 _ x))
          (Conversion.box@{SProp Type ; sort_poly_elab.365} A (R6f1 _ y))
 (* {sort_poly_elab.365} |=  *)
-File "./output/sort_poly_elab.v", line 576, characters 10-17:
+File "./output/sort_poly_elab.v", line 577, characters 10-17:
 The command has indeed failed with message:
 In environment
 A : Prop
@@ -860,7 +860,7 @@ while it is expected to have type
     (Conversion.box@{α380 Type ; sort_poly_elab.369} A (R6f1 _ y))"
 (cannot unify "Conversion.box@{α380 Type ; sort_poly_elab.369} A (R6f1 _ x)"
 and "Conversion.box@{α380 Type ; sort_poly_elab.369} A (R6f1 _ y)").
-File "./output/sort_poly_elab.v", line 578, characters 10-17:
+File "./output/sort_poly_elab.v", line 579, characters 10-17:
 The command has indeed failed with message:
 In environment
 A : SProp
@@ -891,7 +891,7 @@ R7@{α α0 ; u} may only be eliminated to produce values whose type is in sort q
   than the instantiation of α0.
 Arguments R7 A%_type_scope
 Expands to: Inductive sort_poly_elab.Records.R7
-Declared in library sort_poly_elab, line 581, characters 38-40
+Declared in library sort_poly_elab, line 582, characters 38-40
 R7f1@{α α0 ; u} :
 forall (A : Type@{α ; u}) (_ : R7@{α α0 ; u} A), A
 (* α α0 ; u |= α0 -> α *)
@@ -901,7 +901,7 @@ R7f1 is a projection of R7
 Arguments R7f1 A%_type_scope r
 R7f1 is transparent
 Expands to: Constant sort_poly_elab.Records.R7f1
-Declared in library sort_poly_elab, line 581, characters 55-59
+Declared in library sort_poly_elab, line 582, characters 55-59
 R7f2@{α α0 ; u} :
 forall (A : Type@{α ; u}) (_ : R7@{α α0 ; u} A), nat
 (* α α0 ; u |= α0 -> Type *)
@@ -911,7 +911,7 @@ R7f2 is a projection of R7
 Arguments R7f2 A%_type_scope r
 R7f2 is transparent
 Expands to: Constant sort_poly_elab.Records.R7f2
-Declared in library sort_poly_elab, line 581, characters 65-69
+Declared in library sort_poly_elab, line 582, characters 65-69
 Rsigma@{s ; u v} :
 forall (A : Type@{s ; u}) (_ : forall _ : A, Type@{s ; v}),
 Type@{s ; max(u,v)}
@@ -921,7 +921,7 @@ Rsigma is universe polymorphic
 Rsigma has primitive projections with eta conversion.
 Arguments Rsigma A%_type_scope B%_function_scope
 Expands to: Inductive sort_poly_elab.Records.Rsigma
-Declared in library sort_poly_elab, line 592, characters 9-15
+Declared in library sort_poly_elab, line 593, characters 9-15
 Rsigma_srect@{α α0 ; u u0 u1} :
 forall (A : Type@{α ; u}) (B : forall _ : A, Type@{α ; u0})
   (P : forall _ : Rsigma@{α ; u u0} A B, Type@{α0 ; u1})
@@ -934,7 +934,7 @@ Rsigma_srect is universe polymorphic
 Arguments Rsigma_srect A%_type_scope (B P H)%_function_scope s
 Rsigma_srect is transparent
 Expands to: Constant sort_poly_elab.Records.Rsigma_srect
-Declared in library sort_poly_elab, line 597, characters 13-25
+Declared in library sort_poly_elab, line 598, characters 13-25
 sexists@{α ; u} :
 forall (A : Type@{α ; u}) (_ : forall _ : A, Prop), Prop
 (* α ; u |=  *)
@@ -944,7 +944,7 @@ sexists@{α ; u} may only be eliminated to produce values whose type is SProp or
   unless instantiated such that the quality α is SProp or Prop.
 Arguments sexists A%_type_scope B%_function_scope
 Expands to: Inductive sort_poly_elab.Records.sexists
-Declared in library sort_poly_elab, line 611, characters 12-19
+Declared in library sort_poly_elab, line 612, characters 12-19
 sexists_ind@{Type ;
 sort_poly_elab.396}
      : forall (A : Type@{sort_poly_elab.396}) (B : forall _ : A, Prop)
@@ -962,7 +962,7 @@ R8@{α α0 ; u} may only be eliminated to produce values whose type is in sort q
   (SProp <= Prop <= Type, and all variables <= Type)
   than the instantiation of α.
 Expands to: Inductive sort_poly_elab.Records.R8
-Declared in library sort_poly_elab, line 621, characters 9-11
+Declared in library sort_poly_elab, line 622, characters 9-11
 R8f1@{α α0 ; u} :
 forall _ : R8@{α α0 ; u}, Type@{α0 ; u}
 (* α α0 ; u |= α -> Type *)
@@ -972,7 +972,7 @@ R8f1 is a projection of R8
 Arguments R8f1 r
 R8f1 is transparent
 Expands to: Constant sort_poly_elab.Records.R8f1
-Declared in library sort_poly_elab, line 622, characters 4-8
+Declared in library sort_poly_elab, line 623, characters 4-8
 R8f2@{α α0 ; u} :
 forall r : R8@{α α0 ; u}, R8f1@{α α0 ; u} r
 (* α α0 ; u |= α -> α0
@@ -983,7 +983,7 @@ R8f2 is a projection of R8
 Arguments R8f2 r
 R8f2 is transparent
 Expands to: Constant sort_poly_elab.Records.R8f2
-Declared in library sort_poly_elab, line 623, characters 4-8
+Declared in library sort_poly_elab, line 624, characters 4-8
 R9@{α α0 α1 ; } : Type@{α ; Set}
 (* α α0 α1 ;  |=  *)
 
@@ -994,7 +994,7 @@ R9@{α α0 α1 ; } may only be eliminated to produce values whose type is in sor
   (SProp <= Prop <= Type, and all variables <= Type)
   than the instantiation of α.
 Expands to: Inductive sort_poly_elab.Records.R9
-Declared in library sort_poly_elab, line 641, characters 9-11
+Declared in library sort_poly_elab, line 642, characters 9-11
 R9f1@{α α0 α1 ; } :
 forall _ : R9@{α α0 α1 ; }, bool@{α0 ; }
 (* α α0 α1 ;  |= α -> α0 *)
@@ -1004,7 +1004,7 @@ R9f1 is a projection of R9
 Arguments R9f1 r
 R9f1 is transparent
 Expands to: Constant sort_poly_elab.Records.R9f1
-Declared in library sort_poly_elab, line 642, characters 4-8
+Declared in library sort_poly_elab, line 643, characters 4-8
 R9f2@{α α0 α1 ; } :
 forall _ : R9@{α α0 α1 ; }, bool@{α1 ; }
 (* α α0 α1 ;  |= α -> α1 *)
@@ -1014,7 +1014,7 @@ R9f2 is a projection of R9
 Arguments R9f2 r
 R9f2 is transparent
 Expands to: Constant sort_poly_elab.Records.R9f2
-Declared in library sort_poly_elab, line 643, characters 4-8
+Declared in library sort_poly_elab, line 644, characters 4-8
 R10@{α α0 α1 α2 ; u u0} :
 forall _ : Type@{α0 ; u}, Type@{α ; max(Set,u,u0)}
 (* α α0 α1 α2 ; u u0 |=  *)
@@ -1027,7 +1027,7 @@ R10@{α α0 α1 α2 ; u u0} may only be eliminated to produce values whose type
   than the instantiation of α.
 Arguments R10 A%_type_scope
 Expands to: Inductive sort_poly_elab.Records.R10
-Declared in library sort_poly_elab, line 655, characters 9-12
+Declared in library sort_poly_elab, line 656, characters 9-12
 R10f1@{α α0 α1 α2 ; u u0} :
 forall (A : Type@{α0 ; u}) (_ : R10@{α α0 α1 α2 ; u u0} A), A
 (* α α0 α1 α2 ; u u0 |= α -> α0 *)
@@ -1037,7 +1037,7 @@ R10f1 is a projection of R10
 Arguments R10f1 A%_type_scope r
 R10f1 is transparent
 Expands to: Constant sort_poly_elab.Records.R10f1
-Declared in library sort_poly_elab, line 656, characters 4-9
+Declared in library sort_poly_elab, line 657, characters 4-9
 R10f2@{α α0 α1 α2 ; u u0} :
 forall (A : Type@{α0 ; u}) (r : R10@{α α0 α1 α2 ; u u0} A),
 @eq@{α0 α1 ; u u0} A (R10f1@{α α0 α1 α2 ; u u0} A r)
@@ -1050,7 +1050,7 @@ R10f2 is a projection of R10
 Arguments R10f2 A%_type_scope r
 R10f2 is transparent
 Expands to: Constant sort_poly_elab.Records.R10f2
-Declared in library sort_poly_elab, line 657, characters 4-9
+Declared in library sort_poly_elab, line 658, characters 4-9
 R10f3@{α α0 α1 α2 ; u u0} :
 forall (A : Type@{α0 ; u}) (_ : R10@{α α0 α1 α2 ; u u0} A), bool@{α2 ; }
 (* α α0 α1 α2 ; u u0 |= α -> α2 *)
@@ -1060,7 +1060,7 @@ R10f3 is a projection of R10
 Arguments R10f3 A%_type_scope r
 R10f3 is transparent
 Expands to: Constant sort_poly_elab.Records.R10f3
-Declared in library sort_poly_elab, line 658, characters 4-9
+Declared in library sort_poly_elab, line 659, characters 4-9
 R11@{α α0 α1 α2 α3 α4 α5 ; u} :
 Type@{α ; Set}
 (* α α0 α1 α2 α3 α4 α5 ; u |= α0 -> α3
@@ -1073,7 +1073,7 @@ R11@{α α0 α1 α2 α3 α4 α5 ; u} may only be eliminated to produce values wh
   (SProp <= Prop <= Type, and all variables <= Type)
   than the instantiation of α.
 Expands to: Inductive sort_poly_elab.Records.R11
-Declared in library sort_poly_elab, line 674, characters 9-12
+Declared in library sort_poly_elab, line 675, characters 9-12
 R11f1@{α α0 α1 α2 α3 α4 α5 ; u} :
 forall _ : R11@{α α0 α1 α2 α3 α4 α5 ; u}, bool@{α3 ; }
 (* α α0 α1 α2 α3 α4 α5 ; u |= α -> α3
@@ -1085,7 +1085,7 @@ R11f1 is a projection of R11
 Arguments R11f1 r
 R11f1 is transparent
 Expands to: Constant sort_poly_elab.Records.R11f1
-Declared in library sort_poly_elab, line 675, characters 4-9
+Declared in library sort_poly_elab, line 676, characters 4-9
 R11f2@{α α0 α1 α2 α3 α4 α5 ; u} :
 forall r : R11@{α α0 α1 α2 α3 α4 α5 ; u},
 let r0 : R10@{α0 α1 α2 α3 ; Set u} bool@{α1 ; } :=
@@ -1107,7 +1107,7 @@ R11f2 is a projection of R11
 Arguments R11f2 r
 R11f2 is transparent
 Expands to: Constant sort_poly_elab.Records.R11f2
-Declared in library sort_poly_elab, line 676, characters 4-9
+Declared in library sort_poly_elab, line 677, characters 4-9
 R11f3@{α α0 α1 α2 α3 α4 α5 ; u} :
 forall _ : R11@{α α0 α1 α2 α3 α4 α5 ; u}, bool@{α5 ; }
 (* α α0 α1 α2 α3 α4 α5 ; u |= α -> α5
@@ -1119,7 +1119,7 @@ R11f3 is a projection of R11
 Arguments R11f3 r
 R11f3 is transparent
 Expands to: Constant sort_poly_elab.Records.R11f3
-Declared in library sort_poly_elab, line 681, characters 4-9
+Declared in library sort_poly_elab, line 682, characters 4-9
 R12@{α α0 ; } : Type@{α ; Set}
 (* α α0 ;  |= α0 -> Type *)
 
@@ -1130,7 +1130,7 @@ R12@{α α0 ; } may only be eliminated to produce values whose type is in sort q
   (SProp <= Prop <= Type, and all variables <= Type)
   than the instantiation of α.
 Expands to: Inductive sort_poly_elab.Records.R12
-Declared in library sort_poly_elab, line 700, characters 9-12
+Declared in library sort_poly_elab, line 701, characters 9-12
 R12f1@{α α0 ; } :
 forall _ : R12@{α α0 ; }, bool@{α0 ; }
 (* α α0 ;  |= α -> α0
@@ -1141,7 +1141,7 @@ R12f1 is a projection of R12
 Arguments R12f1 r
 R12f1 is transparent
 Expands to: Constant sort_poly_elab.Records.R12f1
-Declared in library sort_poly_elab, line 701, characters 4-9
+Declared in library sort_poly_elab, line 702, characters 4-9
 R12f2@{α α0 ; } :
 forall r : R12@{α α0 ; },
 let f' : forall _ : nat, nat :=
@@ -1164,7 +1164,7 @@ R12f2 is a projection of R12
 Arguments R12f2 r
 R12f2 is transparent
 Expands to: Constant sort_poly_elab.Records.R12f2
-Declared in library sort_poly_elab, line 702, characters 4-9
+Declared in library sort_poly_elab, line 703, characters 4-9
 R13@{α α0 α1 α2 ; u u0} :
 Type@{α ; max(Set,u+1,u0+1)}
 (* α α0 α1 α2 ; u u0 |= α1 -> Type
@@ -1178,7 +1178,7 @@ R13@{α α0 α1 α2 ; u u0} may only be eliminated to produce values whose type
   (SProp <= Prop <= Type, and all variables <= Type)
   than the instantiation of α.
 Expands to: Inductive sort_poly_elab.Records.R13
-Declared in library sort_poly_elab, line 717, characters 9-12
+Declared in library sort_poly_elab, line 718, characters 9-12
 R13f1@{α α0 α1 α2 ; u u0} :
 forall _ : R13@{α α0 α1 α2 ; u u0}, Type@{α0 ; u}
 (* α α0 α1 α2 ; u u0 |= α -> Type
@@ -1191,7 +1191,7 @@ R13f1 is a projection of R13
 Arguments R13f1 r
 R13f1 is transparent
 Expands to: Constant sort_poly_elab.Records.R13f1
-Declared in library sort_poly_elab, line 718, characters 4-9
+Declared in library sort_poly_elab, line 719, characters 4-9
 R13f2@{α α0 α1 α2 ; u u0} :
 forall _ : R13@{α α0 α1 α2 ; u u0}, Type@{α0 ; u0}
 (* α α0 α1 α2 ; u u0 |= α -> Type
@@ -1204,7 +1204,7 @@ R13f2 is a projection of R13
 Arguments R13f2 r
 R13f2 is transparent
 Expands to: Constant sort_poly_elab.Records.R13f2
-Declared in library sort_poly_elab, line 719, characters 4-9
+Declared in library sort_poly_elab, line 720, characters 4-9
 R13f3@{α α0 α1 α2 ; u u0} :
 forall _ : R13@{α α0 α1 α2 ; u u0}, bool@{α1 ; }
 (* α α0 α1 α2 ; u u0 |= α -> α1
@@ -1217,7 +1217,7 @@ R13f3 is a projection of R13
 Arguments R13f3 r
 R13f3 is transparent
 Expands to: Constant sort_poly_elab.Records.R13f3
-Declared in library sort_poly_elab, line 720, characters 4-9
+Declared in library sort_poly_elab, line 721, characters 4-9
 R13f4@{α α0 α1 α2 ; u u0} :
 forall (r : R13@{α α0 α1 α2 ; u u0}) (b : bool@{α2 ; }),
 match b return Type@{α0 ; u} with
@@ -1240,7 +1240,7 @@ R13f4 is a projection of R13
 Arguments R13f4 r b
 R13f4 is transparent
 Expands to: Constant sort_poly_elab.Records.R13f4
-Declared in library sort_poly_elab, line 721, characters 4-9
+Declared in library sort_poly_elab, line 722, characters 4-9
 C1@{α α0 ; u} : forall _ : Type@{α ; u}, Type@{α0 ; u}
 (* α α0 ; u |=  *)
 
@@ -1252,7 +1252,7 @@ C1@{α α0 ; u} may only be eliminated to produce values whose type is in sort q
   than the instantiation of α0.
 Arguments C1 A%_type_scope
 Expands to: Inductive sort_poly_elab.Classes.C1
-Declared in library sort_poly_elab, line 756, characters 8-10
+Declared in library sort_poly_elab, line 757, characters 8-10
 C1f1@{α α0 ; u} :
 forall {A : Type@{α ; u}} {_ : C1@{α α0 ; u} A}, A
 (* α α0 ; u |= α0 -> α *)
@@ -1262,41 +1262,41 @@ C1f1 is a projection of C1
 Arguments C1f1 {A}%_type_scope {C1}
 C1f1 is transparent
 Expands to: Constant sort_poly_elab.Classes.C1f1
-Declared in library sort_poly_elab, line 757, characters 4-8
+Declared in library sort_poly_elab, line 758, characters 4-8
 C1I1@{α α0 ; u} : C1@{α α0 ; u} unit@{α ; u}
 (* α α0 ; u |=  *)
 
 C1I1 is universe polymorphic
 C1I1 is transparent
 Expands to: Constant sort_poly_elab.Classes.C1I1
-Declared in library sort_poly_elab, line 764, characters 11-15
+Declared in library sort_poly_elab, line 765, characters 11-15
 C1ProgramI1@{α α0 ; u} : C1@{α α0 ; u} unit@{α ; u}
 (* α α0 ; u |=  *)
 
 C1ProgramI1 is universe polymorphic
 C1ProgramI1 is transparent
 Expands to: Constant sort_poly_elab.Classes.C1ProgramI1
-Declared in library sort_poly_elab, line 767, characters 19-30
+Declared in library sort_poly_elab, line 768, characters 19-30
 C1RefineI1@{α α0 ; u} : C1@{α α0 ; u} unit@{α ; u}
 (* α α0 ; u |=  *)
 
 C1RefineI1 is universe polymorphic
 C1RefineI1 is transparent
 Expands to: Constant sort_poly_elab.Classes.C1RefineI1
-Declared in library sort_poly_elab, line 774, characters 11-21
+Declared in library sort_poly_elab, line 775, characters 11-21
 C1InteractiveI1@{α α0 ; u} : C1@{α α0 ; u} unit@{α ; u}
 (* α α0 ; u |=  *)
 
 C1InteractiveI1 is universe polymorphic
 C1InteractiveI1 is transparent
 Expands to: Constant sort_poly_elab.Classes.C1InteractiveI1
-Declared in library sort_poly_elab, line 779, characters 11-26
+Declared in library sort_poly_elab, line 781, characters 11-26
 C1AxiomaticI1@{α α0 ; u} : C1@{α α0 ; u} unit@{α ; u}
 (* α α0 ; u |=  *)
 
 C1AxiomaticI1 is universe polymorphic
 Expands to: Constant sort_poly_elab.Classes.C1AxiomaticI1
-Declared in library sort_poly_elab, line 783, characters 9-22
+Declared in library sort_poly_elab, line 785, characters 9-22
 C1InductiveI1@{α ; u} : Type@{α ; u}
 (* α ; u |=  *)
 
@@ -1307,8 +1307,8 @@ C1InductiveI1@{α ; u} may only be eliminated to produce values whose type is in
   (SProp <= Prop <= Type, and all variables <= Type)
   than the instantiation of α.
 Expands to: Inductive sort_poly_elab.Classes.C1InductiveI1
-Declared in library sort_poly_elab, line 787, characters 12-25
-File "./output/sort_poly_elab.v", line 796, characters 0-76:
+Declared in library sort_poly_elab, line 789, characters 12-25
+File "./output/sort_poly_elab.v", line 798, characters 0-76:
 The command has indeed failed with message:
 Sort metavariables must be collapsed to Type in universe monomorphic constructions.
 Attr@{α ; u} : Type@{α ; u}
@@ -1321,4 +1321,4 @@ Attr@{α ; u} may only be eliminated to produce values whose type is in sort qua
   (SProp <= Prop <= Type, and all variables <= Type)
   than the instantiation of α.
 Expands to: Inductive sort_poly_elab.Attr
-Declared in library sort_poly_elab, line 800, characters 10-14
+Declared in library sort_poly_elab, line 802, characters 10-14
diff --git a/test-suite/output/sort_poly_elab.v b/test-suite/output/sort_poly_elab.v
index b5a87eb0b567..27bfb01eafb8 100644
--- a/test-suite/output/sort_poly_elab.v
+++ b/test-suite/output/sort_poly_elab.v
@@ -529,6 +529,7 @@ Module Inductives.
   About FooNat.
 
   Definition Foo (n : FooNat) : FooNat.
+  Proof.
     destruct n.
     - exact FO.
     - exact FO.
@@ -772,6 +773,7 @@ Module Classes.
 
   #[refine]
   Instance C1RefineI1 : C1 unit := { C1f1 := _ }.
+  Proof.
   exact tt.
   Defined.
   About C1RefineI1.
diff --git a/test-suite/output/ssr_error_multiple_intro_after_case.out b/test-suite/output/ssr_error_multiple_intro_after_case.out
index d7bc9cf79635..82f9ab706b95 100644
--- a/test-suite/output/ssr_error_multiple_intro_after_case.out
+++ b/test-suite/output/ssr_error_multiple_intro_after_case.out
@@ -1,3 +1,3 @@
-File "./output/ssr_error_multiple_intro_after_case.v", line 3, characters 5-16:
+File "./output/ssr_error_multiple_intro_after_case.v", line 4, characters 5-16:
 The command has indeed failed with message:
 x already used
diff --git a/test-suite/output/ssr_error_multiple_intro_after_case.v b/test-suite/output/ssr_error_multiple_intro_after_case.v
index b3a078fdfda7..dc2ba241c0bc 100644
--- a/test-suite/output/ssr_error_multiple_intro_after_case.v
+++ b/test-suite/output/ssr_error_multiple_intro_after_case.v
@@ -1,4 +1,5 @@
 Require Import ssreflect.
 Goal forall p : nat * nat , True.
+Proof.
 Fail case => x x.
 Abort.
diff --git a/test-suite/output/ssr_explain_match.out b/test-suite/output/ssr_explain_match.out
index 3f967402d940..36792fd3ff07 100644
--- a/test-suite/output/ssr_explain_match.out
+++ b/test-suite/output/ssr_explain_match.out
@@ -50,6 +50,6 @@ instance: (addnC z (x + y)) matches: (x + y + z)
 instance: (addnC y x) matches: (x + y)
 instance: (addnC y x) matches: (x + y)
 END INSTANCES
-File "./output/ssr_explain_match.v", line 22, characters 5-38:
+File "./output/ssr_explain_match.v", line 23, characters 5-38:
 The command has indeed failed with message:
 Not supported
diff --git a/test-suite/output/ssr_explain_match.v b/test-suite/output/ssr_explain_match.v
index 38725eae462d..73e8c15c8e46 100644
--- a/test-suite/output/ssr_explain_match.v
+++ b/test-suite/output/ssr_explain_match.v
@@ -14,6 +14,7 @@ Require Import ssreflect ssrbool TestSuite.ssr_mini_mathcomp.
 Definition addnAC := (addnA, addnC).
 
 Lemma test x y z : x + y + z =  x + y.
+Proof.
 
 ssrinstancesoftpat (_ + _).
 ssrinstancesofruleL2R addnC.
diff --git a/test-suite/output/ssr_under.v b/test-suite/output/ssr_under.v
index d100488d0abb..1b4179fbef2a 100644
--- a/test-suite/output/ssr_under.v
+++ b/test-suite/output/ssr_under.v
@@ -10,6 +10,7 @@ Axiom eq_G :
 Ltac show := match goal with [|-?g] => idtac g end.
 
 Lemma example_G (n : nat) : G (fun n => n - n) n >= 0.
+Proof.
 under eq_G => m do [show; rw subnn].
 show.
 Abort.
diff --git a/test-suite/output/subst.v b/test-suite/output/subst.v
index b64d012c521c..b4058a75c6ac 100644
--- a/test-suite/output/subst.v
+++ b/test-suite/output/subst.v
@@ -7,6 +7,7 @@ Abbreviation goal :=
 Ltac do_intros := intros * Hx Hy Hz H1 HA H2 H3 HB H4.
 
 Goal goal.
+Proof.
 do_intros.
 (* From now on, the order after subst is consistently H1, HA, H2, H3, HB, H4 *)
 subst x.
@@ -15,6 +16,7 @@ Show.
 Abort.
 
 Goal goal.
+Proof.
 do_intros.
 subst y.
 (* In 8.4 or 8.5 without regular subst tactic mode, the order was H1, HA, H2, HB, H4, H3 *)
@@ -22,6 +24,7 @@ Show.
 Abort.
 
 Goal goal.
+Proof.
 do_intros.
 subst z.
 (* In 8.4 or 8.5 without regular subst tactic mode, the order was H1, HA, H2, H3, HB, H4 *)
@@ -29,6 +32,7 @@ Show.
 Abort.
 
 Goal goal.
+Proof.
 do_intros.
 subst.
 (* In 8.4 or 8.5 without regular subst tactic mode, the order was HA, HB, H4, H3, H1, H2 *)
diff --git a/test-suite/output/unidecls.out b/test-suite/output/unidecls.out
index 0b9de40d4574..5ee18fc43a01 100644
--- a/test-suite/output/unidecls.out
+++ b/test-suite/output/unidecls.out
@@ -46,14 +46,14 @@ The command has indeed failed with message:
 Undeclared universe A.u.
 Type@{Arg.u}
      : Type@{Arg.u+1}
-File "./output/unidecls.v", line 79, characters 59-60:
+File "./output/unidecls.v", line 81, characters 15-16:
 The command has indeed failed with message:
 In environment
 A : Type@{v}
 The term "A" has type "Type@{v}" while it is expected to have type
  "Type@{Arg.u}"
 (universe inconsistency: Cannot enforce v <= Arg.u because Arg.u < v).
-File "./output/unidecls.v", line 93, characters 17-24:
+File "./output/unidecls.v", line 96, characters 17-24:
 The command has indeed failed with message:
 Undeclared universe FnApp.v.
 Type@{Fn.v}
@@ -62,14 +62,14 @@ FnApp.foo
      : Type@{Fn.v}
 FnApp.bar
      : Type@{Arg.u}
-File "./output/unidecls.v", line 99, characters 17-26:
+File "./output/unidecls.v", line 102, characters 17-26:
 The command has indeed failed with message:
 Undeclared universe ArgImpl.u.
 FnApp2.foo
      : Type@{Fn.v}
 FnApp2.bar
      : Type@{Arg.u}
-File "./output/unidecls.v", line 113, characters 17-21:
+File "./output/unidecls.v", line 116, characters 17-21:
 The command has indeed failed with message:
 Undeclared universe: poly.
 Set < nat_rect.u0
diff --git a/test-suite/output/unidecls.v b/test-suite/output/unidecls.v
index 64adb338a5e2..a6f14c270cf5 100644
--- a/test-suite/output/unidecls.v
+++ b/test-suite/output/unidecls.v
@@ -76,7 +76,10 @@ Module Fn(A : Arg).
   Definition foo : Type@{v} := nat.
   Definition bar : Type@{Arg.u} := nat.
 
-  Definition foo'(A : Type@{v}) : Type@{Arg.u}. Fail exact A. Abort.
+  Definition foo'(A : Type@{v}) : Type@{Arg.u}.
+  Proof.
+    Fail exact A.
+  Abort.
 End Fn.
 
 Module ArgImpl : Arg.
diff --git a/test-suite/output/unifconstraints.out b/test-suite/output/unifconstraints.out
index a75f64ef7402..df92677f073f 100644
--- a/test-suite/output/unifconstraints.out
+++ b/test-suite/output/unifconstraints.out
@@ -59,7 +59,7 @@ unification constraint:
    True /\ True /\ True \/
    veeryyyyyyyyyyyyloooooooooooooonggidentifier =
    veeryyyyyyyyyyyyloooooooooooooonggidentifier
-File "./output/unifconstraints.v", line 29, characters 56-57:
+File "./output/unifconstraints.v", line 31, characters 56-57:
 The command has indeed failed with message:
 In environment
 P : nat -> Type
@@ -68,6 +68,6 @@ h : P x
 Unable to unify "P x" with "?P x"
 (unable to find a well-typed instantiation for "?P": cannot ensure that
 "nat -> Type" is a subtype of "nat -> Prop").
-File "./output/unifconstraints.v", line 37, characters 5-15:
+File "./output/unifconstraints.v", line 40, characters 5-15:
 The command has indeed failed with message:
 Tactic failure: congruence failed (cannot build a well-typed proof).
diff --git a/test-suite/output/unifconstraints.v b/test-suite/output/unifconstraints.v
index 96af0bac85b2..047e575bab99 100644
--- a/test-suite/output/unifconstraints.v
+++ b/test-suite/output/unifconstraints.v
@@ -5,6 +5,7 @@ Axiom veeryyyyyyyyyyyyloooooooooooooonggidentifier : nat.
 Goal True /\ True /\ True \/
              veeryyyyyyyyyyyyloooooooooooooonggidentifier =
              veeryyyyyyyyyyyyloooooooooooooonggidentifier.
+Proof.
   refine (nat_rect _ _ _ _).
   Show.
 Admitted.
@@ -13,6 +14,7 @@ Set Printing Existential Instances.
 Goal forall n m : nat, True /\ True /\ True \/
                         veeryyyyyyyyyyyyloooooooooooooonggidentifier =
                         veeryyyyyyyyyyyyloooooooooooooonggidentifier.
+Proof.
   intros.
   refine (nat_rect _ _ _ _).
   Show.
@@ -34,6 +36,7 @@ Set Universe Polymorphism.
 Section S.
 Polymorphic Universes i j.
 Goal Type@{i} -> (Type@{j} : Type@{i}).
+Proof.
 Fail congruence.
 Abort.
 End S.
diff --git a/test-suite/output/unification.v b/test-suite/output/unification.v
index 98ee190f3137..48fb03dc7526 100644
--- a/test-suite/output/unification.v
+++ b/test-suite/output/unification.v
@@ -16,18 +16,21 @@ End A.
 (* Choice of evar names *)
 
 Goal (forall x, S (S (S x)) = x) -> exists x, S x = 0.
+Proof.
 eexists.
 rewrite H.
 Show.
 Abort.
 
 Goal (forall x, S (S (S x)) = x) -> exists x, S x = 0.
+Proof.
 eexists ?[x].
 rewrite H.
 Show.
 Abort.
 
 Goal (forall x, S (S (S x)) = x) -> exists x, S x = 0.
+Proof.
 eexists ?[y].
 rewrite H.
 Show.
@@ -37,6 +40,7 @@ Qed.
 (* Preserve the name if there is one *)
 
 Goal (forall x, S x = x) -> exists x, S x = 0.
+Proof.
 eexists ?[y].
 rewrite H.
 Show.
diff --git a/theories/Corelib/Floats/FloatAxioms.v b/theories/Corelib/Floats/FloatAxioms.v
index 732244044245..e73c54edffce 100644
--- a/theories/Corelib/Floats/FloatAxioms.v
+++ b/theories/Corelib/Floats/FloatAxioms.v
@@ -29,11 +29,18 @@ Axiom SF2Prim_Prim2SF : forall x, SF2Prim (Prim2SF x) = x.
 Axiom Prim2SF_SF2Prim : forall x, valid_binary x = true -> Prim2SF (SF2Prim x) = x.
 
 Theorem Prim2SF_inj : forall x y, Prim2SF x = Prim2SF y -> x = y.
+Proof.
   intros. rewrite <- SF2Prim_Prim2SF. symmetry. rewrite <- SF2Prim_Prim2SF. now rewrite H.
 Qed.
 
 Theorem SF2Prim_inj : forall x y, SF2Prim x = SF2Prim y -> valid_binary x = true -> valid_binary y = true -> x = y.
-  intros. rewrite <- Prim2SF_SF2Prim by assumption. symmetry. rewrite <- Prim2SF_SF2Prim by assumption. rewrite H. reflexivity.
+Proof.
+  intros.
+  rewrite <- Prim2SF_SF2Prim by assumption.
+  symmetry.
+  rewrite <- Prim2SF_SF2Prim by assumption.
+  rewrite H.
+  reflexivity.
 Qed.
 
 Axiom opp_spec : forall x, Prim2SF (-x)%float = SFopp (Prim2SF x).
diff --git a/theories/Corelib/Init/Logic.v b/theories/Corelib/Init/Logic.v
index ff3f97dc9a18..b77c74682be1 100644
--- a/theories/Corelib/Init/Logic.v
+++ b/theories/Corelib/Init/Logic.v
@@ -464,6 +464,7 @@ Section Logic_lemmas.
 
   Definition eq_ind_r :
     forall (A:Type) (x:A) (P:A -> Prop), P x -> forall y:A, y = x -> P y.
+  Proof.
     intros A x P H y H0. elim eq_sym with (1 := H0); assumption.
   Defined.
 
@@ -472,11 +473,13 @@ Section Logic_lemmas.
 
   Definition eq_rec_r :
     forall (A:Type) (x:A) (P:A -> Set), P x -> forall y:A, y = x -> P y.
+  Proof.
     intros A x P H y H0; elim eq_sym with (1 := H0); assumption.
   Defined.
 
   Definition eq_rect_r :
     forall (A:Type) (x:A) (P:A -> Type), P x -> forall y:A, y = x -> P y.
+  Proof.
     intros A x P H y H0; elim eq_sym with (1 := H0); assumption.
   Defined.
 
diff --git a/theories/Corelib/Init/Wf.v b/theories/Corelib/Init/Wf.v
index 38ccd33200e3..83f451697807 100644
--- a/theories/Corelib/Init/Wf.v
+++ b/theories/Corelib/Init/Wf.v
@@ -36,7 +36,8 @@ Section Well_founded.
  Register Acc as core.wf.acc.
 
  Lemma Acc_inv : forall x:A, Acc x -> forall y:A, R y x -> Acc y.
-  destruct 1; trivial.
+ Proof.
+   destruct 1; trivial.
  Defined.
 
  Global Arguments Acc_inv [x] _ [y] _, [x] _ y _.
diff --git a/theories/Corelib/ssr/ssrbool.v b/theories/Corelib/ssr/ssrbool.v
index a1d23ba841a8..b1a0d6914aab 100644
--- a/theories/Corelib/ssr/ssrbool.v
+++ b/theories/Corelib/ssr/ssrbool.v
@@ -733,7 +733,8 @@ Proof. by case; [apply: introT | apply: introF]. Qed.
 
 Lemma decPcases : if b then P else ~ P. Proof. by case Pb. Qed.
 
-Definition decP : decidable P. by case: b decPcases; [left | right]. Defined.
+Definition decP : decidable P.
+Proof. by case: b decPcases; [left | right]. Defined.
 
 Lemma rwP : P <-> b. Proof. by split; [apply: introT | apply: elimT]. Qed.
 
diff --git a/vernac/declare.ml b/vernac/declare.ml
index 1bf87833a2de..c33cba13fd5e 100644
--- a/vernac/declare.ml
+++ b/vernac/declare.ml
@@ -1783,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) *)
@@ -1818,6 +1822,10 @@ 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
@@ -1838,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
@@ -1863,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
@@ -2587,6 +2597,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 3f107286215c..5fbf778a6368 100644
--- a/vernac/declare.mli
+++ b/vernac/declare.mli
@@ -268,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/vernacentries.ml b/vernac/vernacentries.ml
index d093c77a4f4c..9ec221c16c27 100644
--- a/vernac/vernacentries.ml
+++ b/vernac/vernacentries.ml
@@ -2626,12 +2626,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
@@ -2740,7 +2751,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)
 
@@ -3008,7 +3019,7 @@ let translate_pure_vernac ?loc ~atts v = let open Vernactypes in match v with
         unsupported_attributes atts;
         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)
 
@@ -3018,7 +3029,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/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

From 58360cb5d087672418e1c9cfb516fe98cd56782a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Wed, 29 Apr 2026 12:18:14 +0200
Subject: [PATCH 442/578] Add coqargs to dune-dbg -I

---
 dev/dune-dbg.in | 6 +++++-
 1 file changed, 5 insertions(+), 1 deletion(-)

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 "$@"

From dfb9aa7d02eb4c0e156d747bd79862808e562ff4 Mon Sep 17 00:00:00 2001
From: Yann Leray <yann.leray@inria.fr>
Date: Tue, 28 Apr 2026 18:01:01 +0200
Subject: [PATCH 443/578] Remove double universe substitution in branches

---
 dev/doc/critical-bugs.md    | 14 ++++++++++++++
 kernel/cClosure.ml          |  1 -
 test-suite/bugs/bug_21970.v |  8 ++++++++
 3 files changed, 22 insertions(+), 1 deletion(-)
 create mode 100644 test-suite/bugs/bug_21970.v

diff --git a/dev/doc/critical-bugs.md b/dev/doc/critical-bugs.md
index d263ad98207b..6f1cf768760f 100644
--- a/dev/doc/critical-bugs.md
+++ b/dev/doc/critical-bugs.md
@@ -53,6 +53,7 @@ This file recollects knowledge about critical bugs found in Coq since version 8.
       - [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)
@@ -613,6 +614,19 @@ fix.
   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
diff --git a/kernel/cClosure.ml b/kernel/cClosure.ml
index ce7ad0d8e58b..825e4bb79eae 100644
--- a/kernel/cClosure.ml
+++ b/kernel/cClosure.ml
@@ -929,7 +929,6 @@ let get_branch infos ci pms cterm br e =
       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
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")." *)

From d737b5e711b8b364624f054e20f4acccee4ac1c5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Thu, 23 Apr 2026 09:52:08 +0200
Subject: [PATCH 444/578] Use Unix file descriptors rather than OCaml channels
 in rocqdep.

OCaml channels have a built-in buffer that happens to be useless in our
case, since lexbuf internals always read the data into its own buffer.
Such implicit buffers are not great for memory consumption and tend in
particular to live too long because they are custom blocks. We solve
this by reading from the raw unix descriptor instead.
---
 tools/coqdep/lib/common.ml | 14 ++++++++++++--
 1 file changed, 12 insertions(+), 2 deletions(-)

diff --git a/tools/coqdep/lib/common.ml b/tools/coqdep/lib/common.ml
index 5dad3252a430..fd15ba00dc2c 100644
--- a/tools/coqdep/lib/common.ml
+++ b/tools/coqdep/lib/common.ml
@@ -158,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;
@@ -191,13 +201,13 @@ 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 ->
+  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 = Lexing.from_channel ~with_positions:false chan in
+  let buf = lexbuf_from_descr ~with_positions:false chan in
   let open Lexer in
   let rec loop () =
     match coq_action buf with

From 4185712c331aa5037e1f6921f40b7abf4690f36e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Sat, 25 Apr 2026 13:03:14 +0200
Subject: [PATCH 445/578] Faster skip_to_dot in rocqdep lexer.

This function is performance critical for rocqdep parsing, as it reads
most file contents except for Require data. The ocamllex generated function
is not very efficient for this kind of dumb code, as it relies on a transition
table and performs lexing on a per-character basis.

We implement our own hand-writter lexer for this function, which tries to be
as fast as possible by gobbling up all non-special characters in a single run
without trying to refill the buffer. We could probably do better by exploiting
SIMD instructions but OCaml does not seem to be able to generate this kind of
code.
---
 tools/coqdep/lib/lexer.mll | 28 ++++++++++++++++++++++++++++
 1 file changed, 28 insertions(+)

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 { () }

From 77fcac6addcfce6a3ffc9139db22209a9e61a781 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Sun, 26 Apr 2026 20:31:59 +0200
Subject: [PATCH 446/578] Small optimization in rocqdep.

We extrude a costly file creation outside of a loop.
---
 tools/coqdep/lib/loadpath.ml | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/tools/coqdep/lib/loadpath.ml b/tools/coqdep/lib/loadpath.ml
index 8dca3438e4e0..e7fbec376c91 100644
--- a/tools/coqdep/lib/loadpath.ml
+++ b/tools/coqdep/lib/loadpath.ml
@@ -195,10 +195,8 @@ let get_worker_path st =
     w
 
 let singleton f =
-  let f = Filename.make f in
   { point = f; files = FileSet.singleton f }
 let add_set f l =
-  let f = Filename.make f in
   { point = f; files = FileSet.add f l.files }
 
 let insert_key root (full,f) m =
@@ -245,6 +243,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
 

From 8981506c0d479fcd5306e0836f74d810f4b38ce0 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Mon, 27 Apr 2026 19:16:37 +0200
Subject: [PATCH 447/578] Do not create intermediate lists in rocqdep directory
 traversal.

This is bad algorithmics as list concatenation is O(n) and we only need
the resulting list for iteration. Instead, we use an ad-hoc tree datatype
to store the result in O(1).
---
 tools/coqdep/lib/loadpath.ml | 19 +++++++++++++++----
 1 file changed, 15 insertions(+), 4 deletions(-)

diff --git a/tools/coqdep/lib/loadpath.ml b/tools/coqdep/lib/loadpath.ml
index e7fbec376c91..067a9d3a85a6 100644
--- a/tools/coqdep/lib/loadpath.ml
+++ b/tools/coqdep/lib/loadpath.ml
@@ -75,18 +75,29 @@ 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 rec aux phys_dir log_dir =
     if System.exists_dir phys_dir then
       let () = register_dir_logpath phys_dir log_dir in
       let curdirfiles = ref [] in
-      let subdirfiles = 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 := !subdirfiles @ nsubdirfiles @ ncurdirfiles
+          subdirfiles := SubNode (!subdirfiles, nsubdirfiles, ncurdirfiles)
       | System.FileRegular f ->
         curdirfiles := (phys_dir, log_dir, f) :: !curdirfiles
       in
@@ -94,10 +105,10 @@ let add_directory recur add_file phys_dir log_dir =
       (!curdirfiles, !subdirfiles)
     else
       let () = System.warn_cannot_open_dir phys_dir in
-      ([], [])
+      ([], SubEmpty)
   in
   let (curdirfiles, subdirfiles) = aux phys_dir log_dir in
-  List.iter (fun (phys_dir, log_dir, f) -> add_file root phys_dir log_dir f) subdirfiles;
+  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

From 8282a0c6c50eef65efb33e809db60e4bd7fd0be6 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Mon, 27 Apr 2026 22:08:29 +0200
Subject: [PATCH 448/578] Do not create intermediate strings in rocqdep
 makefile printing.

These are costly for no good reason, since we immediately print them
after allocation.
---
 tools/coqdep/lib/makefile.ml | 39 +++++++++++++++++++++++-------------
 1 file changed, 25 insertions(+), 14 deletions(-)

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 "%!"

From 88aa5b09f94a992c1c2f148cc2d5ebfb61a5559a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Tue, 28 Apr 2026 16:53:35 +0200
Subject: [PATCH 449/578] Move number notation declarations to their respective
 modules instead of Prelude

---
 .../11-corelib/21971-number-nota-Changed.rst  |  4 +++
 theories/Corelib/Init/Byte.v                  |  2 --
 theories/Corelib/Init/Decimal.v               |  2 ++
 theories/Corelib/Init/Nat.v                   | 10 +++++++
 theories/Corelib/Init/Number.v                | 12 +++++++++
 theories/Corelib/Init/Prelude.v               | 26 +++----------------
 6 files changed, 32 insertions(+), 24 deletions(-)
 create mode 100644 doc/changelog/11-corelib/21971-number-nota-Changed.rst

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 <https://github.com/rocq-prover/rocq/pull/21971>`_,
+  by Gaëtan Gilbert).
diff --git a/theories/Corelib/Init/Byte.v b/theories/Corelib/Init/Byte.v
index 10e95d555ae5..a6e6410bacce 100644
--- a/theories/Corelib/Init/Byte.v
+++ b/theories/Corelib/Init/Byte.v
@@ -16,8 +16,6 @@ Require Import Corelib.Init.Logic.
 Require Import Corelib.Init.Specif.
 Require Corelib.Init.Nat.
 
-Declare ML Module "rocq-runtime.plugins.number_string_notation".
-
 (** We define an inductive for use with the [String Notation] command
     which contains all ascii characters.  We use 256 constructors for
     efficiency and ease of conversion. *)
diff --git a/theories/Corelib/Init/Decimal.v b/theories/Corelib/Init/Decimal.v
index 5cb5216e271d..6fbfa8516b28 100644
--- a/theories/Corelib/Init/Decimal.v
+++ b/theories/Corelib/Init/Decimal.v
@@ -18,6 +18,8 @@
 
 Require Import Datatypes Specif.
 
+Declare ML Module "rocq-runtime.plugins.number_string_notation".
+
 (** Unsigned integers are just lists of digits.
     For instance, ten is (D1 (D0 Nil)) *)
 
diff --git a/theories/Corelib/Init/Nat.v b/theories/Corelib/Init/Nat.v
index eab6f8dc7d2b..a2a4f6b023f4 100644
--- a/theories/Corelib/Init/Nat.v
+++ b/theories/Corelib/Init/Nat.v
@@ -425,3 +425,13 @@ Definition land a b := bitwise andb a a b.
 Definition lor a b := bitwise orb (max a b) a b.
 Definition ldiff a b := bitwise (fun b b' => andb b (negb b')) a a b.
 Definition lxor a b := bitwise xorb (max a b) a b.
+
+Arguments of_hex_uint d%_hex_uint_scope.
+Arguments of_hex_int d%_hex_int_scope.
+Arguments of_uint d%_dec_uint_scope.
+Arguments of_int d%_dec_int_scope.
+
+Module Export NumberNotations.
+  Number Notation nat of_num_uint to_num_hex_uint (abstract after 5000) : hex_nat_scope.
+  Number Notation nat of_num_uint to_num_uint (abstract after 5000) : nat_scope.
+End NumberNotations.
diff --git a/theories/Corelib/Init/Number.v b/theories/Corelib/Init/Number.v
index 741a8d4d8731..745870e316e5 100644
--- a/theories/Corelib/Init/Number.v
+++ b/theories/Corelib/Init/Number.v
@@ -36,3 +36,15 @@ Register number as num.number.type.
 
 Definition uint_of_uint (i:uint) := i.
 Definition int_of_int (i:int) := i.
+
+Module NumberNotations.
+  Number Notation Number.uint Number.uint_of_uint Number.uint_of_uint
+    : hex_uint_scope.
+  Number Notation Number.int Number.int_of_int Number.int_of_int
+    : hex_int_scope.
+
+  Number Notation Number.uint Number.uint_of_uint Number.uint_of_uint
+    : dec_uint_scope.
+  Number Notation Number.int Number.int_of_int Number.int_of_int
+    : dec_int_scope.
+End NumberNotations.
diff --git a/theories/Corelib/Init/Prelude.v b/theories/Corelib/Init/Prelude.v
index f7041e993b61..99f659e2dc09 100644
--- a/theories/Corelib/Init/Prelude.v
+++ b/theories/Corelib/Init/Prelude.v
@@ -35,28 +35,10 @@ Declare ML Module "rocq-runtime.plugins.firstorder".
 
 Global Set Firstorder Solver auto with core.
 
-(* Parsing / printing of hexadecimal numbers *)
-Arguments Nat.of_hex_uint d%_hex_uint_scope.
-Arguments Nat.of_hex_int d%_hex_int_scope.
-Number Notation Number.uint Number.uint_of_uint Number.uint_of_uint
-  : hex_uint_scope.
-Number Notation Number.int Number.int_of_int Number.int_of_int
-  : hex_int_scope.
-
-(* Parsing / printing of decimal numbers *)
-Arguments Nat.of_uint d%_dec_uint_scope.
-Arguments Nat.of_int d%_dec_int_scope.
-Number Notation Number.uint Number.uint_of_uint Number.uint_of_uint
-  : dec_uint_scope.
-Number Notation Number.int Number.int_of_int Number.int_of_int
-  : dec_int_scope.
-
-(* Parsing / printing of [nat] numbers *)
-Number Notation nat Nat.of_num_uint Nat.to_num_hex_uint (abstract after 5000) : hex_nat_scope.
-Number Notation nat Nat.of_num_uint Nat.to_num_uint (abstract after 5000) : nat_scope.
-
-(* Printing/Parsing of bytes *)
-Export Byte.ByteSyntaxNotations.
+Export
+  Number.NumberNotations
+  Nat.NumberNotations
+  Byte.ByteSyntaxNotations.
 
 (* Default substrings not considered by queries like Search *)
 Add Search Blacklist "_subproof" "_subterm" "Private_".

From a1206a1c6e7456cdb58c3c77ef6d536f55c2a5fd Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Wed, 29 Apr 2026 18:04:27 +0200
Subject: [PATCH 450/578] Abstract away the definition the opacity-tracking
 structure in rocqchk.

---
 checker/checkLibrary.ml   |  2 +-
 checker/checkLibrary.mli  |  2 +-
 checker/check_stat.ml     | 40 ++++++++++++++++-----------------------
 checker/check_stat.mli    |  3 +--
 checker/coqchk_main.ml    | 10 +++++++++-
 checker/mod_checking.ml   | 12 ++++++++++++
 checker/mod_checking.mli  |  5 ++++-
 checker/safe_checking.mli |  4 ++--
 8 files changed, 46 insertions(+), 32 deletions(-)

diff --git a/checker/checkLibrary.ml b/checker/checkLibrary.ml
index 549f51181c52..eac6f3539b8d 100644
--- a/checker/checkLibrary.ml
+++ b/checker/checkLibrary.ml
@@ -443,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 ddb6800e3de0..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 =
@@ -70,21 +62,21 @@ let pr_indices_matter env =
     else acc) env [] in
   pr_assumptions "Inductives relying on indices not mattering" 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()) ++ fnl() ++
-      str "* " ++ hov 0 (pr_indices_matter env ++ fnl()))
-      )
-  end
+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 a4c5c29bad3f..bc3b5b68a4ca 100644
--- a/checker/coqchk_main.ml
+++ b/checker/coqchk_main.ml
@@ -146,6 +146,8 @@ 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 () ->
@@ -410,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
@@ -475,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/mod_checking.ml b/checker/mod_checking.ml
index 572667111fb5..8e68592bfb14 100644
--- a/checker/mod_checking.ml
+++ b/checker/mod_checking.ml
@@ -10,6 +10,18 @@ open Environ
 
 type opaques = Names.Cset.t Names.Cmap.t
 
+let empty_opaques = Cmap.empty
+
+let constants_of_opaques 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
+  Cset.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;
diff --git a/checker/mod_checking.mli b/checker/mod_checking.mli
index 1d83f6a70201..2795a82c85a0 100644
--- a/checker/mod_checking.mli
+++ b/checker/mod_checking.mli
@@ -8,10 +8,13 @@
 (*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
 
-type opaques = Names.Cset.t Names.Cmap.t
+type opaques
 
 val set_indirect_accessor : (Opaqueproof.opaque -> Opaqueproof.opaque_proofterm) -> unit
 
 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.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

From 9e9a921ba9fe54fccfa4c621a99fc909145d4640 Mon Sep 17 00:00:00 2001
From: Yann Leray <yann.leray@inria.fr>
Date: Tue, 28 Apr 2026 18:47:09 +0200
Subject: [PATCH 451/578] Clean up function CClosure.get_branch

---
 kernel/cClosure.ml   | 131 ++++++++++++++++++++-----------------------
 kernel/cClosure.mli  |  12 ++--
 kernel/conversion.ml |  16 +++---
 3 files changed, 75 insertions(+), 84 deletions(-)

diff --git a/kernel/cClosure.ml b/kernel/cClosure.ml
index 825e4bb79eae..1ce3ba251b9f 100644
--- a/kernel/cClosure.ml
+++ b/kernel/cClosure.ml
@@ -873,16 +873,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 drop_parameters n m =
-  try try_drop_parameters n m
+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 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.")
@@ -899,14 +897,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
@@ -922,46 +930,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 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
+  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 (mib,mib.mind_packets.(snd ind)) u) then
-      raise Not_found
+  let () = if not (Declareops.is_record_with_eta specif u) then
+    raise Not_found
   in
   match Declareops.inductive_make_projections ind mib with
   | None -> assert false
   | Some projs ->
-    (* (Construct, pars1 .. parsm :: arg1...argn :: []) ~= (f, s') ->
-           arg1..argn ~= (proj1 t...projn t) where t = zip (f,s') *)
+    (* (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
@@ -1891,34 +1887,29 @@ let rec knr info tab ~pat_state m stk =
         | Symbol (u, b, r) ->
           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)
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/conversion.ml b/kernel/conversion.ml
index aa4c0bd3a1a4..6d003e814555 100644
--- a/kernel/conversion.ml
+++ b/kernel/conversion.ml
@@ -610,11 +610,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)
@@ -629,10 +629,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
@@ -679,23 +679,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)
 

From 875b943cc736c7a6a59da16b59605fe292b94c40 Mon Sep 17 00:00:00 2001
From: Jan-Oliver Kaiser <janno@skylabs-ai.com>
Date: Fri, 10 Apr 2026 14:17:55 +0200
Subject: [PATCH 452/578] Add `Hint Mode =` to freeze corresponding evars in TC
 queries

---
 tactics/class_tactics.ml      |   4 +
 tactics/hints.ml              |  32 +++-
 tactics/hints.mli             |   3 +-
 test-suite/success/HintMode.v | 339 +++++++++++++++++++++++++++++++++-
 vernac/g_proofs.mlg           |   1 +
 vernac/ppvernac.ml            |   1 +
 vernac/record.ml              |   6 +-
 7 files changed, 377 insertions(+), 9 deletions(-)

diff --git a/tactics/class_tactics.ml b/tactics/class_tactics.ml
index 6a00fe99845b..85885b01fb42 100644
--- a/tactics/class_tactics.ml
+++ b/tactics/class_tactics.ml
@@ -328,6 +328,10 @@ and e_my_find_search db_list local_db secvars hdc complete env sigma concl0 =
     let hintl =
       CList.map
         (fun (db, m, tacs) ->
+           let allowed_evars = match m with
+             | NoMode -> allowed_evars
+             | 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
diff --git a/tactics/hints.ml b/tactics/hints.ml
index 298a4dfb209b..785d8dd74444 100644
--- a/tactics/hints.ml
+++ b/tactics/hints.ml
@@ -172,6 +172,7 @@ 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 *)
 
@@ -401,9 +402,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
@@ -580,7 +582,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
@@ -666,10 +668,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 =
@@ -1646,6 +1668,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)
@@ -1656,6 +1679,7 @@ let parse_modes s =
 
 let string_of_mode = function
   | ModeInput -> "+"
+  | ModeFrozen -> "="
   | ModeOutput -> "-"
   | ModeNoHeadEvar -> "!"
 
diff --git a/tactics/hints.mli b/tactics/hints.mli
index 7d9ad323c735..33058b692804 100644
--- a/tactics/hints.mli
+++ b/tactics/hints.mli
@@ -71,6 +71,7 @@ end
 
 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 *)
 
@@ -103,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
diff --git a/test-suite/success/HintMode.v b/test-suite/success/HintMode.v
index c786c90345e0..8ba3800c439f 100644
--- a/test-suite/success/HintMode.v
+++ b/test-suite/success/HintMode.v
@@ -88,10 +88,347 @@ Module Plus.
   Defined.
 End Plus.
 
+Module Frozen.
+  Record bi := {
+      car :> Type;
+      emp : car;
+      foo : car;
+      of_bool : bool -> car;
+      to_prop : car -> Prop;
+      to_prop_true : to_prop (of_bool true);
+    }.
+  Arguments emp {_}.
+  Arguments foo {_}.
+  Arguments of_bool {_}.
+  Arguments to_prop {_}.
+
+  Class Special {PROP:bi} (P : PROP) : Prop := {}.
+
+  Instance emp_Special {PROP:bi} : Special PROP.(emp) | 1 := {}.
+  Instance of_bool_false_Special {PROP:bi} : Special (PROP.(of_bool) false) | 1 := {}.
+ (* [True] is a placeholder for some condition that is not part of the TC
+  hierarchy, which is why [of_bool_true_Special] is not an instance. *)
+  Definition of_bool_true_Special {PROP:bi} : True -> Special (PROP.(of_bool) true) := fun _ => Build_Special _ _.
+
+
+  Inductive is_of_bool_false {PROP:bi} : forall (P:PROP), Prop :=
+  | Exactly : is_of_bool_false (of_bool false).
+
+  (* [some_bi] is interesting because it has [to_prop (of_bool false)] *)
+  Axiom some_bi : bi.
+  Axiom some_bi_to_prop_false : some_bi.(to_prop) (of_bool false).
+
+  (* [special_bi] is interesting because all its members are [Special] *)
+  Axiom special_bi : bi.
+  Instance special_bi_Special : forall P: special_bi, Special P | 0 := {}.
+
+  Section ModeOO.
+    Hint Mode Special - - : typeclass_instances.
+
+    Goal exists PROP, Special (PROP.(emp)).
+    Proof.
+      eexists ?[PROP].
+      apply _.                    (* not desireable because it picked a fixed bi *)
+      Fail [PROP]: exact some_bi.
+    Abort.
+
+    Goal forall {PROP:bi}, exists P : PROP,
+        Special P /\ to_prop P.
+    Proof.
+      intros. eexists ?[P].
+      split.
+      - apply _.  (* not desired because it picks a value for [P] arbitrarily *)
+      -           (* stuck because we should have picked [of_bool true] *)
+    Abort.
+
+    Goal forall {PROP:bi}, exists b:bool,
+        Special (PROP.(of_bool) b) /\ PROP.(to_prop) (of_bool b).
+    Proof.
+      intros. eexists ?[P].
+      split.
+      - apply _.  (* not desired because it picks a value for [b] arbitrarily *)
+      - Fail apply to_prop_true. (* stuck because we should have picked [true] *)
+    Abort.
+
+    Goal exists PROP:bi, exists P:PROP, Special P /\ is_of_bool_false P /\ to_prop P.
+    Proof.
+      eexists ?[PROP], ?[P].
+      split; [|split].
+      - apply _.             (* not desired because it picked an arbitrary value for [PROP] *)
+      - constructor.
+      - Fail apply some_bi_to_prop_false. (* stuck *)
+    Abort.
+
+    Goal exists PROP:bi, exists b:bool,
+        Special (PROP.(of_bool) b) /\ PROP.(to_prop) (of_bool b) /\ not (is_true b).
+    Proof.
+      eexists ?[PROP], ?[b].
+      split; [|split].
+      - apply _.             (* not desired because it picked arbitrary values for [PROP] and [b] *)
+      - apply to_prop_true.  (* stuck because we should have picked [true] *)
+    Abort.
+
+    Goal exists PROP:bi, Special (PROP.(of_bool) false) /\ PROP.(to_prop) (of_bool false).
+    Proof.
+      eexists ?[PROP].
+      split.
+      - apply _.                (* picked the wrong bi *)
+      -                         (* stuck *)
+    Abort.
+  End ModeOO.
+
+  Section ModeOI.
+    Hint Mode Special - + : typeclass_instances.
+
+    Goal exists PROP, Special (PROP.(emp)).
+    Proof.
+      eexists.
+      Fail apply _.             (* would be fine but does not work with [+] *)
+    Abort.
+
+    Goal forall {PROP:bi}, exists P : PROP,
+        Special P /\ to_prop P.
+    Proof.
+      intros. eexists.
+      split.
+      - Fail apply _.                  (* Correctly fails *)
+        apply of_bool_true_Special. constructor.
+      - apply to_prop_true.
+    Qed.
+
+    Goal forall {PROP:bi}, exists b:bool,
+        Special (PROP.(of_bool) b) /\ PROP.(to_prop) (of_bool b).
+    Proof.
+      intros. eexists.
+      split.
+      - Fail apply _.           (* Correctly fails. *)
+        apply of_bool_true_Special. constructor.
+      - apply to_prop_true.
+    Qed.
+
+    Goal exists PROP:bi, exists P:PROP, Special P /\ is_of_bool_false P /\ to_prop P.
+    Proof.
+      eexists ?[PROP], ?[P].
+      split; [|split].
+      - Fail apply _.           (* fails correctly *)
+        apply (@of_bool_false_Special some_bi).
+      - constructor.
+      - apply some_bi_to_prop_false.
+    Qed.
+
+    Goal exists PROP:bi, exists b:bool,
+        Special (PROP.(of_bool) b) /\ PROP.(to_prop) (of_bool b).
+    Proof.
+      eexists ?[PROP], ?[P].
+      split.
+      - Fail apply _.           (* fails correctly *)
+        apply (@of_bool_true_Special some_bi). constructor.
+      - apply to_prop_true.
+    Qed.
+
+    Goal exists PROP:bi, exists b:bool,
+        Special (PROP.(of_bool) b) /\ PROP.(to_prop) (of_bool b) /\ not (is_true b).
+    Proof.
+      eexists ?[PROP], ?[b].
+      split; [|split].
+      - Fail apply _.           (* fails correctly *)
+        apply (@of_bool_false_Special some_bi).
+      - apply some_bi_to_prop_false.
+      - intro H. discriminate H.
+    Qed.
+
+    Goal exists PROP:bi, Special (PROP.(of_bool) false) /\ PROP.(to_prop) (of_bool false).
+    Proof.
+      eexists ?[PROP].
+      split.
+      - Fail apply _.           (* fails but could be OK *)
+    Abort.
+  End ModeOI.
+
+  Section ModeOH.
+    Hint Mode Special - ! : typeclass_instances.
+
+    Goal exists PROP, Special (PROP.(emp)).
+    Proof.
+      eexists.
+      apply _.                    (* not desireable because it picked a fixed bi *)
+      Fail [PROP]: exact some_bi.
+    Abort.
+
+    Goal forall {PROP:bi}, exists P : PROP,
+        Special P /\ to_prop P.
+    Proof.
+      intros. eexists ?[P].
+      split.
+      - Fail apply _.      (* Correctly fails but only because [P] is exactly an evar *)
+        apply of_bool_true_Special. constructor.
+      - apply to_prop_true.
+    Qed.
+
+    Goal forall {PROP:bi}, exists b:bool,
+        Special (PROP.(of_bool) b) /\ PROP.(to_prop) (of_bool b).
+    Proof.
+      intros. eexists.
+      split.
+      - apply _.  (* undesirable because it picks a value for [b] arbitrarily *)
+      - Fail apply to_prop_true. (* stuck because we should have picked [true] *)
+    Abort.
+
+    Goal exists PROP:bi, exists P:PROP, Special P /\ is_of_bool_false P /\ to_prop P.
+    Proof.
+      eexists ?[PROP], ?[P].
+      split; [|split].
+      - Fail apply _.           (* fails correctly but only because [P] is exactly an evar *)
+        apply (@of_bool_false_Special some_bi).
+      - constructor.
+      - apply some_bi_to_prop_false.
+    Qed.
+
+    Goal exists PROP:bi, exists b:bool,
+        Special (PROP.(of_bool) b) /\ PROP.(to_prop) (of_bool b) /\ not (is_true b).
+    Proof.
+      eexists ?[PROP], ?[b].
+      split; [|split].
+      - apply _.                (* not desired because it picked arbitrary values for [PROP] and [b] *)
+      - apply to_prop_true.     (* stuck because we should have picked [true] *)
+    Abort.
+
+    Goal exists PROP:bi, Special (PROP.(of_bool) false) /\ PROP.(to_prop) (of_bool false).
+    Proof.
+      eexists ?[PROP].
+      split.
+      - apply _.                (* picked the wrong bi *)
+      -                         (* stuck *)
+    Abort.
+  End ModeOH.
+
+  Section ModeOF.
+    Hint Mode Special - = : typeclass_instances.
+
+    Goal exists PROP, Special (PROP.(emp)).
+    Proof.
+      eexists ?[PROP].
+      apply _.                    (* works and does not pick a bi *)
+      [PROP]: exact some_bi.
+    Qed.
+
+    Goal forall {PROP:bi}, exists P : PROP,
+        Special P /\ to_prop P.
+    Proof.
+      intros. eexists ?[P].
+      split.
+      - Fail apply _.      (* Correctly fails but only because [P] is exactly an evar *)
+        apply of_bool_true_Special. constructor.
+      - apply to_prop_true.
+    Qed.
+
+    Goal forall {PROP:bi}, exists b:bool,
+        Special (PROP.(of_bool) b) /\ PROP.(to_prop) (of_bool b).
+    Proof.
+      intros. eexists.
+      split.
+      - Fail apply _.           (* fails correctly *)
+        apply of_bool_true_Special. constructor.
+      - apply to_prop_true.
+    Qed.
+
+    Goal exists PROP:bi, exists P:PROP, Special P /\ is_of_bool_false P /\ to_prop P.
+    Proof.
+      eexists ?[PROP], ?[P].
+      split; [|split].
+      - apply _.                (* undesired it because it picked [PROP:=special_bi] *)
+      - constructor.
+      - Fail apply some_bi_to_prop_false. (* stuck *)
+    Abort.
+
+    Goal exists PROP:bi, exists b:bool,
+        Special (PROP.(of_bool) b) /\ PROP.(to_prop) (of_bool b) /\ not (is_true b).
+    Proof.
+      eexists ?[PROP], ?[P].
+      split; [|split].
+      - Fail apply _.        (* fails correctly even when [?b] is deeper in the term. *)
+        apply (@of_bool_false_Special some_bi).
+      - apply some_bi_to_prop_false.
+      - intro H. discriminate H.
+    Qed.
+
+    Goal exists PROP:bi, Special (PROP.(of_bool) false) /\ PROP.(to_prop) (of_bool false).
+    Proof.
+      eexists ?[PROP].
+      split.
+      - apply _.                (* works and does not pick a bi *)
+      - apply some_bi_to_prop_false.
+    Qed.
+  End ModeOF.
+
+
+  Section ModeFF.
+    Hint Mode Special = = : typeclass_instances.
+
+    Goal exists PROP, Special (PROP.(emp)).
+    Proof.
+      eexists ?[PROP].
+      apply _.                    (* works and does not pick a bi *)
+      [PROP]: exact some_bi.
+    Qed.
+
+    Goal forall {PROP:bi}, exists P : PROP,
+        Special P /\ to_prop P.
+    Proof.
+      intros. eexists ?[P].
+      split.
+      - Fail apply _.      (* Correctly fails but only because [P] is exactly an evar *)
+        apply of_bool_true_Special. constructor.
+      - apply to_prop_true.
+    Qed.
+
+    Goal forall {PROP:bi}, exists b:bool,
+        Special (PROP.(of_bool) b) /\ PROP.(to_prop) (of_bool b).
+    Proof.
+      intros. eexists.
+      split.
+      - Fail apply _.           (* fails correctly *)
+        apply of_bool_true_Special. constructor.
+      - apply to_prop_true.
+    Qed.
+
+    (* This case is the only difference between [ModeOF] and [ModeFF] *)
+    Goal exists PROP:bi, exists P:PROP, Special P /\ is_of_bool_false P /\ to_prop P.
+    Proof.
+      eexists ?[PROP], ?[P].
+      split; [|split].
+      - Fail apply _.                (* correctly fails to apply *)
+        apply of_bool_false_Special.
+      - constructor.
+      - apply some_bi_to_prop_false.
+    Qed.
+
+    Goal exists PROP:bi, exists b:bool,
+        Special (PROP.(of_bool) b) /\ PROP.(to_prop) (of_bool b) /\ not (is_true b).
+    Proof.
+      eexists ?[PROP], ?[b].
+      split; [|split].
+      - Fail apply _.        (* fails correctly even when [?b] is deeper in the term. *)
+        apply (@of_bool_false_Special some_bi).
+      - apply some_bi_to_prop_false.
+      - intro H. discriminate H.
+    Qed.
+
+    Goal exists PROP:bi, Special (PROP.(of_bool) false) /\ PROP.(to_prop) (of_bool false).
+    Proof.
+      eexists ?[PROP].
+      split.
+      - apply _.                (* works and does not pick a bi *)
+      - apply some_bi_to_prop_false.
+    Qed.
+  End ModeFF.
+End Frozen.
+
 Module ModeAttr.
   Fail #[mode="+"] Inductive foo (A : Type) : Set :=.
 
   Fail #[mode=""] Class Foo (A : Type) := {}.
-  #[mode="+"] Class Foo (A : Type) := {}.
+  Succeed #[mode="+"] Class Foo (A : Type) := {}.
+  Succeed #[mode="="] Class Foo (A : Type) := {}.
   Fail #[mode="+ +"] Class Foo' (A : Type) := {}.
 End ModeAttr.
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/ppvernac.ml b/vernac/ppvernac.ml
index ccdf088cdf48..13ae2a8c41e3 100644
--- a/vernac/ppvernac.ml
+++ b/vernac/ppvernac.ml
@@ -318,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"-"
 
diff --git a/vernac/record.ml b/vernac/record.ml
index 6085099b5bfa..d55f5f1d5c58 100644
--- a/vernac/record.ml
+++ b/vernac/record.ml
@@ -1000,10 +1000,10 @@ let set_class_mode ref mode ctx =
       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);

From 90e518d65e0b2604857c867bb5a30dccfb96de62 Mon Sep 17 00:00:00 2001
From: Jan-Oliver Kaiser <janno@skylabs-ai.com>
Date: Thu, 30 Apr 2026 11:17:54 +0200
Subject: [PATCH 453/578] Update grammar

---
 doc/tools/docgram/fullGrammar    | 2 +-
 doc/tools/docgram/orderedGrammar | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/doc/tools/docgram/fullGrammar b/doc/tools/docgram/fullGrammar
index 54fe8892b8a5..57d89bb98511 100644
--- a/doc/tools/docgram/fullGrammar
+++ b/doc/tools/docgram/fullGrammar
@@ -744,7 +744,7 @@ hint: [
 ]
 
 mode: [
-| LIST1 [ "+" | "!" | "-" ]
+| LIST1 [ "+" | "=" | "!" | "-" ]
 ]
 
 int_or_var: [
diff --git a/doc/tools/docgram/orderedGrammar b/doc/tools/docgram/orderedGrammar
index 86852d2d0b00..6c46521117a1 100644
--- a/doc/tools/docgram/orderedGrammar
+++ b/doc/tools/docgram/orderedGrammar
@@ -1029,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 )

From 0fad295b8e1b485ffbc344ef705b3e9152fe0686 Mon Sep 17 00:00:00 2001
From: Jan-Oliver Kaiser <janno@skylabs-ai.com>
Date: Thu, 30 Apr 2026 11:34:25 +0200
Subject: [PATCH 454/578] Update documentation

---
 doc/sphinx/proofs/automatic-tactics/auto.rst | 14 ++++++++++++--
 1 file changed, 12 insertions(+), 2 deletions(-)

diff --git a/doc/sphinx/proofs/automatic-tactics/auto.rst b/doc/sphinx/proofs/automatic-tactics/auto.rst
index 4d57b51e0432..3313422aa222 100644
--- a/doc/sphinx/proofs/automatic-tactics/auto.rst
+++ b/doc/sphinx/proofs/automatic-tactics/auto.rst
@@ -841,13 +841,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
@@ -857,6 +857,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

From cfca8cd4c2f5a940f9aff1d3eff5c61dc23a4e6b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Thu, 30 Apr 2026 13:11:58 +0200
Subject: [PATCH 455/578] Use Id.equal instead of Id.compare = 0 in
 push_rel_decl_to_named_context

---
 engine/evarutil.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/engine/evarutil.ml b/engine/evarutil.ml
index 296868d28001..0c4af3030964 100644
--- a/engine/evarutil.ml
+++ b/engine/evarutil.ml
@@ -315,7 +315,7 @@ let push_rel_decl_to_named_context
   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

From c441de885769ea11c28367e976a5bae0c202d77f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Thu, 30 Apr 2026 13:25:30 +0200
Subject: [PATCH 456/578] Remove Context.Compacted.Declaration.to_named_context

It is not needed to print a compacted context, because each
declaration is valid in the full environment so doesn't need to be
printed in a partial environment.
---
 ide/rocqide/idetop.ml | 15 +++++----------
 kernel/context.ml     |  6 ------
 kernel/context.mli    |  1 -
 3 files changed, 5 insertions(+), 17 deletions(-)

diff --git a/ide/rocqide/idetop.ml b/ide/rocqide/idetop.ml
index f8e5ec2bd336..0951aeb4997d 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. *)
@@ -199,24 +198,20 @@ 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 (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
+        (Termops.compact_named_context sigma (EConstr.named_context 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
diff --git a/kernel/context.ml b/kernel/context.ml
index 7046ca3f66f8..dbcdd89eb593 100644
--- a/kernel/context.ml
+++ b/kernel/context.ml
@@ -592,12 +592,6 @@ module Compacted =
               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
diff --git a/kernel/context.mli b/kernel/context.mli
index 751b08d54b59..e8d2e0e1d1b3 100644
--- a/kernel/context.mli
+++ b/kernel/context.mli
@@ -381,7 +381,6 @@ sig
 
     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

From c39e67d0448d72f21ec49f0051189cfa7a648588 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Thu, 30 Apr 2026 13:38:34 +0200
Subject: [PATCH 457/578] Remove unused Termops.push_named_rec_types

---
 engine/termops.ml  | 13 -------------
 engine/termops.mli |  1 -
 2 files changed, 14 deletions(-)

diff --git a/engine/termops.ml b/engine/termops.ml
index ad3f3f799e7f..c5bfdedbf3e5 100644
--- a/engine/termops.ml
+++ b/engine/termops.ml
@@ -439,19 +439,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
diff --git a/engine/termops.mli b/engine/termops.mli
index 67557a374484..7a107183fd72 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

From e628fff656a60ec3af2c45df0bba8f33d15eece0 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Thu, 30 Apr 2026 13:41:15 +0200
Subject: [PATCH 458/578] Remove unused argument in checker internals.

---
 checker/mod_checking.ml | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/checker/mod_checking.ml b/checker/mod_checking.ml
index 8e68592bfb14..306efea39166 100644
--- a/checker/mod_checking.ml
+++ b/checker/mod_checking.ml
@@ -256,13 +256,13 @@ let rec collect_constants_without_body sign mp accu =
   | 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
@@ -276,13 +276,13 @@ 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));
@@ -297,7 +297,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

From c736c8b398c72b7f5b2631b05791ca2bead9c4d5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Wed, 29 Apr 2026 19:37:57 +0200
Subject: [PATCH 459/578] Static invariant that rocqchk opaque data only
 contains pure kernames.

---
 checker/mod_checking.ml | 18 ++++++++++--------
 1 file changed, 10 insertions(+), 8 deletions(-)

diff --git a/checker/mod_checking.ml b/checker/mod_checking.ml
index 306efea39166..59055069f442 100644
--- a/checker/mod_checking.ml
+++ b/checker/mod_checking.ml
@@ -8,8 +8,10 @@ open Environ
 
 (** {6 Checking constants } *)
 
-type opaques = Names.Cset.t Names.Cmap.t
+type cset = { cset : KerName.Set.t }
+type opaques = Cset.t Names.Cmap.t
 
+let empty_cset = { cset = KerName.Set.empty }
 let empty_opaques = Cmap.empty
 
 let constants_of_opaques env opac =
@@ -247,12 +249,12 @@ 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
 
@@ -315,14 +317,14 @@ 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 _ : check_state =
-    check_signature env empty_state (mod_type mty) mp (mod_delta mty) Cset.empty in
+    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
@@ -351,7 +353,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) ->
@@ -393,7 +395,7 @@ let get_retroknowlege env retro =
 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 Cset.empty 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 _) ->

From d441c0b34eacdf444de661fc8603eb2d071ae4c7 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Wed, 29 Apr 2026 21:39:38 +0200
Subject: [PATCH 460/578] Factorize the internals of opaque computation in
 rocqchk.

---
 checker/mod_checking.ml | 27 ++++++++++-----------------
 1 file changed, 10 insertions(+), 17 deletions(-)

diff --git a/checker/mod_checking.ml b/checker/mod_checking.ml
index 59055069f442..dbad7d780262 100644
--- a/checker/mod_checking.ml
+++ b/checker/mod_checking.ml
@@ -14,13 +14,14 @@ type opaques = Cset.t Names.Cmap.t
 let empty_cset = { cset = KerName.Set.empty }
 let empty_opaques = Cmap.empty
 
+let add_opaque_cb kn cb opac accu =
+  if Declareops.constant_has_body cb then accu
+  else match Cmap.find_opt kn opac with
+  | None -> Cset.add kn accu
+  | Some s -> Cset.union s accu
+
 let constants_of_opaques 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 add c cb acc = add_opaque_cb c cb opac acc in
   let csts = fold_constants add env Cset.empty in
   Cset.fold (fun c acc -> c :: acc) csts []
 
@@ -30,7 +31,7 @@ type check_state = {
 }
 
 let empty_state = {
-  st_opaques = Cmap.empty;
+  st_opaques = empty_opaques;
   st_retro = (Mindmap_env.empty, Cmap_env.empty);
 }
 
@@ -46,16 +47,8 @@ let register_opacified_constant env chkst kn cb =
     | Constr.Const (c, _) -> Cset.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
+  let fold c accu = add_opaque_cb c (lookup_constant c env) opac accu in
+  let wo_body = Cset.fold fold (gather_consts Cset.empty cb) Cset.empty in
   { chkst with st_opaques = Cmap.add kn wo_body opac }
 
 exception BadConstant of Constant.t * Pp.t

From ae5bffb43fb287d7de6ae719fecfa67abc1ecc59 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Thu, 30 Apr 2026 12:53:13 +0200
Subject: [PATCH 461/578] Rely on user-facing names for rocqchk opaque
 analysis.

This is a slight change of semantics but I believe that it is actually more
correct than what we had before. The reason why the previous code used
canonical names was probably due to the fact that constant sets and maps
silently used the latter rather than the user ordering.
---
 checker/mod_checking.ml | 20 ++++++++++----------
 1 file changed, 10 insertions(+), 10 deletions(-)

diff --git a/checker/mod_checking.ml b/checker/mod_checking.ml
index dbad7d780262..42d0f6416702 100644
--- a/checker/mod_checking.ml
+++ b/checker/mod_checking.ml
@@ -9,21 +9,21 @@ open Environ
 (** {6 Checking constants } *)
 
 type cset = { cset : KerName.Set.t }
-type opaques = Cset.t Names.Cmap.t
+type opaques = Cset_env.t Names.Cmap_env.t
 
 let empty_cset = { cset = KerName.Set.empty }
-let empty_opaques = Cmap.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.find_opt kn opac with
-  | None -> Cset.add kn accu
-  | Some s -> Cset.union s 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.empty in
-  Cset.fold (fun c acc -> c :: acc) csts []
+  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;
@@ -44,12 +44,12 @@ 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 fold c accu = add_opaque_cb c (lookup_constant c env) opac accu in
-  let wo_body = Cset.fold fold (gather_consts Cset.empty cb) Cset.empty in
-  { chkst with st_opaques = Cmap.add kn wo_body opac }
+  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
 

From 5da098ae5069e85bc3eb83e5633b325f7f7aaa71 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Thu, 30 Apr 2026 14:58:05 +0200
Subject: [PATCH 462/578] Stop relying on canonical equality in Inductiveops.

---
 pretyping/inductiveops.ml  | 4 ++--
 pretyping/inductiveops.mli | 2 +-
 vernac/indschemes.ml       | 5 +++--
 3 files changed, 6 insertions(+), 5 deletions(-)

diff --git a/pretyping/inductiveops.ml b/pretyping/inductiveops.ml
index 110f9468aa55..1d8452d3b9d6 100644
--- a/pretyping/inductiveops.ml
+++ b/pretyping/inductiveops.ml
@@ -120,14 +120,14 @@ let mis_is_recursive mip =
   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 tr ->
         match Rtree.Automaton.data ra tr with
-        | Mrec (RecArgInd (kni, _)) -> not @@ MutInd.CanOrd.equal kn kni
+        | Mrec (RecArgInd (kni, _)) -> not @@ QMutInd.equal env kn kni
         | Mrec (RecArgPrim _) | Norec -> false
       ) rvec
     ) trans
diff --git a/pretyping/inductiveops.mli b/pretyping/inductiveops.mli
index 35eae77ed867..deb2756476de 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
 
diff --git a/vernac/indschemes.ml b/vernac/indschemes.ml
index 889d32f9928f..0c7f7c850968 100644
--- a/vernac/indschemes.ml
+++ b/vernac/indschemes.ml
@@ -619,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 ()
 

From ba7ed5669b9a6d628dd002e384aeeb440f3f4dc6 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Thu, 30 Apr 2026 16:03:44 +0200
Subject: [PATCH 463/578] Stop relying on canonizing GlobRef.Map in hint
 internals.

We canonize the keys on the fly instead of using the canonical comparison
function. This should hopefully preserve the old behaviour.
---
 tactics/hints.ml  | 73 ++++++++++++++++++++++++++---------------------
 tactics/hints.mli |  2 +-
 2 files changed, 41 insertions(+), 34 deletions(-)

diff --git a/tactics/hints.ml b/tactics/hints.ml
index 785d8dd74444..57006c9be9f1 100644
--- a/tactics/hints.ml
+++ b/tactics/hints.ml
@@ -178,9 +178,9 @@ type hint_mode =
 
 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 =
@@ -593,7 +593,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 ->
@@ -606,11 +606,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 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
@@ -623,7 +623,7 @@ struct
     hintdb_unfolds : Id.Set.t * Cset.t * PRset.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;
@@ -638,16 +638,21 @@ struct
                           hintdb_unfolds = (Id.Set.empty, Cset.empty, PRset.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
@@ -708,8 +713,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
@@ -717,13 +722,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
@@ -734,6 +739,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
@@ -748,12 +754,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
@@ -778,6 +784,7 @@ struct
     | _ -> 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
@@ -795,7 +802,7 @@ struct
     let grs = List.fold_left fold GlobRef.Set_env.empty grs in
     let filter (_, h) =
       match h.name with Some gr -> not (GlobRef.Set_env.mem gr grs) | None -> true in
-    let hintmap = GlobRef.Map.map (fun e -> remove env (dn_ts db) grs e) db.hintdb_map 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 }
 
@@ -808,11 +815,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
 
@@ -823,10 +830,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
 
@@ -836,12 +843,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
 
@@ -1089,9 +1096,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 = {
@@ -1185,7 +1192,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
@@ -1199,7 +1206,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
@@ -1617,7 +1624,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
diff --git a/tactics/hints.mli b/tactics/hints.mli
index 33058b692804..39cf274c80f8 100644
--- a/tactics/hints.mli
+++ b/tactics/hints.mli
@@ -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.

From 1f0b83b7fd04de820cbea081d6d5c0eac50888cf Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Fri, 1 May 2026 09:27:46 +0200
Subject: [PATCH 464/578] Add overlays.

---
 dev/ci/user-overlays/21986-ppedrot-hints-rm-canord-globref.sh | 1 +
 1 file changed, 1 insertion(+)
 create mode 100644 dev/ci/user-overlays/21986-ppedrot-hints-rm-canord-globref.sh

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

From b5d0109db39ef9a0238c2208b64071a867151ac0 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Fri, 1 May 2026 20:47:05 +0200
Subject: [PATCH 465/578] rocqide -xml-debug does not imply -debug

---
 ide/rocqide/idetop.ml  | 5 -----
 ide/rocqide/rocqide.ml | 1 -
 2 files changed, 6 deletions(-)

diff --git a/ide/rocqide/idetop.ml b/ide/rocqide/idetop.ml
index f8e5ec2bd336..844928313da8 100644
--- a/ide/rocqide/idetop.ml
+++ b/ide/rocqide/idetop.ml
@@ -716,11 +716,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/rocqide.ml b/ide/rocqide/rocqide.ml
index e5ccc88833ba..d78c32e9c20d 100644
--- a/ide/rocqide/rocqide.ml
+++ b/ide/rocqide/rocqide.ml
@@ -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->

From 9268c79f7ff9c4f97a30e5ea0d9eb40603be8d81 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Fri, 1 May 2026 22:42:11 +0200
Subject: [PATCH 466/578] rocqide get background goals when needed

Even if printing_unfocused is false, the background goals are needed
when there are no foreground goals.

Since we already do a second subgoals call for shelved and given up
when there are no foreground goals, we add the background goals
request to it (unless the initial request included them due to
printing_unfocused = true).

Fix #21989
---
 ide/rocqide/rocqOps.ml | 11 ++++++-----
 1 file changed, 6 insertions(+), 5 deletions(-)

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

From 2f5b7a2d0df3d2f5efc4580b24bb11f9ecb5ac08 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Fri, 1 May 2026 22:55:10 +0200
Subject: [PATCH 467/578] Inline some constant arguments in rocqide

---
 ide/rocqide/wg_ProofView.ml | 26 +++++++++++---------------
 1 file changed, 11 insertions(+), 15 deletions(-)

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

From 394d025cb70e19de3525cd5d59a13b1693e8aa47 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Sun, 3 May 2026 21:34:56 +0200
Subject: [PATCH 468/578] Ltac2 share some code between lazy_match and
 multi_match

---
 theories/Ltac2/Pattern.v | 53 ++++++++++++++++------------------------
 1 file changed, 21 insertions(+), 32 deletions(-)

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.
 

From 644c907cebe319e210468e59616aca096723b035 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Sun, 3 May 2026 22:41:23 +0200
Subject: [PATCH 469/578] Stop relying on GlobRef.Map in Zify internals.

---
 plugins/micromega/zify.ml | 38 ++++++++++++++++++++------------------
 1 file changed, 20 insertions(+), 18 deletions(-)

diff --git a/plugins/micromega/zify.ml b/plugins/micromega/zify.ml
index 59e74b546bcb..f2c223985b3d 100644
--- a/plugins/micromega/zify.ml
+++ b/plugins/micromega/zify.ml
@@ -94,24 +94,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
 
-  let add gr e m =
-    Map.update gr (function None -> Some [e] | Some l -> Some (e :: l)) m
+  type 'a t = 'a list QGlobRef.Map.t
 
-  let empty = Map.empty
+  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 find evd h m =
-    match Map.find (fst (EConstr.destRef evd h)) m with
+  let empty = QGlobRef.Map.empty
+
+  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
@@ -645,14 +647,14 @@ 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
@@ -661,7 +663,7 @@ module MakeTable (E : Elt) : S = struct
     | App (intyp, args) when EConstr.isRefX env evd (Lazy.force 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
@@ -1161,7 +1163,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
@@ -1305,7 +1307,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
@@ -1421,7 +1423,7 @@ let do_let tac (h : Constr.named_declaration) =
              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)
 
@@ -1517,7 +1519,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
@@ -1608,7 +1610,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 =

From 660eaadd4c0e84540bcc4665c947dc3d4bc73308 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Sun, 3 May 2026 22:36:15 +0200
Subject: [PATCH 470/578] Deprecate the GlobRef.Map module.

This is one of the last modules exposed in the Names API that relies on
the canonical ordering that was not deprecated yet.
---
 kernel/names.mli | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/kernel/names.mli b/kernel/names.mli
index 9e7be1b72777..4ee6d44c3cf4 100644
--- a/kernel/names.mli
+++ b/kernel/names.mli
@@ -648,6 +648,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). *)

From 72979f4818370c97eeb02b9e1a2094d3a7f50883 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Mon, 4 May 2026 10:35:50 +0200
Subject: [PATCH 471/578] Minor code factorization in Declareops.

We reuse recarg comparison to implement equality.
---
 kernel/declareops.ml | 13 ++-----------
 1 file changed, 2 insertions(+), 11 deletions(-)

diff --git a/kernel/declareops.ml b/kernel/declareops.ml
index 192aad1e7c0c..553d33c1649a 100644
--- a/kernel/declareops.ml
+++ b/kernel/declareops.ml
@@ -151,17 +151,6 @@ 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 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 compare_recarg_type t1 t2 = match t1, t2 with
 | RecArgInd ind1, RecArgInd ind2 -> Names.Ind.CanOrd.compare ind1 ind2
 | RecArgInd _, RecArgPrim _ -> -1
@@ -174,6 +163,8 @@ let compare_recarg r1 r2 = match r1, r2 with
 | Mrec t1, Mrec t2 -> compare_recarg_type t1 t2
 | Mrec _, Norec -> 1
 
+let eq_recarg r1 r2 = Int.equal (compare_recarg r1 r2) 0
+
 let pr_recarg_type = let open Pp in function
   | RecArgInd (mind,i) ->
      str "Mrec[" ++ Names.MutInd.print mind ++ pr_comma () ++ int i ++ str "]"

From 116142d87a9a12d1001db7c57898998923917a50 Mon Sep 17 00:00:00 2001
From: Jan-Oliver Kaiser <janno@skylabs-ai.com>
Date: Mon, 4 May 2026 12:12:01 +0200
Subject: [PATCH 472/578] `Strict Resolution` has precedence over `Hint Mode`

---
 tactics/class_tactics.ml      | 22 ++++++++++++----------
 test-suite/success/HintMode.v | 14 ++++++++++++++
 2 files changed, 26 insertions(+), 10 deletions(-)

diff --git a/tactics/class_tactics.ml b/tactics/class_tactics.ml
index 85885b01fb42..d86a8cbf5109 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,9 +325,14 @@ and e_my_find_search db_list local_db secvars hdc complete env sigma concl0 =
     let hintl =
       CList.map
         (fun (db, m, tacs) ->
-           let allowed_evars = match m with
-             | NoMode -> allowed_evars
-             | WithMode evars -> evars
+           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)
diff --git a/test-suite/success/HintMode.v b/test-suite/success/HintMode.v
index 8ba3800c439f..50253e24c207 100644
--- a/test-suite/success/HintMode.v
+++ b/test-suite/success/HintMode.v
@@ -88,6 +88,20 @@ Module Plus.
   Defined.
 End Plus.
 
+Module StrictFrozen.
+  #[local] Set Typeclasses Strict Resolution.
+  Class C (a : True) (b : True) := {}.
+  Hint Mode C - = : typeclass_instances.
+
+  Instance c : C I I := {}.
+
+  Goal exists a, C a I.
+  Proof.
+    eexists ?[a].
+    Fail apply _.
+  Abort.
+End StrictFrozen.
+
 Module Frozen.
   Record bi := {
       car :> Type;

From a8acbe41c9b7125d386515508fb43f517439a15c Mon Sep 17 00:00:00 2001
From: Jan-Oliver Kaiser <janno@skylabs-ai.com>
Date: Tue, 7 Apr 2026 15:51:11 +0200
Subject: [PATCH 473/578] Print external hints before running them

This makes the output much easier to digest, especially when `Hint
Extern`s produce new top-level searches.
---
 .../21899-janno-typeclasses-debug-Changed.rst |  5 +++
 tactics/class_tactics.ml                      |  7 +++-
 test-suite/output/TypeclassDebug.out          | 28 ++++++++++++++++
 test-suite/output/TypeclassDebug.v            | 33 +++++++++++++++++++
 4 files changed, 72 insertions(+), 1 deletion(-)
 create mode 100644 doc/changelog/02-specification-language/21899-janno-typeclasses-debug-Changed.rst

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 <https://github.com/rocq-prover/rocq/pull/21899>`_,
+  fixes `#21898 <https://github.com/rocq-prover/rocq/issues/21898>`_,
+  by Jan-Oliver Kaiser).
diff --git a/tactics/class_tactics.ml b/tactics/class_tactics.ml
index 6a00fe99845b..703b72b28079 100644
--- a/tactics/class_tactics.ml
+++ b/tactics/class_tactics.ml
@@ -836,9 +836,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
diff --git a/test-suite/output/TypeclassDebug.out b/test-suite/output/TypeclassDebug.out
index 434ac396538f..c303a9ac1f9f 100644
--- a/test-suite/output/TypeclassDebug.out
+++ b/test-suite/output/TypeclassDebug.out
@@ -16,3 +16,31 @@ Debug: 1.1-1.1-1.1-1.1-1.1-1 : foo
 File "./output/TypeclassDebug.v", line 13, characters 5-33:
 The command has indeed failed with message:
 Tactic failure: Proof search reached its limit.
+Debug: 1: looking for bar without backtracking
+Debug: 1.1: simple apply hint on bar, 1 subgoal(s)
+Debug: 1.1-1 : cls
+Debug: 1.1-1: looking for cls without backtracking
+Debug: 1.1-1.1: exact c on cls, 0 subgoal(s)
+Debug: 1: looking for bar without backtracking
+Debug: 1.1: running (*external*) (apply hint) on bar
+Debug: 1.1: (*external*) (apply hint) on bar, 1 subgoal(s)
+Debug: 1.1-1 : cls
+Debug: 1.1-1: looking for cls without backtracking
+Debug: 1.1-1.1: exact c on cls, 0 subgoal(s)
+Debug: 1: looking for bar without backtracking
+Debug:
+1.1: running (*external*) (let c :=
+                                 constr:((ltac:(typeclasses eauto with foo)
+                                          :>
+                                          cls))
+                             in
+                           exact (hint c)) on
+  bar
+Debug: 1: looking for cls without backtracking
+Debug: 1.1: exact c on cls, 0 subgoal(s)
+Debug:
+1.1: (*external*) (let c :=
+                         constr:((ltac:(typeclasses eauto with foo) :> cls))
+                     in
+                   exact (hint c)) on
+  bar, 0 subgoal(s)
diff --git a/test-suite/output/TypeclassDebug.v b/test-suite/output/TypeclassDebug.v
index 092307f4e13e..a81f2b93270b 100644
--- a/test-suite/output/TypeclassDebug.v
+++ b/test-suite/output/TypeclassDebug.v
@@ -12,3 +12,36 @@ Goal foo.
 Typeclasses eauto := debug.
 Fail typeclasses eauto 5 with foo.
 Abort.
+
+(* Ensure that actions triggered by hints are always preceded by debug output for the hint iself. *)
+Parameter bar cls : Prop.
+Axiom c : cls.
+Axiom hint : cls -> bar.
+Hint Resolve c : foo.
+
+Section Resolve.
+  Hint Resolve hint : foo.
+
+  Goal bar.
+  Proof.
+    typeclasses eauto with foo.
+  Qed.
+End Resolve.
+
+Section ExternApply.
+  Hint Extern 0 bar => apply hint : foo.
+
+  Goal bar.
+  Proof.
+    typeclasses eauto with foo.
+  Qed.
+End ExternApply.
+
+Section ExternTC.
+  Hint Extern 0 bar => let c := constr:(ltac:(typeclasses eauto with foo) :> cls) in exact (hint c) : foo.
+
+  Goal bar.
+  Proof.
+    typeclasses eauto with foo.
+  Qed.
+End ExternTC.

From e1c522aa2cab9b23d5104a64ce3384c929a6ec64 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Mon, 4 May 2026 14:32:41 +0200
Subject: [PATCH 474/578] Inline canonical equality in kernel subtyping.

This makes the code marginally clearer even though it is still not obvious
what we are trying to achieve, and it also removes a CanOrd equality.
---
 kernel/subtyping.ml | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/kernel/subtyping.ml b/kernel/subtyping.ml
index 7cb459fa7304..0443f7b57682 100644
--- a/kernel/subtyping.ml
+++ b/kernel/subtyping.ml
@@ -228,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;

From 266d71ee90b11efb9c1ab01afc75877ecaa21610 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Thu, 30 Apr 2026 13:50:57 +0200
Subject: [PATCH 475/578] Simpler implementation of undefined_evars_cache

avoids generating a dummy decl
---
 engine/evarutil.ml | 24 +++++++++---------------
 1 file changed, 9 insertions(+), 15 deletions(-)

diff --git a/engine/evarutil.ml b/engine/evarutil.ml
index 296868d28001..931cba33f676 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
@@ -688,6 +687,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 +702,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

From 75a3e91388ddedbd2b6daadecbf29d38b568c2bb Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Mon, 4 May 2026 16:26:18 +0200
Subject: [PATCH 476/578] Introduce user-based sets and maps for projections.

It was probably an error to have introduced canonical-based types for
projections but at least it has not spread around a lot.
---
 kernel/names.ml  | 3 +++
 kernel/names.mli | 3 +++
 2 files changed, 6 insertions(+)

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 4ee6d44c3cf4..71cf3bd82350 100644
--- a/kernel/names.mli
+++ b/kernel/names.mli
@@ -620,6 +620,9 @@ 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
 
+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
 

From 4359cc8ee75de22d0b109b77069cb7a9558fe769 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Mon, 4 May 2026 16:27:39 +0200
Subject: [PATCH 477/578] Expose userord-based sets for unfoldable globals in
 hint databases.

To preserve the previous behaviour, we canonicalize the references before
storing them in the set.
---
 tactics/eauto.ml  | 12 ++++++------
 tactics/hints.ml  | 14 +++++++++-----
 tactics/hints.mli |  2 +-
 3 files changed, 16 insertions(+), 12 deletions(-)

diff --git a/tactics/eauto.ml b/tactics/eauto.ml
index ca3e4b9902c5..2340da4f8b35 100644
--- a/tactics/eauto.ml
+++ b/tactics/eauto.ml
@@ -414,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
@@ -434,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 *)
@@ -447,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) ->
@@ -484,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/hints.ml b/tactics/hints.ml
index 57006c9be9f1..14229a968862 100644
--- a/tactics/hints.ml
+++ b/tactics/hints.ml
@@ -608,7 +608,7 @@ val set_transparent_state : t -> TransparentState.t -> t
 val add_cut : Environ.env -> hints_path -> 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 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
@@ -620,7 +620,7 @@ 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_env.t;
@@ -635,7 +635,7 @@ 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_env.empty;
@@ -775,9 +775,13 @@ 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
diff --git a/tactics/hints.mli b/tactics/hints.mli
index 39cf274c80f8..4101e107eb67 100644
--- a/tactics/hints.mli
+++ b/tactics/hints.mli
@@ -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

From a4996beb20f0d2102245c6bfa4cd1ae4c08f2478 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Mon, 4 May 2026 16:38:05 +0200
Subject: [PATCH 478/578] Remove non needed check_required_library in
 Generalize.abstract_args

Dependent equality is not always used by this function so this
restriction is too strong.

Even if it was needed we should check the register not the library.
---
 tactics/generalize.ml | 1 -
 1 file changed, 1 deletion(-)

diff --git a/tactics/generalize.ml b/tactics/generalize.ml
index cf11b59e1875..f6d3207a98db 100644
--- a/tactics/generalize.ml
+++ b/tactics/generalize.ml
@@ -488,7 +488,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

From adc572a90bd5f1ff540dcd1b6eafdd7b5633c879 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Mon, 4 May 2026 17:56:59 +0200
Subject: [PATCH 479/578] Rely on user name equality for kernel conversion fast
 path.

Hopefully this should not matter too much, since comparing aliased
names should be fairly uncommon.
---
 kernel/conversion.ml | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/kernel/conversion.ml b/kernel/conversion.ml
index 6d003e814555..770b08d6395c 100644
--- a/kernel/conversion.ml
+++ b/kernel/conversion.ml
@@ -343,14 +343,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

From f71b893af85b29dcbdefba461994c838cc8d5a98 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Tue, 5 May 2026 10:25:52 +0200
Subject: [PATCH 480/578] Add overlays.

---
 dev/ci/user-overlays/21999-ppedrot-hints-unfolds-use-env-set.sh | 1 +
 1 file changed, 1 insertion(+)
 create mode 100644 dev/ci/user-overlays/21999-ppedrot-hints-unfolds-use-env-set.sh

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

From 33609b88930f84de00b64d9bc4094acfa3eb8337 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Tue, 5 May 2026 11:36:29 +0200
Subject: [PATCH 481/578] Correctly expand included modules in Declaremods
 "with Module".

The function computing the libobjects of a module generated through
the "with Module" construction was treating module inclusion as a
plain libobject, even though it actually stood for its expansion.
We fix this by expanding the IncludeObject entry on the fly.

Fixes #20254: Anomaly by including a module type in a module.
---
 test-suite/bugs/bug_19994.v | 28 ++++++++++++++++++++++++++++
 test-suite/bugs/bug_20254.v | 32 ++++++++++++++++++++++++++++++++
 vernac/declaremods.ml       |  2 ++
 3 files changed, 62 insertions(+)
 create mode 100644 test-suite/bugs/bug_19994.v
 create mode 100644 test-suite/bugs/bug_20254.v

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_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/vernac/declaremods.ml b/vernac/declaremods.ml
index d42f59ba3189..31780b8f57a4 100644
--- a/vernac/declaremods.ml
+++ b/vernac/declaremods.ml
@@ -700,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

From 5c1391640aec568062cc069c3cf2a12c7cee3b6c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Mon, 4 May 2026 16:41:24 +0200
Subject: [PATCH 482/578] generalize_eqs_vars fix incorrect selection of
 variables to generalize

Fix #22000
---
 .../user-overlays/22001-SkySkimmer-gene-eqs-vars.sh  |  4 ++++
 .../04-tactics/22001-gene-eqs-vars-Changed.rst       |  6 ++++++
 tactics/generalize.ml                                |  7 ++++++-
 test-suite/bugs/bug_22000.v                          | 12 ++++++++++++
 4 files changed, 28 insertions(+), 1 deletion(-)
 create mode 100644 dev/ci/user-overlays/22001-SkySkimmer-gene-eqs-vars.sh
 create mode 100644 doc/changelog/04-tactics/22001-gene-eqs-vars-Changed.rst
 create mode 100644 test-suite/bugs/bug_22000.v

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/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 <https://github.com/rocq-prover/rocq/pull/22001>`_,
+  fixes `#22000 <https://github.com/rocq-prover/rocq/issues/22000>`_,
+  by Gaëtan Gilbert).
diff --git a/tactics/generalize.ml b/tactics/generalize.ml
index f6d3207a98db..e87a00534ac8 100644
--- a/tactics/generalize.ml
+++ b/tactics/generalize.ml
@@ -364,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,[])
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.

From 7aa7dd18e742526c297bf52b90cdc616ade2fb2f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Tue, 5 May 2026 14:44:16 +0200
Subject: [PATCH 483/578] Don't use Qed to avoid async proofs in TC debug
 output test

---
 test-suite/output/TypeclassDebug.v | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/test-suite/output/TypeclassDebug.v b/test-suite/output/TypeclassDebug.v
index 907dfd97f5e8..9961fef15709 100644
--- a/test-suite/output/TypeclassDebug.v
+++ b/test-suite/output/TypeclassDebug.v
@@ -26,7 +26,7 @@ Section Resolve.
   Goal bar.
   Proof.
     typeclasses eauto with foo.
-  Qed.
+  Defined.
 End Resolve.
 
 Section ExternApply.
@@ -35,7 +35,7 @@ Section ExternApply.
   Goal bar.
   Proof.
     typeclasses eauto with foo.
-  Qed.
+  Defined.
 End ExternApply.
 
 Section ExternTC.
@@ -44,5 +44,5 @@ Section ExternTC.
   Goal bar.
   Proof.
     typeclasses eauto with foo.
-  Qed.
+  Defined.
 End ExternTC.

From 24ae9784df7cd19b41c748abdc8bd810c53bb34d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Thu, 23 Apr 2026 14:44:14 +0200
Subject: [PATCH 484/578] Profiler attempt to measure heap size

---
 dev/bench/benchUtil.ml    |  7 ++++++-
 dev/bench/benchUtil.mli   |  7 ++++++-
 dev/bench/htmloutput.ml   | 10 ++++++++--
 dev/bench/profparser.ml   |  8 ++++++--
 dev/bench/timelog2html.ml |  2 +-
 lib/newProfile.ml         |  7 +++++++
 6 files changed, 34 insertions(+), 7 deletions(-)

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..163ca838daaf 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 -> ()
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/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)

From f27a42e59c7e30133bc33ca80dbdd94e2baa0e28 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Fri, 24 Apr 2026 14:37:01 +0200
Subject: [PATCH 485/578] timelog2html visuals for heap usage

---
 dev/bench/htmloutput.ml                  | 40 +++++++++++++++++++++---
 test-suite/misc/bench-render/result.html | 27 +++++++++-------
 2 files changed, 51 insertions(+), 16 deletions(-)

diff --git a/dev/bench/htmloutput.ml b/dev/bench/htmloutput.ml
index 163ca838daaf..0dbe6cd05747 100644
--- a/dev/bench/htmloutput.ml
+++ b/dev/bench/htmloutput.ml
@@ -74,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
@@ -85,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
 {|<html>
@@ -97,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
 
@@ -145,6 +159,17 @@ in
 
 let () = out "</ol>\n" in
 
+let () =
+  out {|<input type="radio" name="mode" id="time" checked><label for="time">Time</label>
+|}
+in
+
+let () =
+  if maxheap > 0 then
+    out {|<input type="radio" name="mode" id="memory"><label for="memory">Memory</label>
+|}
+in
+
 let () = out "<pre>" in
 
 let last_seen_line = ref 0 in
@@ -168,9 +193,14 @@ Line: %d
     let () = out {|">|} in
 
     let () = data |> Array.iteri (fun k d ->
-        out {|<div class="time%d" style="width: %f%%"></div>|}
+        out {|<div class="measure%d time" style="width: %f%%"></div>|}
           (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 {|<div class="measure%d memory" style="width: %f%%"></div>|}
+              (k+1)
+              (percentage (Q.of_int heap) ~max:(Q.of_int maxheap))))
     in
 
     let text = loc.text in
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 @@
 <head>
 <title>foo.v</title>
 <style>
-.time1 {
+.measure1 {
   background-color: #F08080;
   height: 50%;
   top: 0%;
   z-index: -1;
   position: absolute;
-  opacity: 50%;
+  opacity: 0%;
 }
-.time2 {
+#time:checked ~ pre .time { opacity: 50%; }
+#memory:checked ~ pre .memory { opacity: 50%; }
+.measure2 {
   background-color: #EEE8AA;
   height: 50%;
   top: 50%;
   z-index: -1;
   position: absolute;
-  opacity: 50%;
+  opacity: 0%;
 }
+#time:checked ~ pre .time { opacity: 50%; }
+#memory:checked ~ pre .memory { opacity: 50%; }
 .code {
   z-index: 0;
   position: relative;
@@ -42,12 +46,13 @@ <h1>Timings for foo.v</h1>
 <li style="background-color: #F08080">foo.v.time1 (total time: 3s)</li>
 <li style="background-color: #EEE8AA">foo.v.time2 (total time: 2.5s)</li>
 </ol>
+<input type="radio" name="mode" id="time" checked><label for="time">Time</label>
 <pre><div class="code" title="File: foo.v
 Line: 1
 
 Time1: 0s
 Time2: 0s
-"><div class="time1" style="width: 0.000000%"></div><div class="time2" style="width: 0.000000%"></div><code id="L1" data-line="1">(* some comment *)</code>
+"><div class="measure1 time" style="width: 0.000000%"></div><div class="measure2 time" style="width: 0.000000%"></div><code id="L1" data-line="1">(* some comment *)</code>
 <code id="L2" data-line="2"></code>
 <code id="L3" data-line="3">(* other comment</code>
 <code id="L4" data-line="4"></code>
@@ -60,13 +65,13 @@ <h1>Timings for foo.v</h1>
 
 Time1: 2.s
 Time2: 0.s
-"><div class="time1" style="width: 100.000000%"></div><div class="time2" style="width: 0.000000%"></div><code id="L9" data-line="9">Definition a := 1.</code>
+"><div class="measure1 time" style="width: 100.000000%"></div><div class="measure2 time" style="width: 0.000000%"></div><code id="L9" data-line="9">Definition a := 1.</code>
 </div><div class="code" title="File: foo.v
 Line: 10
 
 Time1: 1.s
 Time2: 1.s
-"><div class="time1" style="width: 50.000000%"></div><div class="time2" style="width: 50.000000%"></div><code id="L10" data-line="10"></code>
+"><div class="measure1 time" style="width: 50.000000%"></div><div class="measure2 time" style="width: 50.000000%"></div><code id="L10" data-line="10"></code>
 <code id="L11" data-line="11">Definition b :=</code>
 <code id="L12" data-line="12">  2.</code>
 </div><div class="code" title="File: foo.v
@@ -74,26 +79,26 @@ <h1>Timings for foo.v</h1>
 
 Time1: 0.s
 Time2: 1.5s
-"><div class="time1" style="width: 0.000000%"></div><div class="time2" style="width: 75.000000%"></div><code id="L13" data-line="13"></code>
+"><div class="measure1 time" style="width: 0.000000%"></div><div class="measure2 time" style="width: 75.000000%"></div><code id="L13" data-line="13"></code>
 <code id="L14" data-line="14">Definition c := 3.</code>
 </div><div class="code" title="File: foo.v
 Line: 14
 
 Time1: 0s
 Time2: 0s
-"><div class="time1" style="width: 0.000000%"></div><div class="time2" style="width: 0.000000%"></div><code data-line="14"> (* hello *)</code>
+"><div class="measure1 time" style="width: 0.000000%"></div><div class="measure2 time" style="width: 0.000000%"></div><code data-line="14"> (* hello *)</code>
 </div><div class="code" title="File: foo.v
 Line: 14
 
 Time1: 0.s
 Time2: 0.s
-"><div class="time1" style="width: 0.000000%"></div><div class="time2" style="width: 0.000000%"></div><code data-line="14"> Definition d := 4.</code>
+"><div class="measure1 time" style="width: 0.000000%"></div><div class="measure2 time" style="width: 0.000000%"></div><code data-line="14"> Definition d := 4.</code>
 </div><div class="code" title="File: foo.v
 Line: 15
 
 Time1: 0s
 Time2: 0s
-"><div class="time1" style="width: 0.000000%"></div><div class="time2" style="width: 0.000000%"></div><code id="L15" data-line="15"></code>
+"><div class="measure1 time" style="width: 0.000000%"></div><div class="measure2 time" style="width: 0.000000%"></div><code id="L15" data-line="15"></code>
 <code id="L16" data-line="16">(* end of file comment *)</code>
 <code id="L17" data-line="17"></code>
 </div>

From b77272f6b70937acbb45380e8fdcd7fe11c044ce Mon Sep 17 00:00:00 2001
From: Yann Leray <yann.leray@inria.fr>
Date: Tue, 5 May 2026 18:20:49 +0200
Subject: [PATCH 486/578] Make RR variables not being unifiable structural

---
 pretyping/evarconv.ml    | 20 ++++++++++----------
 pretyping/evarsolve.ml   | 22 +++++++++++-----------
 pretyping/evarsolve.mli  |  6 +++---
 pretyping/unification.ml | 12 ++++++------
 4 files changed, 30 insertions(+), 30 deletions(-)

diff --git a/pretyping/evarconv.ml b/pretyping/evarconv.ml
index 6535830e2bbe..5f7751267b0b 100644
--- a/pretyping/evarconv.ml
+++ b/pretyping/evarconv.ml
@@ -179,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
@@ -247,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
@@ -750,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 _)) ->
@@ -761,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 _)) ->
@@ -1972,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 *)
@@ -1982,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 *)
@@ -2010,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/evarsolve.ml b/pretyping/evarsolve.ml
index f74c76d69288..f2ea3ac34a01 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)
@@ -62,8 +62,8 @@ type unify_flags = {
 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
@@ -167,7 +167,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
@@ -1432,8 +1432,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
@@ -1512,7 +1512,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
@@ -1736,7 +1736,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
@@ -1808,7 +1808,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..1d001982b4e1 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,7 +60,7 @@ type unification_result =
 
 val is_success : unification_result -> bool
 
-val is_evar_allowed : unify_flags -> Evar.t -> bool
+val is_evar_allowed : unify_flags -> evar_map -> Evar.t -> bool
 
 val allow_all_but_rrpat_evars : evar_map -> AllowedEvars.t
 
diff --git a/pretyping/unification.ml b/pretyping/unification.ml
index 95ae3f13d918..099c895b18bc 100644
--- a/pretyping/unification.ml
+++ b/pretyping/unification.ml
@@ -963,11 +963,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
 
 
@@ -1175,7 +1175,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 ->
@@ -1184,14 +1184,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

From 1f1d459e6fffed9ca59ccb713f6b2cec71aa0f08 Mon Sep 17 00:00:00 2001
From: Yann Leray <yann.leray@inria.fr>
Date: Tue, 14 Apr 2026 18:36:42 +0200
Subject: [PATCH 487/578] Prevent downcast on RR evars

---
 engine/evd.ml | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/engine/evd.ml b/engine/evd.ml
index f66fbf7a53c9..f1a225487481 100644
--- a/engine/evd.ml
+++ b/engine/evd.ml
@@ -941,6 +941,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 }

From d1f11db6e6471faeef7010d9fb99b0f1ecd0666f Mon Sep 17 00:00:00 2001
From: Yann Leray <yann.leray@inria.fr>
Date: Tue, 5 May 2026 18:36:28 +0200
Subject: [PATCH 488/578] Undo adhoc exclusion of RR evar unification

---
 engine/evd.ml           |  2 --
 engine/evd.mli          |  3 ---
 pretyping/coercion.ml   |  5 +----
 pretyping/evarsolve.ml  |  3 ---
 pretyping/evarsolve.mli |  2 --
 pretyping/pretyping.ml  | 15 ++++-----------
 6 files changed, 5 insertions(+), 25 deletions(-)

diff --git a/engine/evd.ml b/engine/evd.ml
index f1a225487481..8a79608a92a9 100644
--- a/engine/evd.ml
+++ b/engine/evd.ml
@@ -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
diff --git a/engine/evd.mli b/engine/evd.mli
index 333d770811ba..d3dea4102c9a 100644
--- a/engine/evd.mli
+++ b/engine/evd.mli
@@ -371,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 *)
 
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/evarsolve.ml b/pretyping/evarsolve.ml
index f2ea3ac34a01..2f89f4e578c0 100644
--- a/pretyping/evarsolve.ml
+++ b/pretyping/evarsolve.ml
@@ -59,9 +59,6 @@ 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 sigma evk =
   AllowedEvars.mem flags.allowed_evars sigma evk
 
diff --git a/pretyping/evarsolve.mli b/pretyping/evarsolve.mli
index 1d001982b4e1..cb73ec9e0cd6 100644
--- a/pretyping/evarsolve.mli
+++ b/pretyping/evarsolve.mli
@@ -62,8 +62,6 @@ val is_success : unification_result -> bool
 
 val is_evar_allowed : unify_flags -> evar_map -> Evar.t -> bool
 
-val allow_all_but_rrpat_evars : evar_map -> AllowedEvars.t
-
 (** Replace the vars and rels that are aliases to other vars and rels by
    their representative that is most ancient in the context *)
 val expand_vars_in_term : env -> evar_map -> constr -> constr
diff --git a/pretyping/pretyping.ml b/pretyping/pretyping.ml
index d286cb565309..2faea419716a 100644
--- a/pretyping/pretyping.ml
+++ b/pretyping/pretyping.ml
@@ -371,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
 
@@ -680,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 ++
@@ -705,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 ++
@@ -1304,7 +1297,7 @@ 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

From 595aee715e24b9377d0dec741ba1e3b0dc3786c3 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Wed, 6 May 2026 08:38:45 +0200
Subject: [PATCH 489/578] Deprecate the canord-based PRset and PRmap modules
 from the Names API.

There is still one place in conversion oracles where we need to emulate
the old behaviour, but this is before the introduction of environments in
the chain of dependences so we cannot use the Q-variant. Thus we simply
redefine the CanOrd map module internally. This is a net gain since this
is abstracted away while removing the tempting CanOrd API from the public
Names module.
---
 kernel/conv_oracle.ml | 3 +++
 kernel/names.mli      | 8 +++++++-
 2 files changed, 10 insertions(+), 1 deletion(-)

diff --git a/kernel/conv_oracle.ml b/kernel/conv_oracle.ml
index a39b4317fff4..7b714253f323 100644
--- a/kernel/conv_oracle.ml
+++ b/kernel/conv_oracle.ml
@@ -34,6 +34,9 @@ let is_transparent = function
 | Level 0 -> true
 | _ -> false
 
+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;
diff --git a/kernel/names.mli b/kernel/names.mli
index 71cf3bd82350..d304e1bc39b2 100644
--- a/kernel/names.mli
+++ b/kernel/names.mli
@@ -618,7 +618,13 @@ 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

From 90f1837474c9935b9dee086462180bc3ae309b58 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Wed, 6 May 2026 09:21:50 +0200
Subject: [PATCH 490/578] Do not perform useless context type conversions in
 Logic reordering.

The function now operates directly on named_context_val rather than having
to convert back and forth from named contexts for no good reason.
---
 proofs/logic.ml | 11 +++++------
 1 file changed, 5 insertions(+), 6 deletions(-)

diff --git a/proofs/logic.ml b/proofs/logic.ml
index b46b1631a1e5..25dc273883f5 100644
--- a/proofs/logic.ml
+++ b/proofs/logic.ml
@@ -82,7 +82,7 @@ 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
+      | [] -> List.fold_left (fun accu decl -> EConstr.push_named_context_val decl accu) ctxt_head ctxt_tail
       | 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
@@ -94,9 +94,9 @@ let reorder_context env sigma sign ord =
                   (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 ->
+          (match EConstr.match_named_context_val ctxt_head with
+            | None -> error_no_such_hypothesis env sigma (List.hd ord)
+            | Some (d, ctxt) ->
                 let x = NamedDecl.get_id d in
                 if Id.Set.mem x expected then
                   step ord (Id.Set.remove x expected)
@@ -112,8 +112,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

From f2f00a4b0bc4b6faf921f1ffae57bfaf00673c26 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Wed, 6 May 2026 09:37:32 +0200
Subject: [PATCH 491/578] Use quotiented constant maps in Dumpglob.

---
 interp/dumpglob.ml  | 8 ++++----
 interp/dumpglob.mli | 4 ++--
 vernac/declare.ml   | 4 ++--
 3 files changed, 8 insertions(+), 8 deletions(-)

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/vernac/declare.ml b/vernac/declare.ml
index c33cba13fd5e..8bc033f82fa2 100644
--- a/vernac/declare.ml
+++ b/vernac/declare.ml
@@ -413,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
@@ -440,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

From 9ca46cb9fdf4ba9aabecf9a79b3dfc7ce7566896 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Wed, 6 May 2026 09:40:52 +0200
Subject: [PATCH 492/578] Use quotiented constant maps in Reductionops.

---
 pretyping/reductionops.ml | 15 ++++++++-------
 1 file changed, 8 insertions(+), 7 deletions(-)

diff --git a/pretyping/reductionops.ml b/pretyping/reductionops.ml
index d7fa36cdc60e..9195b1a1f216 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

From 4760802d2066a36d20798560a5f95ba57f2d16ff Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Wed, 6 May 2026 09:43:29 +0200
Subject: [PATCH 493/578] Deprecate the canord-based maps and sets of
 constants.

---
 kernel/conv_oracle.ml |  1 +
 kernel/names.mli      | 10 +++++++---
 2 files changed, 8 insertions(+), 3 deletions(-)

diff --git a/kernel/conv_oracle.ml b/kernel/conv_oracle.ml
index 7b714253f323..10bb34cb3840 100644
--- a/kernel/conv_oracle.ml
+++ b/kernel/conv_oracle.ml
@@ -34,6 +34,7 @@ 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? *)
 
diff --git a/kernel/names.mli b/kernel/names.mli
index d304e1bc39b2..8d2cf53adb96 100644
--- a/kernel/names.mli
+++ b/kernel/names.mli
@@ -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).

From 32f2cb23bcbaa27497f7c5cdd7a1daa90d7fc736 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Thu, 7 May 2026 15:00:50 +0200
Subject: [PATCH 494/578] Fix nametab handling when printing abbreviation

Fix #21995
---
 interp/notation.ml              | 4 +++-
 test-suite/output/bug_21995.out | 3 +++
 test-suite/output/bug_21995.v   | 6 ++++++
 vernac/prettyp.ml               | 5 ++++-
 4 files changed, 16 insertions(+), 2 deletions(-)
 create mode 100644 test-suite/output/bug_21995.out
 create mode 100644 test-suite/output/bug_21995.v

diff --git a/interp/notation.ml b/interp/notation.ml
index d1327f62aaf7..b1fdb1a02314 100644
--- a/interp/notation.ml
+++ b/interp/notation.ml
@@ -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/test-suite/output/bug_21995.out b/test-suite/output/bug_21995.out
new file mode 100644
index 000000000000..6186029b2e72
--- /dev/null
+++ b/test-suite/output/bug_21995.out
@@ -0,0 +1,3 @@
+Notation Y := M.Y
+
+*** [ M.Y : Prop ]
diff --git a/test-suite/output/bug_21995.v b/test-suite/output/bug_21995.v
new file mode 100644
index 000000000000..ba55ef2ce3bb
--- /dev/null
+++ b/test-suite/output/bug_21995.v
@@ -0,0 +1,6 @@
+Module Import M.
+  Axiom Y : Prop.
+End M.
+
+Abbreviation Y := M.Y.
+Print Y.
diff --git a/vernac/prettyp.ml b/vernac/prettyp.ml
index 03ebd7bdbe97..b4e996be3ad6 100644
--- a/vernac/prettyp.ml
+++ b/vernac/prettyp.ml
@@ -659,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 =

From 9d8ff3593569aef7e7ee71a56215c6b87bfa332c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Thu, 7 May 2026 15:38:37 +0200
Subject: [PATCH 495/578] Bench automatic overlay system

---
 dev/bench/bench.sh | 32 ++++++++++++++++++++++++++++++++
 1 file changed, 32 insertions(+)

diff --git a/dev/bench/bench.sh b/dev/bench/bench.sh
index 5dd12ce0d7e9..cce6272a8b74 100755
--- a/dev/bench/bench.sh
+++ b/dev/bench/bench.sh
@@ -51,6 +51,7 @@ check_variable () {
 : "${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_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,36 @@ 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"
+
+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 +142,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

From c83f03be87b2bdd330a6c86b5739d0706f3e16b5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Sun, 10 May 2026 18:28:21 +0200
Subject: [PATCH 496/578] Update default package list in bench after
 rocq-prover/opam#3726

---
 dev/bench/bench.sh | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/dev/bench/bench.sh b/dev/bench/bench.sh
index 5dd12ce0d7e9..4ccd18750053 100755
--- a/dev/bench/bench.sh
+++ b/dev/bench/bench.sh
@@ -49,7 +49,7 @@ 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:=}"
 
 # example: coq-hott.dev git+https://github.com/some-user/coq-hott#some-branch

From f69fce171fe7939847c935e54ac621b2074a9aa2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Sat, 28 Mar 2026 16:48:40 +0100
Subject: [PATCH 497/578] Allow setting a root in AcyclicGraph.

We do not have to explicitly register it when building the empty graph.
---
 kernel/qGraph.ml     | 1 +
 kernel/uGraph.ml     | 7 ++-----
 lib/acyclicGraph.ml  | 8 +++++++-
 lib/acyclicGraph.mli | 1 +
 4 files changed, 11 insertions(+), 6 deletions(-)

diff --git a/kernel/qGraph.ml b/kernel/qGraph.ml
index 754238f09823..609f46a287b0 100644
--- a/kernel/qGraph.ml
+++ b/kernel/qGraph.ml
@@ -35,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
 
diff --git a/kernel/uGraph.ml b/kernel/uGraph.ml
index 224dacd8c5b8..0af81414463c 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
 
@@ -84,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}
 
diff --git a/lib/acyclicGraph.ml b/lib/acyclicGraph.ml
index 0719f799f870..e70edadd656c 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
 
@@ -682,7 +683,12 @@ module Make (Point:Point) = struct
     with CycleDetected -> None
 
   let empty =
-    { entries = PMap.empty; index = 0; n_nodes = 0; n_edges = 0; table = Index.empty }
+    let ans = { entries = PMap.empty; index = 0; n_nodes = 0; n_edges = 0; table = Index.empty } in
+    match Point.root with
+    | None -> ans
+    | Some root ->
+      let big_rank = 1000000 in
+      add ~rank:big_rank root ans
 
   (* Normalization *)
 
diff --git a/lib/acyclicGraph.mli b/lib/acyclicGraph.mli
index 637a4b341ce3..b658844770f7 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
 

From 39cbebe1ee429f4d2e333a883aa3703fdde86b38 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Sat, 28 Mar 2026 16:54:54 +0100
Subject: [PATCH 498/578] Keep track of components in AcyclicGraph data
 structure.

---
 lib/acyclicGraph.ml | 59 +++++++++++++++++++++++++++++++--------------
 1 file changed, 41 insertions(+), 18 deletions(-)

diff --git a/lib/acyclicGraph.ml b/lib/acyclicGraph.ml
index e70edadd656c..877037214128 100644
--- a/lib/acyclicGraph.ml
+++ b/lib/acyclicGraph.ml
@@ -123,11 +123,16 @@ module Make (Point:Point) = struct
     | Canonical of canonical_node
     | Equiv of Index.t
 
+  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;
+    }
 
   module CN = struct
     type t = canonical_node
@@ -147,36 +152,53 @@ 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 _ -> assert false
+    in
+    { entries = PMap.set u (Equiv v) 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;
+    }
 
   (* 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 _ -> 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 =
@@ -524,7 +546,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 }
 
   let check_declared g us =
     let check l = not (Index.mem l g.table) in
@@ -683,7 +706,7 @@ module Make (Point:Point) = struct
     with CycleDetected -> None
 
   let empty =
-    let ans = { entries = PMap.empty; index = 0; n_nodes = 0; n_edges = 0; table = Index.empty } in
+    let ans = { entries = PMap.empty; index = 0; n_nodes = 0; n_edges = 0; table = Index.empty; components = Int.Map.empty } in
     match Point.root with
     | None -> ans
     | Some root ->

From bfc706e96bcf67f234f8e570ddbadf891a716810 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Mon, 30 Mar 2026 11:11:44 +0200
Subject: [PATCH 499/578] Remove root from AcyclicGraph internal graph.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

The most expensive kind of level constraint in the current algorithm is of the
form "enforce u ≤ Set". Indeed the forward pass has to crawl basically the whole
graph starting from Set, as all levels are above Set. This is the worst case for
the complexity of our variant of the Tarjan algorithm, which expects the graph to
be sparse. Unfortunately, in practice such constraints seem to be commonplace in
universe-polymorphic code.

To work around this issue, in this commit we try to handle Set in a special way
by not storing it in the graph as a normal node. Instead we assume "Set ≤ u"
implicitly everywhere, and we only keep a set of constraints "Set < u". We
still have to perform a kind of forward pass to merge a level with Set, but we
do so hopefully efficiently by leveraging the topological order maintained by
the algorithm.
---
 lib/acyclicGraph.ml | 293 ++++++++++++++++++++++++++++++++++++--------
 1 file changed, 245 insertions(+), 48 deletions(-)

diff --git a/lib/acyclicGraph.ml b/lib/acyclicGraph.ml
index 877037214128..337e385d0304 100644
--- a/lib/acyclicGraph.ml
+++ b/lib/acyclicGraph.ml
@@ -115,13 +115,18 @@ 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 *)
@@ -132,6 +137,7 @@ module Make (Point:Point) = struct
       n_nodes : int; n_edges : int;
       table : Index.table;
       components : components;
+      rootlt : PSet.t; (* nodes strictly above the root *)
     }
 
   module CN = struct
@@ -177,14 +183,19 @@ module Make (Point:Point) = struct
   let enter_equiv g u v =
     let ucan = match PMap.find u g.entries with
     | Canonical n -> n
-    | Equiv _ -> assert false
+    | Equiv _ | Root -> assert false
     in
-    { entries = PMap.set u (Equiv v) g.entries;
+    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;
       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.
@@ -194,7 +205,7 @@ module Make (Point:Point) = struct
   let change_node g n =
     let ucan = match PMap.find n.canon g.entries with
     | Canonical n -> n
-    | Equiv _ -> assert false
+    | 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
@@ -205,6 +216,13 @@ module Make (Point:Point) = struct
     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)
@@ -247,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))
@@ -256,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)
@@ -273,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)
@@ -418,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 =
@@ -471,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;
@@ -480,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)
@@ -531,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
@@ -547,7 +666,7 @@ module Make (Point:Point) = struct
       in
       let entries = PMap.add v (Canonical node) g.entries in
       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 }
+      { 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
@@ -559,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
@@ -590,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
 
@@ -642,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
@@ -659,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
@@ -677,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
@@ -692,26 +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<v if possible, will fail otherwise *)
-  let enforce_lt u v g =
-    let ucan = repr_node g u in
-    let vcan = repr_node g v in
+  let enforce_lt u v g = match repr_or_root_node g u, repr_or_root_node g v with
+  | None, None -> 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 =
-    let ans = { entries = PMap.empty; index = 0; n_nodes = 0; n_edges = 0; table = Index.empty; components = Int.Map.empty } in
-    match Point.root with
-    | None -> ans
-    | Some root ->
-      let big_rank = 1000000 in
-      add ~rank:big_rank root ans
+  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 *)
 
@@ -723,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
@@ -744,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
@@ -774,7 +941,16 @@ 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
@@ -787,7 +963,10 @@ module Make (Point:Point) = struct
 
   let choose p g u =
     let exception Found of Point.t in
-    let ru = (repr_node g u).canon in
+    let ru = match repr_or_root_node g u with
+    | None -> Index.find (Option.get Point.root) g.table
+    | Some arcu -> arcu.canon
+    in
     let ruv = Index.repr ru g.table in
     if p ruv then Some ruv
     else
@@ -800,6 +979,9 @@ module Make (Point:Point) = struct
               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. *)
+          | Root ->
+            let root = Option.get Point.root in
+            if p root then raise_notrace (Found root)
         ) g.entries; None
       with Found v -> Some v
 
@@ -814,6 +996,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

From 90f587ba8ad94d0fda94dc7b0150dbbb53720a3a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Fri, 3 Apr 2026 08:30:54 +0200
Subject: [PATCH 500/578] Constr-as-datatype functions now use the user name
 for references.

This is a follow-up of #21863. Since it is clear that these functions
are only used by plugins to manipulate terms as blobs, we should not try
to be too clever by half, so we just ignore the aliasing quotient.
---
 engine/termops.ml | 16 ++++++++--------
 1 file changed, 8 insertions(+), 8 deletions(-)

diff --git a/engine/termops.ml b/engine/termops.ml
index c5bfdedbf3e5..660e57c349df 100644
--- a/engine/termops.ml
+++ b/engine/termops.ml
@@ -1323,11 +1323,11 @@ let constr_ord_int f t1 t2 =
     | 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 (c1,_u1), Const (c2,_u2) -> Constant.UserOrd.compare c1 c2
     | Const _, _ -> -1 | _, Const _ -> 1
-    | Ind (ind1, _u1), Ind (ind2, _u2) -> Ind.CanOrd.compare ind1 ind2
+    | Ind (ind1, _u1), Ind (ind2, _u2) -> Ind.UserOrd.compare ind1 ind2
     | Ind _, _ -> -1 | _, Ind _ -> 1
-    | Construct (ct1,_u1), Construct (ct2,_u2) -> Construct.CanOrd.compare ct1 ct2
+    | 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 [
@@ -1344,7 +1344,7 @@ let constr_ord_int f t1 t2 =
     | 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 (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
@@ -1385,11 +1385,11 @@ let rec hash t =
     | 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))
+      combinesmall 9 (combine (Constant.UserOrd.hash c) (Instance.hash u))
     | Ind (ind,u) ->
-      combinesmall 10 (combine (Ind.CanOrd.hash ind) (Instance.hash u))
+      combinesmall 10 (combine (Ind.UserOrd.hash ind) (Instance.hash u))
     | Construct (c,u) ->
-      combinesmall 11 (combine (Construct.CanOrd.hash c) (Instance.hash 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)))
@@ -1400,7 +1400,7 @@ let rec hash t =
     | 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))
+      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)

From 8a4aa7d2b92fe23612ba9ae9eb4b8578bdcaa506 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Tue, 12 May 2026 16:29:41 +0200
Subject: [PATCH 501/578] Reduce the exposure of QualityOrSet.t type in the
 Retyping API.

This horrendous type should never have escaped from its very specific
use-case, namely to be able to have separate induction principles for
predicates returning a Set or a Type. We expose a proper retyping
primitive giving direct access to the quality, which is what most users
actually rely on.
---
 plugins/extraction/extraction.ml | 8 ++++----
 plugins/funind/indfun.ml         | 4 ++--
 plugins/rtauto/refl_tauto.ml     | 6 +++---
 plugins/ssr/ssrcommon.ml         | 2 +-
 plugins/ssr/ssrequality.ml       | 2 +-
 pretyping/combinators.ml         | 2 +-
 pretyping/detyping.ml            | 6 +++---
 pretyping/retyping.ml            | 5 ++++-
 pretyping/retyping.mli           | 5 ++++-
 tactics/elim.ml                  | 2 +-
 tactics/eqdecide.ml              | 2 +-
 tactics/equality.ml              | 8 ++++----
 tactics/induction.ml             | 2 +-
 tactics/inv.ml                   | 2 +-
 tactics/rewrite.ml               | 4 ++--
 tactics/tacticals.ml             | 4 ++--
 tactics/tactics.ml               | 6 +++---
 vernac/indschemes.ml             | 2 +-
 18 files changed, 39 insertions(+), 33 deletions(-)

diff --git a/plugins/extraction/extraction.ml b/plugins/extraction/extraction.ml
index 13b09ffb04ef..4d9dac9c8fac 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 _ | QGlobal _) -> 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
diff --git a/plugins/funind/indfun.ml b/plugins/funind/indfun.ml
index 3d2f68b6432a..ea707813aee1 100644
--- a/plugins/funind/indfun.ml
+++ b/plugins/funind/indfun.ml
@@ -60,7 +60,7 @@ 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
@@ -79,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/rtauto/refl_tauto.ml b/plugins/rtauto/refl_tauto.ml
index 72f37be96178..96db0296541f 100644
--- a/plugins/rtauto/refl_tauto.ml
+++ b/plugins/rtauto/refl_tauto.ml
@@ -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
@@ -160,7 +160,7 @@ 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
@@ -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
diff --git a/plugins/ssr/ssrcommon.ml b/plugins/ssr/ssrcommon.ml
index bfbad25e5cc8..4d2a659b2702 100644
--- a/plugins/ssr/ssrcommon.ml
+++ b/plugins/ssr/ssrcommon.ml
@@ -490,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
diff --git a/plugins/ssr/ssrequality.ml b/plugins/ssr/ssrequality.ml
index 157b91c32922..ad836e6e113c 100644
--- a/plugins/ssr/ssrequality.ml
+++ b/plugins/ssr/ssrequality.ml
@@ -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)
diff --git a/pretyping/combinators.ml b/pretyping/combinators.ml
index beb8161aa303..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 }
diff --git a/pretyping/detyping.ml b/pretyping/detyping.ml
index 0d17d2454ff6..cca1f9881327 100644
--- a/pretyping/detyping.ml
+++ b/pretyping/detyping.ml
@@ -985,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
diff --git a/pretyping/retyping.ml b/pretyping/retyping.ml
index f111334a5cae..35cef4bd6ca0 100644
--- a/pretyping/retyping.ml
+++ b/pretyping/retyping.ml
@@ -339,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
@@ -361,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 =
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/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/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/equality.ml b/tactics/equality.ml
index a214b5cdb131..77431b5a7e45 100644
--- a/tactics/equality.ml
+++ b/tactics/equality.ml
@@ -902,8 +902,8 @@ let find_positions env sigma ~keep_proofs ~no_discr ~eqsort ~goalsort t1 t2 =
       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 []
@@ -916,7 +916,7 @@ let find_positions env sigma ~keep_proofs ~no_discr ~eqsort ~goalsort 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 = UnivGen.QualityOrSet.quality @@ get_sort_quality_of env sigma ty1 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
@@ -964,7 +964,7 @@ let find_positions env sigma ~keep_proofs ~no_discr ~eqsort ~goalsort t1 t2 =
   in
   try
     let ty1 = get_type_of env sigma t1 in
-    let s = UnivGen.QualityOrSet.quality @@ get_sort_quality_of env sigma ty1 in
+    let s = get_sort_quality_of env sigma ty1 in
     Inr (findrec [] s t1 t2)
   with DiscrFound (path, d) ->
     Inl (path, d)
diff --git a/tactics/induction.ml b/tactics/induction.ml
index 8d15d260e2f4..553fcdfdbfeb 100644
--- a/tactics/induction.ml
+++ b/tactics/induction.ml
@@ -1095,7 +1095,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
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/rewrite.ml b/tactics/rewrite.ml
index a4b42a69e034..6774f94c78d9 100644
--- a/tactics/rewrite.ml
+++ b/tactics/rewrite.ml
@@ -968,8 +968,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 (
diff --git a/tactics/tacticals.ml b/tactics/tacticals.ml
index 251a3c14d454..575dfdfa1434 100644
--- a/tactics/tacticals.ml
+++ b/tactics/tacticals.ml
@@ -586,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 e03e6fccf858..e135080a965b 100644
--- a/tactics/tactics.ml
+++ b/tactics/tactics.ml
@@ -1432,7 +1432,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)
@@ -1497,7 +1497,7 @@ 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
+        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
@@ -2927,7 +2927,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
diff --git a/vernac/indschemes.ml b/vernac/indschemes.ml
index 0c7f7c850968..b65d755cfe97 100644
--- a/vernac/indschemes.ml
+++ b/vernac/indschemes.ml
@@ -495,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

From 491239d044f229f43e94614352a96ef942eab75e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Tue, 12 May 2026 17:54:17 +0200
Subject: [PATCH 502/578] Add overlays.

---
 dev/ci/user-overlays/22016-ppedrot-reduce-sort-quality-of.sh | 1 +
 1 file changed, 1 insertion(+)
 create mode 100644 dev/ci/user-overlays/22016-ppedrot-reduce-sort-quality-of.sh

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

From 321ff69b4134720e433edfee0ea3ecfaa7a190f7 Mon Sep 17 00:00:00 2001
From: Yann Leray <yann.leray@inria.fr>
Date: Tue, 12 May 2026 19:08:06 +0200
Subject: [PATCH 503/578] Have {find,drop}_uniform_parameters work with mutual
 fixpoints correctly

---
 kernel/inductive.ml | 21 ++++++++++-----------
 1 file changed, 10 insertions(+), 11 deletions(-)

diff --git a/kernel/inductive.ml b/kernel/inductive.ml
index c75101758a04..3f421d8097be 100644
--- a/kernel/inductive.ml
+++ b/kernel/inductive.ml
@@ -1390,12 +1390,11 @@ let find_uniform_parameters recindx nargs bodies =
   (* 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 ->
-      let fold accu c = fold_constr_with_binders succ (aux i) k accu c in
+      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
@@ -1411,9 +1410,9 @@ let find_uniform_parameters recindx nargs bodies =
           ) 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
@@ -1423,19 +1422,19 @@ 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 ->
-      let l = List.map (fun c -> aux i k c) l in
-      (* A recursive reference to the i-th body *)
-      if Int.equal n (nbodies + k - i) then
+      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 Term.applist (f, l)
-    | _ -> map_with_binders succ (aux i) k c
+    | _ -> 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 ?evars nr decrarg stack nuniformparams =
   let rec aux i nuniformparams stack =

From 42f8ebccd23989e6600094cfea94d92cd5e31f04 Mon Sep 17 00:00:00 2001
From: Yann Leray <yann.leray@inria.fr>
Date: Wed, 13 May 2026 13:24:36 +0200
Subject: [PATCH 504/578] Always check nested fix lambda domains

---
 kernel/inductive.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/kernel/inductive.ml b/kernel/inductive.ml
index c75101758a04..942b1837a051 100644
--- a/kernel/inductive.ml
+++ b/kernel/inductive.ml
@@ -1704,9 +1704,9 @@ let check_one_fix ?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 NoNeedReduce renv elt stack x a body in
               check_nested_fix_body illformed renv' (decr-1) stack' rs body'
             | [] ->

From a81c284a2cfb252d1de0dfc89af504794c07ca80 Mon Sep 17 00:00:00 2001
From: Yann Leray <yann.leray@inria.fr>
Date: Wed, 13 May 2026 13:45:55 +0200
Subject: [PATCH 505/578] add test

---
 test-suite/bugs/bug_22021.v | 10 ++++++++++
 1 file changed, 10 insertions(+)
 create mode 100644 test-suite/bugs/bug_22021.v

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.

From d53a4581778dabaa7a2144f063563794bf83e5ef Mon Sep 17 00:00:00 2001
From: Thomas Lamiaux <thomas.lamiaux@gmail.com>
Date: Fri, 8 May 2026 16:19:12 +0200
Subject: [PATCH 506/578] Generalize About to allow printing several
 definitions

---
 .../21823-genAbout-Changed.rst                |  4 +++
 .../proof-engine/vernacular-commands.rst      |  6 ++--
 doc/tools/docgram/common.edit_mlg             |  4 +--
 doc/tools/docgram/fullGrammar                 |  2 +-
 doc/tools/docgram/orderedGrammar              |  2 +-
 test-suite/output/PrintInfos.out              | 33 +++++++++++++++++--
 test-suite/output/PrintInfos.v                |  1 +
 vernac/g_vernac.mlg                           |  5 +--
 vernac/ppvernac.ml                            |  7 ++--
 vernac/vernacentries.ml                       |  7 ++--
 vernac/vernacexpr.mli                         |  2 +-
 11 files changed, 58 insertions(+), 15 deletions(-)
 create mode 100644 doc/changelog/08-vernac-commands-and-options/21823-genAbout-Changed.rst

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 <https://github.com/rocq-prover/rocq/pull/21823>`_,
+  by Thomas Lamiaux).
diff --git a/doc/sphinx/proof-engine/vernacular-commands.rst b/doc/sphinx/proof-engine/vernacular-commands.rst
index c3b86e977eab..fc5fdd0bcd45 100644
--- a/doc/sphinx/proof-engine/vernacular-commands.rst
+++ b/doc/sphinx/proof-engine/vernacular-commands.rst
@@ -68,9 +68,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:
diff --git a/doc/tools/docgram/common.edit_mlg b/doc/tools/docgram/common.edit_mlg
index dcdc67f87500..e8a68547df27 100644
--- a/doc/tools/docgram/common.edit_mlg
+++ b/doc/tools/docgram/common.edit_mlg
@@ -1534,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 "."
diff --git a/doc/tools/docgram/fullGrammar b/doc/tools/docgram/fullGrammar
index fa269b344491..f2fac50bdf6c 100644
--- a/doc/tools/docgram/fullGrammar
+++ b/doc/tools/docgram/fullGrammar
@@ -1404,7 +1404,7 @@ 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 "."
diff --git a/doc/tools/docgram/orderedGrammar b/doc/tools/docgram/orderedGrammar
index 6234a16a90e4..3cb883df382b 100644
--- a/doc/tools/docgram/orderedGrammar
+++ b/doc/tools/docgram/orderedGrammar
@@ -1005,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 )
diff --git a/test-suite/output/PrintInfos.out b/test-suite/output/PrintInfos.out
index e59623a8e3d7..27c8555f6e16 100644
--- a/test-suite/output/PrintInfos.out
+++ b/test-suite/output/PrintInfos.out
@@ -97,6 +97,35 @@ Inductive eq (A : Type) (x : A) : A -> Prop :=  eq_refl : x = x.
 
 Arguments eq {A}%_type_scope x _
 Arguments eq_refl {A}%_type_scope {x}, {_} _
+nat_rect :
+forall P : nat -> Type,
+P 0 -> (forall n : nat, P n -> P (S n)) -> forall n : nat, P n
+
+nat_rect is not universe polymorphic
+Arguments nat_rect P%_function_scope O S%_function_scope n%_nat_scope
+nat_rect is transparent
+Expands to: Constant Corelib.Init.Datatypes.nat_rect
+Declared in library Corelib.Init.Datatypes, line 187, characters 0-54
+
+nat_ind :
+forall P : nat -> Prop,
+P 0 -> (forall n : nat, P n -> P (S n)) -> forall n : nat, P n
+
+nat_ind is not universe polymorphic
+Arguments nat_ind P%_function_scope O S%_function_scope n%_nat_scope
+nat_ind is transparent
+Expands to: Constant Corelib.Init.Datatypes.nat_ind
+Declared in library Corelib.Init.Datatypes, line 187, characters 0-54
+
+nat_sind :
+forall P : nat -> SProp,
+P 0 -> (forall n : nat, P n -> P (S n)) -> forall n : nat, P n
+
+nat_sind is not universe polymorphic
+Arguments nat_sind P%_function_scope O S%_function_scope n%_nat_scope
+nat_sind is transparent
+Expands to: Constant Corelib.Init.Datatypes.nat_sind
+Declared in library Corelib.Init.Datatypes, line 187, characters 0-54
 n:nat
 
 Hypothesis of the goal context.
@@ -140,7 +169,7 @@ fst is a projection of prod
 Arguments fst (A B)%_type_scope p
 fst is transparent
 Expands to: Constant PrintInfos.AboutProj.fst
-Declared in library PrintInfos, line 59, characters 21-24
+Declared in library PrintInfos, line 60, characters 21-24
 fst : forall A B : Type, prod A B -> A
 
 fst is not universe polymorphic
@@ -148,4 +177,4 @@ fst is a primitive projection of prod
 Arguments fst (A B)%_type_scope p
 fst is transparent
 Expands to: Constant PrintInfos.AboutPrimProj.fst
-Declared in library PrintInfos, line 65, characters 21-24
+Declared in library PrintInfos, line 66, characters 21-24
diff --git a/test-suite/output/PrintInfos.v b/test-suite/output/PrintInfos.v
index e2ea98e45b0f..748f6872348f 100644
--- a/test-suite/output/PrintInfos.v
+++ b/test-suite/output/PrintInfos.v
@@ -32,6 +32,7 @@ About sym_eq. (* Notation *)
 Arguments eq_refl {A} {x}, {A} x.
 Print eq_refl.
 
+About nat_rect, nat_ind, nat_sind.
 
 Definition newdef := fun x:nat => x.
 
diff --git a/vernac/g_vernac.mlg b/vernac/g_vernac.mlg
index 89e9af80c9d6..9e35d3e86ec6 100644
--- a/vernac/g_vernac.mlg
+++ b/vernac/g_vernac.mlg
@@ -1157,8 +1157,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; "." ->
diff --git a/vernac/ppvernac.ml b/vernac/ppvernac.ml
index 84807c43557b..6bfcfa6f1a32 100644
--- a/vernac/ppvernac.ml
+++ b/vernac/ppvernac.ml
@@ -703,9 +703,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
diff --git a/vernac/vernacentries.ml b/vernac/vernacentries.ml
index 9ec221c16c27..70e20ea46f08 100644
--- a/vernac/vernacentries.ml
+++ b/vernac/vernacentries.ml
@@ -2328,8 +2328,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 ->
diff --git a/vernac/vernacexpr.mli b/vernac/vernacexpr.mli
index 4d57900c9f5c..87b23cb607e5 100644
--- a/vernac/vernacexpr.mli
+++ b/vernac/vernacexpr.mli
@@ -71,7 +71,7 @@ type printable =
   | PrintScopes
   | PrintScope of string
   | PrintVisibility of string option
-  | PrintAbout of qualid or_by_notation * UnivNames.univ_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

From 2dab6983c5c1b5ae0117e1d9d2b604278ac5faa8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Sun, 17 May 2026 01:40:51 +0200
Subject: [PATCH 507/578] Simplification of elim unification flags.

All callers were passing an empty evar map for evar allowance, which meant
that they were all allowed.
---
 pretyping/unification.ml | 11 ++++-------
 1 file changed, 4 insertions(+), 7 deletions(-)

diff --git a/pretyping/unification.ml b/pretyping/unification.ml
index 95ae3f13d918..9a48dd9e82be 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;

From d3a9eea761788233937052f437fd3166ec588520 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Mon, 18 May 2026 12:59:22 +0200
Subject: [PATCH 508/578] coqloop move resynch_buffer inside read_eand_execute
 try block

Fix #22023
---
 toplevel/coqloop.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

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

From 5ee2850d3f9e6d9fe34f0c2d65b2df43c141a6ba Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Mon, 18 May 2026 13:15:53 +0200
Subject: [PATCH 509/578] Remove duplicate package check in bench

Seems useless and is implemented in a fragile way (cf https://gitlab.inria.fr/coq/coq/-/jobs/7329614)
---
 dev/bench/bench.sh | 6 ------
 1 file changed, 6 deletions(-)

diff --git a/dev/bench/bench.sh b/dev/bench/bench.sh
index 4ccd18750053..892a0b290678 100755
--- a/dev/bench/bench.sh
+++ b/dev/bench/bench.sh
@@ -190,12 +190,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

From 7311bac230120599fc44fd1b56999e9819b02cdf Mon Sep 17 00:00:00 2001
From: Yann Leray <yann.leray@inria.fr>
Date: Mon, 18 May 2026 16:25:15 +0200
Subject: [PATCH 510/578] Add critical bug entry

---
 dev/doc/critical-bugs.md | 15 +++++++++++++--
 1 file changed, 13 insertions(+), 2 deletions(-)

diff --git a/dev/doc/critical-bugs.md b/dev/doc/critical-bugs.md
index 6f1cf768760f..dae77afd6099 100644
--- a/dev/doc/critical-bugs.md
+++ b/dev/doc/critical-bugs.md
@@ -29,7 +29,8 @@ This file recollects knowledge about critical bugs found in Coq since version 8.
       - [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 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)
@@ -325,7 +326,7 @@ and lack of checking of relevance marks on constants in coqchk
 - 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
+#### 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
@@ -335,6 +336,16 @@ and lack of checking of relevance marks on constants in coqchk
 - 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

From 0aeb0e03e5ca7f6dd0237a814b5a3909fae891da Mon Sep 17 00:00:00 2001
From: Elsa Rabu <e225544g@etu.univ-nantes.fr>
Date: Tue, 12 May 2026 17:22:57 +0200
Subject: [PATCH 511/578] Generalize Print to print multiple arguments

---
 .../22017-GeneralizePrint-Changed.rst         |  4 ++
 .../proof-engine/vernacular-commands.rst      |  6 ++-
 doc/tools/docgram/common.edit_mlg             |  6 +--
 doc/tools/docgram/fullGrammar                 |  4 +-
 doc/tools/docgram/orderedGrammar              |  2 +-
 test-suite/output/PrintInfos.out              | 39 ++++++++++++++++++-
 test-suite/output/PrintInfos.v                |  1 +
 vernac/g_vernac.mlg                           |  5 ++-
 vernac/ppvernac.ml                            |  5 ++-
 vernac/vernacentries.ml                       |  6 ++-
 vernac/vernacexpr.mli                         |  2 +-
 11 files changed, 63 insertions(+), 17 deletions(-)
 create mode 100644 doc/changelog/08-vernac-commands-and-options/22017-GeneralizePrint-Changed.rst

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 <https://github.com/rocq-prover/rocq/pull/22017>`_,
+  by Elsa Rabu).
diff --git a/doc/sphinx/proof-engine/vernacular-commands.rst b/doc/sphinx/proof-engine/vernacular-commands.rst
index fc5fdd0bcd45..762d248d77fe 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 } {? ; {* @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,
diff --git a/doc/tools/docgram/common.edit_mlg b/doc/tools/docgram/common.edit_mlg
index e8a68547df27..951e57b63d88 100644
--- a/doc/tools/docgram/common.edit_mlg
+++ b/doc/tools/docgram/common.edit_mlg
@@ -1220,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
@@ -1361,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
diff --git a/doc/tools/docgram/fullGrammar b/doc/tools/docgram/fullGrammar
index f2fac50bdf6c..38c9d327a6f8 100644
--- a/doc/tools/docgram/fullGrammar
+++ b/doc/tools/docgram/fullGrammar
@@ -552,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
@@ -1411,7 +1411,7 @@ query_command: [
 ]
 
 printable: [
-| "Term" smart_global OPT univ_name_list
+| "Term" LIST1 [ smart_global OPT univ_name_list ] SEP ","
 | "All"
 | "Section" global
 | "Grammar" OPT "Tree" LIST0 IDENT
diff --git a/doc/tools/docgram/orderedGrammar b/doc/tools/docgram/orderedGrammar
index 3cb883df382b..d677407a4f1b 100644
--- a/doc/tools/docgram/orderedGrammar
+++ b/doc/tools/docgram/orderedGrammar
@@ -795,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
diff --git a/test-suite/output/PrintInfos.out b/test-suite/output/PrintInfos.out
index 27c8555f6e16..b1dec7b7d791 100644
--- a/test-suite/output/PrintInfos.out
+++ b/test-suite/output/PrintInfos.out
@@ -126,6 +126,41 @@ Arguments nat_sind P%_function_scope O S%_function_scope n%_nat_scope
 nat_sind is transparent
 Expands to: Constant Corelib.Init.Datatypes.nat_sind
 Declared in library Corelib.Init.Datatypes, line 187, characters 0-54
+nat_rect =
+fun (P : nat -> Type) (O : P 0) (S : forall n : nat, P n -> P (S n)) =>
+fix F (n : nat) : P n :=
+  match n as n0 return P n0 with
+  | 0 => O
+  | Datatypes.S n0 => S n0 (F n0)
+  end
+     : forall P : nat -> Type,
+       P 0 -> (forall n : nat, P n -> P (S n)) -> forall n : nat, P n
+
+Arguments nat_rect P%_function_scope O S%_function_scope n%_nat_scope
+
+nat_ind =
+fun (P : nat -> Prop) (O : P 0) (S : forall n : nat, P n -> P (S n)) =>
+fix F (n : nat) : P n :=
+  match n as n0 return P n0 with
+  | 0 => O
+  | Datatypes.S n0 => S n0 (F n0)
+  end
+     : forall P : nat -> Prop,
+       P 0 -> (forall n : nat, P n -> P (S n)) -> forall n : nat, P n
+
+Arguments nat_ind P%_function_scope O S%_function_scope n%_nat_scope
+
+nat_sind =
+fun (P : nat -> SProp) (O : P 0) (S : forall n : nat, P n -> P (S n)) =>
+fix F (n : nat) : P n :=
+  match n as n0 return P n0 with
+  | 0 => O
+  | Datatypes.S n0 => S n0 (F n0)
+  end
+     : forall P : nat -> SProp,
+       P 0 -> (forall n : nat, P n -> P (S n)) -> forall n : nat, P n
+
+Arguments nat_sind P%_function_scope O S%_function_scope n%_nat_scope
 n:nat
 
 Hypothesis of the goal context.
@@ -169,7 +204,7 @@ fst is a projection of prod
 Arguments fst (A B)%_type_scope p
 fst is transparent
 Expands to: Constant PrintInfos.AboutProj.fst
-Declared in library PrintInfos, line 60, characters 21-24
+Declared in library PrintInfos, line 61, characters 21-24
 fst : forall A B : Type, prod A B -> A
 
 fst is not universe polymorphic
@@ -177,4 +212,4 @@ fst is a primitive projection of prod
 Arguments fst (A B)%_type_scope p
 fst is transparent
 Expands to: Constant PrintInfos.AboutPrimProj.fst
-Declared in library PrintInfos, line 66, characters 21-24
+Declared in library PrintInfos, line 67, characters 21-24
diff --git a/test-suite/output/PrintInfos.v b/test-suite/output/PrintInfos.v
index 748f6872348f..6b0e8cd17968 100644
--- a/test-suite/output/PrintInfos.v
+++ b/test-suite/output/PrintInfos.v
@@ -33,6 +33,7 @@ Arguments eq_refl {A} {x}, {A} x.
 Print eq_refl.
 
 About nat_rect, nat_ind, nat_sind.
+Print nat_rect, nat_ind, nat_sind.
 
 Definition newdef := fun x:nat => x.
 
diff --git a/vernac/g_vernac.mlg b/vernac/g_vernac.mlg
index 9e35d3e86ec6..8aca1f2d9134 100644
--- a/vernac/g_vernac.mlg
+++ b/vernac/g_vernac.mlg
@@ -1112,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 ->
@@ -1169,7 +1170,7 @@ 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"; tree = OPT [ IDENT "Tree" -> { () } ]; ent = LIST0 IDENT ->
diff --git a/vernac/ppvernac.ml b/vernac/ppvernac.ml
index 6bfcfa6f1a32..70d723e65527 100644
--- a/vernac/ppvernac.ml
+++ b/vernac/ppvernac.ml
@@ -689,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 ->
diff --git a/vernac/vernacentries.ml b/vernac/vernacentries.ml
index 70e20ea46f08..7d2fea021b73 100644
--- a/vernac/vernacentries.ml
+++ b/vernac/vernacentries.ml
@@ -2291,8 +2291,10 @@ let vernac_print =
   | PrintMLModules -> no_state Mltop.print_ml_modules
   | PrintDebugGC -> no_state Mltop.print_gc
   | PrintDebugDelta qid -> no_state @@ fun () -> vernac_print_debug_delta qid
-  | PrintName (qid,udecl) -> with_proof_env_and_opaques @@ fun ~opaque_access env sigma ->
-    Prettyp.print_name opaque_access env sigma qid udecl
+  | 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
diff --git a/vernac/vernacexpr.mli b/vernac/vernacexpr.mli
index 87b23cb607e5..1ba20ec8bdb5 100644
--- a/vernac/vernacexpr.mli
+++ b/vernac/vernacexpr.mli
@@ -54,7 +54,7 @@ type printable =
   | PrintMLModules
   | PrintDebugGC
   | PrintDebugDelta of qualid option
-  | PrintName of qualid or_by_notation * UnivNames.univ_name_list option
+  | PrintName of (qualid or_by_notation * UnivNames.univ_name_list option) list
   | PrintGraph
   | PrintClasses
   | PrintTypeclasses

From 113975618b46389ebff668e06733b58da5e23f55 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Tue, 19 May 2026 10:56:36 +0200
Subject: [PATCH 512/578] Propagate a constant argument in Rewrite internal.

---
 tactics/rewrite.ml | 22 ++++++++++------------
 1 file changed, 10 insertions(+), 12 deletions(-)

diff --git a/tactics/rewrite.ml b/tactics/rewrite.ml
index 6774f94c78d9..c2011de9df77 100644
--- a/tactics/rewrite.ml
+++ b/tactics/rewrite.ml
@@ -753,7 +753,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
@@ -762,7 +762,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
@@ -1636,7 +1636,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
@@ -1651,7 +1651,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
@@ -1664,6 +1664,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) ->
+        (* if abs is Some (_, T), [p] lives in an extended rel context Γ, x : T *)
         let term =
           match abs with
           | None -> p
@@ -1686,7 +1687,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
@@ -1750,9 +1751,7 @@ let cl_rewrite_clause_newtac ?abs ?origsigma ~progress strat clause =
       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 *)
@@ -1777,7 +1776,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)
@@ -1869,8 +1868,7 @@ let unification_rewrite l2r c1 c2 sigma prf car rel where 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 =
@@ -1906,7 +1904,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

From d1dd10738647a5ded4c2f6876c03ff4c3f430aba Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Sat, 4 Apr 2026 12:00:47 +0200
Subject: [PATCH 513/578] Decouple the Hints.hint_ast type from the API from
 its internal version.

For all purposes this should be an internal type, but unfortunately some
automation tactics need to match on it to dispatch their specific apply
tactic.
---
 tactics/hints.ml | 26 ++++++++++++++++++++++++--
 1 file changed, 24 insertions(+), 2 deletions(-)

diff --git a/tactics/hints.ml b/tactics/hints.ml
index 14229a968862..4b30cab34cb1 100644
--- a/tactics/hints.ml
+++ b/tactics/hints.ml
@@ -95,6 +95,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 *)
@@ -103,6 +106,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
@@ -1756,6 +1762,22 @@ let pr_searchtable env sigma =
   in
   Hintdbmap.fold fold !searchtable (mt ())
 
+type 'a hint_ast =
+  | Res_pf     of 'a (* Hint Apply *)
+  | ERes_pf    of 'a (* Hint EApply *)
+  | Give_exact of 'a
+  | Res_pf_THEN_trivial_fail of 'a (* Hint Immediate *)
+  | Unfold_nth of 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
@@ -1765,7 +1787,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
 
@@ -1774,7 +1796,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 =

From fcf3679007da93f1ee289a27dc24799d6d0f127f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Sat, 4 Apr 2026 12:34:32 +0200
Subject: [PATCH 514/578] Inline the now static parameter in user-facing
 Hints.hint_ast.

---
 tactics/hints.ml  | 10 +++++-----
 tactics/hints.mli | 18 +++++++++---------
 2 files changed, 14 insertions(+), 14 deletions(-)

diff --git a/tactics/hints.ml b/tactics/hints.ml
index 4b30cab34cb1..540f435732d8 100644
--- a/tactics/hints.ml
+++ b/tactics/hints.ml
@@ -1762,11 +1762,11 @@ let pr_searchtable env sigma =
   in
   Hintdbmap.fold fold !searchtable (mt ())
 
-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_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 *)
 
diff --git a/tactics/hints.mli b/tactics/hints.mli
index 4101e107eb67..568fb4cd754a 100644
--- a/tactics/hints.mli
+++ b/tactics/hints.mli
@@ -31,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 =
@@ -57,14 +57,14 @@ 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. *)

From 8ed93d6b552a9e709e3be3a0fb35255bea1f38d6 Mon Sep 17 00:00:00 2001
From: Yann Leray <yann.leray@inria.fr>
Date: Tue, 19 May 2026 14:34:05 +0200
Subject: [PATCH 515/578] Add tests

---
 test-suite/success/Fixpoint.v | 84 +++++++++++++++++++++++++++++++++++
 1 file changed, 84 insertions(+)

diff --git a/test-suite/success/Fixpoint.v b/test-suite/success/Fixpoint.v
index 590ad0c37ff1..6f4f21a44d28 100644
--- a/test-suite/success/Fixpoint.v
+++ b/test-suite/success/Fixpoint.v
@@ -644,3 +644,87 @@ Fixpoint test_size (t : test) : nat :=
   let 'Test ts := t in S (Pmap_fold (fun t' => plus (test_size t')) 0%nat ts).
 
 End TestIntersection.
+
+
+Module NestedUniform.
+
+(* Uniform arguments are passed as-is to nested fixpoints' bodies *)
+
+Fixpoint Valid1 (n : nat) : nat :=
+  match n with
+  | 0 => 0
+  | S k =>
+    (fix f (a : nat) (m : nat) {struct m} : nat :=
+       match m with
+       | 0 => Valid1 a  (* a=k, subterm of n *)
+       | S m' => g a m'
+       end
+     with g (a : nat) (m : nat) {struct m} : nat :=
+       match m with
+       | 0 => 0
+       | S m' => h a m'
+       end
+     with h (a : nat) (m : nat) {struct m} : nat :=
+       match m with
+       | 0 => 0
+       | S m' => f a m'
+       end
+     for f) k k
+  end.
+
+(* Uniform arguments are checked in context of the nested fixpoints' bodies,
+   not in an of themselves *)
+
+Fixpoint Valid2 (n : nat) : nat :=
+  match n with
+  | 0 => 0
+  | S k =>
+    (fix f (h : nat -> nat) (m : nat) {struct m} : nat :=
+       match m with
+       | 0 => h k  (* h = Valid2, k is a subterm *)
+       | S m' => f h m' + g h m'
+       end
+     with g (h : nat -> nat) (p : nat) {struct p} : nat :=
+       match p with
+       | 0 => h k
+       | S p' => f h p' + g h p'
+       end
+     for f) Valid2 k
+  end.
+
+
+Fail Fixpoint Bad1 (n : nat) : nat :=
+  match n with
+  | 0 => 0
+  | S k =>
+    (fix f (a : nat) (m : nat) {struct m} : nat :=
+       match m with
+       | 0 => Bad1 (S a) (* [S a] not a subterm *)
+       | S m' => g a m'
+       end
+     with g (b : nat) (p : nat) {struct p} : nat :=
+       match p with
+       | 0 => 0
+       | S p' => f b p'
+       end
+     for f) k k
+  end.
+
+Fail Fixpoint Bad2 (n : nat) : nat :=
+  match n with
+  | 0 => 0
+  | S k =>
+    (fix f (h : nat) (m : nat) {struct m} : nat :=
+       match m with
+       | 0 => Bad2 h
+       | S m' => g (h + 0) m' (* First argument is not uniform *)
+       end
+     with g (h : nat) (p : nat) {struct p} : nat :=
+       match p with
+       | 0 => 0
+       | S p' => f h p'
+       end
+     for f) k k
+  end.
+
+End NestedUniform.

From a3563637f588848848f99601de60956c772ad824 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Tue, 19 May 2026 14:43:18 +0200
Subject: [PATCH 516/578] Remove the unused AcyclicGraph.choose primitive.

---
 kernel/uGraph.ml     |  1 -
 kernel/uGraph.mli    |  4 ----
 lib/acyclicGraph.ml  | 24 ------------------------
 lib/acyclicGraph.mli |  2 --
 4 files changed, 31 deletions(-)

diff --git a/kernel/uGraph.ml b/kernel/uGraph.ml
index 0af81414463c..f40d4d07b03c 100644
--- a/kernel/uGraph.ml
+++ b/kernel/uGraph.ml
@@ -220,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
 
diff --git a/kernel/uGraph.mli b/kernel/uGraph.mli
index 8b3201924896..9a872ce9d541 100644
--- a/kernel/uGraph.mli
+++ b/kernel/uGraph.mli
@@ -89,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.
 
diff --git a/lib/acyclicGraph.ml b/lib/acyclicGraph.ml
index 337e385d0304..5c28529ba114 100644
--- a/lib/acyclicGraph.ml
+++ b/lib/acyclicGraph.ml
@@ -961,30 +961,6 @@ module Make (Point:Point) = struct
     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 = match repr_or_root_node g u with
-    | None -> Index.find (Option.get Point.root) g.table
-    | Some arcu -> arcu.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. *)
-          | Root ->
-            let root = Option.get Point.root in
-            if p root then raise_notrace (Found root)
-        ) 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
 
diff --git a/lib/acyclicGraph.mli b/lib/acyclicGraph.mli
index b658844770f7..d3f256ff9fd2 100644
--- a/lib/acyclicGraph.mli
+++ b/lib/acyclicGraph.mli
@@ -83,8 +83,6 @@ module Make (Point:Point) : sig
 
   val domain : t -> Point.Set.t
 
-  val choose : (Point.t -> bool) -> t -> Point.t -> Point.t option
-
   (** {5 High-level representation} *)
 
   type node =

From 0f85cf57920b6c1d87c9d390f055ce9985ec5bc4 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Mon, 18 May 2026 17:13:16 +0200
Subject: [PATCH 517/578] Laxer normal form criterion for strong kernel
 normalization.

We now only try to reduce transparent constants and variables, which should
hopefully lead to much less computation for mostly first-order terms. In
particular, nf-betaiota is a very common and expensive caller of kernel
strong reduction, and should benefit from this.
---
 kernel/cClosure.ml | 22 +++++++++++++++-------
 1 file changed, 15 insertions(+), 7 deletions(-)

diff --git a/kernel/cClosure.ml b/kernel/cClosure.ml
index 1ce3ba251b9f..95ea7e67021a 100644
--- a/kernel/cClosure.ml
+++ b/kernel/cClosure.ml
@@ -2048,21 +2048,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

From 623c073cf712f762fd8f4ec35903ff9a6c3d6b80 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Tue, 19 May 2026 19:37:06 +0200
Subject: [PATCH 518/578] Faster type-based fast path in
 Unification.w_unify_to_subterm_all.

We assume that the term in which we seek the pattern is well-typed and
perform minimalistic typing inversions to guess the shape of its type
in a best-effort way. This allows ruling out a lot of potentially costly
unifications in the fast path. Empirically it seems that about a third
of the unifications can be skipped this way.
---
 pretyping/unification.ml | 67 +++++++++++++++++++++++++++-------------
 1 file changed, 46 insertions(+), 21 deletions(-)

diff --git a/pretyping/unification.ml b/pretyping/unification.ml
index 099c895b18bc..d7259fdf2567 100644
--- a/pretyping/unification.ml
+++ b/pretyping/unification.ml
@@ -2270,14 +2270,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
 
@@ -2285,6 +2291,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
@@ -2300,13 +2308,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
@@ -2319,37 +2327,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 =
@@ -2369,18 +2381,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 =
@@ -2389,6 +2401,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 =
@@ -2431,6 +2448,12 @@ 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 *)
@@ -2447,8 +2470,9 @@ let w_unify_to_subterm ~metas env evd ?where ?(flags=default_unify_flags ()) (op
     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
@@ -2478,7 +2502,8 @@ let w_unify_to_subterm ~metas env evd ?where ?(flags=default_unify_flags ()) (op
         | 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

From ba476414d4636b533fbb831c5f1270599effac76 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Fri, 24 Apr 2026 13:54:20 +0200
Subject: [PATCH 519/578] Remove compat coq-core libraries (not executables)

Keep coq-core.kernel because it's used by dune coq mode.
---
 boot/dune                                       |  4 ----
 checker/dune                                    |  4 ----
 clib/dune                                       |  4 ----
 config/dune                                     |  8 --------
 .../user-overlays/21955-SkySkimmer-rm-core.sh   | 17 +++++++++++++++++
 engine/dune                                     |  4 ----
 gramlib/dune                                    |  4 ----
 interp/dune                                     |  4 ----
 kernel/byterun/dune                             |  4 ----
 kernel/dune                                     |  1 +
 lib/dune                                        |  4 ----
 library/dune                                    |  4 ----
 parsing/dune                                    |  4 ----
 perf/dune                                       |  4 ----
 plugins/btauto/dune                             |  4 ----
 plugins/cc/dune                                 |  8 --------
 plugins/derive/dune                             |  4 ----
 plugins/extraction/dune                         |  4 ----
 plugins/firstorder/dune                         |  8 --------
 plugins/funind/dune                             |  4 ----
 plugins/ltac/dune                               |  8 --------
 plugins/ltac2/dune                              |  4 ----
 plugins/ltac2_ltac1/dune                        |  4 ----
 plugins/micromega/dune                          | 12 ------------
 plugins/nsatz/dune                              |  8 --------
 plugins/ring/dune                               |  4 ----
 plugins/rtauto/dune                             |  4 ----
 plugins/ssr/dune                                |  4 ----
 plugins/ssrmatching/dune                        |  4 ----
 plugins/syntax/dune                             |  4 ----
 pretyping/dune                                  |  4 ----
 printing/dune                                   |  4 ----
 proofs/dune                                     |  4 ----
 stm/dune                                        |  4 ----
 sysinit/dune                                    |  8 --------
 tactics/dune                                    |  4 ----
 tools/coqworkmgr/dune                           |  4 ----
 toplevel/dune                                   |  4 ----
 vernac/dune                                     |  4 ----
 39 files changed, 18 insertions(+), 180 deletions(-)
 create mode 100644 dev/ci/user-overlays/21955-SkySkimmer-rm-core.sh

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/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/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/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/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/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/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/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/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/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/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/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/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/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/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/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/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/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/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/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_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/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/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/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/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/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/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/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/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/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/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/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/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/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/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/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/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))

From b192ed849ae5deca1f924ac81da9baaa29125255 Mon Sep 17 00:00:00 2001
From: Yann Leray <yann.leray@inria.fr>
Date: Fri, 22 May 2026 16:03:11 +0200
Subject: [PATCH 520/578] Test for uniform parameters with correct bounds

---
 kernel/inductive.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/kernel/inductive.ml b/kernel/inductive.ml
index f4777b408e91..a1318c31c804 100644
--- a/kernel/inductive.ml
+++ b/kernel/inductive.ml
@@ -1168,7 +1168,7 @@ 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 + k) c) lpar
+  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. *)

From 0d0188b3c68c4b38427ce07350fa3a27d48583d9 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Fri, 22 May 2026 17:15:59 +0200
Subject: [PATCH 521/578] Don't use Lazy in the parser

cf #22041
---
 gramlib/grammar.ml | 19 +++++++++++++++----
 1 file changed, 15 insertions(+), 4 deletions(-)

diff --git a/gramlib/grammar.ml b/gramlib/grammar.ml
index b7bf677d6bb4..a1616afa6fc0 100644
--- a/gramlib/grammar.ml
+++ b/gramlib/grammar.ml
@@ -1512,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;

From f6fb84b1dd54ddfb30d9826a080dab3316c53717 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Fri, 22 May 2026 17:26:31 +0200
Subject: [PATCH 522/578] Stop using global lazys in micromega

They are broken when interrupted, cf #22041

They are also broken when the registers change since the lazy value
won't get updated.
---
 plugins/micromega/coq_micromega.ml | 764 ++++++++++++++---------------
 1 file changed, 381 insertions(+), 383 deletions(-)

diff --git a/plugins/micromega/coq_micromega.ml b/plugins/micromega/coq_micromega.ml
index 8748033a0063..bf55c192ffae 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) -> (
@@ -1052,14 +1050,14 @@ let parse_formula (genv, sigma) parse_atom env tg 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 +1086,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 +1101,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 +1163,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_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 =
-  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_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 +1241,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 +1282,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 +1290,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 +1381,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 +1403,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 +1490,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 +1526,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 +1539,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) ])
 
 (**
@@ -1697,24 +1690,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)
@@ -1723,24 +1716,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
 
@@ -1913,8 +1906,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
@@ -1943,7 +1936,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 =
@@ -1976,9 +1969,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
@@ -1989,20 +1982,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 ->
@@ -2014,22 +2007,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
@@ -2044,7 +2036,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) ->
@@ -2075,7 +2067,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
@@ -2188,12 +2180,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 ->

From 0160e8c43d90944f8a88b4e8bf1e5d2766e9682c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Fri, 22 May 2026 17:30:51 +0200
Subject: [PATCH 523/578] Stop using global lazy in zify

---
 plugins/micromega/zify.ml | 115 +++++++++++++++++++-------------------
 1 file changed, 57 insertions(+), 58 deletions(-)

diff --git a/plugins/micromega/zify.ml b/plugins/micromega/zify.ml
index f2c223985b3d..823b345fe104 100644
--- a/plugins/micromega/zify.ml
+++ b/plugins/micromega/zify.ml
@@ -11,7 +11,6 @@
 open Constr
 open Names
 open Pp
-open Lazy
 module NamedDecl = Context.Named.Declaration
 
 module ERelevance = EConstr.ERelevance
@@ -29,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 *)
@@ -378,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
@@ -417,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) =
@@ -660,7 +659,7 @@ module MakeTable (E : Elt) : S = struct
     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 env evd styp elt
@@ -672,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 =
@@ -852,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 =
@@ -863,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)
 
@@ -909,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
@@ -984,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
@@ -1095,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, [||])
@@ -1230,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
@@ -1254,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 =
@@ -1367,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)
@@ -1391,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")))
 
@@ -1419,7 +1418,7 @@ 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)
@@ -1565,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

From 1ad84d5476bb68a791f2ef5f3c072074f2451d1c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Fri, 22 May 2026 17:35:14 +0200
Subject: [PATCH 524/578] Stop using global lazy for temp dir in nativelib

cf #22041
---
 kernel/nativelib.ml | 26 +++++++++++++++++++-------
 1 file changed, 19 insertions(+), 7 deletions(-)

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

From 6904dddf9cd0b8e5f6fc57d66f943abb4c8e9f07 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Fri, 22 May 2026 17:38:55 +0200
Subject: [PATCH 525/578] Stop using global lazy in tactics/

---
 tactics/generalize.ml | 3 +--
 tactics/hipattern.ml  | 8 ++++----
 tactics/tactics.ml    | 5 +++--
 3 files changed, 8 insertions(+), 8 deletions(-)

diff --git a/tactics/generalize.ml b/tactics/generalize.ml
index e87a00534ac8..31460e3a7684 100644
--- a/tactics/generalize.ml
+++ b/tactics/generalize.ml
@@ -251,8 +251,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")) *)
 
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/tactics.ml b/tactics/tactics.ml
index e135080a965b..907bceb5051b 100644
--- a/tactics/tactics.ml
+++ b/tactics/tactics.ml
@@ -2844,7 +2844,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 =
@@ -2877,7 +2878,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

From b9e64ca48f98d4271807e8d898a3099848b2bafe Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Fri, 22 May 2026 17:41:11 +0200
Subject: [PATCH 526/578] Stop using global lazy in cctac

---
 plugins/cc/cctac.ml | 80 ++++++++++++++++++++++-----------------------
 1 file changed, 40 insertions(+), 40 deletions(-)

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 =

From c030c967583ca1aaabace0181aa220e3ef86aa2c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Fri, 22 May 2026 17:42:37 +0200
Subject: [PATCH 527/578] Stop using global lazy in rtauto

---
 plugins/rtauto/refl_tauto.ml | 62 ++++++++++++++++++------------------
 1 file changed, 31 insertions(+), 31 deletions(-)

diff --git a/plugins/rtauto/refl_tauto.ml b/plugins/rtauto/refl_tauto.ml
index 96db0296541f..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"
@@ -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)
@@ -167,21 +167,21 @@ let rec make_hyps env sigma atom_env lenv = function
        (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
@@ -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

From 9b4c355bc7a473e4d8370e135190ff117a4c936e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Fri, 22 May 2026 17:49:50 +0200
Subject: [PATCH 528/578] Stop using global lazy in funind

---
 .../funind/functional_principles_proofs.ml    | 20 +++++++++----------
 plugins/funind/glob_term_to_relation.ml       |  8 ++++----
 plugins/funind/indfun_common.ml               |  4 ++--
 plugins/funind/indfun_common.mli              |  4 ++--
 plugins/funind/recdef.ml                      |  8 ++++----
 5 files changed, 22 insertions(+), 22 deletions(-)

diff --git a/plugins/funind/functional_principles_proofs.ml b/plugins/funind/functional_principles_proofs.ml
index 08214b0866c7..96dc5ee2aa4a 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)
@@ -864,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
@@ -1391,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/glob_term_to_relation.ml b/plugins/funind/glob_term_to_relation.ml
index 22aa87dce979..6793af714b96 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
 
 (*
diff --git a/plugins/funind/indfun_common.ml b/plugins/funind/indfun_common.ml
index 07d07e0a793a..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 ()
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/recdef.ml b/plugins/funind/recdef.ml
index da4eadda53cd..41a8bdc4c9ec 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
@@ -704,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 _ ->
@@ -1444,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

From 186e567e68f91d2b7c16b104be68cd3fb5c655e0 Mon Sep 17 00:00:00 2001
From: Enrico Tassi <Enrico.Tassi@Inria.fr>
Date: Fri, 22 May 2026 18:20:28 +0200
Subject: [PATCH 529/578] docker: install memprof-limits

---
 .gitlab-ci.yml                       | 2 +-
 dev/ci/docker/edge_ubuntu/Dockerfile | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
index ae4dff93fd84..fc5e4c53fd98 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-V2026-04-25-40c2707b7f"
+  EDGE_CACHEKEY: "edge_ubuntu-V2026-05-22-20228d7d42"
   BASE_IMAGE: "$CI_REGISTRY_IMAGE:$BASE_CACHEKEY"
   EDGE_IMAGE: "$CI_REGISTRY_IMAGE:$EDGE_CACHEKEY"
 
diff --git a/dev/ci/docker/edge_ubuntu/Dockerfile b/dev/ci/docker/edge_ubuntu/Dockerfile
index 6f80dc011513..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.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" \
+    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

From 3006a6d6542c4dfb45e50638f2146126655f1f72 Mon Sep 17 00:00:00 2001
From: Jason Gross <jason@theorem.dev>
Date: Sun, 24 May 2026 01:16:30 +0000
Subject: [PATCH 530/578] Fix contract_case anomaly: reimplement with
 evar-aware decomposition
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

EConstr.contract_case previously delegated to Inductive.contract_case
via unsafe_to_constr (identity function), which does not resolve evars.
When branches contain evar-backed Lambda bodies (e.g., from
Constr.in_context), raw Constr.kind sees Evar instead of Lambda,
causing contract_case to anomaly.

Reimplement EConstr.contract_case using EConstr.kind sigma, following
the established pattern of EConstr.decompose_lambda_decls et al. Also
add EConstr.decompose_lambda_n_decls_opt.

A separate EInductive module was considered but would create a circular
dependency (EInductive -> EConstr for kind/decompose_app/etc., EConstr
-> EInductive for annotate_case via iter_with_full_binders).

Closes #22058

🤖 Generated with [Claude Code](https://claude.ai/code)

Co-Authored-By: Claude Opus 4.6 <noreply@anthropic.com>
---
 .../22058-einductive-contract-case-Fixed.rst  |  5 ++
 engine/eConstr.ml                             | 71 +++++++++++++++----
 engine/eConstr.mli                            |  5 ++
 test-suite/bugs/bug_22058.v                   | 27 +++++++
 4 files changed, 94 insertions(+), 14 deletions(-)
 create mode 100644 doc/changelog/01-kernel/22058-einductive-contract-case-Fixed.rst
 create mode 100644 test-suite/bugs/bug_22058.v

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 <https://github.com/rocq-prover/rocq/issues/22058>`_,
+  by Jason Gross).
diff --git a/engine/eConstr.ml b/engine/eConstr.ml
index 8549606e84b6..60054cd04ddd 100644
--- a/engine/eConstr.ml
+++ b/engine/eConstr.ml
@@ -423,6 +423,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
@@ -594,6 +609,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
@@ -644,20 +665,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
diff --git a/engine/eConstr.mli b/engine/eConstr.mli
index 9850237d7956..861bdf094d96 100644
--- a/engine/eConstr.mli
+++ b/engine/eConstr.mli
@@ -313,6 +313,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
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.

From fc4194fe689faeee88e2521a66e01fb52fd9f2e4 Mon Sep 17 00:00:00 2001
From: Kanghee Park <kap022@ucsd.edu>
Date: Tue, 26 May 2026 17:25:06 +0000
Subject: [PATCH 531/578] Give primitive eta when elimination checks are
 disabled

Respect the environment flag that bypasses elimination constraints when checking primitive record eta, and keep the local worktree ignore entry from the branch.
---
 kernel/indTyping.ml | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/kernel/indTyping.ml b/kernel/indTyping.ml
index 927b10848efe..d667b821c72e 100644
--- a/kernel/indTyping.ml
+++ b/kernel/indTyping.ml
@@ -231,7 +231,7 @@ 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, _) ->
       if Result.is_error res then res
@@ -257,6 +257,7 @@ 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 ->
@@ -586,7 +587,7 @@ let typecheck_inductive env ~sec_univs (mie:mutual_inductive_entry) =
     | 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
+      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

From 44fe4b9476645ee3943f0a6ebd793bb80254f18b Mon Sep 17 00:00:00 2001
From: Pierre Roux <pierre.roux@onera.fr>
Date: Wed, 27 May 2026 16:34:08 +0200
Subject: [PATCH 532/578] [CI] Fix mathcomp

Following merge of https://github.com/math-comp/math-comp/pull/1456/
---
 .gitlab-ci.yml                 | 25 +++++++++++++++++++++++++
 Makefile.ci                    |  2 +-
 dev/ci/ci-basic-overlay.sh     |  6 ++++++
 dev/ci/scripts/ci-micromega.sh | 15 +++++++++++++++
 4 files changed, 47 insertions(+), 1 deletion(-)
 create mode 100644 dev/ci/scripts/ci-micromega.sh

diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
index ae4dff93fd84..71016b48e3c1 100644
--- a/.gitlab-ci.yml
+++ b/.gitlab-ci.yml
@@ -717,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+
 
@@ -752,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
 
@@ -825,6 +827,7 @@ library:ci-oddorder:
   needs:
   - build:edge+flambda
   - plugin:ci-elpi_hb
+  - plugin:ci-micromega
   - library:ci-mathcomp
   stage: build-3+
 
@@ -833,6 +836,7 @@ library:ci-fourcolor:
   needs:
   - build:edge+flambda
   - plugin:ci-elpi_hb
+  - plugin:ci-micromega
   - library:ci-mathcomp
   stage: build-3+
 
@@ -870,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
@@ -879,6 +884,7 @@ library:ci-mathcomp_test:
   needs:
   - build:edge+flambda
   - plugin:ci-elpi_hb
+  - plugin:ci-micromega
   - library:ci-mathcomp
   stage: build-3+
 
@@ -888,6 +894,7 @@ library:ci-mczify:
   - build:edge+flambda
   - library:ci-stdlib+flambda
   - plugin:ci-elpi_hb
+  - plugin:ci-micromega
   - library:ci-mathcomp
   stage: build-3+
 
@@ -897,6 +904,7 @@ library:ci-algebra_tactics:
   - build:edge+flambda
   - library:ci-stdlib+flambda
   - plugin:ci-elpi_hb
+  - plugin:ci-micromega
   - library:ci-mathcomp
   - library:ci-mczify
   stage: build-3+
@@ -906,6 +914,7 @@ library:ci-finmap:
   needs:
   - build:edge+flambda
   - plugin:ci-elpi_hb
+  - plugin:ci-micromega
   - library:ci-mathcomp
   stage: build-3+
 
@@ -914,6 +923,7 @@ library:ci-bigenough:
   needs:
   - build:edge+flambda
   - plugin:ci-elpi_hb
+  - plugin:ci-micromega
   - library:ci-mathcomp
   stage: build-3+
 
@@ -925,6 +935,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
@@ -938,6 +949,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+
 
@@ -1048,6 +1060,7 @@ library:ci-deriving:
   - build:edge+flambda
   - library:ci-stdlib+flambda
   - plugin:ci-elpi_hb
+  - plugin:ci-micromega
   - library:ci-mathcomp
   stage: build-3+
 
@@ -1057,6 +1070,7 @@ library:ci-mathcomp_word:
   - build:edge+flambda
   - library:ci-stdlib+flambda
   - plugin:ci-elpi_hb
+  - plugin:ci-micromega
   - library:ci-mathcomp
   stage: build-2
 
@@ -1066,6 +1080,7 @@ library:ci-jasmin:
   - build:edge+flambda
   - library:ci-stdlib+flambda
   - plugin:ci-elpi_hb
+  - plugin:ci-micromega
   - library:ci-mathcomp
   - library:ci-mathcomp_word
   - library:ci-mczify
@@ -1081,6 +1096,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
@@ -1206,6 +1222,11 @@ plugin:ci-metarocq:
   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:
@@ -1242,6 +1263,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:
@@ -1255,6 +1277,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+
@@ -1268,6 +1291,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+
@@ -1333,6 +1357,7 @@ 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+
diff --git a/Makefile.ci b/Makefile.ci
index e263604d6ed4..f0dbaf80df98 100644
--- a/Makefile.ci
+++ b/Makefile.ci
@@ -138,7 +138,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
diff --git a/dev/ci/ci-basic-overlay.sh b/dev/ci/ci-basic-overlay.sh
index ba708fe7d7ce..a439db13fe73 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
 ########################################################################
diff --git a/dev/ci/scripts/ci-micromega.sh b/dev/ci/scripts/ci-micromega.sh
new file mode 100644
index 000000000000..7ea31e8ff948
--- /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=micromega-plugin @install
+  dune install --root . micromega-plugin --prefix=$CI_INSTALL_DIR
+)

From 60a62d14a49b72907190014034f5cf57ae649dff Mon Sep 17 00:00:00 2001
From: Pierre Roux <pierre.roux@onera.fr>
Date: Thu, 28 May 2026 10:57:54 +0200
Subject: [PATCH 533/578] [CI] Fix mathcomp test

---
 dev/ci/scripts/ci-mathcomp_test.sh | 2 ++
 1 file changed, 2 insertions(+)

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
 )

From 505d8f629383163004490084203023c79eb5d209 Mon Sep 17 00:00:00 2001
From: Pierre Roux <pierre.roux@onera.fr>
Date: Thu, 28 May 2026 10:54:34 +0200
Subject: [PATCH 534/578] [CI] Fix jasmin

No longer depends on algebra-tactics
---
 Makefile.ci | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/Makefile.ci b/Makefile.ci
index f0dbaf80df98..f4c2033138d1 100644
--- a/Makefile.ci
+++ b/Makefile.ci
@@ -175,7 +175,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 +195,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

From 22f4a45f43d18c6e08d02f2a3fa9d9a7caed0cad Mon Sep 17 00:00:00 2001
From: Pierre Roux <pierre.roux@onera.fr>
Date: Thu, 28 May 2026 10:55:49 +0200
Subject: [PATCH 535/578] [CI] Remove algebra tactics

No longer used in CI
---
 .gitlab-ci.yml                       | 12 ------------
 Makefile.ci                          |  1 -
 dev/ci/ci-basic-overlay.sh           |  3 ---
 dev/ci/scripts/ci-algebra_tactics.sh | 17 -----------------
 4 files changed, 33 deletions(-)
 delete mode 100644 dev/ci/scripts/ci-algebra_tactics.sh

diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
index 785c40dac8b8..bd5fc9890774 100644
--- a/.gitlab-ci.yml
+++ b/.gitlab-ci.yml
@@ -898,17 +898,6 @@ library:ci-mczify:
   - 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
-  - plugin:ci-micromega
-  - library:ci-mathcomp
-  - library:ci-mczify
-  stage: build-3+
-
 library:ci-finmap:
   extends: .ci-template-flambda
   needs:
@@ -1084,7 +1073,6 @@ library:ci-jasmin:
   - library:ci-mathcomp
   - library:ci-mathcomp_word
   - library:ci-mczify
-  - library:ci-algebra_tactics
   - library:ci-ext_lib
   - library:ci-paco
   - library:ci-itree
diff --git a/Makefile.ci b/Makefile.ci
index f4c2033138d1..54f477d99235 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 \
diff --git a/dev/ci/ci-basic-overlay.sh b/dev/ci/ci-basic-overlay.sh
index a439db13fe73..b97e041df281 100644
--- a/dev/ci/ci-basic-overlay.sh
+++ b/dev/ci/ci-basic-overlay.sh
@@ -83,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
 
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
-)

From 980c7ea217428b0f472a53abf1df747a3d7b0f98 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Thu, 30 Apr 2026 14:43:05 +0200
Subject: [PATCH 536/578] Keep track of variable status (secvar or not) in
 named contexts

Close #6773
---
 doc/plugin_tutorial/tuto3/src/tuto_tactic.ml  |   4 +-
 engine/eConstr.ml                             |  30 ++++-
 engine/eConstr.mli                            |  21 +++-
 engine/evarutil.ml                            |  28 ++---
 engine/evarutil.mli                           |   1 -
 engine/evd.ml                                 |  14 +--
 engine/proofview.ml                           |  22 ++--
 engine/termops.ml                             |  24 ++--
 ide/rocqide/idetop.ml                         |   2 +-
 interp/constrintern.ml                        |   2 +-
 kernel/environ.ml                             | 110 ++++++++++++------
 kernel/environ.mli                            |  29 +++--
 kernel/safe_typing.ml                         |   2 +-
 kernel/typeops.ml                             |   1 +
 plugins/cc/ccalgo.ml                          |   2 +-
 plugins/derive/derive.ml                      |   6 +-
 plugins/extraction/extraction.ml              |   6 +-
 plugins/funind/functional_principles_types.ml |   2 +-
 plugins/funind/gen_principle.ml               |   2 +-
 plugins/funind/glob_term_to_relation.ml       |  14 +--
 plugins/funind/recdef.ml                      |   5 +-
 plugins/ltac/leminv.ml                        |  12 +-
 plugins/ltac2/tac2core.ml                     |   2 +-
 plugins/micromega/zify.ml                     |   4 +-
 plugins/ssr/ssrcommon.ml                      |   8 +-
 plugins/ssr/ssripats.ml                       |   6 +-
 plugins/ssrmatching/ssrmatching.ml            |   2 +-
 pretyping/evarconv.ml                         |   2 +-
 pretyping/evardefine.ml                       |   4 +-
 pretyping/evarsolve.ml                        |   2 +-
 pretyping/heads.ml                            |   2 +-
 pretyping/unification.ml                      |  14 +--
 printing/printer.ml                           |   2 +-
 proofs/logic.ml                               |  88 +++++++-------
 proofs/logic.mli                              |   2 +-
 proofs/refine.ml                              |  42 ++++---
 proofs/subproof.ml                            |   2 +-
 proofs/tacmach.ml                             |   7 +-
 tactics/abstract.ml                           |  26 +----
 tactics/class_tactics.ml                      |  10 +-
 tactics/equality.ml                           |   4 +-
 tactics/fixTactics.ml                         |   4 +-
 tactics/induction.ml                          |  15 ++-
 tactics/rewrite.ml                            |   6 +-
 tactics/tactics.ml                            |  39 ++++---
 test-suite/bugs/bug_6773.v                    |  14 +++
 vernac/comFixpoint.ml                         |   4 +-
 vernac/declare.ml                             |  16 ++-
 vernac/retrieveObl.ml                         |   2 +
 49 files changed, 384 insertions(+), 284 deletions(-)
 create mode 100644 test-suite/bugs/bug_6773.v

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/engine/eConstr.ml b/engine/eConstr.ml
index 60054cd04ddd..c1b629fbc274 100644
--- a/engine/eConstr.ml
+++ b/engine/eConstr.ml
@@ -1220,16 +1220,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
@@ -1248,10 +1257,21 @@ 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 :
+  (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
 
diff --git a/engine/eConstr.mli b/engine/eConstr.mli
index 861bdf094d96..0b7cec293478 100644
--- a/engine/eConstr.mli
+++ b/engine/eConstr.mli
@@ -424,15 +424,19 @@ 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 :
+  (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
@@ -445,7 +449,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/evarutil.ml b/engine/evarutil.ml
index 438e23bd16b5..aa451c09b682 100644
--- a/engine/evarutil.ml
+++ b/engine/evarutil.ml
@@ -63,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
 
@@ -114,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) &&
@@ -303,14 +304,15 @@ 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
@@ -333,7 +335,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
@@ -345,12 +347,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
@@ -609,10 +611,10 @@ let clear_hyps_in_evi_main env sigma hyps terms ids =
   let terms =
     List.map (check_and_clear_in_constr ~is_section_variable 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 ~is_section_variable env evdref err ids ~global) decl
     in
     remove_hyps ids check_context hyps
   in
diff --git a/engine/evarutil.mli b/engine/evarutil.mli
index dcd6036b5b1c..75f9ac93240b 100644
--- a/engine/evarutil.mli
+++ b/engine/evarutil.mli
@@ -128,7 +128,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
 
diff --git a/engine/evd.ml b/engine/evd.ml
index 8a79608a92a9..87f913f0dfc9 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 }
 
diff --git a/engine/proofview.ml b/engine/proofview.ml
index 10e28d719656..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
@@ -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
 
diff --git a/engine/termops.ml b/engine/termops.ml
index 660e57c349df..ad1f64cf9deb 100644
--- a/engine/termops.ml
+++ b/engine/termops.ml
@@ -62,7 +62,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 +74,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 ())
@@ -149,9 +149,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
@@ -877,10 +879,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
@@ -1008,6 +1007,7 @@ let ids_of_context env =
 let names_of_rel_context env =
   List.map RelDecl.get_name (rel_context env)
 
+(* XXX use var status (NOT IN THIS ENV) *)
 let is_section_variable env id =
   try let _ = Environ.lookup_named id env in true
   with Not_found -> false
@@ -1203,9 +1203,9 @@ let compact_named_context sigma sign =
 
 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 =
diff --git a/ide/rocqide/idetop.ml b/ide/rocqide/idetop.ml
index 0336f939ceba..726b1a6f1e76 100644
--- a/ide/rocqide/idetop.ml
+++ b/ide/rocqide/idetop.ml
@@ -301,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
diff --git a/interp/constrintern.ml b/interp/constrintern.ml
index 35ff54ca4669..3696fb418ac1 100644
--- a/interp/constrintern.ml
+++ b/interp/constrintern.ml
@@ -3110,7 +3110,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
diff --git a/kernel/environ.ml b/kernel/environ.ml
index 54d4ded25492..850bfe73e9e7 100644
--- a/kernel/environ.ml
+++ b/kernel/environ.ml
@@ -80,6 +80,7 @@ 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 = {
@@ -118,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 = {
@@ -187,43 +189,78 @@ 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 push_named_context_val status d ctxt =
+  let id = NamedDecl.get_id d in
+  (*   assert (not (Id.Map.mem id ctxt.env_named_map)); *)
+  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 status d env =
+  {env with env_named_context = push_named_context_val status d env.env_named_context}
 
-let push_named d env =
-  {env with env_named_context = push_named_context_val d env.env_named_context}
+let mem_named_ctxt id ctxt =
+  Id.Map.mem id ctxt.env_named_map
 
-let mem_named id env =
-  Id.Map.mem id env.env_named_context.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
@@ -430,14 +467,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 =
@@ -482,10 +523,10 @@ let fold_named_context f env ~init =
   let rec fold_right env =
     match match_named_context_val env.env_named_context with
     | None -> init
-    | Some (d, rem) ->
+    | Some (status, d, rem) ->
         let env =
           reset_with_named_context rem env in
-        f env d (fold_right env)
+        f env status d (fold_right env)
   in fold_right env
 
 let fold_named_context_reverse f ~init env =
@@ -1017,12 +1058,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
 
@@ -1032,7 +1074,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
@@ -1041,10 +1083,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)
 
diff --git a/kernel/environ.mli b/kernel/environ.mli
index 58c43725e226..477652dc15f5 100644
--- a/kernel/environ.mli
+++ b/kernel/environ.mli
@@ -43,6 +43,7 @@ type named_context_val = private {
   (** 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. *)
+  env_named_secvars : Id.Set.t;
 }
 
 type rel_context_val = private {
@@ -110,24 +111,32 @@ val fold_rel_context :
 
 (** {5 Context of variables (section variables and goal assumptions) } *)
 
+type var_status = SecVar | ProofVar
+
+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])
@@ -142,9 +151,9 @@ val named_body : variable -> env -> constr option
 (** {6 Recurrence on [named_context]: older declarations processed first } *)
 
 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 :
@@ -470,10 +479,10 @@ 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
diff --git a/kernel/safe_typing.ml b/kernel/safe_typing.ml
index c91523b7cc6a..4e285f1d5d25 100644
--- a/kernel/safe_typing.ml
+++ b/kernel/safe_typing.ml
@@ -735,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
diff --git a/kernel/typeops.ml b/kernel/typeops.ml
index cef4fa076b0c..6aebeaeae274 100644
--- a/kernel/typeops.ml
+++ b/kernel/typeops.ml
@@ -172,6 +172,7 @@ let type_of_variable env id =
 (* Checks if a context of variables can be instantiated by the
    variables of the current env.
    Order does not have to be checked assuming that all names are distinct *)
+(* TODO use var status instead *)
 let check_hyps_inclusion env ?evars c sign =
   let conv env a b = conv env ?evars a b in
   Context.Named.fold_outside
diff --git a/plugins/cc/ccalgo.ml b/plugins/cc/ccalgo.ml
index 3724149b3c1f..37187f2f930f 100644
--- a/plugins/cc/ccalgo.ml
+++ b/plugins/cc/ccalgo.ml
@@ -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/derive/derive.ml b/plugins/derive/derive.ml
index 68e9d6e99aeb..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]
@@ -70,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/extraction/extraction.ml b/plugins/extraction/extraction.ml
index 4d9dac9c8fac..697be94d02a8 100644
--- a/plugins/extraction/extraction.ml
+++ b/plugins/extraction/extraction.ml
@@ -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/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/gen_principle.ml b/plugins/funind/gen_principle.ml
index 04a8ece16bfd..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 ))
diff --git a/plugins/funind/glob_term_to_relation.ml b/plugins/funind/glob_term_to_relation.ml
index 6793af714b96..0138c0d71c03 100644
--- a/plugins/funind/glob_term_to_relation.ml
+++ b/plugins/funind/glob_term_to_relation.ml
@@ -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
@@ -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/recdef.ml b/plugins/funind/recdef.ml
index 41a8bdc4c9ec..0d81630d88e6 100644
--- a/plugins/funind/recdef.ml
+++ b/plugins/funind/recdef.ml
@@ -1630,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);  *)
diff --git a/plugins/ltac/leminv.ml b/plugins/ltac/leminv.ml
index 5920390ea1c1..2a7a7d1038ee 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]
@@ -204,8 +203,7 @@ let inversion_scheme ~name ~poly env sigma t sort dep_option inv_op =
   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
+      (fun env status d sign ->
          if mem_named_context_val (NamedDecl.get_id d) global_named_context then sign
          else Context.Named.add d sign)
       invEnv ~init:Context.Named.empty
diff --git a/plugins/ltac2/tac2core.ml b/plugins/ltac2/tac2core.ml
index a31622747735..38ca97720bc7 100644
--- a/plugins/ltac2/tac2core.ml
+++ b/plugins/ltac2/tac2core.ml
@@ -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
diff --git a/plugins/micromega/zify.ml b/plugins/micromega/zify.ml
index 823b345fe104..7d4cdc2f20a6 100644
--- a/plugins/micromega/zify.ml
+++ b/plugins/micromega/zify.ml
@@ -1335,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
@@ -1449,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
diff --git a/plugins/ssr/ssrcommon.ml b/plugins/ssr/ssrcommon.ml
index 4d2a659b2702..21224a91bfec 100644
--- a/plugins/ssr/ssrcommon.ml
+++ b/plugins/ssr/ssrcommon.ml
@@ -1203,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
@@ -1212,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
diff --git a/plugins/ssr/ssripats.ml b/plugins/ssr/ssripats.ml
index 20a04f31661a..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
diff --git a/plugins/ssrmatching/ssrmatching.ml b/plugins/ssrmatching/ssrmatching.ml
index bd858fc96026..93881ab8f8a3 100644
--- a/plugins/ssrmatching/ssrmatching.ml
+++ b/plugins/ssrmatching/ssrmatching.ml
@@ -447,7 +447,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 *)
diff --git a/pretyping/evarconv.ml b/pretyping/evarconv.ml
index 5f7751267b0b..03ecfe8774b0 100644
--- a/pretyping/evarconv.ml
+++ b/pretyping/evarconv.ml
@@ -1818,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
 
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 2f89f4e578c0..5e07133d88d1 100644
--- a/pretyping/evarsolve.ml
+++ b/pretyping/evarsolve.ml
@@ -869,7 +869,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))
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/unification.ml b/pretyping/unification.ml
index 0a01d343da4c..fa75b12120b5 100644
--- a/pretyping/unification.ml
+++ b/pretyping/unification.ml
@@ -2154,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
@@ -2168,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
@@ -2183,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
diff --git a/printing/printer.ml b/printing/printer.ml
index e56dcc7f2a7e..6719789f7bee 100644
--- a/printing/printer.ml
+++ b/printing/printer.ml
@@ -418,7 +418,7 @@ let pr_erel_decl ?flags env sigma (decl:EConstr.rel_declaration) =
 
 (* Prints a signature, all declarations on the same line if possible *)
 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 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)
 
diff --git a/proofs/logic.ml b/proofs/logic.ml
index 25dc273883f5..1f3e0e45271d 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.fold_left (fun accu decl -> EConstr.push_named_context_val decl accu) ctxt_head ctxt_tail
-      | 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 EConstr.match_named_context_val ctxt_head with
-            | None -> error_no_such_hypothesis env sigma (List.hd ord)
-            | Some (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 =
@@ -156,10 +158,10 @@ 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
 
@@ -177,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
@@ -200,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
@@ -220,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
 
@@ -258,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 b4af1fa69769..ca1f9b1b24b7 100644
--- a/proofs/subproof.ml
+++ b/proofs/subproof.ml
@@ -139,7 +139,7 @@ let build_constant_by_tactic ~name ~sigma ~env ~sign ~poly typ tac =
 
 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 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 *)
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/tactics/abstract.ml b/tactics/abstract.ml
index 7faf77ba3973..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
diff --git a/tactics/class_tactics.ml b/tactics/class_tactics.ml
index b4dcceffbf02..8a46776ac73d 100644
--- a/tactics/class_tactics.ml
+++ b/tactics/class_tactics.ml
@@ -442,10 +442,10 @@ 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 ||
         try let t = hyp |> NamedDecl.get_id |> Global.lookup_named |> NamedDecl.get_type in
@@ -456,7 +456,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)
 
@@ -498,7 +498,7 @@ 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 =
diff --git a/tactics/equality.ml b/tactics/equality.ml
index 77431b5a7e45..59e7a64547ae 100644
--- a/tactics/equality.ml
+++ b/tactics/equality.ml
@@ -1186,7 +1186,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
@@ -1415,7 +1415,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
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/induction.ml b/tactics/induction.ml
index 553fcdfdbfeb..02c5b6f75c67 100644
--- a/tactics/induction.ml
+++ b/tactics/induction.ml
@@ -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
diff --git a/tactics/rewrite.ml b/tactics/rewrite.ml
index c2011de9df77..24276be57f82 100644
--- a/tactics/rewrite.ml
+++ b/tactics/rewrite.ml
@@ -838,7 +838,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
@@ -1745,8 +1745,8 @@ let cl_rewrite_clause_newtac ?origsigma ~progress abs 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
diff --git a/tactics/tactics.ml b/tactics/tactics.ml
index 907bceb5051b..61db30f713cf 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
@@ -259,13 +259,17 @@ let rename_hyp repl =
       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
@@ -379,12 +383,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)
@@ -443,6 +447,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
@@ -531,7 +536,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 ->
@@ -542,8 +547,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
@@ -947,7 +952,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
@@ -1916,7 +1921,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
@@ -1932,7 +1937,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) ->
@@ -1950,9 +1955,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
@@ -2534,7 +2539,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
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/vernac/comFixpoint.ml b/vernac/comFixpoint.ml
index 8af3fa4a8822..dccd0d827cda 100644
--- a/vernac/comFixpoint.ml
+++ b/vernac/comFixpoint.ml
@@ -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)
diff --git a/vernac/declare.ml b/vernac/declare.ml
index 8bc033f82fa2..a7fa69557df4 100644
--- a/vernac/declare.ml
+++ b/vernac/declare.ml
@@ -1832,7 +1832,7 @@ let initialize_named_context_for_proof () =
     (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
@@ -1919,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
@@ -1929,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
@@ -1955,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
@@ -1970,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
@@ -1986,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
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 =

From 45e9c605df868e94d8161d156decdefe8a84be90 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Thu, 30 Apr 2026 14:52:54 +0200
Subject: [PATCH 537/578] check_hyps_inclusion use variable status instead of
 conversion

This lets us detect if a variable is some unrelated variable which got
renamed to the name of a previously cleared section variable.

It's also cheaper than conversion but that's not really the point of
this patch.

Fix #11487
---
 kernel/typeops.ml             | 39 +++++++++--------------------------
 kernel/typeops.mli            |  3 +--
 pretyping/inductiveops.ml     |  4 ++--
 pretyping/reductionops.ml     |  5 -----
 pretyping/reductionops.mli    |  3 ---
 pretyping/retyping.ml         |  2 +-
 pretyping/typing.ml           | 11 +++++-----
 test-suite/bugs/bug_11487.v   | 16 ++++++++++++++
 test-suite/bugs/bug_20847_1.v | 18 ++++++++++++++++
 9 files changed, 54 insertions(+), 47 deletions(-)
 create mode 100644 test-suite/bugs/bug_11487.v
 create mode 100644 test-suite/bugs/bug_20847_1.v

diff --git a/kernel/typeops.ml b/kernel/typeops.ml
index 6aebeaeae274..7657a7741223 100644
--- a/kernel/typeops.ml
+++ b/kernel/typeops.ml
@@ -170,35 +170,16 @@ let type_of_variable 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 *)
-(* TODO use var status instead *)
-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:()
+   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 error_reference_variables env id c
 
 (* Instantiation of terms on real arguments. *)
 
diff --git a/kernel/typeops.mli b/kernel/typeops.mli
index d9a47916cc16..c0d94ec8d555 100644
--- a/kernel/typeops.mli
+++ b/kernel/typeops.mli
@@ -72,8 +72,7 @@ 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
+val check_hyps_inclusion : env -> GlobRef.t -> Constr.named_context -> unit
 
 (** Types for primitives *)
 
diff --git a/pretyping/inductiveops.ml b/pretyping/inductiveops.ml
index 1d8452d3b9d6..0fed7ee86bd1 100644
--- a/pretyping/inductiveops.ml
+++ b/pretyping/inductiveops.ml
@@ -31,7 +31,7 @@ let type_of_inductive env (ind,u) =
 
 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;
+ Typeops.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))
 
@@ -47,7 +47,7 @@ let type_of_constructor env (cstr,u) =
 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;
+ Typeops.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))
 
diff --git a/pretyping/reductionops.ml b/pretyping/reductionops.ml
index 9195b1a1f216..e99e4ea1ee4d 100644
--- a/pretyping/reductionops.ml
+++ b/pretyping/reductionops.ml
@@ -1414,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                            *)
 (********************************************************************)
diff --git a/pretyping/reductionops.mli b/pretyping/reductionops.mli
index f003559812f0..2e3df384cd9c 100644
--- a/pretyping/reductionops.mli
+++ b/pretyping/reductionops.mli
@@ -283,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 35cef4bd6ca0..8d27c6126dc1 100644
--- a/pretyping/retyping.ml
+++ b/pretyping/retyping.ml
@@ -136,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 () = Typeops.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))
 
diff --git a/pretyping/typing.ml b/pretyping/typing.ml
index 78fbf193b775..c540c10f6da1 100644
--- a/pretyping/typing.ml
+++ b/pretyping/typing.ml
@@ -135,9 +135,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 Typeops.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 +148,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 Typeops.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
@@ -413,7 +414,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 () = Typeops.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 +425,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 () = Typeops.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 +434,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 () = Typeops.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
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_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.

From 0c35e6bbd167b0b1d266126135338d5afbe364b5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Thu, 30 Apr 2026 15:42:41 +0200
Subject: [PATCH 538/578] Error instead of renaming section variable mentioned
 through a global

Fix #12304
---
 engine/evarutil.mli         |  2 +
 pretyping/evarsolve.ml      |  3 +-
 tactics/hints.ml            |  1 +
 tactics/tactics.ml          | 84 ++++++++++++++++++++++++++++++-------
 test-suite/bugs/bug_12304.v | 11 +++++
 5 files changed, 85 insertions(+), 16 deletions(-)
 create mode 100644 test-suite/bugs/bug_12304.v

diff --git a/engine/evarutil.mli b/engine/evarutil.mli
index 75f9ac93240b..3aa80e258cc7 100644
--- a/engine/evarutil.mli
+++ b/engine/evarutil.mli
@@ -198,6 +198,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 *)
 
diff --git a/pretyping/evarsolve.ml b/pretyping/evarsolve.ml
index 5e07133d88d1..fc3ec8b698e1 100644
--- a/pretyping/evarsolve.ml
+++ b/pretyping/evarsolve.ml
@@ -568,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))
diff --git a/tactics/hints.ml b/tactics/hints.ml
index 540f435732d8..752bdfdda477 100644
--- a/tactics/hints.ml
+++ b/tactics/hints.ml
@@ -897,6 +897,7 @@ let with_uid c = { obj = c; uid = fresh_key () }
 
 let secvars_of_idset s =
   Id.Set.fold (fun id p ->
+      (* XXX how can vars_of_global return non secvars? *)
       if is_section_variable (Global.env ()) id then
         Id.Pred.add id p
       else p) s Id.Pred.empty
diff --git a/tactics/tactics.ml b/tactics/tactics.ml
index 61db30f713cf..7502ca6fd4b9 100644
--- a/tactics/tactics.ml
+++ b/tactics/tactics.ml
@@ -217,6 +217,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,23 +306,9 @@ 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
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.

From 9eef589f7467498b8c7705e9b1b2e116b0df6ca1 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Mon, 4 May 2026 14:49:59 +0200
Subject: [PATCH 539/578] Tactics.clear handle unbound ids

This is accessible through Ltac2 Std.clear which doesn't check the ids
before sending to Tactics.clear, and through ltac1 by abusing bound
values eg `Ltac foo := match goal with H : _ |- _ => clear H; clear H end`
---
 tactics/tactics.ml | 14 ++++++++++++--
 1 file changed, 12 insertions(+), 2 deletions(-)

diff --git a/tactics/tactics.ml b/tactics/tactics.ml
index 7502ca6fd4b9..0ad37135dc2e 100644
--- a/tactics/tactics.ml
+++ b/tactics/tactics.ml
@@ -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

From 78b65e7d8c395799c8c5dea094d5f362dea5b1a5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Thu, 30 Apr 2026 17:11:08 +0200
Subject: [PATCH 540/578] Use variable status to decide if a variable is
 section variable

Termops.is_section_variable is deprecated and a new API
Termops.is_section_variable' is added because their types are the same
but they need different env arguments so changing in place would be too footgunny.

ssr still uses the old "is it in global env" because IDK what it is
doing.

Fix #18858
---
 engine/evarutil.ml                            | 52 +++++++-----------
 engine/evarutil.mli                           | 18 ++-----
 engine/namegen.ml                             |  8 +--
 engine/termops.ml                             | 16 ++++--
 engine/termops.mli                            |  9 +++-
 .../funind/functional_principles_proofs.ml    |  2 +-
 plugins/funind/glob_termops.ml                |  3 +-
 plugins/ltac/leminv.ml                        |  3 +-
 plugins/ltac2/tac2tactics.ml                  |  2 +-
 plugins/ssr/ssrcommon.ml                      |  2 +-
 plugins/ssrmatching/ssrmatching.ml            |  2 +
 pretyping/cases.ml                            | 53 ++++++++-----------
 pretyping/globEnv.ml                          | 16 +++---
 pretyping/globEnv.mli                         |  9 ++--
 pretyping/pretyping.ml                        | 33 +++++-------
 tactics/auto.ml                               |  4 +-
 tactics/class_tactics.ml                      |  1 +
 tactics/eClause.ml                            |  3 +-
 tactics/eauto.ml                              |  2 +-
 tactics/equality.ml                           |  2 +-
 tactics/generalize.ml                         |  9 ++--
 tactics/hints.ml                              | 18 +++----
 tactics/hints.mli                             |  2 +-
 tactics/induction.ml                          | 43 ++++++++-------
 test-suite/bugs/bug_18858.v                   |  9 ++++
 test-suite/bugs/bug_21987_1.v                 | 16 ++++++
 test-suite/bugs/bug_21987_2.v                 |  8 +++
 test-suite/success/clear.v                    | 21 ++++++--
 vernac/proof_using.ml                         |  3 +-
 vernac/vernacentries.ml                       |  2 +-
 30 files changed, 194 insertions(+), 177 deletions(-)
 create mode 100644 test-suite/bugs/bug_18858.v
 create mode 100644 test-suite/bugs/bug_21987_1.v
 create mode 100644 test-suite/bugs/bug_21987_2.v

diff --git a/engine/evarutil.ml b/engine/evarutil.ml
index aa451c09b682..e51486d69b81 100644
--- a/engine/evarutil.ml
+++ b/engine/evarutil.ml
@@ -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
@@ -327,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 Id.Map.mem id0 ext.ext_ctx.env_named_map && 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
@@ -370,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
@@ -384,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
 
 (*------------------------------------*
@@ -409,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 =
@@ -430,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 =
@@ -518,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
@@ -585,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) 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
@@ -599,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) 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 status decl =
       let decl = EConstr.of_named_decl decl in
       let err = OccurHypInSimpleClause (Some (NamedDecl.get_id decl)) in
-      status, 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
@@ -622,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) 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
diff --git a/engine/evarutil.mli b/engine/evarutil.mli
index 3aa80e258cc7..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)
 
@@ -239,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
@@ -248,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/namegen.ml b/engine/namegen.ml
index 5494bc998e47..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 *)
 
@@ -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/termops.ml b/engine/termops.ml
index ad1f64cf9deb..54871eaace91 100644
--- a/engine/termops.ml
+++ b/engine/termops.ml
@@ -1007,10 +1007,13 @@ let ids_of_context env =
 let names_of_rel_context env =
   List.map RelDecl.get_name (rel_context env)
 
-(* XXX use var status (NOT IN THIS 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' ?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
@@ -1424,3 +1427,8 @@ 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 7a107183fd72..e6badbac1940 100644
--- a/engine/termops.mli
+++ b/engine/termops.mli
@@ -206,8 +206,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' 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' : ?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
diff --git a/plugins/funind/functional_principles_proofs.ml b/plugins/funind/functional_principles_proofs.ml
index 96dc5ee2aa4a..6eb38126f814 100644
--- a/plugins/funind/functional_principles_proofs.ml
+++ b/plugins/funind/functional_principles_proofs.ml
@@ -800,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 hyp
               (* should be dangerous *)
             then (clear, decl :: keep)
             else (hyp :: clear, keep))
diff --git a/plugins/funind/glob_termops.ml b/plugins/funind/glob_termops.ml
index 4809a1ef05e1..623e3df74438 100644
--- a/plugins/funind/glob_termops.ml
+++ b/plugins/funind/glob_termops.ml
@@ -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/ltac/leminv.ml b/plugins/ltac/leminv.ml
index 2a7a7d1038ee..11e896c380d6 100644
--- a/plugins/ltac/leminv.ml
+++ b/plugins/ltac/leminv.ml
@@ -200,11 +200,10 @@ let inversion_scheme ~name ~poly env sigma t sort dep_option inv_op =
   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 status d sign ->
-         if mem_named_context_val (NamedDecl.get_id d) global_named_context then sign
+         if status = SecVar then sign
          else Context.Named.add d sign)
       invEnv ~init:Context.Named.empty
   end in
diff --git a/plugins/ltac2/tac2tactics.ml b/plugins/ltac2/tac2tactics.ml
index 29e79d142628..5efd07b530bc 100644
--- a/plugins/ltac2/tac2tactics.ml
+++ b/plugins/ltac2/tac2tactics.ml
@@ -447,7 +447,7 @@ let wrap_tactic_call f =
   let open Proofview.Notations in
   let wrapf ~env ~carrier ~lhs ~rel =
     Proofview.tclEVARMAP >>= fun sigma ->
-      let ectx = ext_named_context_of_env ~hypnaming:Evarutil.VarSet.empty env sigma in
+      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
diff --git a/plugins/ssr/ssrcommon.ml b/plugins/ssr/ssrcommon.ml
index 21224a91bfec..e79cb3d6be9c 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
 
diff --git a/plugins/ssrmatching/ssrmatching.ml b/plugins/ssrmatching/ssrmatching.ml
index 93881ab8f8a3..866e2d65d057 100644
--- a/plugins/ssrmatching/ssrmatching.ml
+++ b/plugins/ssrmatching/ssrmatching.ml
@@ -1166,6 +1166,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
diff --git a/pretyping/cases.ml b/pretyping/cases.ml
index 36f2de210cb7..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
 
@@ -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/globEnv.ml b/pretyping/globEnv.ml
index fb2e18a34ab7..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 =
diff --git a/pretyping/globEnv.mli b/pretyping/globEnv.mli
index 2f2f4998171f..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 *)
 
@@ -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 *)
 
diff --git a/pretyping/pretyping.ml b/pretyping/pretyping.ml
index 2faea419716a..648d6e9c6990 100644
--- a/pretyping/pretyping.ml
+++ b/pretyping/pretyping.ml
@@ -795,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
@@ -839,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 ->
@@ -848,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 })
@@ -1251,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
@@ -1263,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
@@ -1271,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
@@ -1302,8 +1299,7 @@ struct
     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) ;
@@ -1348,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
@@ -1366,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,8 +1426,7 @@ struct
     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 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
@@ -1457,7 +1451,7 @@ struct
       let csgn =
         List.map (set_name Anonymous) cs_args
       in
-      let _,env_c = push_rel_context ~hypnaming sigma csgn env in
+      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
@@ -1675,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/tactics/auto.ml b/tactics/auto.ml
index 85ca53b315e9..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). *)
diff --git a/tactics/class_tactics.ml b/tactics/class_tactics.ml
index 8a46776ac73d..e90fe12f0ef3 100644
--- a/tactics/class_tactics.ml
+++ b/tactics/class_tactics.ml
@@ -448,6 +448,7 @@ let make_hints env sigma (modes,st) only_classes =
     (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))
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 2340da4f8b35..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
diff --git a/tactics/equality.ml b/tactics/equality.ml
index 59e7a64547ae..e50536e57768 100644
--- a/tactics/equality.ml
+++ b/tactics/equality.ml
@@ -1849,7 +1849,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 x then
         check_non_indirectly_dependent_section_variable gl x;
       subst_one dep_proof_ok x res
   end
diff --git a/tactics/generalize.ml b/tactics/generalize.ml
index 31460e3a7684..efabb5313b1d 100644
--- a/tactics/generalize.ml
+++ b/tactics/generalize.ml
@@ -152,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
@@ -161,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
@@ -172,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
diff --git a/tactics/hints.ml b/tactics/hints.ml
index 752bdfdda477..9d9bd3ff7869 100644
--- a/tactics/hints.ml
+++ b/tactics/hints.ml
@@ -77,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
 
@@ -895,15 +894,16 @@ 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 ->
-      (* XXX how can vars_of_global return non secvars? *)
-      if is_section_variable (Global.env ()) id then
+      if is_section_variable' env id then
         Id.Pred.add id p
       else p) s Id.Pred.empty
 
 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
diff --git a/tactics/hints.mli b/tactics/hints.mli
index 568fb4cd754a..da7bdae78c6b 100644
--- a/tactics/hints.mli
+++ b/tactics/hints.mli
@@ -23,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
 
diff --git a/tactics/induction.ml b/tactics/induction.ml
index 02c5b6f75c67..a0ef78585cc2 100644
--- a/tactics/induction.ml
+++ b/tactics/induction.ml
@@ -1397,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 (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
@@ -1445,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 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/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_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/success/clear.v b/test-suite/success/clear.v
index 03034cf1305e..ad093ef6b9bb 100644
--- a/test-suite/success/clear.v
+++ b/test-suite/success/clear.v
@@ -15,19 +15,34 @@ Qed.
 
 Class A.
 
+Class B := BB : A.
+
 Section Foo.
 
   Variable a : A.
 
   Goal A.
     solve [typeclasses eauto].
-    Undo 1.
+  Qed.
+
+  Goal A.
     clear a.
-    try typeclasses eauto.
+    Fail solve [ typeclasses eauto ].
     assert(a:=Build_A).
     solve [ typeclasses eauto ].
-    Undo 2.
+  Qed.
+
+  Goal A.
+    clear a.
     assert(b:=Build_A).
     solve [ typeclasses eauto ].
   Qed.
+
+  Instance myb : B := a.
+
+  Goal B.
+    clear a.
+    assert(a:=Build_A).
+    Fail solve [typeclasses eauto].
+  Abort.
 End Foo.
diff --git a/vernac/proof_using.ml b/vernac/proof_using.ml
index c8f7bc6cc4bb..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 =
diff --git a/vernac/vernacentries.ml b/vernac/vernacentries.ml
index 7d2fea021b73..86adb56b5020 100644
--- a/vernac/vernacentries.ml
+++ b/vernac/vernacentries.ml
@@ -823,7 +823,7 @@ 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

From 44ee3d29f17f88a67519fd11cc5de9412c0a41f0 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Tue, 19 May 2026 16:55:30 +0200
Subject: [PATCH 541/578] changelog for section variable status tracking

---
 .../04-tactics/21987-context-secvar-Changed.rst       |  5 +++++
 .../04-tactics/21987-context-secvar-Fixed.rst         | 11 +++++++++++
 2 files changed, 16 insertions(+)
 create mode 100644 doc/changelog/04-tactics/21987-context-secvar-Changed.rst
 create mode 100644 doc/changelog/04-tactics/21987-context-secvar-Fixed.rst

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 <https://github.com/rocq-prover/rocq/pull/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 <https://github.com/rocq-prover/rocq/pull/21987>`_,
+  fixes `#18858 <https://github.com/rocq-prover/rocq/issues/18858>`_
+  and `#12304 <https://github.com/rocq-prover/rocq/issues/12304>`_
+  and `#11487 <https://github.com/rocq-prover/rocq/issues/11487>`_
+  and `#6773 <https://github.com/rocq-prover/rocq/issues/6773>`_,
+  by Gaëtan Gilbert).

From d52593d7e8248cff18242392251a309e096e9141 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Tue, 19 May 2026 16:58:24 +0200
Subject: [PATCH 542/578] better error message for ReferenceVariables for
 secvar status mismatch

---
 vernac/himsg.ml | 10 ++++++----
 1 file changed, 6 insertions(+), 4 deletions(-)

diff --git a/vernac/himsg.ml b/vernac/himsg.ml
index 1041122c1307..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
@@ -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 ->

From 4efd00c331afddd1f48deb9a17df413706cc5120 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Tue, 19 May 2026 17:11:27 +0200
Subject: [PATCH 543/578] slightly streamline pr_context_of code

---
 printing/printer.ml | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/printing/printer.ml b/printing/printer.ml
index 6719789f7bee..4aa208ab0a5b 100644
--- a/printing/printer.ml
+++ b/printing/printer.ml
@@ -521,9 +521,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) *)
 

From 8d6ddc01cdab227c09e723328c05fb25abae1cb5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Tue, 19 May 2026 17:29:42 +0200
Subject: [PATCH 544/578] Move CompactedDecl to ppconstr

---
 engine/eConstr.ml       |  2 --
 engine/eConstr.mli      |  2 --
 engine/termops.ml       | 23 -----------------------
 engine/termops.mli      |  1 -
 ide/rocqide/idetop.ml   |  2 +-
 kernel/constr.ml        |  2 --
 kernel/constr.mli       |  2 --
 kernel/context.ml       | 29 -----------------------------
 kernel/context.mli      | 17 -----------------
 printing/ppconstr.ml    | 39 +++++++++++++++++++++++++++++++++++++++
 printing/ppconstr.mli   | 14 ++++++++++++++
 printing/printer.ml     | 29 ++++++++++++-----------------
 printing/printer.mli    |  4 +---
 printing/proof_diffs.ml | 11 ++---------
 14 files changed, 69 insertions(+), 108 deletions(-)

diff --git a/engine/eConstr.ml b/engine/eConstr.ml
index c1b629fbc274..5f73db590b59 100644
--- a/engine/eConstr.ml
+++ b/engine/eConstr.ml
@@ -171,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
 
diff --git a/engine/eConstr.mli b/engine/eConstr.mli
index 0b7cec293478..6d2cab493c23 100644
--- a/engine/eConstr.mli
+++ b/engine/eConstr.mli
@@ -93,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
 
diff --git a/engine/termops.ml b/engine/termops.ml
index 54871eaace91..c9b8643fadd7 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
 
@@ -1182,28 +1181,6 @@ 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 _ status = function
diff --git a/engine/termops.mli b/engine/termops.mli
index e6badbac1940..625c3bb8115b 100644
--- a/engine/termops.mli
+++ b/engine/termops.mli
@@ -194,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
 
diff --git a/ide/rocqide/idetop.ml b/ide/rocqide/idetop.ml
index 726b1a6f1e76..6f9aeb94b3ca 100644
--- a/ide/rocqide/idetop.ml
+++ b/ide/rocqide/idetop.ml
@@ -207,7 +207,7 @@ let process_goal short sigma g =
     if short then [] else
       let hyps =
         List.rev_map process_hyp
-        (Termops.compact_named_context sigma (EConstr.named_context env))
+          (Ppconstr.compact_named_context sigma (EConstr.named_context env))
       in
       hyps
   in
diff --git a/kernel/constr.ml b/kernel/constr.ml
index a05c35c581e6..e7051c6e4af6 100644
--- a/kernel/constr.ml
+++ b/kernel/constr.ml
@@ -1383,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 *)
 
diff --git a/kernel/constr.mli b/kernel/constr.mli
index c578e1d29798..edb0d9fe3cc8 100644
--- a/kernel/constr.mli
+++ b/kernel/constr.mli
@@ -430,10 +430,8 @@ val eq_constr_nounivs : constr -> constr -> bool
 
 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 } *)
 
diff --git a/kernel/context.ml b/kernel/context.ml
index dbcdd89eb593..a0d9f84432eb 100644
--- a/kernel/context.ml
+++ b/kernel/context.ml
@@ -569,32 +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)
-      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 e8d2e0e1d1b3..7d67681980ce 100644
--- a/kernel/context.mli
+++ b/kernel/context.mli
@@ -370,20 +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
-  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/printing/ppconstr.ml b/printing/ppconstr.ml
index f792f9f7f252..ec7f4036788d 100644
--- a/printing/ppconstr.ml
+++ b/printing/ppconstr.ml
@@ -855,3 +855,42 @@ 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 Id.t EConstr.binder_annot list * EConstr.types
+    | LocalDef of Id.t EConstr.binder_annot list * EConstr.constr * EConstr.types
+
+  let of_named_decl = function
+    | Context.Named.Declaration.LocalAssum (id,t) ->
+      LocalAssum ([id],t)
+    | Context.Named.Declaration.LocalDef (id,v,t) ->
+      LocalDef ([id],v,t)
+
+  let to_tuple = function
+    | LocalAssum (ids, t) -> ids, None, t
+    | LocalDef (ids, b, t) -> ids, Some b, t
+end
+
+let compact_named_context sigma sign =
+  let module NamedDecl = Context.Named.Declaration in
+  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
diff --git a/printing/ppconstr.mli b/printing/ppconstr.mli
index c1921f57fa3f..64bfedd59091 100644
--- a/printing/ppconstr.mli
+++ b/printing/ppconstr.mli
@@ -96,3 +96,17 @@ 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 Id.t EConstr.binder_annot list * EConstr.types
+    | LocalDef of Id.t EConstr.binder_annot list * EConstr.constr * EConstr.types
+
+  val of_named_decl : 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 -> EConstr.named_context -> CompactedDecl.t list
diff --git a/printing/printer.ml b/printing/printer.ml
index 4aa208ab0a5b..4c07453dd69e 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 *)
@@ -363,33 +363,28 @@ let get_compact_context,set_compact_context =
   let compact_context = ref false in
   (fun () -> !compact_context),(fun b  -> compact_context := b)
 
-let pr_compacted_decl ?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
+       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 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
+  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)
 
-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 decl =
+  decl |> CompactedDecl.of_named_decl |> 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 (decl:Constr.named_declaration) =
+  pr_enamed_decl ?flags env sigma (EConstr.of_named_decl decl)
 
 let pr_rel_decl ?flags env sigma decl =
   let na = RelDecl.get_name decl in
@@ -441,11 +436,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 (EConstr.named_context env)) (mt ())
   in
   let db_env =
     fold_rel_context
@@ -496,7 +491,7 @@ and bld_sign_env_id ?flags env sigma ctxt pps is_start =
    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 = compact_named_context sigma ctxt in
   let lgth = List.length ctxt in
   let n_capped =
     match n with
diff --git a/printing/printer.mli b/printing/printer.mli
index 2dbcf1a553d2..043932c33f0d 100644
--- a/printing/printer.mli
+++ b/printing/printer.mli
@@ -192,15 +192,13 @@ 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
 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
 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
 
diff --git a/printing/proof_diffs.ml b/printing/proof_diffs.ml
index 54f84dd6357a..33887bb8af5f 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 (EConstr.named_context 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 )

From ff75bf4db438595a5223b58a7bd5b4d22cadbead Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Tue, 19 May 2026 17:51:43 +0200
Subject: [PATCH 545/578] Debug flag for variable status

---
 dev/top_printers.ml                           |  2 +-
 .../proof-engine/vernacular-commands.rst      |  6 ++
 engine/eConstr.ml                             |  9 ++-
 engine/eConstr.mli                            |  7 ++-
 ide/rocqide/idetop.ml                         |  2 +-
 kernel/environ.ml                             | 22 ++++---
 kernel/environ.mli                            |  9 ++-
 printing/ppconstr.ml                          | 42 +++++++------
 printing/ppconstr.mli                         |  9 +--
 printing/printer.ml                           | 59 +++++++++++--------
 printing/printer.mli                          |  8 +--
 printing/proof_diffs.ml                       |  2 +-
 test-suite/output/SecVar.out                  | 18 ++++++
 test-suite/output/SecVar.v                    | 15 +++++
 vernac/vernacentries.ml                       |  8 ---
 15 files changed, 143 insertions(+), 75 deletions(-)
 create mode 100644 test-suite/output/SecVar.out
 create mode 100644 test-suite/output/SecVar.v

diff --git a/dev/top_printers.ml b/dev/top_printers.ml
index e4a2c7717b12..d0a4a803dd77 100644
--- a/dev/top_printers.ml
+++ b/dev/top_printers.ml
@@ -318,7 +318,7 @@ 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
diff --git a/doc/sphinx/proof-engine/vernacular-commands.rst b/doc/sphinx/proof-engine/vernacular-commands.rst
index 762d248d77fe..7b8bfd7f96fb 100644
--- a/doc/sphinx/proof-engine/vernacular-commands.rst
+++ b/doc/sphinx/proof-engine/vernacular-commands.rst
@@ -1089,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:
diff --git a/engine/eConstr.ml b/engine/eConstr.ml
index 5f73db590b59..52f99c726532 100644
--- a/engine/eConstr.ml
+++ b/engine/eConstr.ml
@@ -1259,8 +1259,15 @@ let match_named_context_val :
   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 =
+  (env -> var_status -> named_declaration -> 'a -> 'a) ->
+  env -> init:'a -> 'a =
   let Refl, Refl = unsafe_eq, unsafe_relevance_eq in
   Environ.fold_named_context
 
diff --git a/engine/eConstr.mli b/engine/eConstr.mli
index 6d2cab493c23..7ee9a48ce89f 100644
--- a/engine/eConstr.mli
+++ b/engine/eConstr.mli
@@ -433,8 +433,13 @@ val val_of_named_context : (var_status * named_declaration) list -> named_contex
 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
+  (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
diff --git a/ide/rocqide/idetop.ml b/ide/rocqide/idetop.ml
index 6f9aeb94b3ca..7afdb18ea3d9 100644
--- a/ide/rocqide/idetop.ml
+++ b/ide/rocqide/idetop.ml
@@ -207,7 +207,7 @@ let process_goal short sigma g =
     if short then [] else
       let hyps =
         List.rev_map process_hyp
-          (Ppconstr.compact_named_context sigma (EConstr.named_context env))
+          (Ppconstr.compact_named_context sigma (Environ.named_context_val env))
       in
       hyps
   in
diff --git a/kernel/environ.ml b/kernel/environ.ml
index 850bfe73e9e7..3a695cd15f67 100644
--- a/kernel/environ.ml
+++ b/kernel/environ.ml
@@ -191,6 +191,11 @@ let set_rel_context_val v env =
 (* Named context *)
 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
   (*   assert (not (Id.Map.mem id ctxt.env_named_map)); *)
@@ -519,15 +524,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 (status, d, rem) ->
-        let env =
-          reset_with_named_context rem env in
-        f env status d (fold_right env)
-  in fold_right env
+      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)
diff --git a/kernel/environ.mli b/kernel/environ.mli
index 477652dc15f5..3eff5eabcb78 100644
--- a/kernel/environ.mli
+++ b/kernel/environ.mli
@@ -113,6 +113,8 @@ val fold_rel_context :
 
 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
 
@@ -150,8 +152,13 @@ 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 -> var_status -> 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 -> (var_status * named_declaration * named_context_val) option
 
diff --git a/printing/ppconstr.ml b/printing/ppconstr.ml
index ec7f4036788d..f286f29b82af 100644
--- a/printing/ppconstr.ml
+++ b/printing/ppconstr.ml
@@ -858,39 +858,43 @@ let pr_binders ~flags env sigma l : Pp.t = pr_undelimited_binders ~flags spc tru
 
 module CompactedDecl = struct
   type t =
-    | LocalAssum of Id.t EConstr.binder_annot list * EConstr.types
-    | LocalDef of Id.t EConstr.binder_annot list * EConstr.constr * EConstr.types
+    | 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 = function
+  let of_named_decl status = function
     | Context.Named.Declaration.LocalAssum (id,t) ->
-      LocalAssum ([id],t)
+      LocalAssum ([status,id], t)
     | Context.Named.Declaration.LocalDef (id,v,t) ->
-      LocalDef ([id],v,t)
+      LocalDef ([status,id], v, t)
 
   let to_tuple = function
-    | LocalAssum (ids, t) -> ids, None, t
-    | LocalDef (ids, b, t) -> ids, Some b, t
+    | 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 decl =
+  let compact l status decl =
     match decl, l with
     | NamedDecl.LocalAssum (i,t), [] ->
-       [CompactedDecl.LocalAssum ([i],t)]
+      [CompactedDecl.LocalAssum ([Some status,i],t)]
     | NamedDecl.LocalDef (i,c,t), [] ->
-       [CompactedDecl.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 (i1::li, t2) :: q
-       else CompactedDecl.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 (i1::li, c2, t2) :: q
-       else CompactedDecl.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 ([i],t) :: q
+      CompactedDecl.LocalAssum ([Some status,i],t) :: q
     | NamedDecl.LocalDef (i,c,t), q ->
-       CompactedDecl.LocalDef ([i],c,t) :: q
+      CompactedDecl.LocalDef ([Some status,i],c,t) :: q
   in
-  sign |> Context.Named.fold_inside compact ~init:[] |> List.rev
+  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 64bfedd59091..7735b7ff1856 100644
--- a/printing/ppconstr.mli
+++ b/printing/ppconstr.mli
@@ -99,14 +99,15 @@ val modular_constr_pr :
 
 module CompactedDecl : sig
   type t =
-    | LocalAssum of Id.t EConstr.binder_annot list * EConstr.types
-    | LocalDef of Id.t EConstr.binder_annot list * EConstr.constr * EConstr.types
+    | 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 : EConstr.named_declaration -> t
+  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 -> EConstr.named_context -> CompactedDecl.t list
+
+val compact_named_context : Evd.evar_map -> Environ.named_context_val -> CompactedDecl.t list
diff --git a/printing/printer.ml b/printing/printer.ml
index 4c07453dd69e..1021090fa7c4 100644
--- a/printing/printer.ml
+++ b/printing/printer.ml
@@ -359,32 +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_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_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
+      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
+    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_enamed_decl ?flags env sigma decl =
-  decl |> CompactedDecl.of_named_decl |> pr_ecompacted_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_named_decl ?flags env sigma (decl:Constr.named_declaration) =
-  pr_enamed_decl ?flags env sigma (EConstr.of_named_decl 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
@@ -412,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 _status 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
@@ -440,7 +449,7 @@ let pr_context_unlimited ?flags env sigma =
       (fun d pps ->
          let pidt =  pr_ecompacted_decl ?flags env sigma d in
          (pps ++ fnl () ++ pidt))
-      (compact_named_context sigma (EConstr.named_context env)) (mt ())
+      (compact_named_context sigma (Environ.named_context_val env)) (mt ())
   in
   let db_env =
     fold_rel_context
@@ -469,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')
@@ -480,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
@@ -490,7 +499,7 @@ 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 = Environ.named_context_val env in
   let ctxt = compact_named_context sigma ctxt in
   let lgth = List.length ctxt in
   let n_capped =
diff --git a/printing/printer.mli b/printing/printer.mli
index 043932c33f0d..7413d617f289 100644
--- a/printing/printer.mli
+++ b/printing/printer.mli
@@ -183,20 +183,16 @@ 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
+  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 -> Ppconstr.CompactedDecl.t -> Pp.t
 val pr_erel_decl : ?flags:PrintingFlags.t ->
diff --git a/printing/proof_diffs.ml b/printing/proof_diffs.ml
index 33887bb8af5f..12eec5366745 100644
--- a/printing/proof_diffs.ml
+++ b/printing/proof_diffs.ml
@@ -311,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 = Ppconstr.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 )
diff --git a/test-suite/output/SecVar.out b/test-suite/output/SecVar.out
new file mode 100644
index 000000000000..6f32683e6776
--- /dev/null
+++ b/test-suite/output/SecVar.out
@@ -0,0 +1,18 @@
+1 goal
+  
+  a (* section variable *), b (* section variable *) : nat
+  H (* section variable *) : a = b
+  ============================
+  True
+1 goal
+  
+  a (* section variable *), b (* section variable *) : nat
+  H (* hypothesis *) : b = a
+  ============================
+  True
+1 goal
+  
+  a (* section variable *), y (* hypothesis *) : nat
+  H (* hypothesis *) : y = a
+  ============================
+  True
diff --git a/test-suite/output/SecVar.v b/test-suite/output/SecVar.v
new file mode 100644
index 000000000000..82116643fa3a
--- /dev/null
+++ b/test-suite/output/SecVar.v
@@ -0,0 +1,15 @@
+Section S.
+  Variables a b : nat.
+  Variable H : a = b.
+
+  Set Printing Variables Status.
+
+  Goal True.
+  Proof.
+    Show.
+    apply eq_sym in H.
+    Show.
+    rename b into y.
+    Show.
+  Abort.
+End S.
diff --git a/vernac/vernacentries.ml b/vernac/vernacentries.ml
index 86adb56b5020..5e9b897fdea7 100644
--- a/vernac/vernacentries.ml
+++ b/vernac/vernacentries.ml
@@ -1943,14 +1943,6 @@ let () =
       optread  = (fun () -> (Global.typing_flags ()).Declarations.unfold_dep_heuristic);
       optwrite = Global.set_unfold_dep_heuristic }
 
-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) }
-
 let () =
   declare_int_option
     { optstage = Summary.Stage.Interp;

From f977070a65022de8dacda2fb7c89314a211f0680 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Wed, 20 May 2026 16:57:05 +0200
Subject: [PATCH 546/578] uncomment assert in environ

when this invariant is broken secvar checking produces another assert
failure later
---
 kernel/environ.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/kernel/environ.ml b/kernel/environ.ml
index 3a695cd15f67..f171ec2e77b4 100644
--- a/kernel/environ.ml
+++ b/kernel/environ.ml
@@ -198,7 +198,7 @@ let var_status_eq a b = match a, b with
 
 let push_named_context_val status d ctxt =
   let id = NamedDecl.get_id d in
-  (*   assert (not (Id.Map.mem id ctxt.env_named_map)); *)
+  assert (not (Id.Map.mem id ctxt.env_named_map));
   let secvars = match status with
     | ProofVar -> ctxt.env_named_secvars
     | SecVar -> Id.Set.add id ctxt.env_named_secvars

From 3452ac2a82aeaad541a3141f7e8d016726d8b621 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Thu, 21 May 2026 17:41:49 +0200
Subject: [PATCH 547/578] bench auto overlays for metarocq

---
 dev/bench/bench.sh | 1 +
 1 file changed, 1 insertion(+)

diff --git a/dev/bench/bench.sh b/dev/bench/bench.sh
index 47be3fc4a216..37202ededc15 100755
--- a/dev/bench/bench.sh
+++ b/dev/bench/bench.sh
@@ -98,6 +98,7 @@ export COQ_LOG_DIR=$log_dir
 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-}"

From 395a8d80987125f03bd244fa1643b71af4555bd5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Wed, 27 May 2026 14:28:20 +0200
Subject: [PATCH 548/578] add is_section_var tactic

Close #21104
---
 doc/sphinx/proof-engine/ltac.rst |  8 ++++++++
 doc/tools/docgram/fullGrammar    |  1 +
 doc/tools/docgram/orderedGrammar |  1 +
 plugins/ltac/extratactics.mlg    |  4 ++++
 plugins/ltac/internals.ml        | 14 ++++++++++++++
 plugins/ltac/internals.mli       |  1 +
 6 files changed, 29 insertions(+)

diff --git a/doc/sphinx/proof-engine/ltac.rst b/doc/sphinx/proof-engine/ltac.rst
index f88e0ad5775f..7ea13b8843a0 100644
--- a/doc/sphinx/proof-engine/ltac.rst
+++ b/doc/sphinx/proof-engine/ltac.rst
@@ -1706,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
diff --git a/doc/tools/docgram/fullGrammar b/doc/tools/docgram/fullGrammar
index 38c9d327a6f8..1e2a661598d2 100644
--- a/doc/tools/docgram/fullGrammar
+++ b/doc/tools/docgram/fullGrammar
@@ -1826,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
diff --git a/doc/tools/docgram/orderedGrammar b/doc/tools/docgram/orderedGrammar
index d677407a4f1b..bf3fca66453f 100644
--- a/doc/tools/docgram/orderedGrammar
+++ b/doc/tools/docgram/orderedGrammar
@@ -1498,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
diff --git a/plugins/ltac/extratactics.mlg b/plugins/ltac/extratactics.mlg
index fc0cb6611fe0..30c7aff4d81b 100644
--- a/plugins/ltac/extratactics.mlg
+++ b/plugins/ltac/extratactics.mlg
@@ -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
diff --git a/plugins/ltac/internals.ml b/plugins/ltac/internals.ml
index 7bf5ab378113..4efe423e653b 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' ~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
diff --git a/plugins/ltac/internals.mli b/plugins/ltac/internals.mli
index 027debcc3ac8..3d9090326c71 100644
--- a/plugins/ltac/internals.mli
+++ b/plugins/ltac/internals.mli
@@ -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

From 9fd9307754d3479d241be379104538cacfcd0ae0 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Wed, 20 May 2026 15:41:36 +0200
Subject: [PATCH 549/578] overlay

---
 .../21987-SkySkimmer-context-secvar.sh        | 34 +++++++++++++++++++
 1 file changed, 34 insertions(+)
 create mode 100644 dev/ci/user-overlays/21987-SkySkimmer-context-secvar.sh

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..011d5f234b70
--- /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

From db319703a0f9340952ddc82defed693efcb3f088 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Wed, 27 May 2026 16:25:35 +0200
Subject: [PATCH 550/578] weaken assert in push_named

---
 kernel/environ.ml | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/kernel/environ.ml b/kernel/environ.ml
index f171ec2e77b4..7f5295a5e76a 100644
--- a/kernel/environ.ml
+++ b/kernel/environ.ml
@@ -198,7 +198,9 @@ let var_status_eq a b = match a, b with
 
 let push_named_context_val status d ctxt =
   let id = NamedDecl.get_id d in
-  assert (not (Id.Map.mem id ctxt.env_named_map));
+  (* 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

From 53153270f2251ccb9f9814ab9756e3723ef98484 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Thu, 28 May 2026 13:16:11 +0200
Subject: [PATCH 551/578] Remove more global lazys

---
 plugins/btauto/refl_btauto.ml      | 45 +++++++++++++-------------
 plugins/firstorder/g_ground.mlg    | 16 ----------
 plugins/micromega/coq_micromega.ml |  2 --
 plugins/nsatz/nsatz.ml             | 51 +++++++++++++++---------------
 plugins/ring/ring.ml               | 11 +++----
 tactics/rewrite.ml                 | 25 +++++++--------
 6 files changed, 65 insertions(+), 85 deletions(-)

diff --git a/plugins/btauto/refl_btauto.ml b/plugins/btauto/refl_btauto.ml
index 40dbe50395a5..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|]
@@ -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/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/micromega/coq_micromega.ml b/plugins/micromega/coq_micromega.ml
index bf55c192ffae..939c73eb4914 100644
--- a/plugins/micromega/coq_micromega.ml
+++ b/plugins/micromega/coq_micromega.ml
@@ -1047,8 +1047,6 @@ 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 (rocq_IsProp()) then Mc.IsProp
   else Mc.IsBool
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/ring.ml b/plugins/ring/ring.ml
index 1eb530a77c39..e9e11ef2b4e6 100644
--- a/plugins/ring/ring.ml
+++ b/plugins/ring/ring.ml
@@ -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 *)
 
@@ -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) ->
@@ -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"
diff --git a/tactics/rewrite.ml b/tactics/rewrite.ml
index c2011de9df77..a74f484bac93 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" ()
 

From 01d2f00682c5a69507b69131e9bc2536dc19ff30 Mon Sep 17 00:00:00 2001
From: Pierre Roux <pierre.roux@onera.fr>
Date: Tue, 14 Apr 2026 16:50:40 +0200
Subject: [PATCH 552/578] Have implicit arguments with "Asymmetric Patterns"

Add a flag "Asymmetric Patterns No Implicits" (false by default) that
can be set to true to retrieve the previous behavior of "Asymmetric
Patterns" (needed for backward compat).
---
 ...ymmetric-patterns-no-implicits-Changed.rst |  8 +++++++
 doc/sphinx/language/extensions/match.rst      |  9 ++++++++
 interp/constrintern.ml                        |  9 +++++++-
 interp/constrintern.mli                       |  2 ++
 test-suite/bugs/bug_11576.v                   |  7 +++---
 test-suite/bugs/bug_3045.v                    |  4 ++--
 test-suite/bugs/bug_3262.v                    |  4 ++--
 test-suite/bugs/bug_3732.v                    |  4 ++--
 test-suite/bugs/bug_4001.v                    |  2 +-
 test-suite/bugs/bug_7916.v                    |  2 +-
 test-suite/output/Cases.out                   | 19 +++++++++-------
 test-suite/output/Cases.v                     |  6 ++---
 test-suite/prerequisite/ssr_mini_mathcomp.v   | 22 +++++++++----------
 test-suite/success/Case22.v                   |  2 +-
 theories/Corelib/Compat/Rocq92.v              |  2 ++
 15 files changed, 66 insertions(+), 36 deletions(-)
 create mode 100644 doc/changelog/08-vernac-commands-and-options/21947-asymmetric-patterns-no-implicits-Changed.rst

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 <https://github.com/rocq-prover/rocq/pull/21947>`_,
+  fixes `#21769 <https://github.com/rocq-prover/rocq/issues/21769>`_,
+  by Pierre Roux).
diff --git a/doc/sphinx/language/extensions/match.rst b/doc/sphinx/language/extensions/match.rst
index fb44d8cfa6c9..8269a5b1d6b6 100644
--- a/doc/sphinx/language/extensions/match.rst
+++ b/doc/sphinx/language/extensions/match.rst
@@ -664,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/interp/constrintern.ml b/interp/constrintern.ml
index 35ff54ca4669..e1c324f62ee1 100644
--- a/interp/constrintern.ml
+++ b/interp/constrintern.ml
@@ -1776,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
@@ -1853,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 ->
diff --git a/interp/constrintern.mli b/interp/constrintern.mli
index c53597e3a9f7..3cbf381ca920 100644
--- a/interp/constrintern.mli
+++ b/interp/constrintern.mli
@@ -251,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/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_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_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/output/Cases.out b/test-suite/output/Cases.out
index 5d1a3dfb321c..00b58288f3ad 100644
--- a/test-suite/output/Cases.out
+++ b/test-suite/output/Cases.out
@@ -231,15 +231,18 @@ File "./output/Cases.v", line 284, characters 33-39:
 The command has indeed failed with message:
 The constructor cons (in type list) is expected to be applied to 2 arguments
 while it is actually applied to 1 argument.
-File "./output/Cases.v", line 286, characters 33-39:
+fun x : J' ?T ?p => match x with
+                    | @D' _ _ _ _ _ _ _ _ => 0
+                    end
+     : J' ?T ?p -> nat
+where
+?T : [x : J' ?T ?p |- Type] (x cannot be used)
+?T0 : [x : J' ?T ?p |- Type] (x cannot be used)
+?p : [x : J' ?T ?p |- (?T * ?T0)%type] (x cannot be used)
+File "./output/Cases.v", line 282, characters 33-45:
 The command has indeed failed with message:
-The constructor D' (in type J') is expected to be applied to 3 arguments (or
-4 arguments when including variables for local definitions) while it is
-actually applied to 2 arguments.
-File "./output/Cases.v", line 287, characters 33-45:
-The command has indeed failed with message:
-The constructor D' (in type J') is expected to be applied to 3 arguments (or
-4 arguments when including variables for local definitions) while it is
+The constructor D' (in type J') is expected to be applied to 2 arguments (or
+3 arguments when including variables for local definitions) while it is
 actually applied to 5 arguments.
 fun x : J' bool (true, true) =>
 match x with
diff --git a/test-suite/output/Cases.v b/test-suite/output/Cases.v
index 98ee85518031..32c0145cd51d 100644
--- a/test-suite/output/Cases.v
+++ b/test-suite/output/Cases.v
@@ -283,10 +283,10 @@ Fail Check fun x => match x with (y,z) w => y+z+w end.
 Fail Check fun x => match x with cons y z w => 0 | nil => 0 end.
 Fail Check fun x => match x with cons y => 0 | nil => 0 end.
 
-Fail Check fun x => match x with D' n _ => 0 end.
+Check fun x => match x with D' n _ => 0 end.
 Fail Check fun x => match x with D' n m p e _ => 0 end.
-Check fun x : J' bool (true,true) => match x with D' n m e => existT (fun x => eq x x) m e end.
-Check fun x : J' bool (true,true) => match x with D' n m p e => (n,p) end.
+Check fun x : J' bool (true,true) => match x with D' n e => existT (fun x => eq x x) _ e end.
+Check fun x : J' bool (true,true) => match x with D' n p e => (n,p) end.
 
 End ConstructorArgumentsNumber.
 
diff --git a/test-suite/prerequisite/ssr_mini_mathcomp.v b/test-suite/prerequisite/ssr_mini_mathcomp.v
index 78a41c2501ef..e25aa27b6745 100644
--- a/test-suite/prerequisite/ssr_mini_mathcomp.v
+++ b/test-suite/prerequisite/ssr_mini_mathcomp.v
@@ -35,7 +35,7 @@ Structure type := Pack {sort; _ : class_of sort; _ : Type}.
 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.
 
 Definition pack c := @Pack T c T.
 Definition clone := fun c & cT -> T & phant_id (pack c) cT => pack c.
@@ -694,9 +694,9 @@ Local Coercion base : class_of >->  Equality.class_of.
 Structure type := Pack {sort; _ : class_of sort; _ : Type}.
 Local Coercion sort : type >-> Sortclass.
 Variables (T : Type) (cT : type).
-Definition class := let: Pack _ c _ as cT' := cT return class_of cT' in c.
+Definition class := let: Pack c _ as cT' := cT return class_of cT' in c.
 Definition clone c & phant_id class c := @Pack T c T.
-Let xT := let: Pack T _ _ := cT in T.
+Let xT := let: @Pack T _ _ := cT in T.
 Notation xclass := (class : class_of xT).
 
 Definition pack m :=
@@ -797,9 +797,9 @@ Local Coercion base : class_of >-> Choice.class_of.
 Structure type : Type := Pack {sort : Type; _ : class_of sort; _ : Type}.
 Local Coercion sort : type >-> Sortclass.
 Variables (T : Type) (cT : type).
-Definition class := let: Pack _ c _ as cT' := cT return class_of cT' in c.
+Definition class := let: Pack c _ as cT' := cT return class_of cT' in c.
 Definition clone c & phant_id class c := @Pack T c T.
-Let xT := let: Pack T _ _ := cT in T.
+Let xT := let: @Pack T _ _ := cT in T.
 Notation xclass := (class : class_of xT).
 
 Definition pack m :=
@@ -881,7 +881,7 @@ Structure subCountType : Type :=
   SubCountType {subCount_sort :> subType P; _ : mixin_of subCount_sort}.
 
 Coercion sub_countType (sT : subCountType) :=
-  Eval hnf in pack (let: SubCountType _ m := sT return mixin_of sT in m) id.
+  Eval hnf in pack (let: SubCountType m := sT return mixin_of sT in m) id.
 Canonical sub_countType.
 
 Definition pack_subCountType U :=
@@ -925,7 +925,7 @@ Section Mixins.
 Variable T : countType.
 
 Definition EnumMixin :=
-  let: Countable.Pack _ (Countable.Class _ m) _ as cT := T
+  let: Countable.Pack (Countable.Class _ m) _ as cT := T
     return forall e : seq cT, axiom e -> mixin_of cT in
   @Mixin (EqType _ _) m.
 
@@ -947,9 +947,9 @@ Local Coercion base : class_of >-> Choice.class_of.
 Structure type : Type := Pack {sort; _ : class_of sort; _ : Type}.
 Local Coercion sort : type >-> Sortclass.
 Variables (T : Type) (cT : type).
-Definition class := let: Pack _ c _ as cT' := cT return class_of cT' in c.
+Definition class := let: Pack c _ as cT' := cT return class_of cT' in c.
 Definition clone c & phant_id class c := @Pack T c T.
-Let xT := let: Pack T _ _ := cT in T.
+Let xT := let: @Pack T _ _ := cT in T.
 Notation xclass := (class : class_of xT).
 
 Definition pack b0 (m0 : mixin_of (EqType T b0)) :=
@@ -1016,7 +1016,7 @@ Definition pack_subFinType U :=
 Implicit Type sT : subFinType.
 
 Definition subFin_mixin sT :=
-  let: SubFinType _ m := sT return mixin_of (sub_eqType sT) in m.
+  let: SubFinType m := sT return mixin_of (sub_eqType sT) in m.
 
 Coercion subFinType_subCountType sT := @SubCountType _ _ sT (subFin_mixin sT).
 Canonical subFinType_subCountType.
@@ -1047,7 +1047,7 @@ Variable n : nat.
 
 Inductive ordinal : predArgType := Ordinal m of m < n.
 
-Coercion nat_of_ord i := let: Ordinal m _ := i in m.
+Coercion nat_of_ord i := let: @Ordinal m _ := i in m.
 
 Canonical ordinal_subType := [subType for nat_of_ord].
 Definition ordinal_eqMixin := Eval hnf in [eqMixin of ordinal by <:].
diff --git a/test-suite/success/Case22.v b/test-suite/success/Case22.v
index 90c1b308f2b6..5ccd46f6507f 100644
--- a/test-suite/success/Case22.v
+++ b/test-suite/success/Case22.v
@@ -100,5 +100,5 @@ Check fun x : {True}+{False} => match x with left _ => 0 | right _ => 1 end.
 Inductive expr {A} : A -> Type := intro : forall {n:nat} (a:A), n=n -> expr a.
 Check fun (x:expr true) => match x in expr n return n=n with intro _ _ => eq_refl end.
 Set Asymmetric Patterns.
-Check fun (x:expr true) => match x in expr n return n=n with intro _ a _ => eq_refl a end.
+Check fun (x:expr true) => match x in expr n return n=n with intro a _ => eq_refl a end.
 Unset Asymmetric Patterns.
diff --git a/theories/Corelib/Compat/Rocq92.v b/theories/Corelib/Compat/Rocq92.v
index 377a995a6e0b..bf6541048caf 100644
--- a/theories/Corelib/Compat/Rocq92.v
+++ b/theories/Corelib/Compat/Rocq92.v
@@ -16,3 +16,5 @@
 #[export] Set Warnings "-deprecated-since-9.3".
 
 #[export] Set Inline Abstract Subproof.
+
+#[export] Set Asymmetric Patterns No Implicits.

From 0ff5c743b13194d54da76fc6711d3abf0d503539 Mon Sep 17 00:00:00 2001
From: Pierre Roux <pierre.roux@onera.fr>
Date: Tue, 14 Apr 2026 16:54:52 +0200
Subject: [PATCH 553/578] Improve pattern externalization with Asymettric
 Patterns

---
 interp/constrextern.ml           | 21 +++++++++++++--------
 test-suite/output/Cases.out      |  6 +++---
 test-suite/output/PrintMatch.out |  2 +-
 3 files changed, 17 insertions(+), 12 deletions(-)

diff --git a/interp/constrextern.ml b/interp/constrextern.ml
index 9668ef64bb96..397eb9bbe440 100644
--- a/interp/constrextern.ml
+++ b/interp/constrextern.ml
@@ -307,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
diff --git a/test-suite/output/Cases.out b/test-suite/output/Cases.out
index 00b58288f3ad..112f1d3da96e 100644
--- a/test-suite/output/Cases.out
+++ b/test-suite/output/Cases.out
@@ -232,21 +232,21 @@ The command has indeed failed with message:
 The constructor cons (in type list) is expected to be applied to 2 arguments
 while it is actually applied to 1 argument.
 fun x : J' ?T ?p => match x with
-                    | @D' _ _ _ _ _ _ _ _ => 0
+                    | D' _ _ _ => 0
                     end
      : J' ?T ?p -> nat
 where
 ?T : [x : J' ?T ?p |- Type] (x cannot be used)
 ?T0 : [x : J' ?T ?p |- Type] (x cannot be used)
 ?p : [x : J' ?T ?p |- (?T * ?T0)%type] (x cannot be used)
-File "./output/Cases.v", line 282, characters 33-45:
+File "./output/Cases.v", line 287, characters 33-45:
 The command has indeed failed with message:
 The constructor D' (in type J') is expected to be applied to 2 arguments (or
 3 arguments when including variables for local definitions) while it is
 actually applied to 5 arguments.
 fun x : J' bool (true, true) =>
 match x with
-| @D' _ _ _ _ _ m _ e => existT (fun x0 : nat => x0 = x0) m e
+| D' m _ e => existT (fun x0 : nat => x0 = x0) m e
 end
      : J' bool (true, true) -> {x : nat & x = x}
 fun x : J' bool (true, true) =>
diff --git a/test-suite/output/PrintMatch.out b/test-suite/output/PrintMatch.out
index 84400087400e..21edf10e2e76 100644
--- a/test-suite/output/PrintMatch.out
+++ b/test-suite/output/PrintMatch.out
@@ -41,7 +41,7 @@ Arguments eq_sym [A]%_type_scope [x y] H
 eq_sym =
 fun (A : Type) (x y : A) (H : x = y) =>
 match H in _ = y0 return y0 = x with
-| @eq_refl _ _ => @eq_refl A x
+| eq_refl => @eq_refl A x
 end
      : forall [A : Type] [x y : A], x = y -> y = x
 

From 20d7787a1db2436e7804235352d43d782f4e41af Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Thu, 28 May 2026 14:53:33 +0200
Subject: [PATCH 554/578] Makefile.ci use wildcard instead of exhaustive list
 of CI_TARGETS

Fix ci-mathcomp in local build (ci-micromega wasn't added to the list)
---
 Makefile.ci            | 67 +-----------------------------------------
 dev/ci/README-users.md |  9 +++---
 2 files changed, 5 insertions(+), 71 deletions(-)

diff --git a/Makefile.ci b/Makefile.ci
index 54f477d99235..70708e47a530 100644
--- a/Makefile.ci
+++ b/Makefile.ci
@@ -42,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-rocq_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 \
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 (`_`).

From 7447c24695cc1120ebcec9909788d7eaa5e2e561 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Thu, 28 May 2026 15:37:20 +0200
Subject: [PATCH 555/578] Reduction effects use econstr

---
 dev/ci/user-overlays/22077-SkySkimmer-red-ef-eon.sh | 1 +
 pretyping/cbv.ml                                    | 2 +-
 pretyping/reductionops.ml                           | 2 +-
 pretyping/reductionops.mli                          | 4 ++--
 pretyping/tacred.ml                                 | 4 ++--
 tactics/cbn.ml                                      | 2 +-
 6 files changed, 8 insertions(+), 7 deletions(-)
 create mode 100644 dev/ci/user-overlays/22077-SkySkimmer-red-ef-eon.sh

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/pretyping/cbv.ml b/pretyping/cbv.ml
index b7c6bedbb1bd..61f74e4c605a 100644
--- a/pretyping/cbv.ml
+++ b/pretyping/cbv.ml
@@ -541,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) ->
diff --git a/pretyping/reductionops.ml b/pretyping/reductionops.ml
index 9195b1a1f216..da0dd3ab7c39 100644
--- a/pretyping/reductionops.ml
+++ b/pretyping/reductionops.ml
@@ -853,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 ->
diff --git a/pretyping/reductionops.mli b/pretyping/reductionops.mli
index f003559812f0..807b68e21025 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
diff --git a/pretyping/tacred.ml b/pretyping/tacred.ml
index 67e746b58ef7..ecc9e345d719 100644
--- a/pretyping/tacred.ml
+++ b/pretyping/tacred.ml
@@ -603,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
@@ -620,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
diff --git a/tactics/cbn.ml b/tactics/cbn.ml
index 3ad64d4793ab..d63ab933cb3a 100644
--- a/tactics/cbn.ml
+++ b/tactics/cbn.ml
@@ -709,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

From eb2d03ded9b0a4583012643f36c027f3e435ceb4 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Thu, 28 May 2026 16:39:23 +0200
Subject: [PATCH 556/578] Avoid printing missing-scheme warning when rewrite
 fails

This removes some warnings in stdlib which would be caught by try when
the warning is as-error.
---
 tactics/equality.ml | 39 ++++++++++++++++++++++++++-------------
 1 file changed, 26 insertions(+), 13 deletions(-)

diff --git a/tactics/equality.ml b/tactics/equality.ml
index 77431b5a7e45..65a1be50d4a0 100644
--- a/tactics/equality.ml
+++ b/tactics/equality.ml
@@ -480,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 ->
@@ -499,10 +510,10 @@ 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
   let nb_args = List.length args in
@@ -517,7 +528,7 @@ let find_elim lft2rgt dep inccl type_of_cls (ctx, hdcncl, args) =
     let p_sort = Retyping.get_sort_of env sigma type_of_cls in
     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 ()
@@ -531,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
-      lft2rgt elim indarg
+        lft2rgt elim indarg >>= fun () ->
+      warn_missing_scheme warn
   end
 
 let adjust_rewriting_direction args lft2rgt =
@@ -1383,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
@@ -1396,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

From 66dc56d25fc99ce0de927e986b4fe300946a1e9d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Thu, 28 May 2026 14:39:11 +0200
Subject: [PATCH 557/578] disable some not needed overlays

---
 dev/ci/user-overlays/21987-SkySkimmer-context-secvar.sh | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/dev/ci/user-overlays/21987-SkySkimmer-context-secvar.sh b/dev/ci/user-overlays/21987-SkySkimmer-context-secvar.sh
index 011d5f234b70..d0bb28df466e 100644
--- a/dev/ci/user-overlays/21987-SkySkimmer-context-secvar.sh
+++ b/dev/ci/user-overlays/21987-SkySkimmer-context-secvar.sh
@@ -2,9 +2,9 @@ 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 mathcomp https://github.com/SkySkimmer/math-comp context-secvar 21987
 
-overlay tlc https://github.com/SkySkimmer/tlc 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
@@ -19,7 +19,7 @@ overlay coqutil https://github.com/SkySkimmer/coqutil context-secvar 21987
 
 overlay fiat_crypto https://github.com/SkySkimmer/fiat-crypto context-secvar 21987
 
-overlay ceres https://github.com/SkySkimmer/coq-ceres context-secvar 21987
+#overlay ceres https://github.com/SkySkimmer/coq-ceres context-secvar 21987
 
 overlay unicoq https://github.com/SkySkimmer/unicoq context-secvar 21987
 

From 33534059ca8981fbb8166ea49b69f4eb09a5a7de Mon Sep 17 00:00:00 2001
From: Pierre Roux <pierre.roux@onera.fr>
Date: Fri, 29 May 2026 10:04:44 +0200
Subject: [PATCH 558/578] [CI] Fix micromega dune package name

---
 dev/ci/scripts/ci-micromega.sh | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/dev/ci/scripts/ci-micromega.sh b/dev/ci/scripts/ci-micromega.sh
index 7ea31e8ff948..b198faa63f5b 100644
--- a/dev/ci/scripts/ci-micromega.sh
+++ b/dev/ci/scripts/ci-micromega.sh
@@ -10,6 +10,6 @@ git_download micromega
 if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi
 
 ( cd "${CI_BUILD_DIR}/micromega"
-  dune build --root . --only-packages=micromega-plugin @install
-  dune install --root . micromega-plugin --prefix=$CI_INSTALL_DIR
+  dune build --root . --only-packages=rocq-micromega-plugin @install
+  dune install --root . rocq-micromega-plugin --prefix=$CI_INSTALL_DIR
 )

From 8777cc1f018fc7209c6ff74108cb3db183a0a989 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Fri, 29 May 2026 11:15:01 +0200
Subject: [PATCH 559/578] Stop explicitly starting memprof limits

Since memprof 0.3 it should init itself when needed.

This appears to fix ocamldebug bugged backtracking (as long as memprof
doesn't need to init itself).
---
 clib/memprof_coq.memprof.ml | 2 --
 clib/memprof_coq.mli        | 2 --
 clib/memprof_coq.std.ml     | 2 --
 dune-project                | 2 +-
 rocq-runtime.opam           | 6 +++++-
 sysinit/coqinit.ml          | 1 -
 6 files changed, 6 insertions(+), 9 deletions(-)

diff --git a/clib/memprof_coq.memprof.ml b/clib/memprof_coq.memprof.ml
index ad3728bb00c9..114889cdb298 100644
--- a/clib/memprof_coq.memprof.ml
+++ b/clib/memprof_coq.memprof.ml
@@ -6,8 +6,6 @@ let is_interrupted () = Memprof_limits.is_interrupted () [@@inline]
 
 let limit_allocations = Memprof_limits.limit_allocations
 
-let start_memprof_limits = Memprof_limits.start_memprof_limits
-
 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 8396bd1a0c5a..ba5a73079d06 100644
--- a/clib/memprof_coq.mli
+++ b/clib/memprof_coq.mli
@@ -5,8 +5,6 @@ val is_interrupted : unit -> bool
 
 val limit_allocations : limit:Int64.t -> (unit -> 'a) -> ('a * Int64.t, exn) result
 
-val start_memprof_limits : unit -> unit
-
 module Masking : sig
 
   val with_resource :
diff --git a/clib/memprof_coq.std.ml b/clib/memprof_coq.std.ml
index 4bf5ec7f77c0..d10a3f6df9ec 100644
--- a/clib/memprof_coq.std.ml
+++ b/clib/memprof_coq.std.ml
@@ -4,8 +4,6 @@ let is_interrupted _ = false [@@inline]
 
 let limit_allocations ~limit:_ f = Ok (f(), 0L)
 
-let start_memprof_limits () = ()
-
 module Resource_bind = struct
   let ( let& ) f scope = f ~scope
 end
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/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/sysinit/coqinit.ml b/sysinit/coqinit.ml
index a133ed9cc036..d6f777fbb8de 100644
--- a/sysinit/coqinit.ml
+++ b/sysinit/coqinit.ml
@@ -153,7 +153,6 @@ let init_runtime ~usage opts =
   let open Coqargs in
   Vernacextend.static_linking_done ();
   Option.iter (fun file -> init_profile ~file) opts.config.profile;
-  Memprof_coq.start_memprof_limits ();
   Lib.init ();
   if opts.post.memory_stat then at_exit print_memory_stat;
 

From 40538c7ee2e8582296d6171b1c98cab8c46349c2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Sat, 30 May 2026 18:36:18 +0200
Subject: [PATCH 560/578] Correctly handle iris projects in ci-reset script.

---
 dev/ci/ci-reset.sh | 10 ++++++++++
 1 file changed, 10 insertions(+)

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}"

From 112b50cf11eb83acba4e0e50ff340fd63c59f011 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Wed, 10 Dec 2025 16:41:53 +0100
Subject: [PATCH 561/578] Do not return the inductive entry in
 IndTyping.get_template.

This was always returned unchanged from the argument.
---
 kernel/indTyping.ml | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/kernel/indTyping.ml b/kernel/indTyping.ml
index d667b821c72e..b32ccb6e0ccd 100644
--- a/kernel/indTyping.ml
+++ b/kernel/indTyping.ml
@@ -341,7 +341,7 @@ let make_template_univ_names (u:UVars.Instance.t) : UVars.bound_names =
   {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, None
 | Template_ind_entry {uctx; default_univs} ->
   let ((template_qvars, _), (template_univs, _ as template_uctx) as template_context) =
     UVars.UContext.to_context_set uctx
@@ -500,7 +500,7 @@ let get_template (mie:mutual_inductive_entry) = match mie.mind_entry_universes w
     qsubst, usubst
   in
 
-  mie, Some template_usubst, Some {
+  Some template_usubst, Some {
     template_param_arguments;
     template_context;
     template_concl;
@@ -547,7 +547,7 @@ 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_usubst, template = get_template mie in
 
   let env_univs =
     match mie.mind_entry_universes with

From d3f37869af7602863770b747228381387d0c1aff Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Wed, 10 Dec 2025 16:56:13 +0100
Subject: [PATCH 562/578] Preserve bound universe names in template inductive
 types.

---
 kernel/indTyping.ml | 11 ++---------
 1 file changed, 2 insertions(+), 9 deletions(-)

diff --git a/kernel/indTyping.ml b/kernel/indTyping.ml
index b32ccb6e0ccd..d457b1bdaf57 100644
--- a/kernel/indTyping.ml
+++ b/kernel/indTyping.ml
@@ -336,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 _ -> None, 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
@@ -354,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
 

From 921ad1d149636eecc6354f3ec57cedc65d21df35 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Tue, 10 Mar 2026 18:03:34 +0100
Subject: [PATCH 563/578] Store template inductive data abstracted w.r.t.
 template levels.

All accesses to terms and sorts from a template inductive block need
first to substitute the bound levels by the default template instance,
just like polymorphic inductive types. Thanks to the invariants on
template types, there is actually little additional work to do, because
template levels can only appear in the type of parameters (not in lets!)
or in the conclusion.
---
 kernel/conversion.ml       |  10 ++-
 kernel/environ.ml          |  14 +++-
 kernel/indTyping.ml        | 153 +++++++++++++------------------------
 kernel/indtypes.ml         |  13 +++-
 kernel/inductive.ml        |  26 +++++--
 kernel/inductive.mli       |   2 +
 kernel/safe_typing.ml      |   5 +-
 pretyping/inductiveops.ml  |   7 ++
 pretyping/inductiveops.mli |   2 +
 pretyping/typing.ml        |   9 +--
 tactics/allScheme.ml       |  11 ++-
 tactics/eqschemes.ml       |   9 +++
 12 files changed, 146 insertions(+), 115 deletions(-)

diff --git a/kernel/conversion.ml b/kernel/conversion.ml
index 770b08d6395c..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,7 +285,7 @@ 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
diff --git a/kernel/environ.ml b/kernel/environ.ml
index 54d4ded25492..7672c7524449 100644
--- a/kernel/environ.ml
+++ b/kernel/environ.ml
@@ -308,6 +308,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 =
@@ -333,11 +340,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
@@ -346,6 +357,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, _) =
diff --git a/kernel/indTyping.ml b/kernel/indTyping.ml
index d457b1bdaf57..2956272c72c0 100644
--- a/kernel/indTyping.ml
+++ b/kernel/indTyping.ml
@@ -159,8 +159,8 @@ let check_indices_matter env_params info indices =
     (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;
@@ -175,7 +175,7 @@ let check_arity ~template env_params env_ar ind =
      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)
 
@@ -337,7 +337,7 @@ let check_no_increment ~template_univs u =
       Pp.(str "Template polymorphism with conclusion strictly larger than a bound universe not supported.")
 
 let get_template (mie:mutual_inductive_entry) = match mie.mind_entry_universes with
-| Monomorphic_ind_entry | Polymorphic_ind_entry _ -> None, None
+| Monomorphic_ind_entry | Polymorphic_ind_entry _ -> None
 | Template_ind_entry {uctx; default_univs} ->
   let ((template_qvars, _), (template_univs, _ as template_uctx)) =
     UVars.UContext.to_context_set uctx
@@ -464,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 _ | QGlobal _), _ -> 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
 
-  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,relies_on_indices_not_mattering) =
-  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, relies_on_indices_not_mattering
-
 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.")
@@ -540,17 +494,24 @@ let typecheck_inductive env ~sec_univs (mie:mutual_inductive_entry) =
   assert (List.is_empty (Environ.rel_context env));
 
   (* universes *)
-  let 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
@@ -559,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 *)
@@ -570,10 +536,11 @@ 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_params ~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
@@ -590,10 +557,11 @@ let typecheck_inductive env ~sec_univs (mie:mutual_inductive_entry) =
       | 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, im) ->
-            a, b, compute_elim_squash env_ar_par Sorts.prop univs, im)
-            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
 
@@ -605,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
@@ -616,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/indtypes.ml b/kernel/indtypes.ml
index b51a1ad500a6..58c79b4bfc0a 100644
--- a/kernel/indtypes.ml
+++ b/kernel/indtypes.ml
@@ -516,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. *)
diff --git a/kernel/inductive.ml b/kernel/inductive.ml
index a1318c31c804..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
 
 (************************************************************************)
 (************************************************************************)
@@ -376,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 =
@@ -1803,8 +1813,14 @@ let sorts_of_mutfix env minds names =
   if Array.exists ind_ignores_elim_constraints minds then None
   else
     Some (Array.fold_left_i (fun i sorts (ind, inst) ->
-        let _, mip = lookup_mind_specif env ind in
-        let ind_sort = UVars.subst_instance_sort inst mip.mind_sort in
+        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
diff --git a/kernel/inductive.mli b/kernel/inductive.mli
index d1bbf5d71f8d..0bd8b7b096ea 100644
--- a/kernel/inductive.mli
+++ b/kernel/inductive.mli
@@ -205,6 +205,8 @@ 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/safe_typing.ml b/kernel/safe_typing.ml
index c91523b7cc6a..68b823163788 100644
--- a/kernel/safe_typing.ml
+++ b/kernel/safe_typing.ml
@@ -1862,7 +1862,10 @@ let check_register_ind (type t) ind (r : t CPrimitives.prim_ind) (mb, ob as spec
     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) ->
diff --git a/pretyping/inductiveops.ml b/pretyping/inductiveops.ml
index 1d8452d3b9d6..4606c3891e00 100644
--- a/pretyping/inductiveops.ml
+++ b/pretyping/inductiveops.ml
@@ -219,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
@@ -226,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 =
diff --git a/pretyping/inductiveops.mli b/pretyping/inductiveops.mli
index deb2756476de..49228bdaaf2d 100644
--- a/pretyping/inductiveops.mli
+++ b/pretyping/inductiveops.mli
@@ -237,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/typing.ml b/pretyping/typing.ml
index 78fbf193b775..8df05b86d4c7 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 ->
diff --git a/tactics/allScheme.ml b/tactics/allScheme.ml
index c14757e0fc2d..679eba999525 100644
--- a/tactics/allScheme.ml
+++ b/tactics/allScheme.ml
@@ -76,6 +76,12 @@ 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
 
@@ -621,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
@@ -1087,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/eqschemes.ml b/tactics/eqschemes.ml
index 2896eb3e021d..fadfbaa2f3c8 100644
--- a/tactics/eqschemes.ml
+++ b/tactics/eqschemes.ml
@@ -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.";
@@ -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

From 66be6643b71a6478ca88ac69101a9094cbf5a132 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Thu, 28 May 2026 13:11:09 +0200
Subject: [PATCH 564/578] Add overlays.

---
 .../22070-ppedrot-kernel-abstract-univ-inductive.sh          | 5 +++++
 1 file changed, 5 insertions(+)
 create mode 100644 dev/ci/user-overlays/22070-ppedrot-kernel-abstract-univ-inductive.sh

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

From 60156a00dddba384b5174fd10dff2282f532b30e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Mon, 1 Jun 2026 17:11:57 +0200
Subject: [PATCH 565/578] Rename is_section_variable' ->
 is_section_variable_env

---
 engine/evarutil.ml                             | 6 +++---
 engine/termops.ml                              | 2 +-
 engine/termops.mli                             | 4 ++--
 plugins/funind/functional_principles_proofs.ml | 2 +-
 plugins/ltac/internals.ml                      | 2 +-
 tactics/equality.ml                            | 2 +-
 tactics/hints.ml                               | 2 +-
 tactics/induction.ml                           | 4 ++--
 8 files changed, 12 insertions(+), 12 deletions(-)

diff --git a/engine/evarutil.ml b/engine/evarutil.ml
index e51486d69b81..7adf698fc061 100644
--- a/engine/evarutil.ml
+++ b/engine/evarutil.ml
@@ -571,7 +571,7 @@ let rec check_and_clear_in_constr env evdref err ids ~global c =
                 try
                   let nids = Id.Map.domain rids in
                   let env = evar_filtered_env env evi in
-                  let global = Id.Set.exists (is_section_variable' env) nids in
+                  let global = Id.Set.exists (is_section_variable_env env) nids in
                   let concl = evar_concl evi in
                   check_and_clear_in_constr env evdref (EvarTypingBreak ev) nids ~global concl
                 with ClearDependencyError (rid,err,where) ->
@@ -592,7 +592,7 @@ let clear_hyps_in_evi_main env sigma hyps terms ids =
      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 global = Id.Set.exists (is_section_variable' env) ids in
+  let global = Id.Set.exists (is_section_variable_env env) ids in
   let terms =
     List.map (check_and_clear_in_constr env evdref (OccurHypInSimpleClause None) ids ~global) terms in
   let nhyps =
@@ -607,7 +607,7 @@ 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) ids in
+  let global = Id.Set.exists (is_section_variable_env env) ids in
   let _ : EConstr.constr = check_and_clear_in_constr
       ~global
       env evdref err ids c
diff --git a/engine/termops.ml b/engine/termops.ml
index c9b8643fadd7..70659d9389da 100644
--- a/engine/termops.ml
+++ b/engine/termops.ml
@@ -1011,7 +1011,7 @@ let is_section_variable_sign ?check sign id =
   | SecVar -> true
   | ProofVar -> false
 
-let is_section_variable' ?check env id =
+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 =
diff --git a/engine/termops.mli b/engine/termops.mli
index 625c3bb8115b..167713da5211 100644
--- a/engine/termops.mli
+++ b/engine/termops.mli
@@ -207,13 +207,13 @@ val dependency_closure : env -> Evd.evar_map -> named_context -> Id.Set.t -> Id.
 
 (** 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' on the local env instead of is_section_variable on the global env."]
+[@@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' : ?check:bool -> env -> 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
diff --git a/plugins/funind/functional_principles_proofs.ml b/plugins/funind/functional_principles_proofs.ml
index 6eb38126f814..7238bc3eb7c3 100644
--- a/plugins/funind/functional_principles_proofs.ml
+++ b/plugins/funind/functional_principles_proofs.ml
@@ -800,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' env hyp
+              || Termops.is_section_variable_env env hyp
               (* should be dangerous *)
             then (clear, decl :: keep)
             else (hyp :: clear, keep))
diff --git a/plugins/ltac/internals.ml b/plugins/ltac/internals.ml
index 4efe423e653b..53a8b4175fb1 100644
--- a/plugins/ltac/internals.ml
+++ b/plugins/ltac/internals.ml
@@ -135,7 +135,7 @@ let is_section_var x =
     | 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' ~check:false env id then Proofview.tclUNIT ()
+      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
diff --git a/tactics/equality.ml b/tactics/equality.ml
index e50536e57768..9292bed8a0a8 100644
--- a/tactics/equality.ml
+++ b/tactics/equality.ml
@@ -1849,7 +1849,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' 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/hints.ml b/tactics/hints.ml
index 9d9bd3ff7869..698af4e61d68 100644
--- a/tactics/hints.ml
+++ b/tactics/hints.ml
@@ -898,7 +898,7 @@ let with_uid c = { obj = c; uid = fresh_key () }
    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' env id then
+      if is_section_variable_env env id then
         Id.Pred.add id p
       else p) s Id.Pred.empty
 
diff --git a/tactics/induction.ml b/tactics/induction.ml
index a0ef78585cc2..191708085726 100644
--- a/tactics/induction.ml
+++ b/tactics/induction.ml
@@ -1397,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 (is_section_variable' env (destVar evd c))
+    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
@@ -1449,7 +1449,7 @@ let induction_gen_l isrec with_evars elim names lc =
           let env = Proofview.Goal.env gl in
           let sigma = Proofview.Goal.sigma gl in
           match EConstr.kind sigma c with
-          | Var id when not (is_section_variable' env id)
+          | Var id when not (is_section_variable_env env id)
                      && not with_evars ->
             let () = newlc:= id::!newlc in
             atomize_list l'

From 12719f32a97939727acef0b94ad14c200e949e9e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= <gaetan.gilbert@skyskimmer.net>
Date: Tue, 2 Jun 2026 13:25:31 +0200
Subject: [PATCH 566/578] Move check_hyps_inclusion out of the kernel

In the kernel we check the section variables used in another way
(eg Constant_typing.check_section_variables)
---
 engine/eConstr.ml         | 12 ++++++++++++
 engine/eConstr.mli        |  4 ++++
 kernel/typeops.ml         | 25 +------------------------
 kernel/typeops.mli        |  3 ---
 pretyping/inductiveops.ml |  8 ++++----
 pretyping/retyping.ml     |  2 +-
 pretyping/typing.ml       | 10 +++++-----
 7 files changed, 27 insertions(+), 37 deletions(-)

diff --git a/engine/eConstr.ml b/engine/eConstr.ml
index 52f99c726532..debff74fd1c7 100644
--- a/engine/eConstr.ml
+++ b/engine/eConstr.ml
@@ -1299,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 7ee9a48ce89f..e48c5efaea3d 100644
--- a/engine/eConstr.mli
+++ b/engine/eConstr.mli
@@ -445,6 +445,10 @@ 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
 
diff --git a/kernel/typeops.ml b/kernel/typeops.ml
index 7657a7741223..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
@@ -167,20 +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. *)
-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 error_reference_variables env id c
-
 (* Instantiation of terms on real arguments. *)
 
 (* Make a type polymorphic if an arity *)
@@ -189,16 +174,12 @@ let check_hyps_inclusion env 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. *)
@@ -400,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
@@ -409,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
@@ -421,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
@@ -430,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
diff --git a/kernel/typeops.mli b/kernel/typeops.mli
index c0d94ec8d555..326185780b75 100644
--- a/kernel/typeops.mli
+++ b/kernel/typeops.mli
@@ -71,9 +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 -> GlobRef.t -> Constr.named_context -> unit
-
 (** Types for primitives *)
 
 val type_of_int : env -> types
diff --git a/pretyping/inductiveops.ml b/pretyping/inductiveops.ml
index 0fed7ee86bd1..ca11d479c90e 100644
--- a/pretyping/inductiveops.ml
+++ b/pretyping/inductiveops.ml
@@ -25,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
- 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, EConstr.Unsafe.to_instance u) in
  EConstr.of_constr (Arguments_renaming.rename_type env t (IndRef ind))
 
@@ -40,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
- 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,EConstr.Unsafe.to_instance u) specif in
  EConstr.of_constr (Arguments_renaming.rename_type env t (ConstructRef cstr))
 
diff --git a/pretyping/retyping.ml b/pretyping/retyping.ml
index 8d27c6126dc1..b4c48b0992e6 100644
--- a/pretyping/retyping.ml
+++ b/pretyping/retyping.ml
@@ -136,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 () = Typeops.check_hyps_inclusion env (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))
 
diff --git a/pretyping/typing.ml b/pretyping/typing.ml
index c540c10f6da1..a5fcb61365ff 100644
--- a/pretyping/typing.ml
+++ b/pretyping/typing.ml
@@ -138,7 +138,7 @@ let judge_of_applied ~check env sigma funj argjv =
 (* 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 Typeops.check_hyps_inclusion env (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
@@ -148,7 +148,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 Typeops.check_hyps_inclusion env (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
@@ -414,7 +414,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 () = Typeops.check_hyps_inclusion env (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
@@ -425,7 +425,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 () = Typeops.check_hyps_inclusion env (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
@@ -434,7 +434,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 () = Typeops.check_hyps_inclusion env (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

From 29c3f609f731151578f1b2509910cd64f5804eeb Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Tue, 2 Jun 2026 17:52:44 +0200
Subject: [PATCH 567/578] Add a set primitive to the Range module.

While this is currently unused, I had the need to have this function
available in several POCs. For API expressivity and uniformity it does
not hurt to expose it by default.
---
 clib/range.ml  | 14 ++++++++++++++
 clib/range.mli |  1 +
 2 files changed, 15 insertions(+)

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

From bc7591539b9e61d7612c5ba2f668deac12452699 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Tue, 2 Jun 2026 18:22:45 +0200
Subject: [PATCH 568/578] Abstract the val variant of context datatypes.

The internal details were barely used and should have been considered
bad practice anyway. A good part of the reason for keeping the type
transparent was likely to please serapi but this is now unnecessary.
---
 engine/eConstr.ml         |  2 +-
 engine/evarutil.ml        |  2 +-
 engine/evd.ml             |  6 +++---
 kernel/cClosure.ml        |  6 +-----
 kernel/environ.ml         | 17 +++++++++++++----
 kernel/environ.mli        | 23 ++++++++---------------
 plugins/micromega/zify.ml |  6 +++---
 plugins/ssr/ssrcommon.ml  |  2 +-
 pretyping/evarsolve.ml    |  2 +-
 proofs/logic.ml           |  2 +-
 10 files changed, 33 insertions(+), 35 deletions(-)

diff --git a/engine/eConstr.ml b/engine/eConstr.ml
index 52f99c726532..15c51f4d948a 100644
--- a/engine/eConstr.ml
+++ b/engine/eConstr.ml
@@ -1278,7 +1278,7 @@ let map_named_val :
   | 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
diff --git a/engine/evarutil.ml b/engine/evarutil.ml
index 7adf698fc061..2ece061ff1cf 100644
--- a/engine/evarutil.ml
+++ b/engine/evarutil.ml
@@ -316,7 +316,7 @@ let push_rel_decl_to_named_context
   in
   match extract_if_neq id na with
   | Some id0 ->
-    if Id.Map.mem id0 ext.ext_ctx.env_named_map && is_section_variable_sign ext.ext_ctx 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
diff --git a/engine/evd.ml b/engine/evd.ml
index 87f913f0dfc9..85d325801689 100644
--- a/engine/evd.ml
+++ b/engine/evd.ml
@@ -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
@@ -1436,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;
diff --git a/kernel/cClosure.ml b/kernel/cClosure.ml
index 95ea7e67021a..8d7296b2e8c1 100644
--- a/kernel/cClosure.ml
+++ b/kernel/cClosure.ml
@@ -398,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
diff --git a/kernel/environ.ml b/kernel/environ.ml
index f83b1ef92a55..08284ffa1450 100644
--- a/kernel/environ.ml
+++ b/kernel/environ.ml
@@ -172,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;
@@ -275,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
@@ -1289,8 +1298,8 @@ module Internal = struct
       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.Quality.Set.t;
       env_symb_pats : machine_rewrite_rule list Cmap_env.t;
@@ -1302,8 +1311,8 @@ module Internal = struct
       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.domain env.env_qualities;
       env_symb_pats = env.symb_pats;
diff --git a/kernel/environ.mli b/kernel/environ.mli
index 3eff5eabcb78..b712e764aa07 100644
--- a/kernel/environ.mli
+++ b/kernel/environ.mli
@@ -37,19 +37,9 @@ type link_info =
 
 type key = int CEphemeron.key option ref
 
-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. *)
-  env_named_secvars : Id.Set.t;
-}
-
-type rel_context_val = private {
-  env_rel_ctx : Constr.rel_context;
-  env_rel_map : Constr.rel_declaration Range.t;
-}
+type named_context_val
+
+type rel_context_val
 
 type env
 (** Type of global environments. *)
@@ -101,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
 
@@ -146,6 +137,8 @@ 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
@@ -534,8 +527,8 @@ module Internal : sig
       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.Quality.Set.t;
       env_symb_pats : machine_rewrite_rule list Cmap_env.t;
diff --git a/plugins/micromega/zify.ml b/plugins/micromega/zify.ml
index 7d4cdc2f20a6..a1ffa54725ae 100644
--- a/plugins/micromega/zify.ml
+++ b/plugins/micromega/zify.ml
@@ -1481,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)
diff --git a/plugins/ssr/ssrcommon.ml b/plugins/ssr/ssrcommon.ml
index e79cb3d6be9c..40258be845cb 100644
--- a/plugins/ssr/ssrcommon.ml
+++ b/plugins/ssr/ssrcommon.ml
@@ -1272,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/pretyping/evarsolve.ml b/pretyping/evarsolve.ml
index fc3ec8b698e1..6c9573d5e46e 100644
--- a/pretyping/evarsolve.ml
+++ b/pretyping/evarsolve.ml
@@ -1369,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
diff --git a/proofs/logic.ml b/proofs/logic.ml
index 1f3e0e45271d..4b088b58e402 100644
--- a/proofs/logic.ml
+++ b/proofs/logic.ml
@@ -152,7 +152,7 @@ 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

From 4b52da1482b37e21f3597deab49d45464dc5a703 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Wed, 3 Jun 2026 08:23:30 +0200
Subject: [PATCH 569/578] Add overlays.

---
 dev/ci/user-overlays/22090-ppedrot-abstract-context-val.sh | 1 +
 1 file changed, 1 insertion(+)
 create mode 100644 dev/ci/user-overlays/22090-ppedrot-abstract-context-val.sh

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

From 57c4d837ff004c0720175bf4cfd329cd118edfdb Mon Sep 17 00:00:00 2001
From: Rodolphe Lepigre <rodolphe.lepigre@skylabs-ai.com>
Date: Wed, 3 Jun 2026 15:11:00 +0200
Subject: [PATCH 570/578] Parse Ltac2 matches at level 0.

---
 .../06-Ltac2-language/22092-ltac2-match-level-Changed.rst   | 4 ++++
 doc/tools/docgram/common.edit_mlg                           | 6 +++++-
 doc/tools/docgram/fullGrammar                               | 2 +-
 plugins/ltac2/g_ltac2.mlg                                   | 4 ++--
 4 files changed, 12 insertions(+), 4 deletions(-)
 create mode 100644 doc/changelog/06-Ltac2-language/22092-ltac2-match-level-Changed.rst

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 <https://github.com/rocq-prover/rocq/pull/22092>`_,
+  by Rodolphe Lepigre).
diff --git a/doc/tools/docgram/common.edit_mlg b/doc/tools/docgram/common.edit_mlg
index 951e57b63d88..8ab6b9c2165e 100644
--- a/doc/tools/docgram/common.edit_mlg
+++ b/doc/tools/docgram/common.edit_mlg
@@ -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: [
 
 ]
diff --git a/doc/tools/docgram/fullGrammar b/doc/tools/docgram/fullGrammar
index 1e2a661598d2..dd4fdea97af4 100644
--- a/doc/tools/docgram/fullGrammar
+++ b/doc/tools/docgram/fullGrammar
@@ -2750,7 +2750,6 @@ ltac2_expr6: [
 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 *)
 ]
@@ -2785,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 *)
 ]
 
diff --git a/plugins/ltac2/g_ltac2.mlg b/plugins/ltac2/g_ltac2.mlg
index d0e23f677131..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 } ]
     ]
   ;

From 3e09cfed0950254b7e23fc2fe6b9245be50b8bb6 Mon Sep 17 00:00:00 2001
From: Matthieu Sozeau <mattam@mattam.org>
Date: Sat, 23 May 2026 20:41:20 +0200
Subject: [PATCH 571/578] [fix] ssrmatching/equality and univ poly handling

Fixes #22086

These patches enforce recording appropriate universe unifications in [unfold], [unlock] and [rw].

The matching phase for multiple occcurrences of a pattern is now done accumulating the necessary universe constraints.
---
 .../22096-fix-ssr-univpoly-Fixed.rst          |  6 ++
 plugins/ssr/ssrequality.ml                    | 14 +++--
 plugins/ssrmatching/ssrmatching.ml            | 61 ++++++++++++++-----
 plugins/ssrmatching/ssrmatching.mli           |  2 +-
 test-suite/bugs/ssrew_poly.v                  | 21 +++++++
 5 files changed, 82 insertions(+), 22 deletions(-)
 create mode 100644 doc/changelog/07-ssreflect/22096-fix-ssr-univpoly-Fixed.rst
 create mode 100644 test-suite/bugs/ssrew_poly.v

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 <https://github.com/rocq-prover/rocq/pull/22096>`_,
+  fixes `#22086 <https://github.com/rocq-prover/rocq/issues/22086>`_,
+  by Matthieu Sozeau).
diff --git a/plugins/ssr/ssrequality.ml b/plugins/ssr/ssrequality.ml
index ad836e6e113c..a505ace81f1b 100644
--- a/plugins/ssr/ssrequality.ml
+++ b/plugins/ssr/ssrequality.ml
@@ -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))
@@ -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/ssrmatching/ssrmatching.ml b/plugins/ssrmatching/ssrmatching.ml
index 866e2d65d057..115960f31834 100644
--- a/plugins/ssrmatching/ssrmatching.ml
+++ b/plugins/ssrmatching/ssrmatching.ml
@@ -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
@@ -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)) =
@@ -1485,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")
diff --git a/plugins/ssrmatching/ssrmatching.mli b/plugins/ssrmatching/ssrmatching.mli
index eab4ec3ce789..742c9d53e741 100644
--- a/plugins/ssrmatching/ssrmatching.mli
+++ b/plugins/ssrmatching/ssrmatching.mli
@@ -210,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
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.

From 81d28e62f96cd2b1dd0dfefc9bf86f2af8d3c115 Mon Sep 17 00:00:00 2001
From: Matthieu Sozeau <mattam@mattam.org>
Date: Wed, 8 Apr 2026 19:06:23 +0200
Subject: [PATCH 572/578] [fix] program fixpoint not typechecking its whole
 construction, potentially missing univ constraints

---
 vernac/comFixpoint.ml | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/vernac/comFixpoint.ml b/vernac/comFixpoint.ml
index dccd0d827cda..bcf10a296e5e 100644
--- a/vernac/comFixpoint.ml
+++ b/vernac/comFixpoint.ml
@@ -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

From 9ef261b3fb0c8a6d6c90b54b75e513d1e299cb5a Mon Sep 17 00:00:00 2001
From: Matthieu Sozeau <mattam@mattam.org>
Date: Fri, 5 Jun 2026 16:29:49 +0200
Subject: [PATCH 573/578] [fix] program fixpoint not typechecking its whole
 construction, potentially missing univ constraints

Also avoids an unecessary repeated call to solve_evars.
---
 vernac/comFixpoint.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/vernac/comFixpoint.ml b/vernac/comFixpoint.ml
index bcf10a296e5e..87de789b0196 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 =

From 7d64bf6bf08d3ad8b225bfb5998c4e3471883d46 Mon Sep 17 00:00:00 2001
From: Matthieu Sozeau <mattam@mattam.org>
Date: Fri, 5 Jun 2026 17:24:58 +0200
Subject: [PATCH 574/578] Make with-jobs work on OS X, where nproc is
 unavailable

---
 dev/tools/with-jobs.sh | 8 +++++++-
 1 file changed, 7 insertions(+), 1 deletion(-)

diff --git a/dev/tools/with-jobs.sh b/dev/tools/with-jobs.sh
index bd18b9fff7b7..3aa051d6ed44 100755
--- a/dev/tools/with-jobs.sh
+++ b/dev/tools/with-jobs.sh
@@ -48,7 +48,13 @@ if ! [ "$mode" ]; then
   elif [ "$jobs" = 1 ]; then
     exec "$@" -j 1
   elif [ "$jobs" = infinite ]; then
-    exec "$@" -j "$(nproc)"
+    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

From c2c27c309f033de82344b904991f21996f528623 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Sun, 7 Jun 2026 18:46:40 +0200
Subject: [PATCH 575/578] Print the segment hash in votour toplevel output.

This is a trivial quality of life improvement.
---
 checker/votour.ml | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/checker/votour.ml b/checker/votour.ml
index f6d725d3deda..99fd9d625e86 100644
--- a/checker/votour.ml
+++ b/checker/votour.ml
@@ -466,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 ->

From 817e561ef78f9e1e9769aac769ae144a91368b83 Mon Sep 17 00:00:00 2001
From: Gregory Malecha <gregory@skylabs-ai.com>
Date: Tue, 9 Jun 2026 21:31:10 -0400
Subject: [PATCH 576/578] Test case for attributes on hooks

---
 test-suite/misc/attributes/theories/attr.v | 28 ++++++++++++++++++++++
 1 file changed, 28 insertions(+)

diff --git a/test-suite/misc/attributes/theories/attr.v b/test-suite/misc/attributes/theories/attr.v
index f4e447af5c2b..8e501f4f32af 100644
--- a/test-suite/misc/attributes/theories/attr.v
+++ b/test-suite/misc/attributes/theories/attr.v
@@ -9,6 +9,34 @@ 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.

From b21665b1f86c72f7a22e38f9358e4332149957e2 Mon Sep 17 00:00:00 2001
From: Gregory Malecha <gregory@skylabs-ai.com>
Date: Tue, 9 Jun 2026 21:32:12 -0400
Subject: [PATCH 577/578] Install hooks when attributes are completed

---
 vernac/comFixpoint.ml   | 11 ++++++++---
 vernac/comFixpoint.mli  |  2 ++
 vernac/vernacentries.ml | 22 ++++++++++++++++------
 3 files changed, 26 insertions(+), 9 deletions(-)

diff --git a/vernac/comFixpoint.ml b/vernac/comFixpoint.ml
index 87de789b0196..6db2939a74c5 100644
--- a/vernac/comFixpoint.ml
+++ b/vernac/comFixpoint.ml
@@ -563,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
@@ -571,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
@@ -582,10 +582,15 @@ let do_mutually_recursive ?pm ~refine ~program_mode ?(use_inference_hook=false)
   let sigma = Evarconv.solve_unif_constraints_with_heuristics env 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/vernacentries.ml b/vernac/vernacentries.ml
index 5e9b897fdea7..d7ea97885da6 100644
--- a/vernac/vernacentries.ml
+++ b/vernac/vernacentries.ml
@@ -829,6 +829,13 @@ let check_name_freshness locality {CAst.loc;v=id} : unit =
   then
     user_err ?loc  (Id.print id ++ str " already exists.")
 
+(* 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
@@ -846,9 +853,7 @@ let vernac_definition_hook ~hooks ~canonical_instance ~local ~poly ~reversible k
       make (fun { S.dref } -> Canonical.declare_canonical_structure dref) :: hooks
     | _ -> hooks
   in
-  match hooks with
-  | [] -> None
-  | _ -> Some (Declare.Hook.make (fun st -> List.iter (fun hook -> Declare.Hook.call ~hook st) hooks))
+  hook_of_hooks hooks
 
 let default_thm_id = Id.of_string "Unnamed_thm"
 
@@ -927,14 +932,19 @@ let vernac_start_proof ~atts kind l =
     List.iter (fun ((id, _), _) -> Dumpglob.dump_definition id false "prf") l;
   let DefAttributes.{
     scope; locality=local; poly; program=program_mode;
-    user_warns; typing_flags; using; clearbody;
+    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,_),_) :: _ ->
@@ -942,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

From 7fe364c8056163be2741ab235c261cc263f33339 Mon Sep 17 00:00:00 2001
From: Gregory Malecha <gregory@skylabs-ai.com>
Date: Tue, 9 Jun 2026 22:58:57 -0400
Subject: [PATCH 578/578] A sketch for a hint attribute plugin

---
 hint_attr_plugin/_CoqProject                 |   7 ++
 hint_attr_plugin/src/META.rocq-hint-attr     |  11 ++
 hint_attr_plugin/src/hintAttr.ml             | 123 +++++++++++++++++++
 hint_attr_plugin/src/hint_attr_plugin.mlpack |   1 +
 hint_attr_plugin/theories/HintAttr.v         |   3 +
 hint_attr_plugin/theories/test.v             |  44 +++++++
 6 files changed, 189 insertions(+)
 create mode 100644 hint_attr_plugin/_CoqProject
 create mode 100644 hint_attr_plugin/src/META.rocq-hint-attr
 create mode 100644 hint_attr_plugin/src/hintAttr.ml
 create mode 100644 hint_attr_plugin/src/hint_attr_plugin.mlpack
 create mode 100644 hint_attr_plugin/theories/HintAttr.v
 create mode 100644 hint_attr_plugin/theories/test.v

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.