Synchronize with trunk.unused_declarations

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

8 files changed, 58 insertions, 54 deletions

diff --git a/bytecomp/bytelibrarian.ml b/bytecomp/bytelibrarian.ml
index 62d900023d..767a3dca68 100644
--- a/bytecomp/bytelibrarian.ml
+++ b/bytecomp/bytelibrarian.ml
@@ -55,7 +55,7 @@ let add_ccobjs l =
     lib_dllibs := !lib_dllibs @ l.lib_dllibs
   end
 
-let copy_object_file oc name =
+let copy_object_file ppf oc name =
   let file_name =
     try
       find_in_path !load_path name
@@ -69,7 +69,7 @@ let copy_object_file oc name =
       let compunit_pos = input_binary_int ic in
       seek_in ic compunit_pos;
       let compunit = (input_value ic : compilation_unit) in
-      Bytelink.check_consistency file_name compunit;
+      Bytelink.check_consistency ppf file_name compunit;
       copy_compunit ic oc compunit;
       close_in ic;
       [compunit]
@@ -78,7 +78,7 @@ let copy_object_file oc name =
       let toc_pos = input_binary_int ic in
       seek_in ic toc_pos;
       let toc = (input_value ic : library) in
-      List.iter (Bytelink.check_consistency file_name) toc.lib_units;
+      List.iter (Bytelink.check_consistency ppf file_name) toc.lib_units;
       add_ccobjs toc;
       List.iter (copy_compunit ic oc) toc.lib_units;
       close_in ic;
@@ -89,13 +89,13 @@ let copy_object_file oc name =
     End_of_file -> close_in ic; raise(Error(Not_an_object_file file_name))
   | x -> close_in ic; raise x
 
-let create_archive file_list lib_name =
+let create_archive ppf file_list lib_name =
   let outchan = open_out_bin lib_name in
   try
     output_string outchan cma_magic_number;
     let ofs_pos_toc = pos_out outchan in
     output_binary_int outchan 0;
-    let units = List.flatten(List.map (copy_object_file outchan) file_list) in
+    let units = List.flatten(List.map (copy_object_file ppf outchan) file_list) in
     let toc =
       { lib_units = units;
         lib_custom = !Clflags.custom_runtime;
diff --git a/bytecomp/bytelibrarian.mli b/bytecomp/bytelibrarian.mli
index a4250f96d7..2420111593 100644
--- a/bytecomp/bytelibrarian.mli
+++ b/bytecomp/bytelibrarian.mli
@@ -21,7 +21,7 @@
       content table = list of compilation units
 *)
 
-val create_archive: string list -> string -> unit
+val create_archive: Format.formatter -> string list -> string -> unit
 
 type error =
     File_not_found of string
diff --git a/bytecomp/bytelink.ml b/bytecomp/bytelink.ml
index 794a0acb4a..aa4c3d45a4 100644
--- a/bytecomp/bytelink.ml
+++ b/bytecomp/bytelink.ml
@@ -29,6 +29,7 @@ type error =
   | File_exists of string
   | Cannot_open_dll of string
 
+
 exception Error of error
 
 type link_action =
@@ -161,9 +162,10 @@ let scan_file obj_name tolink =
 (* Consistency check between interfaces *)
 
 let crc_interfaces = Consistbl.create ()
+let implementations_defined = ref ([] : (string * string) list)
 
-let check_consistency file_name cu =
-  try
+let check_consistency ppf file_name cu =
+  begin try
     List.iter
       (fun (name, crc) ->
         if name = cu.cu_name
@@ -172,6 +174,15 @@ let check_consistency file_name cu =
       cu.cu_imports
   with Consistbl.Inconsistency(name, user, auth) ->
     raise(Error(Inconsistent_import(name, user, auth)))
+  end;
+  begin try
+    let source = List.assoc cu.cu_name !implementations_defined in
+    Location.print_warning (Location.in_file file_name) ppf
+      (Warnings.Multiple_definition(cu.cu_name, file_name, source))
+  with Not_found -> ()
+  end;
+  implementations_defined :=
+    (cu.cu_name, file_name) :: !implementations_defined
 
 let extract_crc_interfaces () =
   Consistbl.extract crc_interfaces
@@ -182,8 +193,8 @@ let debug_info = ref ([] : (int * string) list)
 
 (* Link in a compilation unit *)
 
-let link_compunit output_fun currpos_fun inchan file_name compunit =
-  check_consistency file_name compunit;
+let link_compunit ppf output_fun currpos_fun inchan file_name compunit =
+  check_consistency ppf file_name compunit;
   seek_in inchan compunit.cu_pos;
   let code_block = String.create compunit.cu_codesize in
   really_input inchan code_block 0 compunit.cu_codesize;
@@ -200,10 +211,10 @@ let link_compunit output_fun currpos_fun inchan file_name compunit =
 
 (* Link in a .cmo file *)
 
-let link_object output_fun currpos_fun file_name compunit =
+let link_object ppf output_fun currpos_fun file_name compunit =
   let inchan = open_in_bin file_name in
   try
-    link_compunit output_fun currpos_fun inchan file_name compunit;
+    link_compunit ppf output_fun currpos_fun inchan file_name compunit;
     close_in inchan
   with
     Symtable.Error msg ->
@@ -213,14 +224,14 @@ let link_object output_fun currpos_fun file_name compunit =
 
 (* Link in a .cma file *)
 
-let link_archive output_fun currpos_fun file_name units_required =
+let link_archive ppf output_fun currpos_fun file_name units_required =
   let inchan = open_in_bin file_name in
   try
     List.iter
       (fun cu ->
          let name = file_name ^ "(" ^ cu.cu_name ^ ")" in
          try
-           link_compunit output_fun currpos_fun inchan name cu
+           link_compunit ppf output_fun currpos_fun inchan name cu
          with Symtable.Error msg ->
            raise(Error(Symbol_error(name, msg))))
       units_required;
@@ -229,11 +240,11 @@ let link_archive output_fun currpos_fun file_name units_required =
 
 (* Link in a .cmo or .cma file *)
 
-let link_file output_fun currpos_fun = function
+let link_file ppf output_fun currpos_fun = function
     Link_object(file_name, unit) ->
-      link_object output_fun currpos_fun file_name unit
+      link_object ppf output_fun currpos_fun file_name unit
   | Link_archive(file_name, units) ->
-      link_archive output_fun currpos_fun file_name units
+      link_archive ppf output_fun currpos_fun file_name units
 
 (* Output the debugging information *)
 (* Format is:
@@ -265,7 +276,7 @@ let make_absolute file =
 
 (* Create a bytecode executable file *)
 
-let link_bytecode tolink exec_name standalone =
+let link_bytecode ppf tolink exec_name standalone =
   Misc.remove_file exec_name; (* avoid permission problems, cf PR#1911 *)
   let outchan =
     open_out_gen [Open_wronly; Open_trunc; Open_creat; Open_binary]
@@ -303,7 +314,7 @@ let link_bytecode tolink exec_name standalone =
     end;
     let output_fun = output_string outchan
     and currpos_fun () = pos_out outchan - start_code in
-    List.iter (link_file output_fun currpos_fun) tolink;
+    List.iter (link_file ppf output_fun currpos_fun) tolink;
     if standalone then Dll.close_all_dlls();
     (* The final STOP instruction *)
     output_byte outchan Opcodes.opSTOP;
@@ -402,7 +413,7 @@ let output_cds_file outfile =
 
 (* Output a bytecode executable as a C file *)
 
-let link_bytecode_as_c tolink outfile =
+let link_bytecode_as_c ppf tolink outfile =
   let outchan = open_out outfile in
   begin try
     (* The bytecode *)
@@ -424,7 +435,7 @@ let link_bytecode_as_c tolink outfile =
       output_code_string outchan code;
       currpos := !currpos + String.length code
     and currpos_fun () = !currpos in
-    List.iter (link_file output_fun currpos_fun) tolink;
+    List.iter (link_file ppf output_fun currpos_fun) tolink;
     (* The final STOP instruction *)
     Printf.fprintf outchan "\n0x%x};\n\n" Opcodes.opSTOP;
     (* The table of global data *)
@@ -491,7 +502,7 @@ let fix_exec_name name =
 
 (* Main entry point (build a custom runtime if needed) *)
 
-let link objfiles output_name =
+let link ppf objfiles output_name =
   let objfiles =
     if !Clflags.nopervasives then objfiles
     else if !Clflags.output_c_object then "stdlib.cma" :: objfiles
@@ -501,19 +512,23 @@ let link objfiles output_name =
   Clflags.ccopts := !lib_ccopts @ !Clflags.ccopts; (* put user's opts first *)
   Clflags.dllibs := !lib_dllibs @ !Clflags.dllibs; (* put user's DLLs first *)
   if not !Clflags.custom_runtime then
-    link_bytecode tolink output_name true
+    link_bytecode ppf tolink output_name true
   else if not !Clflags.output_c_object then begin
     let bytecode_name = Filename.temp_file "camlcode" "" in
     let prim_name = Filename.temp_file "camlprim" ".c" in
     try
-      link_bytecode tolink bytecode_name false;
+      link_bytecode ppf tolink bytecode_name false;
       let poc = open_out prim_name in
       output_string poc "\
         #ifdef __cplusplus\n\
         extern \"C\" {\n\
         #endif\n\
         #ifdef _WIN64\n\
+        #ifdef __MINGW32__\n\
+        typedef long long value;\n\
+        #else\n\
         typedef __int64 value;\n\
+        #endif\n\
         #else\n\
         typedef long value;\n\
         #endif\n";
@@ -540,7 +555,7 @@ let link objfiles output_name =
     if Sys.file_exists c_file then raise(Error(File_exists c_file));
     let temps = ref [] in
     try
-      link_bytecode_as_c tolink c_file;
+      link_bytecode_as_c ppf tolink c_file;
       if not (Filename.check_suffix output_name ".c") then begin
         temps := c_file :: !temps;
         if Ccomp.compile_file c_file <> 0 then raise(Error Custom_runtime);
diff --git a/bytecomp/bytelink.mli b/bytecomp/bytelink.mli
index 375bde0d5d..1366a1686f 100644
--- a/bytecomp/bytelink.mli
+++ b/bytecomp/bytelink.mli
@@ -14,9 +14,9 @@
 
 (* Link .cmo files and produce a bytecode executable. *)
 
-val link: string list -> string -> unit
+val link : Format.formatter -> string list -> string -> unit
 
-val check_consistency: string -> Cmo_format.compilation_unit -> unit
+val check_consistency: Format.formatter -> string -> Cmo_format.compilation_unit -> unit
 
 val extract_crc_interfaces: unit -> (string * Digest.t) list
 
diff --git a/bytecomp/bytepackager.ml b/bytecomp/bytepackager.ml
index 2385b99c43..fc53d54d6d 100644
--- a/bytecomp/bytepackager.ml
+++ b/bytecomp/bytepackager.ml
@@ -124,10 +124,10 @@ let read_member_info file =
    Accumulate relocs, debug info, etc.
    Return size of bytecode. *)
 
-let rename_append_bytecode packagename oc mapping defined ofs prefix subst objfile compunit =
+let rename_append_bytecode ppf packagename oc mapping defined ofs prefix subst objfile compunit =
   let ic = open_in_bin objfile in
   try
-    Bytelink.check_consistency objfile compunit;
+    Bytelink.check_consistency ppf objfile compunit;
     List.iter
       (rename_relocation packagename objfile mapping defined ofs)
       compunit.cu_reloc;
@@ -148,20 +148,20 @@ let rename_append_bytecode packagename oc mapping defined ofs prefix subst objfi
 (* Same, for a list of .cmo and .cmi files.
    Return total size of bytecode. *)
 
-let rec rename_append_bytecode_list packagename oc mapping defined ofs prefix subst = function
+let rec rename_append_bytecode_list ppf packagename oc mapping defined ofs prefix subst = function
     [] ->
       ofs
   | m :: rem ->
       match m.pm_kind with
       | PM_intf ->
-          rename_append_bytecode_list packagename oc mapping defined ofs prefix subst rem
+          rename_append_bytecode_list ppf packagename oc mapping defined ofs prefix subst rem
       | PM_impl compunit ->
           let size =
-            rename_append_bytecode packagename oc mapping defined ofs prefix subst
+            rename_append_bytecode ppf packagename oc mapping defined ofs prefix subst
                                    m.pm_file compunit in
           let id = Ident.create_persistent m.pm_name in
           let root = Path.Pident (Ident.create_persistent prefix) in
-          rename_append_bytecode_list packagename
+          rename_append_bytecode_list ppf packagename
             oc mapping (id :: defined)
             (ofs + size) prefix (Subst.add_module id (Path.Pdot (root, Ident.name id, Path.nopos)) subst) rem
 
@@ -186,7 +186,7 @@ let build_global_target oc target_name members mapping pos coercion =
 
 (* Build the .cmo file obtained by packaging the given .cmo files. *)
 
-let package_object_files files targetfile targetname coercion =
+let package_object_files ppf files targetfile targetname coercion =
   let members =
     map_left_right read_member_info files in
   let unit_names =
@@ -203,7 +203,7 @@ let package_object_files files targetfile targetname coercion =
     let pos_depl = pos_out oc in
     output_binary_int oc 0;
     let pos_code = pos_out oc in
-    let ofs = rename_append_bytecode_list targetname oc mapping [] 0 targetname Subst.identity members in
+    let ofs = rename_append_bytecode_list ppf targetname oc mapping [] 0 targetname Subst.identity members in
     build_global_target oc targetname members mapping ofs coercion;
     let pos_debug = pos_out oc in
     if !Clflags.debug && !events <> [] then
@@ -233,7 +233,7 @@ let package_object_files files targetfile targetname coercion =
 
 (* The entry point *)
 
-let package_files files targetfile =
+let package_files ppf files targetfile =
     let files =
     List.map
 	(fun f ->
@@ -245,7 +245,7 @@ let package_files files targetfile =
     let targetname = String.capitalize(Filename.basename prefix) in
     try
       let coercion = Typemod.package_units files targetcmi targetname in
-    let ret = package_object_files files targetfile targetname coercion in 
+    let ret = package_object_files ppf files targetfile targetname coercion in
     ret
   with x ->
     remove_file targetfile; raise x
diff --git a/bytecomp/bytepackager.mli b/bytecomp/bytepackager.mli
index 2a599d9f98..696b12aa09 100644
--- a/bytecomp/bytepackager.mli
+++ b/bytecomp/bytepackager.mli
@@ -15,7 +15,7 @@
 (* "Package" a set of .cmo files into one .cmo file having the
    original compilation units as sub-modules. *)
 
-val package_files: string list -> string -> unit
+val package_files: Format.formatter -> string list -> string -> unit
 
 type error =
     Forward_reference of string * Ident.t
diff --git a/bytecomp/simplif.ml b/bytecomp/simplif.ml
index e26524e676..d5f85fc3a8 100644
--- a/bytecomp/simplif.ml
+++ b/bytecomp/simplif.ml
@@ -260,6 +260,9 @@ let simplify_exits lam =
 
 let simplify_lets lam =
 
+  (* Disable optimisations for bytecode compilation with -g flag *)
+  let optimize = !Clflags.native_code || not !Clflags.debug in
+
   (* First pass: count the occurrences of all let-bound identifiers *)
 
   let occ = (Hashtbl.create 83: (Ident.t, int ref) Hashtbl.t) in
@@ -307,7 +310,7 @@ let simplify_lets lam =
       count bv l1; List.iter (count bv) ll
   | Lfunction(kind, params, l) ->
       count Tbl.empty l
-  | Llet(str, v, Lvar w, l2) when not !Clflags.debug ->
+  | Llet(str, v, Lvar w, l2) when optimize ->
       (* v will be replaced by w in l2, so each occurrence of v in l2
          increases w's refcount *)
       count (bind_var bv v) l2;
@@ -361,7 +364,6 @@ let simplify_lets lam =
      and substitute the bindings of variables used exactly once. *)
 
   let subst = Hashtbl.create 83 in
-  let optimize = !Clflags.native_code || not !Clflags.debug in
 
 (* This (small)  optimisation is always legal, it may uncover some
    tail call later on. *)
diff --git a/bytecomp/translclass.ml b/bytecomp/translclass.ml
index f06e43b461..843ef5a90a 100644
--- a/bytecomp/translclass.ml
+++ b/bytecomp/translclass.ml
@@ -142,15 +142,7 @@ let rec build_object_init cl_table obj params inh_init obj_init cl =
                    (inh_init, obj_init, has_init)
                | Cf_init _ ->
                    (inh_init, obj_init, true)
-               | Cf_let (rec_flag, defs, vals) ->
-                   (inh_init,
-                    Translcore.transl_let rec_flag defs
-                      (List.fold_right
-                         (fun (id, expr) rem ->
-                            lsequence (Lifused(id, set_inst_var obj id expr))
-                                      rem)
-                         vals obj_init),
-                    has_init))
+            )
             str.cl_field
             (inh_init, obj_init obj, false)
         in
@@ -292,11 +284,6 @@ let rec build_class_init cla cstr super inh_init cl_init msubst top cl =
                 (inh_init, cl_init,
                  Lvar (Meths.find name str.cl_meths) :: met_code @ methods,
                  values)
-            | Cf_let (rec_flag, defs, vals) ->
-                let vals =
-                  List.map (function (id, _) -> (Ident.name id, id)) vals
-                in
-                (inh_init, cl_init, methods, vals @ values)
             | Cf_init exp ->
                 (inh_init,
                  Lsequence(mkappl (oo_prim "add_initializer",