Translate 'Lwt_preemptive.detach'

Author: Julow

bin/lwt_to_direct_style/ast_rewrite.ml

@@ -390,6 +390,12 @@ let rewrite_apply ~backend ~state full_ident args =
   | "Lwt_io", "flush" -> take @@ fun fd -> return (Some (backend#io_flush fd))
   | "Lwt_main", "run" ->
       take @@ fun promise -> return (Some (backend#main_run promise))
+  | "Lwt_preemptive", "detach" ->
+      take @@ fun f ->
+      take @@ fun arg ->
+      return
+        (Some
+           (backend#domain_detach (mk_thunk (Exp.apply f [ (Nolabel, arg) ]))))
   | _ -> return None
 
 (** Transform a [binding_op] into a [pattern] and an [expression] while

bin/lwt_to_direct_style/concurrency_backend.ml

@@ -326,4 +326,16 @@ let eio ~eio_sw_as_fiber_var ~eio_env_as_fiber_var add_comment =
           (Labelled (mk_loc "follow"), mk_constr_of_bool follow);
           (Nolabel, mk_apply_simple [ "Eio"; "Path"; "/" ] [ env "cwd"; path ]);
         ]
+
+    method domain_detach thunk =
+      mk_apply_ident
+        (fiber_ident "fork_promise")
+        [
+          get_current_switch_arg ();
+          ( Nolabel,
+            mk_thunk
+              (mk_apply_simple
+                 [ "Eio"; "Domain_manager"; "run" ]
+                 [ env "domain_mgr"; thunk ]) );
+        ]
   end

test/lwt_to_direct_style/to_direct_style.t/run.t

@@ -230,9 +230,11 @@ Make a writable directory tree:
     Lwt_mutex.lock (line 136 column 9)
     Lwt_mutex.unlock (line 137 column 9)
     Lwt_mutex.with_lock (line 138 column 9)
-  lib/test_lwt_unix.ml: (43 occurrences)
+  lib/test_lwt_unix.ml: (47 occurrences)
     Lwt_io (line 7 column 8)
     Lwt.return (line 12 column 3)
+    Lwt.return (line 46 column 11)
+    Lwt.return_unit (line 44 column 43)
     Lwt.let* (line 10 column 3)
     Lwt.let* (line 11 column 3)
     Lwt.let* (line 30 column 3)
@@ -264,6 +266,8 @@ Make a writable directory tree:
     Lwt_io.stdout (line 26 column 33)
     Lwt_io.open_file (line 30 column 13)
     Lwt_io.open_file (line 34 column 13)
+    Lwt_preemptive.detach (line 44 column 10)
+    Lwt_preemptive.detach (line 47 column 3)
     Lwt_unix.Timeout (line 14 column 9)
     Lwt_unix.of_unix_file_descr (line 6 column 8)
     Lwt_unix.stat (line 37 column 16)
@@ -816,3 +820,18 @@ Make a writable directory tree:
       ?count:(Some 42) chan
   
   let _f chan = Eio.Buf_write.flush chan
+  
+  let _f =
+    Fiber.fork_promise ~sw (fun () ->
+        Eio.Domain_manager.run env#domain_mgr (fun () ->
+            (* TODO: lwt-to-direct-style: [sw] (of type Switch.t) must be propagated here. *)
+            (* TODO: lwt-to-direct-style: [env] must be propagated from the main loop *)
+            (fun () -> ()) ()))
+  
+  let _f =
+    let f = fun x1 -> x1 in
+    Fiber.fork_promise ~sw (fun () ->
+        Eio.Domain_manager.run env#domain_mgr (fun () ->
+            (* TODO: lwt-to-direct-style: [env] must be propagated from the main loop *)
+            (* TODO: lwt-to-direct-style: [sw] (of type Switch.t) must be propagated here. *)
+            f 12))

test/lwt_to_direct_style/to_direct_style.t/src/lib/test_lwt_unix.ml

@@ -40,3 +40,8 @@ let _f chan = Lwt_io.read chan
 let _f chan = Lwt_io.read ~count:42 chan
 let _f chan = Lwt_io.read ?count:(Some 42) chan
 let _f chan = Lwt_io.flush chan
+
+let _f = Lwt_preemptive.detach (fun () -> Lwt.return_unit) ()
+let _f =
+  let f = Lwt.return in
+  Lwt_preemptive.detach f 12