aboutsummaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
authorGravatar Hugo Herbelin <Hugo.Herbelin@inria.fr>2016-04-27 22:13:02 +0200
committerGravatar Hugo Herbelin <Hugo.Herbelin@inria.fr>2016-04-27 22:13:02 +0200
commitc13b589601a8fc9bf5a6142caa0480fe8a59327e (patch)
treefe2a67ecc08cd20ae79c0cfc471068c3572e8d33
parent1149c00f81c7ac578bb4acdd8b91da728556c75b (diff)
Revert "Using existing names as a basis for the inner names of the pattern-matching produced by an implicit "in" clause"
-rw-r--r--pretyping/cases.ml16
1 files changed, 7 insertions, 9 deletions
diff --git a/pretyping/cases.ml b/pretyping/cases.ml
index 92135e834..375e742e0 100644
--- a/pretyping/cases.ml
+++ b/pretyping/cases.ml
@@ -1763,31 +1763,29 @@ let build_tycon loc env tycon_env s subst tycon extenv evdref t =
*)
let build_inversion_problem loc env sigma tms t =
- let make_patvar t (subst,avoid) =
- (* Typed in initial environment [env] *)
+ let make_patvar env t (subst,avoid) =
let name = match kind_of_term t with
| Rel n -> get_name (lookup_rel n env)
| Var id -> Name (Context.Named.Declaration.get_id (lookup_named id env))
| _ -> named_hd env t Anonymous in
let id = next_name_away name avoid in
PatVar (Loc.ghost,Name id), ((id,t)::subst, id::avoid) in
- let rec reveal_pattern t (subst,avoid as acc) =
- (* Typed in initial environment [env] *)
+ let rec reveal_pattern env t (subst,avoid as acc) =
match kind_of_term (whd_betadeltaiota env sigma t) with
| Construct (cstr,u) -> PatCstr (Loc.ghost,cstr,[],Anonymous), acc
| App (f,v) when isConstruct f ->
let cstr,u = destConstruct f in
let n = constructor_nrealargs_env env cstr in
let l = List.lastn n (Array.to_list v) in
- let l,acc = List.fold_map' reveal_pattern l acc in
+ let l,acc = List.fold_map' (reveal_pattern env) l acc in
PatCstr (Loc.ghost,cstr,l,Anonymous), acc
- | _ -> make_patvar t acc in
+ | _ -> make_patvar env t acc in
let rec aux n env acc_sign tms acc =
match tms with
| [] -> [], acc_sign, acc
| (t, IsInd (_,IndType(indf,realargs),_)) :: tms ->
- let patl,acc = List.fold_map' reveal_pattern realargs acc in
- let pat,acc = make_patvar t acc in
+ let patl,acc = List.fold_map' (reveal_pattern env) realargs acc in
+ let pat,acc = make_patvar env t acc in
let indf' = lift_inductive_family n indf in
let sign = make_arity_signature env true indf' in
let patl = pat :: List.rev patl in
@@ -1797,7 +1795,7 @@ let build_inversion_problem loc env sigma tms t =
let patl',acc_sign,acc = aux (n+p) env' (sign@acc_sign) tms acc in
List.rev_append patl patl',acc_sign,acc
| (t, NotInd (bo,typ)) :: tms ->
- let pat,acc = make_patvar t acc in
+ let pat,acc = make_patvar env t acc in
let d = LocalAssum (alias_of_pat pat,lift n typ) in
let patl,acc_sign,acc = aux (n+1) (push_rel d env) (d::acc_sign) tms acc in
pat::patl,acc_sign,acc in