diff --git a/src/Debugger.ml b/src/Debugger.ml index 2272b0d..c43bdf4 100644 --- a/src/Debugger.ml +++ b/src/Debugger.ml @@ -1,10 +1,9 @@ include DebuggerSigs module Make () = struct - type 'a Effect.t += - | Debug : Loctext.t -> unit Effect.t - | CallBegin : Loctext.t -> unit Effect.t - | CallEnd : Loctext.t -> unit Effect.t + 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 @@ -21,4 +20,6 @@ module Make () = struct 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/DebuggerSigs.ml b/src/DebuggerSigs.ml index 5bf4578..8848193 100644 --- a/src/DebuggerSigs.ml +++ b/src/DebuggerSigs.ml @@ -1,5 +1,13 @@ +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 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