Lwt.dont_wait: a more local, more explicit Lwt.async

src/core/lwt.ml

@@ -2454,6 +2454,7 @@ let wrap_in_cancelable p =
 
 module Concurrent_composition :
 sig
+  val dont_wait : (unit -> _ t) -> (exn -> unit) -> unit
   val async : (unit -> _ t) -> unit
   val ignore_result : _ t -> unit
 
@@ -2472,6 +2473,26 @@ end =
 struct
   external reraise : exn -> 'a = "%reraise"
 
+  let dont_wait f h =
+    let p = try f () with exn -> fail exn in
+    let Internal p = to_internal_promise p in
+
+    match (underlying p).state with
+    | Fulfilled _ ->
+      ()
+    | Rejected exn ->
+      h exn
+
+    | Pending p_callbacks ->
+      let callback result =
+        match result with
+        | Fulfilled _ ->
+          ()
+        | Rejected exn ->
+          h exn
+      in
+      add_implicitly_removed_callback p_callbacks callback
+
   let async f =
     let p = try f () with exn -> fail exn in
     let Internal p = to_internal_promise p in

src/core/lwt.mli

@@ -796,6 +796,25 @@ val try_bind : (unit -> 'a t) -> ('a -> 'b t) -> (exn -> 'b t) -> 'b t
       performing any operation on one is equivalent to performing it on the
       other. *)
 
+val dont_wait : (unit -> unit t) -> (exn -> unit) -> unit
+(** [Lwt.dont_wait f handler] applies [f ()], which returns a promise, and then
+    makes it so that if the promise is {{: #TYPEt} {e rejected}}, the exception
+    is passed to [handler].
+
+    In addition, if [f ()] raises an exception, it is also passed to [handler].
+
+    As the name implies, [dont_wait (fun () -> <e>) handler] is a way to
+    evaluate the expression [<e>] (which typically has asynchronous
+    side-effects) {e without waiting} for the resolution of the promise [<e>]
+    evaluates to.
+
+    [dont_wait] is meant as an alternative to {!async} with a local, explicit,
+    predictable exception handler.
+
+    Note that [dont_wait f h] causes [f ()] to be evaluated immediately.
+    Consequently, the non-yielding/non-pausing prefix of the body of [f] is
+    evaluated immediately. *)
+
 val async : (unit -> unit t) -> unit
 (** [Lwt.async f] applies [f ()], which returns a promise, and then makes it so
     that if the promise is {{: #TYPEt} {e rejected}}, the exception is passed to
@@ -805,7 +824,8 @@ val async : (unit -> unit t) -> unit
     [!]{!Lwt.async_exception_hook}.
 
     [!]{!Lwt.async_exception_hook} typically prints an error message and
-    terminates the program.
+    terminates the program. If you need a similar behaviour with a different
+    exception handler, you can use {!Lwt.dont_wait}.
 
     [Lwt.async] is misleadingly named. Itself, it has nothing to do with
     asynchronous execution. It's actually a safety function for making Lwt

test/core/test_lwt.ml

@@ -1803,6 +1803,54 @@ let async_tests = suite "async" [
 ]
 let suites = suites @ [async_tests]
 
+let dont_wait_tests = suite "dont_wait" [
+  test "fulfilled" begin fun () ->
+    let f_ran = ref false in
+    Lwt.dont_wait (fun () -> f_ran := true; Lwt.return ()) (fun _ -> ());
+    later (fun () -> !f_ran = true)
+  end;
+
+  test "f raises" begin fun () ->
+    let saw = ref None in
+    Lwt.dont_wait
+      (fun () -> raise Exception)
+      (fun exn -> saw := Some exn);
+    later (fun () -> !saw = Some Exception)
+  end;
+
+  test "rejected" begin fun () ->
+    let saw = ref None in
+    Lwt.dont_wait
+      (fun () -> Lwt.fail Exception)
+      (fun exn -> saw := Some exn);
+    later (fun () -> !saw = Some Exception)
+  end;
+
+  test "pending, fulfilled" begin fun () ->
+    let resolved = ref false in
+    let p, r = Lwt.wait () in
+    Lwt.dont_wait
+      (fun () ->
+        Lwt.bind p (fun () ->
+          resolved := true;
+          Lwt.return ()))
+      (fun _ -> ());
+    Lwt.wakeup r ();
+    later (fun () -> !resolved = true)
+  end;
+
+  test "pending, rejected" begin fun () ->
+    let saw = ref None in
+    let p, r = Lwt.wait () in
+    Lwt.dont_wait
+      (fun () -> p)
+      (fun exn -> saw := Some exn) ;
+    Lwt.wakeup_exn r Exception;
+    later (fun () -> !saw = Some Exception)
+  end;
+]
+let suites = suites @ [dont_wait_tests]
+
 let ignore_result_tests = suite "ignore_result" [
   test "fulfilled" begin fun () ->
     Lwt.ignore_result (Lwt.return ());