aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPierre-Marie Pédrot2015-04-16 08:35:57 +0200
committerPierre-Marie Pédrot2015-04-16 14:53:06 +0200
commitdfb64dda51f7eea174e41129c8d2e0c3559298ec (patch)
tree08fa337f0c96fee6725332884b3924816ddcf6d8
parent92e491097dbd7ca610ded20c3c4a3bb978c996eb (diff)
Fixing bug #4190.
The solution is a bit ugly. In order for two tactic notations identifiers not to be confused by the inclusion from two distinct modules, we embed the name of the source module in the identifiers. This may still fail if the same module is included twice with two distinct parameters, but this should not be possible thanks to the fact any definition in there will forbid the inclusion, for it would be repeated. People including twice the same empty module otherwise probably deserve whatever will arise from it.
-rw-r--r--kernel/names.ml9
-rw-r--r--kernel/names.mli6
-rw-r--r--toplevel/metasyntax.ml18
3 files changed, 25 insertions, 8 deletions
diff --git a/kernel/names.ml b/kernel/names.ml
index 4ccf5b60ae..480b37e897 100644
--- a/kernel/names.ml
+++ b/kernel/names.ml
@@ -33,9 +33,9 @@ struct
let hash = String.hash
- let check_soft x =
+ let check_soft ?(warn = true) x =
let iter (fatal, x) =
- if fatal then Errors.error x else Pp.msg_warning (str x)
+ if fatal then Errors.error x else if warn then Pp.msg_warning (str x)
in
Option.iter iter (Unicode.ident_refutation x)
@@ -48,6 +48,11 @@ struct
let s = String.copy s in
String.hcons s
+ let of_string_soft s =
+ let () = check_soft ~warn:false s in
+ let s = String.copy s in
+ String.hcons s
+
let to_string id = String.copy id
let print id = str id
diff --git a/kernel/names.mli b/kernel/names.mli
index d82043da1a..92ee58f260 100644
--- a/kernel/names.mli
+++ b/kernel/names.mli
@@ -29,7 +29,11 @@ sig
val of_string : string -> t
(** Converts a string into an identifier. May raise [UserError _] if the
- string is not valid. *)
+ string is not valid, or echo a warning if it contains invalid identifier
+ characters. *)
+
+ val of_string_soft : string -> t
+ (** Same as {!of_string} except that no warning is ever issued. *)
val to_string : t -> string
(** Converts a identifier into an string. *)
diff --git a/toplevel/metasyntax.ml b/toplevel/metasyntax.ml
index c8eff59b15..639ec1e6e3 100644
--- a/toplevel/metasyntax.ml
+++ b/toplevel/metasyntax.ml
@@ -62,11 +62,19 @@ let rec make_tags = function
| [] -> []
let make_fresh_key =
- let id = Summary.ref ~name:"Tactic Notation counter" 0 in
- fun () -> KerName.make
- (Safe_typing.current_modpath (Global.safe_env ()))
- (Global.current_dirpath ())
- (incr id; Label.make ("_" ^ string_of_int !id))
+ let id = Summary.ref ~name:"TACTIC-NOTATION-COUNTER" 0 in
+ fun () ->
+ let cur = incr id; !id in
+ let lbl = Id.of_string ("_" ^ string_of_int cur) in
+ let kn = Lib.make_kn lbl in
+ let (mp, dir, _) = KerName.repr kn in
+ (** We embed the full path of the kernel name in the label so that the
+ identifier should be unique. This ensures that including two modules
+ together won't confuse the corresponding labels. *)
+ let lbl = Id.of_string_soft (Printf.sprintf "%s#%s#%i"
+ (ModPath.to_string mp) (DirPath.to_string dir) cur)
+ in
+ KerName.make mp dir (Label.of_id lbl)
type tactic_grammar_obj = {
tacobj_key : KerName.t;