Skip to content

Commit 82de63e

Browse files
committed
[nametab] Introduce type of imperative nametabs, unify API
This is both a cleanup and a step towards pushing the state upwards, and handling the nametabs functionally. Related to rocq-prover#16746 and rocq-prover/rfcs#65
1 parent e00b96d commit 82de63e

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

42 files changed

+525
-484
lines changed

engine/namegen.ml

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -81,14 +81,14 @@ let is_imported_ref = let open GlobRef in function
8181

8282
let is_global id =
8383
try
84-
let ref = Nametab.locate (qualid_of_ident id) in
84+
let ref = Nametab.GlobRef.locate (qualid_of_ident id) in
8585
not (is_imported_ref ref)
8686
with Not_found ->
8787
false
8888

8989
let is_constructor id =
9090
try
91-
match Nametab.locate (qualid_of_ident id) with
91+
match Nametab.GlobRef.locate (qualid_of_ident id) with
9292
| GlobRef.ConstructRef _ -> true
9393
| _ -> false
9494
with Not_found ->
@@ -281,7 +281,7 @@ let visible_ids sigma (nenv, c) =
281281
let g = global_of_constr c in
282282
if not (GlobRef.Set_env.mem g gseen) then
283283
let gseen = GlobRef.Set_env.add g gseen in
284-
let ids = match Nametab.shortest_qualid_of_global Id.Set.empty g with
284+
let ids = match Nametab.GlobRef.shortest_qualid Id.Set.empty g with
285285
| short ->
286286
let dir, id = repr_qualid short in
287287
if DirPath.is_empty dir then Id.Set.add id ids else ids

engine/termops.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -886,7 +886,7 @@ let free_rels_and_unqualified_refs sigma t =
886886
if not (GlobRef.Set_env.mem g gseen) then begin
887887
try
888888
let gseen = GlobRef.Set_env.add g gseen in
889-
let short = Nametab.shortest_qualid_of_global Id.Set.empty g in
889+
let short = Nametab.GlobRef.shortest_qualid Id.Set.empty g in
890890
let dir, id = Libnames.repr_qualid short in
891891
let ids = if DirPath.is_empty dir then Id.Set.add id ids else ids in
892892
(gseen, vseen, ids)

engine/univNames.ml

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -15,7 +15,8 @@ open Univ
1515
let qualid_of_level ctx l =
1616
match Level.name l with
1717
| Some qid ->
18-
(try Some (Nametab.shortest_qualid_of_universe ctx qid)
18+
let ctx = Id.Map.domain ctx in
19+
(try Some (Nametab.Universe.shortest_qualid ctx qid)
1920
with Not_found -> None)
2021
| None -> None
2122

interp/abbreviation.ml

Lines changed: 9 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -39,17 +39,17 @@ let toggle_abbreviation ~on ~use kn =
3939
if data.abbrev_activated != on then
4040
begin
4141
abbrev_table := KNmap.add kn {data with abbrev_activated = on} !abbrev_table;
42-
let sp = Nametab.path_of_abbreviation kn in
42+
let sp = Nametab.Abbrev.path kn in
4343
match use with
4444
| OnlyPrinting -> ()
4545
| OnlyParsing | ParsingAndPrinting ->
4646
if on then
4747
begin
48-
Nametab.push_abbreviation (Nametab.Until 1) sp kn;
49-
Nametab.push_abbreviation (Nametab.Exactly 1) sp kn
48+
Nametab.Abbrev.push (Nametab.Until 1) sp kn;
49+
Nametab.Abbrev.push (Nametab.Exactly 1) sp kn
5050
end
5151
else
52-
Nametab.remove_abbreviation sp kn
52+
Nametab.Abbrev.remove sp kn
5353
end
5454

5555
let toggle_abbreviations ~on ~use filter =
@@ -58,23 +58,23 @@ let toggle_abbreviations ~on ~use filter =
5858
!abbrev_table ()
5959

6060
let load_abbreviation i ((sp,kn),(_local,abbrev)) =
61-
if Nametab.exists_cci sp then
61+
if Nametab.GlobRef.exists sp then
6262
user_err
6363
(Id.print (basename sp) ++ str " already exists.");
6464
add_abbreviation kn abbrev;
65-
Nametab.push_abbreviation (Nametab.Until i) sp kn
65+
Nametab.Abbrev.push (Nametab.Until i) sp kn
6666

6767
let is_alias_of_already_visible_name sp = function
6868
| _,NRef (ref,_) ->
69-
let (dir,id) = repr_qualid (Nametab.shortest_qualid_of_global Id.Set.empty ref) in
69+
let (dir,id) = repr_qualid (Nametab.GlobRef.shortest_qualid Id.Set.empty ref) in
7070
DirPath.is_empty dir && Id.equal id (basename sp)
7171
| _ ->
7272
false
7373

7474
let open_abbreviation i ((sp,kn),(_local,abbrev)) =
7575
let pat = abbrev.abbrev_pattern in
7676
if not (Int.equal i 1 && is_alias_of_already_visible_name sp pat) then begin
77-
Nametab.push_abbreviation (Nametab.Exactly i) sp kn;
77+
Nametab.Abbrev.push (Nametab.Exactly i) sp kn;
7878
if not abbrev.abbrev_onlyparsing then
7979
(* Redeclare it to be used as (short) name in case an other (distfix)
8080
notation was declared in between *)
@@ -115,7 +115,7 @@ let declare_abbreviation ~local ?(also_in_cases_pattern=true) deprecation id ~on
115115
in
116116
add_leaf (inAbbreviation id (local,abbrev))
117117

118-
let pr_abbreviation kn = pr_qualid (Nametab.shortest_qualid_of_abbreviation Id.Set.empty kn)
118+
let pr_abbreviation kn = pr_qualid (Nametab.Abbrev.shortest_qualid Id.Set.empty kn)
119119

120120
let warn_deprecated_abbreviation =
121121
Deprecation.create_warning ~object_name:"Notation" ~warning_name:"deprecated-syntactic-definition"

interp/constrextern.ml

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -128,7 +128,7 @@ let _show_inactive_notations () =
128128
(function
129129
| NotationRule (inscope, ntn) ->
130130
Feedback.msg_notice (pr_notation ntn ++ show_scope inscope)
131-
| AbbrevRule kn -> Feedback.msg_notice (str (string_of_qualid (Nametab.shortest_qualid_of_abbreviation Id.Set.empty kn))))
131+
| AbbrevRule kn -> Feedback.msg_notice (str (string_of_qualid (Nametab.Abbrev.shortest_qualid Id.Set.empty kn))))
132132
!inactive_notations_table
133133

134134
let deactivate_scope sc =
@@ -266,7 +266,7 @@ let path_of_global = function
266266
| GlobRef.ConstructRef ((ind,n),p) -> Libnames.make_path (dirpath_of_modpath (MutInd.modpath ind)) (Id.of_string_soft ("<constructor:" ^ Label.to_string (MutInd.label ind) ^ ":" ^ string_of_int n ^ ":" ^ string_of_int (p+1) ^ ">"))
267267

268268
let default_extern_reference ?loc vars r =
269-
try Nametab.shortest_qualid_of_global ?loc vars r
269+
try Nametab.GlobRef.shortest_qualid ?loc vars r
270270
with Not_found when GlobRef.is_bound r -> qualid_of_path (path_of_global r)
271271

272272
let my_extern_reference = ref default_extern_reference
@@ -496,7 +496,7 @@ and apply_notation_to_pattern ?loc gr ((subst,substlist),(no_implicit,nb_to_drop
496496
match availability_of_entry_coercion custom InConstrEntrySomeLevel with
497497
| None -> raise No_match
498498
| Some coercion ->
499-
let qid = Nametab.shortest_qualid_of_abbreviation ?loc vars kn in
499+
let qid = Nametab.Abbrev.shortest_qualid ?loc vars kn in
500500
let l1 =
501501
List.rev_map (fun (c,(subentry,(scopt,scl))) ->
502502
extern_cases_pattern_in_scope (subentry,(scopt,scl@scopes)) vars c)
@@ -861,7 +861,7 @@ let extended_glob_local_binder_of_decl ?loc u = DAst.make ?loc (extended_glob_lo
861861

862862
(* this helper function is copied from notation.ml as it's not exported *)
863863
let qualid_of_ref n =
864-
n |> Coqlib.lib_ref |> Nametab.shortest_qualid_of_global Id.Set.empty
864+
n |> Coqlib.lib_ref |> Nametab.GlobRef.shortest_qualid Id.Set.empty
865865

866866
let q_infinity () = qualid_of_ref "num.float.infinity"
867867
let q_neg_infinity () = qualid_of_ref "num.float.neg_infinity"
@@ -1336,7 +1336,7 @@ and extern_notation inctx (custom,scopes as allscopes) vars t rules =
13361336
extern true (subentry,(scopt,scl@snd scopes)) (vars,uvars) c)
13371337
terms
13381338
in
1339-
let cf = Nametab.shortest_qualid_of_abbreviation ?loc vars kn in
1339+
let cf = Nametab.Abbrev.shortest_qualid ?loc vars kn in
13401340
let a = CRef (cf,None) in
13411341
let args = fill_arg_scopes args argsscopes allscopes in
13421342
let args = extern_args (extern true) (vars,uvars) args in

interp/constrintern.ml

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -130,7 +130,7 @@ let explain_bad_patterns_number n1 n2 =
130130

131131
let inductive_of_record s =
132132
let inductive = GlobRef.IndRef (s.Structure.name) in
133-
Nametab.shortest_qualid_of_global Id.Set.empty inductive
133+
Nametab.GlobRef.shortest_qualid Id.Set.empty inductive
134134

135135
let explain_field_not_a_projection field_id =
136136
pr_qualid field_id ++ str ": Not a projection"
@@ -797,7 +797,7 @@ let terms_of_binders bl =
797797
| PatVar (Name id) -> CRef (qualid_of_ident id, None)
798798
| PatVar (Anonymous) -> error_cannot_coerce_wildcard_term ?loc ()
799799
| PatCstr (c,l,_) ->
800-
let qid = qualid_of_path ?loc (Nametab.path_of_global (GlobRef.ConstructRef c)) in
800+
let qid = qualid_of_path ?loc (Nametab.GlobRef.path (GlobRef.ConstructRef c)) in
801801
let hole = CAst.make ?loc @@ CHole (None,IntroAnonymous,None) in
802802
let params = List.make (Inductiveops.inductive_nparams (Global.env()) (fst c)) hole in
803803
CAppExpl ((qid,None),params @ List.map term_of_pat l)) pt in
@@ -1164,7 +1164,7 @@ let intern_sort_name ~local_univs = function
11641164
match local with
11651165
| Some u -> GUniv u
11661166
| None ->
1167-
try GUniv (Univ.Level.make (Nametab.locate_universe qid))
1167+
try GUniv (Univ.Level.make (Nametab.Universe.locate qid))
11681168
with Not_found ->
11691169
if is_id && local_univs.unb_univs
11701170
then GLocalUniv (CAst.make ?loc:qid.loc (qualid_basename qid))
@@ -2809,7 +2809,7 @@ let interp_named_context_evars ?(program_mode=false) ?(impl_env=empty_internaliz
28092809
let known_universe_level_name evd lid =
28102810
try Evd.universe_of_name evd lid.CAst.v
28112811
with Not_found ->
2812-
let u = Nametab.locate_universe (Libnames.qualid_of_lident lid) in
2812+
let u = Nametab.Universe.locate (Libnames.qualid_of_lident lid) in
28132813
Univ.Level.make u
28142814

28152815
let known_glob_level evd = function

interp/dumpglob.ml

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -248,7 +248,7 @@ let add_glob_gen ?loc sp lib_dp ty =
248248

249249
let add_glob ?loc ref =
250250
if dump () then
251-
let sp = Nametab.path_of_global ref in
251+
let sp = Nametab.GlobRef.path ref in
252252
let lib_dp = Lib.library_part ref in
253253
let ty = type_of_global_ref ref in
254254
add_glob_gen ?loc sp lib_dp ty
@@ -259,7 +259,7 @@ let mp_of_kn kn =
259259

260260
let add_glob_kn ?loc kn =
261261
if dump () then
262-
let sp = Nametab.path_of_abbreviation kn in
262+
let sp = Nametab.Abbrev.path kn in
263263
let lib_dp = Names.ModPath.dp (mp_of_kn kn) in
264264
add_glob_gen ?loc sp lib_dp "abbrev"
265265

interp/implicit_quantifiers.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -188,7 +188,7 @@ let implicit_application env ty =
188188
let ({CAst.v=(qid, _, _)} as clapp) = destClassAppExpl ty in
189189
if Libnames.idset_mem_qualid qid env then None
190190
else
191-
let gr = Nametab.locate qid in
191+
let gr = Nametab.GlobRef.locate qid in
192192
if Typeclasses.is_class gr then Some (clapp, gr) else None
193193
with Not_found -> None
194194
in

interp/modintern.ml

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -49,12 +49,12 @@ let lookup_module_or_modtype kind qid =
4949
let loc = qid.CAst.loc in
5050
try
5151
if kind == ModType then raise Not_found;
52-
let mp = Nametab.locate_module qid in
52+
let mp = Nametab.Module.locate qid in
5353
Dumpglob.dump_modref ?loc mp "modtype"; (mp,Module)
5454
with Not_found ->
5555
try
5656
if kind == Module then raise Not_found;
57-
let mp = Nametab.locate_modtype qid in
57+
let mp = Nametab.ModType.locate qid in
5858
Dumpglob.dump_modref ?loc mp "mod"; (mp,ModType)
5959
with Not_found as exn ->
6060
let _, info = Exninfo.capture exn in

interp/notation.ml

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -1028,13 +1028,13 @@ module Strings = struct
10281028
open PrimTokenNotation
10291029

10301030
let qualid_of_ref n =
1031-
n |> Coqlib.lib_ref |> Nametab.shortest_qualid_of_global Id.Set.empty
1031+
n |> Coqlib.lib_ref |> Nametab.GlobRef.shortest_qualid Id.Set.empty
10321032

10331033
let q_list () = qualid_of_ref "core.list.type"
10341034
let q_byte () = qualid_of_ref "core.byte.type"
10351035

10361036
let unsafe_locate_ind q =
1037-
match Nametab.locate q with
1037+
match Nametab.GlobRef.locate q with
10381038
| GlobRef.IndRef i -> i
10391039
| _ -> raise Not_found
10401040

@@ -1506,7 +1506,7 @@ let is_printing_inactive_rule rule pat =
15061506
| NotationRule (scope,ntn) ->
15071507
not (is_printing_active_in_scope (scope,ntn) pat)
15081508
| AbbrevRule kn ->
1509-
try let _ = Nametab.path_of_abbreviation kn in false with Not_found -> true
1509+
try let _ = Nametab.Abbrev.path kn in false with Not_found -> true
15101510

15111511
let availability_of_notation (ntn_scope,ntn) scopes =
15121512
find_without_delimiters (has_active_parsing_rule_in_scope ntn) (ntn_scope,Some ntn) (make_current_scopes scopes)
@@ -2467,7 +2467,7 @@ let warn_abbreviation_not_bound_to_scope =
24672467

24682468
let toggle_abbreviations ~on found ntn_pattern =
24692469
let data_of_interp kn i =
2470-
let q = Nametab.shortest_qualid_of_abbreviation Id.Set.empty kn in
2470+
let q = Nametab.Abbrev.shortest_qualid Id.Set.empty kn in
24712471
((DirPath.empty, DirPath.empty), string_of_qualid q), i in
24722472
match ntn_pattern.interp_rule_key_pattern, ntn_pattern.notation_entry_pattern, ntn_pattern.scope_pattern with
24732473
| Some (Inr kn), [], None ->

library/coqlib.ml

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -74,13 +74,13 @@ let register_ref s c =
7474
(* Generic functions to find Coq objects *)
7575

7676
let has_suffix_in_dirs dirs ref =
77-
let dir = Libnames.dirpath (Nametab.path_of_global ref) in
77+
let dir = Libnames.dirpath (Nametab.GlobRef.path ref) in
7878
List.exists (fun d -> Libnames.is_dirpath_prefix_of d dir) dirs
7979

8080
let gen_reference_in_modules locstr dirs s =
8181
let dirs = List.map make_dir dirs in
8282
let qualid = Libnames.qualid_of_string s in
83-
let all = Nametab.locate_all qualid in
83+
let all = Nametab.GlobRef.locate_all qualid in
8484
let all = List.sort_uniquize GlobRef.UserOrd.compare all in
8585
let these = List.filter (has_suffix_in_dirs dirs) all in
8686
match these with
@@ -93,7 +93,7 @@ let gen_reference_in_modules locstr dirs s =
9393
CErrors.anomaly ~label:locstr
9494
Pp.(str "ambiguous name " ++ str s ++ str " can represent "
9595
++ prlist_with_sep pr_comma (fun x ->
96-
Libnames.pr_path (Nametab.path_of_global x)) l ++ str " in module"
96+
Libnames.pr_path (Nametab.GlobRef.path x)) l ++ str " in module"
9797
++ str (if List.length dirs > 1 then "s " else " ")
9898
++ prlist_with_sep pr_comma DirPath.print dirs ++ str ".")
9999

library/lib.ml

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -189,8 +189,8 @@ let start_mod is_type export id mp fs =
189189
in
190190
let prefix = Nametab.{ obj_dir = dir; obj_mp = mp; } in
191191
let exists =
192-
if is_type then Nametab.exists_cci (make_path id)
193-
else Nametab.exists_module dir
192+
if is_type then Nametab.GlobRef.exists (make_path id)
193+
else Nametab.Module.exists dir
194194
in
195195
if exists then
196196
CErrors.user_err Pp.(Id.print id ++ str " already exists.");
@@ -373,12 +373,12 @@ let open_section id =
373373
let opp = !lib_state.path_prefix in
374374
let obj_dir = Libnames.add_dirpath_suffix opp.Nametab.obj_dir id in
375375
let prefix = Nametab.{ obj_dir; obj_mp = opp.obj_mp; } in
376-
if Nametab.exists_dir obj_dir then
376+
if Nametab.Dir.exists obj_dir then
377377
CErrors.user_err Pp.(Id.print id ++ str " already exists.");
378378
let fs = Summary.freeze_summaries ~marshallable:false in
379379
add_entry (OpenedSection (prefix, fs));
380380
(*Pushed for the lifetime of the section: removed by unfrozing the summary*)
381-
Nametab.(push_dir (Until 1) obj_dir (GlobDirRef.DirOpenSection obj_dir));
381+
Nametab.(Dir.push (Until 1) obj_dir (GlobDirRef.DirOpenSection obj_dir));
382382
lib_state := { !lib_state with path_prefix = prefix }
383383

384384
(* Restore lib_stk and summaries as before the section opening, and

0 commit comments

Comments
 (0)