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
master
Mehdi Bouaziz 7 years ago committed by Facebook Github Bot
parent 7b891e45eb
commit 6c39c2ccd3

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

@ -428,11 +428,12 @@ let block_pvar = Pvar.mk (Mangled.from_string "block") (Typ.Procname.from_string
(** Dump an instruction. *) (** Dump an instruction. *)
let d_instr (i: instr) = L.add_print_action (L.PTinstr, Obj.repr i) 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 | first :: others
-> F.fprintf f "%a;@\n%a" (pp_instr pe) i (pp_instr_list pe) is -> 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. *) (** Dump a list of instructions. *)
let d_instr_list (il: instr list) = L.add_print_action (L.PTinstr_list, Obj.repr il) 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 *) (** dump an atom *)
let d_atom (a: atom) = L.add_print_action (L.PTatom, Obj.repr a) 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. *) (** Print a *-separated sequence. *)
let rec pp_star_seq pp f = function let rec pp_star_seq pp f = function

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

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

Loading…
Cancel
Save