Move occurrences to its own folder

Signed-off-by: Paul-Elliot <[email protected]>
panglesd · Feb 19, 2024 · a5447e0 · a5447e0
1 parent dfd97de
commit a5447e0
Show file tree

Hide file tree

Showing 8 changed files with 147 additions and 139 deletions.
diff --git a/src/occurrences/dune b/src/occurrences/dune
@@ -0,0 +1,4 @@
+(library
+ (name odoc_occurrences)
+ (public_name odoc.occurrences)
+ (libraries odoc_model))
diff --git a/src/occurrences/odoc_occurrences.ml b/src/occurrences/odoc_occurrences.ml
@@ -0,0 +1,26 @@
+module Table = Table
+
+let of_impl ~include_hidden unit htbl =
+  let incr tbl p =
+    let open Odoc_model.Paths.Path.Resolved in
+    let p = (p :> t) in
+    let id = identifier p in
+    if (not (is_hidden p)) || include_hidden then Table.add tbl id
+  in
+  let open Odoc_model.Lang in
+  List.iter
+    (function
+      | Source_info.Module { documentation = Some (`Resolved p); _ }, _ ->
+          incr htbl p
+      | Value { documentation = Some (`Resolved p); _ }, _ -> incr htbl p
+      | ModuleType { documentation = Some (`Resolved p); _ }, _ -> incr htbl p
+      | Type { documentation = Some (`Resolved p); _ }, _ -> incr htbl p
+      | _ -> ())
+    (match unit.Compilation_unit.source_info with
+    | None -> []
+    | Some i -> i.infos)
+
+let aggregate ~tbl ~data =
+  Table.iter
+    (fun id { Table.direct; _ } -> Table.add ~quantity:direct tbl id)
+    data
diff --git a/src/occurrences/odoc_occurrences.mli b/src/occurrences/odoc_occurrences.mli
@@ -0,0 +1,9 @@
+open Odoc_model.Lang
+
+module Table = Table
+
+val of_impl : include_hidden:bool -> Compilation_unit.t -> Table.t -> unit
+(** Add all occurrences from implementation of a compilation unit into a table *)
+
+val aggregate : tbl:Table.t -> data:Table.t -> unit
+(** Aggregate [data] into [tbl] *)
diff --git a/src/occurrences/table.ml b/src/occurrences/table.ml
@@ -0,0 +1,86 @@
+module H = Hashtbl.Make (Odoc_model.Paths.Identifier)
+
+type t = item H.t
+and item = { direct : int; indirect : int; sub : item H.t }
+type key = Odoc_model.Paths.Identifier.t
+
+let v_item () = { direct = 0; indirect = 0; sub = H.create 0 }
+
+let v () = H.create 0
+
+let add ?(quantity = 1) tbl id =
+  let rec add ?(kind = `Indirect) id =
+    let incr htbl id =
+      let { direct; indirect; sub } =
+        try H.find htbl id with Not_found -> v_item ()
+      in
+      let direct, indirect =
+        match kind with
+        | `Direct -> (direct + quantity, indirect)
+        | `Indirect -> (direct, indirect + quantity)
+      in
+      H.replace htbl id { direct; indirect; sub };
+      sub
+    in
+    let do_ parent =
+      let htbl = add (parent :> key) in
+      incr htbl id
+    in
+    match id.iv with
+    | `InstanceVariable (parent, _) -> do_ parent
+    | `Parameter (parent, _) -> do_ parent
+    | `Module (parent, _) -> do_ parent
+    | `ModuleType (parent, _) -> do_ parent
+    | `Method (parent, _) -> do_ parent
+    | `Field (parent, _) -> do_ parent
+    | `Extension (parent, _) -> do_ parent
+    | `Type (parent, _) -> do_ parent
+    | `CoreType _ -> incr tbl id
+    | `Constructor (parent, _) -> do_ parent
+    | `Exception (parent, _) -> do_ parent
+    | `ExtensionDecl (parent, _, _) -> do_ parent
+    | `Class (parent, _) -> do_ parent
+    | `Value (parent, _) -> do_ parent
+    | `ClassType (parent, _) -> do_ parent
+    | `Root _ -> incr tbl id
+    | `SourcePage _ | `Page _ | `LeafPage _ | `SourceLocation _
+    | `CoreException _ | `Label _ | `SourceLocationMod _ | `Result _
+    | `AssetFile _ | `SourceDir _ | `SourceLocationInternal _ ->
+        assert false
+  in
+  let _htbl = add ~kind:`Direct id in
+  ()
+
+let rec get t id =
+  let do_ parent =
+    get t (parent :> key) |> function
+    | None -> None
+    | Some { sub; _ } -> ( try Some (H.find sub id) with Not_found -> None)
+  in
+  match id.iv with
+  | `InstanceVariable (parent, _) -> do_ parent
+  | `Parameter (parent, _) -> do_ parent
+  | `Module (parent, _) -> do_ parent
+  | `ModuleType (parent, _) -> do_ parent
+  | `Method (parent, _) -> do_ parent
+  | `Field (parent, _) -> do_ parent
+  | `Extension (parent, _) -> do_ parent
+  | `ExtensionDecl (parent, _, _) -> do_ parent
+  | `Type (parent, _) -> do_ parent
+  | `Constructor (parent, _) -> do_ parent
+  | `Exception (parent, _) -> do_ parent
+  | `Class (parent, _) -> do_ parent
+  | `Value (parent, _) -> do_ parent
+  | `ClassType (parent, _) -> do_ parent
+  | `Root _ -> ( try Some (H.find t id) with Not_found -> None)
+  | `SourcePage _ | `Page _ | `LeafPage _ | `CoreType _ | `SourceLocation _
+  | `CoreException _ | `Label _ | `SourceLocationMod _ | `Result _
+  | `AssetFile _ | `SourceDir _ | `SourceLocationInternal _ ->
+      assert false
+
+let rec iter f tbl =
+  H.iter
+    (fun id v ->
+      iter f v.sub;
+      f id v)
+    tbl
diff --git a/src/occurrences/table.mli b/src/occurrences/table.mli
@@ -0,0 +1,11 @@
+type t
+type item = { direct : int; indirect : int; sub : t }
+type key = Odoc_model.Paths.Identifier.t
+
+val v : unit -> t
+
+val add : ?quantity:int -> t -> key -> unit
+
+val iter : (key -> item -> unit) -> t -> unit
+
+val get : t -> key -> item option
diff --git a/src/odoc/dune b/src/odoc/dune
@@ -12,6 +12,7 @@
   odoc_model
   odoc_json_index
   odoc_xref2
+  odoc_occurrences
   tyxml
   unix)
  (instrumentation

diff --git a/src/odoc/occurrences.ml b/src/odoc/occurrences.ml
@@ -21,130 +21,10 @@ let fold_dirs ~dirs ~f ~init =
            acc dir)
        (Ok init)
 
-module H = Hashtbl.Make (Odoc_model.Paths.Identifier)
-
-module Occtbl : sig
-  type item = { direct : int; indirect : int; sub : item H.t }
-  type t = item H.t
-  type key = Odoc_model.Paths.Identifier.t
-  val v : unit -> t
-
-  val add : t -> key -> unit
-
-  val iter : (key -> item -> unit) -> t -> unit
-
-  val get : t -> key -> item option
-end = struct
-  type item = { direct : int; indirect : int; sub : item H.t }
-  type t = item H.t
-  type key = Odoc_model.Paths.Identifier.t
-
-  let v_item () = { direct = 0; indirect = 0; sub = H.create 0 }
-
-  let v () = H.create 0
-
-  let add tbl id =
-    let rec add ?(kind = `Indirect) id =
-      let incr htbl id =
-        let { direct; indirect; sub } =
-          try H.find htbl id with Not_found -> v_item ()
-        in
-        let direct, indirect =
-          match kind with
-          | `Direct -> (direct + 1, indirect)
-          | `Indirect -> (direct, indirect + 1)
-        in
-        H.replace htbl id { direct; indirect; sub };
-        sub
-      in
-      let do_ parent =
-        let htbl = add (parent :> key) in
-        incr htbl id
-      in
-      match id.iv with
-      | `InstanceVariable (parent, _) -> do_ parent
-      | `Parameter (parent, _) -> do_ parent
-      | `Module (parent, _) -> do_ parent
-      | `ModuleType (parent, _) -> do_ parent
-      | `Method (parent, _) -> do_ parent
-      | `Field (parent, _) -> do_ parent
-      | `Extension (parent, _) -> do_ parent
-      | `Type (parent, _) -> do_ parent
-      | `CoreType _ -> incr tbl id
-      | `Constructor (parent, _) -> do_ parent
-      | `Exception (parent, _) -> do_ parent
-      | `ExtensionDecl (parent, _, _) -> do_ parent
-      | `Class (parent, _) -> do_ parent
-      | `Value (parent, _) -> do_ parent
-      | `ClassType (parent, _) -> do_ parent
-      | `Root _ -> incr tbl id
-      | `SourcePage _ | `Page _ | `LeafPage _ | `SourceLocation _
-      | `CoreException _ | `Label _ | `SourceLocationMod _ | `Result _
-      | `AssetFile _ | `SourceDir _ | `SourceLocationInternal _ ->
-          assert false
-    in
-    let _htbl = add ~kind:`Direct id in
-    ()
-
-  let rec get t id =
-    let do_ parent =
-      get t (parent :> key) |> function
-      | None -> None
-      | Some { sub; _ } -> ( try Some (H.find sub id) with Not_found -> None)
-    in
-    match id.iv with
-    | `InstanceVariable (parent, _) -> do_ parent
-    | `Parameter (parent, _) -> do_ parent
-    | `Module (parent, _) -> do_ parent
-    | `ModuleType (parent, _) -> do_ parent
-    | `Method (parent, _) -> do_ parent
-    | `Field (parent, _) -> do_ parent
-    | `Extension (parent, _) -> do_ parent
-    | `ExtensionDecl (parent, _, _) -> do_ parent
-    | `Type (parent, _) -> do_ parent
-    | `Constructor (parent, _) -> do_ parent
-    | `Exception (parent, _) -> do_ parent
-    | `Class (parent, _) -> do_ parent
-    | `Value (parent, _) -> do_ parent
-    | `ClassType (parent, _) -> do_ parent
-    | `Root _ -> ( try Some (H.find t id) with Not_found -> None)
-    | `SourcePage _ | `Page _ | `LeafPage _ | `CoreType _ | `SourceLocation _
-    | `CoreException _ | `Label _ | `SourceLocationMod _ | `Result _
-    | `AssetFile _ | `SourceDir _ | `SourceLocationInternal _ ->
-        assert false
-
-  let rec iter f tbl =
-    H.iter
-      (fun id v ->
-        iter f v.sub;
-        f id v)
-      tbl
-end
-
 let count ~dst ~warnings_options:_ directories include_hidden =
-  let htbl = H.create 100 in
+  let htbl = Odoc_occurrences.Table.v () in
   let f () (unit : Odoc_model.Lang.Compilation_unit.t) =
-    let incr tbl p =
-      let p = (p :> Odoc_model.Paths.Path.Resolved.t) in
-      let id = Odoc_model.Paths.Path.Resolved.identifier p in
-      if (not (Odoc_model.Paths.Path.Resolved.is_hidden p)) || include_hidden
-      then Occtbl.add tbl id
-    in
-    let () =
-      List.iter
-        (function
-          | ( Odoc_model.Lang.Source_info.Module
-                { documentation = Some (`Resolved p); _ },
-              _ ) ->
-              incr htbl p
-          | Value { documentation = Some (`Resolved p); _ }, _ -> incr htbl p
-          | ModuleType { documentation = Some (`Resolved p); _ }, _ ->
-              incr htbl p
-          | Type { documentation = Some (`Resolved p); _ }, _ -> incr htbl p
-          | _ -> ())
-        (match unit.source_info with None -> [] | Some i -> i.infos)
-    in
-    ()
+    Odoc_occurrences.of_impl ~include_hidden unit htbl
   in
   fold_dirs ~dirs:directories ~f ~init:() >>= fun () ->
   Fs.Directory.mkdir_p (Fs.File.dirname dst);
@@ -175,27 +55,18 @@ let aggregate files file_list ~warnings_options:_ ~dst =
   try
     parse_input_files file_list >>= fun new_files ->
     let files = files @ new_files in
-    let from_file file : Occtbl.t =
+    let from_file file : Odoc_occurrences.Table.t =
       let ic = open_in_bin (Fs.File.to_string file) in
       Marshal.from_channel ic
     in
-    let rec loop n f =
-      if n > 0 then (
-        f ();
-        loop (n - 1) f)
-      else ()
-    in
     let occtbl =
       match files with
-      | [] -> H.create 0
-      | file1 :: files ->
-          let acc = from_file file1 in
+      | [] -> Odoc_occurrences.Table.v ()
+      | file :: files ->
+          let acc = from_file file in
           List.iter
             (fun file ->
-              Occtbl.iter
-                (fun id { direct; _ } ->
-                  loop direct (fun () -> Occtbl.add acc id))
-                (from_file file))
+              Odoc_occurrences.aggregate ~tbl:acc ~data:(from_file file))
             files;
           acc
     in

diff --git a/test/odoc_print/occurrences_print.ml b/test/odoc_print/occurrences_print.ml
@@ -2,9 +2,9 @@ module H = Hashtbl.Make (Odoc_model.Paths.Identifier)
 
 let run inp =
   let ic = open_in_bin inp in
-  let htbl : Odoc_odoc.Occurrences.Occtbl.t = Marshal.from_channel ic in
-  Odoc_odoc.Occurrences.Occtbl.iter
-    (fun id { Odoc_odoc.Occurrences.Occtbl.direct; indirect; _ } ->
+  let htbl : Odoc_occurrences.Table.t = Marshal.from_channel ic in
+  Odoc_occurrences.Table.iter
+    (fun id { Odoc_occurrences.Table.direct; indirect; _ } ->
       let id = String.concat "." (Odoc_model.Paths.Identifier.fullname id) in
       Format.printf "%s was used directly %d times and indirectly %d times\n" id
         direct indirect)