weak dependencies with -trans-mod (github/ocamllabs/weak-depends 45e980a,21856a7,merge)

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14719 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

Author: mshinwell

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;