Fix #5490.

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

8 files changed, 71 insertions, 75 deletions

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