Introduce Import_info

Author: mshinwell

backend/asmlibrarian.ml

@@ -63,21 +63,28 @@ let create_archive file_list lib_name =
          (fun file_name (unit, crc) ->
             Asmlink.check_consistency file_name unit crc)
          file_list descr_list;
-       let cmis = Asmlink.extract_crc_interfaces () |> Array.of_list in
-       let cmxs = Asmlink.extract_crc_implementations () |> Array.of_list in
+       let cmis = Asmlink.extract_crc_interfaces () in
+       let cmxs = Asmlink.extract_crc_implementations () in
+       (* CR mshinwell: see comment in compilenv.ml
+       let cmxs =
+         Compilenv.ensure_sharing_between_cmi_and_cmx_imports cmis cmxs
+       in
+       *)
+       let cmis = Array.of_list cmis in
+       let cmxs = Array.of_list cmxs in
        let cmi_index = Compilation_unit.Name.Tbl.create 42 in
-       Array.iteri
-         (fun i (name, _crc) -> Compilation_unit.Name.Tbl.add cmi_index name i)
+       Array.iteri (fun i import ->
+           Compilation_unit.Name.Tbl.add cmi_index (Import_info.name import) i)
          cmis;
        let cmx_index = Compilation_unit.Tbl.create 42 in
-       Array.iteri
-         (fun i (name, _crc) -> Compilation_unit.Tbl.add cmx_index name i)
+       Array.iteri (fun i import ->
+           Compilation_unit.Tbl.add cmx_index (Import_info.cu import) i)
          cmxs;
        let genfns = Cmm_helpers.Generic_fns_tbl.make () in
-       let mk_bitmap arr ix entries ~find =
+       let mk_bitmap arr ix entries ~find ~get_name =
          let module B = Misc.Bitmap in
          let b = B.make (Array.length arr) in
-         entries |> List.iter (fun (name, _crc) -> B.set b (find ix name));
+         List.iter (fun import -> B.set b (find ix (get_name import))) entries;
          b
        in
        let units =
@@ -89,10 +96,12 @@ let create_archive file_list lib_name =
              li_force_link = unit.ui_force_link;
              li_imports_cmi =
                mk_bitmap cmis cmi_index unit.ui_imports_cmi
-                 ~find:Compilation_unit.Name.Tbl.find;
+                 ~find:Compilation_unit.Name.Tbl.find
+                 ~get_name:Import_info.name;
              li_imports_cmx =
                mk_bitmap cmxs cmx_index unit.ui_imports_cmx
-                 ~find:Compilation_unit.Tbl.find })
+                 ~find:Compilation_unit.Tbl.find
+                 ~get_name:Import_info.cu })
          descr_list
        in
        let infos =

backend/asmlink.ml

@@ -60,7 +60,9 @@ let cmx_required = ref ([] : CU.t list)
 let check_cmi_consistency file_name cmis =
   try
     Array.iter
-      (fun (name, crco) ->
+      (fun import ->
+        let name = Import_info.name import in
+        let crco = Import_info.crc_with_unit import in
         CU.Name.Tbl.replace interfaces name ();
         match crco with
           None -> ()
@@ -77,7 +79,9 @@ let check_cmi_consistency file_name cmis =
 let check_cmx_consistency file_name cmxs =
   try
     Array.iter
-      (fun (name, crco) ->
+      (fun import ->
+        let name = Import_info.cu import in
+        let crco = Import_info.crc import in
         implementations := name :: !implementations;
         match crco with
             None ->
@@ -110,13 +114,16 @@ let check_consistency ~unit cmis cmxs =
 
 let extract_crc_interfaces () =
   CU.Name.Tbl.fold (fun name () crcs ->
-      (name, Cmi_consistbl.find crc_interfaces name) :: crcs)
+      let crc_with_unit = Cmi_consistbl.find crc_interfaces name in
+      Import_info.create name ~crc_with_unit :: crcs)
     interfaces
     []
 
 let extract_crc_implementations () =
   Cmx_consistbl.extract !implementations crc_implementations
-  |> List.map (fun (name, crco) -> name, Option.map snd crco)
+  |> List.map (fun (cu, crc) ->
+       let crc = Option.map (fun ((), crc) -> crc) crc in
+       Import_info.create_normal 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. *)
@@ -151,7 +158,8 @@ let is_required name =
   try ignore (Hashtbl.find missing_globals name); true
   with Not_found -> false
 
-let add_required by (name, _crc) =
+let add_required by import =
+  let name = Import_info.cu import in
   try
     let rq = Hashtbl.find missing_globals name in
     rq := by :: !rq
@@ -206,16 +214,16 @@ let scan_file ~shared genfns file (objfiles, tolink) =
   | Unit (file_name,info,crc) ->
       (* This is a .cmx file. It must be linked in any case. *)
       remove_required info.ui_unit;
-      List.iter (fun (name, crc) ->
-          add_required (file_name, None) (name, crc))
+      List.iter (fun import ->
+          add_required (file_name, None) import)
         info.ui_imports_cmx;
       let dynunit : Cmxs_format.dynunit option =
         if not shared then None else
           Some { dynu_name = info.ui_unit;
                  dynu_crc = crc;
                  dynu_defines = info.ui_defines;
-                 dynu_imports_cmi = info.ui_imports_cmi;
-                 dynu_imports_cmx = info.ui_imports_cmx }
+                 dynu_imports_cmi = info.ui_imports_cmi |> Array.of_list;
+                 dynu_imports_cmx = info.ui_imports_cmx |> Array.of_list }
       in
       let unit =
         { name = info.ui_unit;
@@ -261,8 +269,8 @@ let scan_file ~shared genfns file (objfiles, tolink) =
              remove_required info.li_name;
              let req_by = (file_name, Some li_name) in
              info.li_imports_cmx |> Misc.Bitmap.iter (fun i ->
-               let modname, digest = infos.lib_imports_cmx.(i) in
-               add_required req_by (modname, digest));
+               let import = infos.lib_imports_cmx.(i) in
+               add_required req_by import);
              let imports_list tbl bits =
                List.init (Array.length tbl) (fun i ->
                  if Misc.Bitmap.get bits i then Some tbl.(i) else None)
@@ -275,9 +283,11 @@ let scan_file ~shared genfns file (objfiles, tolink) =
                    dynu_crc = info.li_crc;
                    dynu_defines = info.li_defines;
                    dynu_imports_cmi =
-                     imports_list infos.lib_imports_cmi info.li_imports_cmi;
+                     imports_list infos.lib_imports_cmi info.li_imports_cmi
+                     |> Array.of_list;
                    dynu_imports_cmx =
-                     imports_list infos.lib_imports_cmx info.li_imports_cmx }
+                     imports_list infos.lib_imports_cmx info.li_imports_cmx
+                     |> Array.of_list }
              in
              let unit =
                { name = info.li_name;

backend/asmlink.mli

@@ -27,8 +27,8 @@ val call_linker_shared: string list -> string -> unit
 
 val reset : unit -> unit
 val check_consistency: filepath -> Cmx_format.unit_infos -> Digest.t -> unit
-val extract_crc_interfaces: unit -> Cmx_format.import_info_cmi list
-val extract_crc_implementations: unit -> Cmx_format.import_info_cmx list
+val extract_crc_interfaces: unit -> Import_info.t list
+val extract_crc_implementations: unit -> Import_info.t list
 
 type error =
   | File_not_found of filepath

backend/asmpackager.ml

@@ -71,7 +71,8 @@ let check_units members =
       | PM_intf -> ()
       | PM_impl infos ->
           List.iter
-            (fun (unit, _) ->
+            (fun import ->
+              let unit = Import_info.cu import in
               let name = CU.name unit in
               if List.mem name forbidden
               then raise(Error(Forward_reference(mb.pm_file, name))))
@@ -202,9 +203,9 @@ let get_approx ui : Clambda.value_approximation =
 let build_package_cmx members cmxfile =
   let unit_names =
     List.map (fun m -> m.pm_name) members in
-  let filter ~get_name lst =
-    List.filter (fun (name, _crc) ->
-      not (List.mem (get_name name) unit_names)) lst in
+  let filter lst =
+    List.filter (fun import ->
+      not (List.mem (Import_info.name import) unit_names)) lst in
   let union lst =
     List.fold_left
       (List.fold_left
@@ -247,10 +248,11 @@ let build_package_cmx members cmxfile =
           List.flatten (List.map (fun info -> info.ui_defines) units) @
           [ui.ui_unit];
       ui_imports_cmi =
-          (modname, Some (ui.ui_unit, Env.crc_of_unit modname)) ::
-          filter(Asmlink.extract_crc_interfaces()) ~get_name:(fun name -> name);
+          (Import_info.create modname
+            ~crc_with_unit:(Some (ui.ui_unit, Env.crc_of_unit modname))) ::
+            filter (Asmlink.extract_crc_interfaces ());
       ui_imports_cmx =
-          filter(Asmlink.extract_crc_implementations()) ~get_name:CU.name;
+          filter(Asmlink.extract_crc_implementations());
       ui_generic_fns =
         { curry_fun =
             union(List.map (fun info -> info.ui_generic_fns.curry_fun) units);

file_formats/cmx_format.mli

@@ -49,11 +49,6 @@ type generic_fns =
     apply_fun: apply_fn list;
     send_fun: apply_fn list }
 
-type import_info_cmi =
-  Compilation_unit.Name.t * (Compilation_unit.t * Digest.t) option
-type import_info_cmx =
-  Compilation_unit.t * Digest.t option
-
 (* Symbols of function that pass certain checks for special properties. *)
 type checks =
   {
@@ -68,9 +63,9 @@ type unit_infos =
                                           (* All compilation units in the
                                              .cmx file (i.e. [ui_unit] and
                                              any produced via [Asmpackager]) *)
-    mutable ui_imports_cmi: import_info_cmi list;
+    mutable ui_imports_cmi: Import_info.t list;
                                           (* Interfaces imported *)
-    mutable ui_imports_cmx: import_info_cmx list;
+    mutable ui_imports_cmx: Import_info.t list;
                                           (* Infos imported *)
     mutable ui_generic_fns: generic_fns;  (* Generic functions needed *)
     mutable ui_export_info: export_info;
@@ -80,8 +75,8 @@ type unit_infos =
 type unit_infos_raw =
   { uir_unit: Compilation_unit.t;
     uir_defines: Compilation_unit.t list;
-    uir_imports_cmi: import_info_cmi list;
-    uir_imports_cmx: import_info_cmx list;
+    uir_imports_cmi: Import_info.t array;
+    uir_imports_cmx: Import_info.t array;
     uir_generic_fns: generic_fns;
     uir_export_info: export_info_raw;
     uir_checks: checks;
@@ -104,8 +99,8 @@ type lib_unit_info =
     li_imports_cmx : Bitmap.t } (* subset of lib_imports_cmx *)
 
 type library_infos =
-  { lib_imports_cmi: import_info_cmi array;
-    lib_imports_cmx: import_info_cmx array;
+  { lib_imports_cmi: Import_info.t array;
+    lib_imports_cmx: Import_info.t array;
     lib_units: lib_unit_info list;
     lib_generic_fns: generic_fns;
     (* In the following fields the lists are reversed with respect to

middle_end/compilenv.ml

@@ -173,8 +173,8 @@ let read_unit_info filename =
     let ui = {
       ui_unit = uir.uir_unit;
       ui_defines = uir.uir_defines;
-      ui_imports_cmi = uir.uir_imports_cmi;
-      ui_imports_cmx = uir.uir_imports_cmx;
+      ui_imports_cmi = uir.uir_imports_cmi |> Array.to_list;
+      ui_imports_cmx = uir.uir_imports_cmx |> Array.to_list;
       ui_generic_fns = uir.uir_generic_fns;
       ui_export_info = export_info;
       ui_checks = uir.uir_checks;
@@ -226,8 +226,8 @@ let get_unit_info comp_unit ~cmx_name =
               (None, None)
           end
       in
-      current_unit.ui_imports_cmx <-
-        (comp_unit, crc) :: current_unit.ui_imports_cmx;
+      let import = Import_info.create_normal 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
   end
@@ -337,6 +337,28 @@ let need_send_fun n mode =
 
 (* Write the description of the current unit *)
 
+(* CR mshinwell: let's think about this later, quadratic algorithm
+
+let ensure_sharing_between_cmi_and_cmx_imports cmi_imports cmx_imports =
+  (* If a [CU.t] in the .cmx imports also occurs in the .cmi imports, use
+     the one in the .cmi imports, to increase sharing.  (Such a [CU.t] in
+     the .cmi imports may already have part of its value shared with the
+     first [CU.Name.t] component in the .cmi imports, c.f.
+     [Persistent_env.ensure_crc_sharing], so it's best to pick this [CU.t].) *)
+  List.map (fun ((comp_unit, crc) as import) ->
+      match
+        List.find_map (function
+            | _, None -> None
+            | _, Some (comp_unit', _) ->
+              if CU.equal comp_unit comp_unit' then Some comp_unit'
+              else None)
+          cmi_imports
+      with
+      | None -> import
+      | Some comp_unit -> comp_unit, crc)
+    cmx_imports
+*)
+
 let write_unit_info info filename =
   let raw_export_info, sections =
     match info.ui_export_info with
@@ -351,8 +373,8 @@ let write_unit_info info filename =
   let raw_info = {
     uir_unit = info.ui_unit;
     uir_defines = info.ui_defines;
-    uir_imports_cmi = info.ui_imports_cmi;
-    uir_imports_cmx = info.ui_imports_cmx;
+    uir_imports_cmi = Array.of_list info.ui_imports_cmi;
+    uir_imports_cmx = Array.of_list info.ui_imports_cmx;
     uir_generic_fns = info.ui_generic_fns;
     uir_export_info = raw_export_info;
     uir_checks = info.ui_checks;

middle_end/compilenv.mli

@@ -133,6 +133,13 @@ val require_global: Compilation_unit.t -> unit
 
 val read_library_info: string -> library_infos
 
+(* CR mshinwell: see comment in .ml
+val ensure_sharing_between_cmi_and_cmx_imports :
+  (_ * (Compilation_unit.t * _) option) list ->
+  (Compilation_unit.t * 'a) list ->
+  (Compilation_unit.t * 'a) list
+*)
+
 type error =
     Not_a_unit_info of string
   | Corrupted_unit_info of string