flambda-backend: Use CU.Name.t for name of .cmi; support import info for parameters (#1753)

To support parameterised libraries, it will help to sharpen the distinction
between `Compilation_unit.Name.t` and `Compilation_unit.t`. In particular, a
`CU.Name.t` will mean the name of a .cmi and a `CU.t` will mean the name of a
.cmo/x.

Accordingly, the `cmi_name` field in `Cmi_format` changes from `CU.t` to
`CU.Name.t`. There is never a `CU.t` for a parameter module since it has no
.cmo/x, so for these, the `CU.t` is removed from the `Cmi_format` altogether. A
non-parameter .cmi still needs it, however, since we need to store the pack
prefix for the implementation .cmo/x. (We don't support pack prefixes for
parameter modules.) Accordingly, the `cmi_kind` field now has two variants:

```
type kind =
  | Normal of { cmi_impl : CU.t }
  | Parameter
```

As it happens, all this forces through a related change in `Import_info.t` so
that we can store import info for a parameter module, which has a CRC but no
compilation unit. Since the format of import info for interfaces and
implementations is diverging, a split API is introduced to `Import_info`. (This
is the same API that #1746 adds, but here it's optional and only used in the few
places that need it.)

Author: lukemaurer

asmcomp/asmlink.ml

@@ -37,7 +37,8 @@ exception Error of error
 
 (* Consistency check between interfaces and implementations *)
 
-module Cmi_consistbl = Consistbl.Make (CU.Name) (CU)
+module Cmi_consistbl =
+  Consistbl.Make (CU.Name) (Import_info.Intf.Nonalias.Kind)
 let crc_interfaces = Cmi_consistbl.create ()
 let interfaces = ref ([] : CU.Name.t list)
 
@@ -58,12 +59,12 @@ let check_consistency file_name unit crc =
     Array.iter
       (fun import ->
         let name = Import_info.name import in
-        let crco = Import_info.crc_with_unit import in
+        let info = Import_info.Intf.info import in
         interfaces := name :: !interfaces;
-        match crco with
+        match info with
           None -> ()
-        | Some (full_name, crc) ->
-            Cmi_consistbl.check crc_interfaces name full_name crc file_name)
+        | Some (kind, crc) ->
+            Cmi_consistbl.check crc_interfaces name kind crc file_name)
       unit.ui_imports_cmi
   with Cmi_consistbl.Inconsistency {
       unit_name = name;
@@ -102,7 +103,7 @@ let check_consistency file_name unit crc =
 let extract_crc_interfaces () =
   Cmi_consistbl.extract !interfaces crc_interfaces
   |> List.map (fun (name, crc_with_unit) ->
-      Import_info.create name ~crc_with_unit)
+      Import_info.Intf.create name crc_with_unit)
 
 let extract_crc_implementations () =
   Cmx_consistbl.extract !implementations crc_implementations
@@ -244,23 +245,21 @@ let make_globals_map units_list ~crc_interfaces =
   let crc_interfaces =
     crc_interfaces
     |> List.map (fun import ->
-         Import_info.name import, Import_info.crc_with_unit import)
+         Import_info.name import, Import_info.crc import)
     |> CU.Name.Tbl.of_list
   in
   let defined =
     List.map (fun (unit, _, impl_crc) ->
         let name = CU.name unit.ui_unit in
         let intf_crc =
           CU.Name.Tbl.find crc_interfaces name
-          |> Option.map (fun (_unit, crc) -> crc)
         in
         CU.Name.Tbl.remove crc_interfaces name;
         let syms = List.map Symbol.for_compilation_unit unit.ui_defines in
         (unit.ui_unit, intf_crc, Some impl_crc, syms))
       units_list
   in
   CU.Name.Tbl.fold (fun name intf acc ->
-      let intf = Option.map (fun (_unit, crc) -> crc) intf in
       (assume_no_prefix name, intf, None, []) :: acc)
     crc_interfaces defined
 

bytecomp/bytelink.ml

@@ -184,7 +184,7 @@ let scan_file obj_name tolink =
 
 (* Consistency check between interfaces *)
 
-module Consistbl = Consistbl.Make (CU.Name) (Compilation_unit)
+module Consistbl = Consistbl.Make (CU.Name) (Import_info.Intf.Nonalias.Kind)
 
 let crc_interfaces = Consistbl.create ()
 let interfaces = ref ([] : CU.Name.t list)
@@ -200,12 +200,12 @@ let check_consistency file_name cu =
     Array.iter
       (fun import ->
         let name = Import_info.name import in
-        let crco = Import_info.crc_with_unit import in
+        let info = Import_info.Intf.info import in
         interfaces := name :: !interfaces;
-        match crco with
+        match info with
           None -> ()
-        | Some (full_name, crc) ->
-            Consistbl.check crc_interfaces name full_name crc file_name)
+        | Some (kind, crc) ->
+            Consistbl.check crc_interfaces name kind crc file_name)
       cu.cu_imports
   with Consistbl.Inconsistency {
       unit_name = name;
@@ -220,7 +220,7 @@ let check_consistency file_name cu =
 let extract_crc_interfaces () =
   Consistbl.extract !interfaces crc_interfaces
   |> List.map (fun (name, crc_with_unit) ->
-       Import_info.create name ~crc_with_unit)
+       Import_info.Intf.create name crc_with_unit)
 
 let clear_crc_interfaces () =
   Consistbl.clear crc_interfaces;

driver/compile_common.ml

@@ -83,15 +83,16 @@ let typecheck_intf info ast =
 
 let emit_signature info ast tsg =
   let sg =
+    let name = Compilation_unit.name info.module_name in
     let kind : Cmi_format.kind =
       if !Clflags.as_parameter then
         Parameter
       else
-        Normal
+        Normal { cmi_impl = info.module_name }
     in
     let alerts = Builtin_attributes.alerts_of_sig ast in
     Env.save_signature ~alerts tsg.Typedtree.sig_type
-      info.module_name kind (info.output_prefix ^ ".cmi")
+      name kind (info.output_prefix ^ ".cmi")
   in
   Typemod.save_signature info.module_name tsg
     info.output_prefix info.source_file info.env sg

file_formats/cmi_format.ml

@@ -21,7 +21,9 @@ type pers_flags =
   | Opaque
 
 type kind =
-  | Normal
+  | Normal of {
+      cmi_impl : Compilation_unit.t;
+    }
   | Parameter
 
 type error =
@@ -58,13 +60,13 @@ module Serialized = Types.Make_wrapped(struct type 'a t = int end)
 type crcs = Import_info.t array  (* smaller on disk than using a list *)
 type flags = pers_flags list
 type header = {
-    header_name : Compilation_unit.t;
+    header_name : Compilation_unit.Name.t;
     header_kind : kind;
     header_sign : Serialized.signature;
 }
 
 type 'sg cmi_infos_generic = {
-    cmi_name : Compilation_unit.t;
+    cmi_name : Compilation_unit.Name.t;
     cmi_kind : kind;
     cmi_sign : 'sg;
     cmi_crcs : crcs;
@@ -192,10 +194,14 @@ let output_cmi filename oc cmi =
   (* BACKPORT END *)
   flush oc;
   let crc = Digest.file filename in
-  let crcs =
-    Array.append [| Import_info.create_normal cmi.cmi_name ~crc:(Some crc) |]
-      cmi.cmi_crcs
+  let my_info =
+    match cmi.cmi_kind with
+    | Normal { cmi_impl } ->
+      Import_info.Intf.create_normal cmi.cmi_name cmi_impl ~crc
+    | Parameter ->
+      Import_info.Intf.create_parameter cmi.cmi_name ~crc
   in
+  let crcs = Array.append [| my_info |] cmi.cmi_crcs in
   output_value oc (crcs : crcs);
   output_value oc (cmi.cmi_flags : flags);
   crc

file_formats/cmi_format.mli

@@ -21,11 +21,13 @@ type pers_flags =
   | Opaque
 
 type kind =
-  | Normal
+  | Normal of {
+      cmi_impl : Compilation_unit.t;
+    }
   | Parameter
 
 type 'sg cmi_infos_generic = {
-    cmi_name : Compilation_unit.t;
+    cmi_name : Compilation_unit.Name.t;
     cmi_kind : kind;
     cmi_sign : 'sg;
     cmi_crcs : Import_info.t array;

testsuite/tests/templates/basic/bad_param_impl.ml

@@ -9,6 +9,8 @@
  ocamlc_byte_exit_status = "2";
  compiler_output = "bad_param_impl.output";
  ocamlc.byte;
+ reason = "error broken, will be fixed by #1764";
+ skip;
  compiler_reference = "bad_param_impl.reference";
  check-ocamlc.byte-output;
 *)

testsuite/tests/templates/basic/test.ml

@@ -8,6 +8,8 @@
  compiler_output = "bad_ref_direct.output";
  ocamlc_byte_exit_status = "2";
  ocamlc.byte;
+ reason = "correct error message not yet implemented";
+ skip;
  compiler_reference = "bad_ref_direct.reference";
  check-ocamlc.byte-output;
 *)

tools/objinfo.ml

@@ -99,10 +99,10 @@ let print_cma_infos (lib : Cmo_format.library) =
 let print_cmi_infos name crcs kind =
   if not !quiet then begin
     let open Cmi_format in
-    printf "Unit name: %a\n" Compilation_unit.output name;
+    printf "Unit name: %a\n" Compilation_unit.Name.output name;
     let is_param =
       match kind with
-      | Normal -> false
+      | Normal _ -> false
       | Parameter -> true
     in
     printf "Is parameter: %s\n" (if is_param then "YES" else "no");

tools/ocamlcmt.ml

@@ -91,7 +91,7 @@ let print_info cmt =
   let imports =
     let imports =
       Array.map (fun import ->
-          Import_info.name import, Import_info.crc_with_unit import)
+          Import_info.name import, Import_info.crc import)
         cmt.cmt_imports
     in
     Array.sort compare_imports imports;
@@ -101,7 +101,7 @@ let print_info cmt =
     let crc =
       match crco with
         None -> dummy_crc
-      | Some (_unit, crc) -> Digest.to_hex crc
+      | Some crc -> Digest.to_hex crc
     in
     Printf.fprintf oc "import: %a %s\n" Compilation_unit.Name.output name crc;
   ) imports;

typing/env.ml

@@ -954,7 +954,11 @@ let components_of_module ~alerts ~uid env ps path addr mty shape =
   }
 
 let read_sign_of_cmi { Persistent_env.Persistent_signature.cmi; _ } =
-  let name = cmi.cmi_name in
+  let name =
+    match cmi.cmi_kind with
+    | Normal { cmi_impl } -> cmi_impl
+    | Parameter -> Misc.fatal_error "Unsupported import of parameter module"
+  in
   let sign = cmi.cmi_sign in
   let flags = cmi.cmi_flags in
   let id = Ident.create_persistent (Compilation_unit.name_as_string name) in
@@ -2643,7 +2647,7 @@ let open_signature
 (* Read a signature from a file *)
 let read_signature modname filename ~add_binding =
   let mda =
-    read_pers_mod (Compilation_unit.name modname) filename ~add_binding
+    read_pers_mod modname filename ~add_binding
   in
   let md = Subst.Lazy.force_module_decl mda.mda_declaration in
   match md.md_type with

typing/env.mli

@@ -463,16 +463,16 @@ val get_unit_name: unit -> Compilation_unit.t option
 
 (* Read, save a signature to/from a file *)
 val read_signature:
-  Compilation_unit.t -> filepath -> add_binding:bool -> signature
+  Compilation_unit.Name.t -> filepath -> add_binding:bool -> signature
         (* Arguments: module name, file name, [add_binding] flag.
            Results: signature. If [add_binding] is true, creates an entry for
            the module in the environment. *)
 val save_signature:
-  alerts:alerts -> signature -> Compilation_unit.t -> Cmi_format.kind
+  alerts:alerts -> signature -> Compilation_unit.Name.t -> Cmi_format.kind
   -> filepath -> Cmi_format.cmi_infos_lazy
         (* Arguments: signature, module name, module kind, file name. *)
 val save_signature_with_imports:
-  alerts:alerts -> signature -> Compilation_unit.t -> Cmi_format.kind
+  alerts:alerts -> signature -> Compilation_unit.Name.t -> Cmi_format.kind
   -> filepath -> Import_info.t array -> Cmi_format.cmi_infos_lazy
         (* Arguments: signature, module name, module kind,
            file name, imported units with their CRCs. *)