Wrap hook exceptions and have them printed with the standard mechanism instead of stopping the process.

parsing/location.ml

@@ -427,10 +427,19 @@ let () =
           Some
             (errorf ~loc:(in_file !input_name)
              "Some fatal warnings were triggered (%d occurrences)" n)
-      | _ ->
-          None
-    )
 
+      | Misc.HookExnWrapper {error = e; hook_name;
+                             hook_info={Misc.sourcefile}} ->
+          let sub = match error_of_exn e with
+            | None -> error (Printexc.to_string e)
+            | Some err -> err
+          in
+          Some
+            (errorf ~loc:(in_file sourcefile)
+               "In hook %S:" hook_name
+               ~sub:[sub])
+      | _ -> None
+    )
 
 external reraise : exn -> 'a = "%reraise"
 

utils/misc.ml

@@ -652,17 +652,27 @@ type hook_info = {
   sourcefile : string;
 }
 
+exception HookExnWrapper of
+    {
+      error: exn;
+      hook_name: string;
+      hook_info: hook_info;
+    }
+
 exception HookExn of exn
-let fold_hooks list info ast =
-  List.fold_left (fun ast (name,f) ->
+
+let raise_direct_hook_exn e = raise (HookExn e)
+
+let fold_hooks list hook_info ast =
+  List.fold_left (fun ast (hook_name,f) ->
     try
-      f info ast
+      f hook_info ast
     with
     | HookExn e -> raise e
-    | e ->
-      Printf.eprintf "Error: exception %S while running hook %S on %S\n%!"
-        (Printexc.to_string e) name info.sourcefile;
-      exit 2
+    | error -> raise (HookExnWrapper {error; hook_name; hook_info})
+       (* when explicit reraise with backtrace will be available,
+          it should be used here *)
+
   ) ast (List.sort compare list)
 
 module type HookSig = sig

utils/misc.mli

@@ -297,19 +297,33 @@ val delete_eol_spaces : string -> string
 
 
 
+(** {2 Hook machinery} *)
 
 (* Hooks machinery:
-  [add_hook name f] will register a function that will be called on the
+   [add_hook name f] will register a function that will be called on the
     argument of a later call to [apply_hooks]. Hooks are applied in the
     lexicographical order of their names.
 *)
 
-exception HookExn of exn
-
 type hook_info = {
   sourcefile : string;
 }
 
+exception HookExnWrapper of
+    {
+      error: exn;
+      hook_name: string;
+      hook_info: hook_info;
+    }
+    (** An exception raised by a hook will be wrapped into a [HookExnWrapper] constructor
+        by the hook machinery.
+    *)
+
+
+val raise_direct_hook_exn: exn -> 'a
+  (** A hook can use [raise_unwrapped_hook_exn] to raise an exception that will
+      not be wrapped into a [HookExnWrapper]. *)
+
 module type HookSig = sig
   type t
   val add_hook : string -> (hook_info -> t -> t) -> unit