From 66f95df3b47b08589da9e065bff11d8eac119a1b Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Mon, 4 Mar 2024 12:37:01 -0500
Subject: [PATCH] add `Fiber.{return,fail}`

---
 src/fib/fiber.ml  | 40 +++++++++++++++++++++++++++-------------
 src/fib/fiber.mli |  3 +++
 2 files changed, 30 insertions(+), 13 deletions(-)

diff --git a/src/fib/fiber.ml b/src/fib/fiber.ml
index dcc59557..cc666b24 100644
--- a/src/fib/fiber.ml
+++ b/src/fib/fiber.ml
@@ -44,6 +44,33 @@ end
 
 include Private_
 
+let create_ ~ls ~runner () : 'a t =
+  let id = Handle.generate_fresh () in
+  let res, _promise = Fut.make () in
+  {
+    state =
+      A.make
+      @@ Alive { children = FM.empty; on_cancel = Int_map.empty; cancel_id = 0 };
+    id;
+    res;
+    runner;
+    ls;
+  }
+
+let create_done_ ~res () : _ t =
+  let id = Handle.generate_fresh () in
+  {
+    state =
+      A.make
+      @@ Alive { children = FM.empty; on_cancel = Int_map.empty; cancel_id = 0 };
+    id;
+    res;
+    runner = Immediate_runner.runner;
+    ls = Task_local_storage.dummy;
+  }
+
+let[@inline] return x = create_done_ ~res:(Fut.return x) ()
+let[@inline] fail ebt = create_done_ ~res:(Fut.fail_exn_bt ebt) ()
 let[@inline] res self = self.res
 let[@inline] peek self = Fut.peek self.res
 let[@inline] is_done self = Fut.is_done self.res
@@ -212,19 +239,6 @@ let add_child_ ~protect (self : _ t) (child : _ t) =
     ()
   done
 
-let create_ ~ls ~runner () : 'a t =
-  let id = Handle.generate_fresh () in
-  let res, _promise = Fut.make () in
-  {
-    state =
-      A.make
-      @@ Alive { children = FM.empty; on_cancel = Int_map.empty; cancel_id = 0 };
-    id;
-    res;
-    runner;
-    ls;
-  }
-
 let spawn_ ~ls ~parent ~runner (f : unit -> 'a) : 'a t =
   (match parent with
   | Some p when is_closed p -> failwith "spawn: nursery is closed"
diff --git a/src/fib/fiber.mli b/src/fib/fiber.mli
index a8e3b6c6..f1c544d2 100644
--- a/src/fib/fiber.mli
+++ b/src/fib/fiber.mli
@@ -46,6 +46,9 @@ type 'a callback = 'a Exn_bt.result -> unit
 (** Type erased fiber *)
 type any = Private_.any = Any : _ t -> any [@@unboxed]
 
+val return : 'a -> 'a t
+val fail : Exn_bt.t -> _ t
+
 val self : unit -> any
 (** [self ()] is the current fiber.
     Must be run from inside a fiber.