Repository: rocq-prover/rocq
Pull request #20496: Use record instead of tuple for UVars.bound_names
Author: login: LeoAlexElouan
Labels: name: kind: internal
description: API, ML documentation...
Created: 2025-04-09T15:46:32Z | Merged: 2025-04-18T11:28:16Z

Changed bound names to a record to know more easily what the fields refer to. 

<!-- Thank you for your contribution.
     Make sure you read the contributing guide and fill this template. -->

<!-- Remove anything that doesn't apply in the following checklist. -->

<!-- If there is a user-visible change and testing is not prohibitively expensive: -->
- [X] Added / updated **test-suite**.

Overlays:
- https://github.com/ejgallego/coq-lsp/pull/946


Diff:
diff --git a/dev/ci/user-overlays/20496-LeoAlexElouan-clarify-bound-names.sh b/dev/ci/user-overlays/20496-LeoAlexElouan-clarify-bound-names.sh
new file mode 100644
index 000000000000..01d6e70b75d1
--- /dev/null
+++ b/dev/ci/user-overlays/20496-LeoAlexElouan-clarify-bound-names.sh
@@ -0,0 +1,4 @@
+overlay coq_lsp https://github.com/LeoAlexElouan/coq-lsp clarify-bound-names 20496
+overlay lean_importer https://github.com/LeoAlexElouan/rocq-lean-import clarify-bound-names 20496
+overlay metarocq https://github.com/LeoAlexElouan/metarocq clarify-bound-names 20496
+overlay paramcoq https://github.com/LeoAlexElouan/paramcoq clarify-bound-names 20496
diff --git a/dev/top_printers.ml b/dev/top_printers.ml
index e93100688076..0fa62ae27a6f 100644
--- a/dev/top_printers.ml
+++ b/dev/top_printers.ml
@@ -302,7 +302,7 @@ let ppnamedcontextval e =
   pp (pr_named_context env sigma (named_context_of_val e))
 
 let ppaucontext auctx =
-  let qnas, unas = AbstractContext.names auctx in
+  let {quals = qnas; univs = unas} = AbstractContext.names auctx in
   let prgen pr var_index nas l = match var_index l with
     | Some n -> (match nas.(n) with
         | Anonymous -> pr l
diff --git a/engine/uState.ml b/engine/uState.ml
index 40d80ebe655b..e37dc063d261 100644
--- a/engine/uState.ml
+++ b/engine/uState.ml
@@ -357,7 +357,7 @@ let sort_context_set uctx =
 let constraints uctx = snd uctx.local
 
 let compute_instance_binders uctx inst =
-  let (qrev,urev) = snd uctx.names in
+  let (qrev, urev) = snd uctx.names in
   let qinst, uinst = Instance.to_array inst in
   let qmap = function
     | QVar q ->
@@ -370,7 +370,7 @@ let compute_instance_binders uctx inst =
     try Name (Option.get (Level.Map.find lvl urev).uname)
     with Option.IsNone | Not_found -> Anonymous
   in
-  Array.map qmap qinst, Array.map umap uinst
+  {quals = Array.map qmap qinst; univs =  Array.map umap uinst}
 
 let context uctx =
   let qvars = QState.undefined uctx.sort_variables in
diff --git a/kernel/cPrimitives.ml b/kernel/cPrimitives.ml
index 16f7315b243c..8033e8609960 100644
--- a/kernel/cPrimitives.ml
+++ b/kernel/cPrimitives.ml
@@ -308,7 +308,7 @@ and ind_or_type =
   | PITT_param : int -> ind_or_type (* DeBruijn index referring to prenex type quantifiers *)
 
 let one_univ =
-  AbstractContext.make ([||],Names.[|Name (Id.of_string "u")|]) Constraints.empty
+  AbstractContext.make { quals = [||]; univs = Names.[|Name (Id.of_string "u")|]} Constraints.empty
 
 let typ_univs (type a) (t : a prim_type) = match t with
   | PT_int63 -> AbstractContext.empty
diff --git a/kernel/indTyping.ml b/kernel/indTyping.ml
index 9d534334008f..464a0fc9522e 100644
--- a/kernel/indTyping.ml
+++ b/kernel/indTyping.ml
@@ -315,7 +315,7 @@ let check_no_increment ~template_univs u =
 
 let make_template_univ_names (u:UVars.Instance.t) : UVars.bound_names =
   let qlen, ulen = UVars.Instance.length u in
-  Array.make qlen Anonymous, Array.make ulen Anonymous
+  {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
diff --git a/kernel/inferCumulativity.ml b/kernel/inferCumulativity.ml
index ee479040539f..9116b5713386 100644
--- a/kernel/inferCumulativity.ml
+++ b/kernel/inferCumulativity.ml
@@ -59,7 +59,7 @@ end = struct
 
   let to_variance_opt o = Option.cata to_variance Invariant o
 
-  let infer_level_eq u variances =
+  let infer_level_eq u (variances : variances) =
     match Level.Map.find_opt u variances.univs with
     | None -> variances
     | Some (Check, expected) ->
@@ -98,7 +98,7 @@ end = struct
     if Level.Map.is_empty univs then raise TrivialVariance;
     {univs; orig_array=us; infer_mode=true}
 
-  let finish variances =
+  let finish (variances : variances) =
     Array.map
       (fun (u,_check) -> to_variance_opt (Option.map snd (Level.Map.find_opt u variances.univs)))
       variances.orig_array
diff --git a/kernel/uVars.ml b/kernel/uVars.ml
index d9dc811ed4ee..dc0f20d6254f 100644
--- a/kernel/uVars.ml
+++ b/kernel/uVars.ml
@@ -274,8 +274,13 @@ let in_punivs x = (x, Instance.empty)
 let eq_puniverses f (x, u) (y, u') =
   f x y && Instance.equal u u'
 
-type bound_names = Names.Name.t array * Names.Name.t array
-
+type bound_names = {
+  quals: Names.Name.t array;
+  univs: Names.Name.t array;
+}
+let empty_bound_names = {quals = [||]; univs =  [||]}
+let append_bound_names {quals = qnames; univs = unames} {quals = qnames'; univs = unames'} =
+  {quals = Array.append qnames qnames'; univs = Array.append unames unames'}
 (** A context of universe levels with universe constraints,
     representing local universe variables and constraints *)
 
@@ -285,36 +290,36 @@ struct
 
   let make names (univs, _ as x) : t =
     let qs, us = Instance.to_array univs in
-    assert (Array.length (fst names) = Array.length qs && Array.length(snd names) = Array.length us);
+    assert (Array.length names.quals = Array.length qs && Array.length names.univs = Array.length us);
     (names, x)
 
   (** Universe contexts (variables as a list) *)
-  let empty = (([||], [||]), (Instance.empty, Constraints.empty))
+  let empty = (empty_bound_names, (Instance.empty, Constraints.empty))
   let is_empty (_, (univs, csts)) = Instance.is_empty univs && Constraints.is_empty csts
 
   let pr prq prl ?variance (_, (univs, csts) as uctx) =
     if is_empty uctx then mt() else
       h (Instance.pr prq prl ?variance univs ++ str " |= ") ++ h (v 0 (Constraints.pr prl csts))
 
-  let hcons ((qnames, unames), (univs, csts)) =
+  let hcons ({quals = qnames; univs = unames}, (univs, csts)) =
     let hqnames, qnames = Hashcons.hashcons_array Names.Name.hcons qnames in
     let hunames, unames = Hashcons.hashcons_array Names.Name.hcons unames in
     let hunivs, univs = Instance.hcons univs in
     let hcsts, csts = Constraints.hcons csts in
-    Hashset.Combine.combine4 hqnames hunames hunivs hcsts, ((qnames, unames), (univs, csts))
+    Hashset.Combine.combine4 hqnames hunames hunivs hcsts, ({quals = qnames; univs = unames}, (univs, csts))
 
   let names ((names, _) : t) = names
   let instance (_, (univs, _csts)) = univs
   let constraints (_, (_univs, csts)) = csts
 
-  let union ((qna, una), (univs, csts)) ((qna', una'), (univs', csts')) =
-    (Array.append qna qna', Array.append una una'), (Instance.append univs univs', Constraints.union csts csts')
+  let union (names, (univs, csts)) (names', (univs', csts')) =
+    append_bound_names names names', (Instance.append univs univs', Constraints.union csts csts')
 
   let size (_,(x,_)) = Instance.length x
 
-  let refine_names (qnames',unames') ((qnames, unames), x) =
+  let refine_names names' (names, x) =
     let merge_names = Array.map2 Names.(fun old refined -> match refined with Anonymous -> old | Name _ -> refined) in
-    ((merge_names qnames qnames', merge_names unames unames'), x)
+    ({quals = merge_names names.quals names'.quals; univs = merge_names names.univs names'.univs}, x)
 
   let sort_levels a =
     Array.sort Level.compare a; a
@@ -355,31 +360,31 @@ struct
 
   let make names csts : t = names, csts
 
-  let instantiate inst ((qnames,unames), cst) =
+  let instantiate inst (names, cst) =
     let q, u = Instance.to_array inst in
-    assert (Array.length q == Array.length qnames && Array.length u = Array.length unames);
+    assert (Array.length q == Array.length names.quals && Array.length u = Array.length names.univs);
     subst_instance_constraints inst cst
 
   let names (nas, _) = nas
 
-  let hcons ((qnames,unames), cst) =
+  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
     let hcst, cst = Constraints.hcons cst in
-    Hashset.Combine.combine3 hqnames hunames hcst, ((qnames, unames), cst)
+    Hashset.Combine.combine3 hqnames hunames hcst, ({quals = qnames; univs = unames}, cst)
 
-  let empty = (([||],[||]), Constraints.empty)
+  let empty = (empty_bound_names, Constraints.empty)
 
-  let is_constant ((qnas,unas),_) =
-    Array.is_empty qnas && Array.is_empty unas
+  let is_constant (names,_) =
+    Array.is_empty names.quals && Array.is_empty names.univs
 
   let is_empty (_, cst as ctx) =
     is_constant ctx && Constraints.is_empty cst
 
-  let union ((qnas,unas), cst) ((qnas',unas'), cst') =
-    ((Array.append qnas qnas', Array.append unas unas'), Constraints.union cst cst')
+  let union (names, cst) (names', cst') =
+    (append_bound_names names names', Constraints.union cst cst')
 
-  let size ((qnas,unas), _) = Array.length qnas, Array.length unas
+  let size (names, _) = Array.length names.quals, Array.length names.univs
 
   let repr (names, cst as self) : UContext.t =
     let inst = Instance.abstract_instance (size self) in
diff --git a/kernel/uVars.mli b/kernel/uVars.mli
index cf3c4639289b..1d9132b23e99 100644
--- a/kernel/uVars.mli
+++ b/kernel/uVars.mli
@@ -97,7 +97,12 @@ val in_punivs : 'a -> 'a puniverses
 
 val eq_puniverses : ('a -> 'a -> bool) -> 'a puniverses -> 'a puniverses -> bool
 
-type bound_names = Names.Name.t array * Names.Name.t array
+
+type bound_names = {
+  quals: Names.Name.t array;
+  univs: Names.Name.t array
+}
+val empty_bound_names : bound_names
 
 (** A vector of universe levels with universe Constraints.t,
     representing local universe variables and associated Constraints.t;
diff --git a/printing/printer.ml b/printing/printer.ml
index be4685f4a2d0..33e173f253c9 100644
--- a/printing/printer.ml
+++ b/printing/printer.ml
@@ -188,7 +188,7 @@ let u_ident = Id.of_string "u"
 
 let universe_binders_with_opt_names orig names =
   let open Univ in
-  let qorig, uorig = UVars.AbstractContext.names orig 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
diff --git a/test-suite/misc/poly-capture-global-univs/src/evilImpl.ml b/test-suite/misc/poly-capture-global-univs/src/evilImpl.ml
index f89bcab62c6a..05cba1cb0be1 100644
--- a/test-suite/misc/poly-capture-global-univs/src/evilImpl.ml
+++ b/test-suite/misc/poly-capture-global-univs/src/evilImpl.ml
@@ -14,7 +14,7 @@ let evil name name_f =
   let tc = mkConst tc in
 
   let fe = Declare.definition_entry
-      ~univs:(UState.Polymorphic_entry (UContext.make ([||],[|Anonymous|]) (Instance.of_array ([||],[|u|]),Constraints.empty)), UnivNames.empty_binders)
+      ~univs:(UState.Polymorphic_entry (UContext.make {quals = [||]; univs= [|Anonymous|]} (Instance.of_array ([||],[|u|]),Constraints.empty)), UnivNames.empty_binders)
       ~types:(Term.mkArrowR tc tu)
       (mkLambda (Context.nameR (Id.of_string "x"), tc, mkRel 1))
   in
diff --git a/vernac/declare.ml b/vernac/declare.ml
index 0c2211ea4081..333e54a956d8 100644
--- a/vernac/declare.ml
+++ b/vernac/declare.ml
@@ -746,7 +746,7 @@ let declare_variable ~name ~kind ~typing_flags d =
           Global.push_section_context uctx;
           let mk_anon_names u =
             let qs, us = UVars.Instance.to_array u in
-            Array.make (Array.length qs) Anonymous, Array.make (Array.length us) Anonymous
+            {UVars.quals = Array.make (Array.length qs) Anonymous; UVars.univs = Array.make (Array.length us) Anonymous}
           in
           Global.push_section_context
             (UVars.UContext.of_context_set mk_anon_names Sorts.QVar.Set.empty body_uctx);
diff --git a/vernac/declareUniv.ml b/vernac/declareUniv.ml
index 2ce72d0b6da8..386b85ea6959 100644
--- a/vernac/declareUniv.ml
+++ b/vernac/declareUniv.ml
@@ -156,7 +156,7 @@ let do_universe ~poly l =
     let names = CArray.map_of_list (fun (na,_) -> Name na) l in
     let us = CArray.map_of_list (fun (_,l) -> Level.make l) l in
     let ctx =
-      UVars.UContext.make ([||],names) (UVars.Instance.of_array ([||],us), Constraints.empty)
+      UVars.UContext.make {quals = [||]; univs = names} (UVars.Instance.of_array ([||],us), Constraints.empty)
     in
     Global.push_section_context ctx
 
@@ -174,7 +174,7 @@ let do_constraint ~poly l =
     Global.push_context_set uctx
   | true ->
     let uctx = UVars.UContext.make
-        ([||],[||])
+        UVars.empty_bound_names
         (UVars.Instance.empty,constraints)
     in
     Global.push_section_context uctx


Reviews:
user: login: SkySkimmer
state: COMMENTED
author_association: CONTRIBUTOR
submitted_at: 2025-04-09T16:31:20Z
user: login: SkySkimmer
state: COMMENTED
author_association: CONTRIBUTOR
submitted_at: 2025-04-09T16:32:04Z
user: login: SkySkimmer
state: APPROVED
author_association: CONTRIBUTOR
submitted_at: 2025-04-14T10:40:28Z

Review comments:
diff_hunk: @@ -274,7 +274,10 @@ let in_punivs x = (x, Instance.empty)
 let eq_puniverses f (x, u) (y, u') =
   f x y && Instance.equal u u'
 
-type bound_names = Names.Name.t array * Names.Name.t array
+type bound_names = {
+  quals: Names.Name.t array;
+  univs: Names.Name.t array}
path: kernel/uVars.ml
user: login: SkySkimmer
body: ```suggestion
  univs: Names.Name.t array;
}
```
created_at: 2025-04-09T16:31:20Z
author_association: CONTRIBUTOR
diff_hunk: @@ -285,36 +288,36 @@ struct
 
   let make names (univs, _ as x) : t =
     let qs, us = Instance.to_array univs in
-    assert (Array.length (fst names) = Array.length qs && Array.length(snd names) = Array.length us);
+    assert (Array.length names.quals = Array.length qs && Array.length names.univs = Array.length us);
     (names, x)
 
   (** Universe contexts (variables as a list) *)
-  let empty = (([||], [||]), (Instance.empty, Constraints.empty))
+  let empty = (empty_bound_names, (Instance.empty, Constraints.empty))
   let is_empty (_, (univs, csts)) = Instance.is_empty univs && Constraints.is_empty csts
 
   let pr prq prl ?variance (_, (univs, csts) as uctx) =
     if is_empty uctx then mt() else
       h (Instance.pr prq prl ?variance univs ++ str " |= ") ++ h (v 0 (Constraints.pr prl csts))
 
-  let hcons ((qnames, unames), (univs, csts)) =
+  let hcons ({quals = qnames; univs = unames}, (univs, csts)) =
     let hqnames, qnames = Hashcons.hashcons_array Names.Name.hcons qnames in
     let hunames, unames = Hashcons.hashcons_array Names.Name.hcons unames in
     let hunivs, univs = Instance.hcons univs in
     let hcsts, csts = Constraints.hcons csts in
-    Hashset.Combine.combine4 hqnames hunames hunivs hcsts, ((qnames, unames), (univs, csts))
+    Hashset.Combine.combine4 hqnames hunames hunivs hcsts, ({quals = qnames; univs = unames}, (univs, csts))
 
   let names ((names, _) : t) = names
   let instance (_, (univs, _csts)) = univs
   let constraints (_, (_univs, csts)) = csts
 
-  let union ((qna, una), (univs, csts)) ((qna', una'), (univs', csts')) =
-    (Array.append qna qna', Array.append una una'), (Instance.append univs univs', Constraints.union csts csts')
+  let union (names, (univs, csts)) (names', (univs', csts')) =
+    { quals = Array.append names.quals names'.quals; univs =  Array.append names.univs names'.univs}, (Instance.append univs univs', Constraints.union csts csts')
path: kernel/uVars.ml
user: login: SkySkimmer
body: maybe worth defining a `append_bound_names` helper, this happens in several places
created_at: 2025-04-09T16:32:03Z
author_association: CONTRIBUTOR

PR comments:
user: login: SkySkimmer
created_at: 2025-04-14T10:40:36Z
body: @coqbot run full ci
author_association: CONTRIBUTOR
user: login: SkySkimmer
created_at: 2025-04-15T11:48:06Z
body: You need to write overlays https://github.com/rocq-prover/rocq/blob/f50bacff0ab545507b471ab423e7c730a677a505/dev/ci/user-overlays/README.md
Ask for help if you have problems (here or on zulip)
author_association: CONTRIBUTOR
user: login: coqbot-app[bot]
created_at: 2025-04-15T15:24:20Z
body: I am not triggering a CI run on this PR because the CI configuration has been modified. CI can be triggered manually by an authorized contributor.
author_association: CONTRIBUTOR
user: login: SkySkimmer
created_at: 2025-04-16T13:19:23Z
body: @coqbot run full ci
author_association: CONTRIBUTOR
user: login: SkySkimmer
created_at: 2025-04-18T11:28:13Z
body: @coqbot merge now
author_association: CONTRIBUTOR
user: login: coqbot-app[bot]
created_at: 2025-04-18T11:28:18Z
body: @SkySkimmer: Please take care of the following overlays:
- 20496-LeoAlexElouan-clarify-bound-names.sh

author_association: CONTRIBUTOR