diff options
| author | Gaëtan Gilbert | 2020-07-03 15:15:20 +0200 |
|---|---|---|
| committer | Gaëtan Gilbert | 2020-07-03 15:15:20 +0200 |
| commit | cf388fdb679adb88a7e8b3122f65377552d2fb94 (patch) | |
| tree | b852fd1e116ff72748210a11bc95298453ac2e4d /interp/constrintern.ml | |
| parent | 33581635d3ad525e1d5c2fb2587be345a7e77009 (diff) | |
| parent | 53e19f76624b7a18792af799e970e9478f8e90a9 (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.ml | 24 |
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 |
