Merge pull request #960 from kit-ty-kate/run_in_main_no_wait

Add Lwt_preemptive.run_in_main_no_wait

Author: raphael-proust

CHANGES

@@ -21,6 +21,8 @@
   * Lwt.reraise an exception raising function which preserves backtraces, recommended for use in Lwt.catch (#963)
   * Expose Lwt_io.delete_recursively for deleting a directory and its content recursively. (#984, Antonin Décimo)
 
+  * Lwt_preemptive.run_in_main_dont_wait to run a function in the main preemptive thread but without waiting for the result. (Kate Deplaix, #960)
+
 ====== Build ======
 
   * Remove unused dependency in dune file. (#969, Kate Deplaix)

src/unix/lwt_preemptive.ml

@@ -228,6 +228,14 @@ let job_notification =
        Mutex.unlock jobs_mutex;
        ignore (thunk ()))
 
+let run_in_main_dont_wait f =
+  (* Add the job to the queue. *)
+  Mutex.lock jobs_mutex;
+  Queue.add f jobs;
+  Mutex.unlock jobs_mutex;
+  (* Notify the main thread. *)
+  Lwt_unix.send_notification job_notification
+
 (* There is a potential performance issue from creating a cell every time this
    function is called. See:
    https://github.com/ocsigen/lwt/issues/218
@@ -245,13 +253,13 @@ let run_in_main f =
     CELL.set cell result;
     Lwt.return_unit
   in
-  (* Add the job to the queue. *)
-  Mutex.lock jobs_mutex;
-  Queue.add job jobs;
-  Mutex.unlock jobs_mutex;
-  (* Notify the main thread. *)
-  Lwt_unix.send_notification job_notification;
+  run_in_main_dont_wait job;
   (* Wait for the result. *)
   match CELL.get cell with
   | Result.Ok ret -> ret
   | Result.Error exn -> raise exn
+
+(* This version shadows the one above, adding an exception handler *)
+let run_in_main_dont_wait f handler =
+  let f () = Lwt.catch f (fun exc -> handler exc; Lwt.return_unit) in
+  run_in_main_dont_wait f

src/unix/lwt_preemptive.mli

@@ -34,6 +34,15 @@ val run_in_main : (unit -> 'a Lwt.t) -> 'a
       retrieve values set this way inside [f ()], but not values set using
       {!Lwt.with_value} outside [f ()]. *)
 
+val run_in_main_dont_wait : (unit -> unit Lwt.t) -> (exn -> unit) -> unit
+(** [run_in_main_dont_wait f h] does the same as [run_in_main f] but a bit faster
+    and lighter as it does not wait for the result of [f].
+
+    If [f]'s promise is rejected (or if it raises), then the function [h] is
+    called with the rejection exception.
+
+    @since 5.7.0 *)
+
 val init : int -> int -> (string -> unit) -> unit
   (** [init min max log] initialises this module. i.e. it launches the
       minimum number of preemptive threads and starts the {b

test/unix/test_lwt_unix.ml

@@ -1063,6 +1063,52 @@ let lwt_preemptive_tests = [
     Lwt_preemptive.detach f () >>= fun x ->
     Lwt.return (x = 42)
   end;
+  test "run_in_main_dont_wait" begin fun () ->
+    let p, r = Lwt.wait () in
+    let f () =
+      Lwt_preemptive.run_in_main_dont_wait
+        (fun () ->
+          Lwt.pause () >>= fun () ->
+          Lwt.pause () >>= fun () ->
+          Lwt.wakeup r 42;
+          Lwt.return ())
+        (fun _ -> assert false)
+    in
+    Lwt_preemptive.detach f () >>= fun () ->
+    p >>= fun x ->
+    Lwt.return (x = 42)
+  end;
+  test "run_in_main_dont_wait_fail" begin fun () ->
+    let p, r = Lwt.wait () in
+    let f () =
+      Lwt_preemptive.run_in_main_dont_wait
+        (fun () ->
+          Lwt.pause () >>= fun () ->
+          Lwt.pause () >>= fun () ->
+          raise Exit)
+        (function Exit -> Lwt.wakeup r 45 | _ -> assert false)
+    in
+    Lwt_preemptive.detach f () >>= fun () ->
+    p >>= fun x ->
+    Lwt.return (x = 45)
+  end;
+  test "run_in_main_with_dont_wait" begin fun () ->
+    let p, r = Lwt.wait () in
+    let f () =
+      Lwt_preemptive.run_in_main (fun () ->
+        Lwt.dont_wait
+          (fun () ->
+            Lwt.pause () >>= fun () ->
+            Lwt.pause () >>= fun () ->
+            Lwt.wakeup r 42;
+            Lwt.return ())
+          (function _ -> Stdlib.exit 2);
+        Lwt.return ())
+    in
+    Lwt_preemptive.detach f () >>= fun () ->
+    p >>= fun x ->
+    Lwt.return (x = 42)
+  end;
 ]
 
 let getlogin_works =