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 /ltac | |
| 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 'ltac')
| -rw-r--r-- | ltac/extratactics.ml4 | 3 | ||||
| -rw-r--r-- | ltac/rewrite.ml | 8 |
2 files changed, 6 insertions, 5 deletions
diff --git a/ltac/extratactics.ml4 b/ltac/extratactics.ml4 index d0318fb5f..063bfbe6d 100644 --- a/ltac/extratactics.ml4 +++ b/ltac/extratactics.ml4 @@ -316,7 +316,8 @@ let project_hint pri l2r r = in let ctx = Evd.universe_context_set sigma in let c = Declare.declare_definition ~internal:Declare.InternalTacticRequest id (c,ctx) in - (pri,false,true,Hints.PathAny, Hints.IsGlobRef (Globnames.ConstRef c)) + let info = Vernacexpr.({hint_priority = pri; hint_pattern = None}) in + (info,false,true,Hints.PathAny, Hints.IsGlobRef (Globnames.ConstRef c)) let add_hints_iff l2r lc n bl = Hints.add_hints true bl diff --git a/ltac/rewrite.ml b/ltac/rewrite.ml index 4d7c5d0e4..44efdd383 100644 --- a/ltac/rewrite.ml +++ b/ltac/rewrite.ml @@ -1788,7 +1788,7 @@ let declare_instance a aeq n s = declare_an_instance n s [a;aeq] let anew_instance global binders instance fields = new_instance (Flags.is_universe_polymorphism ()) binders instance (Some (true, CRecord (Loc.ghost,fields))) - ~global ~generalize:false ~refine:false None + ~global ~generalize:false ~refine:false Hints.empty_hint_info let declare_instance_refl global binders a aeq n lemma = let instance = declare_instance a aeq (add_suffix n "_Reflexive") "Coq.Classes.RelationClasses.Reflexive" @@ -1969,7 +1969,7 @@ let add_morphism_infer glob m n = Decl_kinds.IsAssumption Decl_kinds.Logical) in add_instance (Typeclasses.new_instance - (Lazy.force PropGlobal.proper_class) None glob + (Lazy.force PropGlobal.proper_class) Hints.empty_hint_info glob poly (ConstRef cst)); declare_projection n instance_id (ConstRef cst) else @@ -1980,7 +1980,7 @@ let add_morphism_infer glob m n = let hook _ = function | Globnames.ConstRef cst -> add_instance (Typeclasses.new_instance - (Lazy.force PropGlobal.proper_class) None + (Lazy.force PropGlobal.proper_class) Hints.empty_hint_info glob poly (ConstRef cst)); declare_projection n instance_id (ConstRef cst) | _ -> assert false @@ -2004,7 +2004,7 @@ let add_morphism glob binders m s n = let tac = Tacinterp.interp (make_tactic "add_morphism_tactic") in ignore(new_instance ~global:glob poly binders instance (Some (true, CRecord (Loc.ghost,[]))) - ~generalize:false ~tac ~hook:(declare_projection n instance_id) None) + ~generalize:false ~tac ~hook:(declare_projection n instance_id) Hints.empty_hint_info) (** Bind to "rewrite" too *) |