Skip to content

Commit cead0ce

Browse files
committed
Generate more user-readable tactic notation kernel names.
This has no influence on user-side, and only makes the life of the debugging developer easier.
1 parent 87f6a16 commit cead0ce

File tree

1 file changed

+12
-11
lines changed

1 file changed

+12
-11
lines changed

ltac/tacentries.ml

Lines changed: 12 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -228,18 +228,19 @@ let interp_prod_item = function
228228

229229
let make_fresh_key =
230230
let id = Summary.ref ~name:"TACTIC-NOTATION-COUNTER" 0 in
231-
fun () ->
231+
fun prods ->
232232
let cur = incr id; !id in
233-
let lbl = Id.of_string ("_" ^ string_of_int cur) in
234-
let kn = Lib.make_kn lbl in
235-
let (mp, dir, _) = KerName.repr kn in
236-
(** We embed the full path of the kernel name in the label so that the
237-
identifier should be unique. This ensures that including two modules
238-
together won't confuse the corresponding labels. *)
239-
let lbl = Id.of_string_soft (Printf.sprintf "%s#%s#%i"
240-
(ModPath.to_string mp) (DirPath.to_string dir) cur)
233+
let map = function
234+
| TacTerm s -> s
235+
| TacNonTerm _ -> "#"
241236
in
242-
KerName.make mp dir (Label.of_id lbl)
237+
let prods = String.concat "_" (List.map map prods) in
238+
(** We embed the hash of the kernel name in the label so that the identifier
239+
should be mostly unique. This ensures that including two modules
240+
together won't confuse the corresponding labels. *)
241+
let hash = (cur lxor (ModPath.hash (Lib.current_mp ()))) land 0x7FFFFFFF in
242+
let lbl = Id.of_string_soft (Printf.sprintf "%s_%08X" prods hash) in
243+
Lib.make_kn lbl
243244

244245
type tactic_grammar_obj = {
245246
tacobj_key : KerName.t;
@@ -307,7 +308,7 @@ let add_glob_tactic_notation local n prods forml ids tac =
307308
tacgram_prods = prods;
308309
} in
309310
let tacobj = {
310-
tacobj_key = make_fresh_key ();
311+
tacobj_key = make_fresh_key prods;
311312
tacobj_local = local;
312313
tacobj_tacgram = parule;
313314
tacobj_body = (ids, tac);

0 commit comments

Comments
 (0)