aboutsummaryrefslogtreecommitdiffhomepage
path: root/pretyping
diff options
context:
space:
mode:
Diffstat (limited to 'pretyping')
-rw-r--r--pretyping/pretyping.ml17
-rw-r--r--pretyping/pretyping.mli6
2 files changed, 18 insertions, 5 deletions
diff --git a/pretyping/pretyping.ml b/pretyping/pretyping.ml
index 75fda97b8..e72394fa2 100644
--- a/pretyping/pretyping.ml
+++ b/pretyping/pretyping.ml
@@ -564,7 +564,17 @@ let new_type_evar env evdref loc =
evdref := Sigma.to_evar_map sigma;
e
-let (f_genarg_interp, genarg_interp_hook) = Hook.make ()
+module ConstrInterpObj =
+struct
+ type ('r, 'g, 't) obj =
+ unbound_ltac_var_map -> env -> evar_map -> types -> 'g -> constr * evar_map
+ let name = "constr_interp"
+ let default _ = None
+end
+
+module ConstrInterp = Genarg.Register(ConstrInterpObj)
+
+let register_constr_interp0 = ConstrInterp.register0
(* [pretype tycon env evdref lvar lmeta cstr] attempts to type [cstr] *)
(* in environment [env], with existential variables [evdref] and *)
@@ -625,8 +635,11 @@ let rec pretype k0 resolve_tc (tycon : type_constraint) (env : ExtraEnv.t) evdre
| Some ty -> ty
| None ->
new_type_evar env evdref loc in
+ let open Genarg in
let ist = lvar.ltac_genargs in
- let (c, sigma) = Hook.get f_genarg_interp ty env.ExtraEnv.env !evdref ist arg in
+ let GenArg (Glbwit tag, arg) = arg in
+ let interp = ConstrInterp.obj tag in
+ let (c, sigma) = interp ist env.ExtraEnv.env !evdref ty arg in
let () = evdref := sigma in
{ uj_val = c; uj_type = ty }
diff --git a/pretyping/pretyping.mli b/pretyping/pretyping.mli
index 79fafcf1a..dcacd0720 100644
--- a/pretyping/pretyping.mli
+++ b/pretyping/pretyping.mli
@@ -163,6 +163,6 @@ val ise_pretype_gen :
val interp_sort : ?loc:Loc.t -> evar_map -> glob_sort -> evar_map * sorts
val interp_elimination_sort : glob_sort -> sorts_family
-val genarg_interp_hook :
- (types -> env -> evar_map -> unbound_ltac_var_map ->
- Genarg.glob_generic_argument -> constr * evar_map) Hook.t
+val register_constr_interp0 :
+ ('r, 'g, 't) Genarg.genarg_type ->
+ (unbound_ltac_var_map -> env -> evar_map -> types -> 'g -> constr * evar_map) -> unit