Split Import_info.t into Import_info.{Intf,Impl}.t

backend/asmlink.ml

@@ -123,7 +123,7 @@ let extract_crc_implementations () =
   Cmx_consistbl.extract !implementations crc_implementations
   |> List.map (fun (cu, crc) ->
        let crc = Option.map (fun ((), crc) -> crc) crc in
-       Import_info.Impl.create_normal cu ~crc)
+       Import_info.Impl.create cu ~crc)
 
 (* Add C objects and options and "custom" info from a library descriptor.
    See bytecomp/bytelink.ml for comments on the order of C objects. *)

middle_end/compilenv.ml

@@ -205,7 +205,7 @@ let get_unit_info comp_unit =
               (None, None)
           end
       in
-      let import = Import_info.Impl.create_normal comp_unit ~crc in
+      let import = Import_info.Impl.create comp_unit ~crc in
       current_unit.ui_imports_cmx <- import :: current_unit.ui_imports_cmx;
       CU.Name.Tbl.add global_infos_table cmx_name infos;
       infos

ocaml/asmcomp/asmlink.ml

@@ -108,7 +108,7 @@ let extract_crc_implementations () =
   Cmx_consistbl.extract !implementations crc_implementations
   |> List.map (fun (cu, crc) ->
        let crc = Option.map (fun ((), crc) -> crc) crc in
-       Import_info.Impl.create_normal cu ~crc)
+       Import_info.Impl.create cu ~crc)
 
 
 (* Add C objects and options and "custom" info from a library descriptor.

ocaml/middle_end/compilenv.ml

@@ -187,7 +187,7 @@ let get_unit_info comp_unit =
               (None, None)
           end
       in
-      let import = Import_info.Impl.create_normal comp_unit ~crc in
+      let import = Import_info.Impl.create comp_unit ~crc in
       current_unit.ui_imports_cmx <-
         Array.append [| import |] current_unit.ui_imports_cmx;
       CU.Name.Tbl.add global_infos_table cmx_name infos;

ocaml/utils/import_info.ml

@@ -16,106 +16,64 @@ module CU = Compilation_unit
 
 module Intf = struct
   type t =
-    | Normal of CU.t * Digest.t
-    | Normal_no_crc of CU.t
+    | Normal of CU.Name.t * Digest.t (* Unpacked, so compilation unit = name *)
+    | Name_only of CU.Name.t (* Same but digest unknown *)
     | Other of CU.Name.t * (CU.t * Digest.t) option
-
-  (* CR xclerc: Maybe introduce Other_no_crc to flatten the option *)
+  (* Packed, so the CU isn't just the name *)
 
   let create cu_name ~crc_with_unit =
     match crc_with_unit with
     | None -> Other (cu_name, None)
     | Some (cu, crc) ->
-      (* For the moment be conservative and only use the [Normal] constructor
-         when there is no pack prefix at all. *)
+      (* If there's no pack prefix, the CU is just the name, so we don't need to
+         store both. *)
       if CU.Prefix.is_empty (CU.for_pack_prefix cu)
          && CU.Name.equal (CU.name cu) cu_name
-      then Normal (cu, crc)
+      then Normal (cu_name, crc)
       else Other (cu_name, Some (cu, crc))
 
-  let create_normal cu ~crc =
-    match crc with Some crc -> Normal (cu, crc) | None -> Normal_no_crc cu
-
   let name t =
-    match t with
-    | Normal (cu, _) | Normal_no_crc cu -> CU.name cu
-    | Other (name, _) -> name
+    match t with Normal (name, _) | Name_only name | Other (name, _) -> name
 
-  let cu t =
+  let impl t =
     match t with
-    | Normal (cu, _) | Normal_no_crc cu | Other (_, Some (cu, _)) -> cu
-    | Other (name, None) ->
-      Misc.fatal_errorf
-        "Cannot extract [Compilation_unit.t] from [Import_info.t] (for unit \
-         %a) that never received it"
-        CU.Name.print name
+    | Normal (name, _) ->
+      let cu = CU.create CU.Prefix.empty name in
+      Some cu
+    | Name_only _ -> None
+    | Other (_, Some (cu, _)) -> Some cu
+    | Other (_, None) -> None
 
   let crc t =
     match t with
     | Normal (_, crc) -> Some crc
-    | Normal_no_crc _ | Other (_, None) -> None
+    | Name_only _ | Other (_, None) -> None
     | Other (_, Some (_, crc)) -> Some crc
 
   let crc_with_unit t =
     match t with
-    | Normal (cu, crc) -> Some (cu, crc)
-    | Normal_no_crc _ | Other (_, None) -> None
+    | Normal (cu, crc) -> Some (CU.create CU.Prefix.empty cu, crc)
+    | Name_only _ | Other (_, None) -> None
     | Other (_, some_cu_and_crc) -> some_cu_and_crc
 
   let has_name t ~name:name' = CU.Name.equal (name t) name'
 
-  let dummy = Other (CU.Name.dummy, None)
+  let dummy = Name_only CU.Name.dummy
 end
 
 module Impl = struct
   type t =
-    | Normal of CU.t * Digest.t
-    | Normal_no_crc of CU.t
-    | Other of CU.Name.t * (CU.t * Digest.t) option
-
-  (* CR xclerc: Maybe introduce Other_no_crc to flatten the option *)
-
-  let create cu_name ~crc_with_unit =
-    match crc_with_unit with
-    | None -> Other (cu_name, None)
-    | Some (cu, crc) ->
-      (* For the moment be conservative and only use the [Normal] constructor
-         when there is no pack prefix at all. *)
-      if CU.Prefix.is_empty (CU.for_pack_prefix cu)
-         && CU.Name.equal (CU.name cu) cu_name
-      then Normal (cu, crc)
-      else Other (cu_name, Some (cu, crc))
+    | With_crc of CU.t * Digest.t
+    | No_crc of CU.t
 
-  let create_normal cu ~crc =
-    match crc with Some crc -> Normal (cu, crc) | None -> Normal_no_crc cu
+  let create cu ~crc =
+    match crc with Some crc -> With_crc (cu, crc) | None -> No_crc cu
 
-  let name t =
-    match t with
-    | Normal (cu, _) | Normal_no_crc cu -> CU.name cu
-    | Other (name, _) -> name
+  let cu (With_crc (cu, _) | No_crc cu) = cu
 
-  let cu t =
-    match t with
-    | Normal (cu, _) | Normal_no_crc cu | Other (_, Some (cu, _)) -> cu
-    | Other (name, None) ->
-      Misc.fatal_errorf
-        "Cannot extract [Compilation_unit.t] from [Import_info.t] (for unit \
-         %a) that never received it"
-        CU.Name.print name
+  let name t = CU.name (cu t)
 
-  let crc t =
-    match t with
-    | Normal (_, crc) -> Some crc
-    | Normal_no_crc _ | Other (_, None) -> None
-    | Other (_, Some (_, crc)) -> Some crc
-
-  let crc_with_unit t =
-    match t with
-    | Normal (cu, crc) -> Some (cu, crc)
-    | Normal_no_crc _ | Other (_, None) -> None
-    | Other (_, some_cu_and_crc) -> some_cu_and_crc
-
-  let has_name t ~name:name' = CU.Name.equal (name t) name'
+  let crc t = match t with With_crc (_, crc) -> Some crc | No_crc _ -> None
 
-  let dummy = Other (CU.Name.dummy, None)
+  let dummy = No_crc CU.dummy
 end

ocaml/utils/import_info.mli

@@ -29,45 +29,31 @@ module CU := Compilation_unit
 module Intf : sig
   type t
 
-  val create : CU.Name.t -> crc_with_unit:(CU.t * string) option -> t
-
-  val create_normal : CU.t -> crc:string option -> t
+  val create : CU.Name.t -> crc_with_unit:(CU.t * Digest.t) option -> t
 
   val name : t -> CU.Name.t
 
-  (** This function will cause a fatal error if a [CU.t] was not provided when the
-      supplied value of type [t] was created. *)
-  val cu : t -> CU.t
+  val impl : t -> CU.t option
 
-  val crc : t -> string option
+  val crc : t -> Digest.t option
 
-  val crc_with_unit : t -> (CU.t * string) option
+  val crc_with_unit : t -> (CU.t * Digest.t) option
 
   val has_name : t -> name:CU.Name.t -> bool
 
   val dummy : t
 end
 
-(* CR-soon lmaurer: Change the APIs to reflect the differences between the two
-   types. (In particular, an [Impl.t] always has a [CU.t].)*)
 module Impl : sig
   type t
 
-  val create : CU.Name.t -> crc_with_unit:(CU.t * string) option -> t
-
-  val create_normal : CU.t -> crc:string option -> t
+  val create : CU.t -> crc:Digest.t option -> t
 
   val name : t -> CU.Name.t
 
-  (** This function will cause a fatal error if a [CU.t] was not provided when the
-      supplied value of type [t] was created. *)
   val cu : t -> CU.t
 
-  val crc : t -> string option
-
-  val crc_with_unit : t -> (CU.t * string) option
-
-  val has_name : t -> name:CU.Name.t -> bool
+  val crc : t -> Digest.t option
 
   val dummy : t
 end