diff options
| author | Pierre-Marie Pédrot | 2020-10-04 16:16:53 +0200 |
|---|---|---|
| committer | Pierre-Marie Pédrot | 2020-11-04 13:43:57 +0100 |
| commit | f4c1b8b9ffdb5e531685130824fc4ce03a3e9794 (patch) | |
| tree | b68dcc1bd537c1108d2aa92642bca3b2725c9333 | |
| parent | be332604f4d495ea875185ff1b5aee1eb12b4178 (diff) | |
Do not try to be clever for term-as-hint interpretation.
The prepare_hint function was trying to requantify over all undefined evars,
but actually this should not happen when defining generic terms as hints through
some Hint vernacular command.
| -rw-r--r-- | tactics/hints.ml | 8 | ||||
| -rw-r--r-- | tactics/hints.mli | 5 | ||||
| -rw-r--r-- | vernac/comHints.ml | 18 |
3 files changed, 17 insertions, 14 deletions
diff --git a/tactics/hints.ml b/tactics/hints.ml index 2bff610b00..68229dbe26 100644 --- a/tactics/hints.ml +++ b/tactics/hints.ml @@ -1349,13 +1349,7 @@ let add_hints ~locality dbnames h = let hint_globref gr = IsGlobRef gr -let hint_constr env sigma ~poly c = - let c, diff = prepare_hint true env sigma c in - let diff, uctx = - if poly then Some diff, Univ.ContextSet.empty - else None, diff - in - IsConstr (c, diff), uctx +let hint_constr (c, diff) = IsConstr (c, diff) let expand_constructor_hints env sigma lems = List.map_append (fun (evd,lem) -> diff --git a/tactics/hints.mli b/tactics/hints.mli index eb0f937302..3d4d9c7970 100644 --- a/tactics/hints.mli +++ b/tactics/hints.mli @@ -199,9 +199,8 @@ val add_hints : locality:Goptions.option_locality -> hint_db_name list -> hints_ val hint_globref : GlobRef.t -> hint_term -val hint_constr : - env -> evar_map -> poly:bool -> evar_map * constr -> hint_term * Univ.ContextSet.t - [@ocaml.deprecated "Declare a hint constant instead"] +val hint_constr : constr * Univ.ContextSet.t option -> hint_term +[@ocaml.deprecated "Declare a hint constant instead"] (** A constr which is Hint'ed will be: - (1) used as an Exact, if it does not start with a product diff --git a/vernac/comHints.ml b/vernac/comHints.ml index 6cc1940b40..0d32f28d79 100644 --- a/vernac/comHints.ml +++ b/vernac/comHints.ml @@ -101,10 +101,20 @@ let interp_hints ~poly h = let () = warn_deprecated_hint_constr () in let env = Global.env () in let sigma = Evd.from_env env in - let evd, c = Constrintern.interp_open_constr env sigma c in - let h, diff = Hints.hint_constr env sigma ~poly (evd, c) in - let () = DeclareUctx.declare_universe_context ~poly:false diff [@ocaml.warning "-3"] in - (PathAny, h) + let sigma, c = Constrintern.interp_open_constr env sigma c in + let sigma = Typeclasses.resolve_typeclasses ~fail:false env sigma in + let sigma, _ = Evd.nf_univ_variables sigma in + let c = Evarutil.nf_evar sigma c in + let c = Termops.drop_extra_implicit_args sigma c in + let () = Pretyping.check_evars env sigma c in + let diff = Evd.universe_context_set sigma in + let c = + if poly then (c, Some diff) + else + let () = DeclareUctx.declare_universe_context ~poly:false diff in + (c, None) + in + (PathAny, Hints.hint_constr c) [@ocaml.warning "-3"] in let fp = Constrintern.intern_constr_pattern env sigma in let fres (info, b, r) = |
