aboutsummaryrefslogtreecommitdiff
path: root/interp/notation.ml
diff options
context:
space:
mode:
authorHugo Herbelin2017-11-25 12:14:59 +0100
committerHugo Herbelin2018-12-04 11:50:02 +0100
commit93a65415ff582d2ceb5bb9d994edaa6068da8280 (patch)
tree630333b9518caa8f7b97b9f1c32deba2ebf35aff /interp/notation.ml
parentfe81b1a6f813fe21f0cc21ede761acae64c7b026 (diff)
Pre-isolating a notation test to avoid interferences.
Diffstat (limited to 'interp/notation.ml')
-rw-r--r--interp/notation.ml41
1 files changed, 32 insertions, 9 deletions
diff --git a/interp/notation.ml b/interp/notation.ml
index db8ee5bc18..49403c6e34 100644
--- a/interp/notation.ml
+++ b/interp/notation.ml
@@ -982,15 +982,38 @@ let interp_notation ?loc ntn local_scopes =
user_err ?loc
(str "Unknown interpretation for notation " ++ pr_notation ntn ++ str ".")
-let uninterp_notations c =
- List.map_append (fun key -> keymap_find key !notations_key_table)
- (glob_constr_keys c)
-
-let uninterp_cases_pattern_notations c =
- keymap_find (cases_pattern_key c) !notations_key_table
-
-let uninterp_ind_pattern_notations ind =
- keymap_find (RefKey (canonical_gr (IndRef ind))) !notations_key_table
+let sort_notations scopes l =
+ let extract_scope l = function
+ | Scope sc -> List.partitioni (fun _i x ->
+ match x with
+ | NotationRule (Some sc',_),_,_ -> String.equal sc sc'
+ | _ -> false) l
+ | SingleNotation ntn -> List.partitioni (fun _i x ->
+ match x with
+ | NotationRule (None,ntn'),_,_ -> notation_eq ntn ntn'
+ | _ -> false) l in
+ let rec aux l scopes =
+ if l == [] then [] (* shortcut *) else
+ match scopes with
+ | sc :: scopes -> let ntn_in_sc,l = extract_scope l sc in ntn_in_sc @ aux l scopes
+ | [] -> l in
+ aux l scopes
+
+let uninterp_notations scopes c =
+ let scopes = make_current_scopes scopes in
+ let keys = glob_constr_keys c in
+ let maps = List.map_append (fun key -> keymap_find key !notations_key_table) keys in
+ sort_notations scopes maps
+
+let uninterp_cases_pattern_notations scopes c =
+ let scopes = make_current_scopes scopes in
+ let maps = keymap_find (cases_pattern_key c) !notations_key_table in
+ sort_notations scopes maps
+
+let uninterp_ind_pattern_notations scopes ind =
+ let scopes = make_current_scopes scopes in
+ let maps = keymap_find (RefKey (canonical_gr (IndRef ind))) !notations_key_table in
+ sort_notations scopes maps
let availability_of_notation (ntn_scope,ntn) scopes =
let f scope =