aboutsummaryrefslogtreecommitdiffhomepage
path: root/interp
diff options
context:
space:
mode:
authorGravatar Hugo Herbelin <Hugo.Herbelin@inria.fr>2017-08-18 11:36:05 +0200
committerGravatar Hugo Herbelin <Hugo.Herbelin@inria.fr>2017-12-12 13:30:57 +0100
commitc1cab3ba606f7034f2785f06c0d3892bca3976cf (patch)
tree19918420f7e4b64be31953dae8f51c981e638f4a /interp
parent745eb8d6d9f99b69d11c16e8fb5e133e8e27d0a8 (diff)
Removing cumbersome location in multiple patterns.
This is to have a better symmetry between CCases and GCases.
Diffstat (limited to 'interp')
-rw-r--r--interp/constrexpr_ops.ml8
-rw-r--r--interp/constrextern.ml2
-rw-r--r--interp/constrintern.ml8
3 files changed, 10 insertions, 8 deletions
diff --git a/interp/constrexpr_ops.ml b/interp/constrexpr_ops.ml
index 8b78a91b5..7cc8de85d 100644
--- a/interp/constrexpr_ops.ml
+++ b/interp/constrexpr_ops.ml
@@ -188,7 +188,7 @@ and case_expr_eq (e1, n1, p1) (e2, n2, p2) =
Option.equal cases_pattern_expr_eq p1 p2
and branch_expr_eq (_, (p1, e1)) (_, (p2, e2)) =
- List.equal (eq_located (List.equal cases_pattern_expr_eq)) p1 p2 &&
+ List.equal (List.equal cases_pattern_expr_eq) p1 p2 &&
constr_expr_eq e1 e2
and binder_expr_eq ((n1, _, e1) : binder_expr) (n2, _, e2) =
@@ -260,7 +260,6 @@ let local_binders_loc bll = match bll with
(* Legacy functions *)
let down_located f (_l, x) = f x
-let located_fold_left f x (_l, y) = f x y
let is_constructor id =
try Globnames.isConstructRef
@@ -292,8 +291,7 @@ let ids_of_pattern =
let ids_of_pattern_list =
List.fold_left
- (located_fold_left
- (List.fold_left (cases_pattern_fold_names Id.Set.add)))
+ (List.fold_left (cases_pattern_fold_names Id.Set.add))
Id.Set.empty
let ids_of_cases_indtype p =
@@ -571,7 +569,7 @@ let expand_binders ?loc mkC bl c =
let c = CAst.make ?loc @@
CCases
(LetPatternStyle, None, [(e,None,None)],
- [(Loc.tag ?loc:loc1 ([(loc1,[p])], c))])
+ [(Loc.tag ?loc:loc1 ([[p]], c))])
in
(ni :: env, mkC ?loc ([id],Default Explicit,ty) c)
in
diff --git a/interp/constrextern.ml b/interp/constrextern.ml
index bc8debd02..6704ed4b7 100644
--- a/interp/constrextern.ml
+++ b/interp/constrextern.ml
@@ -967,7 +967,7 @@ and extern_local_binder scopes vars = function
(assums,ids, CLocalPattern(Loc.tag @@ (p,ty)) :: l)
and extern_eqn inctx scopes vars (loc,(ids,pl,c)) =
- Loc.tag ?loc ([loc,List.map (extern_cases_pattern_in_scope scopes vars) pl],
+ Loc.tag ?loc ([List.map (extern_cases_pattern_in_scope scopes vars) pl],
extern inctx scopes vars c)
and extern_notation (tmp_scope,scopes as allscopes) vars t = function
diff --git a/interp/constrintern.ml b/interp/constrintern.ml
index 977146b2f..74ae32120 100644
--- a/interp/constrintern.ml
+++ b/interp/constrintern.ml
@@ -958,8 +958,11 @@ let rec has_duplicate = function
| [] -> None
| x::l -> if Id.List.mem x l then (Some x) else has_duplicate l
+let loc_of_multiple_pattern pl =
+ Loc.merge_opt (cases_pattern_expr_loc (List.hd pl)) (cases_pattern_expr_loc (List.last pl))
+
let loc_of_lhs lhs =
- Loc.merge_opt (fst (List.hd lhs)) (fst (List.last lhs))
+ Loc.merge_opt (loc_of_multiple_pattern (List.hd lhs)) (loc_of_multiple_pattern (List.last lhs))
let check_linearity lhs ids =
match has_duplicate ids with
@@ -1873,8 +1876,9 @@ let internalize globalenv env pattern_mode (_, ntnvars as lvar) c =
intern_local_binder_aux intern ntnvars env bind
(* Expands a multiple pattern into a disjunction of multiple patterns *)
- and intern_multiple_pattern env n (loc,pl) =
+ and intern_multiple_pattern env n pl =
let idsl_pll = List.map (intern_cases_pattern globalenv (None,env.scopes) empty_alias) pl in
+ let loc = loc_of_multiple_pattern pl in
check_number_of_pattern loc n pl;
product_of_cases_patterns empty_alias idsl_pll