feat: add Exn_bt to core

src/core/exn_bt.ml

@@ -0,0 +1,18 @@
+type t = exn * Printexc.raw_backtrace
+
+let[@inline] make exn bt : t = exn, bt
+let[@inline] exn (e, _) = e
+let[@inline] bt (_, bt) = bt
+
+let[@inline] get exn =
+  let bt = Printexc.get_raw_backtrace () in
+  make exn bt
+
+let[@inline] get_callstack n exn =
+  let bt = Printexc.get_callstack n in
+  make exn bt
+
+let show self = Printexc.to_string (fst self)
+let[@inline] raise self = Printexc.raise_with_backtrace (exn self) (bt self)
+
+type nonrec 'a result = ('a, t) result

src/core/exn_bt.mli

@@ -0,0 +1,25 @@
+(** Exception with backtrace.
+
+    @since NEXT_RELEASE *)
+
+type t = exn * Printexc.raw_backtrace
+(** An exception bundled with a backtrace *)
+
+val exn : t -> exn
+val bt : t -> Printexc.raw_backtrace
+
+val make : exn -> Printexc.raw_backtrace -> t
+(** Trivial builder *)
+
+val get : exn -> t
+(** [get exn] is [make exn (get_raw_backtrace ())] *)
+
+val get_callstack : int -> exn -> t
+
+val raise : t -> 'a
+(** Raise the exception with its save backtrace *)
+
+val show : t -> string
+(** Simple printing *)
+
+type nonrec 'a result = ('a, t) result

src/core/fut.ml

@@ -1,6 +1,6 @@
 module A = Atomic_
 
-type 'a or_error = ('a, exn * Printexc.raw_backtrace) result
+type 'a or_error = ('a, Exn_bt.t) result
 type 'a waiter = 'a or_error -> unit
 
 type 'a state =
@@ -25,6 +25,7 @@ let make ?(name = "") () =
 let[@inline] of_result x : _ t = { st = A.make (Done x) }
 let[@inline] return x : _ t = of_result (Ok x)
 let[@inline] fail e bt : _ t = of_result (Error (e, bt))
+let[@inline] fail_exn_bt ebt = of_result (Error ebt)
 
 let[@inline] is_resolved self : bool =
   match A.get self.st with

src/core/fut.mli

@@ -17,7 +17,7 @@
     the runner [pool] (once [fut] resolves successfully with a value).
 *)
 
-type 'a or_error = ('a, exn * Printexc.raw_backtrace) result
+type 'a or_error = ('a, Exn_bt.t) result
 
 type 'a t
 (** A future with a result of type ['a]. *)
@@ -51,6 +51,10 @@ val return : 'a -> 'a t
 val fail : exn -> Printexc.raw_backtrace -> _ t
 (** Already settled future, with a failure *)
 
+val fail_exn_bt : Exn_bt.t -> _ t
+(** Fail from a bundle of exception and backtrace
+    @since NEXT_RELEASE *)
+
 val of_result : 'a or_error -> 'a t
 
 val is_resolved : _ t -> bool

src/core/moonpool.ml

@@ -17,6 +17,7 @@ module Atomic = Atomic_
 module Blocking_queue = Bb_queue
 module Bounded_queue = Bounded_queue
 module Chan = Chan
+module Exn_bt = Exn_bt
 module Fifo_pool = Fifo_pool
 module Fut = Fut
 module Lock = Lock

src/core/moonpool.mli

@@ -13,6 +13,7 @@ module Ws_pool = Ws_pool
 module Fifo_pool = Fifo_pool
 module Runner = Runner
 module Immediate_runner = Immediate_runner
+module Exn_bt = Exn_bt
 
 val start_thread_on_some_domain : ('a -> unit) -> 'a -> Thread.t
 (** Similar to {!Thread.create}, but it picks a background domain at random