Merge pull request #963 from ocsigen/export-reraise-and-update-recommendations

Export reraise, document recommended use

Author: raphael-proust

CHANGES

@@ -4,6 +4,10 @@
 
   * Lwt_result.catch now takes a function (unit -> 'a t) rather than a promise ('a t) (#965)
 
+====== Additions ======
+
+  * Lwt.reraise an exception raising function which preserves backtraces, recommended for use in Lwt.catch (#963)
+
 ====== Build ======
 
   * Remove unused dependency in dune file. (#969, Kate Deplaix)

src/core/lwt.ml

@@ -1677,6 +1677,7 @@ sig
   (* Main interface (public) *)
   val bind : 'a t -> ('a -> 'b t) -> 'b t
   val map : ('a -> 'b) -> 'a t -> 'b t
+  external reraise : exn -> 'a = "%reraise"
   val catch : (unit -> 'a t) -> (exn -> 'a t) -> 'a t
   val finalize : (unit -> 'a t) -> (unit -> unit t) -> 'a t
   val try_bind : (unit -> 'a t) -> ('a -> 'b t) -> (exn -> 'b t) -> 'b t
@@ -2004,6 +2005,8 @@ struct
       add_implicitly_removed_callback p_callbacks callback;
       p''
 
+  external reraise : exn -> 'a = "%reraise"
+
   let catch f h =
     let p = try f () with exn -> fail exn in
     let Internal p = to_internal_promise p in

src/core/lwt.mli

@@ -458,10 +458,14 @@ val fail : exn -> _ t
     captures a backtrace, while [Lwt.fail] does not. If you call [raise exn] in
     a callback that is expected by Lwt to return a promise, Lwt will
     automatically wrap [exn] in a rejected promise, but the backtrace will have
-    been recorded by the OCaml runtime. Use [Lwt.fail] only when you
-    specifically want to create a rejected promise, to pass to another function,
-    or store in a data structure. *)
+    been recorded by the OCaml runtime.
 
+    For example, [bind]'s second argument is a callback which returns a promise.
+    And so it is recommended to use [raise] in the body of that callback. This
+    applies to the aliases of [bind] as well: [( >>= )] and [( let* )].
+
+    Use [Lwt.fail] only when you specifically want to create a rejected promise,
+    to pass to another function, or store in a data structure. *)
 
 
 (** {3 Callbacks} *)
@@ -574,6 +578,16 @@ let () =
 
 (** {2:2_Rejection Rejection} *)
 
+external reraise : exn -> 'a = "%reraise"
+(** [reraise e] raises the exception [e]. Unlike [raise e], [reraise e]
+    preserves the existing exception backtrace and even adds a "Re-raised at"
+    entry with the call location.
+
+    This function is intended to be used in the exception handlers of
+    [Lwt.catch] and [Lwt.try_bind].
+
+    It is also used in the code produced by Lwt_ppx. *)
+
 val catch : (unit -> 'a t) -> (exn -> 'a t) -> 'a t
 (** [Lwt.catch f h] applies [f ()], which returns a promise, and then makes it
     so that [h] (“handler”) will run when that promise is {{!t} {e rejected}}.
@@ -582,10 +596,10 @@ val catch : (unit -> 'a t) -> (exn -> 'a t) -> 'a t
 let () =
   Lwt_main.run begin
     Lwt.catch
-      (fun () -> Lwt.fail Exit)
+      (fun () -> raise Exit)
       (function
       | Exit -> Lwt_io.printl "Got Stdlib.Exit"
-      | exn -> Lwt.fail exn)
+      | exn -> Lwt.reraise exn)
   end
 
 (* ocamlfind opt -linkpkg -thread -package lwt.unix code.ml && ./a.out *)
@@ -598,15 +612,15 @@ let () =
 {[
 let () =
   Lwt_main.run begin
-    try%lwt Lwt.fail Exit
+    try%lwt raise Exit
     with Exit -> Lwt_io.printl "Got Stdlb.Exit"
   end
 
 (* ocamlfind opt -linkpkg -thread -package lwt_ppx,lwt.unix code.ml && ./a.out *)
 ]}
 
     A particular advantage of the PPX syntax is that it is not necessary to
-    artificially insert a catch-all [exn -> Lwt.fail exn] case. Like in the core
+    artificially insert a catch-all [exn -> reraise exn] case. Like in the core
     language's [try] expression, the catch-all case is implied in [try%lwt].
 
     [Lwt.catch] is a counterpart to {!Lwt.bind} – {!Lwt.bind} is for
@@ -640,33 +654,7 @@ let () =
     - If [h exn] instead returns the promise [p_2], [p_3] is effectively made
       into a reference to [p_2]. This means [p_3] and [p_2] have the same state,
       undergo the same state changes, and performing any operation one is
-      equivalent to performing it on the other.
-
-    {b (2)} {b Warning}: it may be tempting to write this code, which differs
-    from the second example above only in that [try] is used instead of
-    [try%lwt]:
-
-{[
-let () =
-  Lwt_main.run begin
-    try Lwt.fail Exit
-    with Exit -> Lwt_io.printl "Got Stdlib.Exit"
-  end
-
-(* ocamlfind opt -linkpkg -thread -package lwt.unix code.ml && ./a.out *)
-]}
-
-    This does {e not} handle the exception and does not print the message.
-    Instead, it terminates the program with an unhandled [Stdlib.Exit].
-
-    This is because the call to {!Lwt.fail} creates a rejected promise. The
-    promise is still an ordinary OCaml value, though, and not a {e raised}
-    exception. So, [try] considers that code to have succeeded, and doesn't run
-    the handler. When that rejected promise reaches {!Lwt_main.run},
-    it is {!Lwt_main.run} that raises the exception.
-
-    Basically, the rule is: if the code inside [try] evaluates to a promise
-    (has type [_ Lwt.t]), replace [try] by [try%lwt]. *)
+      equivalent to performing it on the other. *)
 
 val finalize : (unit -> 'a t) -> (unit -> unit t) -> 'a t
 (** [Lwt.finalize f c] applies [f ()], which returns a promise, and then makes
@@ -755,6 +743,23 @@ val try_bind : (unit -> 'a t) -> ('a -> 'b t) -> (exn -> 'b t) -> 'b t
       fulfilled with, and, respectively, the exception [f ()] was rejected
       with.
 
+    As with {!Lwt.catch}, it is recommended to use {!reraise} in the catch-all
+    case of the exception handler:
+
+{[
+let () =
+  Lwt_main.run begin
+    Lwt.try_bind
+      (fun () -> raise Exit)
+      (fun () -> Lwt_io.printl "Got Success")
+      (function
+      | Exit -> Lwt_io.printl "Got Stdlib.Exit"
+      | exn -> Lwt.reraise exn)
+  end
+
+(* ocamlfind opt -linkpkg -thread -package lwt.unix code.ml && ./a.out *)
+]}
+
     The rest is a detailed description of the promises involved.
 
     As with {!Lwt.finalize} and the several preceding functions, three promises
@@ -892,7 +897,7 @@ val async_exception_hook : (exn -> unit) ref
     top level of the program:
 
 {[
-let () = Lwt.async (fun () -> Lwt.fail Exit)
+let () = Lwt.async (fun () -> raise Exit)
 
 (* ocamlfind opt -linkpkg -package lwt code.ml && ./a.out *)
 ]}

src/ppx/ppx_lwt.ml

@@ -77,9 +77,8 @@ let gen_binds e_loc l e =
       let new_exp =
           let loc = e_loc in
           [%expr
-            let module Reraise = struct external reraise : exn -> 'a = "%reraise" end in
             Lwt.backtrace_bind
-              (fun exn -> try Reraise.reraise exn with exn -> exn)
+              (fun exn -> try Lwt.reraise exn with exn -> exn)
               [%e name]
               [%e fun_]
           ]
@@ -92,9 +91,8 @@ let lwt_sequence mapper ~exp ~lhs ~rhs ~ext_loc =
   let lhs, rhs = mapper#expression lhs, mapper#expression rhs in
   let loc = exp.pexp_loc in
     [%expr
-      let module Reraise = struct external reraise : exn -> 'a = "%reraise" end in
       Lwt.backtrace_bind
-        (fun exn -> try Reraise.reraise exn with exn -> exn)
+        (fun exn -> try Lwt.reraise exn with exn -> exn)
         [%e lhs]
         (fun [%p pat] -> [%e rhs])
     ]
@@ -222,9 +220,8 @@ let lwt_expression mapper exp attributes ext_loc =
     let new_exp =
       let loc = !default_loc in
         [%expr
-          let module Reraise = struct external reraise : exn -> 'a = "%reraise" end in
           Lwt.backtrace_catch
-            (fun exn -> try Reraise.reraise exn with exn -> exn)
+            (fun exn -> try Lwt.reraise exn with exn -> exn)
             (fun () -> [%e expr])
             [%e pexp_function ~loc cases]
         ]
@@ -308,9 +305,8 @@ class mapper = object (self)
         let new_exp =
           let loc = !default_loc in
             [%expr
-              let module Reraise = struct external reraise : exn -> 'a = "%reraise" end in
               Lwt.backtrace_finalize
-                (fun exn -> try Reraise.reraise exn with exn -> exn)
+                (fun exn -> try Lwt.reraise exn with exn -> exn)
                 (fun () -> [%e exp])
                 (fun () -> [%e finally])
             ]