Spawning a fiber will disable effect handlers installed after main loop

I recently tried to implement effects and fibers in Lua (using Lua’s coroutines). I stumbled upon the problem that when implementing fibers through effects with a naïve implementation, then spawning a new fiber would cause the fiber to be executed in the outer context of the scheduler rather than being subject to local effect handlers.

I was curious how OCaml solves this problem, but it looks like it doesn’t address the issue. Thus a fiber does not obey any effect handlers that are in between starting the main event loop and spawning the fiber.

Consider the following example (which uses the libraries eio and eio_main):

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

let log message = Effect.perform (Log message)

let do_not_log f =
  Effect.Deep.try_with f ()
    {
      effc =
        (fun (type a) (eff : a Effect.t) ->
          match eff with
          | Log _ ->
              Some
                (fun (k : (a, _) Effect.Deep.continuation) ->
                  Effect.Deep.continue k ())
          | _ -> None);
    }

let log_to_stdout f =
  Effect.Deep.try_with f ()
    {
      effc =
        (fun (type a) (eff : a Effect.t) ->
          match eff with
          | Log message ->
              Some
                (fun (k : (a, _) Effect.Deep.continuation) ->
                  Printf.printf "Log: %s" message;
                  print_newline ();
                  Effect.Deep.continue k ())
          | _ -> None);
    }

let foo () = log "doing foo"
let do_twice_in_parallel f = Eio.Fiber.both f f

let bar () =
  foo ();
  do_twice_in_parallel foo

let main _ =
  print_endline "### Executing foo with logging";
  log_to_stdout foo;
  print_endline "### Executing foo without logging";
  do_not_log foo;
  print_endline "### Executing bar with logging";
  log_to_stdout bar

let () = Eio_main.run main

Output:

### Executing foo with logging    
Log: doing foo
### Executing foo without logging
### Executing bar with logging
Log: doing foo
Fatal error: exception Stdlib.Effect.Unhandled(Dune__exe__Fiber_test.Log("doing foo"))

Both in regard to OCaml and in regard to my own experiments in Lua, I’m curiuous whether this behavior is well-known and/or desired.

1 Like

There’s some related discussion here: How to compose effect handlers with Eio - #20 by wokalski

I feel like there are two issues discussed there. One issue is exhibited by the following code:

The above program does NOT crash with my current version of OCaml and the libraries. So that’s no longer an issue it seems. I believe it was solved here.

However, my issue is that when I switch these statements

 let main () =
-  Echo.run (fun () ->
-      Eio_main.run (fun _ ->
+  Eio_main.run (fun _ ->
+      Echo.run (fun () ->
           Eio.Fiber.both
             (fun () ->

then the effect won’t be handled.

This is the same problem as exhibited in the program in my OP in this topic (and if I’m not mistaken, then the OP of the other thread also installs the effect handler between the event loop and the fiber creation).

One might ask, why not install all handlers outside the Eio_main.run event loop. Well, that’s not always practical. In particular, a function x might receive a callback y and make use of fibers internally which then use the callback y. If that callback y makes use of effects, we can’t call x with those effect being handled locally because the fibers will disable the handlers (like in my example code in the beginning of this thread).

To my understanding, one purpose of effects is to “pass” them through the stack without any functions in between on the stack needing to know something about them (similar to exceptions bubbling up the stack). Now this goal seems to be missed by the current implementation in some (corner?) cases.

Eio.Fiber.both f g runs f and g concurrently in the context of the Eio scheduler (I think?). What you want is some both_inplace f g that runs f and g in the context where both_inplace was called.

I don’t think anything fundamentally prevents this, I think a simple local overriding of Yield would work:

let finish f =
  ignore @@
  deep_handle f () with
  | Yield (), k -> k ()

let rec both_inplace f g =
  ignore @@
  shallow_handle f () with
  | Yield (), k -> both_inplace g k
  | return v -> finish g

Of course that is the most basic local scheduler possible, Eio would probably want something more involved that adds the two threads into the thread’s pool, it’s just not implemented.

1 Like

My approach was to use a hook in the effect handling, but overriding the scheduling effects (i.e. yield) might be a much cleaner approach.

However, I think that when you add the threads to the pool, things get much more complicated (implementation wise).

One issue might be that if you start fibers in the background, they might be resumed after their enclosing effect handling function has already returned. (That’s one of the issues I faced when trying to implement effects in Lua.)

Pseudocode:

let retval = handle_my_effect @@ fun () ->
  spawn (fun () -> yield (); perform MyEffect; yield ());
  "return_value"
in
(* handle_my_effect has returned at this point *)
print_endline retval;
yield ();
(* may call the spawned fiber,
   even if handle_my_effect has already returned *)

I wonder if there is some theoretical or practical work around that discusses these issues.

Also, does someone know how Koka is doing it? As far as I understood, parallelism in Koka is still pretty much experimental and not usable, but I might be wrong.

A fork/spawn like that, that remembers to execute the function in the calling context and also proceeds with normal execution, would need to capture the continuation (up to the Eio delimiter, let’s say) and use it twice. OCaml by default supports one-shot continuations, and copying continuations has some issues.

Coroutines also correspond to one-shot delimited continuations.

I don’t think that’s necessarily the case. For example, one could demand that whenever handle_my_effect returns, all spawned fibers (within that context) will cause an exception when

  • they are resumed, or
  • they perform MyEffect, or even when
  • they didn’t terminate before handle_my_effect returned.

The fiber itself will never be continued more than once (for each yield).

In my Lua implementation, I disallowed continuing threads/fibers that were spawned within an effect-handled section if that section has already been returned from.


Follow-up:

I think the reason why one might assume this needs continuations that can resume twice is that the effect handler installed by handle_my_effect might do an early return. So whenever the inner fiber runs, it might perform MyEffect, and the effect handler then could do an early return. And if handle_my_effect has already returned, it would need to return twice.

However, it would be counter-intuitive (and in my opinion undesired) behavior if handle_my_effect returns twice, just because the effect handler performs an early return triggered by an effect that has been performed by a fiber.

Instead, whenever handle_my_effect returns, then the context in which all the spawned fibers (created within the passed function) are running is destroyed, and then resuming them (or at least when they perform an effect that does an early return) should be considered a runtime exception.

This is why I believe parallelism needs to be handled in a special way by an effect system. A naïve implementation of

  • creating an effect system, and then
  • using that effect system to implement fibers

doesn’t seem to work well. Instead, the effect system must be already aware of parallelism or somehow provide hooks to allow for fibers interacting with the installation of effect handlers.

I’m not sure about the whole issue though. Once I get my Lua implementation running (it still has some unresolved bugs), I might present it here to give an actual working example (and a solution) of the problem that I tried to describe. But it’s not easy to implement.

So maybe you won’t actually resume the continuation more than once, but it sounds like you still would need to somehow store/remember fibers (i.e. the stack segments associated with handlers) after they’ve been already used (fully popped off the stack) by the “main” path of execution. This leads to exactly the same problems with the performance cost of copying/persistence and semantical issues with resources and optimizations related to “entering the room once but leaving twice”.

Are you aware of One-shot Algebraic Effects as Coroutines in Lua? (I haven’t read it but sounds related)

I don’t understand why that would be necessary.

In my Lua implementation (that is still buggy and not published yet), every effect handler installation effectively contained an own (sub)scheduler (installed through a hook by the fiber library). Thus when a function like handle_my_effect returns, all the data structures associated with that thread are destroyed (except join/wakeup handles, which would result in a runtime exception when being used unless the fiber had already completed its execution).

I just skimmed through it. It seems related indeed, but I don’t see their actual implementation in Lua (edit: found it here).

Basically what I did in Lua was to implement effects on top of the coroutine library.

  • perform is implemented using Lua’s coroutine.yield.
  • handle is implemented by running the passed function as a coroutine, catching any yielded effects that are being handled and passing any non-handled effects further up the stack by using coroutine.yield again (and passing any value passed to the continue function back to the interrupted coroutine using Lua’s coroutine.resume).

I managed to make it work almost transparently, so even if the library uses coroutine.yield, it may still be used by other user code.


Update #1: I just published the effect handling part of the Lua library on github.com/JanBeh/neumond, so maybe that makes it easier to talk about it. The threading/fiber part of the library is still buggy and not published as of yet. If I manage to get it working the way I would like it to work, I will share it here as well, also for a demonstration in regard to how I believe fibers and effects should interact with each other.

Update #2: Note that my implementation in Lua doesn’t require a discontinue function like in OCaml’s Effect.Deep module. The reason is that I cleanup the stack by throwing an exception in the inner function when performing an early return. I thus wonder if the Effect.Deep.discontinue function in OCaml is really needed.

I have encountered this exact problem while experimenting with an effect-based interface for logs, which enable amongst other things to define a logger in a pure manner instead of using a global ref, change the logger for a subscope, indent or add a tag to all nested logs, …

let () =
  Logs.with_reporter reporter @@ fun () ->
  Logs.with_info (fun m -> m "indent nested logs ") @@ fun () ->
  for x = 1 to 3 do
     Logs.info (fun m -> m "%d" x)
  done

(*
logs_eio.exe: [INFO] indent nested logs
logs_eio.exe: [INFO]   x = 1
logs_eio.exe: [INFO]   x = 2
logs_eio.exe: [INFO]   x = 3
*)

To my initial surprise, this didn’t work once combined with eio:

let () =
  Eio_main.run @@ fun _ ->
  Logs.with_reporter reporter @@ fun () ->
  Logs.with_info (fun m -> m "indent nested logs") @@ fun () ->
  Eio.Fiber.both
    (fun () ->
      for x = 1 to 3 do
        Logs.info (fun m -> m "x = %d" x);
        Eio.Fiber.yield ()
      done)
    (fun () ->
      for y = 1 to 3 do
        Logs.info (fun m -> m "y = %d" y);
        Eio.Fiber.yield ()
      done)

(*
logs_eio.exe: [INFO] scope 
Fatal error: exception Stdlib.Effect.Unhandled(Logs.Report(_, 0, 3, _, _, _))
*)

As explained by previous posts, it is logical given the implementation of forking in eio, and AFAICT it’s not possible to make it work out of the box since continuation can only be resumed once. It is however IMO counterintuitive and quite disappointing, as I really want this to work. The with_reporter could be moved above Eio_main.run, but being able to change reporter for a scope sounds useful (say redirect to a file) and my nesting/indentation is still lost.

I did find a reasonable workaround though, which consists in intercepting eio forks by tapping directly into its private effects and reinstalling the effect handler in the forked fiber:

  (** Installs [install] on [f] and reinstalls it on all forked fibers *)
  let reinstall install f =
    install @@ fun () ->
    Effect.Deep.try_with f ()
      {
        effc =
          (fun (type a) (eff : a Effect.t) ->
            match eff with
            | Eio.Private.Effects.Fork (context, fiber) ->
                let fiber () = install fiber in
                Some
                  (fun (continuation : (a, _) Effect.Deep.continuation) ->
                    Effect.Deep.continue continuation
                    @@ Effect.perform
                         (Eio.Private.Effects.Fork (context, fiber)))
            | _ -> None);
      }

  let with_reporter reporter f = reinstall (with_reporter reporter) f
  let with_info msgf f = reinstall (with_info msgf) f

(*
logs_eio.exe: [INFO] scope 
logs_eio.exe: [INFO]   x = 1
logs_eio.exe: [INFO]   y = 1
logs_eio.exe: [INFO]   x = 2
logs_eio.exe: [INFO]   y = 2
logs_eio.exe: [INFO]   x = 3
logs_eio.exe: [INFO]   y = 3
*)

I think this could be enabled automatically by libraries when eio is detected. Since a new handler is installed, it also solves the question of “what happens if the fiber keeps running after we get out of scope of the initial handler”. I’m still only beginning toying with this though.

1 Like

This supports me in my suspicion that it’s not just a theoretical problem (or a misconception on my end?) but something you can run into in practice as well. Thanks for sharing!

I would say the current behavior is indeed “logical”. Not sure about “counterintuitive” (that might depend on documentation), but I would say it’s impractical, to say the least. In particular, I feel like it undermines transparency of functions in regard to effects, i.e. if a function uses fibers (that are implemented using effects), it will no longer be transparent for effects.

With transparency, I mean that an effect will “bubble through the stack” until it hits a handler, so any callback-based API will be transparent (as in invisible or passable) for the effect. Now if fibers are implemented through effects and the scheduler is on an outer level, then the stack will be “interrupted” at the point of spawning/forking, and the “bubbling” doesn’t work anymore.

Sorry for using this figurative language, I haven’t been able to express these thoughts in a mathematically sound way.

This “transparency” is an important property of effects in my opinion, and one of the reasons why I got interested in effects in the first place: For anyone who is interested, I have witnessed some limitations of Rust where API’s that use callbacks need to be aware of

  • async
  • fallibility (which is idiomatically not implemented through exceptions in Rust but through a Result data type that has to be passed through every function call on the stack)

As far as I understand, the idea of using generalized effects is (apart from ideally providing type safety in regard to effects, as done by Koka) to unify the concepts of

  • exceptions
  • yielding (whether for parallelism or generator-style programming)
  • mutli-shot continuations (not supported by OCaml or the two Lua implementations though, and more of an exotic thing)
  • allowing context-based execution of certain operations (like the logging example)

I surmise that if an effect system is used for yielding and/or parallelism, it gets unusable for the logging use-case. This brings me to the following assertion:

  • If you have coroutines in a language, it is possible to implement a (one-shot) effect system on top of that, as shown in the paper linked by @monoidoid above (though this may make your coroutines unusable for other purposes, as mentioned in section 4 of that paper).
  • You can implement coroutines or parallelism (again) on top of an effect system (as done by the Eio.Fiber module :smiley:, BUT then this makes the original effect system unsuitable for transparently handling other effects :frowning_face: (because any spawning will interrupt the “bubbling”).
  • This, again, can be solved, by implementing a new effect handling system on top of what you have, which is what @mefyl demonstrated with the reinstall function (note that this required dabbling with internals in Eio.Private):

This also concurs with what I experienced when implementing effects and fibers in Lua: Once I implemented fibers in Lua, I needed to modify the effect system (through hooks) in order to make the effect-handler-installation function aware of the fibers.

So far, this is still pretty confusing to me. However, I think this is a serious problem that needs to be addressed. I would probably open up an issue on this for tracking the problem (unless there is already an open issue?). I don’t know what’s the best solution to the problem, but I feel like the effect system needs some additional hook which can be utilized by a library that implements fibers through that effect system.

As said above, I don’t think this is related to resuming continuations twice, but honestly I’m not overlooking the whole issue very well.

3 Likes

Effects are still a new toy in OCaml, and opinion diverge on what they are useful for. I personally am a firm believer that they are just another control mechanism tool that can really improve code quality.

Actually now that you mention it, there might be a different design that would enable this. The issue right now, I think, is that when forking with eg. Fiber.both the effect is handled by the scheduler at the very toplevel, and once we’re there there is no way to resume execution at the fork site twice, one for each fiber: we can recycle the continuation at most for one of them. This has the unfortunate effect of losing effect handlers, the stacktrace, etc.

But if the effect were handled at the fork point (ie. by Fiber.both, Switch functions etc) maybe we could preserve everything. This however would complicate the design quite a bit, as eio wouldn’t have a central scheduler with all the coroutines neatly listed, but a tree of nested coroutines it has to communicate with via effects. Maybe there is a technical limitation that I missed that would prevent this too.

I had a closer look at their Lua implementation. As far as I understand, it doesn’t seem to do tail-call elimination in case of shallow effect handling (I might be wrong though, as I don’t really fully understand the library).

Am I right that shallow effect handling is needed to implement fibers? Attempting to use deep effect handling for fibers might be the reason why my Lua code was buggy in past.

Side note: I updated my own Lua implementation of effect handling to support shallow effect handling with proper tail-call elimination, i.e. this example program can run indefinitely without a stack overflow.

Is it also right that the discontinue function is mostly needed in case of shallow effect handling? I would think that in case of deep effect handling, you could just automatically discontinue once the effect handler returns (like done in my Lua library)? But for some reason OCaml’s Effect library didn’t do that, and both deep and shallow effect handling use an explicit discontinue function?

discontinue is necessary to (1) unwind the stack, running finalisers to free up resources and (2) free up the stack space allocated for fibers when fibers don’t run to completion. See the OCaml manual for more details OCaml - Language extensions.

You need discontinue irrespective of whether the handler is shallow or deep.

1 Like

I understand that I need discontinue the way the Effect.Deep library has been designed, but my question is: Could we (hypothetically) design an Effect.DeepAutoDiscontinue that automatically does the cleanup work once Effect.DeepAutoDiscontinue.try_with has returned?

This is what my Lua implementation does currently (but only in case of deep handling).

As far as I understand, fibers need to be implemented with shallow handling.


Edit: Re-thinking about this, I believe that fibers could be implemented either with shallow or deep handling (because the effect handlers don’t need to be exchanged/replaced). Instead, I believe “auto discontinuing” would make it impossible to implement fibers on top of an effect library. However, I’d still think something like DeepAutoDiscontinue might be handy for a couple of other use-cases.

The issue is more fundamental. You have a continuation which is a first class value representing suspended computations. The continuations may close over resources such as file descriptors. You can store the continuations in arbitrary data structures. If you never resume a suspended continuation you will leak the resources it closes over.

Given this, I don’t understand the model of “auto discontinuing”. Are you suggesting that the GC determines that the continuation becomes unreachable and does the discontinue? You can do this by installing a finaliser to every captured continuation which will discontinue the continuation if it happens to be unresumed. We’ve explored this in the PLDI 2021 paper ([2104.00250] Retrofitting Effect Handlers onto OCaml) and in the general case, it is too expensive to attach a finaliser to every continuation.

In OCaml, continuations are treated like resources. Just like having to close file descriptors, we leave it to the programmer to ensure that every continuation is resumed exactly once. This is the same choice that we make in the Wasm effect handlers work ([2308.08347] Continuing WebAssembly with Effect Handlers).

2 Likes

No, I didn’t mean GC. I meant instantaneous cleanup as soon as Effect.DeepAutoDiscontinue.try_with returns. This would mean, however, that you couldn’t store the continue funnction and call it later (after try_with returned). That shouldn’t be a problem in many use-cases, because when doing deep effect handling, you often only want to call the continue function from within an effect handler anyway.

Note that continue already has restrictions anyway, as you can’t call it twice either. This would introduce another restriction (that may not be a problem for most use-cases, but some). So manual cleanup is still needed for use-cases where this restriction is a problem.

Thanks for the link, I’ll look into it later when I have time (currently on mobile here). Beside being expensive to do cleanup through GC, I think the bigger issue why GC-based discontinuing is a bad idea is that the freeing of resources will happen in a time-delayed manner, i.e. finalizers would not be executed in time, such as it is the case when working with exceptions.

Not sure how you’d enforce this. Unless you track scope, you won’t be able to store the (continuation / the continue function) in any mutable data structure as it can potentially escape the scope.

Sorry if I was imprecise.

I meant: If it escapes and you use it later, it would raise an exception at runtime (same as what happens already when calling it twice).


Update: I implemented a proof of concept in Lua showing how auto-discontinuation with deep handling vs manual discontinuation with shallow handling can look like in practice.

I have been working on a proof-of-concept for implementing effect handling and fibers in such a way that effect handlers are applied to spawned fibers, also when they are installed while the main loop already runs, thus providing some evidence for my thesis above.

It is implemented in Lua, though, and not in OCaml. It can be found here: GitHub - JanBeh/neumond: Effects in Lua.

An example program using the current version of the library can be found here, with an excerpt given below:

local fiber = require "fiber"
local effect = fiber.effect_mod -- use modified "effect" module from "fiber"

local log = effect.new("log")

local function logging(...)
  return effect.handle({
    [log] = function(resume, message)
      print("LOG: " .. tostring(message))
      return resume()
    end,
  }, ...)
end

local retval = fiber.main(function()
  local v
  local producer, consumer
  local retval = logging(function()
    producer = fiber.spawn(function()
      log("Producer started")
      for i = 1, 10 do
        while v ~= nil do
          fiber.sleep()
        end
        v = i
        consumer:wake()
      end
      log("Producer finished")
      return "Producer finished"
    end)

It is possible to install a logger using the logging function, and it will apply to any spawned fibers as well! In consequence, logging will not return until all spawned fibers have terminated, but the logging handler will always be executed in the same context. I think this differs from the solution provided by @mefyl, and I think my solution is more generic and less prone to cause surprises in certain scenarios (but not sure about that).

Also note that my second hypothesis (“You can implement coroutines or parallelism (again) on top of an effect system […] BUT then this makes the original effect system unsuitable for transparently handling other effects”) seems to be true. If we replace

 local fiber = require "fiber"
-local effect = fiber.effect_mod -- use modified "effect" module from "fiber"
+local effect = require "effect"

i.e. if we use the original function from the effect library, then the handling of the effect is not applied to the spawned fiber (as expected):

lua54: unhandled effect or yield: log effect

I would be interested in feedback to my approach, and I’m also curious if this could be implemented for OCaml (as I think it is a better approach than the currently existing one, but not sure). Maybe there could be some sort of hook in the effect library such that code which uses Effect.Deep does not need to be aware of fibers in order to transparently use effects (instead of requiring the code to use a different module when fibers are used). One solution I had been thinking of is that installing an effect handler could be implemented by obtaining the respective function through an effect (which can be handled and thus overridden depending on execution context) :face_with_spiral_eyes:.


P.S.: Where should or could I open an issue in regard to the current behavior where effect handlers are not applied to spawned fibers? I’m unsure if this is an issue of Eio or whether this should (or rather needs to) be addressed by OCaml’s Effect library (e.g. by providing a hook that could be used by Eio then).

Of course, I don’t consider the current behavior as buggy. It seems to behave as specified. But I think it isn’t very useful for some scenarios and thus could (or should) be improved (unless it’s already too late because things are stabilized, which I hope is not the case).


P.P.S.: Rethinking about this, I wonder if there is an optimal behavior at all. My proposed solution would solve the problem discussed in the original post but avoid any handler installation from returning until all fibers spawned inside have terminated (because they might invoke an action that needs to be handled). This likely can be same (or even more?) surprising as an effect handler not being applied to spawned fibers. :thinking: