diff options
| author |  Matthieu Sozeau <mattam@mattam.org> | 2016-10-24 18:18:33 +0200 |
|---|---|---|
| committer | Matthieu Sozeau <mattam@mattam.org> | 2016-11-03 16:26:27 +0100 |
| commit | d6fe6773c959493ed97108e1032b1bd8c1e78081 (patch) | |
| tree | 69d1cb3e8aaf0b1800c0c09b22f70c162948f7d7 /tactics/class_tactics.ml | |
| parent | 6ec511721efc9235f6c2fa922a21dcb9b041bbfd (diff) | |
Lets Hints/Instances take an optional pattern
In addition to a priority, cleanup the interfaces for passing this
information as well. The pattern, if given, takes priority over the
inferred one.
We only allow Existing Instances gr ... gr | pri. for now, without
pattern, as before.
Make the API compatible to 8.5 as well.
Diffstat (limited to 'tactics/class_tactics.ml')
| -rw-r--r-- | tactics/class_tactics.ml | 18 |
1 files changed, 12 insertions, 6 deletions
diff --git a/tactics/class_tactics.ml b/tactics/class_tactics.ml index 9cb6b7fe7..da91674f5 100644 --- a/tactics/class_tactics.ml +++ b/tactics/class_tactics.ml @@ -539,10 +539,16 @@ let make_resolve_hyp env sigma st flags only_classes pri decl = let name = PathHints [VarRef id] in let hints = if is_class then - let hints = build_subclasses ~check:false env sigma (VarRef id) None in + let hints = build_subclasses ~check:false env sigma (VarRef id) empty_hint_info in (List.map_append - (fun (path,pri, c) -> make_resolves env sigma ~name:(PathHints path) - (true,false,Flags.is_verbose()) pri false + (fun (path,info,c) -> + let info = + { info with Vernacexpr.hint_pattern = + Option.map (Constrintern.intern_constr_pattern env) + info.Vernacexpr.hint_pattern } + in + make_resolves env sigma ~name:(PathHints path) + (true,false,Flags.is_verbose()) info false (IsConstr (c,Univ.ContextSet.empty))) hints) else [] @@ -567,7 +573,7 @@ let make_hints g st only_classes sign = in if consider then let hint = - pf_apply make_resolve_hyp g st (true,false,false) only_classes None hyp + pf_apply make_resolve_hyp g st (true,false,false) only_classes empty_hint_info hyp in hint @ hints else hints) ([]) sign @@ -636,7 +642,7 @@ module V85 = struct let env = Goal.V82.env s g' in let context = Environ.named_context_of_val (Goal.V82.hyps s g') in let hint = make_resolve_hyp env s (Hint_db.transparent_state info.hints) - (true,false,false) info.only_classes None (List.hd context) in + (true,false,false) info.only_classes empty_hint_info (List.hd context) in let ldb = Hint_db.add_list env s hint info.hints in (g', { info with is_evar = None; hints = ldb; auto_last_tac = lazy (str"intro") })) gls @@ -1140,7 +1146,7 @@ module Search = struct let decl = Tacmach.New.pf_last_hyp gl in let hint = make_resolve_hyp env s (Hint_db.transparent_state info.search_hints) - (true,false,false) info.search_only_classes None decl in + (true,false,false) info.search_only_classes empty_hint_info decl in let ldb = Hint_db.add_list env s hint info.search_hints in let info' = { info with search_hints = ldb; last_tac = lazy (str"intro") } |