Print warnings on the warnings formatter in the couple of places that don't

Except the OCAMLPARAM stuff, as that runs before the command line
warning settings are even parsed, so while they are reported using the
normal warnings code, they don't look like normal warnings.

Author: v-gb

Diff for: bytecomp/bytelibrarian.ml

@@ -55,7 +55,7 @@ let add_ccobjs l =
     lib_dllibs := !lib_dllibs @ l.lib_dllibs
   end
 
-let copy_object_file ppf oc name =
+let copy_object_file oc name =
   let file_name =
     try
       find_in_path !load_path name
@@ -68,7 +68,7 @@ let copy_object_file ppf 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 ppf file_name compunit;
+      Bytelink.check_consistency file_name compunit;
       copy_compunit ic oc compunit;
       close_in ic;
       [compunit]
@@ -77,7 +77,7 @@ let copy_object_file ppf 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 ppf file_name) toc.lib_units;
+      List.iter (Bytelink.check_consistency file_name) toc.lib_units;
       add_ccobjs toc;
       List.iter (copy_compunit ic oc) toc.lib_units;
       close_in ic;
@@ -88,14 +88,14 @@ let copy_object_file ppf 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 ppf file_list lib_name =
+let create_archive 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 ppf outchan) file_list) in
+      List.flatten(List.map (copy_object_file outchan) file_list) in
     let toc =
       { lib_units = units;
         lib_custom = !Clflags.custom_runtime;

Diff for: bytecomp/bytelibrarian.mli

@@ -22,7 +22,7 @@
       content table = list of compilation units
 *)
 
-val create_archive: Format.formatter -> string list -> string -> unit
+val create_archive: string list -> string -> unit
 
 type error =
     File_not_found of string

Diff for: bytecomp/bytelink.ml

@@ -169,7 +169,7 @@ let crc_interfaces = Consistbl.create ()
 let interfaces = ref ([] : string list)
 let implementations_defined = ref ([] : (string * string) list)
 
-let check_consistency ppf file_name cu =
+let check_consistency file_name cu =
   begin try
     List.iter
       (fun (name, crco) ->
@@ -186,7 +186,7 @@ let check_consistency ppf file_name cu =
   end;
   begin try
     let source = List.assoc cu.cu_name !implementations_defined in
-    Location.print_warning (Location.in_file file_name) ppf
+    Location.prerr_warning (Location.in_file file_name)
       (Warnings.Multiple_definition(cu.cu_name,
                                     Location.show_filename file_name,
                                     Location.show_filename source))
@@ -208,8 +208,8 @@ let debug_info = ref ([] : (int * Instruct.debug_event list * string list) list)
 
 (* Link in a compilation unit *)
 
-let link_compunit ppf output_fun currpos_fun inchan file_name compunit =
-  check_consistency ppf file_name compunit;
+let link_compunit output_fun currpos_fun inchan file_name compunit =
+  check_consistency file_name compunit;
   seek_in inchan compunit.cu_pos;
   let code_block = LongString.input_bytes inchan compunit.cu_codesize in
   Symtable.patch_object code_block compunit.cu_reloc;
@@ -230,10 +230,10 @@ let link_compunit ppf output_fun currpos_fun inchan file_name compunit =
 
 (* Link in a .cmo file *)
 
-let link_object ppf output_fun currpos_fun file_name compunit =
+let link_object output_fun currpos_fun file_name compunit =
   let inchan = open_in_bin file_name in
   try
-    link_compunit ppf output_fun currpos_fun inchan file_name compunit;
+    link_compunit output_fun currpos_fun inchan file_name compunit;
     close_in inchan
   with
     Symtable.Error msg ->
@@ -243,14 +243,14 @@ let link_object ppf output_fun currpos_fun file_name compunit =
 
 (* Link in a .cma file *)
 
-let link_archive ppf output_fun currpos_fun file_name units_required =
+let link_archive 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 ppf output_fun currpos_fun inchan name cu
+           link_compunit output_fun currpos_fun inchan name cu
          with Symtable.Error msg ->
            raise(Error(Symbol_error(name, msg))))
       units_required;
@@ -259,11 +259,11 @@ let link_archive ppf output_fun currpos_fun file_name units_required =
 
 (* Link in a .cmo or .cma file *)
 
-let link_file ppf output_fun currpos_fun = function
+let link_file output_fun currpos_fun = function
     Link_object(file_name, unit) ->
-      link_object ppf output_fun currpos_fun file_name unit
+      link_object output_fun currpos_fun file_name unit
   | Link_archive(file_name, units) ->
-      link_archive ppf output_fun currpos_fun file_name units
+      link_archive output_fun currpos_fun file_name units
 
 (* Output the debugging information *)
 (* Format is:
@@ -298,7 +298,7 @@ let make_absolute file =
 
 (* Create a bytecode executable file *)
 
-let link_bytecode ppf tolink exec_name standalone =
+let link_bytecode tolink exec_name standalone =
   (* Avoid the case where the specified exec output file is the same as
      one of the objects to be linked *)
   List.iter (function
@@ -343,7 +343,7 @@ let link_bytecode ppf tolink exec_name standalone =
     end;
     let output_fun = output_bytes outchan
     and currpos_fun () = pos_out outchan - start_code in
-    List.iter (link_file ppf output_fun currpos_fun) tolink;
+    List.iter (link_file output_fun currpos_fun) tolink;
     if check_dlls then Dll.close_all_dlls();
     (* The final STOP instruction *)
     output_byte outchan Opcodes.opSTOP;
@@ -444,7 +444,7 @@ let output_cds_file outfile =
 
 (* Output a bytecode executable as a C file *)
 
-let link_bytecode_as_c ppf tolink outfile =
+let link_bytecode_as_c tolink outfile =
   let outchan = open_out outfile in
   begin try
     (* The bytecode *)
@@ -464,7 +464,7 @@ let link_bytecode_as_c ppf tolink outfile =
       output_code_string outchan code;
       currpos := !currpos + Bytes.length code
     and currpos_fun () = !currpos in
-    List.iter (link_file ppf output_fun currpos_fun) tolink;
+    List.iter (link_file output_fun currpos_fun) tolink;
     (* The final STOP instruction *)
     Printf.fprintf outchan "\n0x%x};\n\n" Opcodes.opSTOP;
     (* The table of global data *)
@@ -565,7 +565,7 @@ let fix_exec_name name =
 
 (* Main entry point (build a custom runtime if needed) *)
 
-let link ppf objfiles output_name =
+let link objfiles output_name =
   let objfiles =
     if !Clflags.nopervasives then objfiles
     else if !Clflags.output_c_object then "stdlib.cma" :: objfiles
@@ -584,7 +584,7 @@ let link ppf objfiles output_name =
                                                    (* put user's opts first *)
   Clflags.dllibs := !lib_dllibs @ !Clflags.dllibs; (* put user's DLLs first *)
   if not !Clflags.custom_runtime then
-    link_bytecode ppf tolink output_name true
+    link_bytecode tolink output_name true
   else if not !Clflags.output_c_object then begin
     let bytecode_name = Filename.temp_file "camlcode" "" in
     let prim_name =
@@ -593,7 +593,7 @@ let link ppf objfiles output_name =
       else
         Filename.temp_file "camlprim" ".c" in
     try
-      link_bytecode ppf tolink bytecode_name false;
+      link_bytecode tolink bytecode_name false;
       let poc = open_out prim_name in
       (* note: builds will not be reproducible if the C code contains macros
          such as __FILE__. *)
@@ -646,7 +646,7 @@ let link ppf objfiles output_name =
       else basename ^ Config.ext_obj
     in
     try
-      link_bytecode_as_c ppf tolink c_file;
+      link_bytecode_as_c tolink c_file;
       if not (Filename.check_suffix output_name ".c") then begin
         temps := c_file :: !temps;
         if Ccomp.compile_file ~output:obj_file ?stable_name c_file <> 0 then

Diff for: bytecomp/bytelink.mli

@@ -15,11 +15,10 @@
 
 (* Link .cmo files and produce a bytecode executable. *)
 
-val link : Format.formatter -> string list -> string -> unit
+val link : string list -> string -> unit
 val reset : unit -> unit
 
-val check_consistency:
-  Format.formatter -> string -> Cmo_format.compilation_unit -> unit
+val check_consistency: string -> Cmo_format.compilation_unit -> unit
 
 val extract_crc_interfaces: unit -> (string * Digest.t option) list
 

Diff for: bytecomp/bytepackager.ml

@@ -132,11 +132,11 @@ let read_member_info file = (
    Accumulate relocs, debug info, etc.
    Return size of bytecode. *)
 
-let rename_append_bytecode ppf packagename oc mapping defined ofs prefix subst
+let rename_append_bytecode packagename oc mapping defined ofs prefix subst
                            objfile compunit =
   let ic = open_in_bin objfile in
   try
-    Bytelink.check_consistency ppf objfile compunit;
+    Bytelink.check_consistency objfile compunit;
     List.iter
       (rename_relocation packagename objfile mapping defined ofs)
       compunit.cu_reloc;
@@ -161,23 +161,23 @@ let rename_append_bytecode ppf packagename oc mapping defined ofs prefix subst
 (* Same, for a list of .cmo and .cmi files.
    Return total size of bytecode. *)
 
-let rec rename_append_bytecode_list ppf packagename oc mapping defined ofs
+let rec rename_append_bytecode_list packagename oc mapping defined ofs
                                     prefix subst =
   function
     [] ->
       ofs
   | m :: rem ->
       match m.pm_kind with
       | PM_intf ->
-          rename_append_bytecode_list ppf packagename oc mapping defined ofs
+          rename_append_bytecode_list packagename oc mapping defined ofs
                                       prefix subst rem
       | PM_impl compunit ->
           let size =
-            rename_append_bytecode ppf packagename oc mapping defined ofs
+            rename_append_bytecode 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 ppf packagename oc mapping (id :: defined)
+          rename_append_bytecode_list packagename oc mapping (id :: defined)
             (ofs + size) prefix
             (Subst.add_module id (Path.Pdot (root, Ident.name id, Path.nopos))
                               subst)
@@ -206,7 +206,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 ppf files targetfile targetname coercion =
+let package_object_files files targetfile targetname coercion =
   let members =
     map_left_right read_member_info files in
   let required_globals =
@@ -241,7 +241,7 @@ let package_object_files ppf 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 ppf targetname oc mapping [] 0
+    let ofs = rename_append_bytecode_list 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
@@ -278,7 +278,7 @@ let package_object_files ppf files targetfile targetname coercion =
 
 (* The entry point *)
 
-let package_files ppf initial_env files targetfile =
+let package_files initial_env files targetfile =
     let files =
     List.map
         (fun f ->
@@ -291,7 +291,7 @@ let package_files ppf initial_env files targetfile =
     try
       let coercion =
         Typemod.package_units initial_env files targetcmi targetname in
-      package_object_files ppf files targetfile targetname coercion
+      package_object_files files targetfile targetname coercion
     with x ->
       remove_file targetfile; raise x
 

Diff for: bytecomp/bytepackager.mli

@@ -16,7 +16,7 @@
 (* "Package" a set of .cmo files into one .cmo file having the
    original compilation units as sub-modules. *)
 
-val package_files: Format.formatter -> Env.t -> string list -> string -> unit
+val package_files: Env.t -> string list -> string -> unit
 
 type error =
     Forward_reference of string * Ident.t

Diff for: driver/compmisc.ml

@@ -57,11 +57,11 @@ let initial_env () =
     ~initially_opened_module
     ~open_implicit_modules:(List.rev !Clflags.open_modules)
 
-let read_color_env ppf =
+let read_color_env () =
   try
     match Clflags.parse_color_setting (Sys.getenv "OCAML_COLOR") with
     | None ->
-        Location.print_warning Location.none ppf
+        Location.prerr_warning Location.none
           (Warnings.Bad_env_variable
              ("OCAML_COLOR",
               "expected \"auto\", \"always\" or \"never\""));

Diff for: driver/compmisc.mli

@@ -16,4 +16,4 @@
 val init_path : ?dir:string -> bool -> unit
 val initial_env : unit -> Env.t
 
-val read_color_env : Format.formatter -> unit
+val read_color_env : unit -> unit

Diff for: driver/main.ml

@@ -134,7 +134,7 @@ let main () =
   try
     readenv ppf Before_args;
     Clflags.parse_arguments anonymous usage;
-    Compmisc.read_color_env ppf;
+    Compmisc.read_color_env ();
     begin try
       Compenv.process_deferred_actions
         (ppf,
@@ -162,16 +162,15 @@ let main () =
     if !make_archive then begin
       Compmisc.init_path false;
 
-      Bytelibrarian.create_archive ppf
-                                   (Compenv.get_objfiles ~with_ocamlparam:false)
+      Bytelibrarian.create_archive (Compenv.get_objfiles ~with_ocamlparam:false)
                                    (extract_output !output_name);
       Warnings.check_fatal ();
     end
     else if !make_package then begin
       Compmisc.init_path false;
       let extracted_output = extract_output !output_name in
       let revd = get_objfiles ~with_ocamlparam:false in
-      Bytepackager.package_files ppf (Compmisc.initial_env ())
+      Bytepackager.package_files (Compmisc.initial_env ())
         revd (extracted_output);
       Warnings.check_fatal ();
     end
@@ -193,7 +192,7 @@ let main () =
           default_output !output_name
       in
       Compmisc.init_path false;
-      Bytelink.link ppf (get_objfiles ~with_ocamlparam:true) target;
+      Bytelink.link (get_objfiles ~with_ocamlparam:true) target;
       Warnings.check_fatal ();
     end;
   with x ->

Diff for: driver/optmain.ml

@@ -247,7 +247,7 @@ let main () =
        "<options> Compute dependencies \
         (use 'ocamlopt -depend -help' for details)"];
     Clflags.parse_arguments anonymous usage;
-    Compmisc.read_color_env ppf;
+    Compmisc.read_color_env ();
     if !gprofile && not Config.profiling then
       fatal "Profiling with \"gprof\" is not supported on this platform.";
     begin try

Diff for: middle_end/middle_end.ml

@@ -45,11 +45,11 @@ let middle_end ppf ~prefixname ~backend
       end)
     in
     let warning_set = ref WarningSet.empty in
-    let flambda_warning_printer loc _fmt w =
+    let flambda_warning_printer loc ppf w =
       let elt = loc, w in
       if not (WarningSet.mem elt !warning_set) then begin
         warning_set := WarningSet.add elt !warning_set;
-        previous_warning_printer loc !Location.formatter_for_warnings w
+        previous_warning_printer loc ppf w
       end;
     in
     Misc.protect_refs