From 53853e841a6fd47c9e66ae36fcb9d1a60821c28d Mon Sep 17 00:00:00 2001
From: Vesa Karvonen <vesa.a.j.k@gmail.com>
Date: Thu, 8 Aug 2024 10:26:52 +0300
Subject: [PATCH] Experiment to use shallow effects in `picos.fifos`

---
 lib/picos_mux.fifo/picos_mux_fifo.ml | 43 ++++++++++++++++------------
 1 file changed, 24 insertions(+), 19 deletions(-)

diff --git a/lib/picos_mux.fifo/picos_mux_fifo.ml b/lib/picos_mux.fifo/picos_mux_fifo.ml
index 083efda0..1e5773cc 100644
--- a/lib/picos_mux.fifo/picos_mux_fifo.ml
+++ b/lib/picos_mux.fifo/picos_mux_fifo.ml
@@ -4,11 +4,13 @@ let[@inline never] quota_non_positive () = invalid_arg "quota must be positive"
 
 type ready =
   | Spawn of Fiber.t * (Fiber.t -> unit)
-  | Continue of Fiber.t * (unit, unit) Effect.Deep.continuation
+  | Continue of Fiber.t * (unit, unit) Effect.Shallow.continuation
   | Resume of
       Fiber.t
-      * ((exn * Printexc.raw_backtrace) option, unit) Effect.Deep.continuation
-  | Return of Fiber.Maybe.t * (unit, unit) Effect.Deep.continuation
+      * ( (exn * Printexc.raw_backtrace) option,
+          unit )
+        Effect.Shallow.continuation
+  | Return of Fiber.Maybe.t * (unit, unit) Effect.Shallow.continuation
 
 module Mpscq = Picos_aux_mpscq
 
@@ -20,13 +22,13 @@ type t = {
   resume :
     Trigger.t ->
     Fiber.t ->
-    ((exn * Printexc.raw_backtrace) option, unit) Effect.Deep.continuation ->
+    ((exn * Printexc.raw_backtrace) option, unit) Effect.Shallow.continuation ->
     unit;
-  current : ((Fiber.t, unit) Effect.Deep.continuation -> unit) option;
-  yield : ((unit, unit) Effect.Deep.continuation -> unit) option;
-  return : ((unit, unit) Effect.Deep.continuation -> unit) option;
-  discontinue : ((unit, unit) Effect.Deep.continuation -> unit) option;
-  handler : (unit, unit) Effect.Deep.handler;
+  current : ((Fiber.t, unit) Effect.Shallow.continuation -> unit) option;
+  yield : ((unit, unit) Effect.Shallow.continuation -> unit) option;
+  return : ((unit, unit) Effect.Shallow.continuation -> unit) option;
+  discontinue : ((unit, unit) Effect.Shallow.continuation -> unit) option;
+  handler : (unit, unit) Effect.Shallow.handler;
   quota : int;
   mutable fiber : Fiber.Maybe.t;
   mutable remaining_quota : int;
@@ -38,19 +40,20 @@ let rec next t =
   | Spawn (fiber, main) ->
       t.fiber <- Fiber.Maybe.of_fiber fiber;
       t.remaining_quota <- t.quota;
-      Effect.Deep.match_with main fiber t.handler
+      let k = Effect.Shallow.fiber main in
+      Effect.Shallow.continue_with k fiber t.handler
   | Return (fiber, k) ->
       t.fiber <- fiber;
       t.remaining_quota <- t.quota;
-      Effect.Deep.continue k ()
+      Effect.Shallow.continue_with k () t.handler
   | Continue (fiber, k) ->
       t.fiber <- Fiber.Maybe.of_fiber fiber;
       t.remaining_quota <- t.quota;
-      Fiber.continue fiber k ()
+      Fiber.continue_with fiber k () t.handler
   | Resume (fiber, k) ->
       t.fiber <- Fiber.Maybe.of_fiber fiber;
       t.remaining_quota <- t.quota;
-      Fiber.resume fiber k
+      Fiber.resume_with fiber k t.handler
   | exception Mpscq.Empty ->
       t.fiber <- Fiber.Maybe.nothing;
       if t.num_alive_fibers <> 0 then begin
@@ -102,7 +105,7 @@ let run_fiber ?quota ?fatal_exn_handler:(exnc : _ = raise) fiber main =
     Some
       (fun k ->
         let fiber = Fiber.Maybe.to_fiber t.fiber in
-        Effect.Deep.continue k fiber)
+        Effect.Shallow.continue_with k fiber t.handler)
   and yield =
     Some
       (fun k ->
@@ -115,7 +118,7 @@ let run_fiber ?quota ?fatal_exn_handler:(exnc : _ = raise) fiber main =
         let remaining_quota = t.remaining_quota - 1 in
         if 0 < remaining_quota then begin
           t.remaining_quota <- remaining_quota;
-          Effect.Deep.continue k ()
+          Effect.Shallow.continue_with k () t.handler
         end
         else begin
           Mpscq.push t.ready (Return (t.fiber, k));
@@ -125,10 +128,10 @@ let run_fiber ?quota ?fatal_exn_handler:(exnc : _ = raise) fiber main =
     Some
       (fun k ->
         let fiber = Fiber.Maybe.to_fiber t.fiber in
-        Fiber.continue fiber k ())
+        Fiber.continue_with fiber k () t.handler)
   and handler = { retc; exnc; effc }
   and[@alert "-handler"] effc :
-      type a. a Effect.t -> ((a, _) Effect.Deep.continuation -> _) option =
+      type a. a Effect.t -> ((a, _) Effect.Shallow.continuation -> _) option =
     function
     | Fiber.Current -> t.current
     | Fiber.Spawn r ->
@@ -150,7 +153,9 @@ let run_fiber ?quota ?fatal_exn_handler:(exnc : _ = raise) fiber main =
           | () -> t.return
           | exception exn ->
               let bt = Printexc.get_raw_backtrace () in
-              Some (fun k -> Effect.Deep.discontinue_with_backtrace k exn bt)
+              Some
+                (fun k ->
+                  Effect.Shallow.discontinue_with_backtrace k exn bt t.handler)
       end
     | Trigger.Await trigger ->
         Some
@@ -161,7 +166,7 @@ let run_fiber ?quota ?fatal_exn_handler:(exnc : _ = raise) fiber main =
               let remaining_quota = t.remaining_quota - 1 in
               if 0 < remaining_quota then begin
                 t.remaining_quota <- remaining_quota;
-                Fiber.resume fiber k
+                Fiber.resume_with fiber k t.handler
               end
               else begin
                 Mpscq.push t.ready (Resume (fiber, k));