wip: sidekick_trace

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))

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
 

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 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)

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 *)

src/trace/write_entry.ml

@@ -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 }

src/trace/write_entry.mli

@@ -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.
-*)

src/trace/write_value.ml

@@ -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

src/trace/write_value.mli

@@ -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