Use the Hook module here and there.

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@16510 85f007b7-540e-0410-9357-904b9bb8a0f7

2 files changed, 17 insertions, 24 deletions

diff --git a/pretyping/typeclasses.ml b/pretyping/typeclasses.ml
index 4dc6280f12..24b084e9b8 100644
--- a/pretyping/typeclasses.ml
+++ b/pretyping/typeclasses.ml
@@ -21,24 +21,17 @@ open Libobject
 (*i*)
 
 
-let add_instance_hint_ref = ref (fun id path local pri -> assert false)
-let register_add_instance_hint =
-  (:=) add_instance_hint_ref
-let add_instance_hint id = !add_instance_hint_ref id
-
-let remove_instance_hint_ref = ref (fun id -> assert false)
-let register_remove_instance_hint =
-  (:=) remove_instance_hint_ref
-let remove_instance_hint id = !remove_instance_hint_ref id
-
-let set_typeclass_transparency_ref = ref (fun id local c -> assert false)
-let register_set_typeclass_transparency =
-  (:=) set_typeclass_transparency_ref
-let set_typeclass_transparency gr local c = !set_typeclass_transparency_ref gr local c
-
-let classes_transparent_state_ref = ref (fun () -> assert false)
-let register_classes_transparent_state = (:=) classes_transparent_state_ref
-let classes_transparent_state () = !classes_transparent_state_ref ()
+let (add_instance_hint, add_instance_hint_hook) = Hook.make ()
+let add_instance_hint id = Hook.get add_instance_hint id
+
+let (remove_instance_hint, remove_instance_hint_hook) = Hook.make ()
+let remove_instance_hint id = Hook.get remove_instance_hint id
+
+let (set_typeclass_transparency, set_typeclass_transparency_hook) = Hook.make ()
+let set_typeclass_transparency gr local c = Hook.get set_typeclass_transparency gr local c
+
+let (classes_transparent_state, classes_transparent_state_hook) = Hook.make ()
+let classes_transparent_state () = Hook.get classes_transparent_state ()
 
 let solve_instanciation_problem = ref (fun _ _ _ -> assert false)
 
diff --git a/pretyping/typeclasses.mli b/pretyping/typeclasses.mli
index 46877a58ff..c8f41841a6 100644
--- a/pretyping/typeclasses.mli
+++ b/pretyping/typeclasses.mli
@@ -98,16 +98,16 @@ val resolve_typeclasses : ?filter:evar_filter -> ?split:bool -> ?fail:bool ->
   env -> evar_map -> evar_map
 val resolve_one_typeclass : env -> evar_map -> types -> open_constr
 
-val register_set_typeclass_transparency : (evaluable_global_reference -> bool (*local?*) -> bool -> unit) -> unit
+val set_typeclass_transparency_hook : (evaluable_global_reference -> bool (*local?*) -> bool -> unit) Hook.t
 val set_typeclass_transparency : evaluable_global_reference -> bool -> bool -> unit
 
-val register_classes_transparent_state : (unit -> transparent_state) -> unit
+val classes_transparent_state_hook : (unit -> transparent_state) Hook.t
 val classes_transparent_state : unit -> transparent_state
 
-val register_add_instance_hint : 
-  (global_reference_or_constr -> global_reference list -> 
-   bool (* local? *) -> int option -> unit) -> unit
-val register_remove_instance_hint : (global_reference -> unit) -> unit
+val add_instance_hint_hook : 
+  (global_reference_or_constr -> global_reference list ->
+   bool (* local? *) -> int option -> unit) Hook.t
+val remove_instance_hint_hook : (global_reference -> unit) Hook.t
 val add_instance_hint : global_reference_or_constr -> global_reference list -> 
   bool -> int option -> unit
 val remove_instance_hint : global_reference -> unit