Simplify the state machine

Signed-off-by: Etienne Millon <[email protected]>

Author: emillon

src/catapult/catapult.ml

@@ -7,17 +7,18 @@ type ops =
   ; gc_stat : unit -> Gc.stat
   }
 
-type state =
+type mode =
   | Disabled
-  | Path of string
   | Using of ops
 
 type t =
-  { mutable state : state
+  { mutable mode : mode
+  ; mutable after_first_event : bool
   }
 
 let make () =
-  { state = Disabled
+  { mode = Disabled
+  ; after_first_event = false
   }
 
 let fake_gc_stat =
@@ -44,43 +45,47 @@ let fake time_ref buf =
   let close () = () in
   let get_time () = !time_ref in
   let gc_stat () = fake_gc_stat in
-  { state =
+  { mode =
       Using
         { print
         ; close
         ; get_time
         ; gc_stat
         }
+  ; after_first_event = false
   }
 
-let close t = match t.state with
+let close t = match t.mode with
   | Disabled -> ()
-  | Path _ -> ()
   | Using {print; close; _} ->
     print "]\n";
     close ()
 
-let enable t path =
-  t.state <- Path path
-
-let make_reporter path =
+let path_ops path =
   let channel = Pervasives.open_out path in
   let print s = Pervasives.output_string channel s in
   let close () = Pervasives.close_out channel in
   let get_time () = Unix.gettimeofday () in
   let gc_stat () = Gc.stat () in
   {print; close; get_time; gc_stat}
 
+let enable t path =
+  t.mode <- Using (path_ops path)
+
+let next_leading_char t =
+  match t.after_first_event with
+  | true -> ','
+  | false ->
+    t.after_first_event <- true;
+    '['
+
 let printf t format_string =
-  match t.state with
+  match t.mode with
   | Disabled ->
     Printf.ifprintf () format_string
   | Using {print; _} ->
-    Printf.ksprintf print ("," ^^ format_string ^^ "\n")
-  | Path path ->
-    let reporter = make_reporter path in
-    t.state <- Using reporter;
-    Printf.ksprintf reporter.print ("[" ^^ format_string ^^ "\n")
+    let c = next_leading_char t in
+    Printf.ksprintf print ("%c" ^^ format_string ^^ "\n") c
 
 let color_of_name = function
   | "ocamlc" | "ocamlc.opt" -> "thread_state_uninterruptible"
@@ -144,20 +149,13 @@ let emit_counters t ~time (stat: Gc.stat) =
   emit_counter t ~time "free_words" stat.free_words;
   emit_counter t ~time "stack_size" stat.stack_size
 
-let get_time t = match t.state with
-  | Disabled
-  | Path _
-    -> 0.
-  | Using {get_time; _}
-    ->
-    get_time ()
+let get_time t = match t.mode with
+  | Disabled -> 0.
+  | Using {get_time; _} -> get_time ()
 
-let gc_stat t = match t.state with
-  | Disabled
-  | Path _
-    -> fake_gc_stat
-  | Using {gc_stat; _} ->
-    gc_stat ()
+let gc_stat t = match t.mode with
+  | Disabled -> fake_gc_stat
+  | Using {gc_stat; _} -> gc_stat ()
 
 let on_process_start t ~program ~args =
   { start_time = get_time t

src/catapult/catapult.mli

@@ -11,16 +11,14 @@ type t
 val make : unit -> t
 
 (** Return a fake reporter that reads time in a reference and writes JSON
-    objects to a buffer. Note that in this case, the output is not valid JSON
-    since there is no leading '['. *)
+    objects to a buffer. *)
 val fake : float ref -> Buffer.t -> t
 
 (** Output trailing data to make the underlying file valid JSON, and close it. *)
 val close : t -> unit
 
 (** Enable tracing: open a trace file and further events will be logged into it.
-    The file is only created when the first event is logged. It is necessary to
-    call [close] on the reporter to make the file valid. *)
+    It is necessary to call [close] on the reporter to make the file valid. *)
 val enable : t -> string -> unit
 
 type event

test/unit-tests/catapult.mlt

@@ -37,7 +37,7 @@ let buffer_lines () =
 buffer_lines ();;
 [%%expect{|
 - : string list =
-[",{\"name\": \"program\", \"pid\": 0, \"tid\": 0, \"ph\": \"X\", \"dur\": 20000000, \"ts\": 30000000, \"color\": \"generic_work\", \"args\": [\"arg1\",\"arg2\"]}";
+["[{\"name\": \"program\", \"pid\": 0, \"tid\": 0, \"ph\": \"X\", \"dur\": 20000000, \"ts\": 30000000, \"color\": \"generic_work\", \"args\": [\"arg1\",\"arg2\"]}";
  ",{\"name\": \"live_words\", \"pid\": 0, \"tid\": 0, \"ph\": \"C\", \"ts\": 30000000, \"args\": {\"value\": 0}}";
  ",{\"name\": \"free_words\", \"pid\": 0, \"tid\": 0, \"ph\": \"C\", \"ts\": 30000000, \"args\": {\"value\": 0}}";
  ",{\"name\": \"stack_size\", \"pid\": 0, \"tid\": 0, \"ph\": \"C\", \"ts\": 30000000, \"args\": {\"value\": 0}}";