aboutsummaryrefslogtreecommitdiffhomepage
path: root/tactics
diff options
context:
space:
mode:
authorGravatar Pierre-Marie Pédrot <pierre-marie.pedrot@inria.fr>2018-06-13 15:00:30 +0200
committerGravatar Pierre-Marie Pédrot <pierre-marie.pedrot@inria.fr>2018-06-13 15:00:30 +0200
commit3d30f6f2478cfdcacb0c3c56852230499e83aeea (patch)
tree64a5bb9c3018a8cbee9fbd63d54aff886e10854e /tactics
parentc1d690443589a457b18b39b7003ccb762bcf401f (diff)
parentc464965df350ab5007d2a1c0d6e625d119abf650 (diff)
Merge PR #7789: Fixes #7779: destruct's "in" clause was forgetting the possibility of an "eqn" clause
Diffstat (limited to 'tactics')
-rw-r--r--tactics/tactics.ml30
1 files changed, 17 insertions, 13 deletions
diff --git a/tactics/tactics.ml b/tactics/tactics.ml
index 67170d2cf..770e31fea 100644
--- a/tactics/tactics.ml
+++ b/tactics/tactics.ml
@@ -2650,6 +2650,15 @@ let insert_before decls lasthyp env =
push_named d env)
~init:(reset_context env) env
+let mk_eq_name env id {CAst.loc;v=ido} =
+ match ido with
+ | IntroAnonymous -> fresh_id_in_env (Id.Set.singleton id) (add_prefix "Heq" id) env
+ | IntroFresh heq_base -> fresh_id_in_env (Id.Set.singleton id) heq_base env
+ | IntroIdentifier id ->
+ if List.mem id (ids_of_named_context (named_context env)) then
+ user_err ?loc (Id.print id ++ str" is already used.");
+ id
+
(* unsafe *)
let mkletin_goal env sigma store with_eq dep (id,lastlhyp,ccl,c) ty =
@@ -2659,14 +2668,7 @@ let mkletin_goal env sigma store with_eq dep (id,lastlhyp,ccl,c) ty =
else LocalAssum (id,t)
in
match with_eq with
- | Some (lr,{CAst.loc;v=ido}) ->
- let heq = match ido with
- | IntroAnonymous -> fresh_id_in_env (Id.Set.singleton id) (add_prefix "Heq" id) env
- | IntroFresh heq_base -> fresh_id_in_env (Id.Set.singleton id) heq_base env
- | IntroIdentifier id ->
- if List.mem id (ids_of_named_context (named_context env)) then
- user_err ?loc (Id.print id ++ str" is already used.");
- id in
+ | Some (lr,heq) ->
let eqdata = build_coq_eq_data () in
let args = if lr then [t;mkVar id;c] else [t;c;mkVar id]in
let (sigma, eq) = Evd.fresh_global env sigma eqdata.eq in
@@ -4401,7 +4403,8 @@ let pose_induction_arg_then isrec with_evars (is_arg_pure_hyp,from_prefix) elim
match res with
| None ->
(* pattern not found *)
- let with_eq = Option.map (fun eq -> (false,eq)) eqname in
+ let with_eq = Option.map (fun eq -> (false,mk_eq_name env id eq)) eqname in
+ let inhyps = if List.is_empty inhyps then inhyps else Option.fold_left (fun inhyps (_,heq) -> heq::inhyps) inhyps with_eq in
(* we restart using bindings after having tried type-class
resolution etc. on the term given by the user *)
let flags = tactic_infer_flags (with_evars && (* do not give a success semantics to edestruct on an open term yet *) false) in
@@ -4426,21 +4429,22 @@ let pose_induction_arg_then isrec with_evars (is_arg_pure_hyp,from_prefix) elim
else Proofview.tclUNIT ();
if isrec then Proofview.cycle (-1) else Proofview.tclUNIT ()
])
- tac
+ (tac inhyps)
in
Proofview.tclTHEN (Proofview.Unsafe.tclEVARS sigma) tac
| Some (sigma', c) ->
(* pattern found *)
- let with_eq = Option.map (fun eq -> (false,eq)) eqname in
(* TODO: if ind has predicate parameters, use JMeq instead of eq *)
let env = reset_with_named_context sign env in
+ let with_eq = Option.map (fun eq -> (false,mk_eq_name env id eq)) eqname in
+ let inhyps = if List.is_empty inhyps then inhyps else Option.fold_left (fun inhyps (_,heq) -> heq::inhyps) inhyps with_eq in
let tac =
Tacticals.New.tclTHENLIST [
Refine.refine ~typecheck:false begin fun sigma ->
mkletin_goal env sigma store with_eq true (id,lastlhyp,ccl,c) None
end;
- tac
+ (tac inhyps)
]
in
Proofview.tclTHEN (Proofview.Unsafe.tclEVARS sigma') tac
@@ -4490,7 +4494,7 @@ let induction_gen clear_flag isrec with_evars elim
pose_induction_arg_then
isrec with_evars info_arg elim id arg t inhyps cls
(induction_with_atomization_of_ind_arg
- isrec with_evars elim names id inhyps)
+ isrec with_evars elim names id)
end
(* Induction on a list of arguments. First make induction arguments