Refactoring in preparation of implementing C++ lambda

Summary:public
This diff refactors the current recursive module. It simplifies the structure
making CMethod_decl redoundand.

The idea is to have now two recursive functors: cTrans.ml and cFrontend.ml.
The first dealing with all the expressions and the latter dealing with all
the declarations (in a later diff, we may want to change names of these moules
to reflect Expr and Decl).

This structure will enable to implement lambdas. The previous version
would require some more complex solution where another recursive module
would be involved.

I'm breaking the refactoring in several diffs to make it easier to review.

Reviewed By: akotulski

Differential Revision: D3035122

fb-gh-sync-id: 7dabe9e
shipit-source-id: 7dabe9e
master
Dino Distefano 9 years ago committed by Facebook Github Bot 9
parent 010b57e7cc
commit ce0ae5c821

@ -16,71 +16,165 @@
module L = Logging
open CFrontend_utils
open CGen_trans
(* Translate one global declaration *)
let rec translate_one_declaration tenv cg cfg parent_dec dec =
let open Clang_ast_t in
(* Run the frontend checkers on this declaration *)
CFrontend_errors.run_frontend_checkers_on_decl tenv cg cfg dec;
(* each procedure has different scope: start names from id 0 *)
Ident.NameGenerator.reset ();
let info = Clang_ast_proj.get_decl_tuple dec in
CLocation.update_curr_file info;
let source_range = info.Clang_ast_t.di_source_range in
let should_translate_decl = CLocation.should_translate_lib source_range in
(if should_translate_decl then
match dec with
| FunctionDecl(_, _, _, _) ->
CMethod_declImpl.function_decl tenv cfg cg dec None
| ObjCInterfaceDecl(_, name_info, decl_list, _, oi_decl_info) ->
let name = Ast_utils.get_qualified_name name_info in
let curr_class = ObjcInterface_decl.get_curr_class name oi_decl_info in
ignore
(ObjcInterface_decl.interface_declaration CTypes_decl.type_ptr_to_sil_type tenv dec);
CMethod_declImpl.process_methods tenv cg cfg curr_class decl_list
| ObjCProtocolDecl(_, name_info, decl_list, _, _) ->
let name = Ast_utils.get_qualified_name name_info in
let curr_class = CContext.ContextProtocol name in
ignore (ObjcProtocol_decl.protocol_decl CTypes_decl.type_ptr_to_sil_type tenv dec);
CMethod_declImpl.process_methods tenv cg cfg curr_class decl_list
| ObjCCategoryDecl(_, name_info, decl_list, _, ocdi) ->
let name = Ast_utils.get_qualified_name name_info in
let curr_class = ObjcCategory_decl.get_curr_class_from_category_decl name ocdi in
ignore (ObjcCategory_decl.category_decl CTypes_decl.type_ptr_to_sil_type tenv dec);
CMethod_declImpl.process_methods tenv cg cfg curr_class decl_list
| ObjCCategoryImplDecl(_, name_info, decl_list, _, ocidi) ->
let name = Ast_utils.get_qualified_name name_info in
let curr_class = ObjcCategory_decl.get_curr_class_from_category_impl name ocidi in
ignore (ObjcCategory_decl.category_impl_decl CTypes_decl.type_ptr_to_sil_type tenv dec);
CMethod_declImpl.process_methods tenv cg cfg curr_class decl_list;
| ObjCImplementationDecl(_, _, decl_list, _, idi) ->
let curr_class = ObjcInterface_decl.get_curr_class_impl idi in
let type_ptr_to_sil_type = CTypes_decl.type_ptr_to_sil_type in
ignore (ObjcInterface_decl.interface_impl_declaration type_ptr_to_sil_type tenv dec);
CMethod_declImpl.process_methods tenv cg cfg curr_class decl_list;
| CXXMethodDecl (decl_info, _, _, _, _)
| CXXConstructorDecl (decl_info, _, _, _, _)
| CXXConversionDecl (decl_info, _, _, _, _)
| CXXDestructorDecl (decl_info, _, _, _, _) ->
(* di_parent_pointer has pointer to lexical context such as class.*)
(* If it's not defined, then it's the same as parent in AST *)
let class_decl = match decl_info.Clang_ast_t.di_parent_pointer with
| Some ptr -> Ast_utils.get_decl ptr
| None -> Some parent_dec in
(match class_decl with
| Some (CXXRecordDecl _ as d)
| Some (ClassTemplateSpecializationDecl _ as d) ->
let class_name = CTypes_decl.get_record_name d in
let curr_class = CContext.ContextCls(class_name, None, []) in
if !CFrontend_config.cxx_experimental then
CMethod_declImpl.process_methods tenv cg cfg curr_class [dec]
module type CFrontend_decl = sig
val function_decl : Sil.tenv -> Cfg.cfg -> Cg.t -> Clang_ast_t.decl ->
CModule_type.block_data option -> unit
val translate_one_declaration : Sil.tenv -> Cg.t -> Cfg.cfg -> Clang_ast_t.decl -> Clang_ast_t.decl -> unit
end
module CFrontend_decl_funct(T: CModule_type.CTranslation) : CFrontend_decl =
struct
let model_exists procname =
Specs.summary_exists_in_models procname && not !CFrontend_config.models_mode
(* Translates the method/function's body into nodes of the cfg. *)
let add_method tenv cg cfg class_decl_opt procname body has_return_param is_objc_method
outer_context_opt extra_instrs =
Printing.log_out
"\n\n>>---------- ADDING METHOD: '%s' ---------<<\n@." (Procname.to_string procname);
try
(match Cfg.Procdesc.find_from_name cfg procname with
| Some procdesc ->
if (Cfg.Procdesc.is_defined procdesc && not (model_exists procname)) then
(let context =
CContext.create_context tenv cg cfg procdesc class_decl_opt
has_return_param is_objc_method outer_context_opt in
let start_node = Cfg.Procdesc.get_start_node procdesc in
let exit_node = Cfg.Procdesc.get_exit_node procdesc in
Printing.log_out
"\n\n>>---------- Start translating body of function: '%s' ---------<<\n@."
(Procname.to_string procname);
let meth_body_nodes = T.instructions_trans context body extra_instrs exit_node in
Cfg.Node.add_locals_ret_declaration start_node (Cfg.Procdesc.get_locals procdesc);
Cfg.Node.set_succs_exn start_node meth_body_nodes [];
Cg.add_defined_node (CContext.get_cg context) (Cfg.Procdesc.get_proc_name procdesc))
| None -> ())
with
| Not_found -> ()
| CTrans_utils.Self.SelfClassException _ ->
assert false (* this shouldn't happen, because self or [a class] should always be arguments of functions. This is to make sure I'm not wrong. *)
| Assert_failure (file, line, column) ->
print_endline ("Fatal error: exception Assert_failure("^
file^", "^(string_of_int line)^", "^(string_of_int column)^")");
Cfg.Procdesc.remove cfg procname true;
CMethod_trans.create_external_procdesc cfg procname is_objc_method None;
()
let function_decl tenv cfg cg func_decl block_data_opt =
Printing.log_out "\nResetting the goto_labels hashmap...\n";
CTrans_utils.GotoLabel.reset_all_labels (); (* C Language Std 6.8.6.1-1 *)
let captured_vars, outer_context_opt =
match block_data_opt with
| Some (outer_context, _, _, captured_vars) -> captured_vars, Some outer_context
| None -> [], None in
let ms, body_opt, extra_instrs =
CMethod_trans.method_signature_of_decl tenv func_decl block_data_opt in
match body_opt with
| Some body -> (* Only in the case the function declaration has a defined body we create a procdesc *)
let procname = CMethod_signature.ms_get_name ms in
let return_param_typ_opt = CMethod_signature.ms_get_return_param_typ ms in
if CMethod_trans.create_local_procdesc cfg tenv ms [body] captured_vars false then
add_method tenv cg cfg CContext.ContextNoCls procname body return_param_typ_opt false
outer_context_opt extra_instrs
| None -> ()
let process_method_decl tenv cg cfg curr_class meth_decl ~is_objc =
let ms, body_opt, extra_instrs =
CMethod_trans.method_signature_of_decl tenv meth_decl None in
match body_opt with
| Some body ->
let is_instance = CMethod_signature.ms_is_instance ms in
let procname = CMethod_signature.ms_get_name ms in
let is_objc_inst_method = is_instance && is_objc in
let return_param_typ_opt = CMethod_signature.ms_get_return_param_typ ms in
if CMethod_trans.create_local_procdesc cfg tenv ms [body] [] is_objc_inst_method then
add_method tenv cg cfg curr_class procname body return_param_typ_opt is_objc
None extra_instrs
| None -> ()
let process_one_method_decl tenv cg cfg curr_class dec =
let open Clang_ast_t in
match dec with
| CXXMethodDecl _ | CXXConstructorDecl _ | CXXConversionDecl _ | CXXDestructorDecl _ ->
process_method_decl tenv cg cfg curr_class dec ~is_objc:false
| ObjCMethodDecl _ ->
process_method_decl tenv cg cfg curr_class dec ~is_objc:true
| ObjCPropertyImplDecl _ | EmptyDecl _
| ObjCIvarDecl _ | ObjCPropertyDecl _ -> ()
| _ ->
Printing.log_stats
"\nWARNING: found Method Declaration '%s' skipped. NEED TO BE FIXED\n\n" (Ast_utils.string_of_decl dec);
()
let process_methods tenv cg cfg curr_class decl_list =
IList.iter (process_one_method_decl tenv cg cfg curr_class) decl_list
(* Translate one global declaration *)
let rec translate_one_declaration tenv cg cfg parent_dec dec =
let open Clang_ast_t in
(* Run the frontend checkers on this declaration *)
CFrontend_errors.run_frontend_checkers_on_decl tenv cg cfg dec;
(* each procedure has different scope: start names from id 0 *)
Ident.NameGenerator.reset ();
let info = Clang_ast_proj.get_decl_tuple dec in
CLocation.update_curr_file info;
let source_range = info.Clang_ast_t.di_source_range in
let should_translate_decl = CLocation.should_translate_lib source_range in
(if should_translate_decl then
match dec with
| FunctionDecl(_, _, _, _) ->
function_decl tenv cfg cg dec None
| ObjCInterfaceDecl(_, name_info, decl_list, _, oi_decl_info) ->
let name = Ast_utils.get_qualified_name name_info in
let curr_class = ObjcInterface_decl.get_curr_class name oi_decl_info in
ignore
(ObjcInterface_decl.interface_declaration CTypes_decl.type_ptr_to_sil_type tenv dec);
process_methods tenv cg cfg curr_class decl_list
| ObjCProtocolDecl(_, name_info, decl_list, _, _) ->
let name = Ast_utils.get_qualified_name name_info in
let curr_class = CContext.ContextProtocol name in
ignore (ObjcProtocol_decl.protocol_decl CTypes_decl.type_ptr_to_sil_type tenv dec);
process_methods tenv cg cfg curr_class decl_list
| ObjCCategoryDecl(_, name_info, decl_list, _, ocdi) ->
let name = Ast_utils.get_qualified_name name_info in
let curr_class = ObjcCategory_decl.get_curr_class_from_category_decl name ocdi in
ignore (ObjcCategory_decl.category_decl CTypes_decl.type_ptr_to_sil_type tenv dec);
process_methods tenv cg cfg curr_class decl_list
| ObjCCategoryImplDecl(_, name_info, decl_list, _, ocidi) ->
let name = Ast_utils.get_qualified_name name_info in
let curr_class = ObjcCategory_decl.get_curr_class_from_category_impl name ocidi in
ignore (ObjcCategory_decl.category_impl_decl CTypes_decl.type_ptr_to_sil_type tenv dec);
process_methods tenv cg cfg curr_class decl_list;
| ObjCImplementationDecl(_, _, decl_list, _, idi) ->
let curr_class = ObjcInterface_decl.get_curr_class_impl idi in
let type_ptr_to_sil_type = CTypes_decl.type_ptr_to_sil_type in
ignore (ObjcInterface_decl.interface_impl_declaration type_ptr_to_sil_type tenv dec);
process_methods tenv cg cfg curr_class decl_list;
| CXXMethodDecl (decl_info, _, _, _, _)
| CXXConstructorDecl (decl_info, _, _, _, _)
| CXXConversionDecl (decl_info, _, _, _, _)
| CXXDestructorDecl (decl_info, _, _, _, _) ->
(* di_parent_pointer has pointer to lexical context such as class.*)
(* If it's not defined, then it's the same as parent in AST *)
let class_decl = match decl_info.Clang_ast_t.di_parent_pointer with
| Some ptr -> Ast_utils.get_decl ptr
| None -> Some parent_dec in
(match class_decl with
| Some (CXXRecordDecl _ as d)
| Some (ClassTemplateSpecializationDecl _ as d) ->
let class_name = CTypes_decl.get_record_name d in
let curr_class = CContext.ContextCls(class_name, None, []) in
if !CFrontend_config.testing_mode then
process_methods tenv cg cfg curr_class [dec]
| Some dec -> Printing.log_stats "Methods of %s skipped\n" (Ast_utils.string_of_decl dec)
| None -> ())
| _ -> ());
@ -110,55 +204,4 @@ let rec translate_one_declaration tenv cg cfg parent_dec dec =
IList.iter (translate_one_declaration tenv cg cfg dec) decl_list
| _ -> ()
(* Translates a file by translating the ast into a cfg. *)
let compute_icfg tenv ast =
match ast with
| Clang_ast_t.TranslationUnitDecl(_, decl_list, _, _) ->
CFrontend_config.global_translation_unit_decls := decl_list;
Printing.log_out "\n Start creating icfg\n";
let cg = Cg.create () in
let cfg = Cfg.Node.create_cfg () in
IList.iter (translate_one_declaration tenv cg cfg ast) decl_list;
Printing.log_out "\n Finished creating icfg\n";
(cg, cfg)
| _ -> assert false (* NOTE: Assumes that an AST alsways starts with a TranslationUnitDecl *)
let init_global_state source_file =
Config.curr_language := Config.C_CPP;
DB.current_source := source_file;
DB.Results_dir.init ();
Ident.NameGenerator.reset ();
CFrontend_config.global_translation_unit_decls := [];
CFrontend_utils.General_utils.reset_block_counter ()
let do_source_file source_file ast =
let tenv = Sil.create_tenv () in
CTypes_decl.add_predefined_types tenv;
init_global_state source_file;
Config.nLOC := FileLOC.file_get_loc (DB.source_file_to_string source_file);
Printing.log_out "\n Start building call/cfg graph for '%s'....\n"
(DB.source_file_to_string source_file);
let call_graph, cfg = compute_icfg tenv ast in
Printing.log_out "\n End building call/cfg graph for '%s'.\n"
(DB.source_file_to_string source_file);
(* This part below is a boilerplate in every frontends. *)
(* This could be moved in the cfg_infer module *)
let source_dir = DB.source_dir_from_source_file !DB.current_source in
let tenv_file = DB.source_dir_get_internal_file source_dir ".tenv" in
let cfg_file = DB.source_dir_get_internal_file source_dir ".cfg" in
let cg_file = DB.source_dir_get_internal_file source_dir ".cg" in
Cfg.add_removetemps_instructions cfg;
Preanal.doit cfg call_graph tenv;
Cfg.add_abstraction_instructions cfg;
Cg.store_to_file cg_file call_graph;
Cfg.store_cfg_to_file cfg_file true cfg;
(*Logging.out "Tenv %a@." Sil.pp_tenv tenv;*)
(* Printing.print_tenv tenv; *)
(*Printing.print_procedures cfg; *)
General_utils.sort_fields_tenv tenv;
Sil.store_tenv_to_file tenv_file tenv;
if !CFrontend_config.stats_mode then Cfg.check_cfg_connectedness cfg;
if !CFrontend_config.stats_mode || !CFrontend_config.debug_mode || !CFrontend_config.testing_mode then
(Dotty.print_icfg_dotty cfg [];
Cg.save_call_graph_dotty None Specs.get_specs call_graph)
end

@ -13,5 +13,12 @@
(** declarations as procdescs to the cfg, and adding the control flow graph of all the *)
(** code of those functions and methods to the cfg *)
module type CFrontend_decl = sig
val function_decl : Sil.tenv -> Cfg.cfg -> Cg.t -> Clang_ast_t.decl ->
CModule_type.block_data option -> unit
val do_source_file : DB.source_file -> Clang_ast_t.decl -> unit
val translate_one_declaration : Sil.tenv -> Cg.t -> Cfg.cfg ->
Clang_ast_t.decl -> Clang_ast_t.decl -> unit
end
module CFrontend_decl_funct(T: CModule_type.CTranslation) : CFrontend_decl

@ -7,8 +7,65 @@
* of patent rights can be found in the PATENTS file in the same directory.
*)
module L = Logging
open CFrontend_utils
module rec CTransImpl : CTrans.CTrans =
CTrans.CTrans_funct(CMethod_declImpl)
CTrans.CTrans_funct(CFrontend_declImpl)
and CFrontend_declImpl : CFrontend.CFrontend_decl =
CFrontend.CFrontend_decl_funct(CTransImpl)
(* Translates a file by translating the ast into a cfg. *)
let compute_icfg tenv ast =
match ast with
| Clang_ast_t.TranslationUnitDecl(_, decl_list, _, _) ->
CFrontend_config.global_translation_unit_decls := decl_list;
Printing.log_out "\n Start creating icfg\n";
let cg = Cg.create () in
let cfg = Cfg.Node.create_cfg () in
IList.iter (CFrontend_declImpl.translate_one_declaration tenv cg cfg ast) decl_list;
Printing.log_out "\n Finished creating icfg\n";
(cg, cfg)
| _ -> assert false (* NOTE: Assumes that an AST alsways starts with a TranslationUnitDecl *)
let init_global_state source_file =
Config.curr_language := Config.C_CPP;
DB.current_source := source_file;
DB.Results_dir.init ();
Ident.NameGenerator.reset ();
CFrontend_config.global_translation_unit_decls := [];
CFrontend_utils.General_utils.reset_block_counter ()
and CMethod_declImpl : CMethod_decl.CMethod_decl =
CMethod_decl.CMethod_decl_funct(CTransImpl)
let do_source_file source_file ast =
let tenv = Sil.create_tenv () in
CTypes_decl.add_predefined_types tenv;
init_global_state source_file;
Config.nLOC := FileLOC.file_get_loc (DB.source_file_to_string source_file);
Printing.log_out "\n Start building call/cfg graph for '%s'....\n"
(DB.source_file_to_string source_file);
let call_graph, cfg = compute_icfg tenv ast in
Printing.log_out "\n End building call/cfg graph for '%s'.\n"
(DB.source_file_to_string source_file);
(* This part below is a boilerplate in every frontends. *)
(* This could be moved in the cfg_infer module *)
let source_dir = DB.source_dir_from_source_file !DB.current_source in
let tenv_file = DB.source_dir_get_internal_file source_dir ".tenv" in
let cfg_file = DB.source_dir_get_internal_file source_dir ".cfg" in
let cg_file = DB.source_dir_get_internal_file source_dir ".cg" in
Cfg.add_removetemps_instructions cfg;
Preanal.doit cfg call_graph tenv;
Cfg.add_abstraction_instructions cfg;
Cg.store_to_file cg_file call_graph;
Cfg.store_cfg_to_file cfg_file true cfg;
(*Logging.out "Tenv %a@." Sil.pp_tenv tenv;*)
(* Printing.print_tenv tenv; *)
(*Printing.print_procedures cfg; *)
General_utils.sort_fields_tenv tenv;
Sil.store_tenv_to_file tenv_file tenv;
if !CFrontend_config.stats_mode then Cfg.check_cfg_connectedness cfg;
if !CFrontend_config.stats_mode
|| !CFrontend_config.debug_mode || !CFrontend_config.testing_mode then
(Dotty.print_icfg_dotty cfg [];
Cg.save_call_graph_dotty None Specs.get_specs call_graph)

@ -132,7 +132,7 @@ let do_run source_path ast_path =
CLocation.check_source_file source_path;
let source_file = CLocation.source_file_from_path source_path in
print_endline ("Start translation of AST from " ^ !CFrontend_config.json);
CFrontend.do_source_file source_file ast_decl;
CGen_trans.do_source_file source_file ast_decl;
print_endline ("End translation AST file " ^ !CFrontend_config.json ^ "... OK!")
with
(Yojson.Json_error s) as exc -> Printing.log_err "%s\n" s;

@ -20,9 +20,10 @@ sig
Cfg.Node.t -> Cfg.Node.t list
end
module type CMethod_declaration =
sig
module type CFrontend = sig
val function_decl : Sil.tenv -> Cfg.cfg -> Cg.t -> Clang_ast_t.decl ->
block_data option -> unit
val translate_one_declaration : Sil.tenv -> Cg.t -> Cfg.cfg ->
Clang_ast_t.decl -> Clang_ast_t.decl -> unit
end

@ -26,7 +26,7 @@ module type CTrans = sig
end
module CTrans_funct(M: CModule_type.CMethod_declaration) : CTrans =
module CTrans_funct(F: CModule_type.CFrontend) : CTrans =
struct
(*Returns the procname and whether is instance, according to the selector *)
@ -1890,7 +1890,7 @@ struct
let ids_instrs = IList.map assign_captured_var captured_vars in
let ids, instrs = IList.split ids_instrs in
let block_data = (context, type_ptr, block_pname, captured_vars) in
M.function_decl context.tenv context.cfg context.cg decl (Some block_data);
F.function_decl context.tenv context.cfg context.cg decl (Some block_data);
Cfg.set_procname_priority context.cfg block_pname;
let captured_exps = IList.map (fun id -> Sil.Var id) ids in
let tu = Sil.Ctuple ((Sil.Const (Sil.Cfun block_pname)) :: captured_exps) in

@ -19,5 +19,5 @@ module type CTrans = sig
end
module CTrans_funct(M: CModule_type.CMethod_declaration) : CTrans
module CTrans_funct(F: CModule_type.CFrontend) : CTrans

Loading…
Cancel
Save