From 6c39c2ccd3e9d92a159ee480fea933b331dcddad Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mbouaziz@fb.com>
Date: Fri, 6 Oct 2017 03:56:57 -0700
Subject: [PATCH] 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            | 42 ++++++++++++++++-------------
 infer/src/IR/Sil.ml                 | 11 ++++----
 infer/src/backend/dotty.ml          |  2 +-
 infer/src/quandary/TaintAnalysis.ml |  2 +-
 4 files changed, 31 insertions(+), 26 deletions(-)

diff --git a/infer/src/IR/Procdesc.ml b/infer/src/IR/Procdesc.ml
index 453da4ae2..2bccd5010 100644
--- a/infer/src/IR/Procdesc.ml
+++ b/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 =
-    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
-    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 ()
-    | Prune_node (_, _, descr)
-     -> if sub_instrs then print_sub_instrs () else F.fprintf fmt "assume %s %a" descr pp_loc ()
-    | Exit_node _
-     -> if sub_instrs then print_sub_instrs () else F.fprintf fmt "exit %a" pp_loc ()
-    | Skip_node s
-     -> if sub_instrs then print_sub_instrs () else F.fprintf fmt "skip (%s) %a" s pp_loc ()
-    | Start_node _
-     -> if sub_instrs then print_sub_instrs () else F.fprintf fmt "start %a" pp_loc ()
-    | Join_node
-     -> if sub_instrs then print_sub_instrs () else F.fprintf fmt "join %a" pp_loc ()
+    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
+      Sil.pp_instr_list pe fmt instrs
+    else
+      let () =
+        match get_kind node with
+        | Stmt_node s
+         -> F.fprintf fmt "statements (%s)" s
+        | Prune_node (_, _, descr)
+         -> F.fprintf fmt "assume %s" descr
+        | Exit_node _
+         -> F.fprintf fmt "exit"
+        | Skip_node s
+         -> F.fprintf fmt "skip (%s)" s
+        | Start_node _
+         -> F.fprintf fmt "start"
+        | Join_node
+         -> 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) =
diff --git a/infer/src/IR/Sil.ml b/infer/src/IR/Sil.ml
index dc51b1c25..2e0c88ae4 100644
--- a/infer/src/IR/Sil.ml
+++ b/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
diff --git a/infer/src/backend/dotty.ml b/infer/src/backend/dotty.ml
index 945724abd..9e9c662e1 100644
--- a/infer/src/backend/dotty.ml
+++ b/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
diff --git a/infer/src/quandary/TaintAnalysis.ml b/infer/src/quandary/TaintAnalysis.ml
index a74829492..27323bf91 100644
--- a/infer/src/quandary/TaintAnalysis.ml
+++ b/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