aboutsummaryrefslogtreecommitdiff
path: root/interp
diff options
context:
space:
mode:
authorHugo Herbelin2020-02-10 22:31:55 +0100
committerHugo Herbelin2020-02-16 21:44:43 +0100
commit29919b725262dca76708192bde65ce82860747be (patch)
tree61694625fbeb3491bef8cb1f09f2a07548318acf /interp
parentacde8140bd51be112be33ae07db68b2f3b93302c (diff)
Granting #9516 and #9518 (support for numerals and strings in custom entries).
Diffstat (limited to 'interp')
-rw-r--r--interp/constrextern.ml8
-rw-r--r--interp/notation.ml28
-rw-r--r--interp/notation.mli3
3 files changed, 36 insertions, 3 deletions
diff --git a/interp/constrextern.ml b/interp/constrextern.ml
index c198c4eb9b..06232b8e1a 100644
--- a/interp/constrextern.ml
+++ b/interp/constrextern.ml
@@ -792,9 +792,11 @@ let rec flatten_application c = match DAst.get c with
let extern_possible_prim_token (custom,scopes) r =
let (sc,n) = uninterp_prim_token r in
- match availability_of_entry_coercion custom InConstrEntrySomeLevel with
- | None -> raise No_match
- | Some coercion ->
+ let coercion =
+ if entry_has_prim_token n custom then [] else
+ match availability_of_entry_coercion custom InConstrEntrySomeLevel with
+ | None -> raise No_match
+ | Some coercion -> coercion in
match availability_of_prim_token n sc scopes with
| None -> raise No_match
| Some key -> insert_coercion coercion (insert_delimiters (CAst.make ?loc:(loc_of_glob_constr r) @@ CPrim n) key)
diff --git a/interp/notation.ml b/interp/notation.ml
index 93969f3718..9d6cab550d 100644
--- a/interp/notation.ml
+++ b/interp/notation.ml
@@ -1349,6 +1349,34 @@ let entry_has_ident = function
| InCustomEntryLevel (s,n) ->
try String.Map.find s !entry_has_ident_map <= n with Not_found -> false
+let entry_has_numeral_map = ref String.Map.empty
+let entry_has_string_map = ref String.Map.empty
+
+let declare_custom_entry_has_numeral s n =
+ try
+ let p = String.Map.find s !entry_has_numeral_map in
+ user_err (str "Custom entry " ++ str s ++
+ str " has already a rule for numerals at level " ++ int p ++ str ".")
+ with Not_found ->
+ entry_has_numeral_map := String.Map.add s n !entry_has_numeral_map
+
+let declare_custom_entry_has_string s n =
+ try
+ let p = String.Map.find s !entry_has_string_map in
+ user_err (str "Custom entry " ++ str s ++
+ str " has already a rule for strings at level " ++ int p ++ str ".")
+ with Not_found ->
+ entry_has_string_map := String.Map.add s n !entry_has_string_map
+
+let entry_has_prim_token prim = function
+ | InConstrEntrySomeLevel -> true
+ | InCustomEntryLevel (s,n) ->
+ match prim with
+ | Numeral _ ->
+ (try String.Map.find s !entry_has_numeral_map <= n with Not_found -> false)
+ | String _ ->
+ (try String.Map.find s !entry_has_string_map <= n with Not_found -> false)
+
let uninterp_prim_token c =
match glob_prim_constr_key c with
| None -> raise Notation_ops.No_match
diff --git a/interp/notation.mli b/interp/notation.mli
index ea5125f7ec..707be6cb87 100644
--- a/interp/notation.mli
+++ b/interp/notation.mli
@@ -305,9 +305,12 @@ val availability_of_entry_coercion : notation_entry_level -> notation_entry_leve
val declare_custom_entry_has_global : string -> int -> unit
val declare_custom_entry_has_ident : string -> int -> unit
+val declare_custom_entry_has_numeral : string -> int -> unit
+val declare_custom_entry_has_string : string -> int -> unit
val entry_has_global : notation_entry_level -> bool
val entry_has_ident : notation_entry_level -> bool
+val entry_has_prim_token : prim_token -> notation_entry_level -> bool
(** Rem: printing rules for primitive token are canonical *)