The Fiber.current () operation must never propagate cancelation

polytypic · polytypic · commit 4da71f315488 · 2024-03-21T23:39:23.000+02:00
The problem is that in order to call `Fiber.forbid fiber (fun () -&gt; ...)` to
forbid cancelation, it is necessary to call `Fiber.current ()` to obtain the
`fiber`.  Hence `Fiber.current ()` must not propagate cancelation.  In some
cases one could call `Fiber.current ()` well before performing the work that
needs to be protected by `Fiber.forbid ...`, but this is not always practical.
diff --git a/lib/picos/intf.ocaml5.ml b/lib/picos/intf.ocaml5.ml
@@ -86,11 +86,11 @@ module type Fiber = sig
   (** Schedulers may handle the {!Current} effect to customize the behavior of
       [current].
 
-      A handler should eventually either continue the fiber or discontinue it in
-      case the fiber permits propagation of cancelation and the associated
-      computation has been canceled.
+      ⚠️ A handler should eventually resume the fiber without propagating
+      cancelation.  A scheduler may, of course, decide to reschedule the current
+      fiber to be resumed later.
 
-      Note that in typical use cases of [current] it makes sense to give
+      Note that in typical use cases of {!current} it makes sense to give
       priority to the fiber performing {!Current}, but this is not required. *)
   type _ Effect.t += private Current : t Effect.t
 
diff --git a/lib/picos/picos.mli b/lib/picos/picos.mli
@@ -95,7 +95,7 @@
     {{!Fiber.permit} permit} the scheduler from propagating cancelation to it.
     This is important for the implementation of some key concurrent abstractions
     such as condition variables, where it is necessary to forbid cancelation
-    when the associated mutex is re-acquired.
+    when the associated mutex is reacquired.
 
     Each fiber has an associated {!Computation}.  A computation is something
     that needs to be completed either by {{!Computation.return} returning} a
@@ -814,7 +814,7 @@ module Fiber : sig
   (** {2 Interface for rescheduling} *)
 
   val yield : unit -> unit
-  (** [yield ()] asks the current fiber to be re-scheduled.
+  (** [yield ()] asks the current fiber to be rescheduled.
 
       ℹ️ The behavior is that
 
@@ -867,7 +867,11 @@ module Fiber : sig
 
       - on OCaml 5, [current] performs the {!Current} effect, and
       - on OCaml 4, [current] will call the [current] operation of the
-        {{!Handler} current handler}. *)
+        {{!Handler} current handler}.
+
+      ⚠️ The [current] operation must always resume the fiber without propagating
+      cancelation.  A scheduler may, of course, decide to reschedule the current
+      fiber to be resumed later. *)
 
   val has_forbidden : t -> bool
   (** [has_forbidden fiber] determines whether the fiber {!forbid}s or
@@ -889,7 +893,7 @@ module Fiber : sig
       abstractions that may have to {{!Trigger.await} await} for something, or
       may need to perform other effects, and must not be canceled while doing
       so.  For example, the wait operation on a condition variable typically
-      re-acquires the associated mutex before returning, which may require
+      reacquires the associated mutex before returning, which may require
       awaiting for the owner of the mutex to release it.
 
       ℹ️ [forbid] does not prevent the fiber or the associated {!computation}
diff --git a/lib/picos_fifos/picos_fifos.ml b/lib/picos_fifos/picos_fifos.ml
@@ -25,7 +25,13 @@ type t = {
 let rec next t =
   match Queue.pop_exn t.ready with
   | Spawn (fiber, main) ->
-      let current = Some (fun k -> Fiber.continue fiber k fiber)
+      let current =
+        Some
+          (fun k ->
+            (* The current handler must never propagate cancelation, but it
+               would be possible to continue some other fiber and resume the
+               current fiber later. *)
+            Effect.Deep.continue k fiber)
       and yield =
         Some
           (fun k ->
diff --git a/lib/picos_threaded/picos_threaded.ml b/lib/picos_threaded/picos_threaded.ml
@@ -72,11 +72,13 @@ let[@alert "-handler"] rec await fiber trigger =
   end
 
 and current fiber =
-  (* In each handler we need to account for cancelation. *)
-  Fiber.check fiber;
+  (* The current handler must never propagate cancelation, but it would be
+     possible to yield here to run some other fiber before resuming the current
+     fiber. *)
   fiber
 
 and yield fiber =
+  (* In other handlers we need to account for cancelation. *)
   Fiber.check fiber;
   Systhreads.yield ()
 
