From 616be32b5b68817ed70a04670305821795ba3190 Mon Sep 17 00:00:00 2001 From: Josh Berdine Date: Mon, 25 Feb 2019 07:07:15 -0800 Subject: [PATCH] [sledge] Merge Config.trace_all into Config.trace Reviewed By: mbouaziz Differential Revision: D14075519 fbshipit-source-id: 740e0f02a --- sledge/src/config.ml | 40 ++++++++--------- sledge/src/trace/trace.ml | 95 ++++++++++++++++++++------------------- 2 files changed, 68 insertions(+), 67 deletions(-) diff --git a/sledge/src/config.ml b/sledge/src/config.ml index d7839431f..50e799ed9 100644 --- a/sledge/src/config.ml +++ b/sledge/src/config.ml @@ -8,23 +8,21 @@ (** Configuration options *) let trace_conv = - let parse s = - match Trace.parse s with - | Ok c -> Ok c.trace_mods_funs - | Error err -> Error err - in - let print fs c = + let print fs {trace_all; trace_mods_funs} = let pf fmt = Format.fprintf fs fmt in - Map.iteri c ~f:(fun ~key:mod_name ~data:{trace_mod; trace_funs} -> - ( match trace_mod with - | Some true -> pf "+%s" mod_name - | Some false -> pf "-%s" mod_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 ) ) + if trace_all then pf "*" + else + Map.iteri trace_mods_funs + ~f:(fun ~key:mod_name ~data:{trace_mod; trace_funs} -> + ( match trace_mod with + | Some true -> pf "+%s" mod_name + | Some false -> pf "-%s" mod_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. *) - ; trace_all: bool [@aka ["v"]] (** Enable all debug tracing. *) } + function. The $(i,spec) value $(b,* )enables 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} -> - Trace.init ~config:{trace_all; trace_mods_funs= trace} () ; + | `Ok {compile_only; input; output; trace} -> + Trace.init ~config:trace () ; main ~input ~output ~compile_only diff --git a/sledge/src/trace/trace.ml b/sledge/src/trace/trace.ml index 7bd54016f..f0857f72d 100644 --- a/sledge/src/trace/trace.ml +++ b/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 - let index_from s i = - Option.merge ~f:min - (String.index_from s i '+') - (String.index_from s i '-') - in - let rec split s rev_parts i = - match index_from s (i + 1) with - | Some j when j = i -> split s rev_parts j - | Some j -> split s (String.sub s ~pos:i ~len:(j - i) :: rev_parts) j - | _ -> List.rev (String.subo s ~pos:i :: rev_parts) - in - let parts = split s [] 0 in - let trace_mods_funs = - List.fold parts ~init:default ~f:(fun m part -> - let parse_part part = - let sign, rest = - match part.[0] with - | '-' -> (false, String.subo part ~pos:1) - | '+' -> (true, String.subo part ~pos:1) - | _ -> (true, part) - in - assert (not (String.is_empty rest)) ; - assert (Char.is_uppercase rest.[0]) ; - 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} + if String.equal s "*" then Ok all + else + let default = Map.empty (module String) in + let index_from s i = + Option.merge ~f:min + (String.index_from s i '+') + (String.index_from s i '-') + in + let rec split s rev_parts i = + match index_from s (i + 1) with + | Some j when j = i -> split s rev_parts j + | Some j -> + split s (String.sub s ~pos:i ~len:(j - i) :: rev_parts) j + | _ -> List.rev (String.subo s ~pos:i :: rev_parts) + in + let parts = split s [] 0 in + let trace_mods_funs = + List.fold parts ~init:default ~f:(fun m part -> + let parse_part part = + let sign, rest = + match part.[0] with + | '-' -> (false, String.subo part ~pos:1) + | '+' -> (true, String.subo part ~pos:1) + | _ -> (true, part) 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} + assert (not (String.is_empty rest)) ; + assert (Char.is_uppercase rest.[0]) ; + 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 + ~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 () =