Experiment to use shallow effects in picos_mux.fifo

ocaml-multicore · Oct 16, 2024 · 0877a20 · 0877a20
1 parent 7692f14
commit 0877a20
Showing 1 changed file with 29 additions and 20 deletions.
diff --git 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.t * (unit, unit) Effect.Deep.continuation
+      * ( (exn * Printexc.raw_backtrace) option,
+          unit )
+        Effect.Shallow.continuation
+  | Return of Fiber.t * (unit, unit) Effect.Shallow.continuation
 
 module Mpscq = Picos_aux_mpscq
 
@@ -20,13 +22,15 @@ type t = {
   mutable resume :
     Trigger.t ->
     Fiber.t ->
-    ((exn * Printexc.raw_backtrace) option, unit) Effect.Deep.continuation ->
+    ((exn * Printexc.raw_backtrace) option, unit) Effect.Shallow.continuation ->
     unit;
-  mutable current : ((Fiber.t, unit) Effect.Deep.continuation -> unit) option;
-  mutable yield : ((unit, unit) Effect.Deep.continuation -> unit) option;
-  mutable return : ((unit, unit) Effect.Deep.continuation -> unit) option;
-  mutable discontinue : ((unit, unit) Effect.Deep.continuation -> unit) option;
-  mutable handler : (unit, unit) Effect.Deep.handler;
+  mutable current :
+    ((Fiber.t, unit) Effect.Shallow.continuation -> unit) option;
+  mutable yield : ((unit, unit) Effect.Shallow.continuation -> unit) option;
+  mutable return : ((unit, unit) Effect.Shallow.continuation -> unit) option;
+  mutable discontinue :
+    ((unit, unit) Effect.Shallow.continuation -> unit) option;
+  mutable handler : (unit, unit) Effect.Shallow.handler;
   quota : int;
   mutable fiber : Fiber.Maybe.t;
   mutable remaining_quota : int;
@@ -45,10 +49,12 @@ let rec next t =
         | Return (fiber, _) ->
             Fiber.Maybe.of_fiber fiber);
       match ready with
-      | Spawn (fiber, main) -> Effect.Deep.match_with main fiber t.handler
-      | Return (_, k) -> Effect.Deep.continue k ()
-      | Continue (fiber, k) -> Fiber.continue fiber k ()
-      | Resume (fiber, k) -> Fiber.resume fiber k
+      | Spawn (fiber, main) ->
+          let k = Effect.Shallow.fiber main in
+          Effect.Shallow.continue_with k fiber t.handler
+      | Return (_, k) -> Effect.Shallow.continue_with k () t.handler
+      | Continue (fiber, k) -> Fiber.continue_with fiber k () t.handler
+      | Resume (fiber, k) -> Fiber.resume_with fiber k t.handler
     end
   | exception Mpscq.Empty ->
       t.fiber <- Fiber.Maybe.nothing;
@@ -97,7 +103,7 @@ let run_fiber ?quota ?fatal_exn_handler fiber main =
       exnc = (match fatal_exn_handler with None -> raise | Some exnc -> exnc);
       effc =
         (fun (type a) (e : a Effect.t) :
-             ((a, _) Effect.Deep.continuation -> _) option ->
+             ((a, _) Effect.Shallow.continuation -> _) option ->
           match e with
           | Fiber.Current -> t.current
           | Fiber.Spawn r ->
@@ -121,7 +127,9 @@ let run_fiber ?quota ?fatal_exn_handler fiber main =
                 | exception exn ->
                     let bt = Printexc.get_raw_backtrace () in
                     Some
-                      (fun k -> Effect.Deep.discontinue_with_backtrace k exn bt)
+                      (fun k ->
+                        Effect.Shallow.discontinue_with_backtrace k exn bt
+                          t.handler)
             end
           | Trigger.Await trigger ->
               Some
@@ -133,7 +141,7 @@ let run_fiber ?quota ?fatal_exn_handler 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));
@@ -165,7 +173,7 @@ let run_fiber ?quota ?fatal_exn_handler 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);
   t.yield <-
     Some
       (fun k ->
@@ -178,7 +186,7 @@ let run_fiber ?quota ?fatal_exn_handler 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 (Fiber.Maybe.to_fiber t.fiber, k));
@@ -188,8 +196,9 @@ let run_fiber ?quota ?fatal_exn_handler fiber main =
     Some
       (fun k ->
         let fiber = Fiber.Maybe.to_fiber t.fiber in
-        Fiber.continue fiber k ());
-  Effect.Deep.match_with main fiber t.handler
+        Fiber.continue_with fiber k () t.handler);
+  let k = Effect.Shallow.fiber main in
+  Effect.Shallow.continue_with k fiber t.handler
 
 let[@inline never] run ?quota ?fatal_exn_handler fiber main computation =
   run_fiber ?quota ?fatal_exn_handler fiber main;