Simplify interface - move Implementation at toplevel

Since the module interfaces trait and implementation are recursive
otherwise, use the module0 pattern (rather than actual recursive
modules).

src/provider.ml

@@ -46,32 +46,29 @@ module Trait = struct
 
   let compare_by_uid id1 id2 = Uid.compare (uid id1) (uid id2)
   let same (id1 : _ t) (id2 : _ t) = phys_same id1 id2
+  let implement = Implementation0.implement
+end
 
-  module Implementation = struct
-    type ('t, 'module_type, 'tag) trait = ('t, 'module_type, 'tag) t
-
-    type 'a t = 'a Implementation0.t = private
-      | T :
-          { trait : ('t, 'module_type, _) trait
-          ; impl : 'module_type
-          }
-          -> 't t
-
-    let uid (T { trait; impl = _ }) = uid trait
-    let info (T { trait; impl = _ }) = info trait
+module Implementation = struct
+  type 'a t = 'a Implementation0.t = private
+    | T :
+        { trait : ('t, 'module_type, _) Trait.t
+        ; impl : 'module_type
+        }
+        -> 't t
 
-    let compare_by_uid (T { trait = id1; _ }) (T { trait = id2; _ }) =
-      compare_by_uid id1 id2
-    ;;
-  end
+  let uid (T { trait; impl = _ }) = Trait.uid trait
+  let info (T { trait; impl = _ }) = Trait.info trait
 
-  let implement = Implementation0.implement
+  let compare_by_uid (T { trait = id1; _ }) (T { trait = id2; _ }) =
+    Trait.compare_by_uid id1 id2
+  ;;
 end
 
 module Interface = struct
   (* We sort the element by their extension_id in increasing order. Element.(0)
      is a cache of the most recently looked up method. *)
-  type ('t, -'tags) t = 't Trait.Implementation.t array
+  type ('t, -'tags) t = 't Implementation.t array
 
   let dedup_sorted_keep_last =
     let[@tail_mod_cons] rec aux list ~cmp =
@@ -84,11 +81,11 @@ module Interface = struct
     aux
   ;;
 
-  let make (type a) (implementations : a Trait.Implementation.t list) : (a, _) t =
+  let make (type a) (implementations : a Implementation.t list) : (a, _) t =
     let implementations =
       implementations
-      |> List.stable_sort ~cmp:Trait.Implementation.compare_by_uid
-      |> dedup_sorted_keep_last ~cmp:Trait.Implementation.compare_by_uid
+      |> List.stable_sort ~cmp:Implementation.compare_by_uid
+      |> dedup_sorted_keep_last ~cmp:Implementation.compare_by_uid
     in
     match implementations with
     | [] -> [||]
@@ -104,11 +101,11 @@ module Interface = struct
     then false
     else
       Array.for_alli t1 ~f:(fun i implementation ->
-        i = 0 || 0 = Trait.Implementation.compare_by_uid implementation t2.(i))
+        i = 0 || 0 = Implementation.compare_by_uid implementation t2.(i))
   ;;
 
   let is_empty t = Array.length t = 0
-  let cache t = if Array.length t = 0 then None else Some (Trait.Implementation.uid t.(0))
+  let cache t = if Array.length t = 0 then None else Some (Implementation.uid t.(0))
 
   let implementations t =
     match Array.to_list t with
@@ -134,7 +131,7 @@ module Interface = struct
     then if_not_found ~trait_info:(Trait.info trait)
     else (
       let mid = (from + to_) / 2 in
-      let (Trait.Implementation.T { trait = elt; impl } as implementation) = t.(mid) in
+      let (Implementation.T { trait = elt; impl } as implementation) = t.(mid) in
       match Trait.compare_by_uid elt trait |> Ordering.of_int with
       | Equal ->
         if update_cache then t.(0) <- implementation;
@@ -158,7 +155,7 @@ module Interface = struct
     if Array.length t = 0
     then if_not_found ~trait_info:(Trait.info trait)
     else (
-      let (Trait.Implementation.T { trait = cached_id; impl }) = t.(0) in
+      let (Implementation.T { trait = cached_id; impl }) = t.(0) in
       if Trait.same trait cached_id
       then if_found (Stdlib.Obj.magic impl)
       else

src/provider.mli

@@ -7,6 +7,7 @@
 
     The module is divided into several submodules:
     - {!module:Trait}: To identify and implement functionality.
+    - {!module:Implementation}: Represents an implementation for a trait.
     - {!module:Interface}: Manages the set of traits that a provider implements.
     - {!module:Private}: Used for testing purposes.
 
@@ -81,24 +82,6 @@ module Trait : sig
 
   val same : _ t -> _ t -> bool
 
-  module Implementation : sig
-    (** Representing an implementation for a trait. *)
-
-    type ('t, 'module_type, 'tag) trait := ('t, 'module_type, 'tag) t
-
-    type 'a t = 'a Implementation0.t = private
-      | T :
-          { trait : ('t, 'module_type, _) trait
-          ; impl : 'module_type
-          }
-          -> 't t
-
-    (** {1 Dump & debug} *)
-
-    val uid : _ t -> Uid.t
-    val info : _ t -> Info.t
-  end
-
   (** [implement trait ~impl:(module Impl)] says to implement [trait] with
       [Impl]. The module [Impl] provided must have the right module type as
       specified by the type of [trait].
@@ -108,7 +91,23 @@ module Trait : sig
       granularity of each trait. This means that the {!val:implement} function
       focuses solely on creating the implementation, without considering the
       tags that indicate which traits are supported by the provider. *)
-  val implement : ('t, 'module_type, _) t -> impl:'module_type -> 't Implementation.t
+  val implement : ('t, 'module_type, _) t -> impl:'module_type -> 't Implementation0.t
+end
+
+module Implementation : sig
+  (** Representing an implementation for a trait. *)
+
+  type 'a t = 'a Implementation0.t = private
+    | T :
+        { trait : ('t, 'module_type, _) Trait.t
+        ; impl : 'module_type
+        }
+        -> 't t
+
+  (** {1 Dump & debug} *)
+
+  val uid : _ t -> Trait.Uid.t
+  val info : _ t -> Trait.Info.t
 end
 
 module Interface : sig
@@ -152,18 +151,18 @@ module Interface : sig
       trait. This means that the resulting interface will not contain any
       duplicate traits, and the order of the implementations in the input list
       can affect its contents. *)
-  val make : 't Trait.Implementation.t list -> ('t, _) t
+  val make : 't Implementation.t list -> ('t, _) t
 
   (** [implementations t] returns a list of trait implementations that the
       interface [t] supports. See also {!extend}. *)
-  val implementations : ('t, _) t -> 't Trait.Implementation.t list
+  val implementations : ('t, _) t -> 't Implementation.t list
 
   (** [extend t ~with_] extends the interface [t] and returns a new interface
       that includes both the original and additional implementations. The
       resulting interface only contains the last occurrence of each trait,
       prioritizing the rightmost elements in the combined list
       [implementations t @ with_]. *)
-  val extend : ('t, _) t -> with_:'t Trait.Implementation.t list -> ('t, _) t
+  val extend : ('t, _) t -> with_:'t Implementation.t list -> ('t, _) t
 
   (** {1 Lookup}
 

test/test__introspection.ml

@@ -6,7 +6,7 @@
 let print_implemented_traits (Provider.T { t = _; interface }) =
   let info =
     List.map (Provider.Interface.implementations interface) ~f:(fun implementation ->
-      [%sexp (Provider.Trait.Implementation.info implementation : Provider.Trait.Info.t)])
+      [%sexp (Provider.Implementation.info implementation : Provider.Trait.Info.t)])
   in
   print_s [%sexp (info : Sexp.t list)]
 ;;

test/test__lookup.ml

@@ -151,7 +151,7 @@ end
 let uids (Provider.T { t = _; interface }) =
   interface
   |> Provider.Interface.implementations
-  |> List.map ~f:Provider.Trait.Implementation.uid
+  |> List.map ~f:Provider.Implementation.uid
   |> Set.of_list (module Uid)
 ;;
 

test/test__make_interface.ml

@@ -47,8 +47,8 @@ let%expect_test "make interface" =
      require_equal
        [%here]
        (module Provider.Trait.Uid)
-       (Provider.Trait.Implementation.uid c1)
-       (Provider.Trait.Implementation.uid trait1);
+       (Provider.Implementation.uid c1)
+       (Provider.Implementation.uid trait1);
      [%expect {||}]
    | _ -> assert false);
   let empty = Provider.Interface.make [] in

test/test__override.ml

@@ -26,8 +26,7 @@ let%expect_test "override" =
   let print_implemented_traits (Provider.T { t = _; interface }) =
     let info =
       List.map (Provider.Interface.implementations interface) ~f:(fun implementation ->
-        [%sexp
-          (Provider.Trait.Implementation.info implementation : Provider.Trait.Info.t)])
+        [%sexp (Provider.Implementation.info implementation : Provider.Trait.Info.t)])
     in
     print_s [%sexp (info : Sexp.t list)]
   in