From 0caa7e1826fd271dd90bb0d7f5a83b62ebe32c6c Mon Sep 17 00:00:00 2001 From: Jules Villard Date: Mon, 29 Aug 2016 18:51:37 -0700 Subject: [PATCH] move printing module to its own file Summary: This breaks a dependency to allow cFrontend_utils.ml to call into cLocation.ml. Reviewed By: sblackshear Differential Revision: D3779514 fbshipit-source-id: 6ca83d6 --- infer/src/clang/cFrontend_utils.ml | 87 +-------------------------- infer/src/clang/cFrontend_utils.mli | 28 +-------- infer/src/clang/cLocation.ml | 2 - infer/src/clang/cMain.ml | 2 - infer/src/clang/printing.ml | 92 +++++++++++++++++++++++++++++ infer/src/clang/printing.mli | 30 ++++++++++ 6 files changed, 126 insertions(+), 115 deletions(-) create mode 100644 infer/src/clang/printing.ml create mode 100644 infer/src/clang/printing.mli diff --git a/infer/src/clang/cFrontend_utils.ml b/infer/src/clang/cFrontend_utils.ml index c88029e42..1e4b7227e 100644 --- a/infer/src/clang/cFrontend_utils.ml +++ b/infer/src/clang/cFrontend_utils.ml @@ -9,95 +9,12 @@ open! Utils -(** Module for utility functions for the whole frontend. Includes functions for printing, *) -(** for transformations of ast nodes and general utility functions such as functions on lists *) +(** Module for utility functions for the whole frontend. Includes functions for transformations of + ast nodes and general utility functions such as functions on lists *) module L = Logging module F = Format -module Printing = -struct - let log_out fmt = - let pp = if Config.debug_mode then Format.fprintf else Format.ifprintf in - pp Format.std_formatter fmt - - let log_err fmt = - let pp = if Config.debug_mode then Format.fprintf else Format.ifprintf in - pp Format.err_formatter fmt - - - let annotation_to_string (annotation, _) = - "< " ^ annotation.Typ.class_name ^ " : " ^ - (IList.to_string (fun x -> x) annotation.Typ.parameters) ^ " >" - - let field_to_string (fieldname, typ, annotation) = - (Ident.fieldname_to_string fieldname) ^ " " ^ - (Typ.to_string typ) ^ (IList.to_string annotation_to_string annotation) - - let log_stats fmt = - let pp = - if Config.stats_mode || Config.debug_mode - then Format.fprintf else Format.ifprintf in - pp Format.std_formatter fmt - - let print_tenv tenv = - Tenv.iter (fun typname struct_t -> - match typname with - | Typename.TN_csu (Csu.Class _, _) | Typename.TN_csu (Csu.Protocol, _) -> - print_endline ( - (Typename.to_string typname) ^ " " ^ - (Typ.item_annotation_to_string struct_t.struct_annotations) ^ "\n" ^ - "---> superclass and protocols " ^ (IList.to_string (fun tn -> - "\t" ^ (Typename.to_string tn) ^ "\n") struct_t.superclasses) ^ - "---> methods " ^ - (IList.to_string (fun x ->"\t" ^ (Procname.to_string x) ^ "\n") struct_t.def_methods) - ^ " " ^ - "\t---> fields " ^ (IList.to_string field_to_string struct_t.instance_fields) ^ "\n") - | _ -> () - ) tenv - - let print_tenv_struct_unions tenv = - Tenv.iter (fun typname struct_t -> - match typname with - | Typename.TN_csu (Csu.Struct, _) | Typename.TN_csu (Csu.Union, _) -> - print_endline ( - (Typename.to_string typname)^"\n"^ - "\t---> fields "^(IList.to_string (fun (fieldname, typ, _) -> - match typ with - | Typ.Tvar tname -> "tvar"^(Typename.to_string tname) - | Typ.Tstruct _ | _ -> - "\t struct "^(Ident.fieldname_to_string fieldname)^" "^ - (Typ.to_string typ)^"\n") struct_t.instance_fields - ) - ) - | Typename.TN_typedef typname -> - print_endline - ((Mangled.to_string typname)^"-->"^(Typ.to_string (Typ.Tstruct struct_t))) - | _ -> () - ) tenv - - let print_procedures cfg = - let procs = Cfg.get_all_procs cfg in - print_endline - (IList.to_string (fun pdesc -> - let pname = Cfg.Procdesc.get_proc_name pdesc in - "name> "^ - (Procname.to_string pname) ^ - " defined? " ^ (string_of_bool (Cfg.Procdesc.is_defined pdesc)) ^ "\n") - procs) - - let print_failure_info pointer = - L.err "AST Element> %s IN FILE> %s @.@." pointer !CFrontend_config.json - - let print_nodes nodes = - IList.iter (fun node -> print_endline (Cfg.Node.get_description pe_text node)) nodes - - let instrs_to_string instrs = - let pp fmt () = Format.fprintf fmt "%a" (Sil.pp_instr_list pe_text) instrs in - pp_to_string pp () - -end - module Ast_utils = struct type type_ptr_to_sil_type = Tenv.t -> Clang_ast_t.type_ptr -> Typ.t diff --git a/infer/src/clang/cFrontend_utils.mli b/infer/src/clang/cFrontend_utils.mli index a3bd5b099..42efd5a58 100644 --- a/infer/src/clang/cFrontend_utils.mli +++ b/infer/src/clang/cFrontend_utils.mli @@ -9,32 +9,8 @@ open! Utils -(** Module for utility functions for the whole frontend. Includes functions for printing, *) -(** for transformations of ast nodes and general utility functions such as functions on lists *) - -module Printing : -sig - - val log_out : ('a, Format.formatter, unit) format -> 'a - - val log_err : ('a, Format.formatter, unit) format -> 'a - - val log_stats : ('a, Format.formatter, unit) format -> 'a - - val print_failure_info : string -> unit - - val print_tenv : Tenv.t -> unit - - val print_tenv_struct_unions : Tenv.t -> unit - - val print_procedures : Cfg.cfg -> unit - - val print_nodes : Cfg.Node.t list -> unit - - val instrs_to_string : Sil.instr list -> string - - val field_to_string : Ident.fieldname * Typ.t * Typ.item_annotation -> string -end +(** Module for utility functions for the whole frontend. Includes functions for transformations of + ast nodes and general utility functions such as functions on lists *) module Ast_utils : sig diff --git a/infer/src/clang/cLocation.ml b/infer/src/clang/cLocation.ml index ab1488bcb..ea9fe3155 100644 --- a/infer/src/clang/cLocation.ml +++ b/infer/src/clang/cLocation.ml @@ -11,8 +11,6 @@ open! Utils (** Module for function to retrieve the location (file, line, etc) of instructions *) -open CFrontend_utils - (* Inside the json there may be code or type definitions from other files *) (* than the one passed as an argument. That current file in the translation is saved*) (* in this variable. *) diff --git a/infer/src/clang/cMain.ml b/infer/src/clang/cMain.ml index 005885811..4d9217e58 100644 --- a/infer/src/clang/cMain.ml +++ b/infer/src/clang/cMain.ml @@ -15,8 +15,6 @@ open! Utils module L = Logging -open CFrontend_utils - let buffer_len = 262143 (* This function reads the json file in fname, validates it, and encoded in the AST data structure*) diff --git a/infer/src/clang/printing.ml b/infer/src/clang/printing.ml new file mode 100644 index 000000000..7dc3f4f6f --- /dev/null +++ b/infer/src/clang/printing.ml @@ -0,0 +1,92 @@ +(* + * Copyright (c) 2013 - present Facebook, Inc. + * All rights reserved. + * + * This source code is licensed under the BSD style license found in the + * LICENSE file in the root directory of this source tree. An additional grant + * of patent rights can be found in the PATENTS file in the same directory. + *) + +open! Utils + +module L = Logging +module F = Format + +let log_out fmt = + let pp = if Config.debug_mode then Format.fprintf else Format.ifprintf in + pp Format.std_formatter fmt + +let log_err fmt = + let pp = if Config.debug_mode then Format.fprintf else Format.ifprintf in + pp Format.err_formatter fmt + + +let annotation_to_string (annotation, _) = + "< " ^ annotation.Typ.class_name ^ " : " ^ + (IList.to_string (fun x -> x) annotation.Typ.parameters) ^ " >" + +let field_to_string (fieldname, typ, annotation) = + (Ident.fieldname_to_string fieldname) ^ " " ^ + (Typ.to_string typ) ^ (IList.to_string annotation_to_string annotation) + +let log_stats fmt = + let pp = + if Config.stats_mode || Config.debug_mode + then Format.fprintf else Format.ifprintf in + pp Format.std_formatter fmt + +let print_tenv tenv = + Tenv.iter (fun typname struct_t -> + match typname with + | Typename.TN_csu (Csu.Class _, _) | Typename.TN_csu (Csu.Protocol, _) -> + print_endline ( + (Typename.to_string typname) ^ " " ^ + (Typ.item_annotation_to_string struct_t.struct_annotations) ^ "\n" ^ + "---> superclass and protocols " ^ (IList.to_string (fun tn -> + "\t" ^ (Typename.to_string tn) ^ "\n") struct_t.superclasses) ^ + "---> methods " ^ + (IList.to_string (fun x ->"\t" ^ (Procname.to_string x) ^ "\n") struct_t.def_methods) + ^ " " ^ + "\t---> fields " ^ (IList.to_string field_to_string struct_t.instance_fields) ^ "\n") + | _ -> () + ) tenv + +let print_tenv_struct_unions tenv = + Tenv.iter (fun typname struct_t -> + match typname with + | Typename.TN_csu (Csu.Struct, _) | Typename.TN_csu (Csu.Union, _) -> + print_endline ( + (Typename.to_string typname)^"\n"^ + "\t---> fields "^(IList.to_string (fun (fieldname, typ, _) -> + match typ with + | Typ.Tvar tname -> "tvar"^(Typename.to_string tname) + | Typ.Tstruct _ | _ -> + "\t struct "^(Ident.fieldname_to_string fieldname)^" "^ + (Typ.to_string typ)^"\n") struct_t.instance_fields + ) + ) + | Typename.TN_typedef typname -> + print_endline + ((Mangled.to_string typname)^"-->"^(Typ.to_string (Typ.Tstruct struct_t))) + | _ -> () + ) tenv + +let print_procedures cfg = + let procs = Cfg.get_all_procs cfg in + print_endline + (IList.to_string (fun pdesc -> + let pname = Cfg.Procdesc.get_proc_name pdesc in + "name> "^ + (Procname.to_string pname) ^ + " defined? " ^ (string_of_bool (Cfg.Procdesc.is_defined pdesc)) ^ "\n") + procs) + +let print_failure_info pointer = + L.err "AST Element> %s IN FILE> %s @.@." pointer !CFrontend_config.json + +let print_nodes nodes = + IList.iter (fun node -> print_endline (Cfg.Node.get_description pe_text node)) nodes + +let instrs_to_string instrs = + let pp fmt () = Format.fprintf fmt "%a" (Sil.pp_instr_list pe_text) instrs in + pp_to_string pp () diff --git a/infer/src/clang/printing.mli b/infer/src/clang/printing.mli new file mode 100644 index 000000000..73680ca96 --- /dev/null +++ b/infer/src/clang/printing.mli @@ -0,0 +1,30 @@ +(* + * Copyright (c) 2013 - present Facebook, Inc. + * All rights reserved. + * + * This source code is licensed under the BSD style license found in the + * LICENSE file in the root directory of this source tree. An additional grant + * of patent rights can be found in the PATENTS file in the same directory. + *) + +open! Utils + +val log_out : ('a, Format.formatter, unit) format -> 'a + +val log_err : ('a, Format.formatter, unit) format -> 'a + +val log_stats : ('a, Format.formatter, unit) format -> 'a + +val print_failure_info : string -> unit + +val print_tenv : Tenv.t -> unit + +val print_tenv_struct_unions : Tenv.t -> unit + +val print_procedures : Cfg.cfg -> unit + +val print_nodes : Cfg.Node.t list -> unit + +val instrs_to_string : Sil.instr list -> string + +val field_to_string : Ident.fieldname * Typ.t * Typ.item_annotation -> string