@@ -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
538539let warning_tc_hints = CWarnings. create ~name: " TC.hints" ~category: elpi_cat Pp. str
539540
541+
540542let 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
566569type 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