feat: custom printers for unhandled effects

src/Reader.ml

@@ -30,4 +30,8 @@ struct
             | _ -> None }
 
   let scope f c = run ~env:(f @@ read ()) c
+
+  let register_printer ?read () = Printexc.register_printer @@ function
+    | Effect.Unhandled Read -> read
+    | _ -> None
 end

src/Reader.mli

@@ -41,6 +41,8 @@ sig
 
   val run : env:env -> (unit -> 'a) -> 'a
   (** [run t] runs the thunk [t] which may perform reading effects. *)
+
+  val register_printer : ?read:string -> unit -> unit
 end
 
 module Make (P : Param) : S with type env = P.env

src/Sequencer.ml

@@ -27,4 +27,8 @@ struct
             | Yield x -> Option.some @@ fun (k : (a, _) continuation) ->
               Seq.Cons (x, continue k)
             | _ -> None }
+
+  let register_printer ?yield () = Printexc.register_printer @@ function
+    | Effect.Unhandled (Yield elt) -> Option.map (fun f -> f elt) yield
+    | _ -> None
 end

src/Sequencer.mli

@@ -35,6 +35,8 @@ sig
 
   val run : (unit -> unit) -> elt Seq.t
   (** [run t] runs the thunk [t] which may perform sequencing effects. *)
+
+  val register_printer : ?yield:(elt -> string) -> unit -> unit
 end
 
 module Make (P : Param) : S with type elt = P.elt

src/State.ml

@@ -37,4 +37,9 @@ struct
             | _ -> None }
 
   let modify f = set @@ f @@ get ()
+
+  let register_printer ?get ?set () = Printexc.register_printer @@ function
+  | Effect.Unhandled Get -> get
+  | Effect.Unhandled (Set state) -> Option.map (fun f -> f state) set
+  | _ -> None
 end

src/State.mli

@@ -40,6 +40,8 @@ sig
 
   val run : init:state -> (unit -> 'a) -> 'a
   (** [run t] runs the thunk [t] which may perform state effects. *)
+
+  val register_printer : ?get:string -> ?set:(state -> string) -> unit -> unit
 end
 
 module Make (P : Param) : S with type state = P.state

src/UniqueID.ml

@@ -66,4 +66,11 @@ struct
             | Export -> Option.some @@ fun (k : (a, _) continuation) ->
               continue k @@ Seq.map snd @@ M.to_seq @@ Eff.get ()
             | _ -> None }
+
+  let register_printer ?register ?retrieve ?export () = Printexc.register_printer @@ function
+    | Effect.Unhandled (Insert elt) -> Option.map (fun f -> f elt) register
+    | Effect.Unhandled (Select id) -> Option.map (fun f -> f id) retrieve
+    | Effect.Unhandled Export -> export
+    | _ -> None
+
 end

src/UniqueID.mli

@@ -54,6 +54,8 @@ sig
 
       @param init The initial storage, which should be the output of some previous {!val:export}.
   *)
+
+  val register_printer : ?register:(elt -> string) -> ?retrieve:(id -> string) -> ?export:string -> unit -> unit
 end
 
 module Make (P : Param) : S with type elt = P.elt

test/TestReader.ml

@@ -18,6 +18,7 @@ struct
   let read () = U.perform ReaderMonad.read
   let scope f m = U.perform @@ ReaderMonad.scope f @@ U.run m
   let run ~env f = U.run f env
+  let register_printer ?read:_ () = ()
 end
 
 type cmd = ReadAndPrint | Scope of (int -> int) * prog

test/TestSequencer.ml

@@ -26,6 +26,7 @@ struct
   type elt = int
   let yield x = U.perform (SequencerMonad.yield x)
   let run f = output_to_seq @@ snd @@ U.run f
+  let register_printer ?yield:_ () = ()
 end
 
 type cmd = Yield of int

test/TestState.ml

@@ -20,6 +20,7 @@ struct
   let set s = U.perform @@ StateMonad.set s
   let modify f = U.perform @@ StateMonad.modify f
   let run ~init f = fst @@ U.run f init
+  let register_printer ?get:_ ?set:_ () = ()
 end
 
 type cmd = Set of int | GetAndPrint | Mod of (int -> int)