Occurrences: detection of hidden modules should be more efficient

We consider as internal children of internal modules, and double underscored
roots.

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

Author: panglesd

src/model/paths.ml

@@ -19,6 +19,15 @@ module Ocaml_env = Env
 
 open Names
 
+let contains_double_underscore s =
+  let len = String.length s in
+  let rec aux i =
+    if i > len - 2 then false
+    else if s.[i] = '_' && s.[i + 1] = '_' then true
+    else aux (i + 1)
+  in
+  aux 0
+
 module Identifier = struct
   type 'a id = 'a Paths_types.id = { iv : 'a; ihash : int; ikey : string }
 
@@ -66,7 +75,9 @@ module Identifier = struct
   let rec is_internal : t -> bool =
    fun x ->
     match x.iv with
-    | `Root (_, name) -> ModuleName.is_internal name
+    | `Root (_, name) ->
+        ModuleName.is_internal name
+        || contains_double_underscore (ModuleName.to_string name)
     | `Page (_, _) -> false
     | `LeafPage (_, _) -> false
     | `Module (_, name) -> ModuleName.is_internal name
@@ -91,6 +102,36 @@ module Identifier = struct
     | `SourceLocationInternal _ | `AssetFile _ ->
         false
 
+  let rec is_internal_rec : t -> bool =
+   fun x ->
+    is_internal x
+    ||
+    match x.iv with
+    | `Root (_, name) -> ModuleName.is_internal name
+    | `Page (_, _) -> false
+    | `LeafPage (_, _) -> false
+    | `Module (parent, _) -> is_internal_rec (parent :> t)
+    | `Parameter (parent, _) -> is_internal_rec (parent :> t)
+    | `Result x -> is_internal_rec (x :> t)
+    | `ModuleType (parent, _) -> is_internal_rec (parent :> t)
+    | `Type (parent, _) -> is_internal_rec (parent :> t)
+    | `CoreType name -> TypeName.is_internal name
+    | `Constructor (parent, _) -> is_internal (parent :> t)
+    | `Field (parent, _) -> is_internal (parent :> t)
+    | `Extension (parent, _) -> is_internal (parent :> t)
+    | `ExtensionDecl (parent, _, _) -> is_internal (parent :> t)
+    | `Exception (parent, _) -> is_internal (parent :> t)
+    | `CoreException _ -> false
+    | `Value (parent, _) -> is_internal_rec (parent :> t)
+    | `Class (parent, _) -> is_internal_rec (parent :> t)
+    | `ClassType (parent, _) -> is_internal_rec (parent :> t)
+    | `Method (parent, _) -> is_internal (parent :> t)
+    | `InstanceVariable (parent, _) -> is_internal (parent :> t)
+    | `Label (parent, _) -> is_internal (parent :> t)
+    | `SourceDir _ | `SourceLocationMod _ | `SourceLocation _ | `SourcePage _
+    | `SourceLocationInternal _ | `AssetFile _ ->
+        false
+
   let name : [< t_pv ] id -> string = fun n -> name_aux (n :> t)
 
   let rec full_name_aux : t -> string list =
@@ -671,7 +712,7 @@ module Path = struct
       | `Identifier { iv = `Module (_, m); _ }
         when Names.ModuleName.is_internal m ->
           true
-      | `Identifier _ -> false
+      | `Identifier i -> Identifier.is_internal_rec i
       | `Canonical (_, `Resolved _) -> false
       | `Canonical (x, _) ->
           (not weak_canonical_test) && inner (x : module_ :> any)
@@ -708,15 +749,6 @@ module Path = struct
     in
     inner x
 
-  and contains_double_underscore s =
-    let len = String.length s in
-    let rec aux i =
-      if i > len - 2 then false
-      else if s.[i] = '_' && s.[i + 1] = '_' then true
-      else aux (i + 1)
-    in
-    aux 0
-
   and is_path_hidden : Paths_types.Path.any -> bool =
     let open Paths_types.Path in
     function

test/occurrences/double_wrapped.t/run.t

@@ -63,6 +63,7 @@ and prints the number of occurrences in a readable format.
 Uses of A are: 2 times in b.ml, 1 time in c.ml, 1 time in main.ml
 Uses of B are: 1 time in main.ml
 Uses of C are not counted, since the canonical destination (Main.C, generated by dune) does not exist.
+Uses of B.Z are not counted since they go to a hidden module.
 Uses of values Y.x and Z.y (in b.ml) are not counted since they come from a "local" module.
 
   $ occurrences_print occurrences.txt | sort
@@ -73,9 +74,6 @@ Uses of values Y.x and Z.y (in b.ml) are not counted since they come from a "loc
   Main.A.t was used directly 1 times and indirectly 0 times
   Main.A.x was used directly 4 times and indirectly 0 times
   Main.B was used directly 1 times and indirectly 0 times
-  Main__B was used directly 0 times and indirectly 1 times
-  Main__B.Z was used directly 0 times and indirectly 1 times
-  Main__B.Z.y was used directly 1 times and indirectly 0 times
   string was used directly 1 times and indirectly 0 times
 
   $ occurrences_print occurrences1.txt | sort
@@ -95,9 +93,6 @@ Uses of values Y.x and Z.y (in b.ml) are not counted since they come from a "loc
   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 0 times and indirectly 1 times
-  Main__B.Z was used directly 0 times and indirectly 1 times
-  Main__B.Z.y was used directly 1 times and indirectly 0 times
 
   $ occurrences_print occurrences5.txt | sort
   Main was used directly 0 times and indirectly 3 times
@@ -121,7 +116,4 @@ Now we can merge both files
   Main.A.t was used directly 1 times and indirectly 0 times
   Main.A.x was used directly 4 times and indirectly 0 times
   Main.B was used directly 1 times and indirectly 0 times
-  Main__B was used directly 0 times and indirectly 1 times
-  Main__B.Z was used directly 0 times and indirectly 1 times
-  Main__B.Z.y was used directly 1 times and indirectly 0 times
   string was used directly 1 times and indirectly 0 times