tunneling effects between domains

dune

(executable
 (name hoge)
 (libraries eio_main domainslib))

main.ml

open Eio.Std

type _ Effect.t += Get : int Effect.t

module Chan = Domainslib.Chan

let sending = Chan.make_unbounded ()
let receiving = Chan.make_unbounded ()

let tunnel (type v ans) (eff : v Effect.t) : (v -> ans) -> ans =
  let sending, receiving = Obj.(magic sending, magic receiving) in
  Chan.send sending eff;
  Chan.recv receiving
;;

let rec tunnel_terminal (type a) () =
  match Chan.recv_poll sending with
  | Some eff ->
    (match (Obj.obj eff : a Effect.t) with
     | Get ->
       let f k = k 42 in
       Chan.send receiving f;
       tunnel_terminal ()
     | eff -> raise @@ Effect.Unhandled eff)
  | None -> Fiber.yield () |> tunnel_terminal
;;

let handle_tunnel_out_f th =
  try th () with
  | effect any, k -> tunnel any @@ Effect.Deep.continue k
;;

let thread1 () =
  handle_tunnel_out_f
  @@ fun () ->
  let v = Effect.perform Get in
  Printf.printf "hoge: %d\n" v;
  flush stdout
;;

let () =
  try
    Eio_main.run
    @@ fun env ->
    Switch.run
    @@ fun sw ->
    let dmgr = Eio.Stdenv.domain_mgr env in
    let () = Fiber.fork ~sw tunnel_terminal in
    let () = Eio.Domain_manager.run dmgr thread1 in
    Switch.fail sw Exit
  with
  | Exit -> ()
;;