occurrences: review comments

- Handle `Pextra_ty` in `is_persistent`
- alias `Tast_iterator.default_iterator` to improve readability
- Remove possibility for `jump_to` type to have different types for doc and impl
- Factorize all instances of `contains_double_underscore`
- Use `ModuleName.is_hidden` instead of inlining its definition...
- Handle `ClassType` occurrences in compile, and avoid future miss by having an
  exhaustive match.

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

Author: panglesd

src/loader/cmi.ml

@@ -968,7 +968,7 @@ and read_module_declaration env parent ident (md : Odoc_model.Compat.module_decl
   let hidden =
     match canonical with
     | Some _ -> false
-    | None -> Odoc_model.Root.contains_double_underscore (Ident.name ident)
+    | None -> Odoc_model.Names.contains_double_underscore (Ident.name ident)
   in
   {id; locs; doc; type_; canonical; hidden }
 

src/loader/cmt.ml

@@ -450,7 +450,7 @@ and read_module_binding env parent mb =
   let hidden =
 #if OCAML_VERSION >= (4,10,0)
     match canonical, mb.mb_id with
-    | None, Some id -> Odoc_model.Root.contains_double_underscore (Ident.name id)
+    | None, Some id -> Odoc_model.Names.contains_double_underscore (Ident.name id)
     | _, _ -> false
 #else
     match canonical with

src/loader/cmti.ml

@@ -628,7 +628,7 @@ and read_module_declaration env parent md =
   let hidden =
 #if OCAML_VERSION >= (4,10,0)
     match canonical, md.md_id with
-    | None, Some id -> Odoc_model.Root.contains_double_underscore (Ident.name id)
+    | None, Some id -> Odoc_model.Names.contains_double_underscore (Ident.name id)
     | _,_ -> false
 #else
     match canonical with

src/loader/ident_env.cppo.ml

@@ -553,7 +553,7 @@ let add_items : Id.Signature.t -> item list -> t -> unit = fun parent items env
 
     | `Module (t, is_hidden_item, loc) :: rest ->
       let name = Ident.name t in
-      let double_underscore = Odoc_model.Root.contains_double_underscore name in
+      let double_underscore = Odoc_model.Names.contains_double_underscore name in
       let is_hidden = is_hidden_item || module_name_exists name rest || double_underscore in
       let identifier =
         if is_hidden

src/loader/implementation.ml

@@ -5,7 +5,7 @@ let rec is_persistent : Path.t -> bool = function
   | Path.Pdot(p, _) -> is_persistent p
   | Path.Papply(p, _) -> is_persistent p
 #if OCAML_VERSION >= (5,1,0)
-  | Path.Pextra_ty _ -> assert false
+  | Path.Pextra_ty (p, _) -> is_persistent p
 #endif
 
 let pos_of_loc loc = (loc.Location.loc_start.pos_cnum, loc.loc_end.pos_cnum)

src/loader/odoc_loader.ml

@@ -83,7 +83,7 @@ let make_compilation_unit ~make_root ~imports ~interface ?sourcefile ~name ~id
     imports;
     source;
     interface;
-    hidden = Odoc_model.Root.contains_double_underscore name;
+    hidden = Odoc_model.Names.contains_double_underscore name;
     content;
     expansion = None;
     linked = false;

src/loader/typedtree_traverse.ml

@@ -94,37 +94,38 @@ end
 
 let of_cmt env structure =
   let poses = ref [] in
+  let iter = Tast_iterator.default_iterator in
   let module_expr iterator mod_expr =
     Analysis.module_expr poses mod_expr;
-    Tast_iterator.default_iterator.module_expr iterator mod_expr
+    iter.module_expr iterator mod_expr
   in
   let expr iterator e =
     Analysis.expr poses e;
-    Tast_iterator.default_iterator.expr iterator e
+    iter.expr iterator e
   in
   let pat iterator e =
     Analysis.pat env poses e;
-    Tast_iterator.default_iterator.pat iterator e
+    iter.pat iterator e
   in
   let typ iterator ctyp_expr =
     Analysis.core_type poses ctyp_expr;
-    Tast_iterator.default_iterator.typ iterator ctyp_expr
+    iter.typ iterator ctyp_expr
   in
   let module_type iterator mty =
     Analysis.module_type poses mty;
-    Tast_iterator.default_iterator.module_type iterator mty
+    iter.module_type iterator mty
   in
   let class_type iterator cl_type =
     Analysis.class_type poses cl_type;
-    Tast_iterator.default_iterator.class_type iterator cl_type
+    iter.class_type iterator cl_type
   in
   let module_binding iterator mb =
     Analysis.module_binding env poses mb;
-    Tast_iterator.default_iterator.module_binding iterator mb
+    iter.module_binding iterator mb
   in
   let iterator =
     {
-      Tast_iterator.default_iterator with
+      iter with
       expr;
       pat;
       module_expr;

src/model/lang.ml

@@ -22,21 +22,19 @@ module Source_info = struct
     | Unresolved of 'a
     | Resolved of Identifier.SourceLocation.t
 
-  type ('doc, 'impl) jump_to = {
-    documentation : 'doc option;
-    implementation : 'impl jump_to_impl option;
+  type 'a jump_to = {
+    documentation : 'a option;
+    implementation : 'a jump_to_impl option;
   }
 
-  type 'path jump_1 = ('path, 'path) jump_to
-
   type annotation =
     | Definition of Paths.Identifier.SourceLocation.t
-    | Value of Path.Value.t jump_1
-    | Module of Path.Module.t jump_1
-    | ClassType of Path.ClassType.t jump_1
-    | ModuleType of Path.ModuleType.t jump_1
-    | Type of Path.Type.t jump_1
-    | Constructor of Path.Constructor.t jump_1
+    | Value of Path.Value.t jump_to
+    | Module of Path.Module.t jump_to
+    | ClassType of Path.ClassType.t jump_to
+    | ModuleType of Path.ModuleType.t jump_to
+    | Type of Path.Type.t jump_to
+    | Constructor of Path.Constructor.t jump_to
 
   type 'a with_pos = 'a * (int * int)
 

src/model/names.ml

@@ -15,6 +15,15 @@ let parenthesise name =
         | _ -> "(" ^ name ^ ")"
       else name
 
+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 type Name = sig
   type t
 
@@ -73,14 +82,7 @@ module Name : Name = struct
   let fmt ppf x = Format.fprintf ppf "%s" (to_string x)
 
   let is_hidden = function
-    | Std 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
+    | Std s -> contains_double_underscore s
     | Internal _ -> true
 end
 
@@ -117,14 +119,7 @@ module SimpleName : SimpleName = struct
 
   let fmt ppf t = Format.pp_print_string ppf (to_string t)
 
-  let is_hidden 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
+  let is_hidden s = contains_double_underscore s
 end
 
 module ModuleName = Name

src/model/names.mli

@@ -7,6 +7,8 @@
 *)
 
 val parenthesise : string -> string
+val contains_double_underscore : string -> bool
+(* not the best place for this but. *)
 
 (** Name is the signature for names that could possibly be internal. Internal
     names occur when we generate items that don't have a path that will be