Fix pp_instr_list nontailrecursiveness

Summary:
`pp_instr_list` was not tailrec causing a stack overflow on big code.
Also simplified a few things

Reviewed By: jvillard

Differential Revision: D5995451

fbshipit-source-id: 40a4911

infer/src/IR/Procdesc.ml

@@ -192,25 +192,29 @@ module Node = struct
   (** Print extended instructions for the node,
       highlighting the given subinstruction if present *)
   let pp_instrs pe0 ~sub_instrs instro fmt node =
+    if sub_instrs then
       let pe =
         match instro with None -> pe0 | Some instr -> Pp.extend_colormap pe0 (Obj.repr instr) Red
       in
       let instrs = get_instrs node in
-    let pp_loc fmt () = F.fprintf fmt " %a " Location.pp (get_loc node) in
-    let print_sub_instrs () = F.fprintf fmt "%a" (Sil.pp_instr_list pe) instrs in
+      Sil.pp_instr_list pe fmt instrs
+    else
+      let () =
         match get_kind node with
         | Stmt_node s
-     -> if sub_instrs then print_sub_instrs () else F.fprintf fmt "statements (%s) %a" s pp_loc ()
+         -> F.fprintf fmt "statements (%s)" s
         | Prune_node (_, _, descr)
-     -> if sub_instrs then print_sub_instrs () else F.fprintf fmt "assume %s %a" descr pp_loc ()
+         -> F.fprintf fmt "assume %s" descr
         | Exit_node _
-     -> if sub_instrs then print_sub_instrs () else F.fprintf fmt "exit %a" pp_loc ()
+         -> F.fprintf fmt "exit"
         | Skip_node s
-     -> if sub_instrs then print_sub_instrs () else F.fprintf fmt "skip (%s) %a" s pp_loc ()
+         -> F.fprintf fmt "skip (%s)" s
         | Start_node _
-     -> if sub_instrs then print_sub_instrs () else F.fprintf fmt "start %a" pp_loc ()
+         -> F.fprintf fmt "start"
         | Join_node
-     -> if sub_instrs then print_sub_instrs () else F.fprintf fmt "join %a" pp_loc ()
+         -> F.fprintf fmt "join"
+      in
+      F.fprintf fmt "  %a " Location.pp (get_loc node)
 
   (** Dump extended instructions for the node *)
   let d_instrs ~(sub_instrs: bool) (curr_instr: Sil.instr option) (node: t) =

infer/src/IR/Sil.ml

@@ -428,11 +428,12 @@ let block_pvar = Pvar.mk (Mangled.from_string "block") (Typ.Procname.from_string
 (** Dump an instruction. *)
 let d_instr (i: instr) = L.add_print_action (L.PTinstr, Obj.repr i)
 
-let rec pp_instr_list pe f = function
+let pp_instr_list pe fmt = function
   | []
-   -> F.fprintf f ""
-  | i :: is
-   -> F.fprintf f "%a;@\n%a" (pp_instr pe) i (pp_instr_list pe) is
+   -> ()
+  | first :: others
+   -> pp_instr pe fmt first ;
+      List.iter others ~f:(fun instr -> F.fprintf fmt ";@\n%a" (pp_instr pe) instr)
 
 (** Dump a list of instructions. *)
 let d_instr_list (il: instr list) = L.add_print_action (L.PTinstr_list, Obj.repr il)
@@ -467,7 +468,7 @@ let pp_atom pe0 f a =
 (** dump an atom *)
 let d_atom (a: atom) = L.add_print_action (L.PTatom, Obj.repr a)
 
-let pp_lseg_kind f = function Lseg_NE -> F.fprintf f "ne" | Lseg_PE -> F.fprintf f ""
+let pp_lseg_kind f = function Lseg_NE -> F.fprintf f "ne" | Lseg_PE -> ()
 
 (** Print a *-separated sequence. *)
 let rec pp_star_seq pp f = function

infer/src/backend/dotty.ml

@@ -1154,7 +1154,7 @@ let pp_cfgnodeshape fmt (n: Procdesc.Node.t) =
   | Procdesc.Node.Stmt_node _
    -> F.fprintf fmt "shape=\"box\""
   | _
-   -> F.fprintf fmt ""
+   -> ()
 
 let pp_cfgnode pdesc fmt (n: Procdesc.Node.t) =
   let pname = Procdesc.get_proc_name pdesc in

infer/src/quandary/TaintAnalysis.ml

@@ -208,7 +208,7 @@ module Make (TaintSpecification : TaintSpec.S) = struct
         let source_trace =
           let pp_access_path_opt fmt = function
             | None
-             -> F.fprintf fmt ""
+             -> ()
             | Some access_path
              -> let base, _ = AccessPath.Abs.extract access_path in
                 F.fprintf fmt " with tainted data %a" AccessPath.Abs.pp