You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

90 lines
3.1 KiB

(*
* 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: Annot.t), _) =
"< " ^ annotation.class_name ^ " : " ^
(IList.to_string (fun x -> x) annotation.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) ^ " " ^
(Annot.Item.to_string struct_t.annots) ^ "\n" ^
"---> superclass and protocols " ^ (IList.to_string (fun tn ->
"\t" ^ (Typename.to_string tn) ^ "\n") struct_t.supers) ^
"---> methods " ^
(IList.to_string (fun x ->"\t" ^ (Procname.to_string x) ^ "\n") struct_t.methods)
^ " " ^
"\t---> fields " ^ (IList.to_string field_to_string struct_t.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.Tstruct tname -> "tvar"^(Typename.to_string tname)
| _ ->
"\t struct "^(Ident.fieldname_to_string fieldname)^" "^
(Typ.to_string typ)^"\n") struct_t.fields
)
)
| _ -> ()
) 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 ()