Combine shape and uid_to_id to one field in Lang

Author: jonludlam

src/loader/implementation.ml

@@ -512,21 +512,20 @@ let read_cmt_infos source_id_opt id cmt_info =
           let map, source_infos =
             of_cmt source_id id impl uid_to_loc
           in
-          ( Some shape,
-            map,
+          ( Some (shape, map),
             Some
               {
                 Odoc_model.Lang.Source_info.id = source_id;
                 infos = source_infos;
               } )
-      | _, _ -> (Some shape, Odoc_model.Compat.empty_map, None))
-  | None -> (None, Odoc_model.Compat.empty_map, None)
+      | _, _ -> (Some (shape, Odoc_model.Compat.empty_map), None))
+  | None -> (None, None)
 
 
 
 #else
 
-let read_cmt_infos _source_id_opt _id ~filename:_ () =
-  (None, Odoc_model.Compat.empty_map, None)
+let read_cmt_infos _source_id_opt _id _cmt_info =
+  (None, None)
 
 #endif

src/loader/implementation.mli

@@ -2,9 +2,10 @@ val read_cmt_infos :
   Odoc_model.Paths.Identifier.Id.source_page option ->
   Odoc_model.Paths.Identifier.Id.root_module ->
   Cmt_format.cmt_infos ->
-  Odoc_model.Compat.shape option
+  (Odoc_model.Compat.shape
   * Odoc_model.Paths.Identifier.Id.source_location
-    Odoc_model.Compat.shape_uid_map
+    Odoc_model.Compat.shape_uid_map)
+  option
   * Odoc_model.Lang.Source_info.t option
 (** Extract all implementation information from a [cmt]: the shape, and the
     {{!Odoc_model.Lang.Source_info.infos}source infos} (local and global

src/loader/odoc_loader.ml

@@ -52,7 +52,7 @@ let read_cmt_infos source_id_opt id ~filename () =
 
 
 let make_compilation_unit ~make_root ~imports ~interface ?sourcefile ~name ~id
-    ?canonical ?shape ~uid_to_id ~source_info content =
+    ?canonical ?shape_info ~source_info content =
   let open Odoc_model.Lang.Compilation_unit in
   let interface, digest =
     match interface with
@@ -89,16 +89,15 @@ let make_compilation_unit ~make_root ~imports ~interface ?sourcefile ~name ~id
     linked = false;
     canonical;
     source_info;
-    shape;
-    uid_to_id;
+    shape_info;
   }
 
 
 let compilation_unit_of_sig ~make_root ~imports ~interface ?sourcefile ~name ~id
-    ?canonical ?shape ~uid_to_id sg =
+    ?canonical ?shape_info sg =
   let content = Odoc_model.Lang.Compilation_unit.Module sg in
   make_compilation_unit ~make_root ~imports ~interface ?sourcefile ~name ~id
-    ?canonical ?shape ~uid_to_id content
+    ?canonical ?shape_info content
 
 let read_cmti ~make_root ~parent ~filename ~cmt_filename_opt ~source_id_opt () =
   let cmt_info = Cmt_format.read_cmt filename in
@@ -114,14 +113,14 @@ let read_cmti ~make_root ~parent ~filename ~cmt_filename_opt ~source_id_opt () =
               cmt_info.cmt_builddir )
           in
           let id, sg, canonical = Cmti.read_interface parent name intf in
-          let shape, uid_to_id, source_info =
+          let shape_info, source_info =
             match cmt_filename_opt with
             | Some cmt_filename ->
                 read_cmt_infos source_id_opt id ~filename:cmt_filename ()
-            | None -> (None, Odoc_model.Compat.empty_map, None)
+            | None -> (None, None)
           in
           compilation_unit_of_sig ~make_root ~imports:cmt_info.cmt_imports
-            ~interface ~sourcefile ~name ~id ?shape ~uid_to_id ~source_info
+            ~interface ~sourcefile ~name ~id ?shape_info ~source_info
             ?canonical sg)
   | _ -> raise Not_an_interface
 
@@ -165,14 +164,14 @@ let read_cmt ~make_root ~parent ~filename ~source_id_opt () =
           in
           let content = Odoc_model.Lang.Compilation_unit.Pack items in
           make_compilation_unit ~make_root ~imports ~interface ~sourcefile ~name
-            ~id ~uid_to_id:Odoc_model.Compat.empty_map ~source_info:None content
+            ~id ~source_info:None content
       | Implementation impl ->
           let id, sg, canonical = Cmt.read_implementation parent name impl in
-          let shape, uid_to_id, source_info =
+          let shape_info, source_info =
             read_cmt_infos source_id_opt id ~filename ()
           in
           compilation_unit_of_sig ~make_root ~imports ~interface ~sourcefile
-            ~name ~id ?canonical ?shape ~uid_to_id ~source_info sg
+            ~name ~id ?canonical ?shape_info ~source_info sg
       | _ -> raise Not_an_implementation)
 
 let read_cmi ~make_root ~parent ~filename () =
@@ -184,7 +183,7 @@ let read_cmi ~make_root ~parent ~filename () =
           (Odoc_model.Compat.signature cmi_info.cmi_sign)
       in
       compilation_unit_of_sig ~make_root ~imports ~interface ~name ~id
-        ~source_info:None ~uid_to_id:Odoc_model.Compat.empty_map sg
+        ~source_info:None sg
   | _ -> raise Corrupted
 
 (** Catch errors from reading the object files and some internal errors *)

src/model/lang.ml

@@ -486,8 +486,9 @@ module rec Compilation_unit : sig
     linked : bool;  (** Whether this unit has been linked. *)
     canonical : Path.Module.t option;
     source_info : Source_info.t option;
-    shape : Compat.shape option;
-    uid_to_id : Paths.Identifier.SourceLocation.t Compat.shape_uid_map;
+    shape_info :
+      (Compat.shape * Paths.Identifier.SourceLocation.t Compat.shape_uid_map)
+      option;
   }
 end =
   Compilation_unit

src/odoc/odoc_link.ml

@@ -46,11 +46,15 @@ let from_odoc ~resolver ~warnings_options input output =
       |> handle_warnings ~input_warnings ~warnings_options
       >>= fun (m, warnings) ->
       (* Remove the shape here so that we only depend upon odoc types
-         rather than odoc and ocaml types. This means we should be able
-         save an odocl file with odoc x.y compiled with one version of
-         the compiler and load it in odoc x.y compiled with a different
-         version of the compiler. This is an important use case for
-         voodoo. *)
-      let m = { m with Odoc_model.Lang.Compilation_unit.shape = None } in
+         rather than odoc and ocaml types. This means we don't break
+         being able save an odocl file with odoc x.y compiled with one
+         version of the compiler and load it in odoc x.y compiled with
+         a different version of the compiler, provided the compiler
+         itself doesn't break cross-version marshalling! This ability
+         is currently being used by voodoo. *)
+      let m =
+        let open Odoc_model.Lang.Compilation_unit in
+        { m with shape_info = None }
+      in
       Odoc_file.save_unit output ~warnings m;
       Ok (`Module m)

src/xref2/shape_tools.ml

@@ -21,7 +21,8 @@ let rec shape_of_id env :
     match id.iv with
     | `Root (_, name) -> begin
         match Env.lookup_unit (ModuleName.to_string name) env with
-        | Some (Env.Found unit) -> unit.shape
+        | Some (Env.Found unit) -> (
+          match unit.shape_info with | Some (shape, _) -> Some shape | None -> None)
         | _ -> None
       end
     | `Module (parent, name) ->
@@ -69,7 +70,8 @@ let lookup_shape :
     let fuel = 10
     let read_unit_shape ~unit_name =
       match Env.lookup_unit unit_name env with
-      | Some (Found unit) -> unit.shape
+      | Some (Found unit) -> (
+        match unit.shape_info with | Some (shape, _) -> Some shape | None -> None)
       | _ -> None
     let find_shape _ _ = raise Not_found
   end) in
@@ -82,7 +84,11 @@ let lookup_shape :
   | Some Forward_reference
   | Some (Not_found) -> None
   | Some (Found unit) -> 
-    let uid_to_id = unit.uid_to_id in
+    let uid_to_id =
+      match unit.shape_info with
+      | Some (_, uid_to_id) -> uid_to_id
+      | None -> Odoc_model.Compat.empty_map
+    in
     match Shape.Uid.Map.find_opt uid uid_to_id with
     | Some x -> Some x
     | None -> (

test/xref2/lib/common.cppo.ml

@@ -616,8 +616,7 @@ let my_compilation_unit id (s : Odoc_model.Lang.Signature.t) =
     ; linked = false
     ; canonical = None
     ; source_info = None
-    ; shape = None
-    ; uid_to_id = Odoc_model.Compat.empty_map
+    ; shape_info = None
 }
 
 let mkresolver () =