Shadowing simplification

This still isn't quite right, but it's definitely less wrong with this
fix.

Signed-off-by: Jon Ludlam <[email protected]>

Author: jonludlam

src/loader/cmi.ml

@@ -901,7 +901,7 @@ and read_signature_noenv env parent (items : Odoc_model.Compat.signature) =
         let vd = read_value_description env parent id v in
         let shadowed =
           if Env.is_shadowed env id
-          then { shadowed with s_values = (Ident.name id, (Env.find_value_identifier env id)) :: shadowed.s_values }
+          then { shadowed with s_values = Ident.name id :: shadowed.s_values }
           else shadowed
         in
           loop (vd :: acc, shadowed) rest
@@ -912,7 +912,7 @@ and read_signature_noenv env parent (items : Odoc_model.Compat.signature) =
         let decl = read_type_declaration env parent id decl in
         let shadowed =
           if Env.is_shadowed env id
-          then { shadowed with s_types = (Ident.name id, decl.id) :: shadowed.s_types }
+          then { shadowed with s_types = Ident.name id :: shadowed.s_types }
           else shadowed
         in
         loop (Type (read_type_rec_status rec_status, decl)::acc, shadowed) rest
@@ -937,15 +937,15 @@ and read_signature_noenv env parent (items : Odoc_model.Compat.signature) =
           let md = read_module_declaration env parent id md in
           let shadowed =
             if Env.is_shadowed env id
-            then { shadowed with s_modules = (Ident.name id, md.id) :: shadowed.s_modules }
+            then { shadowed with s_modules = Ident.name id :: shadowed.s_modules }
             else shadowed
           in
             loop (Module (read_module_rec_status rec_status, md)::acc, shadowed) rest
     | Sig_modtype(id, mtd, _) :: rest ->
           let mtd = read_module_type_declaration env parent id mtd in
           let shadowed =
             if Env.is_shadowed env id
-            then { shadowed with s_module_types = (Ident.name id, mtd.id) :: shadowed.s_module_types }
+            then { shadowed with s_module_types = Ident.name id :: shadowed.s_module_types }
             else shadowed
           in
             loop (ModuleType mtd :: acc, shadowed) rest
@@ -954,15 +954,15 @@ and read_signature_noenv env parent (items : Odoc_model.Compat.signature) =
           let cl = read_class_declaration env parent id cl in
           let shadowed =
             if Env.is_shadowed env id
-            then { shadowed with s_classes = (Ident.name id, cl.id) :: shadowed.s_classes }
+            then { shadowed with s_classes = Ident.name id :: shadowed.s_classes }
             else shadowed
           in
             loop (Class (read_type_rec_status rec_status, cl)::acc, shadowed) rest
     | Sig_class_type(id, cltyp, rec_status, _)::Sig_type _::Sig_type _::rest ->
         let cltyp = read_class_type_declaration env parent id cltyp in
         let shadowed =
           if Env.is_shadowed env id
-          then { shadowed with s_class_types = (Ident.name id, cltyp.id) :: shadowed.s_class_types }
+          then { shadowed with s_class_types = Ident.name id :: shadowed.s_class_types }
           else shadowed
         in
         loop (ClassType (read_type_rec_status rec_status, cltyp)::acc, shadowed) rest

src/model/lang.ml

@@ -148,12 +148,12 @@ end =
 
 and Include : sig
   type shadowed = {
-    s_modules : (string * Identifier.Module.t) list;
-    s_module_types : (string * Identifier.ModuleType.t) list;
-    s_values : (string * Identifier.Value.t) list;
-    s_types : (string * Identifier.Type.t) list;
-    s_classes : (string * Identifier.Class.t) list;
-    s_class_types : (string * Identifier.ClassType.t) list;
+    s_modules : string list;
+    s_module_types : string list;
+    s_values : string list;
+    s_types : string list;
+    s_classes : string list;
+    s_class_types : string list;
   }
 
   type expansion = { shadowed : shadowed; content : Signature.t }

src/model_desc/lang_desc.ml

@@ -216,18 +216,12 @@ and include_shadowed =
   let open Lang.Include in
   Record
     [
-      F ("s_modules", (fun t -> t.s_modules), List (Pair (string, identifier)));
-      F
-        ( "s_module_types",
-          (fun t -> t.s_module_types),
-          List (Pair (string, identifier)) );
-      F ("s_values", (fun t -> t.s_values), List (Pair (string, identifier)));
-      F ("s_types", (fun t -> t.s_types), List (Pair (string, identifier)));
-      F ("s_classes", (fun t -> t.s_classes), List (Pair (string, identifier)));
-      F
-        ( "s_class_types",
-          (fun t -> t.s_class_types),
-          List (Pair (string, identifier)) );
+      F ("s_modules", (fun t -> t.s_modules), List string);
+      F ("s_module_types", (fun t -> t.s_module_types), List string);
+      F ("s_values", (fun t -> t.s_values), List string);
+      F ("s_types", (fun t -> t.s_types), List string);
+      F ("s_classes", (fun t -> t.s_classes), List string);
+      F ("s_class_types", (fun t -> t.s_class_types), List string);
     ]
 
 and include_expansion =

src/xref2/lang_of.ml

@@ -247,8 +247,11 @@ module ExtractIDs = struct
   let rec type_decl parent map id =
     let name = Ident.Name.type_ id in
     let identifier =
-      if List.mem_assoc name map.shadowed.s_types then
-        List.assoc name map.shadowed.s_types
+      if List.mem name map.shadowed.s_types then
+        `Type
+          ( parent,
+            Odoc_model.Names.TypeName.internal_of_string (Ident.Name.type_ id)
+          )
       else `Type (parent, Ident.Name.typed_type id)
     in
     {
@@ -262,20 +265,19 @@ module ExtractIDs = struct
     }
 
   and module_ parent map id =
-    let name' = Ident.Name.typed_module id in
-    let name = ModuleName.to_string name' in
+    let name = Ident.Name.module_ id in
     let identifier =
-      if List.mem_assoc name map.shadowed.s_modules then
-        List.assoc name map.shadowed.s_modules
-      else `Module (parent, name')
+      if List.mem name map.shadowed.s_modules then
+        `Module (parent, ModuleName.internal_of_string name)
+      else `Module (parent, Ident.Name.typed_module id)
     in
     { map with module_ = Component.ModuleMap.add id identifier map.module_ }
 
   and module_type parent map id =
     let name = Ident.Name.module_type id in
     let identifier =
-      if List.mem_assoc name map.shadowed.s_module_types then
-        List.assoc name map.shadowed.s_module_types
+      if List.mem name map.shadowed.s_module_types then
+        `ModuleType (parent, ModuleTypeName.internal_of_string name)
       else `ModuleType (parent, Ident.Name.typed_module_type id)
     in
     {
@@ -286,8 +288,8 @@ module ExtractIDs = struct
   and class_ parent map id =
     let name = Ident.Name.class_ id in
     let identifier =
-      if List.mem_assoc name map.shadowed.s_classes then
-        List.assoc name map.shadowed.s_classes
+      if List.mem name map.shadowed.s_classes then
+        `Class (parent, ClassName.internal_of_string name)
       else `Class (parent, Ident.Name.typed_class id)
     in
     {
@@ -308,8 +310,8 @@ module ExtractIDs = struct
   and class_type parent map (id : Ident.class_type) =
     let name = Ident.Name.class_type id in
     let identifier =
-      if List.mem_assoc name map.shadowed.s_class_types then
-        List.assoc name map.shadowed.s_class_types
+      if List.mem name map.shadowed.s_class_types then
+        `ClassType (parent, ClassTypeName.internal_of_string name)
       else `ClassType (parent, Ident.Name.typed_class_type id)
     in
     {
@@ -522,7 +524,12 @@ and instance_variable map parent id i =
 
 and external_ map parent id e =
   let open Component.External in
-  let identifier = `Value (parent, Ident.Name.typed_value id) in
+  let name = Ident.Name.value id in
+  let identifier =
+    if List.mem name map.shadowed.s_values then
+      `Value (parent, ValueName.internal_of_string name)
+    else `Value (parent, Ident.Name.typed_value id)
+  in
   {
     id = identifier;
     doc = docs (parent :> Identifier.LabelParent.t) e.doc;

test/xref2/v408_and_above/github_issue_587.t/run.t

@@ -1,32 +1,5 @@
 A quick test to repro the issue found in #587
 
   $ ./build.sh
-  odoc: internal error, uncaught exception:
-        Failure("Error")
-        Raised at Stdlib.failwith in file "stdlib.ml", line 29, characters 17-33
-        Called from Odoc_xref2__Subst.rename_bound_idents.new_module_id in file "src/xref2/subst.ml", line 771, characters 13-29
-        Called from Odoc_xref2__Subst.rename_bound_idents.(fun) in file "src/xref2/subst.ml", line 809, characters 16-32
-        Called from Odoc_xref2__Subst.rename_bound_idents.(fun) in file "src/xref2/subst.ml", line 868, characters 8-69
-        Called from Odoc_xref2__Subst.signature in file "src/xref2/subst.ml", line 907, characters 17-50
-        Called from Odoc_xref2__Subst.simple_expansion in file "src/xref2/subst.ml", line 503, characters 30-46
-        Called from Odoc_xref2__Subst.option_ in file "src/xref2/subst.ml", line 412, characters 51-61
-        Called from Odoc_xref2__Subst.module_type_expr in file "src/xref2/subst.ml", line 599, characters 24-62
-        Called from Odoc_xref2__Subst.module_type in file "src/xref2/subst.ml", line 509, characters 37-59
-        Called from Odoc_xref2__Tools.handle_module_type_lookup.(fun) in file "src/xref2/tools.ml", line 415, characters 13-37
-        Called from Odoc_xref2__Tools.resolve_module_type.(fun) in file "src/xref2/tools.ml", line 708, characters 8-68
-        Called from Odoc_xref2__Expand_tools.aux_expansion_of_u_module_type_expr in file "src/xref2/expand_tools.ml", line 111, characters 6-61
-        Called from Odoc_xref2__Compile.include_.get_expansion in file "src/xref2/compile.ml", line 325, characters 10-66
-        Called from Odoc_xref2__Compile.signature_items.(fun) in file "src/xref2/compile.ml", line 240, characters 21-35
-        Called from Stdlib__list.fold_left in file "list.ml", line 121, characters 24-34
-        Called from Odoc_xref2__Compile.signature_items in file "src/xref2/compile.ml", line 204, characters 4-1023
-        Called from Odoc_xref2__Compile.signature in file "src/xref2/compile.ml", line 273, characters 16-46
-        Called from Odoc_xref2__Compile.content.(fun) in file "src/xref2/compile.ml", line 66, characters 13-54
-        Called from Odoc_xref2__Compile.unit in file "src/xref2/compile.ml", line 59, characters 21-47
-        Called from Odoc_xref2__Lookup_failures.catch_failures in file "src/xref2/lookup_failures.ml", line 18, characters 10-14
-        Called from Odoc_odoc__Compile.resolve_and_substitute.(fun) in file "src/odoc/compile.ml", line 74, characters 2-37
-        Called from Cmdliner_term.app.(fun) in file "cmdliner_term.ml", line 25, characters 19-24
-        Called from Cmdliner_term.app.(fun) in file "cmdliner_term.ml", line 23, characters 12-19
-        Called from Cmdliner.Term.run in file "cmdliner.ml", line 117, characters 32-39
-  [2]