[NodePrinter] Force usage of with_session

Summary:
- Makes sure that `start_session` and `finish_session` are well parenthesized
- Avoids a try finally when debug is disabled

Reviewed By: ngorogiannis

Differential Revision: D15371841

fbshipit-source-id: 340203edb

infer/src/absint/AbstractInterpreter.ml

@@ -337,14 +337,13 @@ module MakeUsingWTO (TransferFunctions : TransferFunctions.SIL) = struct
       F.pp_print_string fmt " WEAK TOPOLOGICAL ORDER"
     in
     let underlying_node = Node.underlying_node node in
-    NodePrinter.start_session ~pp_name underlying_node ;
+    NodePrinter.with_session ~pp_name underlying_node ~f:(fun () ->
         let pp_node fmt node = node |> Node.id |> Node.pp_id fmt in
         L.d_printfln "%a" (WeakTopologicalOrder.Partition.pp ~pp_node) wto ;
         let loop_heads =
           wto |> IContainer.to_rev_list ~fold:WeakTopologicalOrder.Partition.fold_heads |> List.rev
         in
-    L.d_printfln "Loop heads: %a" (Pp.seq pp_node) loop_heads ;
-    NodePrinter.finish_session underlying_node
+        L.d_printfln "Loop heads: %a" (Pp.seq pp_node) loop_heads )
 
 
   let exec_wto_node ~pp_instr cfg proc_data inv_map node ~is_loop_head ~is_narrowing =

infer/src/absint/NodePrinter.ml

@@ -22,14 +22,9 @@ let new_session node =
       !(summary.Summary.sessions)
 
 
-let start_session ~pp_name node =
-  if Config.write_html then
-    let session = new_session node in
-    Printer.node_start_session ~pp_name node session
-
-
-let finish_session node = if Config.write_html then Printer.node_finish_session node
-
 let with_session ~pp_name node ~f =
-  start_session ~pp_name node ;
-  Utils.try_finally_swallow_timeout ~f ~finally:(fun () -> finish_session node)
+  if Config.write_html then (
+    let session = new_session node in
+    Printer.node_start_session ~pp_name node session ;
+    Utils.try_finally_swallow_timeout ~f ~finally:(fun () -> Printer.node_finish_session node) )
+  else f ()

infer/src/absint/NodePrinter.mli

@@ -9,12 +9,8 @@ open! IStd
 
 (** Simplified html node printer for checkers *)
 
-val start_session : pp_name:(Format.formatter -> unit) -> Procdesc.Node.t -> unit
-(** To be called before analyzing a node *)
-
-val finish_session : Procdesc.Node.t -> unit
-(** To be called after analyzing a node *)
-
 val with_session : pp_name:(Format.formatter -> unit) -> Procdesc.Node.t -> f:(unit -> 'a) -> 'a
-(** Wraps [f] between [start_session] and [finish_session]. Will swallow timeouts so do *not* use
-   from within biabduction *)
+(**
+  Wraps [f] in an html debug session.
+  Will swallow timeouts so do *not* use from within biabduction.
+*)

infer/src/bufferoverrun/bufferOverrunChecker.ml

@@ -428,8 +428,7 @@ let checker : Callbacks.proc_callback_args -> Summary.t =
   in
   let underlying_exit_node = Procdesc.get_exit_node proc_desc in
   let pp_name f = F.pp_print_string f "bufferoverrun check" in
-  NodePrinter.start_session ~pp_name underlying_exit_node ;
-  let summary =
+  NodePrinter.with_session ~pp_name underlying_exit_node ~f:(fun () ->
       let cfg = CFG.from_pdesc proc_desc in
       let checks =
         let get_proc_summary callee_pname =
@@ -448,7 +447,4 @@ let checker : Callbacks.proc_callback_args -> Summary.t =
       report_errors tenv checks summary ;
       let locals = BufferOverrunAnalysis.get_local_decls proc_desc in
       let cond_set = get_checks_summary locals checks in
-    Payload.update_summary cond_set summary
-  in
-  NodePrinter.finish_session underlying_exit_node ;
-  summary
+      Payload.update_summary cond_set summary )

infer/src/checkers/cost.ml

@@ -794,13 +794,12 @@ let compute_get_node_nb_exec node_cfg bound_map : get_node_nb_exec =
       {ConstraintSolver.f}
   in
   let start_node = NodeCFG.start_node node_cfg in
-  ( if Config.write_html then
-    let pp_name fmt = F.pp_print_string fmt "cost(constraints)" in
-    NodePrinter.start_session ~pp_name start_node ) ;
+  NodePrinter.with_session start_node
+    ~pp_name:(fun fmt -> F.pp_print_string fmt "cost(constraints)")
+    ~f:(fun () ->
       let equalities = ConstraintSolver.collect_constraints ~debug node_cfg in
       let () = ConstraintSolver.compute_costs ~debug bound_map equalities in
-  if Config.write_html then NodePrinter.finish_session start_node ;
-  ConstraintSolver.get_node_nb_exec equalities
+      ConstraintSolver.get_node_nb_exec equalities )
 
 
 let compute_worst_case_cost tenv integer_type_widths get_callee_summary_and_formals instr_cfg_wto

infer/src/nullsafe/eradicate.ml

@@ -84,7 +84,7 @@ module MkCallback (Extension : ExtensionT) : CallBackT = struct
       let pp_name fmt = F.pp_print_string fmt "eradicate"
 
       let do_node tenv node typestate =
-        NodePrinter.start_session ~pp_name node ;
+        NodePrinter.with_session ~pp_name node ~f:(fun () ->
             State.set_node node ;
             let typestates_succ, typestates_exn =
               TypeCheck.typecheck_node tenv calls_this checks idenv curr_pname curr_pdesc
@@ -96,8 +96,7 @@ module MkCallback (Extension : ExtensionT) : CallBackT = struct
               d_typestate typestate ;
               L.d_strln "after:" ;
               List.iter ~f:d_typestate typestates_succ ) ;
-        NodePrinter.finish_session node ;
-        (typestates_succ, typestates_exn)
+            (typestates_succ, typestates_exn) )
 
 
       let proc_throws _ = DontKnow