Fix #5490.

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

26 files changed, 175 insertions, 175 deletions

diff --git a/asmcomp/asmgen.ml b/asmcomp/asmgen.ml
index c14c0006d..a25ff300a 100644
--- a/asmcomp/asmgen.ml
+++ b/asmcomp/asmgen.ml
@@ -24,77 +24,77 @@ type error = Assembler_error of string
 
 exception Error of error
 
-let liveness ppf phrase =
-  Liveness.fundecl ppf phrase; phrase
+let liveness phrase =
+  Liveness.fundecl phrase; phrase
 
-let dump_if ppf flag message phrase =
-  if !flag then Printmach.phase message ppf phrase
+let dump_if flag message phrase =
+  if !flag then Printmach.phase message Format.err_formatter phrase
 
-let pass_dump_if ppf flag message phrase =
-  dump_if ppf flag message phrase; phrase
+let pass_dump_if flag message phrase =
+  dump_if flag message phrase; phrase
 
-let pass_dump_linear_if ppf flag message phrase =
-  if !flag then fprintf ppf "*** %s@.%a@." message Printlinear.fundecl phrase;
+let pass_dump_linear_if flag message phrase =
+  if !flag then fprintf Format.err_formatter "*** %s@.%a@." message Printlinear.fundecl phrase;
   phrase
 
-let rec regalloc ppf round fd =
+let rec regalloc round fd =
   if round > 50 then
     fatal_error(fd.Mach.fun_name ^
                 ": function too complex, cannot complete register allocation");
-  dump_if ppf dump_live "Liveness analysis" fd;
+  dump_if dump_live "Liveness analysis" fd;
   Interf.build_graph fd;
-  if !dump_interf then Printmach.interferences ppf ();
-  if !dump_prefer then Printmach.preferences ppf ();
+  if !dump_interf then Printmach.interferences Format.err_formatter ();
+  if !dump_prefer then Printmach.preferences Format.err_formatter ();
   Coloring.allocate_registers();
-  dump_if ppf dump_regalloc "After register allocation" fd;
+  dump_if dump_regalloc "After register allocation" fd;
   let (newfd, redo_regalloc) = Reload.fundecl fd in
-  dump_if ppf dump_reload "After insertion of reloading code" newfd;
+  dump_if dump_reload "After insertion of reloading code" newfd;
   if redo_regalloc then begin
-    Reg.reinit(); Liveness.fundecl ppf newfd; regalloc ppf (round + 1) newfd
+    Reg.reinit(); Liveness.fundecl newfd; regalloc (round + 1) newfd
   end else newfd
 
 let (++) x f = f x
 
-let compile_fundecl (ppf : formatter) fd_cmm =
+let compile_fundecl fd_cmm =
   Reg.reset();
   fd_cmm
   ++ Selection.fundecl
-  ++ pass_dump_if ppf dump_selection "After instruction selection"
+  ++ pass_dump_if dump_selection "After instruction selection"
   ++ Comballoc.fundecl
-  ++ pass_dump_if ppf dump_combine "After allocation combining"
-  ++ liveness ppf
-  ++ pass_dump_if ppf dump_live "Liveness analysis"
+  ++ pass_dump_if dump_combine "After allocation combining"
+  ++ liveness
+  ++ pass_dump_if dump_live "Liveness analysis"
   ++ Spill.fundecl
-  ++ liveness ppf
-  ++ pass_dump_if ppf dump_spill "After spilling"
+  ++ liveness
+  ++ pass_dump_if dump_spill "After spilling"
   ++ Split.fundecl
-  ++ pass_dump_if ppf dump_split "After live range splitting"
-  ++ liveness ppf
-  ++ regalloc ppf 1
+  ++ pass_dump_if dump_split "After live range splitting"
+  ++ liveness
+  ++ regalloc 1
   ++ Linearize.fundecl
-  ++ pass_dump_linear_if ppf dump_linear "Linearized code"
+  ++ pass_dump_linear_if dump_linear "Linearized code"
   ++ Scheduling.fundecl
-  ++ pass_dump_linear_if ppf dump_scheduling "After instruction scheduling"
+  ++ pass_dump_linear_if dump_scheduling "After instruction scheduling"
   ++ Emit.fundecl
 
-let compile_phrase ppf p =
-  if !dump_cmm then fprintf ppf "%a@." Printcmm.phrase p;
+let compile_phrase p =
+  if !dump_cmm then eprintf "%a@." Printcmm.phrase p;
   match p with
-  | Cfunction fd -> compile_fundecl ppf fd
+  | Cfunction fd -> compile_fundecl fd
   | Cdata dl -> Emit.data dl
 
 
 (* For the native toplevel: generates generic functions unless
    they are already available in the process *)
-let compile_genfuns ppf f =
+let compile_genfuns f =
   List.iter
     (function
        | (Cfunction {fun_name = name}) as ph when f name ->
-           compile_phrase ppf ph
+           compile_phrase ph
        | _ -> ())
     (Cmmgen.generic_functions true [Compilenv.current_unit_infos ()])
 
-let compile_implementation ?toplevel prefixname ppf (size, lam) =
+let compile_implementation ?toplevel prefixname (size, lam) =
   let asmfile =
     if !keep_asm_file
     then prefixname ^ ext_asm
@@ -105,8 +105,8 @@ let compile_implementation ?toplevel prefixname ppf (size, lam) =
     Emit.begin_assembly();
     Closure.intro size lam
     ++ Cmmgen.compunit size
-    ++ List.iter (compile_phrase ppf) ++ (fun () -> ());
-    (match toplevel with None -> () | Some f -> compile_genfuns ppf f);
+    ++ List.iter compile_phrase ++ (fun () -> ());
+    (match toplevel with None -> () | Some f -> compile_genfuns f);
 
     (* We add explicit references to external primitive symbols.  This
        is to ensure that the object files that define these symbols,
@@ -114,7 +114,7 @@ let compile_implementation ?toplevel prefixname ppf (size, lam) =
        This is important if a module that uses such a symbol is later
        dynlinked. *)
 
-    compile_phrase ppf
+    compile_phrase
       (Cmmgen.reference_symbols
          (List.filter (fun s -> s <> "" && s.[0] <> '%')
             (List.map Primitive.native_name !Translmod.primitive_declarations))
diff --git a/asmcomp/asmgen.mli b/asmcomp/asmgen.mli
index f71cba8f7..b3577e7f4 100644
--- a/asmcomp/asmgen.mli
+++ b/asmcomp/asmgen.mli
@@ -16,9 +16,9 @@
 
 val compile_implementation :
     ?toplevel:(string -> bool) ->
-    string -> Format.formatter -> int * Lambda.lambda -> unit
+    string -> int * Lambda.lambda -> unit
 val compile_phrase :
-    Format.formatter -> Cmm.phrase -> unit
+    Cmm.phrase -> unit
 
 type error = Assembler_error of string
 exception Error of error
diff --git a/asmcomp/asmlink.ml b/asmcomp/asmlink.ml
index 8a1109fd6..1edb27082 100644
--- a/asmcomp/asmlink.ml
+++ b/asmcomp/asmlink.ml
@@ -197,8 +197,8 @@ let scan_file obj_name tolink = match read_file obj_name with
 
 (* Second pass: generate the startup file and link it with everything else *)
 
-let make_startup_file ppf filename units_list =
-  let compile_phrase p = Asmgen.compile_phrase ppf p in
+let make_startup_file filename units_list =
+  let compile_phrase = Asmgen.compile_phrase in
   let oc = open_out filename in
   Emitaux.output_channel := oc;
   Location.input_name := "caml_startup"; (* set name of "current" input *)
@@ -230,8 +230,8 @@ let make_startup_file ppf filename units_list =
   Emit.end_assembly();
   close_out oc
 
-let make_shared_startup_file ppf units filename =
-  let compile_phrase p = Asmgen.compile_phrase ppf p in
+let make_shared_startup_file units filename =
+  let compile_phrase = Asmgen.compile_phrase in
   let oc = open_out filename in
   Emitaux.output_channel := oc;
   Location.input_name := "caml_startup";
@@ -254,7 +254,7 @@ let call_linker_shared file_list output_name =
   if not (Ccomp.call_linker Ccomp.Dll output_name file_list "")
   then raise(Error Linking_error)
 
-let link_shared ppf objfiles output_name =
+let link_shared objfiles output_name =
   let units_tolink = List.fold_right scan_file objfiles [] in
   List.iter
     (fun (info, file_name, crc) -> check_consistency file_name info crc)
@@ -268,7 +268,7 @@ let link_shared ppf objfiles output_name =
     if !Clflags.keep_startup_file
     then output_name ^ ".startup" ^ ext_asm
     else Filename.temp_file "camlstartup" ext_asm in
-  make_shared_startup_file ppf
+  make_shared_startup_file
     (List.map (fun (ui,_,crc) -> (ui,crc)) units_tolink) startup;
   let startup_obj = output_name ^ ".startup" ^ ext_obj in
   if Proc.assemble_file startup startup_obj <> 0
@@ -299,7 +299,7 @@ let call_linker file_list startup_file output_name =
 
 (* Main entry point *)
 
-let link ppf objfiles output_name =
+let link objfiles output_name =
   let stdlib =
     if !Clflags.gprofile then "stdlib.p.cmxa" else "stdlib.cmxa" in
   let stdexit =
@@ -322,7 +322,7 @@ let link ppf objfiles output_name =
   let startup =
     if !Clflags.keep_startup_file then output_name ^ ".startup" ^ ext_asm
     else Filename.temp_file "camlstartup" ext_asm in
-  make_startup_file ppf startup units_tolink;
+  make_startup_file startup units_tolink;
   let startup_obj = Filename.temp_file "camlstartup" ext_obj in
   if Proc.assemble_file startup startup_obj <> 0 then
     raise(Error(Assembler_error startup));
diff --git a/asmcomp/asmlink.mli b/asmcomp/asmlink.mli
index b9465f809..0d88bd424 100644
--- a/asmcomp/asmlink.mli
+++ b/asmcomp/asmlink.mli
@@ -16,9 +16,9 @@
 
 open Format
 
-val link: formatter -> string list -> string -> unit
+val link: string list -> string -> unit
 
-val link_shared: formatter -> string list -> string -> unit
+val link_shared: string list -> string -> unit
 
 val call_linker_shared: string list -> string -> unit
 
diff --git a/asmcomp/asmpackager.ml b/asmcomp/asmpackager.ml
index 548a0a3d5..c375bf768 100644
--- a/asmcomp/asmpackager.ml
+++ b/asmcomp/asmpackager.ml
@@ -79,7 +79,7 @@ let check_units members =
 
 (* Make the .o file for the package *)
 
-let make_package_object ppf members targetobj targetname coercion =
+let make_package_object members targetobj targetname coercion =
   let objtemp =
     if !Clflags.keep_asm_file
     then chop_extension_if_any targetobj ^ ".pack" ^ Config.ext_obj
@@ -96,7 +96,7 @@ let make_package_object ppf members targetobj targetname coercion =
         | PM_impl _ -> Some(Ident.create_persistent m.pm_name))
       members in
   Asmgen.compile_implementation
-    (chop_extension_if_any objtemp) ppf
+    (chop_extension_if_any objtemp)
     (Translmod.transl_store_package
        components (Ident.create_persistent targetname) coercion);
   let objfiles =
@@ -152,7 +152,7 @@ let build_package_cmx members cmxfile =
 
 (* Make the .cmx and the .o for the package *)
 
-let package_object_files ppf files targetcmx
+let package_object_files files targetcmx
                          targetobj targetname coercion =
   let pack_path =
     match !Clflags.for_package with
@@ -160,12 +160,12 @@ let package_object_files ppf files targetcmx
     | Some p -> p ^ "." ^ targetname in
   let members = map_left_right (read_member_info pack_path) files in
   check_units members;
-  make_package_object ppf members targetobj targetname coercion;
+  make_package_object members targetobj targetname coercion;
   build_package_cmx members targetcmx
 
 (* The entry point *)
 
-let package_files ppf files targetcmx =
+let package_files files targetcmx =
   let files =
     List.map
       (fun f ->
@@ -182,7 +182,7 @@ let package_files ppf files targetcmx =
   Compilenv.reset ?packname:!Clflags.for_package targetname;
   try
     let coercion = Typemod.package_units files targetcmi targetname in
-    package_object_files ppf files targetcmx targetobj targetname coercion
+    package_object_files files targetcmx targetobj targetname coercion
   with x ->
     remove_file targetcmx; remove_file targetobj;
     raise x
diff --git a/asmcomp/asmpackager.mli b/asmcomp/asmpackager.mli
index fafccfea3..86cc5cf15 100644
--- a/asmcomp/asmpackager.mli
+++ b/asmcomp/asmpackager.mli
@@ -15,7 +15,7 @@
 (* "Package" a set of .cmx/.o files into one .cmx/.o file having the
    original compilation units as sub-modules. *)
 
-val package_files: Format.formatter -> string list -> string -> unit
+val package_files: string list -> string -> unit
 
 type error =
     Illegal_renaming of string * string
diff --git a/asmcomp/liveness.ml b/asmcomp/liveness.ml
index 74a034fb3..ded9e88c7 100644
--- a/asmcomp/liveness.ml
+++ b/asmcomp/liveness.ml
@@ -110,11 +110,11 @@ let rec live i finally =
       i.live <- across;
       Reg.add_set_array across i.arg
 
-let fundecl ppf f =
+let fundecl f =
   let initially_live = live f.fun_body Reg.Set.empty in
   (* Sanity check: only function parameters can be live at entrypoint *)
   let wrong_live = Reg.Set.diff initially_live (Reg.set_of_array f.fun_args) in
   if not (Reg.Set.is_empty wrong_live) then begin
-    Format.fprintf ppf "%a@." Printmach.regset wrong_live;
+    Format.eprintf "%a@." Printmach.regset wrong_live;
     Misc.fatal_error "Liveness.fundecl"
   end
diff --git a/asmcomp/liveness.mli b/asmcomp/liveness.mli
index 8a25a27bc..32d7c1855 100644
--- a/asmcomp/liveness.mli
+++ b/asmcomp/liveness.mli
@@ -17,4 +17,4 @@
 
 open Format
 
-val fundecl: formatter -> Mach.fundecl -> unit
+val fundecl: Mach.fundecl -> unit
diff --git a/bytecomp/bytelibrarian.ml b/bytecomp/bytelibrarian.ml
index 767a3dca6..62d900023 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 ppf oc name =
+let copy_object_file oc name =
   let file_name =
     try
       find_in_path !load_path name
@@ -69,7 +69,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]
@@ -78,7 +78,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;
@@ -89,13 +89,13 @@ 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
+    let units = List.flatten(List.map (copy_object_file 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 242011159..a4250f96d 100644
--- a/bytecomp/bytelibrarian.mli
+++ b/bytecomp/bytelibrarian.mli
@@ -21,7 +21,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 --git a/bytecomp/bytelink.ml b/bytecomp/bytelink.ml
index aa4c3d45a..9bd226e5c 100644
--- a/bytecomp/bytelink.ml
+++ b/bytecomp/bytelink.ml
@@ -164,7 +164,7 @@ let scan_file obj_name tolink =
 let crc_interfaces = Consistbl.create ()
 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, crc) ->
@@ -177,7 +177,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, file_name, source))
   with Not_found -> ()
   end;
@@ -193,8 +193,8 @@ let debug_info = ref ([] : (int * string) 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 = String.create compunit.cu_codesize in
   really_input inchan code_block 0 compunit.cu_codesize;
@@ -211,10 +211,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 ->
@@ -224,14 +224,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;
@@ -240,11 +240,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:
@@ -276,7 +276,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 =
   Misc.remove_file exec_name; (* avoid permission problems, cf PR#1911 *)
   let outchan =
     open_out_gen [Open_wronly; Open_trunc; Open_creat; Open_binary]
@@ -314,7 +314,7 @@ let link_bytecode ppf tolink exec_name standalone =
     end;
     let output_fun = output_string 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 standalone then Dll.close_all_dlls();
     (* The final STOP instruction *)
     output_byte outchan Opcodes.opSTOP;
@@ -413,7 +413,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 *)
@@ -435,7 +435,7 @@ let link_bytecode_as_c ppf tolink outfile =
       output_code_string outchan code;
       currpos := !currpos + String.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 *)
@@ -502,7 +502,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
@@ -512,12 +512,12 @@ let link ppf 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 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 = 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
       output_string poc "\
         #ifdef __cplusplus\n\
@@ -555,7 +555,7 @@ let link ppf 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 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 c_file <> 0 then raise(Error Custom_runtime);
diff --git a/bytecomp/bytelink.mli b/bytecomp/bytelink.mli
index 1366a1686..2fd700e3c 100644
--- a/bytecomp/bytelink.mli
+++ b/bytecomp/bytelink.mli
@@ -14,9 +14,9 @@
 
 (* Link .cmo files and produce a bytecode executable. *)
 
-val link : Format.formatter -> string list -> string -> unit
+val link : string list -> string -> 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) list
 
diff --git a/bytecomp/bytepackager.ml b/bytecomp/bytepackager.ml
index fc53d54d6..45457ee38 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 ppf packagename oc mapping defined ofs prefix subst objfile compunit =
+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;
@@ -148,20 +148,20 @@ let rename_append_bytecode ppf packagename oc mapping defined ofs prefix subst o
 (* 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 prefix subst = function
+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 prefix subst rem
+          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 prefix subst
+            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
+          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) 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 ppf files targetfile targetname coercion =
+let package_object_files 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 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 targetname Subst.identity members in
+    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
     if !Clflags.debug && !events <> [] then
@@ -233,7 +233,7 @@ let package_object_files ppf files targetfile targetname coercion =
 
 (* The entry point *)
 
-let package_files ppf files targetfile =
+let package_files files targetfile =
     let files =
     List.map
 	(fun f ->
@@ -245,7 +245,7 @@ let package_files ppf 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 ppf files targetfile targetname coercion in
+    let ret = package_object_files files targetfile targetname coercion in
     ret
   with x ->
     remove_file targetfile; raise x
diff --git a/bytecomp/bytepackager.mli b/bytecomp/bytepackager.mli
index 696b12aa0..2a599d9f9 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: Format.formatter -> string list -> string -> unit
+val package_files: string list -> string -> unit
 
 type error =
     Forward_reference of string * Ident.t
diff --git a/driver/compile.ml b/driver/compile.ml
index a27ffaa19..8d9d2aa16 100644
--- a/driver/compile.ml
+++ b/driver/compile.ml
@@ -49,12 +49,12 @@ let initial_env () =
     fatal_error "cannot open pervasives.cmi"
 
 (* Note: this function is duplicated in optcompile.ml *)
-let check_unit_name ppf filename name =
+let check_unit_name filename name =
   try
     begin match name.[0] with
     | 'A'..'Z' -> ()
     | _ ->
-       Location.print_warning (Location.in_file filename) ppf
+       Location.prerr_warning (Location.in_file filename)
         (Warnings.Bad_module_name name);
        raise Exit;
     end;
@@ -62,7 +62,7 @@ let check_unit_name ppf filename name =
       match name.[i] with
       | 'A'..'Z' | 'a'..'z' | '0'..'9' | '_' | '\'' -> ()
       | _ ->
-         Location.print_warning (Location.in_file filename) ppf
+         Location.prerr_warning (Location.in_file filename)
            (Warnings.Bad_module_name name);
          raise Exit;
     done;
@@ -71,18 +71,18 @@ let check_unit_name ppf filename name =
 
 (* Compile a .mli file *)
 
-let interface ppf sourcefile outputprefix =
+let interface sourcefile outputprefix =
   Location.input_name := sourcefile;
   init_path ();
   let modulename =
     String.capitalize(Filename.basename(chop_extension_if_any sourcefile)) in
-  check_unit_name ppf sourcefile modulename;
+  check_unit_name sourcefile modulename;
   Env.set_unit_name modulename;
   let inputfile = Pparse.preprocess sourcefile in
   try
     let ast =
-      Pparse.file ppf inputfile Parse.interface ast_intf_magic_number in
-    if !Clflags.dump_parsetree then fprintf ppf "%a@." Printast.interface ast;
+      Pparse.file inputfile Parse.interface ast_intf_magic_number in
+    if !Clflags.dump_parsetree then eprintf "%a@." Printast.interface ast;
     let sg = Typemod.transl_signature (initial_env()) ast in
     if !Clflags.print_types then
       fprintf std_formatter "%a@." Printtyp.signature
@@ -97,25 +97,25 @@ let interface ppf sourcefile outputprefix =
 
 (* Compile a .ml file *)
 
-let print_if ppf flag printer arg =
-  if !flag then fprintf ppf "%a@." printer arg;
+let print_if flag printer arg =
+  if !flag then eprintf "%a@." printer arg;
   arg
 
 let (++) x f = f x
 
-let implementation ppf sourcefile outputprefix =
+let implementation sourcefile outputprefix =
   Location.input_name := sourcefile;
   init_path ();
   let modulename =
     String.capitalize(Filename.basename(chop_extension_if_any sourcefile)) in
-  check_unit_name ppf sourcefile modulename;
+  check_unit_name sourcefile modulename;
   Env.set_unit_name modulename;
   let inputfile = Pparse.preprocess sourcefile in
   let env = initial_env() in
   if !Clflags.print_types then begin
     try ignore(
-      Pparse.file ppf inputfile Parse.implementation ast_impl_magic_number
-      ++ print_if ppf Clflags.dump_parsetree Printast.implementation
+      Pparse.file inputfile Parse.implementation ast_impl_magic_number
+      ++ print_if Clflags.dump_parsetree Printast.implementation
       ++ Typemod.type_implementation sourcefile outputprefix modulename env)
     with x ->
       Pparse.remove_preprocessed_if_ast inputfile;
@@ -124,15 +124,15 @@ let implementation ppf sourcefile outputprefix =
     let objfile = outputprefix ^ ".cmo" in
     let oc = open_out_bin objfile in
     try
-      Pparse.file ppf inputfile Parse.implementation ast_impl_magic_number
-      ++ print_if ppf Clflags.dump_parsetree Printast.implementation
+      Pparse.file inputfile Parse.implementation ast_impl_magic_number
+      ++ print_if Clflags.dump_parsetree Printast.implementation
       ++ Typemod.type_implementation sourcefile outputprefix modulename env
       ++ Translmod.transl_implementation modulename
-      ++ print_if ppf Clflags.dump_rawlambda Printlambda.lambda
+      ++ print_if Clflags.dump_rawlambda Printlambda.lambda
       ++ Simplif.simplify_lambda
-      ++ print_if ppf Clflags.dump_lambda Printlambda.lambda
+      ++ print_if Clflags.dump_lambda Printlambda.lambda
       ++ Bytegen.compile_implementation modulename
-      ++ print_if ppf Clflags.dump_instr Printinstr.instrlist
+      ++ print_if Clflags.dump_instr Printinstr.instrlist
       ++ Emitcode.to_file oc modulename;
       Warnings.check_fatal ();
       close_out oc;
diff --git a/driver/compile.mli b/driver/compile.mli
index 779239a8c..d1e4c963d 100644
--- a/driver/compile.mli
+++ b/driver/compile.mli
@@ -16,8 +16,8 @@
 
 open Format
 
-val interface: formatter -> string -> string -> unit
-val implementation: formatter -> string -> string -> unit
+val interface: string -> string -> unit
+val implementation: string -> string -> unit
 val c_file: string -> unit
 
 val initial_env: unit -> Env.t
diff --git a/driver/main.ml b/driver/main.ml
index 5c47a74dd..f1d65f339 100644
--- a/driver/main.ml
+++ b/driver/main.ml
@@ -22,24 +22,24 @@ let output_prefix name =
     | Some n -> if !compile_only then (output_name := None; n) else name in
   Misc.chop_extension_if_any oname
 
-let process_interface_file ppf name =
-  Compile.interface ppf name (output_prefix name)
+let process_interface_file name =
+  Compile.interface name (output_prefix name)
 
-let process_implementation_file ppf name =
+let process_implementation_file name =
   let opref = output_prefix name in
-  Compile.implementation ppf name opref;
+  Compile.implementation name opref;
   objfiles := (opref ^ ".cmo") :: !objfiles
 
-let process_file ppf name =
+let process_file name =
   if Filename.check_suffix name ".ml"
   || Filename.check_suffix name ".mlt" then begin
     let opref = output_prefix name in
-    Compile.implementation ppf name opref;
+    Compile.implementation name opref;
     objfiles := (opref ^ ".cmo") :: !objfiles
   end
   else if Filename.check_suffix name !Config.interface_suffix then begin
     let opref = output_prefix name in
-    Compile.interface ppf name opref;
+    Compile.interface name opref;
     if !make_package then objfiles := (opref ^ ".cmi") :: !objfiles
   end
   else if Filename.check_suffix name ".cmo"
@@ -75,12 +75,10 @@ let print_standard_library () =
 
 let usage = "Usage: ocamlc <options> <files>\nOptions are:"
 
-let ppf = Format.err_formatter
-
 (* Error messages to standard error formatter *)
-let anonymous = process_file ppf;;
-let impl = process_implementation_file ppf;;
-let intf = process_interface_file ppf;;
+let anonymous = process_file;;
+let impl = process_implementation_file;;
+let intf = process_interface_file;;
 
 let show_config () =
   Config.print_config stdout;
@@ -172,15 +170,14 @@ let main () =
     if !make_archive then begin
       Compile.init_path();
 
-      Bytelibrarian.create_archive ppf  (List.rev !objfiles)
+      Bytelibrarian.create_archive (List.rev !objfiles)
                                    (extract_output !output_name)
     end
     else if !make_package then begin
       Compile.init_path();
       let exctracted_output = extract_output !output_name in
       let revd = List.rev !objfiles in
-      Bytepackager.package_files ppf (revd)
-        (exctracted_output)
+      Bytepackager.package_files revd exctracted_output
     end
     else if not !compile_only && !objfiles <> [] then begin
       let target =
@@ -200,11 +197,11 @@ let main () =
           default_output !output_name
       in
       Compile.init_path();
-      Bytelink.link ppf (List.rev !objfiles) target
+      Bytelink.link (List.rev !objfiles) target
     end;
     exit 0
   with x ->
-    Errors.report_error ppf x;
+    Errors.report_error Format.err_formatter x;
     exit 2
 
 let _ = main ()
diff --git a/driver/optcompile.ml b/driver/optcompile.ml
index 1e6ab0ce3..de736294b 100644
--- a/driver/optcompile.ml
+++ b/driver/optcompile.ml
@@ -46,12 +46,12 @@ let initial_env () =
     fatal_error "cannot open pervasives.cmi"
 
 (* Note: this function is duplicated in compile.ml *)
-let check_unit_name ppf filename name =
+let check_unit_name filename name =
   try
     begin match name.[0] with
     | 'A'..'Z' -> ()
     | _ ->
-       Location.print_warning (Location.in_file filename) ppf
+       Location.prerr_warning (Location.in_file filename)
         (Warnings.Bad_module_name name);
        raise Exit;
     end;
@@ -59,7 +59,7 @@ let check_unit_name ppf filename name =
       match name.[i] with
       | 'A'..'Z' | 'a'..'z' | '0'..'9' | '_' | '\'' -> ()
       | _ ->
-         Location.print_warning (Location.in_file filename) ppf
+         Location.prerr_warning (Location.in_file filename)
            (Warnings.Bad_module_name name);
          raise Exit;
     done;
@@ -68,18 +68,18 @@ let check_unit_name ppf filename name =
 
 (* Compile a .mli file *)
 
-let interface ppf sourcefile outputprefix =
+let interface sourcefile outputprefix =
   Location.input_name := sourcefile;
   init_path ();
   let modulename =
     String.capitalize(Filename.basename(chop_extension_if_any sourcefile)) in
-  check_unit_name ppf sourcefile modulename;
+  check_unit_name sourcefile modulename;
   Env.set_unit_name modulename;
   let inputfile = Pparse.preprocess sourcefile in
   try
     let ast =
-      Pparse.file ppf inputfile Parse.interface ast_intf_magic_number in
-    if !Clflags.dump_parsetree then fprintf ppf "%a@." Printast.interface ast;
+      Pparse.file inputfile Parse.interface ast_intf_magic_number in
+    if !Clflags.dump_parsetree then eprintf "%a@." Printast.interface ast;
     let sg = Typemod.transl_signature (initial_env()) ast in
     if !Clflags.print_types then
       fprintf std_formatter "%a@." Printtyp.signature
@@ -96,19 +96,19 @@ let interface ppf sourcefile outputprefix =
 
 (* Compile a .ml file *)
 
-let print_if ppf flag printer arg =
-  if !flag then fprintf ppf "%a@." printer arg;
+let print_if flag printer arg =
+  if !flag then eprintf "%a@." printer arg;
   arg
 
 let (++) x f = f x
 let (+++) (x, y) f = (x, f y)
 
-let implementation ppf sourcefile outputprefix =
+let implementation sourcefile outputprefix =
   Location.input_name := sourcefile;
   init_path ();
   let modulename =
     String.capitalize(Filename.basename(chop_extension_if_any sourcefile)) in
-  check_unit_name ppf sourcefile modulename;
+  check_unit_name sourcefile modulename;
   Env.set_unit_name modulename;
   let inputfile = Pparse.preprocess sourcefile in
   let env = initial_env() in
@@ -117,18 +117,18 @@ let implementation ppf sourcefile outputprefix =
   let objfile = outputprefix ^ ext_obj in
   try
     if !Clflags.print_types then ignore(
-      Pparse.file ppf inputfile Parse.implementation ast_impl_magic_number
-      ++ print_if ppf Clflags.dump_parsetree Printast.implementation
+      Pparse.file inputfile Parse.implementation ast_impl_magic_number
+      ++ print_if Clflags.dump_parsetree Printast.implementation
       ++ Typemod.type_implementation sourcefile outputprefix modulename env)
     else begin
-      Pparse.file ppf inputfile Parse.implementation ast_impl_magic_number
-      ++ print_if ppf Clflags.dump_parsetree Printast.implementation
+      Pparse.file inputfile Parse.implementation ast_impl_magic_number
+      ++ print_if Clflags.dump_parsetree Printast.implementation
       ++ Typemod.type_implementation sourcefile outputprefix modulename env
       ++ Translmod.transl_store_implementation modulename
-      +++ print_if ppf Clflags.dump_rawlambda Printlambda.lambda
+      +++ print_if Clflags.dump_rawlambda Printlambda.lambda
       +++ Simplif.simplify_lambda
-      +++ print_if ppf Clflags.dump_lambda Printlambda.lambda
-      ++ Asmgen.compile_implementation outputprefix ppf;
+      +++ print_if Clflags.dump_lambda Printlambda.lambda
+      ++ Asmgen.compile_implementation outputprefix;
       Compilenv.save_unit_info cmxfile;
     end;
     Warnings.check_fatal ();
diff --git a/driver/optcompile.mli b/driver/optcompile.mli
index 779239a8c..d1e4c963d 100644
--- a/driver/optcompile.mli
+++ b/driver/optcompile.mli
@@ -16,8 +16,8 @@
 
 open Format
 
-val interface: formatter -> string -> string -> unit
-val implementation: formatter -> string -> string -> unit
+val interface: string -> string -> unit
+val implementation: string -> string -> unit
 val c_file: string -> unit
 
 val initial_env: unit -> Env.t
diff --git a/driver/optmain.ml b/driver/optmain.ml
index be3f8b240..e52b11d35 100644
--- a/driver/optmain.ml
+++ b/driver/optmain.ml
@@ -22,21 +22,21 @@ let output_prefix name =
     | Some n -> if !compile_only then (output_name := None; n) else name in
   Misc.chop_extension_if_any oname
 
-let process_interface_file ppf name =
-  Optcompile.interface ppf name (output_prefix name)
+let process_interface_file name =
+  Optcompile.interface name (output_prefix name)
 
-let process_implementation_file ppf name =
+let process_implementation_file name =
   let opref = output_prefix name in
-  Optcompile.implementation ppf name opref;
+  Optcompile.implementation name opref;
   objfiles := (opref ^ ".cmx") :: !objfiles
 
-let process_file ppf name =
+let process_file name =
   if Filename.check_suffix name ".ml"
   || Filename.check_suffix name ".mlt" then
-    process_implementation_file ppf name
+    process_implementation_file name
   else if Filename.check_suffix name !Config.interface_suffix then begin
     let opref = output_prefix name in
-    Optcompile.interface ppf name opref;
+    Optcompile.interface name opref;
     if !make_package then objfiles := (opref ^ ".cmi") :: !objfiles
   end
   else if Filename.check_suffix name ".cmx"
@@ -84,9 +84,9 @@ let default_output = function
 let usage = "Usage: ocamlopt <options> <files>\nOptions are:"
 
 (* Error messages to standard error formatter *)
-let anonymous = process_file Format.err_formatter;;
-let impl = process_implementation_file Format.err_formatter;;
-let intf = process_interface_file Format.err_formatter;;
+let anonymous = process_file;;
+let impl = process_implementation_file;;
+let intf = process_interface_file;;
 
 let show_config () =
   Config.print_config stdout;
@@ -167,7 +167,6 @@ end);;
 
 let main () =
   native_code := true;
-  let ppf = Format.err_formatter in
   try
     Arg.parse (Arch.command_line_options @ Options.list) anonymous usage;
     if
@@ -184,12 +183,12 @@ let main () =
     else if !make_package then begin
       Optcompile.init_path();
       let target = extract_output !output_name in
-      Asmpackager.package_files ppf (List.rev !objfiles) target;
+      Asmpackager.package_files (List.rev !objfiles) target;
     end
     else if !shared then begin
       Optcompile.init_path();
       let target = extract_output !output_name in
-      Asmlink.link_shared ppf (List.rev !objfiles) target;
+      Asmlink.link_shared (List.rev !objfiles) target;
     end
     else if not !compile_only && !objfiles <> [] then begin
       let target =
@@ -208,11 +207,11 @@ let main () =
           default_output !output_name
       in
       Optcompile.init_path();
-      Asmlink.link ppf (List.rev !objfiles) target
+      Asmlink.link (List.rev !objfiles) target
     end;
     exit 0
   with x ->
-    Opterrors.report_error ppf x;
+    Opterrors.report_error Format.err_formatter x;
     exit 2
 
 let _ = main ()
diff --git a/driver/pparse.ml b/driver/pparse.ml
index 5d27beeb4..f5ed2d5a6 100644
--- a/driver/pparse.ml
+++ b/driver/pparse.ml
@@ -47,7 +47,7 @@ let remove_preprocessed_if_ast inputfile =
 
 exception Outdated_version
 
-let file ppf inputfile parse_fun ast_magic =
+let file inputfile parse_fun ast_magic =
   let ic = open_in_bin inputfile in
   let is_ast_file =
     try
@@ -66,7 +66,7 @@ let file ppf inputfile parse_fun ast_magic =
     try
       if is_ast_file then begin
         if !Clflags.fast then
-          fprintf ppf "@[Warning: %s@]@."
+          eprintf "@[Warning: %s@]@."
             "option -unsafe used with a preprocessor returning a syntax tree";
         Location.input_name := input_value ic;
         input_value ic
diff --git a/driver/pparse.mli b/driver/pparse.mli
index 96c2594f1..0c70a1db4 100644
--- a/driver/pparse.mli
+++ b/driver/pparse.mli
@@ -19,4 +19,4 @@ exception Error
 val preprocess : string -> string
 val remove_preprocessed : string -> unit
 val remove_preprocessed_if_ast : string -> unit
-val file : formatter -> string -> (Lexing.lexbuf -> 'a) -> string -> 'a
+val file : string -> (Lexing.lexbuf -> 'a) -> string -> 'a
diff --git a/parsing/location.mli b/parsing/location.mli
index 0303c0add..7a07b80f5 100644
--- a/parsing/location.mli
+++ b/parsing/location.mli
@@ -51,6 +51,9 @@ val print_loc: formatter -> t -> unit
 val print_error: formatter -> t -> unit
 val print_error_cur_file: formatter -> unit
 val print_warning: t -> formatter -> Warnings.t -> unit
+    (** Used only in the toplevels, for Toploop.print_warning. Do not
+        use to report warnings in the compiler. *)
+
 val prerr_warning: t -> Warnings.t -> unit
 val echo_eof: unit -> unit
 val reset: unit -> unit
diff --git a/toplevel/opttopdirs.ml b/toplevel/opttopdirs.ml
index 8655ef96b..74de15ee3 100644
--- a/toplevel/opttopdirs.ml
+++ b/toplevel/opttopdirs.ml
@@ -62,7 +62,7 @@ let load_file ppf name0 =
     if Filename.check_suffix name ".cmx" || Filename.check_suffix name ".cmxa"
     then
       let cmxs = Filename.temp_file "caml" ".cmxs" in
-      Asmlink.link_shared ppf [name] cmxs;
+      Asmlink.link_shared [name] cmxs;
       cmxs,true
     else
       name,false in
diff --git a/toplevel/opttoploop.ml b/toplevel/opttoploop.ml
index 1fa5a3fd0..2321749b4 100644
--- a/toplevel/opttoploop.ml
+++ b/toplevel/opttoploop.ml
@@ -137,7 +137,7 @@ let load_lambda ppf (size, lam) =
     else Filename.temp_file ("caml" ^ !phrase_name) ext_dll
   in
   let fn = Filename.chop_extension dll in
-  Asmgen.compile_implementation ~toplevel:need_symbol fn ppf (size, lam);
+  Asmgen.compile_implementation ~toplevel:need_symbol fn (size, lam);
   Asmlink.call_linker_shared [fn ^ ext_obj] dll;
   Sys.remove (fn ^ ext_obj);
 
diff --git a/typing/typecore.ml b/typing/typecore.ml
index b141d4ed6..1687cf094 100644
--- a/typing/typecore.ml
+++ b/typing/typecore.ml
@@ -189,7 +189,8 @@ let iter_expression f e =
 let free_idents el =
   let idents = Hashtbl.create 8 in
   let f = function
-    | {pexp_desc=Pexp_ident (Longident.Lident id); _} -> Hashtbl.replace idents id ()
+    | {pexp_desc=Pexp_ident (Longident.Lident id); _} ->
+        Hashtbl.replace idents id ()
     | _ -> ()
   in
   List.iter (iter_expression f) el;
@@ -1382,7 +1383,7 @@ let duplicate_ident_types loc caselist env =
             let desc = {desc with val_type = correct_levels desc.val_type} in
             Env.add_value id desc env
         | _ -> env
-      with Not_found -> env)
+      with Not_found | Typetexp.Error (_, Typetexp.Unbound_value _) -> env)
     env idents
 
 (* Typing of expressions *)