Skip to content

Commit b81eaee

Browse files
authored
Merge branch 'master' into namegen
2 parents b700610 + 7a5e4bc commit b81eaee

File tree

3 files changed

+39
-17
lines changed

3 files changed

+39
-17
lines changed

Changelog.md

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -11,6 +11,7 @@
1111
has been given by the user or computed by `coq`
1212
- Change `tc-instance`, now the type is `gref -> tc-priority -> tc-instance` i.e. the priority is not an integer anymore
1313
- New `coq.ltac.fresh-id` to generate fresh names in the proof context
14+
- New `@no-tc!` attribute supported by `coq.ltac.call-ltac1`
1415

1516
### Apps
1617
- New `tc` app providing an implementation of a type class solver written in elpi.

coq-builtin.elpi

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1561,6 +1561,8 @@ external pred coq.ltac.collect-goals i:term, o:list sealed-goal,
15611561
% of type ltac1-tactic, see the tac argument constructor
15621562
% and the ltac_tactic:(...) syntax to pass arguments to
15631563
% an elpi tactic.
1564+
% Supported attributes:
1565+
% - @no-tc! (default false, do not infer typeclasses)
15641566
external pred coq.ltac.call-ltac1 i:any, i:goal, o:list sealed-goal.
15651567

15661568
% [coq.ltac.id-free? ID G]

src/coq_elpi_builtins.ml

Lines changed: 36 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -90,6 +90,18 @@ let with_pp_options o f =
9090
Detyping.print_evar_arguments := print_evar_arguments;
9191
raise reraise
9292

93+
let with_no_tc ~no_tc f sigma =
94+
if no_tc then
95+
let typeclass_evars = Evd.get_typeclass_evars sigma in
96+
let sigma = Evd.set_typeclass_evars sigma Evar.Set.empty in
97+
let sigma, rc = f sigma in
98+
let typeclass_evars = Evar.Set.filter (fun x ->
99+
try ignore (Evd.find_undefined sigma x); true
100+
with Not_found -> false) typeclass_evars in
101+
let sigma = Evd.set_typeclass_evars sigma typeclass_evars in
102+
sigma, rc
103+
else f sigma
104+
93105
let pr_econstr_env options env sigma t =
94106
with_pp_options options.pp (fun () ->
95107
let expr = Constrextern.extern_constr env sigma t in
@@ -3718,10 +3730,14 @@ fold_left over the terms, letin body comes before the type).
37183730
Tac can either be a string (the tactic name), or a value
37193731
of type ltac1-tactic, see the tac argument constructor
37203732
and the ltac_tactic:(...) syntax to pass arguments to
3721-
an elpi tactic.|})))),
3733+
an elpi tactic.
3734+
Supported attributes:
3735+
- @no-tc! (default false, do not infer typeclasses)|})))),
37223736
(fun tac (proof_context,goal,tac_args) _ ~depth _ _ -> abstract__grab_global_env_keep_sigma "coq.ltac.call-ltac1" (fun state ->
3737+
let no_tc = if proof_context.options.no_tc = Some true then true else false in
37233738
let open Ltac_plugin in
37243739
let sigma = get_sigma state in
3740+
37253741
let tac_args = tac_args |> List.map (function
37263742
| Coq_elpi_arg_HOAS.Ctrm t -> Tacinterp.Value.of_constr t
37273743
| Coq_elpi_arg_HOAS.Cstr s -> Geninterp.(Val.inject (val_tag (Genarg.topwit Stdarg.wit_string))) s
@@ -3748,25 +3764,28 @@ an elpi tactic.|})))),
37483764
| _ -> U.type_error ("coq.ltac.call-ltac1: string or ltac1-tactic are expected as the tactic to call")
37493765
in
37503766
Tacinterp.Value.apply tac tac_args in
3751-
let subgoals, sigma =
3767+
let sigma, subgoals =
37523768
let open Proofview in let open Notations in
37533769
let focused_tac =
37543770
Unsafe.tclSETGOALS [with_empty_state goal] <*> tactic in
3755-
let _, pv = init sigma [] in
3756-
let (), pv, _, _ =
3757-
let vernac_state = Vernacstate.freeze_full_state () in
3758-
try
3759-
let rc = apply ~name:(Id.of_string "elpi") ~poly:false proof_context.env focused_tac pv in
3760-
let pstate = Vernacstate.Stm.pstate (Vernacstate.freeze_full_state ()) in
3761-
let vernac_state = Vernacstate.Stm.set_pstate vernac_state pstate in
3762-
Vernacstate.unfreeze_full_state vernac_state;
3763-
rc
3764-
with e when CErrors.noncritical e ->
3765-
Vernacstate.unfreeze_full_state vernac_state;
3766-
Feedback.msg_debug (CErrors.print e);
3767-
raise Pred.No_clause
3768-
in
3769-
proofview pv in
3771+
with_no_tc ~no_tc (fun sigma ->
3772+
let _, pv = init sigma [] in
3773+
let (), pv, _, _ =
3774+
let vernac_state = Vernacstate.freeze_full_state () in
3775+
try
3776+
let rc = apply ~name:(Id.of_string "elpi") ~poly:false proof_context.env focused_tac pv in
3777+
let pstate = Vernacstate.Stm.pstate (Vernacstate.freeze_full_state ()) in
3778+
let vernac_state = Vernacstate.Stm.set_pstate vernac_state pstate in
3779+
Vernacstate.unfreeze_full_state vernac_state;
3780+
rc
3781+
with e when CErrors.noncritical e ->
3782+
Vernacstate.unfreeze_full_state vernac_state;
3783+
Feedback.msg_debug (CErrors.print e);
3784+
raise Pred.No_clause
3785+
in
3786+
let subgoals, sigma = proofview pv in
3787+
sigma, subgoals)
3788+
sigma in
37703789

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

0 commit comments

Comments
 (0)