Remove occurrence count for constructors

The resolving of constructor paths introduced was wrong and never tested. It is
removed in this commit as well.

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

Author: panglesd

src/document/generator.ml

@@ -286,7 +286,6 @@ module Make (Syntax : SYNTAX) = struct
       | Type v -> to_link v
       | ClassType v -> to_link v
       | Value v -> to_link v
-      | Constructor v -> to_link v
 
     let source id syntax_info infos source_code =
       let url = path id in

src/loader/implementation.ml

@@ -332,11 +332,6 @@ let process_occurrences env poses loc_to_id local_ident_to_loc =
           process p Ident_env.Path.read_type
           |> Option.iter @@ fun l ->
              AnnotHashtbl.replace occ_tbl (Type l, pos_of_loc loc) ()
-      | Constructor _p, loc ->
-          (* process p Ident_env.Path.read_constructor *)
-          None
-          |> Option.iter @@ fun l ->
-             AnnotHashtbl.replace occ_tbl (Constructor l, pos_of_loc loc) ()
       | LocalDefinition _, _ -> ())
     poses;
   AnnotHashtbl.fold (fun k () acc -> k :: acc) occ_tbl []

src/loader/typedtree_traverse.ml

@@ -8,34 +8,17 @@ module Analysis = struct
     | ClassType of Path.t
     | ModuleType of Path.t
     | Type of Path.t
-    | Constructor of Path.t
 
   let expr poses expr =
     let exp_loc = expr.Typedtree.exp_loc in
     if exp_loc.loc_ghost then ()
     else
       match expr.exp_desc with
       | Texp_ident (p, _, _) -> poses := (Value p, exp_loc) :: !poses
-      | Texp_construct (_, { cstr_res; _ }, _) -> (
-          let desc = Types.get_desc cstr_res in
-          match desc with
-          | Types.Tconstr (p, _, _) ->
-              poses := (Constructor p, exp_loc) :: !poses
-          | _ -> ())
       | _ -> ()
 
   let pat env (type a) poses : a Typedtree.general_pattern -> unit = function
     | { Typedtree.pat_desc; pat_loc; _ } when not pat_loc.loc_ghost ->
-        let () =
-          match pat_desc with
-          | Typedtree.Tpat_construct (_, { cstr_res; _ }, _, _) -> (
-              let desc = Types.get_desc cstr_res in
-              match desc with
-              | Types.Tconstr (p, _, _) ->
-                  poses := (Constructor p, pat_loc) :: !poses
-              | _ -> ())
-          | _ -> ()
-        in
         let maybe_localvalue id loc =
           match Ident_env.identifier_of_loc env loc with
           | None -> Some (LocalDefinition id, loc)

src/model/lang.ml

@@ -34,7 +34,6 @@ module Source_info = struct
     | 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/xref2/compile.ml

@@ -91,7 +91,6 @@ and source_info_infos env infos =
             | Module v -> Module (map_doc (module_path env) v)
             | ModuleType v -> ModuleType (map_doc (module_type_path env) v)
             | Type v -> Type (map_doc (type_path env) v)
-            | Constructor v -> Constructor (map_doc (constructor_path env) v)
             | ClassType v -> ClassType (map_doc (class_type_path env) v)
             | Definition _ as d -> d
           in

src/xref2/link.ml

@@ -421,9 +421,6 @@ let rec unit env t =
                       (jump_to v
                          (Shape_tools.lookup_type_path env)
                          (type_path env))
-                | Constructor v ->
-                    Constructor
-                      (jump_to v (fun _ -> None) (constructor_path env))
                 | ClassType v ->
                     ClassType
                       (jump_to v

src/xref2/tools.ml

@@ -830,6 +830,29 @@ and lookup_type_gpath :
   in
   res
 
+and lookup_value_gpath :
+    Env.t ->
+    Odoc_model.Paths.Path.Resolved.Value.t ->
+    (Find.value, simple_value_lookup_error) Result.result =
+ fun env p ->
+  let do_value p name =
+    lookup_parent_gpath ~mark_substituted:true env p
+    |> map_error (fun e -> (e :> simple_value_lookup_error))
+    >>= fun (sg, sub) ->
+    match Find.value_in_sig sg name with
+    | `FValue (name, t) :: _ -> Ok (`FValue (name, Subst.value sub t))
+    | [] -> Error `Find_failure
+  in
+  let res =
+    match p with
+    | `Identifier ({ iv = `Value _; _ } as i) ->
+        of_option ~error:(`Lookup_failureV i) (Env.(lookup_by_id s_value) i env)
+        >>= fun (`Value ({ iv = `Value (_, name); _ }, t)) ->
+        Ok (`FValue (name, t))
+    | `Value (p, id) -> do_value p (ValueName.to_string id)
+  in
+  res
+
 and lookup_class_type_gpath :
     Env.t ->
     Odoc_model.Paths.Path.Resolved.ClassType.t ->