diff --git a/src/Debugger.ml b/src/Debugger.ml new file mode 100644 index 0000000..c43bdf4 --- /dev/null +++ b/src/Debugger.ml @@ -0,0 +1,25 @@ +include DebuggerSigs + +module Make () = struct + type 'a Effect.t += Act : action -> unit Effect.t + + let act ?loc s = emit_loctext @@ Loctext.make ?loc s + + let emit_loctext t = Effect.perform @@ Debug t + let emit ?loc s = emit_loctext @@ Loctext.make ?loc s + let emitf ?loc = Loctext.kmakef ?loc emit_loctext + + let trace_open_loctext t = Effect.perform @@ CallBegin t + let trace_close_loctext t = Effect.perform @@ CallEnd t + + let trace ?loc s f = + trace_open_loctext (Loctext.make ?loc s); + Fun.protect f + ~finally:(fun () -> trace_close_loctext (Loctext.make ?loc s)) + let tracef ?loc = + Text.kmakef @@ fun t f -> + trace_open_loctext (Range.locate_opt loc t); + Fun.protect f ~finally:(fun () -> trace_close_loctext (Range.locate_opt loc t)) + + let run : act:(action -> unit) -> ('a -> +end diff --git a/src/Debugger.mli b/src/Debugger.mli new file mode 100644 index 0000000..b67cf24 --- /dev/null +++ b/src/Debugger.mli @@ -0,0 +1,3 @@ +include module type of DebuggerSigs + +module Make () : S diff --git a/src/DebuggerSigs.ml b/src/DebuggerSigs.ml new file mode 100644 index 0000000..8848193 --- /dev/null +++ b/src/DebuggerSigs.ml @@ -0,0 +1,16 @@ +module AttributeMap + +type entry = + | Event of Loctext.t * Map + | + | Trace of [`Open | `Close] * Loctext.t + +module type S = +sig + val log : entry -> unit + val emit : ?loc:Range.t -> string -> unit + val emitf : ?loc:Range.t -> ('a, Format.formatter, unit, unit) format4 -> 'a + val trace : ?loc:Range.t -> string -> (unit -> 'a) -> 'a + val tracef : ?loc:Range.t -> ('b, Format.formatter, unit, (unit -> 'a) -> 'a) format4 -> 'b + val run : emit:(Loctext.t -> unit) -> trace:([`Open | `Close] -> Loctext.t -> unit) -> (unit -> 'a) -> 'a +end diff --git a/src/Reporter.ml b/src/Reporter.ml index 81653cb..6e4fe2b 100644 --- a/src/Reporter.ml +++ b/src/Reporter.ml @@ -3,7 +3,7 @@ open Bwd.Infix include ReporterSigs -module Make (Message : Message) : S with module Message := Message = +module Make (Message : Message) (*: S with module Message := Message*) = struct (* Backtraces *) @@ -67,7 +67,7 @@ struct (* Algebraic effects *) - let run ?init_loc ?(init_backtrace=Emp) ~emit ~fatal f = + let run ?init_loc ?(init_backtrace=Emp) ?debug ~emit ~fatal f = Traces.run ~env:(init_loc, init_backtrace) @@ fun () -> Effect.Deep.match_with f () @@ handler ~emit ~fatal