aboutsummaryrefslogtreecommitdiff
path: root/tactics
diff options
context:
space:
mode:
authorPierre-Marie Pédrot2015-10-10 12:24:28 +0200
committerPierre-Marie Pédrot2015-10-10 12:24:28 +0200
commit75c5e421e91d49eec9cd55c222595d2ef45325d6 (patch)
treeeac436f0dda95d74cc1cbe2676a32a760cb53c71 /tactics
parenteb7da0d0a02a406c196214ec9d08384385541788 (diff)
parentdb06a1ddee4c79ea8f6903596284df2f2700ddac (diff)
Merge branch 'v8.5'
Diffstat (limited to 'tactics')
-rw-r--r--tactics/eauto.ml42
-rw-r--r--tactics/hints.ml15
-rw-r--r--tactics/hints.mli5
3 files changed, 13 insertions, 9 deletions
diff --git a/tactics/eauto.ml4 b/tactics/eauto.ml4
index f3fe5ef75e..f39d714628 100644
--- a/tactics/eauto.ml4
+++ b/tactics/eauto.ml4
@@ -102,7 +102,7 @@ let out_term = function
| IsGlobRef gr -> fst (Universes.fresh_global_instance (Global.env ()) gr)
let prolog_tac l n gl =
- let l = List.map (fun x -> out_term (pf_apply (prepare_hint false) gl x)) l in
+ let l = List.map (fun x -> out_term (pf_apply (prepare_hint false (false,true)) gl x)) l in
let n =
match n with
| ArgArg n -> n
diff --git a/tactics/hints.ml b/tactics/hints.ml
index dbb2340364..9faa96a806 100644
--- a/tactics/hints.ml
+++ b/tactics/hints.ml
@@ -1052,7 +1052,7 @@ let default_prepare_hint_ident = Id.of_string "H"
exception Found of constr * types
-let prepare_hint check env init (sigma,c) =
+let prepare_hint check (poly,local) env init (sigma,c) =
let sigma = Typeclasses.resolve_typeclasses ~fail:false env sigma in
(* We re-abstract over uninstantiated evars.
It is actually a bit stupid to generalize over evars since the first
@@ -1082,15 +1082,18 @@ let prepare_hint check env init (sigma,c) =
let c' = iter c in
if check then Evarutil.check_evars (Global.env()) Evd.empty sigma c';
let diff = Univ.ContextSet.diff (Evd.universe_context_set sigma) (Evd.universe_context_set init) in
- IsConstr (c', diff)
+ if poly then IsConstr (c', diff)
+ else if local then IsConstr (c', diff)
+ else (Global.push_context_set false diff;
+ IsConstr (c', Univ.ContextSet.empty))
let interp_hints poly =
fun h ->
let env = (Global.env()) in
let sigma = Evd.from_env env in
- let f c =
+ let f poly c =
let evd,c = Constrintern.interp_open_constr env sigma c in
- prepare_hint true (Global.env()) Evd.empty (evd,c) in
+ prepare_hint true (poly,false) (Global.env()) Evd.empty (evd,c) in
let fref r =
let gr = global_with_alias r in
Dumpglob.add_glob (loc_of_reference r) gr;
@@ -1103,7 +1106,7 @@ let interp_hints poly =
| HintsReference c ->
let gr = global_with_alias c in
(PathHints [gr], poly, IsGlobRef gr)
- | HintsConstr c -> (PathAny, poly, f c)
+ | HintsConstr c -> (PathAny, poly, f poly c)
in
let fres (pri, b, r) =
let path, poly, gr = fi r in
@@ -1159,7 +1162,7 @@ let expand_constructor_hints env sigma lems =
(fun i -> IsConstr (mkConstructU ((ind,i+1),u),
Univ.ContextSet.empty))
| _ ->
- [prepare_hint false env sigma (evd,lem)]) lems
+ [prepare_hint false (false,true) env sigma (evd,lem)]) lems
(* builds a hint database from a constr signature *)
(* typically used with (lid, ltyp) = pf_hyps_types <some goal> *)
diff --git a/tactics/hints.mli b/tactics/hints.mli
index 5a4fb77091..e25b66b27b 100644
--- a/tactics/hints.mli
+++ b/tactics/hints.mli
@@ -151,8 +151,9 @@ val interp_hints : polymorphic -> hints_expr -> hints_entry
val add_hints : locality_flag -> hint_db_name list -> hints_entry -> unit
-val prepare_hint : bool (* Check no remaining evars *) -> env -> evar_map ->
- open_constr -> hint_term
+val prepare_hint : bool (* Check no remaining evars *) ->
+ (bool * bool) (* polymorphic or monomorphic, local or global *) ->
+ env -> evar_map -> open_constr -> hint_term
(** [make_exact_entry pri (c, ctyp)].
[c] is the term given as an exact proof to solve the goal;