Skip to content

Commit d03e821

Browse files
committed
small refactor
1 parent 1c767a2 commit d03e821

File tree

1 file changed

+13
-8
lines changed

1 file changed

+13
-8
lines changed

src/coq_elpi_builtins.ml

Lines changed: 13 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -514,14 +514,15 @@ let get_instance_prio gr env sigma (hint_priority : int option) : tc_priority =
514514
(* TODO: this algorithm is quite inefficient since we have not yet the
515515
possibility to get the implementation of an instance from its gref in
516516
coq. Currently we have to get all the instances of the tc and the find
517-
its implementation.
518-
NOTE: if we have coq's API to retrieve this implementation from the GlobRef of
519-
the instance the parameter tc will be useless
517+
its implementation.
520518
*)
521-
let get_instance (env: Environ.env) (sigma: Evd.evar_map) (tc : GlobRef.t) (instance : GlobRef.t) : type_class_instance =
519+
let get_isntances_of_tc env sigma (tc : GlobRef.t) =
522520
let inst_of_tc = (* contains all the instances of a type class *)
523521
Typeclasses.instances_exn env sigma tc |>
524522
List.fold_left (fun m i -> GlobRef.Map.add i.Typeclasses.is_impl i m) GlobRef.Map.empty in
523+
inst_of_tc
524+
525+
let get_instance env sigma inst_of_tc instance : type_class_instance =
525526
let instances_grefs2istance inst_gr : type_class_instance =
526527
let open Typeclasses in
527528
let user_hint_prio =
@@ -537,6 +538,7 @@ let get_instance (env: Environ.env) (sigma: Evd.evar_map) (tc : GlobRef.t) (inst
537538

538539
let warning_tc_hints = CWarnings.create ~name:"TC.hints" ~category:elpi_cat Pp.str
539540

541+
540542
let get_instances (env: Environ.env) (sigma: Evd.evar_map) tc : type_class_instance list =
541543
let hint_db = Hints.searchtable_map "typeclass_instances" in
542544
let secvars : Names.Id.Pred.t = Names.Id.Pred.full in
@@ -560,8 +562,9 @@ let get_instances (env: Environ.env) (sigma: Evd.evar_map) tc : type_class_insta
560562
| Constr.Ind (a, _) -> Some (Names.GlobRef.IndRef a)
561563
| Constr.Const (a, _) -> Some (Names.GlobRef.ConstRef a)
562564
| Constr.Construct (a, _) -> Some (Names.GlobRef.ConstructRef a)
563-
| _ -> None) constrs in
564-
List.map (get_instance env sigma tc) instances_grefs
565+
| _ -> None) constrs in
566+
let isnt_of_tc = get_isntances_of_tc env sigma tc in
567+
List.map (get_instance env sigma isnt_of_tc) instances_grefs
565568

566569
type scope = ExecutionSite | CurrentModule | Library
567570

@@ -2855,8 +2858,10 @@ Supported attributes:
28552858
In(gref, "InstGR",
28562859
Out(tc_priority, "InstPrio",
28572860
Read (global, "reads the priority of an instance")))),
2858-
(fun class_gr inst_gr _ ~depth { env } _ state ->
2859-
let {priority} = get_instance env (get_sigma state) class_gr inst_gr in
2861+
(fun class_gr inst_gr _ ~depth { env } _ state ->
2862+
let sigma = get_sigma state in
2863+
let inst_of_tc = get_isntances_of_tc env sigma class_gr in
2864+
let {priority} = get_instance env sigma inst_of_tc inst_gr in
28602865
!: priority)),
28612866
DocAbove);
28622867

0 commit comments

Comments
 (0)