Summary: This allows us to move the CFG rendering to IR/. The parts of that file concerning CFGs and those concerning Biabduction specs were entirely disjoint, it turns out, so that was easy. Reviewed By: jberdine Differential Revision: D18573924 fbshipit-source-id: 0a5ab6478master
Jules Villard
5 years ago
committed by
Facebook Github Bot
parent
8b959be727
commit
8289c7e7c7
@ -0,0 +1,137 @@
|
||||
(*
|
||||
* Copyright (c) 2009-2013, Monoidics ltd.
|
||||
* Copyright (c) Facebook, Inc. and its affiliates.
|
||||
*
|
||||
* This source code is licensed under the MIT license found in the
|
||||
* LICENSE file in the root directory of this source tree.
|
||||
*)
|
||||
|
||||
open! IStd
|
||||
module F = Format
|
||||
|
||||
let pp_cfgnodename pname fmt (n : Procdesc.Node.t) =
|
||||
F.fprintf fmt "\"%s_%d\""
|
||||
(Escape.escape_dotty (Typ.Procname.to_filename pname))
|
||||
(Procdesc.Node.get_id n :> int)
|
||||
|
||||
|
||||
let pp_etlist fmt etl =
|
||||
List.iter etl ~f:(fun (id, typ) ->
|
||||
Format.fprintf fmt " %a:%a" Mangled.pp id (Typ.pp_full Pp.text) typ )
|
||||
|
||||
|
||||
let pp_var_list fmt etl =
|
||||
List.iter etl ~f:(fun (id, ty) ->
|
||||
Format.fprintf fmt " %a:%a" Mangled.pp id (Typ.pp_full Pp.text) ty )
|
||||
|
||||
|
||||
let pp_local_list fmt etl = List.iter ~f:(Procdesc.pp_local fmt) etl
|
||||
|
||||
let pp_cfgnodelabel pdesc fmt (n : Procdesc.Node.t) =
|
||||
let pp_label fmt n =
|
||||
match Procdesc.Node.get_kind n with
|
||||
| Start_node ->
|
||||
let pname = Procdesc.Node.get_proc_name n in
|
||||
let pname_string = Escape.escape_dotty (Typ.Procname.to_string pname) in
|
||||
let attributes = Procdesc.get_attributes pdesc in
|
||||
Format.fprintf fmt "Start %s\\nFormals: %a\\nLocals: %a" pname_string pp_etlist
|
||||
(Procdesc.get_formals pdesc) pp_local_list (Procdesc.get_locals pdesc) ;
|
||||
if not (List.is_empty (Procdesc.get_captured pdesc)) then
|
||||
Format.fprintf fmt "\\nCaptured: %a" pp_var_list (Procdesc.get_captured pdesc) ;
|
||||
let method_annotation = attributes.ProcAttributes.method_annotation in
|
||||
if not (Annot.Method.is_empty method_annotation) then
|
||||
Format.fprintf fmt "\\nAnnotation: %a" (Annot.Method.pp pname_string) method_annotation
|
||||
| Exit_node ->
|
||||
let pname = Procdesc.Node.get_proc_name n in
|
||||
Format.fprintf fmt "Exit %s" (Escape.escape_dotty (Typ.Procname.to_string pname))
|
||||
| Join_node ->
|
||||
Format.pp_print_char fmt '+'
|
||||
| Prune_node (is_true_branch, if_kind, _) ->
|
||||
Format.fprintf fmt "Prune (%b branch, %s)" is_true_branch (Sil.if_kind_to_string if_kind)
|
||||
| Stmt_node s ->
|
||||
Format.fprintf fmt " %a" Procdesc.Node.pp_stmt s
|
||||
| Skip_node s ->
|
||||
Format.fprintf fmt "Skip %s" s
|
||||
in
|
||||
let instr_string i =
|
||||
let pp f = Sil.pp_instr ~print_types:false Pp.text f i in
|
||||
let str = F.asprintf "%t" pp in
|
||||
Escape.escape_dotty str
|
||||
in
|
||||
let pp_instrs fmt instrs =
|
||||
Instrs.iter ~f:(fun i -> F.fprintf fmt " %s\\n " (instr_string i)) instrs
|
||||
in
|
||||
let instrs = Procdesc.Node.get_instrs n in
|
||||
F.fprintf fmt "%d: %a \\n %a" (Procdesc.Node.get_id n :> int) pp_label n pp_instrs instrs
|
||||
|
||||
|
||||
let pp_cfgnodeshape fmt (n : Procdesc.Node.t) =
|
||||
match Procdesc.Node.get_kind n with
|
||||
| Start_node | Exit_node ->
|
||||
F.pp_print_string fmt "color=yellow style=filled"
|
||||
| Prune_node _ ->
|
||||
F.fprintf fmt "shape=\"invhouse\""
|
||||
| Skip_node _ ->
|
||||
F.fprintf fmt "color=\"gray\""
|
||||
| Stmt_node _ ->
|
||||
F.fprintf fmt "shape=\"box\""
|
||||
| _ ->
|
||||
()
|
||||
|
||||
|
||||
let pp_cfgnode pdesc fmt (n : Procdesc.Node.t) =
|
||||
let pname = Procdesc.get_proc_name pdesc in
|
||||
F.fprintf fmt "%a [label=\"%a\" %a]@\n\t@\n" (pp_cfgnodename pname) n (pp_cfgnodelabel pdesc) n
|
||||
pp_cfgnodeshape n ;
|
||||
let print_edge n1 n2 is_exn =
|
||||
let color = if is_exn then "[color=\"red\" ]" else "" in
|
||||
match Procdesc.Node.get_kind n2 with
|
||||
| Exit_node when is_exn ->
|
||||
(* don't print exception edges to the exit node *)
|
||||
()
|
||||
| _ ->
|
||||
F.fprintf fmt "@\n\t %a -> %a %s;" (pp_cfgnodename pname) n1 (pp_cfgnodename pname) n2 color
|
||||
in
|
||||
List.iter ~f:(fun n' -> print_edge n n' false) (Procdesc.Node.get_succs n) ;
|
||||
List.iter ~f:(fun n' -> print_edge n n' true) (Procdesc.Node.get_exn n)
|
||||
|
||||
|
||||
(** Print the flowgraphs in [cfg]. Nodes are printed only if (a) their location is [source] or
|
||||
(b) [Config.dotty_cfg_libs] is set. This triggers preanalysis. *)
|
||||
let print_icfg source fmt cfg =
|
||||
let print_node pdesc node =
|
||||
let loc = Procdesc.Node.get_loc node in
|
||||
if Config.dotty_cfg_libs || SourceFile.equal loc.Location.file source then
|
||||
F.fprintf fmt "%a@\n" (pp_cfgnode pdesc) node
|
||||
in
|
||||
let print_pdesc pdesc =
|
||||
Procdesc.get_nodes pdesc
|
||||
|> List.sort ~compare:Procdesc.Node.compare
|
||||
|> List.iter ~f:(fun node -> print_node pdesc node)
|
||||
in
|
||||
Cfg.iter_sorted cfg ~f:(fun pdesc -> print_pdesc pdesc)
|
||||
|
||||
|
||||
let write_icfg_dotty_to_file source cfg fname =
|
||||
let chan = Out_channel.create fname in
|
||||
let fmt = Format.formatter_of_out_channel chan in
|
||||
(* avoid phabricator thinking this file was generated by substituting substring with %s *)
|
||||
F.fprintf fmt "@[/* %@%s */@\ndigraph cfg {@\n" "generated" ;
|
||||
print_icfg source fmt cfg ;
|
||||
F.fprintf fmt "}@]@." ;
|
||||
Out_channel.close chan
|
||||
|
||||
|
||||
let emit source cfg =
|
||||
let fname =
|
||||
match Config.icfg_dotty_outfile with
|
||||
| Some file ->
|
||||
file
|
||||
| None when Config.frontend_tests ->
|
||||
SourceFile.to_abs_path source ^ ".test.dot"
|
||||
| None ->
|
||||
DB.filename_to_string
|
||||
(DB.Results_dir.path_to_filename (DB.Results_dir.Abs_source_dir source)
|
||||
[Config.dotty_output])
|
||||
in
|
||||
write_icfg_dotty_to_file source cfg fname
|
||||
@ -0,0 +1,12 @@
|
||||
(*
|
||||
* Copyright (c) 2009-2013, Monoidics ltd.
|
||||
* Copyright (c) Facebook, Inc. and its affiliates.
|
||||
*
|
||||
* This source code is licensed under the MIT license found in the
|
||||
* LICENSE file in the root directory of this source tree.
|
||||
*)
|
||||
|
||||
open! IStd
|
||||
|
||||
val emit : SourceFile.t -> Cfg.t -> unit
|
||||
(** emit the given {!Cfg.t} in the "dot" format to a file determined by {!Config} values *)
|
||||
@ -1,21 +0,0 @@
|
||||
(*
|
||||
* Copyright (c) 2009-2013, Monoidics ltd.
|
||||
* Copyright (c) Facebook, Inc. and its affiliates.
|
||||
*
|
||||
* This source code is licensed under the MIT license found in the
|
||||
* LICENSE file in the root directory of this source tree.
|
||||
*)
|
||||
|
||||
open! IStd
|
||||
|
||||
(** Pretty printing functions in dot format. *)
|
||||
|
||||
(** {2 Contol-Flow Graph} *)
|
||||
|
||||
val print_icfg_dotty : SourceFile.t -> Cfg.t -> unit
|
||||
(** Print the cfg *)
|
||||
|
||||
(** {2 Specs} *)
|
||||
|
||||
val pp_speclist_dotty_file : DB.filename -> Prop.normal BiabductionSummary.spec list -> unit
|
||||
(** Dotty printing for specs *)
|
||||
@ -0,0 +1,12 @@
|
||||
(*
|
||||
* Copyright (c) 2009-2013, Monoidics ltd.
|
||||
* Copyright (c) Facebook, Inc. and its affiliates.
|
||||
*
|
||||
* This source code is licensed under the MIT license found in the
|
||||
* LICENSE file in the root directory of this source tree.
|
||||
*)
|
||||
|
||||
open! IStd
|
||||
|
||||
val emit_specs_to_file : DB.filename -> Prop.normal BiabductionSummary.spec list -> unit
|
||||
(** emit specs in the "dot" format to the specified file *)
|
||||
Loading…
Reference in new issue