pghs975uc
/
infer_clone
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

move printing module to its own file

Browse Source 
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
master
Jules Villard 8 years ago committed by Facebook Github Bot 8
parent 9e3b3c5d77
commit 0caa7e1826
6 changed files with 126 additions and 115 deletions
Show Stats Download Patch File Download Diff File

87
infer/src/clang/cFrontend_utils.ml
Unescape View File

@ -9,95 +9,12 @@
open! Utils open! Utils
(** Module for utility functions for the whole frontend. Includes functions for printing, *) (** Module for utility functions for the whole frontend. Includes functions for transformations of
(** for transformations of ast nodes and general utility functions such as functions on lists *) ast nodes and general utility functions such as functions on lists *)
module L = Logging module L = Logging
module F = Format 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 = module Ast_utils =
struct struct
type type_ptr_to_sil_type = Tenv.t -> Clang_ast_t.type_ptr -> Typ.t type type_ptr_to_sil_type = Tenv.t -> Clang_ast_t.type_ptr -> Typ.t

28
infer/src/clang/cFrontend_utils.mli
Unescape View File

@ -9,32 +9,8 @@
open! Utils open! Utils
(** Module for utility functions for the whole frontend. Includes functions for printing, *) (** Module for utility functions for the whole frontend. Includes functions for transformations of
(** for transformations of ast nodes and general utility functions such as functions on lists *) 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 Ast_utils : module Ast_utils :
sig sig

2
infer/src/clang/cLocation.ml
Unescape View File

@ -11,8 +11,6 @@ open! Utils
(** Module for function to retrieve the location (file, line, etc) of instructions *) (** 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 *) (* 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*) (* than the one passed as an argument. That current file in the translation is saved*)
(* in this variable. *) (* in this variable. *)

2
infer/src/clang/cMain.ml
Unescape View File

@ -15,8 +15,6 @@ open! Utils
module L = Logging module L = Logging
open CFrontend_utils
let buffer_len = 262143 let buffer_len = 262143
(* This function reads the json file in fname, validates it, and encoded in the AST data structure*) (* This function reads the json file in fname, validates it, and encoded in the AST data structure*)

92
infer/src/clang/printing.ml
Unescape View File

@ -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 ()

30
infer/src/clang/printing.mli
Unescape View File

@ -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
Write Preview
Loading…
Cancel
Save