Revert "Adding support for resolving constructor and datatype"

This reverts commit 9eee684.

Author: panglesd

src/xref2/compile.ml

@@ -21,26 +21,15 @@ let type_path : Env.t -> Paths.Path.Type.t -> Paths.Path.Type.t =
       | Ok p' -> `Resolved Lang_of.(Path.resolved_type (empty ()) p')
       | Error _ -> p)
 
-(* and value_path : Env.t -> Paths.Path.Value.t -> Paths.Path.Value.t = *)
-(*  fun env p -> *)
-(*   match p with *)
-(*   | `Resolved _ -> p *)
-(*   | _ -> ( *)
-(*       let cp = Component.Of_Lang.(value_path (empty ()) p) in *)
-(*       match Tools.resolve_value_path env cp with *)
-(*       | Ok p' -> `Resolved Lang_of.(Path.resolved_value (empty ()) p') *)
-(*       | Error _ -> p) *)
-
-(* and constructor_path : *)
-(*     Env.t -> Paths.Path.Constructor.t -> Paths.Path.Constructor.t = *)
-(*  fun env p -> *)
-(*   match p with *)
-(*   | `Resolved _ -> p *)
-(*   | _ -> ( *)
-(*       let cp = Component.Of_Lang.(constructor_path (empty ()) p) in *)
-(*       match Tools.resolve_constructor_path env cp with *)
-(*       | Ok p' -> `Resolved Lang_of.(Path.resolved_constructor (empty ()) p') *)
-(*       | Error _ -> p) *)
+and value_path : Env.t -> Paths.Path.Value.t -> Paths.Path.Value.t =
+ fun env p ->
+  match p with
+  | `Resolved _ -> p
+  | _ -> (
+      let cp = Component.Of_Lang.(value_path (empty ()) p) in
+      match Tools.resolve_value_path env cp with
+      | Ok p' -> `Resolved Lang_of.(Path.resolved_value (empty ()) p')
+      | Error _ -> p)
 
 and module_type_path :
     Env.t -> Paths.Path.ModuleType.t -> Paths.Path.ModuleType.t =

src/xref2/errors.ml

@@ -72,17 +72,6 @@ module Tools_error = struct
       (* Could not find the module in the environment *)
     | `Parent of parent_lookup_error ]
 
-  and simple_datatype_lookup_error =
-    [ `LocalDataType of
-      Env.t * Ident.path_datatype
-      (* Internal error: Found local path during lookup *)
-    | `Find_failure
-      (* Internal error: the type was not found in the parent signature *)
-    | `Lookup_failureT of
-      Identifier.Path.Type.t
-      (* Could not find the module in the environment *)
-    | `Parent of parent_lookup_error ]
-
   and simple_value_lookup_error =
     [ `LocalValue of
       Env.t * Ident.path_value
@@ -94,17 +83,6 @@ module Tools_error = struct
       (* Could not find the module in the environment *)
     | `Parent of parent_lookup_error ]
 
-  and simple_constructor_lookup_error =
-    [ `LocalConstructor of
-      Env.t * Ident.constructor
-      (* Internal error: Found local path during lookup *)
-    | `Find_failure
-      (* Internal error: the type was not found in the parent signature *)
-    | `Lookup_failureC of
-      Identifier.Path.Constructor.t
-      (* Could not find the module in the environment *)
-    | `ParentC of simple_datatype_lookup_error ]
-
   and parent_lookup_error =
     [ `Parent_sig of
       expansion_of_module_error
@@ -132,8 +110,6 @@ module Tools_error = struct
   type any =
     [ simple_type_lookup_error
     | simple_value_lookup_error
-    | simple_constructor_lookup_error
-    | simple_datatype_lookup_error
     | simple_module_type_lookup_error
     | simple_module_type_expr_of_module_error
     | simple_module_lookup_error
@@ -171,10 +147,6 @@ module Tools_error = struct
     | `LocalMT (_, id) -> Format.fprintf fmt "Local id found: %a" Ident.fmt id
     | `Local (_, id) -> Format.fprintf fmt "Local id found: %a" Ident.fmt id
     | `LocalType (_, id) -> Format.fprintf fmt "Local id found: %a" Ident.fmt id
-    | `LocalDataType (_, id) ->
-        Format.fprintf fmt "Local id found: %a" Ident.fmt id
-    | `LocalConstructor (_, id) ->
-        Format.fprintf fmt "Local id found: %a" Ident.fmt id
     | `LocalValue (_, id) ->
         Format.fprintf fmt "Local id found: %a" Ident.fmt id
     | `Find_failure -> Format.fprintf fmt "Find failure"
@@ -196,14 +168,9 @@ module Tools_error = struct
         Format.fprintf fmt "Lookup failure (value): %a"
           Component.Fmt.model_identifier
           (m :> Odoc_model.Paths.Identifier.t)
-    | `Lookup_failureC m ->
-        Format.fprintf fmt "Lookup failure (constructor): %a"
-          Component.Fmt.model_identifier
-          (m :> Odoc_model.Paths.Identifier.t)
     | `ApplyNotFunctor -> Format.fprintf fmt "Apply module is not a functor"
     | `Class_replaced -> Format.fprintf fmt "Class replaced"
     | `Parent p -> pp fmt (p :> any)
-    | `ParentC p -> pp fmt (p :> any)
     | `UnexpandedTypeOf t ->
         Format.fprintf fmt "Unexpanded `module type of` expression: %a"
           Component.Fmt.module_type_type_of_desc t
@@ -239,9 +206,7 @@ let is_unexpanded_module_type_of =
     | `Find_failure -> false
     | `Lookup_failure _ -> false
     | `Lookup_failure_root _ -> false
-    | `Lookup_failureC _ -> false
     | `Parent p -> inner (p :> any)
-    | `ParentC p -> inner (p :> any)
     | `Parent_sig p -> inner (p :> any)
     | `Parent_module_type p -> inner (p :> any)
     | `Parent_expr p -> inner (p :> any)
@@ -259,8 +224,6 @@ let is_unexpanded_module_type_of =
     | `Lookup_failureT _ -> false
     | `Lookup_failureV _ -> false
     | `LocalType _ -> false
-    | `LocalDataType _ -> false
-    | `LocalConstructor _ -> false
     | `LocalValue _ -> false
     | `Class_replaced -> false
     | `OpaqueClass -> false
@@ -335,7 +298,6 @@ type what =
   | `Module of Identifier.Module.t
   | `Module_type of Identifier.Signature.t
   | `Module_path of Cpath.module_
-  | `Constructor_path of Cpath.constructor
   | `Module_type_path of Cpath.module_type
   | `Module_type_U of Component.ModuleType.U.expr
   | `Include of Component.Include.decl
@@ -388,7 +350,6 @@ let report ~(what : what) ?tools_error action =
     | `Type cfrag -> r "type" type_fragment cfrag
     | `Type_path path -> r "type" type_path path
     | `Value_path path -> r "value" value_path path
-    | `Constructor_path path -> r "constructor" constructor_path path
     | `Class_type_path path -> r "class_type" class_type_path path
     | `With_module frag -> r "module substitution" module_fragment frag
     | `With_module_type frag ->

src/xref2/find.ml

@@ -111,12 +111,6 @@ let type_in_sig sg name =
         Some (`FClassType (N.class_type' id, c))
     | _ -> None)
 
-let datatype_in_sig sg name =
-  find_in_sig sg (function
-    | Signature.Type (id, _, m) when N.type_ id = name ->
-        Some (`FType (N.type' id, Delayed.get m))
-    | _ -> None)
-
 type removed_type =
   [ `FType_removed of TypeName.t * TypeExpr.t * TypeDecl.Equation.t ]
 
@@ -127,8 +121,6 @@ type careful_module_type =
 
 type careful_type = [ type_ | removed_type ]
 
-type careful_datatype = [ datatype | removed_type ]
-
 type careful_class = [ class_ | removed_type ]
 
 let careful_module_in_sig sg name =
@@ -164,10 +156,11 @@ let careful_type_in_sig sg name =
   | Some _ as x -> x
   | None -> removed_type_in_sig sg name
 
-let careful_datatype_in_sig sg name =
-  match datatype_in_sig sg name with
-  | Some _ as x -> x
-  | None -> removed_type_in_sig sg name
+let datatype_in_sig sg name =
+  find_in_sig sg (function
+    | Signature.Type (id, _, t) when N.type_ id = name ->
+        Some (`FType (N.type' id, Component.Delayed.get t))
+    | _ -> None)
 
 let class_in_sig sg name =
   filter_in_sig sg (function
@@ -184,18 +177,6 @@ let careful_class_in_sig sg name =
   | Some _ as x -> x
   | None -> removed_type_in_sig sg name
 
-let constructor_in_type (typ : TypeDecl.t) name =
-  let rec find_cons = function
-    | ({ TypeDecl.Constructor.name = name'; _ } as cons) :: _ when name' = name
-      ->
-        Some (`FConstructor cons)
-    | _ :: tl -> find_cons tl
-    | [] -> None
-  in
-  match typ.representation with
-  | Some (Variant cons) -> find_cons cons
-  | Some (Record _) | Some Extensible | None -> None
-
 let any_in_type (typ : TypeDecl.t) name =
   let rec find_cons = function
     | ({ TypeDecl.Constructor.name = name'; _ } as cons) :: _ when name' = name

src/xref2/find.mli

@@ -71,8 +71,6 @@ val extension_in_sig : Signature.t -> string -> extension option
 
 val any_in_type : TypeDecl.t -> string -> any_in_type option
 
-val constructor_in_type : TypeDecl.t -> string -> constructor option
-
 val any_in_typext : Extension.t -> string -> extension option
 
 val method_in_class_signature : ClassSignature.t -> string -> method_ option
@@ -116,8 +114,6 @@ type careful_module_type =
 
 type careful_type = [ type_ | removed_type ]
 
-type careful_datatype = [ datatype | removed_type ]
-
 type careful_class = [ class_ | removed_type ]
 
 val careful_module_in_sig : Signature.t -> string -> careful_module option
@@ -127,6 +123,4 @@ val careful_module_type_in_sig :
 
 val careful_type_in_sig : Signature.t -> string -> careful_type option
 
-val careful_datatype_in_sig : Signature.t -> string -> careful_datatype option
-
 val careful_class_in_sig : Signature.t -> string -> careful_class option

src/xref2/link.ml

@@ -106,8 +106,6 @@ let rec should_reresolve : Paths.Path.Resolved.t -> bool =
       should_reresolve (x :> t) || should_resolve (y :> Paths.Path.t)
   | `CanonicalType (x, y) ->
       should_reresolve (x :> t) || should_resolve (y :> Paths.Path.t)
-  | `CanonicalDataType (x, y) ->
-      should_reresolve (x :> t) || should_resolve (y :> Paths.Path.t)
   | `Apply (x, y) ->
       should_reresolve (x :> t) || should_reresolve (y :> Paths.Path.Resolved.t)
   | `SubstT (x, y) -> should_reresolve (x :> t) || should_reresolve (y :> t)
@@ -122,19 +120,12 @@ let rec should_reresolve : Paths.Path.Resolved.t -> bool =
   | `ModuleType (p, _)
   | `Module (p, _) ->
       should_reresolve (p :> t)
-  | `Constructor (p, _) -> should_reresolve (p :> t)
   | `OpaqueModule m -> should_reresolve (m :> t)
   | `OpaqueModuleType m -> should_reresolve (m :> t)
 
 and should_resolve : Paths.Path.t -> bool =
  fun p -> match p with `Resolved p -> should_reresolve p | _ -> true
 
-(* and should_resolve_constructor : Paths.Path.Constructor.t -> bool = *)
-(*  fun p -> *)
-(*   match p with *)
-(*   | `Resolved p -> should_reresolve (p :> Paths.Path.Resolved.t) *)
-(*   | _ -> true *)
-
 let type_path : Env.t -> Paths.Path.Type.t -> Paths.Path.Type.t =
  fun env p ->
   if not (should_resolve (p :> Paths.Path.t)) then p
@@ -171,27 +162,6 @@ let value_path : Env.t -> Paths.Path.Value.t -> Paths.Path.Value.t =
             Errors.report ~what:(`Value_path cp) ~tools_error:e `Lookup;
             p)
 
-let constructor_path :
-    Env.t -> Paths.Path.Constructor.t -> Paths.Path.Constructor.t =
- fun env p ->
-  (* if not (should_resolve (p : Paths.Path.Constructor.t :> Paths.Path.t)) then p *)
-  (* else *)
-  if not (should_resolve_constructor p) then p
-  else
-    let cp = Component.Of_Lang.(constructor_path (empty ()) p) in
-    match cp with
-    | `Resolved p ->
-        let result = Tools.reresolve_constructor env p in
-        `Resolved Lang_of.(Path.resolved_constructor (empty ()) result)
-    | _ -> (
-        match Tools.resolve_constructor_path env cp with
-        | Ok p' ->
-            let result = Tools.reresolve_constructor env p' in
-            `Resolved Lang_of.(Path.resolved_constructor (empty ()) result)
-        | Error e ->
-            Errors.report ~what:(`Constructor_path cp) ~tools_error:e `Lookup;
-            p)
-
 let class_type_path : Env.t -> Paths.Path.ClassType.t -> Paths.Path.ClassType.t
     =
  fun env p ->