aboutsummaryrefslogtreecommitdiff
path: root/interp/constrintern.ml
diff options
context:
space:
mode:
authorGaëtan Gilbert2020-07-03 15:15:20 +0200
committerGaëtan Gilbert2020-07-03 15:15:20 +0200
commitcf388fdb679adb88a7e8b3122f65377552d2fb94 (patch)
treeb852fd1e116ff72748210a11bc95298453ac2e4d /interp/constrintern.ml
parent33581635d3ad525e1d5c2fb2587be345a7e77009 (diff)
parent53e19f76624b7a18792af799e970e9478f8e90a9 (diff)
Merge PR #12523: Fix #11121: Simultaneous definition of term and notation in custom gr…
Reviewed-by: SkySkimmer Ack-by: ejgallego Ack-by: herbelin
Diffstat (limited to 'interp/constrintern.ml')
-rw-r--r--interp/constrintern.ml24
1 files changed, 12 insertions, 12 deletions
diff --git a/interp/constrintern.ml b/interp/constrintern.ml
index ee041ed088..d95554de56 100644
--- a/interp/constrintern.ml
+++ b/interp/constrintern.ml
@@ -224,35 +224,35 @@ let expand_notation_string ntn n =
(* Remark: expansion of squash at definition is done in metasyntax.ml *)
let contract_curly_brackets ntn (l,ll,bl,bll) =
match ntn with
- | InCustomEntryLevel _,_ -> ntn,(l,ll,bl,bll)
- | InConstrEntrySomeLevel, ntn ->
+ | InCustomEntry _,_ -> ntn,(l,ll,bl,bll)
+ | InConstrEntry, ntn ->
let ntn' = ref ntn in
let rec contract_squash n = function
| [] -> []
- | { CAst.v = CNotation (None,(InConstrEntrySomeLevel,"{ _ }"),([a],[],[],[])) } :: l ->
+ | { CAst.v = CNotation (None,(InConstrEntry,"{ _ }"),([a],[],[],[])) } :: l ->
ntn' := expand_notation_string !ntn' n;
contract_squash n (a::l)
| a :: l ->
a::contract_squash (n+1) l in
let l = contract_squash 0 l in
(* side effect; don't inline *)
- (InConstrEntrySomeLevel,!ntn'),(l,ll,bl,bll)
+ (InConstrEntry,!ntn'),(l,ll,bl,bll)
let contract_curly_brackets_pat ntn (l,ll) =
match ntn with
- | InCustomEntryLevel _,_ -> ntn,(l,ll)
- | InConstrEntrySomeLevel, ntn ->
+ | InCustomEntry _,_ -> ntn,(l,ll)
+ | InConstrEntry, ntn ->
let ntn' = ref ntn in
let rec contract_squash n = function
| [] -> []
- | { CAst.v = CPatNotation (None,(InConstrEntrySomeLevel,"{ _ }"),([a],[]),[]) } :: l ->
+ | { CAst.v = CPatNotation (None,(InConstrEntry,"{ _ }"),([a],[]),[]) } :: l ->
ntn' := expand_notation_string !ntn' n;
contract_squash n (a::l)
| a :: l ->
a::contract_squash (n+1) l in
let l = contract_squash 0 l in
(* side effect; don't inline *)
- (InConstrEntrySomeLevel,!ntn'),(l,ll)
+ (InConstrEntry,!ntn'),(l,ll)
type intern_env = {
ids: Names.Id.Set.t;
@@ -1688,11 +1688,11 @@ let drop_notations_pattern looked_for genv =
(* but not scopes in expl_pl *)
let (argscs1,_) = find_remaining_scopes expl_pl pl g in
DAst.make ?loc @@ RCPatCstr (g, List.map2 (in_pat_sc scopes) argscs1 expl_pl @ List.map (in_pat false scopes) pl, [])
- | CPatNotation (_,(InConstrEntrySomeLevel,"- _"),([a],[]),[]) when is_non_zero_pat a ->
+ | CPatNotation (_,(InConstrEntry,"- _"),([a],[]),[]) when is_non_zero_pat a ->
let p = match a.CAst.v with CPatPrim (Numeral (_, p)) -> p | _ -> assert false in
let pat, _df = Notation.interp_prim_token_cases_pattern_expr ?loc (ensure_kind false loc) (Numeral (SMinus,p)) scopes in
rcp_of_glob scopes pat
- | CPatNotation (_,(InConstrEntrySomeLevel,"( _ )"),([a],[]),[]) ->
+ | CPatNotation (_,(InConstrEntry,"( _ )"),([a],[]),[]) ->
in_pat top scopes a
| CPatNotation (_,ntn,fullargs,extrargs) ->
let ntn,(terms,termlists) = contract_curly_brackets_pat ntn fullargs in
@@ -2006,10 +2006,10 @@ let internalize globalenv env pattern_mode (_, ntnvars as lvar) c =
DAst.make ?loc @@
GLetIn (na.CAst.v, inc1, int,
intern_restart_binders (push_name_env ntnvars (impls_term_list 1 inc1) env na) c2)
- | CNotation (_,(InConstrEntrySomeLevel,"- _"), ([a],[],[],[])) when is_non_zero a ->
+ | CNotation (_,(InConstrEntry,"- _"), ([a],[],[],[])) when is_non_zero a ->
let p = match a.CAst.v with CPrim (Numeral (_, p)) -> p | _ -> assert false in
intern env (CAst.make ?loc @@ CPrim (Numeral (SMinus,p)))
- | CNotation (_,(InConstrEntrySomeLevel,"( _ )"),([a],[],[],[])) -> intern env a
+ | CNotation (_,(InConstrEntry,"( _ )"),([a],[],[],[])) -> intern env a
| CNotation (_,ntn,args) ->
let c = intern_notation intern env ntnvars loc ntn args in
let x, impl, scopes = find_appl_head_data c in