[exn] Forbid raising in exn printers, make them return Pp.t option

Raising inside exception printers is quite tricky as the order of
registration for printers will indeed depend on the linking order.

We thus forbid this, and make our API closer to the upstream
`Printexn` by having printers return an option type.

2 files changed, 13 insertions, 12 deletions

diff --git a/engine/logic_monad.ml b/engine/logic_monad.ml
index 3c383b2e00..605877cfba 100644
--- a/engine/logic_monad.ml
+++ b/engine/logic_monad.ml
@@ -38,9 +38,9 @@ exception Tac_Timeout
 exception TacticFailure of exn
 
 let _ = CErrors.register_handler begin function
-  | Exception e -> CErrors.print e
-  | TacticFailure e -> CErrors.print e
-  | _ -> raise CErrors.Unhandled
+  | Exception e -> Some (CErrors.print e)
+  | TacticFailure e -> Some (CErrors.print e)
+  | _ -> None
 end
 
 (** {6 Non-logical layer} *)
diff --git a/engine/proofview.ml b/engine/proofview.ml
index b0ea75ac60..31e4dae2de 100644
--- a/engine/proofview.ml
+++ b/engine/proofview.ml
@@ -303,8 +303,8 @@ let tclONCE = Proof.once
 exception MoreThanOneSuccess
 let _ = CErrors.register_handler begin function
   | MoreThanOneSuccess ->
-    Pp.str "This tactic has more than one success."
-  | _ -> raise CErrors.Unhandled
+    Some (Pp.str "This tactic has more than one success.")
+  | _ -> None
 end
 
 (** [tclEXACTLY_ONCE e t] succeeds as [t] if [t] has exactly one
@@ -348,8 +348,8 @@ exception NoSuchGoals of int
 
 let _ = CErrors.register_handler begin function
   | NoSuchGoals n ->
-    str "No such " ++ str (String.plural n "goal") ++ str "."
-  | _ -> raise CErrors.Unhandled
+    Some (str "No such " ++ str (String.plural n "goal") ++ str ".")
+  | _ -> None
 end
 
 (** [tclFOCUS ?nosuchgoal i j t] applies [t] in a context where
@@ -421,9 +421,10 @@ exception SizeMismatch of int*int
 let _ = CErrors.register_handler begin function
   | SizeMismatch (i,j) ->
     let open Pp in
-    str"Incorrect number of goals" ++ spc() ++
-    str"(expected "++int i++str(String.plural i " tactic") ++ str", was given "++ int j++str")."
-  | _ -> raise CErrors.Unhandled
+    Some (
+      str"Incorrect number of goals" ++ spc() ++
+      str"(expected "++int i++str(String.plural i " tactic") ++ str", was given "++ int j++str").")
+  | _ -> None
 end
 
 (** A variant of [Monad.List.iter] where we iter over the focused list
@@ -908,8 +909,8 @@ let tclPROGRESS t =
 
 let _ = CErrors.register_handler begin function
   | Logic_monad.Tac_Timeout ->
-    Pp.str "[Proofview.tclTIMEOUT] Tactic timeout!"
-  | _ -> raise CErrors.Unhandled
+    Some (Pp.str "[Proofview.tclTIMEOUT] Tactic timeout!")
+  | _ -> None
 end
 
 let tclTIMEOUT n t =