Continue.

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

asmcomp/asmgen.ml

@@ -140,3 +140,10 @@ let report_error ppf = function
   | Assembler_error file ->
       fprintf ppf "Assembler error, input left in file %a"
         Location.print_filename file
+
+let () =
+  Location.register_error_of_exn
+    (function
+      | Error err -> Some (Location.error_of_printer_file report_error err)
+      | _ -> None
+    )

asmcomp/asmlibrarian.ml

@@ -69,3 +69,10 @@ let report_error ppf = function
       fprintf ppf "Cannot find file %s" name
   | Archiver_error name ->
       fprintf ppf "Error while creating the library %s" name
+
+let () =
+  Location.register_error_of_exn
+    (function
+      | Error err -> Some (Location.error_of_printer_file report_error err)
+      | _ -> None
+    )

asmcomp/asmlink.ml

@@ -390,3 +390,10 @@ let report_error ppf = function
         Location.print_filename filename name
         Location.print_filename  filename
         name
+
+let () =
+  Location.register_error_of_exn
+    (function
+      | Error err -> Some (Location.error_of_printer_file report_error err)
+      | _ -> None
+    )

asmcomp/asmpackager.ml

@@ -204,3 +204,10 @@ let report_error ppf = function
       fprintf ppf "Error while assembling %s" file
   | Linking_error ->
       fprintf ppf "Error during partial linking"
+
+let () =
+  Location.register_error_of_exn
+    (function
+      | Error err -> Some (Location.error_of_printer_file report_error err)
+      | _ -> None
+    )

asmcomp/compilenv.ml

@@ -245,3 +245,10 @@ let report_error ppf = function
       fprintf ppf "%a@ contains the description for unit\
                    @ %s when %s was expected"
         Location.print_filename filename name modname
+
+let () =
+  Location.register_error_of_exn
+    (function
+      | Error err -> Some (Location.error_of_printer_file report_error err)
+      | _ -> None
+    )

driver/errors.ml

@@ -10,4 +10,7 @@
 (*                                                                     *)
 (***********************************************************************)
 
+(* This module should be removed.  We keep it for now, to avoid
+   breaking external tools depending on it. *)
+
 let report_error = Location.report_exception

driver/opterrors.ml

@@ -10,34 +10,7 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* WARNING: if you change something in this file, you must look at
-   errors.ml to see if you need to make the same changes there.
-*)
+(* This module should be removed.  We keep it for now, to avoid
+   breaking external tools depending on it. *)
 
-open Format
-
-(* Report an error *)
-
-let report_error ppf exn =
-  let report ppf = function
-  | Compilenv.Error code ->
-      Location.print_error_cur_file ppf;
-      Compilenv.report_error ppf code
-  | Asmgen.Error code ->
-      Location.print_error_cur_file ppf;
-      Asmgen.report_error ppf code
-  | Asmlink.Error code ->
-      Location.print_error_cur_file ppf;
-      Asmlink.report_error ppf code
-  | Asmlibrarian.Error code ->
-      Location.print_error_cur_file ppf;
-      Asmlibrarian.report_error ppf code
-  | Asmpackager.Error code ->
-      Location.print_error_cur_file ppf;
-      Asmpackager.report_error ppf code
-  | x ->
-      match Location.error_of_exn x with
-      | Some err -> Location.report_error ppf err
-      | None -> fprintf ppf "@]"; raise x
-  in
-  fprintf ppf "@[%a@]@." report exn
+let report_error = Location.report_exception

driver/optmain.ml

@@ -201,7 +201,7 @@ let main () =
     end;
     exit 0
   with x ->
-    Opterrors.report_error ppf x;
-    exit 2
+      Location.report_exception ppf x;
+      exit 2
 
 let _ = main ()

toplevel/opttoploop.ml

@@ -325,7 +325,7 @@ let use_file ppf name =
         with
         | Exit -> false
         | Sys.Break -> fprintf ppf "Interrupted.@."; false
-        | x -> Opterrors.report_error ppf x; false) in
+        | x -> Location.report_exception ppf x; false) in
     if must_close then close_in ic;
     success
   with Not_found -> fprintf ppf "Cannot find file %s.@." name; false
@@ -439,7 +439,7 @@ let loop ppf =
     | End_of_file -> exit 0
     | Sys.Break -> fprintf ppf "Interrupted.@."; Btype.backtrack snap
     | PPerror -> ()
-    | x -> Opterrors.report_error ppf x; Btype.backtrack snap
+    | x -> Location.report_exception ppf x; Btype.backtrack snap
   done
 
 (* Execute a script *)

toplevel/opttopmain.ml

@@ -26,7 +26,7 @@ let prepare ppf =
     !Opttoploop.toplevel_startup_hook ();
     res
   with x ->
-    try Opterrors.report_error ppf x; false
+    try Location.report_exception ppf x; false
     with x ->
       Format.fprintf ppf "Uncaught exception: %s\n" (Printexc.to_string x);
       false