diff --git a/src/trace/dune b/src/trace/dune index aedce4a1..37cb56f5 100644 --- a/src/trace/dune +++ b/src/trace/dune @@ -3,4 +3,5 @@ (public_name sidekick.trace) (synopsis "Trace system for sidekick.") (flags :standard -open Sidekick_util) - (libraries containers iter sidekick.util sidekick.sigs sidekick.core-logic)) + (libraries containers iter sidekick.util sidekick.bencode sidekick.sigs + sidekick.core-logic)) diff --git a/src/trace/sidekick_trace.ml b/src/trace/sidekick_trace.ml index 358bc2bd..109079c6 100644 --- a/src/trace/sidekick_trace.ml +++ b/src/trace/sidekick_trace.ml @@ -21,7 +21,7 @@ open Sidekick_sigs (** {2 Exports} *) module Entry_view = Entry_view -module Write_value = Write_value +module Entry_read = Entry_read module Sink = Sink module Entry_id = Entry_id diff --git a/src/trace/sink.ml b/src/trace/sink.ml index 8aefccdc..03117377 100644 --- a/src/trace/sink.ml +++ b/src/trace/sink.ml @@ -5,58 +5,33 @@ *) module type S = sig - val emit : Write_value.t -> Entry_id.t + val emit : tag:string -> Ser_value.t -> Entry_id.t end type t = (module S) (** Trace sink *) -let[@inline] emit (module Sink : S) (v : Write_value.t) : Entry_id.t = - Sink.emit v +let[@inline] emit (module Sink : S) ~tag (v : Ser_value.t) : Entry_id.t = + Sink.emit v ~tag -let[@inline] emit' (self : t) v : unit = ignore (emit self v : Entry_id.t) - -let bencode_buf_ (buf:Buffer.t) (v:Write_value.t) : unit = - - let[@inline] char c = Buffer.add_char buf c in - let[@inline] str s = Buffer.add_string buf s in - let[@inline] int i = Printf.bprintf buf "%d" i in - - let rec enc_v (v:Write_value.t) : unit = - let module V = Write_value in - match v with - | V.Int i -> char 'i'; int i; char 'e' - | V.Bool true -> str "i1e" - | V.Bool false -> str "i0e" - | V.Str s | Bytes s -> - int (String.length s); - char ':'; - str s - | V.List l -> - char 'l'; - List.iter (fun v -> enc_v (v ())) l; - char 'e' - | V.Dict l -> - char 'd'; - List.iter (fun (k,v) -> - enc_v (V.string k); - enc_v (v ())) l; - char 'e' - in - enc_v v +let[@inline] emit' (self : t) ~tag v : unit = + ignore (emit self ~tag v : Entry_id.t) (** A sink that emits entries using Bencode into the given channel *) -let of_out_channel_using_bencode (oc: out_channel): t = +let of_out_channel_using_bencode (oc : out_channel) : t = let id_ = ref 0 in let buf = Buffer.create 128 in (module struct - let emit (v:Write_value.t) = + let emit ~tag (v : Ser_value.t) = assert (Buffer.length buf = 0); let id = Entry_id.Internal_.make !id_ in + (* add tag+id around *) + let v' = + Ser_value.(dict_of_list [ "id", int !id_; "T", string tag; "v", v ]) + in incr id_; - bencode_buf_ buf v; + Sidekick_bencode.Encode.to_buffer buf v'; Buffer.output_buffer oc buf; Buffer.clear buf; id - end) diff --git a/src/trace/sink.mli b/src/trace/sink.mli index 6129758e..339c4f8b 100644 --- a/src/trace/sink.mli +++ b/src/trace/sink.mli @@ -5,16 +5,14 @@ *) module type S = sig - val emit : Write_value.t -> Entry_id.t + val emit : tag:string -> Ser_value.t -> Entry_id.t end type t = (module S) (** Trace sink *) -val emit : t -> Write_value.t -> Entry_id.t +val emit : t -> tag:string -> Ser_value.t -> Entry_id.t +val emit' : t -> tag:string -> Ser_value.t -> unit -val emit' : t -> Write_value.t -> unit - -(** A sink that emits entries using Bencode into the given channel *) val of_out_channel_using_bencode : out_channel -> t - +(** A sink that emits entries using Bencode into the given channel *) diff --git a/src/trace/write_entry.ml b/src/trace/write_entry.ml deleted file mode 100644 index 52bec676..00000000 --- a/src/trace/write_entry.ml +++ /dev/null @@ -1,8 +0,0 @@ -type entry_view = Entry_view.t - -module type OPS = sig - val write : entry_view -> Write_value.t -end - -type ops = (module OPS) -type t = { view: entry_view; ops: ops } diff --git a/src/trace/write_entry.mli b/src/trace/write_entry.mli deleted file mode 100644 index d9f966d8..00000000 --- a/src/trace/write_entry.mli +++ /dev/null @@ -1,27 +0,0 @@ -(** Entry to be written. - - This is used when producing a trace, to emit a new entry. -*) - -type entry_view = Entry_view.t - -(** Dynamic operations for {!t} *) -module type OPS = sig - val write : entry_view -> Write_value.t - - (* - val pp : entry_view Fmt.printer - *) - (* TODO: read *) -end - -type ops = (module OPS) - -type t = { view: entry_view; ops: ops } -(** A single entry to be written into the trace. - - A trace is consistuted of entries, numbered - from [0] to [n], in the order of their production. - The number has no semantics besides a form of - causal order. -*) diff --git a/src/trace/write_value.ml b/src/trace/write_value.ml deleted file mode 100644 index be9f9bf6..00000000 --- a/src/trace/write_value.ml +++ /dev/null @@ -1,23 +0,0 @@ -(** Value writer. - - A [Writer.t] value, describes how to write some structured - data into a {!Sink.t}. It reflects the shape of the structured - data but does not commit to a particular serialization format. -*) - -type t = - | Bool of bool - | Str of string - | Bytes of string - | Int of int - | List of delayed list - | Dict of (string * delayed) list - -and delayed = unit -> t - -let bool b : t = Bool b -let int i : t = Int i -let string x : t = Str x -let bytes x : t = Bytes x -let list x : t = List x -let dict x : t = Dict x diff --git a/src/trace/write_value.mli b/src/trace/write_value.mli deleted file mode 100644 index 95ba14b3..00000000 --- a/src/trace/write_value.mli +++ /dev/null @@ -1,23 +0,0 @@ -(** Value writer. - - A [Writer.t] value, describes how to write some structured - data into a {!Sink.t}. It reflects the shape of the structured - data but does not commit to a particular serialization format. -*) - -type t = private - | Bool of bool - | Str of string - | Bytes of string - | Int of int - | List of delayed list - | Dict of (string * delayed) list - -and delayed = unit -> t - -val bool : bool -> t -val int : int -> t -val string : string -> t -val bytes : string -> t -val list : delayed list -> t -val dict : (string * delayed) list -> t