[sledge] Merge Config.trace_all into Config.trace

Reviewed By: mbouaziz

Differential Revision: D14075519

fbshipit-source-id: 740e0f02a

sledge/src/config.ml

@@ -8,23 +8,21 @@
 (** Configuration options *)
 
 let trace_conv =
-  let parse s =
+  let print fs {trace_all; trace_mods_funs} =
-    match Trace.parse s with
-    | Ok c -> Ok c.trace_mods_funs
-    | Error err -> Error err
-  in
-  let print fs c =
     let pf fmt = Format.fprintf fs fmt in
-    Map.iteri c ~f:(fun ~key:mod_name ~data:{trace_mod; trace_funs} ->
+    if trace_all then pf "*"
-        ( match trace_mod with
+    else
-        | Some true -> pf "+%s" mod_name
+      Map.iteri trace_mods_funs
-        | Some false -> pf "-%s" mod_name
+        ~f:(fun ~key:mod_name ~data:{trace_mod; trace_funs} ->
-        | None -> () ) ;
+          ( match trace_mod with
-        Map.iteri trace_funs ~f:(fun ~key:fun_name ~data:fun_enabled ->
+          | Some true -> pf "+%s" mod_name
-            if fun_enabled then pf "+%s.%s" mod_name fun_name
+          | Some false -> pf "-%s" mod_name
-            else pf "-%s.%s" mod_name fun_name ) )
+          | None -> () ) ;
+          Map.iteri trace_funs ~f:(fun ~key:fun_name ~data:fun_enabled ->
+              if fun_enabled then pf "+%s.%s" mod_name fun_name
+              else pf "-%s.%s" mod_name fun_name ) )
   in
-  (parse, print)
+  (Trace.parse, print)
 
 type t =
   { compile_only: bool
@@ -38,17 +36,17 @@ type t =
          [@aka ["o"]] [@docv "output.llair"]
         (** Dump $(i,input.bc) translated to LLAIR in human-readable form to
             $(i,output.llair), or $(b,-) for $(b,stdout). *)
-  ; trace: Trace.trace_mods_funs
+  ; trace: Trace.config
          [@aka ["t"]]
          [@docv "spec"]
          [@conv trace_conv]
-         [@default Trace.none.trace_mods_funs]
+         [@default Trace.none]
         (** Enable debug tracing according to $(i,spec), which is a sequence
             of module and function names separated by $(b,+) or $(b,-). For
             example, $(b,Control-Control.exec_inst) enables all tracing in
             the $(b,Control) module except the $(b,Control.exec_inst)
-            function. *)
+            function. The $(i,spec) value $(b,* )enables all debug tracing. *)
-  ; trace_all: bool [@aka ["v"]]  (** Enable all debug tracing. *) }
+  }
 [@@deriving cmdliner]
 
 let run main =
@@ -57,6 +55,6 @@ let run main =
   |> function
   | `Error _ -> Caml.exit 1
   | `Help | `Version -> Caml.exit 0
-  | `Ok {compile_only; input; output; trace; trace_all} ->
+  | `Ok {compile_only; input; output; trace} ->
-      Trace.init ~config:{trace_all; trace_mods_funs= trace} () ;
+      Trace.init ~config:trace () ;
       main ~input ~output ~compile_only

sledge/src/trace/trace.ml

@@ -25,53 +25,56 @@ let config : config ref = ref none
 
 let parse s =
   try
-    let default = Map.empty (module String) in
+    if String.equal s "*" then Ok all
-    let index_from s i =
+    else
-      Option.merge ~f:min
+      let default = Map.empty (module String) in
-        (String.index_from s i '+')
+      let index_from s i =
-        (String.index_from s i '-')
+        Option.merge ~f:min
-    in
+          (String.index_from s i '+')
-    let rec split s rev_parts i =
+          (String.index_from s i '-')
-      match index_from s (i + 1) with
+      in
-      | Some j when j = i -> split s rev_parts j
+      let rec split s rev_parts i =
-      | Some j -> split s (String.sub s ~pos:i ~len:(j - i) :: rev_parts) j
+        match index_from s (i + 1) with
-      | _ -> List.rev (String.subo s ~pos:i :: rev_parts)
+        | Some j when j = i -> split s rev_parts j
-    in
+        | Some j ->
-    let parts = split s [] 0 in
+            split s (String.sub s ~pos:i ~len:(j - i) :: rev_parts) j
-    let trace_mods_funs =
+        | _ -> List.rev (String.subo s ~pos:i :: rev_parts)
-      List.fold parts ~init:default ~f:(fun m part ->
+      in
-          let parse_part part =
+      let parts = split s [] 0 in
-            let sign, rest =
+      let trace_mods_funs =
-              match part.[0] with
+        List.fold parts ~init:default ~f:(fun m part ->
-              | '-' -> (false, String.subo part ~pos:1)
+            let parse_part part =
-              | '+' -> (true, String.subo part ~pos:1)
+              let sign, rest =
-              | _ -> (true, part)
+                match part.[0] with
-            in
+                | '-' -> (false, String.subo part ~pos:1)
-            assert (not (String.is_empty rest)) ;
+                | '+' -> (true, String.subo part ~pos:1)
-            assert (Char.is_uppercase rest.[0]) ;
+                | _ -> (true, part)
-            match String.lsplit2 rest ~on:'.' with
-            | Some (mod_name, fun_name) ->
-                assert (Char.is_lowercase fun_name.[0]) ;
-                (mod_name, Some fun_name, sign)
-            | None -> (rest, None, sign)
-          in
-          match parse_part part with
-          | mod_name, Some fun_name, enabled ->
-              let {trace_mod; trace_funs} =
-                match Map.find m mod_name with
-                | Some c -> c
-                | None -> {trace_mod= None; trace_funs= default}
               in
-              Map.set m ~key:mod_name
+              assert (not (String.is_empty rest)) ;
-                ~data:
+              assert (Char.is_uppercase rest.[0]) ;
-                  { trace_mod
+              match String.lsplit2 rest ~on:'.' with
-                  ; trace_funs=
+              | Some (mod_name, fun_name) ->
-                      Map.set trace_funs ~key:fun_name ~data:enabled }
+                  assert (Char.is_lowercase fun_name.[0]) ;
-          | mod_name, None, enabled ->
+                  (mod_name, Some fun_name, sign)
-              Map.set m ~key:mod_name
+              | None -> (rest, None, sign)
-                ~data:{trace_mod= Some enabled; trace_funs= default} )
+            in
-    in
+            match parse_part part with
-    Ok {none with trace_mods_funs}
+            | mod_name, Some fun_name, enabled ->
+                let {trace_mod; trace_funs} =
+                  match Map.find m mod_name with
+                  | Some c -> c
+                  | None -> {trace_mod= None; trace_funs= default}
+                in
+                Map.set m ~key:mod_name
+                  ~data:
+                    { trace_mod
+                    ; trace_funs=
+                        Map.set trace_funs ~key:fun_name ~data:enabled }
+            | mod_name, None, enabled ->
+                Map.set m ~key:mod_name
+                  ~data:{trace_mod= Some enabled; trace_funs= default} )
+      in
+      Ok {none with trace_mods_funs}
   with Assert_failure _ -> Error (`Msg ("Invalid trace spec: " ^ s))
 
 let init ?(margin = 300) ~config:c () =