Occurrence: change datastructure to capture more information

Signed-off-by: Paul-Elliot <[email protected]>

Author: panglesd

src/odoc/occurrences.ml

@@ -22,14 +22,109 @@ let fold_dirs ~dirs ~f ~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 } =
+          match H.find_opt htbl id with Some n -> n | None -> 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 ( >>= ) = Option.bind in
+    let do_ parent =
+      get t (parent :> key) >>= fun { sub; _ } -> H.find_opt sub 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
+    | `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 _ -> H.find_opt t id
+    | `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 =
   let htbl = H.create 100 in
   let f () (unit : Odoc_model.Lang.Compilation_unit.t) =
     let incr tbl p p' =
       let id = Odoc_model.Paths.Path.Resolved.(identifier (p :> t)) in
-      let old_value = match H.find_opt tbl id with Some n -> n | None -> 0 in
-      if not Odoc_model.Paths.Path.(is_hidden p') then
-        H.replace tbl id (old_value + 1)
+      if not Odoc_model.Paths.Path.(is_hidden p') then Occtbl.add tbl id
     in
     let () =
       List.iter

test/occurrences/double_wrapped.t/run.t

@@ -50,10 +50,11 @@ Uses of values Y.x and Z.y (in b.ml) are not counted since they come from a "loc
 Uses of values Main__.C.y and Main__.A.x are not rewritten since we use references instead of paths.
 
   $ occurrences_print occurrences.txt | sort
-  Main.A was used 4 times
-  Main.A.(||>) was used 1 times
-  Main.A.M was used 2 times
-  Main.A.t was used 1 times
-  Main.A.x was used 2 times
-  Main.B was used 1 times
-  string was used 1 times
+  Main was used directly 0 times and indirectly 11 times
+  Main.A was used directly 4 times and indirectly 6 times
+  Main.A.(||>) was used directly 1 times and indirectly 0 times
+  Main.A.M was used directly 2 times and indirectly 0 times
+  Main.A.t was used directly 1 times and indirectly 0 times
+  Main.A.x was used directly 2 times and indirectly 0 times
+  Main.B was used directly 1 times and indirectly 0 times
+  string was used directly 1 times and indirectly 0 times

test/odoc_print/dune

@@ -11,4 +11,4 @@
 (executable
  (name occurrences_print)
  (modules occurrences_print)
- (libraries odoc_model_desc compatcmdliner))
+ (libraries odoc_model_desc compatcmdliner odoc_odoc))

test/odoc_print/occurrences_print.ml

@@ -2,11 +2,14 @@ module H = Hashtbl.Make (Odoc_model.Paths.Identifier)
 
 let run inp =
   let ic = open_in_bin inp in
-  let htbl = Marshal.from_channel ic in
-  H.iter
-    (fun id occ ->
+  let htbl : Odoc_odoc.Occurrences.Occtbl.item Odoc_odoc.Occurrences.H.t =
+    Marshal.from_channel ic
+  in
+  Odoc_odoc.Occurrences.Occtbl.iter
+    (fun id { Odoc_odoc.Occurrences.Occtbl.direct; indirect; _ } ->
       let id = String.concat "." (Odoc_model.Paths.Identifier.fullname id) in
-      Format.printf "%s was used %d times\n" id occ)
+      Format.printf "%s was used directly %d times and indirectly %d times\n" id
+        direct indirect)
     htbl
 
 open Compatcmdliner