Skip to content

Commit

Permalink
more API support @no-tc!
Browse files Browse the repository at this point in the history
  • Loading branch information
gares committed Nov 27, 2023
1 parent 8f75bcb commit b2252e4
Show file tree
Hide file tree
Showing 3 changed files with 39 additions and 17 deletions.
1 change: 1 addition & 0 deletions Changelog.md
Original file line number Diff line number Diff line change
Expand Up @@ -10,6 +10,7 @@
- New `tc-priority`, contains the priority of an instance and if the priority
has been given by the user or computed by `coq`
- Change `tc-instance`, now the type is `gref -> tc-priority -> tc-instance` i.e. the priority is not an integer anymore
- New `@no-tc!` attribute supported by `coq.ltac.call-ltac1`

### Apps
- New `tc` app providing an implementation of a type class solver written in elpi.
Expand Down
2 changes: 2 additions & 0 deletions coq-builtin.elpi
Original file line number Diff line number Diff line change
Expand Up @@ -1561,6 +1561,8 @@ external pred coq.ltac.collect-goals i:term, o:list sealed-goal,
% of type ltac1-tactic, see the tac argument constructor
% and the ltac_tactic:(...) syntax to pass arguments to
% an elpi tactic.
% Supported attributes:
% - @no-tc! (default false, do not infer typeclasses)
external pred coq.ltac.call-ltac1 i:any, i:goal, o:list sealed-goal.

% [coq.ltac.id-free? ID G]
Expand Down
53 changes: 36 additions & 17 deletions src/coq_elpi_builtins.ml
Original file line number Diff line number Diff line change
Expand Up @@ -90,6 +90,18 @@ let with_pp_options o f =
Detyping.print_evar_arguments := print_evar_arguments;
raise reraise

let with_no_tc ~no_tc f sigma =
if no_tc then
let typeclass_evars = Evd.get_typeclass_evars sigma in
let sigma = Evd.set_typeclass_evars sigma Evar.Set.empty in
let sigma, rc = f sigma in
let typeclass_evars = Evar.Set.filter (fun x ->
try ignore (Evd.find_undefined sigma x); true
with Not_found -> false) typeclass_evars in
let sigma = Evd.set_typeclass_evars sigma typeclass_evars in
sigma, rc
else f sigma

let pr_econstr_env options env sigma t =
with_pp_options options.pp (fun () ->
let expr = Constrextern.extern_constr env sigma t in
Expand Down Expand Up @@ -3718,10 +3730,14 @@ fold_left over the terms, letin body comes before the type).
Tac can either be a string (the tactic name), or a value
of type ltac1-tactic, see the tac argument constructor
and the ltac_tactic:(...) syntax to pass arguments to
an elpi tactic.|})))),
an elpi tactic.
Supported attributes:
- @no-tc! (default false, do not infer typeclasses)|})))),
(fun tac (proof_context,goal,tac_args) _ ~depth _ _ -> abstract__grab_global_env_keep_sigma "coq.ltac.call-ltac1" (fun state ->
let no_tc = if proof_context.options.no_tc = Some true then true else false in
let open Ltac_plugin in
let sigma = get_sigma state in

let tac_args = tac_args |> List.map (function
| Coq_elpi_arg_HOAS.Ctrm t -> Tacinterp.Value.of_constr t
| Coq_elpi_arg_HOAS.Cstr s -> Geninterp.(Val.inject (val_tag (Genarg.topwit Stdarg.wit_string))) s
Expand All @@ -3748,25 +3764,28 @@ an elpi tactic.|})))),
| _ -> U.type_error ("coq.ltac.call-ltac1: string or ltac1-tactic are expected as the tactic to call")
in
Tacinterp.Value.apply tac tac_args in
let subgoals, sigma =
let sigma, subgoals =
let open Proofview in let open Notations in
let focused_tac =
Unsafe.tclSETGOALS [with_empty_state goal] <*> tactic in
let _, pv = init sigma [] in
let (), pv, _, _ =
let vernac_state = Vernacstate.freeze_full_state () in
try
let rc = apply ~name:(Id.of_string "elpi") ~poly:false proof_context.env focused_tac pv in
let pstate = Vernacstate.Stm.pstate (Vernacstate.freeze_full_state ()) in
let vernac_state = Vernacstate.Stm.set_pstate vernac_state pstate in
Vernacstate.unfreeze_full_state vernac_state;
rc
with e when CErrors.noncritical e ->
Vernacstate.unfreeze_full_state vernac_state;
Feedback.msg_debug (CErrors.print e);
raise Pred.No_clause
in
proofview pv in
with_no_tc ~no_tc (fun sigma ->
let _, pv = init sigma [] in
let (), pv, _, _ =
let vernac_state = Vernacstate.freeze_full_state () in
try
let rc = apply ~name:(Id.of_string "elpi") ~poly:false proof_context.env focused_tac pv in
let pstate = Vernacstate.Stm.pstate (Vernacstate.freeze_full_state ()) in
let vernac_state = Vernacstate.Stm.set_pstate vernac_state pstate in
Vernacstate.unfreeze_full_state vernac_state;
rc
with e when CErrors.noncritical e ->
Vernacstate.unfreeze_full_state vernac_state;
Feedback.msg_debug (CErrors.print e);
raise Pred.No_clause
in
let subgoals, sigma = proofview pv in
sigma, subgoals)
sigma in

Declare.Internal.export_side_effects (Evd.eval_side_effects sigma);

Expand Down

0 comments on commit b2252e4

Please sign in to comment.