changements printer

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

5 files changed, 46 insertions, 45 deletions

diff --git a/driver/optcompile.ml b/driver/optcompile.ml
index 6086afa3d1..0646c20433 100644
--- a/driver/optcompile.ml
+++ b/driver/optcompile.ml
@@ -16,7 +16,7 @@
 
 open Misc
 open Config
-open Formatmsg
+open Format
 open Typedtree
 
 (* Initialize the search path.
@@ -99,14 +99,14 @@ let parse_file inputfile parse_fun ast_magic =
 
 (* Compile a .mli file *)
 
-let interface sourcefile =
+let interface ppf sourcefile =
   let prefixname = Filename.chop_extension sourcefile in
   let modulename = String.capitalize(Filename.basename prefixname) in
   let inputfile = preprocess sourcefile (prefixname ^ ".ppi") in
   let ast = parse_file inputfile Parse.interface ast_intf_magic_number in
-  if !Clflags.dump_parsetree then (Printast.interface ast; print_newline ());
+  if !Clflags.dump_parsetree then fprintf ppf "%a@." Printast.interface ast;
   let sg = Typemod.transl_signature (initial_env()) ast in
-  if !Clflags.print_types then (Printtyp.signature sg; print_newline());
+  if !Clflags.print_types then fprintf ppf "%a@." Printtyp.signature sg;
   Env.save_signature sg modulename (prefixname ^ ".cmi");
   remove_preprocessed inputfile
 
@@ -119,19 +119,19 @@ let print_if flag printer arg =
 let (++) x f = f x
 let (+++) (x, y) f = (x, f y)
 
-let implementation sourcefile =
+let implementation ppf sourcefile =
   let prefixname = Filename.chop_extension sourcefile in
   let modulename = String.capitalize(Filename.basename prefixname) in
   let inputfile = preprocess sourcefile (prefixname ^ ".ppo") in
   let env = initial_env() in
   Compilenv.reset modulename;
   parse_file inputfile Parse.implementation ast_impl_magic_number
-  ++ print_if Clflags.dump_parsetree Printast.implementation
+  ++ print_if Clflags.dump_parsetree (Printast.implementation ppf)
   ++ Typemod.type_implementation sourcefile prefixname modulename env
   ++ Translmod.transl_store_implementation modulename
-  +++ print_if Clflags.dump_rawlambda Printlambda.lambda
+  +++ print_if Clflags.dump_rawlambda (Printlambda.lambda ppf)
   +++ Simplif.simplify_lambda
-  +++ print_if Clflags.dump_lambda Printlambda.lambda
+  +++ print_if Clflags.dump_lambda (Printlambda.lambda ppf)
   ++ Asmgen.compile_implementation prefixname;
   Compilenv.save_unit_info (prefixname ^ ".cmx");
   remove_preprocessed inputfile
diff --git a/driver/optcompile.mli b/driver/optcompile.mli
index 42f1c07983..2271d103e3 100644
--- a/driver/optcompile.mli
+++ b/driver/optcompile.mli
@@ -14,8 +14,10 @@
 
 (* Compile a .ml or .mli file *)
 
-val interface: string -> unit
-val implementation: string -> unit
+open Format
+
+val interface: formatter -> string -> unit
+val implementation: formatter -> string -> unit
 val c_file: string -> unit
 
 val initial_env: unit -> Env.t
diff --git a/driver/opterrors.ml b/driver/opterrors.ml
index 087cf37162..5a11931f34 100644
--- a/driver/opterrors.ml
+++ b/driver/opterrors.ml
@@ -14,33 +14,33 @@
 
 (* Error report *)
 
-open Formatmsg
+open Format
 open Location
 
 (* Report an error *)
 
-let report_error exn =
-  open_box 0;
-  begin match exn with
-    Lexer.Error(err, start, stop) ->
-      Location.print {loc_start = start; loc_end = stop; loc_ghost = false};
-      Lexer.report_error err
+let report_error ppf exn =
+  let report ppf = function
+  | Lexer.Error(err, start, stop) ->
+      Location.print ppf
+        {loc_start = start; loc_end = stop; loc_ghost = false};
+      Lexer.report_error ppf err
   | Syntaxerr.Error err ->
-      Syntaxerr.report_error err
+      Syntaxerr.report_error ppf err
   | Env.Error err ->
-      Env.report_error err
+      Env.report_error ppf err
   | Typecore.Error(loc, err) ->
-      Location.print loc; Typecore.report_error err
+      Location.print ppf loc; Typecore.report_error ppf err
   | Typetexp.Error(loc, err) ->
-      Location.print loc; Typetexp.report_error err
+      Location.print ppf loc; Typetexp.report_error ppf err
   | Typedecl.Error(loc, err) ->
-      Location.print loc; Typedecl.report_error err
+      Location.print ppf loc; Typedecl.report_error ppf err
   | Includemod.Error err ->
-      Includemod.report_error err
+      Includemod.report_error ppf err
   | Typemod.Error(loc, err) ->
-      Location.print loc; Typemod.report_error err
+      Location.print ppf loc; Typemod.report_error ppf err
   | Translcore.Error(loc, err) ->
-      Location.print loc; Translcore.report_error err
+      Location.print ppf loc; Translcore.report_error ppf err
   | Compilenv.Error code ->
       Compilenv.report_error code
   | Asmgen.Error code ->
@@ -50,10 +50,9 @@ let report_error exn =
   | Asmlibrarian.Error code ->
       Asmlibrarian.report_error code
   | Sys_error msg ->
-      printf "I/O error: %s" msg
+      fprintf ppf "I/O error: %s" msg
   | Typeclass.Error(loc, err) ->
-      Location.print loc; Typeclass.report_error err
-  | x ->
-      close_box(); raise x
-  end;
-  close_box(); print_newline()
+      Location.print ppf loc; Typeclass.report_error ppf err
+  | x -> fprintf ppf "@]"; raise x in
+
+  fprintf ppf "@[%a@]@." report exn
diff --git a/driver/opterrors.mli b/driver/opterrors.mli
index be55c0e12c..d09dc733b6 100644
--- a/driver/opterrors.mli
+++ b/driver/opterrors.mli
@@ -14,4 +14,4 @@
 
 (* Error report *)
 
-val report_error: exn -> unit
+val report_error: Format.formatter -> exn -> unit
diff --git a/driver/optmain.ml b/driver/optmain.ml
index 4e5f4766d0..90597375d8 100644
--- a/driver/optmain.ml
+++ b/driver/optmain.ml
@@ -15,21 +15,21 @@
 open Config
 open Clflags
 
-let process_interface_file name =
-  Optcompile.interface name
+let process_interface_file ppf name =
+  Optcompile.interface ppf name
 
-let process_implementation_file name =
-  Optcompile.implementation name;
+let process_implementation_file ppf name =
+  Optcompile.implementation ppf name;
   objfiles := (Filename.chop_extension name ^ ".cmx") :: !objfiles
 
-let process_file name =
+let process_file ppf name =
   if Filename.check_suffix name ".ml"
   or Filename.check_suffix name ".mlt" then begin
-    Optcompile.implementation name;
+    Optcompile.implementation ppf name;
     objfiles := (Filename.chop_extension name ^ ".cmx") :: !objfiles
   end
   else if Filename.check_suffix name !Config.interface_suffix then
-    Optcompile.interface name
+    Optcompile.interface ppf name
   else if Filename.check_suffix name ".cmx" 
        or Filename.check_suffix name ".cmxa" then
     objfiles := name :: !objfiles
@@ -56,7 +56,7 @@ let usage = "Usage: ocamlopt <options> <files>\nOptions are:"
 let main () =
   native_code := true;
   c_compiler := Config.native_c_compiler;
-  Formatmsg.set_output Format.err_formatter;
+  let ppf = Format.err_formatter in
   try
     Arg.parse [
        "-a", Arg.Set make_archive, " Build a library";
@@ -72,11 +72,11 @@ let main () =
        "-i", Arg.Set print_types, " Print the inferred types";
        "-I", Arg.String(fun dir -> include_dirs := dir :: !include_dirs),
              "<dir>  Add <dir> to the list of include directories";
-       "-impl", Arg.String process_implementation_file,
+       "-impl", Arg.String (process_implementation_file ppf),
              "<file>  Compile <file> as a .ml file";
        "-inline", Arg.Int(fun n -> inline_threshold := n * 8),
              "<n>  Set aggressiveness of inlining to <n>";
-       "-intf", Arg.String process_interface_file,
+       "-intf", Arg.String (process_interface_file ppf),
              "<file>  Compile <file> as a .mli file";
        "-intf-suffix", Arg.String (fun s -> Config.interface_suffix := s),
              "<file>  Suffix for interface file (default: .mli)";
@@ -136,9 +136,9 @@ let main () =
        "-dlinear", Arg.Set dump_linear, " (undocumented)";
        "-dstartup", Arg.Set keep_startup_file, " (undocumented)";
 
-       "-", Arg.String process_file,
+       "-", Arg.String (process_file ppf),
             "<file>  Treat <file> as a file name (even if it starts with `-')"
-      ] process_file usage;
+      ] (process_file ppf) usage;
     if !make_archive then begin
       Optcompile.init_path();
       Asmlibrarian.create_archive (List.rev !objfiles) !archive_name
@@ -149,7 +149,7 @@ let main () =
     end;
     exit 0
   with x ->
-    Opterrors.report_error x;
+    Opterrors.report_error ppf x;
     exit 2
 
 let _ = Printexc.catch main ()