Record "weak dependencies" with -trans-mod

Currently, -trans-mod simply ignores dependencies on unused module
aliases. This commit changes this behaviour so that unused module aliases are
included in the list of imported interfaces but without a CRC.

This change means that the imported interfaces list (as displayed by
`ocamlobjinfo`) is now an accurate representation of what was used during the
compilation of a module. Whilst the contents of unused module aliases is not
used, their existance is still required in order for the module to compile
successfully.

Previously, a simple file `foo.ml` containing an unused module alias to `Bar`
would have the following output from `ocamlobjinfo` for `foo.cmo`:

    File foo.cmo
    Unit name: Foo
    Interfaces imported:
            4ad29aa1be509426919169d97aad0a82        Pervasives
            df1763e3e7e64b9b8ebea6f93b0a95b3        Foo
    Uses unsafe features: no
    Force link: no

with this patch it instead has output:

    File foo.cmo
    Unit name: Foo
    Interfaces imported:
            --------------------------------        Bar
            6cda9672639792333f53de8e8ff9e71d        Pervasives
            df1763e3e7e64b9b8ebea6f93b0a95b3        Foo
    Uses unsafe features: no
    Force link: no

This is useful because now we can see that if `bar.cmi` is deleted then this
module will no longer compile successfully.

This commit acheives this change by making the digests optional in every list
of imported interfaces and implementations.

In the case of implementations this replaces the previous use of the
`cmx_not_found_crc` dummy value for implementations where a `.cmx` was not
available.

`ocamlobjinfo` and `read_cmt` print imports with an empty digest as a line of
dashes. All other uses of the imported interface lists ignore imports with an
empty digest, leaving their behaviour unchanged.

This commit also adds a (new) description of -trans-mod to the man pages.

Author: lpw25

asmcomp/asmlink.ml

@@ -33,31 +33,37 @@ exception Error of error
 (* Consistency check between interfaces and implementations *)
 
 let crc_interfaces = Consistbl.create ()
+let interfaces = ref ([] : string list)
 let crc_implementations = Consistbl.create ()
-let extra_implementations = ref ([] : string list)
+let implementations = ref ([] : string list)
 let implementations_defined = ref ([] : (string * string) list)
 let cmx_required = ref ([] : string list)
 
 let check_consistency file_name unit crc =
   begin try
     List.iter
-      (fun (name, crc) ->
-        if name = unit.ui_name
-        then Consistbl.set crc_interfaces name crc file_name
-        else Consistbl.check crc_interfaces name crc file_name)
+      (fun (name, crco) ->
+        interfaces := name :: !interfaces;
+        match crco with
+          None -> ()
+        | Some crc ->
+            if name = unit.ui_name
+            then Consistbl.set crc_interfaces name crc file_name
+            else Consistbl.check crc_interfaces name crc file_name)
       unit.ui_imports_cmi
   with Consistbl.Inconsistency(name, user, auth) ->
     raise(Error(Inconsistent_interface(name, user, auth)))
   end;
   begin try
     List.iter
-      (fun (name, crc) ->
-        if crc <> cmx_not_found_crc then
-          Consistbl.check crc_implementations name crc file_name
-        else if List.mem name !cmx_required then
-          raise(Error(Missing_cmx(file_name, name)))
-        else
-          extra_implementations := name :: !extra_implementations)
+      (fun (name, crco) ->
+        implementations := name :: !implementations;
+        match crco with
+            None ->
+              if List.mem name !cmx_required then
+                raise(Error(Missing_cmx(file_name, name)))
+          | Some crc ->
+              Consistbl.check crc_implementations name crc file_name)
       unit.ui_imports_cmx
   with Consistbl.Inconsistency(name, user, auth) ->
     raise(Error(Inconsistent_implementation(name, user, auth)))
@@ -67,20 +73,17 @@ let check_consistency file_name unit crc =
     raise (Error(Multiple_definition(unit.ui_name, file_name, source)))
   with Not_found -> ()
   end;
+  implementations := unit.ui_name :: !implementations;
   Consistbl.set crc_implementations unit.ui_name crc file_name;
   implementations_defined :=
     (unit.ui_name, file_name) :: !implementations_defined;
   if unit.ui_symbol <> unit.ui_name then
     cmx_required := unit.ui_name :: !cmx_required
 
 let extract_crc_interfaces () =
-  Consistbl.extract crc_interfaces
+  Consistbl.extract !interfaces crc_interfaces
 let extract_crc_implementations () =
-  List.fold_left
-    (fun ncl n ->
-      if List.mem_assoc n ncl then ncl else (n, cmx_not_found_crc) :: ncl)
-    (Consistbl.extract crc_implementations)
-    !extra_implementations
+  Consistbl.extract !implementations crc_implementations
 
 (* Add C objects and options and "custom" info from a library descriptor.
    See bytecomp/bytelink.ml for comments on the order of C objects. *)
@@ -214,10 +217,14 @@ let make_startup_file ppf filename units_list =
     (Cmmgen.globals_map
        (List.map
           (fun (unit,_,crc) ->
-             try (unit.ui_name, List.assoc unit.ui_name unit.ui_imports_cmi,
-                  crc,
-                  unit.ui_defines)
-             with Not_found -> assert false)
+               let intf_crc =
+                 try
+                   match List.assoc unit.ui_name unit.ui_imports_cmi with
+                     None -> assert false
+                   | Some crc -> crc
+                 with Not_found -> assert false
+               in
+                 (unit.ui_name, intf_crc, crc, unit.ui_defines))
           units_list));
   compile_phrase(Cmmgen.data_segment_table ("_startup" :: name_list));
   compile_phrase(Cmmgen.code_segment_table ("_startup" :: name_list));

asmcomp/asmlink.mli

@@ -21,8 +21,8 @@ val link_shared: formatter -> string list -> string -> unit
 val call_linker_shared: string list -> string -> unit
 
 val check_consistency: string -> Cmx_format.unit_infos -> Digest.t -> unit
-val extract_crc_interfaces: unit -> (string * Digest.t) list
-val extract_crc_implementations: unit -> (string * Digest.t) list
+val extract_crc_interfaces: unit -> (string * Digest.t option) list
+val extract_crc_implementations: unit -> (string * Digest.t option) list
 
 type error =
     File_not_found of string

asmcomp/asmpackager.ml

@@ -130,7 +130,7 @@ let build_package_cmx members cmxfile =
           List.flatten (List.map (fun info -> info.ui_defines) units) @
           [ui.ui_symbol];
       ui_imports_cmi =
-          (ui.ui_name, Env.crc_of_unit ui.ui_name) ::
+          (ui.ui_name, Some (Env.crc_of_unit ui.ui_name)) ::
           filter(Asmlink.extract_crc_interfaces());
       ui_imports_cmx =
           filter(Asmlink.extract_crc_implementations());

asmcomp/cmx_format.mli

@@ -26,8 +26,9 @@ type unit_infos =
   { mutable ui_name: string;                    (* Name of unit implemented *)
     mutable ui_symbol: string;            (* Prefix for symbols *)
     mutable ui_defines: string list;      (* Unit and sub-units implemented *)
-    mutable ui_imports_cmi: (string * Digest.t) list; (* Interfaces imported *)
-    mutable ui_imports_cmx: (string * Digest.t) list; (* Infos imported *)
+    mutable ui_imports_cmi:
+              (string * Digest.t option) list; (* Interfaces imported *)
+    mutable ui_imports_cmx:(string * Digest.t option) list; (* Infos imported *)
     mutable ui_approx: Clambda.value_approximation; (* Approx of the structure*)
     mutable ui_curry_fun: int list;             (* Currying functions needed *)
     mutable ui_apply_fun: int list;             (* Apply functions needed *)
@@ -49,8 +50,8 @@ type library_infos =
 type dynunit = {
   dynu_name: string;
   dynu_crc: Digest.t;
-  dynu_imports_cmi: (string * Digest.t) list;
-  dynu_imports_cmx: (string * Digest.t) list;
+  dynu_imports_cmi: (string * Digest.t option) list;
+  dynu_imports_cmx: (string * Digest.t option) list;
   dynu_defines: string list;
 }
 

asmcomp/compilenv.ml

@@ -143,9 +143,6 @@ let read_library_info filename =
 
 (* Read and cache info on global identifiers *)
 
-let cmx_not_found_crc =
-  "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000"
-
 let get_global_info global_ident = (
   let modname = Ident.name global_ident in
   if modname = current_unit.ui_name then
@@ -161,9 +158,9 @@ let get_global_info global_ident = (
           let (ui, crc) = read_unit_info filename in
           if ui.ui_name <> modname then
             raise(Error(Illegal_renaming(modname, ui.ui_name, filename)));
-          (Some ui, crc)
+          (Some ui, Some crc)
         with Not_found ->
-          (None, cmx_not_found_crc) in
+          (None, None) in
       current_unit.ui_imports_cmx <-
         (modname, crc) :: current_unit.ui_imports_cmx;
       Hashtbl.add global_infos_table modname infos;
@@ -231,7 +228,7 @@ let write_unit_info info filename =
   close_out oc
 
 let save_unit_info filename =
-  current_unit.ui_imports_cmi <- Env.imported_units();
+  current_unit.ui_imports_cmi <- Env.imports();
   write_unit_info current_unit filename
 
 

asmcomp/compilenv.mli

@@ -79,10 +79,6 @@ val cache_unit_info: unit_infos -> unit
            honored by [symbol_for_global] and [global_approx]
            without looking at the corresponding .cmx file. *)
 
-val cmx_not_found_crc: Digest.t
-        (* Special digest used in the [ui_imports_cmx] list to signal
-           that no [.cmx] file was found and used for the imported unit *)
-
 val read_library_info: string -> library_infos
 
 type error =

boot/ocamlc

@@ -158,15 +158,20 @@ let scan_file obj_name tolink =
 (* Consistency check between interfaces *)
 
 let crc_interfaces = Consistbl.create ()
+let interfaces = ref ([] : string list)
 let implementations_defined = ref ([] : (string * string) list)
 
 let check_consistency ppf file_name cu =
   begin try
     List.iter
-      (fun (name, crc) ->
-        if name = cu.cu_name
-        then Consistbl.set crc_interfaces name crc file_name
-        else Consistbl.check crc_interfaces name crc file_name)
+      (fun (name, crco) ->
+        interfaces := name :: !interfaces;
+        match crco with
+          None -> ()
+        | Some crc ->
+            if name = cu.cu_name
+            then Consistbl.set crc_interfaces name crc file_name
+            else Consistbl.check crc_interfaces name crc file_name)
       cu.cu_imports
   with Consistbl.Inconsistency(name, user, auth) ->
     raise(Error(Inconsistent_import(name, user, auth)))
@@ -183,7 +188,11 @@ let check_consistency ppf file_name cu =
     (cu.cu_name, file_name) :: !implementations_defined
 
 let extract_crc_interfaces () =
-  Consistbl.extract crc_interfaces
+  Consistbl.extract !interfaces crc_interfaces
+
+let clear_crc_interfaces () =
+  Consistbl.clear crc_interfaces;
+  interfaces := []
 
 (* Record compilation events *)
 
@@ -307,7 +316,7 @@ let link_bytecode ppf tolink exec_name standalone =
     (* The bytecode *)
     let start_code = pos_out outchan in
     Symtable.init();
-    Consistbl.clear crc_interfaces;
+    clear_crc_interfaces ();
     let sharedobjs = List.map Dll.extract_dll_name !Clflags.dllibs in
     let check_dlls = standalone && Config.target = Config.host in
     if check_dlls then begin
@@ -440,7 +449,7 @@ let link_bytecode_as_c ppf tolink outfile =
 \n           char **argv);\n";
     output_string outchan "static int caml_code[] = {\n";
     Symtable.init();
-    Consistbl.clear crc_interfaces;
+    clear_crc_interfaces ();
     let currpos = ref 0 in
     let output_fun code =
       output_code_string outchan code;

boot/ocamldep

@@ -17,7 +17,7 @@ val link : Format.formatter -> string list -> string -> unit
 val check_consistency:
   Format.formatter -> string -> Cmo_format.compilation_unit -> unit
 
-val extract_crc_interfaces: unit -> (string * Digest.t) list
+val extract_crc_interfaces: unit -> (string * Digest.t option) list
 
 type error =
     File_not_found of string

boot/ocamllex

@@ -233,7 +233,8 @@ let package_object_files ppf files targetfile targetname coercion =
         cu_pos = pos_code;
         cu_codesize = pos_debug - pos_code;
         cu_reloc = List.rev !relocs;
-        cu_imports = (targetname, Env.crc_of_unit targetname) :: imports;
+        cu_imports =
+          (targetname, Some (Env.crc_of_unit targetname)) :: imports;
         cu_primitives = !primitives;
         cu_force_link = !force_link;
         cu_debug = if pos_final > pos_debug then pos_debug else 0;

bytecomp/bytelink.ml

@@ -27,7 +27,8 @@ type compilation_unit =
     mutable cu_pos: int;                (* Absolute position in file *)
     cu_codesize: int;                   (* Size of code block *)
     cu_reloc: (reloc_info * int) list;  (* Relocation information *)
-    cu_imports: (string * Digest.t) list; (* Names and CRC of intfs imported *)
+    cu_imports:
+      (string * Digest.t option) list; (* Names and CRC of intfs imported *)
     cu_primitives: string list;         (* Primitives declared inside *)
     mutable cu_force_link: bool;        (* Must be linked even if unref'ed *)
     mutable cu_debug: int;              (* Position of debugging info, or 0 *)

bytecomp/bytelink.mli

@@ -381,7 +381,7 @@ let to_file outchan unit_name code =
       cu_pos = pos_code;
       cu_codesize = !out_position;
       cu_reloc = List.rev !reloc_info;
-      cu_imports = Env.imported_units();
+      cu_imports = Env.imports();
       cu_primitives = List.map Primitive.byte_name
                                !Translmod.primitive_declarations;
       cu_force_link = false;

bytecomp/bytepackager.ml

@@ -300,7 +300,7 @@ let init_toplevel () =
     Dll.init_toplevel dllpath;
     (* Recover CRC infos for interfaces *)
     let crcintfs =
-      try (Obj.magic (sect.read_struct "CRCS") : (string * Digest.t) list)
+      try (Obj.magic (sect.read_struct "CRCS") : (string * Digest.t option) list)
       with Not_found -> [] in
     (* Done *)
     sect.close_reader();

bytecomp/cmo_format.mli

@@ -29,7 +29,7 @@ val data_primitive_names: unit -> string
 
 (* Functions for the toplevel *)
 
-val init_toplevel: unit -> (string * Digest.t) list
+val init_toplevel: unit -> (string * Digest.t option) list
 val update_global_table: unit -> unit
 val get_global_value: Ident.t -> Obj.t
 val is_global_defined: Ident.t -> bool

bytecomp/emitcode.ml

@@ -267,7 +267,7 @@ let mk_thread f =
 
 let mk_trans_mod f =
   "-trans-mod", Arg.Unit f,
-  " Make typing and linking only depend on normalized paths"
+  " Do not import unused module aliases"
 
 let mk_unsafe f =
   "-unsafe", Arg.Unit f,

bytecomp/symtable.ml

@@ -532,6 +532,9 @@ Build a bytecode object file (.cmo file) and its associated compiled
 system "threads" library described in
 .IR The\ OCaml\ user's\ manual .
 .TP
+.B \-trans-mod
+Do not import unused module aliases.
+.TP
 .B \-unsafe
 Turn bound checking off for array and string accesses (the
 .BR v.(i) and s.[i]

bytecomp/symtable.mli

@@ -506,6 +506,9 @@ apply to the way the extra native objects have been compiled (under
 system threads library described in
 .IR "The OCaml user's manual" .
 .TP
+.B \-trans-mod
+Do not import unused module aliases.
+.TP
 .B \-unsafe
 Turn bound checking off for array and string accesses (the
 .BR v.(i) and s.[i]

driver/main_args.ml

@@ -79,13 +79,16 @@ let allow_extension = ref true
 let check_consistency file_name cu =
   try
     List.iter
-      (fun (name, crc) ->
-        if name = cu.cu_name then
-          Consistbl.set !crc_interfaces name crc file_name
-        else if !allow_extension then
-          Consistbl.check !crc_interfaces name crc file_name
-        else
-          Consistbl.check_noadd !crc_interfaces name crc file_name)
+      (fun (name, crco) ->
+         match crco with
+           None -> ()
+         | Some crc ->
+             if name = cu.cu_name then
+               Consistbl.set !crc_interfaces name crc file_name
+             else if !allow_extension then
+               Consistbl.check !crc_interfaces name crc file_name
+             else
+               Consistbl.check_noadd !crc_interfaces name crc file_name)
       cu.cu_imports
   with Consistbl.Inconsistency(name, user, auth) ->
          raise(Error(Inconsistent_import name))
@@ -113,15 +116,21 @@ let prohibit names =
 (* Initialize the crc_interfaces table with a list of units with fixed CRCs *)
 
 let add_available_units units =
-  List.iter (fun (unit, crc) -> Consistbl.set !crc_interfaces unit crc "")
-            units
+  List.iter
+    (fun (unit, crc) -> Consistbl.set !crc_interfaces unit crc "")
+    units
 
 (* Default interface CRCs: those found in the current executable *)
 let default_crcs = ref []
 
 let default_available_units () =
   clear_available_units();
-  add_available_units !default_crcs;
+  List.iter
+    (fun (unit, crco) ->
+       match crco with
+         None -> ()
+       | Some crc -> Consistbl.set !crc_interfaces unit crc "")
+    !default_crcs;
   allow_extension := true
 
 (* Initialize the linker tables and everything *)
@@ -161,7 +170,7 @@ let digest_interface unit loadpath =
     close_in ic;
     let crc =
       match cmi.Cmi_format.cmi_crcs with
-        (_, crc) :: _ -> crc
+        (_, Some crc) :: _ -> crc
       | _             -> raise(Error(Corrupted_interface filename))
     in
     crc