Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

More reasonable implementation of add_resolve_to_db. #109

Merged
merged 1 commit into from
Apr 11, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion src/Common/Tactics/hint_db_extra_plugin.mlg.v819
Original file line number Diff line number Diff line change
Expand Up @@ -16,5 +16,5 @@ TACTIC EXTEND foreach_db

TACTIC EXTEND addto_db
| [ "add" constr(name) "to" ne_preident_list(l) ] ->
{ WITH_DB.add_resolve_to_db (Hints.hint_constr (name, None)) l }
{ WITH_DB.add_resolve_to_db name l }
END
16 changes: 11 additions & 5 deletions src/Common/Tactics/hint_db_extra_tactics.ml.v819
Original file line number Diff line number Diff line change
Expand Up @@ -41,10 +41,16 @@ module WITH_DB =
end

let add_resolve_to_db lem db =
Proofview.Goal.enter begin
fun gl ->
let _ = Hints.add_hints ~locality:Hints.Local db (Hints.HintsResolveEntry [({ Typeclasses.hint_priority = Some 1 ; Typeclasses.hint_pattern = None }, true, lem)]) in
tclIDTAC
end
Proofview.Goal.enter begin fun gl ->
let sigma = Proofview.Goal.sigma gl in
(* Tolerate applications to please tclABSTRACT in a section *)
let lem, _ = EConstr.decompose_app sigma lem in
match EConstr.destRef sigma lem with
| gr, _ ->
let lem = Hints.hint_globref gr in
let () = Hints.add_hints ~locality:Hints.Local db (Hints.HintsResolveEntry [({ Typeclasses.hint_priority = Some 1 ; Typeclasses.hint_pattern = None }, true, lem)]) in
tclIDTAC
| exception Constr.DestKO -> tclFAIL (Pp.str "Cannot add non-global to hint database")
end

end
Loading