Avoid duplication of Computation.await

polytypic · polytypic · commit edf401bd629a · 2024-03-13T18:58:14.000+02:00
diff --git a/lib/picos/dune b/lib/picos/dune
@@ -7,8 +7,8 @@
   (select
    picos.ml
    from
-   (picos_private_ocaml4 -> picos.ocaml4.ml)
-   (picos_private_ocaml5 -> picos.ocaml5.ml))
+   (picos_private_ocaml4 -> picos.common.ml)
+   (picos_private_ocaml5 -> picos.common.ml))
   (select
    intf.ml
    from
diff --git a/lib/picos/ocaml4/picos_private.ml b/lib/picos/ocaml4/picos_private.ml
@@ -28,21 +28,6 @@ end
 module Computation = struct
   include Picos_private_bootstrap.Computation
 
-  let rec await t =
-    match Atomic.get t with
-    | Returned value -> value
-    | Canceled exn_bt -> Exn_bt.raise exn_bt
-    | Continue _ ->
-        let trigger = Trigger.create () in
-        if try_attach t trigger then begin
-          match Trigger.await trigger with
-          | None -> await t
-          | Some exn_bt ->
-              detach t trigger;
-              Exn_bt.raise exn_bt
-        end
-        else await t
-
   let cancel_after computation ~seconds exn_bt =
     if 0.0 <= seconds then
       let _ = Fiber.current () in
diff --git a/lib/picos/ocaml5/picos_private.ml b/lib/picos/ocaml5/picos_private.ml
@@ -52,21 +52,6 @@ end
 module Computation = struct
   include Picos_private_bootstrap.Computation
 
-  let rec await t =
-    match Atomic.get t with
-    | Returned value -> value
-    | Canceled exn_bt -> Exn_bt.raise exn_bt
-    | Continue _ ->
-        let trigger = Picos_private_bootstrap.Trigger.create () in
-        if try_attach t trigger then begin
-          match Trigger.await trigger with
-          | None -> await t
-          | Some exn_bt ->
-              detach t trigger;
-              Exn_bt.raise exn_bt
-        end
-        else await t
-
   type _ Effect.t +=
     | Cancel_after : {
         seconds : float;
diff --git a/lib/picos/picos.common.ml b/lib/picos/picos.common.ml
@@ -0,0 +1,22 @@
+include Picos_private
+
+module Computation = struct
+  include Computation
+
+  let block t =
+    let trigger = Trigger.create () in
+    if try_attach t trigger then begin
+      match Trigger.await trigger with
+      | None -> t
+      | Some exn_bt ->
+          detach t trigger;
+          Exn_bt.raise exn_bt
+    end
+    else t
+
+  let rec await t =
+    match Atomic.get t with
+    | Returned value -> value
+    | Canceled exn_bt -> Exn_bt.raise exn_bt
+    | Continue _ -> await (block t)
+end
diff --git a/lib/picos/picos.ocaml4.ml b/lib/picos/picos.ocaml4.ml
diff --git a/lib/picos/picos.ocaml5.ml b/lib/picos/picos.ocaml5.ml
