Spawning a fiber will disable effect handlers installed after main loop

I have been working on a toy example that better demonstrates the problem with OCaml’s current effect handling system:

open Effect
open Effect.Deep
open Eio

type _ Effect.t += Log : string -> unit t

(* The following function is not aware of any fibers. *)
let logging_with_prefix prefix f =
  try_with f ()
    {
      effc =
        (fun (type a) (eff : a t) ->
          match eff with
          | Log message ->
              Some
                (fun (k : (a, _) continuation) ->
                  print_string prefix;
                  print_endline message;
                  continue k ())
          | _ -> None);
    }

(* The following function is not aware of any fibers. *)
let logging = logging_with_prefix "LOG: "

(* The following function is not aware of any fibers. *)
let logging_important = logging_with_prefix "LOG IMPORTANT: "

(* The following function is generic and not aware of any effects. *)
let do_twice_parallel f = Fiber.both f f

(* The following function is performing but not handling any effects. *)
let double_hello () = do_twice_parallel (fun () -> perform (Log "Hello World!"))

let foo () =
  Fiber.both
    (fun () ->
      (* This should run concurrently with fibers spawned outside [foo]. *)
      for i = 1 to 5 do
        perform (Log ("tick " ^ string_of_int i));
        Fiber.yield ()
      done)
    (fun () ->
      (* We only want this to be logged specially. *)
      logging_important double_hello)

let () =
  logging (fun () ->
      Eio_main.run (fun _env ->
          Fiber.both foo (fun () ->
              for i = 1 to 5 do
                perform (Log ("tock " ^ string_of_int i));
                Fiber.yield ()
              done)))

This creates the following output:

LOG: tick 1                       
LOG: Hello World!
LOG: Hello World!
LOG: tock 1
LOG: tick 2
LOG: tock 2
LOG: tick 3
LOG: tock 3
LOG: tick 4
LOG: tock 4
LOG: tick 5
LOG: tock 5

Now, how to fix the above example to write

LOG: tick 1
LOG IMPORTANT: Hello World!
LOG IMPORTANT: Hello World!
LOG: tock 1
LOG: tick 2
…

instead, without changing the function double_hello and while further keeping do_twice_parallel generic (edit: and without tapping into Eio’s private effects)? I don’t think that’s possible, is it?

I was able to solve this in Lua by making the effect handling be aware of the fibers. See this Lua code, which, using this version of the Lua effect/fiber library, “correctly” prints “LOG IMPORTANT” in front of “Hello World!”:

LOG: tick 1
LOG IMPORTANT: Hello World!
LOG IMPORTANT: Hello World!
LOG: tick 2
LOG: tick 3
LOG: tock 1
LOG: tick 4
LOG: tock 2
LOG: tick 5
LOG: tock 3
LOG: tock 4
LOG: tock 5

(The order of the tick’s and tock’s is a bit off, but that’s not the point here.)


Update:

I opened this issue for tracking the problem:

It’s unclear to me why you’d want to do this, though. If the effect handler resumes the continuation immediately (as in this example) then it could be solved more easily with fiber-local storage. At the moment that’s part of Eio, but I could imagine the stdlib defining a common API for that.

Any program that would install an effect handler to provide a function could instead place the function in fiber-local storage. e.g. your example becomes:

open Eio.Std

let logger = Fiber.create_key ()

let log msg = Fiber.get logger |> Option.iter (fun f -> f msg)

let logging_with_prefix prefix =
  Fiber.with_binding logger (fun message ->
      print_string prefix;
      print_endline message
    )

let logging = logging_with_prefix "LOG: "

let logging_important = logging_with_prefix "LOG IMPORTANT: "

(* The following function is generic and not aware of logging. *)
let do_twice_parallel f = Fiber.both f f

(* The following function is logging but not handling any effects. *)
let double_hello () = do_twice_parallel (fun () -> log "Hello World!")

let foo () =
  Fiber.both
    (fun () ->
       (* This should run concurrently with fibers spawned outside [foo]. *)
       for i = 1 to 5 do
         log ("tick " ^ string_of_int i);
         Fiber.yield ()
       done)
    (fun () ->
       (* We only want this to be logged specially. *)
       logging_important double_hello)

let () =
  Eio_main.run (fun _env ->
      logging @@ fun () ->
      Fiber.both foo (fun () ->
          for i = 1 to 5 do
            log ("tock " ^ string_of_int i);
            Fiber.yield ()
          done))

Indeed, this then requires that logging_with_prefix becomes aware of fibers, while in my code:

In order to gain the “transparency” I have been thinking about, there would still need to be some changes to the stdlib, I guess.

Your solution, however, might solve this problem:


A downside of your solution (or such an API in the stdlib) would be (if I understand it right at this point) that:

  • it doesn’t support real “effects” that change the control flow to apply to fibers (maybe that’s undesired anyway? not sure :thinking:),
  • it requires to distinguish between real effects and those “lightweight” contexts which get passed down to fibers, instead of having a single, unified/generic approach.

In either case, I think the problem requires further discussion. At least I’m not sure what’s the best solution for this or if I’m just having a wrong idea about effects yet.

I have been re-thinking about this again, and I think there is a straightforward solution to the original problem of effect handlers not being applied to spawned fibers.

A solution could be to provide a function within the fiber library (which I will name group scope for now), which installs an effect handler for spawning and which does not return until all spawned fibers have terminated. This function could then ensure that all spawned effects run in the context of that “scope” function.

I created a Lua implementation here for demonstration, and I modified the last example code to use this new “scope” function (see example).

This seems to be much more clean than making effects somehow “aware” of fibers or providing additional hooks. However, it requires users of the fiber library to be aware of effect handling and to consider contexts when spawning.

Concluding, I think that the issue needs (and can!) be solved by a fiber library and doesn’t need to be fixed in OCaml.


Basically this solution resembles @mefyl’s idea here:

I guess there would need to be a new function like Fiber.scope, which then could be used by Fiber.both and others.

Question: Is this existing perhaps already with Eio.Switch? Or is that a different concept?


Update:

Answering my own question, I tried to see if Eio.Switch is acting like my proposed “scope” function above, but it is not. Taking my toy example from the post above and replacing

 let foo () =
-  Fiber.both
-    (fun () ->
-      (* This should run concurrently with fibers spawned outside [foo]. *)
-      for i = 1 to 5 do
-        perform (Log ("tick " ^ string_of_int i));
-        Fiber.yield ()
-      done)
-    (fun () ->
-      (* We only want this to be logged specially. *)
-      logging_important double_hello)
+  Switch.run (fun sw ->
+      Fiber.fork ~sw (fun () ->
+          (* This should run concurrently with fibers spawned outside [foo]. *)
+          for i = 1 to 5 do
+            perform (Log ("tick " ^ string_of_int i));
+            Fiber.yield ()
+          done);
+      Fiber.fork ~sw (fun () ->
+          (* We only want this to be logged specially. *)
+          logging_important double_hello))

I still get

LOG: Hello World!
LOG: Hello World!

with the “IMPORTANT” missing. :face_with_diagonal_mouth:

I think that the whole issue could be resolved by changing some internals of the Eio library, without even needing to change the signature of the API. Eio.Fiber.both could be modified accordingly to either use some sort of scoped fibers or a switch that performs the switching locally (such that installed effect handlers are obeyed). This would still be a potentially compatibility-breaking change, of course.

What do you think? I do believe now that the feature request I made (also linked above) should be targeting at Eio and not OCaml.

Well, “talk is cheap, show me the code”, so I finally took the time to mock my idea. I do realize this is quite the wall of code, but I don’t mind commenting / clarifying it if there is some interest.

Here is a cheap, sort-of minimal illustration of how eio works right now AFAICT.

module Eio = struct
  type fiber = {
    fiber : (unit, unit) Effect.Shallow.continuation;
    mutable over : bool;
  }

  type t = { mutable fibers : fiber list }
  type _ Effect.t += Fork : fiber -> unit Effect.t | Yield : unit Effect.t

  let run f =
    let t = { fibers = [ { fiber = Effect.Shallow.fiber f; over = false } ] } in
    let rec step t =
      match t.fibers with
      | [] -> ()
      | fiber :: fibers ->
          let () =
            t.fibers <- fibers;
            Effect.Shallow.continue_with fiber.fiber ()
              {
                retc = (fun () -> fiber.over <- true);
                exnc = raise;
                effc =
                  (fun (type effect) (effect : effect Effect.t) ->
                    match effect with
                    | Fork fiber ->
                        Some
                          (fun (k : (effect, _) Effect.Shallow.continuation) ->
                            t.fibers <-
                              ({ fiber with fiber = k } :: t.fibers) @ [ fiber ])
                    | Yield ->
                        Some
                          (fun (k : (unit, unit) Effect.Shallow.continuation) ->
                            t.fibers <- t.fibers @ [ { fiber with fiber = k } ])
                    | _ -> None);
              }
          in
          step t
    in
    step t

  let yield () = Effect.perform Yield

  module Switch = struct
    type t = { mutable fibers : fiber list }

    let run f =
      let switch = { fibers = [] } in
      let res = f switch in
      let () =
        let rec join () =
          match List.find_opt (fun { over; _ } -> not over) switch.fibers with
          | None -> ()
          | Some _ -> yield ()
        in
        join ()
      in
      res
  end

  let fork ~sw f =
    let fiber = { fiber = Effect.Shallow.fiber f; over = false } in
    let () = sw.Switch.fibers <- fiber :: sw.Switch.fibers in
    Effect.perform (Fork fiber)
end

Quite a few lines, but the gist of it is that forking will bubble a lambda to the toplevel scheduler, which holds all the running fibers. Yielding bubbles control back to the scheduler, which round-robins to the next fiber until all are over. Scope end just yields in a loop until all fibers are done (atrocious I know, this is just for test purpose).

Testing it with a minimal example:

let () =
  Eio.run @@ fun () ->
  let test name =
    Format.eprintf "%s start@." name;
    Eio.yield ();
    Ping.ping ();
    Format.eprintf "%s finish@." name
  in
  let () =
    Ping.with_pong @@ fun () ->
    Eio.Switch.run @@ fun sw ->
    let () = Eio.fork ~sw (fun () -> test "forked") in
    test "main"
  in
  Format.eprintf "EOP@."
main start
forked start
main finish
forked finish
EOP

Everything is handled, fibers are interleaved, all good.

Let us now introduce another, dummy effect for demonstration puprose:

module Ping = struct
  type _ Effect.t += Ping : unit Effect.t

  let ping () = Effect.perform Ping

  let with_pong f =
    Effect.Deep.try_with f ()
      {
        effc =
          (fun (type effect) (effect : effect Effect.t) ->
            match effect with
            | Ping ->
                Some
                  (fun (k : (effect, _) Effect.Deep.continuation) ->
                    Format.eprintf "pong@.";
                    Effect.Deep.continue k ())
            | _ -> None);
      }
end

If we try using it inside our test, we hit the snag:


let () =
  Eio.run @@ fun () ->
  let test name =
    Format.eprintf "%s start@." name;
    Eio.yield ();
    Ping.ping ();
    Format.eprintf "%s finish@." name
  in
  let () =
    Ping.with_pong @@ fun () ->
    Eio.Switch.run @@ fun sw ->
    let () = Eio.fork ~sw (fun () -> test "forked") in
    test "main"
  in
  Format.eprintf "EOP@."
main start
forked start
pong
main finish
Exception: Stdlib.Effect.Unhandled(Ping.Ping)

This happen because the forked fiber is actually bubbled out of the with_pong handler to be started by the scheduler, so it’s initial run and all its continuation do not have the handler installed. This is quite unfortunate, because it means effects do not compose transparently with eio. A possible workaround would be for libraries using effect to detect eio and manually reinstall effects on forked as illustrated in my previous post, which makes it transparent for the end user, but is still a hassle for libraries maintainer and relies on eio’s Private modules.

Now my instinct was that if we let scopes handle the forking, we can preserve effect handlers; and actually if you take my initial implementation above and simplify Scope.run to just handle forks with the root scheduling function, it just works.

  module Switch = struct
    type t = unit

    let run f = (* This is the scheduler main run function *) run f
  end

(I swear I didn’t cheat to make it look simple, I was just as baffled by the simplicity of the solution :slight_smile: )

main start
forked start
pong
main finish
pong
forked finish
EOP

The fibers are forked at the scope level, and effect handlers are preserved. The scheduling is quite lacking, as scheduling a scope will not yield until all its fibers are done, starving the rest of the program. But that’s easily fixable, scope just need to forward yields up to the root controller.

Here is a gist of the whole thing: A possible alternative scheduling pattern for Eio that preserves effect handler semantics. · GitHub

Now, again, I might have missed something, or maybe this is prohibitively slow, etc. Curious about @talex5 opinion on this.

Cheers,

2 Likes

I think this is similar to what I wrote in my Lua experiment:

where I wrote (in Lua):

function _M.scope(...)
  return schedule(true, ...)
end

I.e. I use the main scheduling function. However, I pass an option (true) to indicate that this is not the root scheduler, which has the consequence that it will forward yields up to the root, as you outlined here, I think:

I implemented this “yielding up” in these lines in my Lua code.

1 Like

I plead 100% guilty to not reading you Lua implementation as I haven’t touched that language for 20 years. It’s a good thing we reached the same conclusion / implementation then :slight_smile:

My understanding was that the custom effect escapes to the eio main loop, but by that reasoning exceptions should behave the same way:

module Effects = struct
  open Effect
  open Effect.Deep

  type _ Effect.t += Greet : string -> unit t

  let run _ =
    try_with
      (fun () ->
       Eio.Fiber.both 
         (fun () -> Eio.traceln "hello")
         (fun () -> perform (Greet "world")))
      ()
      { effc = fun (type a) (eff : a Effect.t)
                 : ((a, _) continuation -> _) option ->
        match eff with
        | Greet who -> Some (fun k ->
            continue k (Eio.traceln "%s" who))
        | _ -> None }
end
module Exceptions = struct
  exception Greet of string

  let run _ =
    try
      Eio.Fiber.both
        (fun () -> Eio.traceln "hello")
        (fun () -> raise (Greet "world"))
    with
      Greet who -> Eio.traceln "%s" who
end

running the first under eio gives the behavior described in detail here, but running the second unexpectedly handles the exception just fine…

# Eio_linux.run Effects.run
+hello
Exception: Stdlib.Effect.Unhandled(Effects.Greet("world"))

# Eio_linux.run Exceptions.run
+hello
+world
- : unit = ()

The only difference I can think of is that the effect saves the stack since it must continue, while the exception doesn’t… but that doesn’t seem related to the effect escaping its handler…

As I understand right, there are currently two different approaches to solve the problem (disregarding my original idea for providing a hook in the effect system itself).

Approach #1:

I.e. here the effect handlers get installed separately for each spawned fiber.

Approach #2:

I.e. here effect handlers get only installed once and spawned fibers are scheduled in such a way that the effect handlers affect all spawned fibers.


It’s notable that both approaches result in a different control flow. Let’s look at what happens if an effect handler discontinues the continuation and returns a value X.

In case #1, I would expect other spawned fibers to continue running. If a spawned fiber performed the effect, then the return value X is used as a return value for the corresponding fiber. In particular: the effect may discontinue several times.

In case #2, a non-resuming effect handler would result in the outer function (that installs the effect handlers) to return X immediately. All spawned fibers within that context cannot continue (and thus should be discontinued).

I believe both variants might be needed in practice (and I’m currently experimenting on both in my Lua implementation, which I called handle_spawned (approach #1) and handle_scoped (approach #2).

What I ran into (which is why I believe approach #1 may be needed in some cases), is that if you have a sub-scheduler, I had problems to make effects yield or sleep (because the effect handlers run in the outer context, which is why I needed handle_spawned in this example).

My appologies for providing Lua examples only. To me, the OCaml syntax for effect handling is very confusing yet and I didn’t have much time to practice with it yet.


Update: Actually even if you mix approaches #1 and #2, sleeping or yielding in an effect handler may lead to surprising results, I believe :slightly_frowning_face:. However, maybe yielding within an effect handler is a somewhat exotic case? I’m not sure.