Add Computation.with_action

polytypic · polytypic · commit 8deffa8ad483 · 2024-04-07T13:48:14.000+03:00
diff --git a/lib/picos/bootstrap/picos_bootstrap.ml b/lib/picos/bootstrap/picos_bootstrap.ml
@@ -63,6 +63,11 @@ module Computation = struct
     let balance_and_mode = Bool.to_int (mode == `FIFO) in
     Atomic.make (Continue { balance_and_mode; triggers = [] })
 
+  let with_action ?(mode : [ `FIFO | `LIFO ] = `FIFO) x y action =
+    let balance_and_mode = one + Bool.to_int (mode == `FIFO) in
+    let trigger = Trigger.from_action x y action in
+    Atomic.make (Continue { balance_and_mode; triggers = [ trigger ] })
+
   let is_canceled t =
     match Atomic.get t with
     | Canceled _ -> true
diff --git a/lib/picos/picos.mli b/lib/picos/picos.mli
@@ -745,6 +745,26 @@ module Computation : sig
   val wait : _ t -> unit
   (** [wait computation] waits for the computation to complete. *)
 
+  val with_action :
+    ?mode:[ `FIFO | `LIFO ] ->
+    'x ->
+    'y ->
+    (Trigger.t -> 'x -> 'y -> unit) ->
+    'a t
+  [@@alert
+    handler
+      "This is an escape hatch for experts implementing schedulers or \
+       structured concurrency mechanisms.  If you know what you are doing, use \
+       [@alert \"-handler\"]."]
+  (** [with_action x y resume] is equivalent to
+      {@ocaml skip[
+        let computation = create () in
+        let trigger = Trigger.from_action x y resume in
+        let _ : bool = try_attach computation trigger in
+        computation
+      ]}
+      ⚠️ The same warnings as with {!Trigger.from_action} apply. *)
+
   (** {2 Interface for propagating cancelation} *)
 
   val canceler : from:_ t -> into:_ t -> Trigger.t
