From 8f765bf74213846a0139cb9a5589f0274c477454 Mon Sep 17 00:00:00 2001
From: Josh Berdine <jjb@fb.com>
Date: Mon, 1 Jul 2019 07:16:32 -0700
Subject: [PATCH] [sledge] Add -margin flag for debug tracing output

Reviewed By: kren1

Differential Revision: D16069455

fbshipit-source-id: 0be9404b6
---
 sledge/sledge-help.txt | 17 ++++++++++++-----
 sledge/src/sledge.ml   | 18 +++++++++++-------
 2 files changed, 23 insertions(+), 12 deletions(-)

diff --git a/sledge/sledge-help.txt b/sledge/sledge-help.txt
index 8534e0b5e..3d4b2473a 100644
--- a/sledge/sledge-help.txt
+++ b/sledge/sledge-help.txt
@@ -49,6 +49,7 @@ Analyze code in a buck target. This is a convenience wrapper for the sequence `s
   [-function-summaries]   use function summaries (in development)
   [-fuzzer]               add a harness for libFuzzer targets
   [-llair-output <file>]  write generated LLAIR to <file>
+  [-margin <cols>]        wrap debug tracing at <cols> columns
   [-modules <file>]       write list of bitcode files to <file>, or to standard
                           output if <file> is `-`
   [-skip-throw]           do not explore past throwing an exception
@@ -67,6 +68,7 @@ Build a buck target and report the included bitcode files.
 
 === flags ===
 
+  [-margin <cols>]   wrap debug tracing at <cols> columns
   [-modules <file>]  write list of bitcode files to <file>, or to standard
                      output if <file> is `-`
   [-trace <spec>]    enable debug tracing
@@ -86,6 +88,7 @@ Link code in a buck target to a single LLVM bitcode module. This also internaliz
 
   -bitcode-output <file>  write linked bitcode to <file>
   [-fuzzer]               add a harness for libFuzzer targets
+  [-margin <cols>]        wrap debug tracing at <cols> columns
   [-modules <file>]       write list of bitcode files to <file>, or to standard
                           output if <file> is `-`
   [-trace <spec>]         enable debug tracing
@@ -122,6 +125,7 @@ Analyze code in one or more LLVM bitcode files. This is a convenience wrapper fo
   [-function-summaries]   use function summaries (in development)
   [-fuzzer]               add a harness for libFuzzer targets
   [-llair-output <file>]  write generated LLAIR to <file>
+  [-margin <cols>]        wrap debug tracing at <cols> columns
   [-skip-throw]           do not explore past throwing an exception
   [-trace <spec>]         enable debug tracing
   [-help]                 print this help text and exit
@@ -140,6 +144,7 @@ Translate one or more LLVM bitcode files to LLAIR. Each <input> filename may be
 
   [-fuzzer]               add a harness for libFuzzer targets
   [-llair-output <file>]  write generated LLAIR to <file>
+  [-margin <cols>]        wrap debug tracing at <cols> columns
   [-trace <spec>]         enable debug tracing
   [-help]                 print this help text and exit
                           (alias: -?)
@@ -157,6 +162,7 @@ The <input> file must be binary LLAIR, such as produced by `sledge translate`.
 
   [-bound <int>]         stop execution exploration at depth <int>
   [-function-summaries]  use function summaries (in development)
+  [-margin <cols>]       wrap debug tracing at <cols> columns
   [-skip-throw]          do not explore past throwing an exception
   [-trace <spec>]        enable debug tracing
   [-help]                print this help text and exit
@@ -173,11 +179,12 @@ The <input> file must be LLAIR code, as produced by `sledge llvm translate`.
 
 === flags ===
 
-  [-llair <file>]  write generated textual LLAIR to <file>, or to standard
-                   output if omitted
-  [-trace <spec>]  enable debug tracing
-  [-help]          print this help text and exit
-                   (alias: -?)
+  [-llair <file>]   write generated textual LLAIR to <file>, or to standard
+                    output if omitted
+  [-margin <cols>]  wrap debug tracing at <cols> columns
+  [-trace <spec>]   enable debug tracing
+  [-help]           print this help text and exit
+                    (alias: -?)
 
 
 ====== sledge version ======
diff --git a/sledge/src/sledge.ml b/sledge/src/sledge.ml
index dbc03782e..029580f2d 100644
--- a/sledge/src/sledge.ml
+++ b/sledge/src/sledge.ml
@@ -23,12 +23,16 @@ let ( >*> ) : ('a -> 'b) param -> ('b -> 'c) param -> ('a -> 'c) param =
 
 (* define a command, with trace flag, and with action wrapped in reporting *)
 let command ~summary ?readme param =
-  let trace_flag =
-    let open Command.Param in
-    flag "trace" ~doc:"<spec> enable debug tracing"
-      (optional_with_default Trace.none
-         (Arg_type.create (fun s -> Trace.parse s |> Result.ok_exn)))
-    >>| fun config -> Trace.init ~config ()
+  let trace =
+    let%map_open config =
+      flag "trace" ~doc:"<spec> enable debug tracing"
+        (optional_with_default Trace.none
+           (Arg_type.create (fun s -> Trace.parse s |> Result.ok_exn)))
+    and margin =
+      flag "margin" ~doc:"<cols> wrap debug tracing at <cols> columns"
+        (optional int)
+    in
+    Trace.init ?margin ~config ()
   in
   let wrap main () =
     try
@@ -49,7 +53,7 @@ let command ~summary ?readme param =
             (Caml.Printexc.to_string exn) ) ;
       Caml.Printexc.raise_with_backtrace exn bt
   in
-  Command.basic ~summary ?readme (trace_flag *> param >>| wrap)
+  Command.basic ~summary ?readme (trace *> param >>| wrap)
 
 let marshal program file =
   Out_channel.with_file file ~f:(fun oc ->