[clang] unopen some modules

Summary:
Use local open instead of open for modules, except utility ones.
master
Jules Villard 9 years ago
parent 4a55382345
commit cc70507552

@ -7,86 +7,81 @@
* of patent rights can be found in the PATENTS file in the same directory.
*)
open Clang_ast_t
open CFrontend_utils
(** This module creates extra ast constructs that are needed for the translation *)
let dummy_source_range () =
let dummy_source_loc = {
sl_file = None;
Clang_ast_t.sl_file = None;
sl_line = None;
sl_column = None
sl_column = None;
} in
(dummy_source_loc, dummy_source_loc)
let dummy_stmt_info () =
{
let dummy_stmt_info () = {
Clang_ast_t.si_pointer = Ast_utils.get_fresh_pointer ();
Clang_ast_t.si_source_range = dummy_source_range ()
}
si_source_range = dummy_source_range ();
}
(* given a stmt_info return the same stmt_info with a fresh pointer *)
let fresh_stmt_info stmt_info =
{ stmt_info with Clang_ast_t.si_pointer = Ast_utils.get_fresh_pointer () }
let dummy_decl_info decl_info =
{
let dummy_decl_info decl_info = {
decl_info with
Clang_ast_t.di_pointer = Ast_utils.get_fresh_pointer ();
Clang_ast_t.di_source_range = dummy_source_range ();
}
di_source_range = dummy_source_range ();
}
let dummy_decl_info_in_curr_file decl_info =
let source_loc = {
sl_file = Some (DB.source_file_to_abs_path !CLocation.current_source_file);
Clang_ast_t.sl_file = Some (DB.source_file_to_abs_path !CLocation.current_source_file);
sl_line = None;
sl_column = None
sl_column = None;
} in {
decl_info with
Clang_ast_t.di_pointer = Ast_utils.get_fresh_pointer ();
Clang_ast_t.di_source_range =
di_source_range =
if !CFrontend_config.testing_mode then
decl_info.Clang_ast_t.di_source_range
else (source_loc, source_loc)
else (source_loc, source_loc);
}
let empty_decl_info = {
Clang_ast_t.di_pointer = "";
Clang_ast_t.di_parent_pointer = None;
Clang_ast_t.di_previous_decl = `None;
Clang_ast_t.di_source_range = dummy_source_range ();
Clang_ast_t.di_owning_module = None;
Clang_ast_t.di_is_hidden = false;
Clang_ast_t.di_is_implicit = false;
Clang_ast_t.di_is_used = true;
Clang_ast_t.di_is_this_declaration_referenced = true;
Clang_ast_t.di_is_invalid_decl = false;
Clang_ast_t.di_attributes = [];
Clang_ast_t.di_full_comment = None;
di_parent_pointer = None;
di_previous_decl = `None;
di_source_range = dummy_source_range ();
di_owning_module = None;
di_is_hidden = false;
di_is_implicit = false;
di_is_used = true;
di_is_this_declaration_referenced = true;
di_is_invalid_decl = false;
di_attributes = [];
di_full_comment = None;
}
let empty_var_decl_info = {
Clang_ast_t.vdi_storage_class = None;
Clang_ast_t.vdi_tls_kind =`Tls_none;
Clang_ast_t.vdi_is_module_private = false;
Clang_ast_t.vdi_is_nrvo_variable = false;
Clang_ast_t.vdi_init_expr = None;
vdi_tls_kind =`Tls_none;
vdi_is_module_private = false;
vdi_is_nrvo_variable = false;
vdi_init_expr = None;
}
let stmt_info_with_fresh_pointer stmt_info =
{
let stmt_info_with_fresh_pointer stmt_info = {
Clang_ast_t.si_pointer = Ast_utils.get_fresh_pointer ();
Clang_ast_t.si_source_range = stmt_info.si_source_range
}
si_source_range = stmt_info.Clang_ast_t.si_source_range;
}
let create_qual_type s =
{
let create_qual_type s = {
Clang_ast_t.qt_raw = s;
Clang_ast_t.qt_desugared = Some s;
qt_desugared = Some s;
(* pointer needs to be set when we start using these, non trivial to do though *)
Clang_ast_t.qt_type_ptr = Ast_utils.get_invalid_pointer ()
}
qt_type_ptr = Ast_utils.get_invalid_pointer ();
}
let create_pointer_type s =
create_qual_type (s^" *")
@ -100,7 +95,11 @@ let create_id_type () = create_qual_type "id"
let create_char_type () = create_qual_type "char *"
(* pointer needs to be set when we start using these, non trivial to do though *)
let create_BOOL_type () = { qt_raw = "BOOL"; qt_desugared = Some("signed char"); qt_type_ptr = Ast_utils.get_invalid_pointer () }
let create_BOOL_type () = {
Clang_ast_t.qt_raw = "BOOL";
qt_desugared = Some ("signed char");
qt_type_ptr = Ast_utils.get_invalid_pointer ();
}
let create_void_unsigned_long_type () = create_qual_type "void *(unsigned long)"
@ -112,47 +111,47 @@ let create_integer_literal stmt_info n =
let stmt_info = dummy_stmt_info () in
let expr_info = {
Clang_ast_t.ei_qual_type = create_int_type ();
Clang_ast_t.ei_value_kind = `RValue;
Clang_ast_t.ei_object_kind = `Ordinary
ei_value_kind = `RValue;
ei_object_kind = `Ordinary;
} in
let integer_literal_info = {
Clang_ast_t.ili_is_signed = true;
Clang_ast_t.ili_bitwidth = 32;
Clang_ast_t.ili_value = n
ili_bitwidth = 32;
ili_value = n;
} in
IntegerLiteral (stmt_info, [], expr_info, integer_literal_info)
Clang_ast_t.IntegerLiteral (stmt_info, [], expr_info, integer_literal_info)
let create_cstyle_cast_expr stmt_info stmts qt =
let expr_info = {
Clang_ast_t.ei_qual_type = create_void_type ();
Clang_ast_t.ei_value_kind = `RValue;
Clang_ast_t.ei_object_kind = `Ordinary
ei_value_kind = `RValue;
ei_object_kind = `Ordinary;
} in
let cast_expr = {
Clang_ast_t.cei_cast_kind = `NullToPointer;
Clang_ast_t.cei_base_path = []
cei_base_path = [];
} in
CStyleCastExpr (stmt_info, stmts, expr_info, cast_expr, qt)
Clang_ast_t.CStyleCastExpr (stmt_info, stmts, expr_info, cast_expr, qt)
let create_parent_expr stmt_info stmts =
let expr_info = {
Clang_ast_t.ei_qual_type = create_void_type ();
Clang_ast_t.ei_value_kind = `RValue;
Clang_ast_t.ei_object_kind = `Ordinary
ei_value_kind = `RValue;
ei_object_kind = `Ordinary;
} in
ParenExpr (stmt_info, stmts, expr_info)
Clang_ast_t.ParenExpr (stmt_info, stmts, expr_info)
let create_implicit_cast_expr stmt_info stmts typ cast_kind =
let expr_info = {
Clang_ast_t.ei_qual_type = typ;
Clang_ast_t.ei_value_kind = `RValue;
Clang_ast_t.ei_object_kind = `Ordinary
ei_value_kind = `RValue;
ei_object_kind = `Ordinary;
} in
let cast_expr_info = {
Clang_ast_t.cei_cast_kind = cast_kind;
Clang_ast_t.cei_base_path = []
cei_base_path = [];
} in
ImplicitCastExpr (stmt_info, stmts, expr_info, cast_expr_info)
Clang_ast_t.ImplicitCastExpr (stmt_info, stmts, expr_info, cast_expr_info)
let create_nil stmt_info =
let integer_literal = create_integer_literal stmt_info "0" in
@ -164,15 +163,18 @@ let create_nil stmt_info =
let dummy_stmt () =
let pointer = Ast_utils.get_fresh_pointer () in
let source_range = dummy_source_range () in
NullStmt({ Clang_ast_t.si_pointer = pointer; Clang_ast_t.si_source_range = source_range } ,[])
Clang_ast_t.NullStmt({ Clang_ast_t.si_pointer = pointer; si_source_range = source_range } ,[])
let make_stmt_info di =
{ Clang_ast_t.si_pointer = di.Clang_ast_t.di_pointer; Clang_ast_t.si_source_range = di.Clang_ast_t.di_source_range }
let make_stmt_info di = {
Clang_ast_t.si_pointer = di.Clang_ast_t.di_pointer;
si_source_range = di.Clang_ast_t.di_source_range;
}
let make_expr_info qt vk objc_kind = {
Clang_ast_t.ei_qual_type = qt;
Clang_ast_t.ei_value_kind = vk;
Clang_ast_t.ei_object_kind = objc_kind;}
ei_value_kind = vk;
ei_object_kind = objc_kind;
}
let make_expr_info_with_objc_kind qt objc_kind =
make_expr_info qt `LValue objc_kind
@ -180,47 +182,41 @@ let make_expr_info_with_objc_kind qt objc_kind =
let make_lvalue_obc_prop_expr_info qt =
make_expr_info qt `LValue `ObjCProperty
let make_method_decl_info mdi body = {
Clang_ast_t.omdi_is_instance_method = mdi.Clang_ast_t.omdi_is_instance_method;
Clang_ast_t.omdi_result_type = mdi.Clang_ast_t.omdi_result_type;
Clang_ast_t.omdi_parameters = mdi.Clang_ast_t.omdi_parameters;
Clang_ast_t.omdi_is_variadic = mdi.Clang_ast_t.omdi_is_variadic;
Clang_ast_t.omdi_body = Some body; }
let make_method_decl_info mdi body =
{ mdi with Clang_ast_t.omdi_body = Some body; }
let make_decl_ref_exp stmt_info expr_info drei =
let stmt_info = {
Clang_ast_t.si_pointer = Ast_utils.get_fresh_pointer ();
Clang_ast_t.si_source_range = stmt_info.Clang_ast_t.si_source_range
si_source_range = stmt_info.Clang_ast_t.si_source_range
} in
DeclRefExpr(stmt_info, [], expr_info, drei)
Clang_ast_t.DeclRefExpr(stmt_info, [], expr_info, drei)
let make_obj_c_message_expr_info_instance sel =
{
let make_obj_c_message_expr_info_instance sel = {
Clang_ast_t.omei_selector = sel;
Clang_ast_t.omei_receiver_kind = `Instance;
Clang_ast_t.omei_is_definition_found = false;
Clang_ast_t.omei_decl_pointer = None (* TODO look into it *)
}
omei_receiver_kind = `Instance;
omei_is_definition_found = false;
omei_decl_pointer = None; (* TODO look into it *)
}
let make_obj_c_message_expr_info_class selector qt =
{
omei_selector = selector;
let make_obj_c_message_expr_info_class selector qt = {
Clang_ast_t.omei_selector = selector;
omei_receiver_kind = `Class (create_qual_type qt);
Clang_ast_t.omei_is_definition_found = false;
Clang_ast_t.omei_decl_pointer = None (* TODO look into it *)
}
omei_is_definition_found = false;
omei_decl_pointer = None (* TODO look into it *)
}
let make_name_decl name = {
Clang_ast_t.ni_name = name;
Clang_ast_t.ni_qual_name = [name];
ni_qual_name = [name];
}
let make_decl_ref k decl_ptr name is_hidden qt_opt = {
Clang_ast_t.dr_kind = k;
Clang_ast_t.dr_decl_pointer = decl_ptr;
Clang_ast_t.dr_name = Some (make_name_decl name);
Clang_ast_t.dr_is_hidden = is_hidden ;
Clang_ast_t.dr_qual_type = qt_opt
dr_decl_pointer = decl_ptr;
dr_name = Some (make_name_decl name);
dr_is_hidden = is_hidden ;
dr_qual_type = qt_opt
}
let make_decl_ref_qt k decl_ptr name is_hidden qt =
@ -234,21 +230,21 @@ let make_decl_ref_invalid k name is_hidden qt =
let make_decl_ref_self ptr qt = {
Clang_ast_t.dr_kind = `ImplicitParam;
Clang_ast_t.dr_decl_pointer = ptr;
Clang_ast_t.dr_name = Some (make_name_decl "self");
Clang_ast_t.dr_is_hidden = false ;
Clang_ast_t.dr_qual_type = Some qt
dr_decl_pointer = ptr;
dr_name = Some (make_name_decl "self");
dr_is_hidden = false ;
dr_qual_type = Some qt
}
let make_decl_ref_expr_info decl_ref = {
Clang_ast_t.drti_decl_ref = Some decl_ref;
Clang_ast_t.drti_found_decl_ref = None;
drti_found_decl_ref = None;
}
let make_obj_c_ivar_ref_expr_info k ptr n qt = {
Clang_ast_t.ovrei_decl_ref = make_decl_ref_qt k ptr n false qt;
Clang_ast_t.ovrei_pointer = Ast_utils.get_fresh_pointer ();
Clang_ast_t.ovrei_is_free_ivar = true;
ovrei_pointer = Ast_utils.get_fresh_pointer ();
ovrei_is_free_ivar = true;
}
(* Build an AST cast expression of a decl_ref_expr *)
@ -258,9 +254,10 @@ let make_cast_expr qt di decl_ref_expr_info objc_kind =
let decl_ref_exp = make_decl_ref_exp stmt_info expr_info decl_ref_expr_info in
let cast_expr = {
Clang_ast_t.cei_cast_kind = `LValueToRValue;
Clang_ast_t.cei_base_path = []
cei_base_path = [];
} in
let cast_exp_rhs = ImplicitCastExpr(stmt_info, [decl_ref_exp], expr_info, cast_expr) in
let cast_exp_rhs =
Clang_ast_t.ImplicitCastExpr(stmt_info, [decl_ref_exp], expr_info, cast_expr) in
cast_exp_rhs
(* Build AST expression self.field_name as `LValue *)
@ -268,9 +265,10 @@ let make_self_field class_type di qt field_name =
let qt_class = create_qual_type class_type in
let expr_info = make_expr_info_with_objc_kind qt `ObjCProperty in
let stmt_info = make_stmt_info di in
let cast_exp = make_cast_expr qt_class di (make_decl_ref_expr_info (make_decl_ref_self di.di_pointer qt_class)) `ObjCProperty in
let obj_c_ivar_ref_expr_info = make_obj_c_ivar_ref_expr_info (`ObjCIvar) di.di_pointer field_name qt in
let ivar_ref_exp = ObjCIvarRefExpr(stmt_info, [cast_exp], expr_info, obj_c_ivar_ref_expr_info) in
let cast_exp = make_cast_expr qt_class di (make_decl_ref_expr_info (make_decl_ref_self di.Clang_ast_t.di_pointer qt_class)) `ObjCProperty in
let obj_c_ivar_ref_expr_info = make_obj_c_ivar_ref_expr_info (`ObjCIvar) di.Clang_ast_t.di_pointer field_name qt in
let ivar_ref_exp =
Clang_ast_t.ObjCIvarRefExpr(stmt_info, [cast_exp], expr_info, obj_c_ivar_ref_expr_info) in
ivar_ref_exp
(* Build AST expression for self.field_name casted as `RValue. *)
@ -278,42 +276,42 @@ let make_deref_self_field class_decl_opt di qt field_name =
let stmt_info = make_stmt_info di in
let ivar_ref_exp = make_self_field class_decl_opt di qt field_name in
let expr_info' = make_expr_info_with_objc_kind qt `ObjCProperty in
let cast_exp_info =
{
let cast_exp_info = {
Clang_ast_t.cei_cast_kind = `LValueToRValue;
Clang_ast_t.cei_base_path = []
cei_base_path = [];
} in
let cast_exp' = ImplicitCastExpr(stmt_info, [ivar_ref_exp], expr_info', cast_exp_info) in
let cast_exp' =
Clang_ast_t.ImplicitCastExpr(stmt_info, [ivar_ref_exp], expr_info', cast_exp_info) in
cast_exp'
let make_objc_ivar_decl decl_info qt property_impl_decl_info ivar_name =
let field_decl_info = {
Clang_ast_t.fldi_is_mutable = true;
Clang_ast_t.fldi_is_module_private = true;
Clang_ast_t.fldi_init_expr = None;
Clang_ast_t.fldi_bit_width_expr = None } in
fldi_is_module_private = true;
fldi_init_expr = None;
fldi_bit_width_expr = None;
} in
let obj_c_ivar_decl_info = {
Clang_ast_t.ovdi_is_synthesize = true; (* NOTE: We set true here because we use this definition to synthesize the getter/setter*)
Clang_ast_t.ovdi_access_control = `Private } in
ObjCIvarDecl(decl_info, make_name_decl ivar_name, qt, field_decl_info, obj_c_ivar_decl_info)
ovdi_access_control = `Private;
} in
Clang_ast_t.ObjCIvarDecl(decl_info, make_name_decl ivar_name, qt, field_decl_info, obj_c_ivar_decl_info)
let make_expr_info qt =
{
let make_expr_info qt = {
Clang_ast_t.ei_qual_type = qt;
Clang_ast_t.ei_value_kind = `LValue;
Clang_ast_t.ei_object_kind = `ObjCProperty
}
ei_value_kind = `LValue;
ei_object_kind = `ObjCProperty
}
let make_general_expr_info qt vk ok =
{
let make_general_expr_info qt vk ok = {
Clang_ast_t.ei_qual_type = qt;
Clang_ast_t.ei_value_kind = vk;
Clang_ast_t.ei_object_kind = ok
}
ei_value_kind = vk;
ei_object_kind = ok
}
let make_ObjCBoolLiteralExpr stmt_info value =
let ei = make_expr_info (create_BOOL_type ()) in
ObjCBoolLiteralExpr((fresh_stmt_info stmt_info),[], ei, value)
Clang_ast_t.ObjCBoolLiteralExpr((fresh_stmt_info stmt_info),[], ei, value)
let make_decl_ref_exp_var (var_name, var_qt, var_ptr) var_kind stmt_info =
let stmt_info = stmt_info_with_fresh_pointer stmt_info in
@ -330,28 +328,30 @@ let make_message_expr param_qt selector decl_ref_exp stmt_info add_cast =
else [decl_ref_exp] in
let obj_c_message_expr_info = make_obj_c_message_expr_info_instance selector in
let expr_info = make_expr_info_with_objc_kind param_qt `ObjCProperty in
ObjCMessageExpr (stmt_info, parameters, expr_info, obj_c_message_expr_info)
Clang_ast_t.ObjCMessageExpr (stmt_info, parameters, expr_info, obj_c_message_expr_info)
let make_compound_stmt stmts stmt_info =
let stmt_info = stmt_info_with_fresh_pointer stmt_info in
CompoundStmt (stmt_info, stmts)
Clang_ast_t.CompoundStmt (stmt_info, stmts)
let make_binary_stmt stmt1 stmt2 stmt_info expr_info boi =
let stmt_info = stmt_info_with_fresh_pointer stmt_info in
BinaryOperator(stmt_info, [stmt1; stmt2], expr_info, boi)
Clang_ast_t.BinaryOperator(stmt_info, [stmt1; stmt2], expr_info, boi)
let make_next_object_exp stmt_info item items =
let var_decl_ref, var_type =
match item with
| DeclStmt (stmt_info, _, [VarDecl(di, name_info, var_type, _)]) ->
| Clang_ast_t.DeclStmt (stmt_info, _, [Clang_ast_t.VarDecl(di, name_info, var_type, _)]) ->
let var_name = name_info.Clang_ast_t.ni_name in
let decl_ptr = di.Clang_ast_t.di_pointer in
let decl_ref = make_decl_ref_qt `Var decl_ptr var_name false var_type in
let stmt_info_var = {
si_pointer = di.Clang_ast_t.di_pointer;
Clang_ast_t.si_pointer = di.Clang_ast_t.di_pointer;
si_source_range = di.Clang_ast_t.di_source_range
} in
DeclRefExpr(stmt_info_var, [], (make_expr_info_with_objc_kind var_type `ObjCProperty), (make_decl_ref_expr_info decl_ref)),
let expr_info = make_expr_info_with_objc_kind var_type `ObjCProperty in
let decl_ref_expr_info = make_decl_ref_expr_info decl_ref in
Clang_ast_t.DeclRefExpr (stmt_info_var, [], expr_info, decl_ref_expr_info),
var_type
| _ -> assert false in
let message_call = make_message_expr (create_qual_type CFrontend_config.id_cl)
@ -360,11 +360,11 @@ let make_next_object_exp stmt_info item items =
make_binary_stmt var_decl_ref message_call stmt_info (make_expr_info_with_objc_kind var_type `ObjCProperty) boi
let empty_var_decl = {
vdi_storage_class = None;
Clang_ast_t.vdi_storage_class = None;
vdi_tls_kind =`Tls_none;
vdi_is_module_private = false;
vdi_is_nrvo_variable = false;
vdi_init_expr = None
vdi_init_expr = None;
}
(* dispatch_once(v,block_def) is transformed as: *)
@ -374,9 +374,10 @@ let translate_dispatch_function block_name stmt_info stmt_list ei n =
try Utils.list_nth stmt_list (n + 1)
with Not_found -> assert false in
let block_name_info = make_name_decl block_name in
let open Clang_ast_t in
match block_expr with
| BlockExpr(bsi, bsl, bei, bd) ->
let qt = bei.Clang_ast_t.ei_qual_type in
| BlockExpr (bsi, bsl, bei, bd) ->
let qt = bei.ei_qual_type in
let cast_info = { cei_cast_kind = `BitCast; cei_base_path =[]} in
let block_def = ImplicitCastExpr(stmt_info,[block_expr], bei, cast_info) in
let decl_info = { empty_decl_info
@ -403,12 +404,13 @@ let make_DeclStmt stmt_info di qt vname iexp =
let ie = create_implicit_cast_expr stmt_info [iexp'] qt `IntegralCast in
Some ie, [ie]
| None -> None, [] in
let var_decl = VarDecl(di, vname, qt, { empty_var_decl_info with Clang_ast_t.vdi_init_expr = init_expr_opt;}) in
DeclStmt(stmt_info, init_expr_l, [var_decl])
let var_decl_info = { empty_var_decl_info with Clang_ast_t.vdi_init_expr = init_expr_opt } in
let var_decl = Clang_ast_t.VarDecl (di, vname, qt, var_decl_info) in
Clang_ast_t.DeclStmt (stmt_info, init_expr_l, [var_decl])
let build_OpaqueValueExpr si source_expr ei =
let opaque_value_expr_info = { Clang_ast_t.ovei_source_expr = Some source_expr } in
OpaqueValueExpr(si, [], ei, opaque_value_expr_info)
Clang_ast_t.OpaqueValueExpr (si, [], ei, opaque_value_expr_info)
let pseudo_object_qt () =
create_qual_type CFrontend_config.pseudo_object_type
@ -416,34 +418,34 @@ let pseudo_object_qt () =
(* Create expression PseudoObjectExpr for 'o.m' *)
let build_PseudoObjectExpr qt_m o_cast_decl_ref_exp mname =
match o_cast_decl_ref_exp with
| ImplicitCastExpr(si, stmt_list, ei, cast_expr_info) ->
| Clang_ast_t.ImplicitCastExpr (si, stmt_list, ei, cast_expr_info) ->
let ove = build_OpaqueValueExpr si o_cast_decl_ref_exp ei in
let ei_opre = make_expr_info (pseudo_object_qt ()) in
let obj_c_property_ref_expr_info = {
Clang_ast_t.oprei_kind =
`PropertyRef (make_decl_ref_no_qt `ObjCProperty si.si_pointer CFrontend_config.count false);
Clang_ast_t.oprei_is_super_receiver = false;
Clang_ast_t.oprei_is_messaging_getter = true;
Clang_ast_t.oprei_is_messaging_setter = false;
`PropertyRef (make_decl_ref_no_qt `ObjCProperty si.Clang_ast_t.si_pointer CFrontend_config.count false);
oprei_is_super_receiver = false;
oprei_is_messaging_getter = true;
oprei_is_messaging_setter = false;
} in
let opre = ObjCPropertyRefExpr(si, [ove], ei_opre, obj_c_property_ref_expr_info) in
let opre = Clang_ast_t.ObjCPropertyRefExpr (si, [ove], ei_opre, obj_c_property_ref_expr_info) in
let ome = make_message_expr qt_m mname o_cast_decl_ref_exp si false in
let poe_ei = make_general_expr_info qt_m `LValue `Ordinary in
PseudoObjectExpr(si, [opre; ove; ome], poe_ei)
Clang_ast_t.PseudoObjectExpr (si, [opre; ove; ome], poe_ei)
| _ -> assert false
let create_call stmt_info decl_pointer function_name qt parameters =
let expr_info_call = {
Clang_ast_t.ei_qual_type = create_void_type ();
Clang_ast_t.ei_value_kind = `XValue;
Clang_ast_t.ei_object_kind = `Ordinary
ei_value_kind = `XValue;
ei_object_kind = `Ordinary
} in
let expr_info_dre = make_expr_info_with_objc_kind qt `Ordinary in
let decl_ref = make_decl_ref_qt `Function decl_pointer function_name false qt in
let decl_ref_info = make_decl_ref_expr_info decl_ref in
let decl_ref_exp = DeclRefExpr(stmt_info, [], expr_info_dre, decl_ref_info) in
let decl_ref_exp = Clang_ast_t.DeclRefExpr (stmt_info, [], expr_info_dre, decl_ref_info) in
let cast = create_implicit_cast_expr (fresh_stmt_info stmt_info) [decl_ref_exp] qt `FunctionToPointerDecay in
CallExpr(stmt_info, cast:: parameters, expr_info_call)
Clang_ast_t.CallExpr (stmt_info, cast:: parameters, expr_info_call)
(* For a of type NSArray* Translate *)
(* [a enumerateObjectsUsingBlock:^(id object, NSUInteger idx, BOOL * stop) { *)
@ -472,18 +474,18 @@ let translate_block_enumerate block_name stmt_info stmt_list ei =
let rec get_name_pointers lp =
match lp with
| [] -> []
| ParmVarDecl(di, name, qt, _):: lp' ->
| Clang_ast_t.ParmVarDecl (di, name, qt, _) :: lp' ->
(name.Clang_ast_t.ni_name, di.Clang_ast_t.di_pointer, qt):: get_name_pointers lp'
| _ -> assert false in
let build_idx_decl pidx =
match pidx with
| ParmVarDecl(di_idx, name_idx, qt_idx, _) ->
| Clang_ast_t.ParmVarDecl (di_idx, name_idx, qt_idx, _) ->
let zero = create_integer_literal stmt_info "0" in
(* qt_idx idx = 0; *)
let idx_decl_stmt = make_DeclStmt (fresh_stmt_info stmt_info) di_idx qt_idx name_idx (Some zero) in
let idx_ei = make_expr_info qt_idx in
let idx_decl_ref = make_decl_ref_qt `Var di_idx.di_pointer name_idx.Clang_ast_t.ni_name false qt_idx in
let idx_decl_ref = make_decl_ref_qt `Var di_idx.Clang_ast_t.di_pointer name_idx.Clang_ast_t.ni_name false qt_idx in
let idx_drei = make_decl_ref_expr_info idx_decl_ref in
let idx_decl_ref_exp = make_decl_ref_exp stmt_info idx_ei idx_drei in
let idx_cast = create_implicit_cast_expr (fresh_stmt_info stmt_info) [idx_decl_ref_exp] qt_idx `LValueToRValue in
@ -499,12 +501,13 @@ let translate_block_enumerate block_name stmt_info stmt_list ei =
(* build statement BOOL *stop = malloc(sizeof(BOOL)); *)
let build_stop pstop =
match pstop with
| ParmVarDecl(di, name, qt, _) ->
| Clang_ast_t.ParmVarDecl (di, name, qt, _) ->
let qt_fun = create_void_unsigned_long_type () in
let parameter = UnaryExprOrTypeTraitExpr((fresh_stmt_info stmt_info), [],
let parameter = Clang_ast_t.UnaryExprOrTypeTraitExpr
((fresh_stmt_info stmt_info), [],
make_expr_info (create_unsigned_long_type ()),
{ Clang_ast_t.uttei_kind = `SizeOf; Clang_ast_t.uttei_qual_type = Some (create_BOOL_type ()) }) in
let malloc = create_call (fresh_stmt_info stmt_info) di.di_pointer CFrontend_config.malloc qt_fun [parameter] in
let malloc = create_call (fresh_stmt_info stmt_info) di.Clang_ast_t.di_pointer CFrontend_config.malloc qt_fun [parameter] in
let init_exp = create_implicit_cast_expr (fresh_stmt_info stmt_info) [malloc] qt `BitCast in
make_DeclStmt (fresh_stmt_info stmt_info) di qt name (Some init_exp)
| _ -> assert false in
@ -512,44 +515,49 @@ let translate_block_enumerate block_name stmt_info stmt_list ei =
(* BOOL *stop =NO; *)
let stop_equal_no pstop =
match pstop with
| ParmVarDecl(di, name, qt, _) ->
let decl_ref = make_decl_ref_qt `Var di.di_pointer name.Clang_ast_t.ni_name false qt in
| Clang_ast_t.ParmVarDecl (di, name, qt, _) ->
let decl_ref = make_decl_ref_qt `Var di.Clang_ast_t.di_pointer name.Clang_ast_t.ni_name false qt in
let cast = cast_expr decl_ref qt in
let lhs = UnaryOperator((fresh_stmt_info stmt_info), [cast], ei, { uoi_kind = `Deref; uoi_is_postfix = true }) in
let postfix_deref = { Clang_ast_t.uoi_kind = `Deref; uoi_is_postfix = true } in
let lhs = Clang_ast_t.UnaryOperator (fresh_stmt_info stmt_info, [cast], ei, postfix_deref) in
let bool_NO = make_ObjCBoolLiteralExpr stmt_info 0 in
BinaryOperator((fresh_stmt_info stmt_info), [lhs; bool_NO], ei, { boi_kind = `Assign })
let assign = { Clang_ast_t.boi_kind = `Assign } in
Clang_ast_t.BinaryOperator (fresh_stmt_info stmt_info, [lhs; bool_NO], ei, assign)
| _ -> assert false in
(* build statement free(stop); *)
let free_stop pstop =
match pstop with
| ParmVarDecl(di, name, qt, _) ->
| Clang_ast_t.ParmVarDecl (di, name, qt, _) ->
let qt_fun = create_void_void_type () in
let decl_ref = make_decl_ref_qt `Var di.di_pointer name.Clang_ast_t.ni_name false qt in
let decl_ref = make_decl_ref_qt `Var di.Clang_ast_t.di_pointer name.Clang_ast_t.ni_name false qt in
let cast = cast_expr decl_ref qt in
let parameter =
create_implicit_cast_expr (fresh_stmt_info stmt_info) [cast] (create_void_type ()) `BitCast in
create_call (fresh_stmt_info stmt_info) di.di_pointer CFrontend_config.free qt_fun [parameter]
create_call (fresh_stmt_info stmt_info) di.Clang_ast_t.di_pointer CFrontend_config.free qt_fun [parameter]
| _ -> assert false in
(* idx<a.count *)
let bin_op pidx array_decl_ref_exp =
let idx_decl_stmt, idx_decl_ref_exp, idx_cast, idx_qt = build_idx_decl pidx in
let rhs = build_PseudoObjectExpr idx_qt array_decl_ref_exp CFrontend_config.count in
BinaryOperator((fresh_stmt_info stmt_info), [idx_cast; rhs], make_expr_info (create_int_type ()), { boi_kind = `LT }) in
let lt = { Clang_ast_t.boi_kind = `LT } in
Clang_ast_t.BinaryOperator (fresh_stmt_info stmt_info, [idx_cast; rhs], make_expr_info (create_int_type ()), lt) in
(* idx++ *)
let un_op idx_decl_ref_expr qt_idx =
let idx_ei = make_expr_info qt_idx in
UnaryOperator((fresh_stmt_info stmt_info), [idx_decl_ref_expr], idx_ei, { uoi_kind = `PostInc; uoi_is_postfix = true }) in
let postinc = { Clang_ast_t.uoi_kind = `PostInc; uoi_is_postfix = true } in
Clang_ast_t.UnaryOperator (fresh_stmt_info stmt_info, [idx_decl_ref_expr], idx_ei, postinc) in
let get_ei_from_cast cast =
match cast with
| ImplicitCastExpr(_, _, ei, _) -> ei
| Clang_ast_t.ImplicitCastExpr (_, _, ei, _) -> ei
| _ -> assert false in
(* id object= objects[idx]; *)
let build_object_DeclStmt pobj decl_ref_expr_array decl_ref_expr_idx qt_idx =
let open Clang_ast_t in
match pobj with
| ParmVarDecl(di_obj, name_obj, qt_obj, _) ->
let poe_ei = make_general_expr_info qt_obj `LValue `Ordinary in
@ -557,15 +565,15 @@ let translate_block_enumerate block_name stmt_info stmt_list ei =
let ove_array = build_OpaqueValueExpr (fresh_stmt_info stmt_info) decl_ref_expr_array ei_array in
let ei_idx = get_ei_from_cast decl_ref_expr_idx in
let ove_idx = build_OpaqueValueExpr (fresh_stmt_info stmt_info) decl_ref_expr_idx ei_idx in
let objc_sre = ObjCSubscriptRefExpr((fresh_stmt_info stmt_info), [ove_array; ove_idx],
let objc_sre = ObjCSubscriptRefExpr (fresh_stmt_info stmt_info, [ove_array; ove_idx],
make_expr_info (pseudo_object_qt ()),
{ osrei_kind =`ArraySubscript; osrei_getter = None; osrei_setter = None; }) in
let obj_c_message_expr_info = make_obj_c_message_expr_info_instance CFrontend_config.object_at_indexed_subscript_m in
let ome = ObjCMessageExpr((fresh_stmt_info stmt_info), [ove_array; ove_idx], poe_ei, obj_c_message_expr_info) in
let pseudo_obj_expr = PseudoObjectExpr((fresh_stmt_info stmt_info), [objc_sre; ove_array; ove_idx; ome], poe_ei) in
let ome = ObjCMessageExpr (fresh_stmt_info stmt_info, [ove_array; ove_idx], poe_ei, obj_c_message_expr_info) in
let pseudo_obj_expr = PseudoObjectExpr (fresh_stmt_info stmt_info, [objc_sre; ove_array; ove_idx; ome], poe_ei) in
let vdi = { empty_var_decl_info with vdi_init_expr = Some (pseudo_obj_expr) } in
let var_decl = VarDecl(di_obj, name_obj, qt_obj, vdi) in
DeclStmt((fresh_stmt_info stmt_info), [pseudo_obj_expr], [var_decl])
let var_decl = VarDecl (di_obj, name_obj, qt_obj, vdi) in
DeclStmt (fresh_stmt_info stmt_info, [pseudo_obj_expr], [var_decl])
| _ -> assert false in
(* NSArray *objects = a *)
@ -573,47 +581,47 @@ let translate_block_enumerate block_name stmt_info stmt_list ei =
let di = { empty_decl_info with Clang_ast_t.di_pointer = Ast_utils.get_fresh_pointer () } in
let qt = create_qual_type CFrontend_config.ns_array_ptr in
(* init should be ImplicitCastExpr of array a *)
let vdi = { empty_var_decl_info with vdi_init_expr = Some (init) } in
let var_decl = VarDecl(di, make_name_decl CFrontend_config.objects, qt, vdi) in
DeclStmt((fresh_stmt_info stmt_info), [init], [var_decl]), [(CFrontend_config.objects, di.Clang_ast_t.di_pointer, qt)] in
let vdi = { empty_var_decl_info with Clang_ast_t.vdi_init_expr = Some (init) } in
let var_decl = Clang_ast_t.VarDecl (di, make_name_decl CFrontend_config.objects, qt, vdi) in
Clang_ast_t.DeclStmt (fresh_stmt_info stmt_info, [init], [var_decl]), [(CFrontend_config.objects, di.Clang_ast_t.di_pointer, qt)] in
let make_object_cast_decl_ref_expr objects =
match objects with
| DeclStmt(si, _, [VarDecl(di, name, qt, vdi)]) ->
let decl_ref = make_decl_ref_qt `Var si.si_pointer name.Clang_ast_t.ni_name false qt in
| Clang_ast_t.DeclStmt (si, _, [Clang_ast_t.VarDecl (di, name, qt, vdi)]) ->
let decl_ref = make_decl_ref_qt `Var si.Clang_ast_t.si_pointer name.Clang_ast_t.ni_name false qt in
cast_expr decl_ref qt
| _ -> assert false in
let build_cast_decl_ref_expr_from_parm p =
match p with
| ParmVarDecl(di, name, qt, _) ->
let decl_ref = make_decl_ref_qt `Var di.di_pointer name.Clang_ast_t.ni_name false qt in
| Clang_ast_t.ParmVarDecl (di, name, qt, _) ->
let decl_ref = make_decl_ref_qt `Var di.Clang_ast_t.di_pointer name.Clang_ast_t.ni_name false qt in
cast_expr decl_ref qt
| _ -> assert false in
let make_block_decl be =
match be with
| BlockExpr(bsi, _, bei, _) ->
| Clang_ast_t.BlockExpr (bsi, _, bei, _) ->
let di = { empty_decl_info with Clang_ast_t.di_pointer = Ast_utils.get_fresh_pointer () } in
let vdi = { empty_var_decl_info with vdi_init_expr = Some (be) } in
let var_decl = VarDecl(di, make_name_decl block_name, bei.Clang_ast_t.ei_qual_type, vdi) in
DeclStmt(bsi, [be], [var_decl]), [(block_name, di.Clang_ast_t.di_pointer, bei.Clang_ast_t.ei_qual_type)]
let vdi = { empty_var_decl_info with Clang_ast_t.vdi_init_expr = Some (be) } in
let var_decl = Clang_ast_t.VarDecl (di, make_name_decl block_name, bei.Clang_ast_t.ei_qual_type, vdi) in
Clang_ast_t.DeclStmt (bsi, [be], [var_decl]), [(block_name, di.Clang_ast_t.di_pointer, bei.Clang_ast_t.ei_qual_type)]
| _ -> assert false in
let make_block_call block_qt object_cast idx_cast stop_cast =
let decl_ref = make_decl_ref_invalid `Var block_name false block_qt in
let fun_cast = cast_expr decl_ref block_qt in
let ei_call = make_expr_info (create_void_type ()) in
CallExpr((fresh_stmt_info stmt_info), [fun_cast; object_cast; idx_cast; stop_cast], ei_call) in
Clang_ast_t.CallExpr (fresh_stmt_info stmt_info, [fun_cast; object_cast; idx_cast; stop_cast], ei_call) in
(* build statement "if (stop) break;" *)
let build_if_stop stop_cast =
let bool_qt = create_BOOL_type () in
let ei = make_expr_info bool_qt in
let unary_op = UnaryOperator((fresh_stmt_info stmt_info), [stop_cast], ei, { uoi_kind = `Deref; uoi_is_postfix = true }) in
let unary_op = Clang_ast_t.UnaryOperator (fresh_stmt_info stmt_info, [stop_cast], ei, { Clang_ast_t.uoi_kind = `Deref; uoi_is_postfix = true }) in
let cond = create_implicit_cast_expr (fresh_stmt_info stmt_info) [unary_op] bool_qt `LValueToRValue in
let break_stmt = BreakStmt((fresh_stmt_info stmt_info),[]) in
IfStmt((fresh_stmt_info stmt_info), [dummy_stmt (); cond; break_stmt; dummy_stmt ()]) in
let break_stmt = Clang_ast_t.BreakStmt (fresh_stmt_info stmt_info, []) in
Clang_ast_t.IfStmt (fresh_stmt_info stmt_info, [dummy_stmt (); cond; break_stmt; dummy_stmt ()]) in
let translate params array_cast_decl_ref_exp block_decl block_qt =
match params with
@ -632,37 +640,37 @@ let translate_block_enumerate block_name stmt_info stmt_list ei =
let if_stop = build_if_stop stop_cast in
let free_stop = free_stop pstop in
[ objects_decl; block_decl; decl_stop; assign_stop;
ForStmt(stmt_info, [idx_decl_stmt; dummy_stmt (); guard; incr;
CompoundStmt(stmt_info, [obj_assignment; call_block; if_stop])]); free_stop], op
Clang_ast_t.ForStmt (stmt_info, [idx_decl_stmt; dummy_stmt (); guard; incr;
Clang_ast_t.CompoundStmt(stmt_info, [obj_assignment; call_block; if_stop])]); free_stop], op
| _ -> assert false in
let open Clang_ast_t in
match stmt_list with
| [s; BlockExpr(_, _, bei, BlockDecl(_, _, _, bdi)) as be] ->
| [s; BlockExpr (_, _, bei, BlockDecl (_, _, _, bdi)) as be] ->
let block_decl, bv = make_block_decl be in
let vars_to_register = get_name_pointers bdi.Clang_ast_t.bdi_parameters in
let translated_stmt, op = translate bdi.Clang_ast_t.bdi_parameters s block_decl bei.Clang_ast_t.ei_qual_type in
CompoundStmt(stmt_info, translated_stmt), vars_to_register@op@bv
let vars_to_register = get_name_pointers bdi.bdi_parameters in
let translated_stmt, op = translate bdi.bdi_parameters s block_decl bei.ei_qual_type in
CompoundStmt (stmt_info, translated_stmt), vars_to_register @ op @ bv
| _ -> (* When it is not the method we expect with only one parameter, we don't translate *)
Printing.log_out "WARNING: Block Enumeration called at %s not translated." (Clang_ast_j.string_of_stmt_info stmt_info);
CompoundStmt(stmt_info, stmt_list), []
CompoundStmt (stmt_info, stmt_list), []
(* We translate the logical negation of an integer with a conditional*)
(* !x <=> x?0:1 *)
let trans_negation_with_conditional stmt_info expr_info stmt_list =
let stmt_list_cond = stmt_list @ [create_integer_literal stmt_info "0"] @ [create_integer_literal stmt_info "1"] in
ConditionalOperator(stmt_info, stmt_list_cond, expr_info)
Clang_ast_t.ConditionalOperator (stmt_info, stmt_list_cond, expr_info)
let create_call stmt_info decl_pointer function_name qt parameters =
let expr_info_call = {
Clang_ast_t.ei_qual_type = qt;
Clang_ast_t.ei_value_kind = `XValue;
Clang_ast_t.ei_object_kind = `Ordinary
ei_value_kind = `XValue;
ei_object_kind = `Ordinary
} in
let expr_info_dre = make_expr_info_with_objc_kind qt `Ordinary in
let decl_ref = make_decl_ref_qt `Function decl_pointer function_name false qt in
let decl_ref_info = make_decl_ref_expr_info decl_ref in
let decl_ref_exp = DeclRefExpr(stmt_info, [], expr_info_dre, decl_ref_info) in
CallExpr(stmt_info, decl_ref_exp:: parameters, expr_info_call)
let decl_ref_exp = Clang_ast_t.DeclRefExpr (stmt_info, [], expr_info_dre, decl_ref_info) in
Clang_ast_t.CallExpr (stmt_info, decl_ref_exp:: parameters, expr_info_call)
let create_assume_not_null_call decl_info var_name var_type =
let stmt_info = stmt_info_with_fresh_pointer (make_stmt_info decl_info) in
@ -671,15 +679,15 @@ let create_assume_not_null_call decl_info var_name var_type =
let decl_ref = make_decl_ref_qt `Var decl_ptr var_name false var_type in
let stmt_info_var = dummy_stmt_info () in
let decl_ref_info = make_decl_ref_expr_info decl_ref in
let var_decl_ref = DeclRefExpr(stmt_info_var, [], (make_expr_info var_type), decl_ref_info) in
let var_decl_ref = Clang_ast_t.DeclRefExpr (stmt_info_var, [], (make_expr_info var_type), decl_ref_info) in
let var_decl_ptr = Ast_utils.get_invalid_pointer () in
let expr_info = {
Clang_ast_t.ei_qual_type = var_type;
Clang_ast_t.ei_value_kind = `RValue;
Clang_ast_t.ei_object_kind = `Ordinary
ei_value_kind = `RValue;
ei_object_kind = `Ordinary
} in
let cast_info_call = { cei_cast_kind = `LValueToRValue; cei_base_path = [] } in
let decl_ref_exp_cast = ImplicitCastExpr(stmt_info, [var_decl_ref], expr_info, cast_info_call) in
let cast_info_call = { Clang_ast_t.cei_cast_kind = `LValueToRValue; cei_base_path = [] } in
let decl_ref_exp_cast = Clang_ast_t.ImplicitCastExpr (stmt_info, [var_decl_ref], expr_info, cast_info_call) in
let null_expr = create_integer_literal stmt_info "0" in
let bin_op = make_binary_stmt decl_ref_exp_cast null_expr stmt_info (make_lvalue_obc_prop_expr_info var_type) boi in
let parameters = [bin_op] in

@ -12,14 +12,15 @@
w.r.t. the previous one. This module processes the AST and makes locations explicit. *)
open Utils
open Clang_ast_j
module L = Logging
module F = Format
(** Get the sub-declarations of the current declaration. *)
let decl_get_sub_decls decl = match decl with
let decl_get_sub_decls decl =
let open Clang_ast_t in
match decl with
| CXXRecordDecl (_, _, _, _, decl_list, _, _, _)
| RecordDecl (_, _, _, _, decl_list, _, _)
| ObjCInterfaceDecl (_, _, decl_list, _, _)
@ -36,7 +37,9 @@ let decl_get_sub_decls decl = match decl with
(** Set the sub-declarations of the current declaration. *)
let decl_set_sub_decls decl decl_list' = match decl with
let decl_set_sub_decls decl decl_list' =
let open Clang_ast_t in
match decl with
| CXXRecordDecl (decl_info, name, opt_type, type_ptr, decl_list, decl_context_info, record_decl_info, cxx_record_info) ->
CXXRecordDecl (decl_info, name, opt_type, type_ptr, decl_list', decl_context_info, record_decl_info, cxx_record_info)
| RecordDecl (decl_info, name, opt_type, type_ptr, decl_list, decl_context_info, record_decl_info) ->
@ -63,13 +66,13 @@ let decl_set_sub_decls decl decl_list' = match decl with
(** Pretty print a source location. *)
let pp_source_loc fmt source_loc =
let file = match source_loc.sl_file with
let file = match source_loc.Clang_ast_t.sl_file with
| Some file -> file
| None -> "None" in
let line = match source_loc.sl_line with
let line = match source_loc.Clang_ast_t.sl_line with
| Some n -> string_of_int n
| None -> "None" in
let column = match source_loc.sl_column with
let column = match source_loc.Clang_ast_t.sl_column with
| Some n -> string_of_int n
| None -> "None" in
if file = "None" && line = "None" && column = "None"
@ -89,16 +92,17 @@ let pp_ast_decl fmt ast_decl =
let stmt_str = Clang_ast_proj.get_stmt_kind_string stmt in
let stmt_info, stmt_list = Clang_ast_proj.get_stmt_tuple stmt in
let decl_list = match stmt with
| DeclStmt (_, _, decl_list) -> decl_list
| Clang_ast_t.DeclStmt (_, _, decl_list) -> decl_list
| _ -> [] in
F.fprintf fmt "%s%s %a@\n"
prefix
stmt_str
pp_source_range stmt_info.si_source_range;
pp_source_range stmt_info.Clang_ast_t.si_source_range;
list_iter (dump_stmt prefix1) stmt_list;
list_iter (dump_decl prefix1) decl_list
and dump_decl prefix decl =
let prefix1 = prefix ^ " " in
let open Clang_ast_t in
match decl with
| FunctionDecl (decl_info, name, qt, fdecl_info) ->
F.fprintf fmt "%sFunctionDecl %s %a@\n"
@ -131,7 +135,7 @@ let pp_ast_decl fmt ast_decl =
let decl_str = Clang_ast_proj.get_decl_kind_string ast_decl in
match ast_decl with
| TranslationUnitDecl (_, decl_list, _, _) ->
| Clang_ast_t.TranslationUnitDecl (_, decl_list, _, _) ->
F.fprintf fmt "%s (%d declarations)@\n" decl_str (list_length decl_list);
list_iter (dump_decl "") decl_list
| _ ->
@ -147,17 +151,17 @@ module LocComposer : sig
val create : unit -> status
(** Compose a new source_range to the current one. *)
val compose : status -> source_range -> source_range
val compose : status -> Clang_ast_t.source_range -> Clang_ast_t.source_range
(** Set the current file if specified in the source_range.
The composer will not descend into file included from the current one.
For locations in included files, it will return instead the last known
location of the current file. *)
val set_current_file : status -> source_range -> unit
val set_current_file : status -> Clang_ast_t.source_range -> unit
end = struct
type status =
{ mutable curr_file: string option;
mutable curr_source_range: source_range;
mutable curr_source_range: Clang_ast_t.source_range;
mutable in_curr_file : bool }
let empty_sloc = { Clang_ast_t.sl_file = None; sl_line = None; sl_column = None }
@ -168,7 +172,7 @@ end = struct
in_curr_file = true; }
let set_current_file st (sloc1, sloc2) =
match sloc1.sl_file, sloc2.sl_file with
match sloc1.Clang_ast_t.sl_file, sloc2.Clang_ast_t.sl_file with
| _, Some fname
| Some fname, None ->
st.curr_file <- Some fname;
@ -176,7 +180,7 @@ end = struct
| _ ->
()
let sloc_is_current_file st sloc = match st.curr_file, sloc.sl_file with
let sloc_is_current_file st sloc = match st.curr_file, sloc.Clang_ast_t.sl_file with
| Some curr_f, Some f ->
Some (f = curr_f)
| None, _ -> None
@ -195,6 +199,7 @@ end = struct
then
let update x_opt y_opt =
if y_opt <> None then y_opt else x_opt in
let open Clang_ast_t in
{ sl_file = update old_sloc.sl_file new_sloc.sl_file;
sl_line = update old_sloc.sl_line new_sloc.sl_line;
sl_column = update old_sloc.sl_column new_sloc.sl_column }
@ -220,11 +225,13 @@ end
(** Apply a location composer to the locations in a statement. *)
let rec stmt_process_locs loc_composer stmt =
let update (stmt_info, stmt_list) =
let range' = LocComposer.compose loc_composer stmt_info.Clang_ast_t.si_source_range in
let stmt_info' =
{ stmt_info with
si_source_range = LocComposer.compose loc_composer stmt_info.si_source_range } in
Clang_ast_t.si_source_range = range' } in
let stmt_list' = list_map (stmt_process_locs loc_composer) stmt_list in
(stmt_info', stmt_list') in
let open Clang_ast_t in
match Clang_ast_proj.update_stmt_tuple update stmt with
| DeclStmt (stmt_info, stmt_list, decl_list) ->
let decl_list' = list_map (decl_process_locs loc_composer) decl_list in
@ -236,12 +243,14 @@ let rec stmt_process_locs loc_composer stmt =
and decl_process_locs loc_composer decl =
let decl' =
let update decl_info =
let range' = LocComposer.compose loc_composer decl_info.Clang_ast_t.di_source_range in
{ decl_info with
di_source_range = LocComposer.compose loc_composer decl_info.di_source_range } in
Clang_ast_t.di_source_range = range' } in
let decl_list = decl_get_sub_decls decl in
let decl1 = Clang_ast_proj.update_decl_tuple update decl in
let decl_list' = list_map (decl_process_locs loc_composer) decl_list in
decl_set_sub_decls decl1 decl_list' in
let open Clang_ast_t in
let get_updated_fun_decl (decl_info', name, qt, fdecl_info) =
let fdi_decls_in_prototype_scope' =
list_map (decl_process_locs loc_composer) fdecl_info.fdi_decls_in_prototype_scope in
@ -280,13 +289,13 @@ let ast_decl_process_locs loc_composer ast_decl =
let toplevel_decl_process_locs decl =
let decl_info = Clang_ast_proj.get_decl_tuple decl in
LocComposer.set_current_file loc_composer decl_info.di_source_range;
LocComposer.set_current_file loc_composer decl_info.Clang_ast_t.di_source_range;
decl_process_locs loc_composer decl in
match ast_decl with
| TranslationUnitDecl (decl_info, decl_list, decl_context_info, type_list) ->
| Clang_ast_t.TranslationUnitDecl (decl_info, decl_list, decl_context_info, type_list) ->
let decl_list' = list_map toplevel_decl_process_locs decl_list in
TranslationUnitDecl (decl_info, decl_list', decl_context_info, type_list)
Clang_ast_t.TranslationUnitDecl (decl_info, decl_list', decl_context_info, type_list)
| _ ->
assert false

@ -76,4 +76,3 @@ val create_context : Sil.tenv -> Cg.t -> Cfg.cfg -> Cfg.Procdesc.t ->
string option -> curr_class -> bool -> (Mangled.t * Sil.typ * bool) list -> bool -> t
val create_curr_class : Sil.tenv -> string -> curr_class

@ -11,7 +11,6 @@
(** translating the code and adding it to a fake procdesc *)
open CFrontend_utils
open Clang_ast_t
let create_empty_procdesc () =
let procname = Procname.from_string_c_fun "__INFER_$GLOBAL_VAR_env" in
@ -49,7 +48,7 @@ let global_procdesc = ref (create_empty_procdesc ())
let rec get_enum_constants context decl_list v =
match decl_list with
| [] -> []
| EnumConstantDecl(decl_info, name_info, qual_type, enum_constant_decl_info) :: decl_list' ->
| Clang_ast_t.EnumConstantDecl (decl_info, name_info, qual_type, enum_constant_decl_info) :: decl_list' ->
let name = name_info.Clang_ast_t.ni_name in
(match enum_constant_decl_info.Clang_ast_t.ecdi_init_expr with
| None -> Printing.log_out "%s" (" ...Defining Enum Constant ("^name^", "^(string_of_int v));

@ -11,8 +11,6 @@
open Utils
open CFrontend_utils
open CFrontend_utils.General_utils
open Clang_ast_t
module L = Logging
@ -24,7 +22,7 @@ let rec get_fields_super_classes tenv super_class =
| None -> []
| Some Sil.Tstruct (fields, _, _, _, (Sil.Class, sc):: _, _, _) ->
let sc_fields = get_fields_super_classes tenv (Sil.TN_csu (Sil.Class, sc)) in
append_no_duplicates_fields fields sc_fields
General_utils.append_no_duplicates_fields fields sc_fields
| Some Sil.Tstruct (fields, _, _, _, _, _, _) -> fields
| Some _ -> []
@ -55,7 +53,7 @@ let build_sil_field tenv class_name field_name qual_type prop_atts =
| Sil.Tptr (_, Sil.Pk_objc_weak) -> [Config.weak]
| Sil.Tptr (_, Sil.Pk_objc_unsafe_unretained) -> [Config.unsafe_unret]
| _ -> [] in
let fname = mk_class_field_name class_name field_name in
let fname = General_utils.mk_class_field_name class_name field_name in
let typ = CTypes_decl.qual_type_to_sil_type tenv qual_type in
let item_annotations = match prop_atts with
| [] ->
@ -90,28 +88,25 @@ let build_sil_field_property curr_class tenv field_name qual_type prop_attribute
(* Given a list of declarations in an interface returns a list of fields *)
let rec get_fields tenv curr_class decl_list =
let open Clang_ast_t in
match decl_list with
| [] -> []
| ObjCIvarDecl(decl_info, name_info, qual_type, field_decl_info, obj_c_ivar_decl_info) :: decl_list' ->
| ObjCIvarDecl (decl_info, name_info, qual_type, field_decl_info, obj_c_ivar_decl_info) :: decl_list' ->
let fields = get_fields tenv curr_class decl_list' in
let field_name = name_info.Clang_ast_t.ni_name in
(* Doing a post visit here. Adding Ivar after all the declaration have been visited so that *)
(* ivar names will be added in the property list. *)
Printing.log_out " ...Adding Instance Variable '%s' @." field_name;
let (fname, typ, ia) = build_sil_field_property curr_class tenv field_name qual_type None in
Printing.log_out " ...Resulting sil field: (%s) with attributes:@." ((Ident.fieldname_to_string fname) ^":"^(Sil.typ_to_string typ));
list_iter (fun (ia', _) ->
list_iter (fun a -> Printing.log_out " '%s'@." a) ia'.Sil.parameters) ia;
(fname, typ, ia):: fields
| ObjCPropertyImplDecl(decl_info, property_impl_decl_info):: decl_list' ->
| ObjCPropertyImplDecl (decl_info, property_impl_decl_info):: decl_list' ->
let property_fields_decl =
ObjcProperty_decl.prepare_dynamic_property curr_class decl_info property_impl_decl_info in
get_fields tenv curr_class (property_fields_decl @ decl_list')
| (d : Clang_ast_t.decl):: decl_list' ->
get_fields tenv curr_class decl_list'
| _ :: decl_list' -> get_fields tenv curr_class decl_list'
(* Add potential extra fields defined only in the implementation of the class *)
(* to the info given in the interface. Update the tenv accordingly. *)
@ -120,7 +115,7 @@ let add_missing_fields tenv class_name fields =
let class_tn_name = Sil.TN_csu (Sil.Class, mang_name) in
match Sil.tenv_lookup tenv class_tn_name with
| Some Sil.Tstruct(intf_fields, _, _, _, superclass, methods, annotation) ->
let new_fields = append_no_duplicates_fields fields intf_fields in
let new_fields = General_utils.append_no_duplicates_fields fields intf_fields in
let new_fields = CFrontend_utils.General_utils.sort_fields new_fields in
let class_type_info =
Sil.Tstruct (

@ -18,7 +18,6 @@ module L = Logging
open Utils
open CFrontend_utils
open CGen_trans
open Clang_ast_t
(* Translate one global declaration *)
let rec translate_one_declaration tenv cg cfg namespace parent_dec dec =
@ -27,6 +26,7 @@ let rec translate_one_declaration tenv cg cfg namespace parent_dec dec =
CLocation.update_curr_file info;
let source_range = info.Clang_ast_t.di_source_range in
let should_translate_enum = CLocation.should_translate_enum source_range in
let open Clang_ast_t in
match dec with
| FunctionDecl(di, name_info, qt, fdecl_info) ->
CMethod_declImpl.function_decl tenv cfg cg namespace dec None CContext.ContextNoCls

@ -11,7 +11,6 @@
(** for transformations of ast nodes and general utility functions such as functions on lists *)
open Utils
open Clang_ast_t
module L = Logging
module F = Format
@ -130,10 +129,11 @@ struct
"<\"" ^ name ^ "\"> '" ^ info.Clang_ast_t.si_pointer ^ "'"
let get_stmts_from_stmt stmt =
let open Clang_ast_t in
match stmt with
| OpaqueValueExpr(_, lstmt, _, opaque_value_expr_info) ->
| OpaqueValueExpr (_, lstmt, _, opaque_value_expr_info) ->
(match opaque_value_expr_info.Clang_ast_t.ovei_source_expr with
| Some stmt -> lstmt@[stmt]
| Some stmt -> lstmt @ [stmt]
| _ -> lstmt)
(* given that this has not been translated, looking up for variables *)
(* inside leads to inconsistencies *)
@ -249,7 +249,7 @@ struct
CFrontend_config.pointer_prefix^("INVALID")
let type_from_unary_expr_or_type_trait_expr_info info =
match info.uttei_qual_type with
match info.Clang_ast_t.uttei_qual_type with
| Some qt -> Some qt
| None -> None

@ -9,7 +9,6 @@
(** 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 *)
open Clang_ast_t
module Printing :
sig
@ -49,15 +48,15 @@ sig
val property_name : Clang_ast_t.obj_c_property_impl_decl_info -> string
val property_attribute_compare : property_attribute -> property_attribute -> int
val property_attribute_compare : Clang_ast_t.property_attribute -> Clang_ast_t.property_attribute -> int
val generated_ivar_name : string -> string
val property_attribute_eq : property_attribute -> property_attribute -> bool
val property_attribute_eq : Clang_ast_t.property_attribute -> Clang_ast_t.property_attribute -> bool
val getter_attribute_opt : property_attribute list -> string option
val getter_attribute_opt : Clang_ast_t.property_attribute list -> string option
val setter_attribute_opt : property_attribute list -> string option
val setter_attribute_opt : Clang_ast_t.property_attribute list -> string option
val get_memory_management_attributes : unit -> Clang_ast_t.property_attribute list

@ -13,8 +13,6 @@
module L = Logging
open Clang_ast_j
open CFrontend_config
open CFrontend_utils
let arg_desc =
@ -27,7 +25,7 @@ let arg_desc =
(filter Utils.base_arg_desc) @
[
"-c",
Arg.String (fun cfile -> source_file := Some cfile),
Arg.String (fun cfile -> CFrontend_config.source_file := Some cfile),
Some "cfile",
"C File to translate";
"-x",
@ -35,7 +33,7 @@ let arg_desc =
Some "cfile",
"Language (c, objective-c, c++, objc-++)";
"-ast",
Arg.String (fun file -> ast_file := Some file),
Arg.String (fun file -> CFrontend_config.ast_file := Some file),
Some "file",
"AST file for the translation";
"-dotty_cfg_libs",
@ -121,11 +119,11 @@ let do_run source_path ast_path =
raise exc
let _ =
Config.print_types:= true;
if Option.is_none !source_file then
Config.print_types := true;
if Option.is_none !CFrontend_config.source_file then
(Printing.log_err "Incorrect command line arguments\n";
print_usage_exit ())
else
match !source_file with
| Some path -> do_run path !ast_file
match !CFrontend_config.source_file with
| Some path -> do_run path !CFrontend_config.ast_file
| None -> assert false

@ -11,8 +11,6 @@
open Utils
open CFrontend_utils
open Clang_ast_t
open CContext
module L = Logging
@ -46,7 +44,7 @@ struct
| decl:: rest ->
let rest_assume_calls = add_assume_not_null_calls rest attributes in
(match decl with
| ParmVarDecl(decl_info, name_info, qtype, var_decl_info)
| Clang_ast_t.ParmVarDecl(decl_info, name_info, qtype, var_decl_info)
when CFrontend_utils.Ast_utils.is_type_nonnull qtype attributes ->
let name = name_info.Clang_ast_t.ni_name in
let assume_call = Ast_expressions.create_assume_not_null_call decl_info name qtype in
@ -129,6 +127,7 @@ struct
| None -> ()
let rec process_one_method_decl tenv cg cfg curr_class namespace dec =
let open Clang_ast_t in
match dec with
| CXXMethodDecl _ ->
process_method_decl tenv cg cfg namespace curr_class dec ~is_objc:false
@ -150,6 +149,7 @@ struct
let process_getter_setter context procname =
let class_name = Procname.c_get_class procname in
let open CContext in
let cls = CContext.create_curr_class context.tenv class_name in
let method_name = Procname.c_get_method procname in
match ObjcProperty_decl.method_is_property_accesor cls method_name with

@ -12,8 +12,6 @@
open Utils
open CFrontend_utils
open CContext
open Clang_ast_t
module L = Logging
@ -59,11 +57,11 @@ let get_param_decls function_method_decl_info =
let get_parameters function_method_decl_info =
let par_to_ms_par par =
match par with
| ParmVarDecl(decl_info, name_info, qtype, var_decl_info) ->
| Clang_ast_t.ParmVarDecl (decl_info, name_info, qtype, var_decl_info) ->
let name = name_info.Clang_ast_t.ni_name in
Printing.log_out "Adding param '%s' " name;
Printing.log_out "with pointer %s@." decl_info.Clang_ast_t.di_pointer;
(name, CTypes.get_type qtype, var_decl_info.vdi_init_expr)
(name, CTypes.get_type qtype, var_decl_info.Clang_ast_t.vdi_init_expr)
| _ -> assert false in
let pars = list_map par_to_ms_par (get_param_decls function_method_decl_info) in
@ -87,14 +85,15 @@ let build_method_signature decl_info procname function_method_decl_info is_insta
CMethod_signature.make_ms procname parameters qt attributes source_range is_instance_method is_generated
let method_signature_of_decl curr_class meth_decl block_data_opt =
let open Clang_ast_t in
match meth_decl, block_data_opt with
| FunctionDecl(decl_info, name_info, qt, fdi), _ ->
let name = name_info.Clang_ast_t.ni_name in
| FunctionDecl (decl_info, name_info, qt, fdi), _ ->
let name = name_info.ni_name in
let func_decl = Func_decl_info (fdi, CTypes.get_type qt) in
let procname = General_utils.mk_procname_from_function name (CTypes.get_type qt) in
let ms = build_method_signature decl_info procname func_decl false false false in
ms, fdi.Clang_ast_t.fdi_body, fdi.Clang_ast_t.fdi_parameters
| CXXMethodDecl(decl_info, name_info, qt, fdi), _ ->
| CXXMethodDecl (decl_info, name_info, qt, fdi), _ ->
let class_name = CContext.get_curr_class_name curr_class in
let method_name = name_info.Clang_ast_t.ni_name in
let typ = CTypes.get_type qt in
@ -102,20 +101,21 @@ let method_signature_of_decl curr_class meth_decl block_data_opt =
let method_decl = Cpp_Meth_decl_info (fdi, class_name, typ) in
let ms = build_method_signature decl_info procname method_decl false false false in
ms, fdi.Clang_ast_t.fdi_body, fdi.Clang_ast_t.fdi_parameters
| ObjCMethodDecl(decl_info, name_info, mdi), _ ->
| ObjCMethodDecl (decl_info, name_info, mdi), _ ->
let class_name = CContext.get_curr_class_name curr_class in
let method_name = name_info.Clang_ast_t.ni_name in
let is_instance = mdi.Clang_ast_t.omdi_is_instance_method in
let method_name = name_info.ni_name in
let is_instance = mdi.omdi_is_instance_method in
let method_kind = Procname.objc_method_kind_of_bool is_instance in
let procname = General_utils.mk_procname_from_objc_method class_name method_name method_kind in
let method_decl = ObjC_Meth_decl_info (mdi, class_name) in
let is_generated = Ast_utils.is_generated name_info in
let ms = build_method_signature decl_info procname method_decl false false is_generated in
ms, mdi.Clang_ast_t.omdi_body, mdi.Clang_ast_t.omdi_parameters
| BlockDecl(decl_info, decl_list, decl_context_info, bdi), Some (qt, is_instance, procname, _) ->
ms, mdi.omdi_body, mdi.omdi_parameters
| BlockDecl (decl_info, decl_list, decl_context_info, bdi),
Some (qt, is_instance, procname, _) ->
let func_decl = Block_decl_info (bdi, CTypes.get_type qt) in
let ms = build_method_signature decl_info procname func_decl is_instance true false in
ms, bdi.Clang_ast_t.bdi_body, bdi.Clang_ast_t.bdi_parameters
ms, bdi.bdi_body, bdi.bdi_parameters
|_ -> assert false
let get_superclass_curr_class context =
@ -187,12 +187,12 @@ let captured_vars_from_block_info context cvl =
(match dr.Clang_ast_t.dr_name, dr.Clang_ast_t.dr_qual_type with
| Some name_info, _ ->
let n = name_info.Clang_ast_t.ni_name in
if n = CFrontend_config.self && not context.is_instance then []
if n = CFrontend_config.self && not context.CContext.is_instance then []
else
(let procdesc_formals = Cfg.Procdesc.get_formals context.procdesc in
(let procdesc_formals = Cfg.Procdesc.get_formals context.CContext.procdesc in
(Printing.log_err "formals are %s@." (Utils.list_to_string (fun (x, _) -> x) procdesc_formals));
let formals = list_map formal2captured procdesc_formals in
[find (context.local_vars @ formals) n])
[find (context.CContext.local_vars @ formals) n])
| _ -> assert false)
| None -> []) :: f cvl'' in
list_flatten (f cvl)

File diff suppressed because it is too large Load Diff

@ -9,9 +9,7 @@
open Utils
open CFrontend_utils
open Clang_ast_t
open Objc_models
open CFrontend_config
let is_cf_non_null_alloc funct =
match funct with
@ -38,8 +36,8 @@ let is_alloc_model typ funct =
let rec get_func_type_from_stmt stmt =
match stmt with
| DeclRefExpr(stmt_info, stmt_list, expr_info, decl_ref_expr_info) ->
Some expr_info.ei_qual_type
| Clang_ast_t.DeclRefExpr(stmt_info, stmt_list, expr_info, decl_ref_expr_info) ->
Some expr_info.Clang_ast_t.ei_qual_type
| _ ->
match CFrontend_utils.Ast_utils.get_stmts_from_stmt stmt with
| stmt:: rest -> get_func_type_from_stmt stmt
@ -134,29 +132,34 @@ let get_predefined_ms_method condition class_name method_name method_kind mk_pro
else None
let get_predefined_ms_stringWithUTF8String class_name method_name mk_procname =
let condition = class_name = nsstring_cl && method_name = string_with_utf8_m in
let condition =
class_name = CFrontend_config.nsstring_cl
&& method_name = CFrontend_config.string_with_utf8_m in
get_predefined_ms_method condition class_name method_name Procname.Class_objc_method
mk_procname [("x", "char *", None)] id_cl [] None
mk_procname [("x", "char *", None)] CFrontend_config.id_cl [] None
let get_predefined_ms_retain_release class_name method_name mk_procname =
let condition = is_retain_or_release method_name in
let return_type =
if is_retain_method method_name || is_autorelease_method method_name
then id_cl else void in
get_predefined_ms_method condition nsobject_cl method_name Procname.Instance_objc_method
mk_procname [(self, class_name, None)] return_type [] (get_builtinname method_name)
then CFrontend_config.id_cl else CFrontend_config.void in
get_predefined_ms_method condition CFrontend_config.nsobject_cl method_name Procname.Instance_objc_method
mk_procname [(CFrontend_config.self, class_name, None)] return_type [] (get_builtinname method_name)
let get_predefined_ms_autoreleasepool_init class_name method_name mk_procname =
let condition = (method_name = init) && (class_name = nsautorelease_pool_cl) in
let condition =
method_name = CFrontend_config.init
&& class_name = CFrontend_config.nsautorelease_pool_cl in
get_predefined_ms_method condition class_name method_name Procname.Instance_objc_method
mk_procname [(self, class_name, None)] void [] None
mk_procname [(CFrontend_config.self, class_name, None)] CFrontend_config.void [] None
let get_predefined_ms_nsautoreleasepool_release class_name method_name mk_procname =
let condition = (method_name = release || method_name = drain) &&
(class_name = nsautorelease_pool_cl) in
let condition =
(method_name = CFrontend_config.release || method_name = CFrontend_config.drain)
&& class_name = CFrontend_config.nsautorelease_pool_cl in
get_predefined_ms_method condition class_name method_name Procname.Instance_objc_method
mk_procname [(self, class_name, None)]
void [] (Some SymExec.ModelBuiltins.__objc_release_autorelease_pool)
mk_procname [(CFrontend_config.self, class_name, None)]
CFrontend_config.void [] (Some SymExec.ModelBuiltins.__objc_release_autorelease_pool)
let get_predefined_model_method_signature class_name method_name mk_procname =
match get_predefined_ms_nsautoreleasepool_release class_name method_name mk_procname with

@ -11,8 +11,6 @@
open Utils
open CFrontend_utils
open CContext
open Clang_ast_t
module L = Logging
@ -279,7 +277,7 @@ let create_alloc_instrs context sil_loc function_type fname =
| Sil.Tptr (styp, Sil.Pk_objc_weak)
| Sil.Tptr (styp, Sil.Pk_objc_unsafe_unretained)
| Sil.Tptr (styp, Sil.Pk_objc_autoreleasing) ->
function_type, CTypes_decl.expand_structured_type context.tenv styp
function_type, CTypes_decl.expand_structured_type context.CContext.tenv styp
| _ -> Sil.Tptr (function_type, Sil.Pk_pointer), function_type in
let sizeof_exp = Sil.Sizeof (function_type_np, Sil.Subtype.exact) in
let exp = (sizeof_exp, function_type) in
@ -306,7 +304,7 @@ let objc_new_trans trans_state loc stmt_info cls_name function_type =
let is_instance = true in
let call_flags = { Sil.cf_virtual = is_instance; Sil.cf_noreturn = false; Sil.cf_is_objc_block = false; } in
let pname = General_utils.mk_procname_from_objc_method cls_name CFrontend_config.init Procname.Instance_objc_method in
CMethod_trans.create_external_procdesc trans_state.context.cfg pname is_instance None;
CMethod_trans.create_external_procdesc trans_state.context.CContext.cfg pname is_instance None;
let args = [(Sil.Var alloc_ret_id, alloc_ret_type)] in
let init_stmt_call = Sil.Call([init_ret_id], (Sil.Const (Sil.Cfun pname)), args, loc, call_flags) in
let instrs = [alloc_stmt_call; init_stmt_call] in
@ -317,7 +315,7 @@ let objc_new_trans trans_state loc stmt_info cls_name function_type =
{ res_trans with exps = [(Sil.Var init_ret_id, alloc_ret_type)]}
let new_or_alloc_trans trans_state loc stmt_info class_name selector =
let function_type = CTypes_decl.type_name_to_sil_type trans_state.context.tenv class_name in
let function_type = CTypes_decl.type_name_to_sil_type trans_state.context.CContext.tenv class_name in
if selector = CFrontend_config.alloc then
alloc_trans trans_state loc stmt_info function_type true
else if selector = CFrontend_config.new_str then
@ -335,7 +333,7 @@ let cpp_new_trans trans_state sil_loc stmt_info function_type =
let create_cast_instrs context exp cast_from_typ cast_to_typ sil_loc =
let ret_id = Ident.create_fresh Ident.knormal in
let cast_typ_no_pointer =
CTypes_decl.expand_structured_type context.tenv (CTypes.remove_pointer_to_typ cast_to_typ) in
CTypes_decl.expand_structured_type context.CContext.tenv (CTypes.remove_pointer_to_typ cast_to_typ) in
let sizeof_exp = Sil.Sizeof (cast_typ_no_pointer, Sil.Subtype.exact) in
let pname = SymExec.ModelBuiltins.__objc_cast in
let args = [(exp, cast_from_typ); (sizeof_exp, Sil.Tvoid)] in
@ -490,12 +488,12 @@ let extract_item_from_option op warning_string =
let is_member_exp stmt =
match stmt with
| MemberExpr _ -> true
| Clang_ast_t.MemberExpr _ -> true
| _ -> false
let is_enumeration_constant stmt =
match stmt with
| DeclRefExpr(_, _, _, drei) ->
| Clang_ast_t.DeclRefExpr(_, _, _, drei) ->
(match drei.Clang_ast_t.drti_decl_ref with
| Some d -> (match d.Clang_ast_t.dr_kind with
| `EnumConstant -> true
@ -505,7 +503,7 @@ let is_enumeration_constant stmt =
let is_null_stmt s =
match s with
| NullStmt _ -> true
| Clang_ast_t.NullStmt _ -> true
| _ -> false
let dummy_id () =
@ -524,6 +522,7 @@ let rec get_type_from_exp_stmt stmt =
| Some n -> n
| _ -> assert false )
| _ -> assert false in
let open Clang_ast_t in
match stmt with
| CXXOperatorCallExpr(_, _, ei)
| CallExpr(_, _, ei) -> ei.Clang_ast_t.ei_qual_type
@ -551,7 +550,7 @@ struct
if is_superinstance mei then
let typ, self_expr, id, ins =
let t' = CTypes.add_pointer_to_typ
(CTypes_decl.get_type_curr_class context.tenv context.curr_class) in
(CTypes_decl.get_type_curr_class context.CContext.tenv context.CContext.curr_class) in
let e = Sil.Lvar (Sil.mk_pvar (Mangled.from_string CFrontend_config.self) procname) in
let id = Ident.create_fresh Ident.knormal in
t', Sil.Var id, [id], [Sil.Letderef (id, e, t', loc)] in
@ -600,7 +599,7 @@ let is_owning_name n =
let rec is_owning_method s =
match s with
| ObjCMessageExpr(_, _ , _, mei) ->
| Clang_ast_t.ObjCMessageExpr(_, _ , _, mei) ->
is_owning_name mei.Clang_ast_t.omei_selector
| _ -> (match snd (Clang_ast_proj.get_stmt_tuple s) with
| [] -> false
@ -608,14 +607,14 @@ let rec is_owning_method s =
let rec is_method_call s =
match s with
| ObjCMessageExpr(_, _ , _, mei) -> true
| Clang_ast_t.ObjCMessageExpr (_, _ , _, mei) -> true
| _ -> (match snd (Clang_ast_proj.get_stmt_tuple s) with
| [] -> false
| s'':: _ -> is_method_call s'')
let rec get_decl_ref_info s parent_line_number =
match s with
| DeclRefExpr (stmt_info, stmt_list, expr_info, decl_ref_expr_info) ->
| Clang_ast_t.DeclRefExpr (stmt_info, stmt_list, expr_info, decl_ref_expr_info) ->
let line_number = CLocation.get_line stmt_info parent_line_number in
stmt_info.Clang_ast_t.si_pointer, line_number
| _ -> (match Clang_ast_proj.get_stmt_tuple s with
@ -626,18 +625,18 @@ let rec get_decl_ref_info s parent_line_number =
let rec contains_opaque_value_expr s =
match s with
| OpaqueValueExpr (_, _, _, _) -> true
| _ -> (match snd (Clang_ast_proj.get_stmt_tuple s) with
| Clang_ast_t.OpaqueValueExpr _ -> true
| _ -> match snd (Clang_ast_proj.get_stmt_tuple s) with
| [] -> false
| s'':: _ -> contains_opaque_value_expr s'')
| s'':: _ -> contains_opaque_value_expr s''
let rec compute_autorelease_pool_vars context stmts =
match stmts with
| [] -> []
| DeclRefExpr(si, sl, ei, drei):: stmts' ->
| Clang_ast_t.DeclRefExpr (si, sl, ei, drei):: stmts' ->
let name = get_name_decl_ref_exp_info drei si in
let procname = Cfg.Procdesc.get_proc_name context.procdesc in
let local_vars = Cfg.Procdesc.get_locals context.procdesc in
let procname = Cfg.Procdesc.get_proc_name context.CContext.procdesc in
let local_vars = Cfg.Procdesc.get_locals context.CContext.procdesc in
let mname = try
list_filter (fun (m, t) -> Mangled.to_string m = name) local_vars
with _ -> [] in
@ -646,9 +645,9 @@ let rec compute_autorelease_pool_vars context stmts =
CFrontend_utils.General_utils.append_no_duplicated_pvars
[(Sil.Lvar (Sil.mk_pvar m procname), t)] (compute_autorelease_pool_vars context stmts')
| _ -> compute_autorelease_pool_vars context stmts')
| s:: stmts' ->
| s :: stmts' ->
let sl = snd(Clang_ast_proj.get_stmt_tuple s) in
compute_autorelease_pool_vars context (sl@stmts')
compute_autorelease_pool_vars context (sl @ stmts')
(* checks if a unary operator is a logic negation applied to integers*)
let is_logical_negation_of_int tenv ei uoi =
@ -658,6 +657,7 @@ let is_logical_negation_of_int tenv ei uoi =
(* Checks if stmt_list is a call to a special dispatch function *)
let is_dispatch_function stmt_list =
let open Clang_ast_t in
match stmt_list with
| ImplicitCastExpr(_,[DeclRefExpr(_, _, _, di)], _, _):: stmts ->
(match di.Clang_ast_t.drti_decl_ref with
@ -690,7 +690,7 @@ let assign_default_params params_stmt callee_pname_opt ~is_cxx_method =
let params_args = list_combine params_stmt args in
let replace_default_arg param =
match param with
| CXXDefaultArgExpr(_, _, _), (_, _, Some default_instr) -> default_instr
| Clang_ast_t.CXXDefaultArgExpr _, (_, _, Some default_instr) -> default_instr
| instr, _ -> instr in
list_map replace_default_arg params_args
with

@ -10,9 +10,7 @@
(** Utility module for retrieving types *)
open Utils
open Clang_ast_t
open CFrontend_utils
open CFrontend_utils.General_utils
module L = Logging
let get_function_return_type s =
@ -66,13 +64,14 @@ let lookup_var_type context pvar =
(* Extract the type out of a statement. This is useful when the statement *)
(* denotes actually an expression *)
let extract_type_from_stmt s =
let open Clang_ast_t in
match s with
| BinaryConditionalOperator(_, _, expr_info) | ConditionalOperator(_, _, expr_info)
| AddrLabelExpr(_, _, expr_info, _) | ArraySubscriptExpr(_, _, expr_info)
| ArrayTypeTraitExpr(_, _, expr_info) | AsTypeExpr(_, _, expr_info)
| AtomicExpr(_, _, expr_info) | BinaryOperator(_, _, expr_info, _)
| CompoundAssignOperator(_, _, expr_info, _, _)
| BlockExpr(_, _, expr_info, _) | CXXBindTemporaryExpr (_, _ , expr_info, _)
| BinaryConditionalOperator (_, _, expr_info) | ConditionalOperator (_, _, expr_info)
| AddrLabelExpr (_, _, expr_info, _) | ArraySubscriptExpr (_, _, expr_info)
| ArrayTypeTraitExpr (_, _, expr_info) | AsTypeExpr (_, _, expr_info)
| AtomicExpr (_, _, expr_info) | BinaryOperator (_, _, expr_info, _)
| CompoundAssignOperator (_, _, expr_info, _, _)
| BlockExpr (_, _, expr_info, _) | CXXBindTemporaryExpr (_, _ , expr_info, _)
| CXXBoolLiteralExpr (_, _, expr_info, _) | CXXConstructExpr (_, _, expr_info, _)
| CXXTemporaryObjectExpr (_, _, expr_info, _) | CXXDefaultArgExpr (_, _, expr_info)
| CXXDefaultInitExpr (_, _, expr_info) | CXXDeleteExpr (_, _, expr_info, _)
@ -136,7 +135,7 @@ let cut_struct_union s =
match buf with
| "struct":: l (*-> Printing.string_from_list l *)
| "class":: l
| "union":: l -> string_from_list l
| "union":: l -> General_utils.string_from_list l
| _ -> s
let get_name_from_struct s =

@ -10,9 +10,7 @@
(** Processes types and record declarations by adding them to the tenv *)
open Utils
open Clang_ast_t
open CFrontend_utils
open CFrontend_utils.General_utils
module L = Logging
exception Typename_not_found
@ -86,10 +84,10 @@ let string_type_to_sil_type tenv s =
let s = (match Str.split (Str.regexp "[ \t]+") s with
| "struct"::"(anonymous":: "struct":: s' ->
(*Printing.log_out " ...Getting rid of the extra 'struct' word@."; *)
string_from_list ("struct"::"(anonymous":: s')
General_utils.string_from_list ("struct"::"(anonymous":: s')
| "union"::"(anonymous":: "union":: s' ->
(*Printing.log_out " ...Getting rid of the extra 'union' word@."; *)
string_from_list ("union"::"(anonymous":: s')
General_utils.string_from_list ("union"::"(anonymous":: s')
| _ -> s) in
let lexbuf = Lexing.from_string s in
let t =
@ -140,6 +138,7 @@ let get_record_name opt_type = match opt_type with
let get_method_decls parent decl_list =
let open Clang_ast_t in
let rec traverse_decl parent decl = match decl with
| CXXMethodDecl _ -> [(parent, decl)]
| CXXRecordDecl (_, _, _, _, decl_list', _, _, _)
@ -195,12 +194,13 @@ and do_typedef_declaration tenv namespace decl_info name opt_type typedef_decl_i
Sil.tenv_add tenv typename typ
and get_struct_fields tenv record_name namespace decl_list =
let open Clang_ast_t in
match decl_list with
| [] -> []
| FieldDecl(decl_info, name_info, qual_type, field_decl_info):: decl_list' ->
let field_name = name_info.Clang_ast_t.ni_name in
Printing.log_out " ...Defining field '%s'.\n" field_name;
let id = mk_class_field_name record_name field_name in
let id = General_utils.mk_class_field_name record_name field_name in
let typ = qual_type_to_sil_type tenv qual_type in
let annotation_items = [] in (* For the moment we don't use them*)
(id, typ, annotation_items):: get_struct_fields tenv record_name namespace decl_list'
@ -215,10 +215,10 @@ and get_struct_fields tenv record_name namespace decl_list =
and get_class_methods tenv class_name namespace decl_list =
let process_method_decl = function
| CXXMethodDecl (decl_info, name_info, qual_type, function_decl_info) ->
let method_name = name_info.ni_name in
| Clang_ast_t.CXXMethodDecl (decl_info, name_info, qual_type, function_decl_info) ->
let method_name = name_info.Clang_ast_t.ni_name in
Printing.log_out " ...Declaring method '%s'.\n" method_name;
let method_proc = mk_procname_from_cpp_method class_name method_name (CTypes.get_type qual_type) in
let method_proc = General_utils.mk_procname_from_cpp_method class_name method_name (CTypes.get_type qual_type) in
Some method_proc
| _ -> None in
(* poor mans list_filter_map *)
@ -241,7 +241,7 @@ and get_declaration_type tenv namespace decl_info n opt_type decl_list decl_cont
Printing.log_out "Record Declaration '%s' defined as struct\n" n;
let non_static_fields = get_struct_fields tenv name_str namespace decl_list in
let non_static_fields = if CTrans_models.is_objc_memory_model_controlled n then
append_no_duplicates_fields [Sil.objc_ref_counter_field] non_static_fields
General_utils.append_no_duplicates_fields [Sil.objc_ref_counter_field] non_static_fields
else non_static_fields in
let non_static_fields = CFrontend_utils.General_utils.sort_fields non_static_fields in
let static_fields = [] in (* Warning for the moment we do not treat static field. *)
@ -264,6 +264,7 @@ and add_late_defined_record tenv namespace typename =
Printing.log_out "!!!! Calling late-defined record '%s'\n" (Sil.typename_to_string typename) ;
match typename with
| Sil.TN_csu(Sil.Struct, name) | Sil.TN_csu(Sil.Union, name) ->
let open Clang_ast_t in
let rec scan decls =
match decls with
| [] -> false
@ -300,6 +301,7 @@ and add_late_defined_typedef tenv namespace typename =
match typename with
| Sil.TN_typedef name ->
let rec scan decls =
let open Clang_ast_t in
match decls with
| [] -> false
| TypedefDecl (decl_info, name_info, opt_type, _, tdi) :: decls' ->

@ -12,7 +12,6 @@
open Utils
open CFrontend_utils
open Clang_ast_t
module L = Logging
@ -43,7 +42,8 @@ let rec lookup_ahead_for_vardecl context pointer var_name kind decl_list =
match decl_list with
| [] -> Printing.log_out " Failing when looking ahead for variable '%s'\n" var_name;
assert false (* nothing has been found ahead, maybe something bad in the AST *)
| VarDecl(decl_info, var_info, t, _) :: rest when var_name = var_info.Clang_ast_t.ni_name ->
| Clang_ast_t.VarDecl (decl_info, var_info, t, _) :: rest
when var_name = var_info.Clang_ast_t.ni_name ->
let var_name' = var_info.Clang_ast_t.ni_name in
if global_to_be_added decl_info then (
let tenv = CContext.get_tenv context in
@ -103,11 +103,12 @@ let lookup_var stmt_info context pointer var_name kind =
(* in the reference instructions, all the variable names are also saved in a map from pointers *)
(* to variable names to be used in the translation of the method's body. *)
let rec get_variables_stmt context (stmt : Clang_ast_t.stmt) : unit =
let open Clang_ast_t in
match stmt with
| DeclStmt(_, lstmt, decl_list) ->
| DeclStmt (_, lstmt, decl_list) ->
get_variables_decls context decl_list;
get_fun_locals context lstmt;
| DeclRefExpr(stmt_info, stmt_list, expr_info, decl_ref_expr_info) ->
| DeclRefExpr (stmt_info, stmt_list, expr_info, decl_ref_expr_info) ->
(* Notice that DeclRefExpr is the reference to a declared var/function/enum... *)
(* so no declaration here *)
Printing.log_out "Collecting variables, passing from DeclRefExpr '%s'\n"
@ -119,11 +120,11 @@ let rec get_variables_stmt context (stmt : Clang_ast_t.stmt) : unit =
| _ ->
let pvar = lookup_var stmt_info context stmt_info.Clang_ast_t.si_pointer var_name kind in
CContext.LocalVars.add_pointer_var stmt_info.Clang_ast_t.si_pointer pvar context)
| CompoundStmt(stmt_info, lstmt) ->
| CompoundStmt (stmt_info, lstmt) ->
Printing.log_out "Collecting variables, passing from CompoundStmt '%s'\n"
stmt_info.Clang_ast_t.si_pointer;
CContext.LocalVars.enter_and_leave_scope context get_fun_locals lstmt
| ForStmt(stmt_info, lstmt) ->
| ForStmt (stmt_info, lstmt) ->
Printing.log_out "Collecting variables, passing from ForStmt '%s'\n"
stmt_info.Clang_ast_t.si_pointer;
CContext.LocalVars.enter_and_leave_scope context get_fun_locals lstmt
@ -141,6 +142,7 @@ and get_fun_locals context (stmts : Clang_ast_t.stmt list) : unit =
(* Collects the local of a function. *)
and get_variables_decls context (decl_list : Clang_ast_t.decl list) : unit =
let do_one_decl decl =
let open Clang_ast_t in
match decl with
| VarDecl (decl_info, name_info, qual_type, var_decl_info) ->
Printing.log_out "Collecting variables, passing from VarDecl '%s'\n" decl_info.Clang_ast_t.di_pointer;
@ -156,8 +158,8 @@ and get_variables_decls context (decl_list : Clang_ast_t.decl list) : unit =
| _ ->
CContext.LocalVars.add_local_var context name typ decl_info.Clang_ast_t.di_pointer
(CFrontend_utils.General_utils.is_static_var var_decl_info))
| CXXRecordDecl(di, n_info, ot, _, dl, dci, rdi, _)
| RecordDecl(di, n_info, ot, _, dl, dci, rdi) ->
| CXXRecordDecl (di, n_info, ot, _, dl, dci, rdi, _)
| RecordDecl (di, n_info, ot, _, dl, dci, rdi) ->
let typ = CTypes_decl.get_declaration_type context.CContext.tenv context.CContext.namespace
di n_info.Clang_ast_t.ni_name ot dl dci rdi in
CTypes_decl.add_struct_to_tenv context.CContext.tenv typ

@ -16,8 +16,6 @@
open Utils
open CFrontend_utils
open CFrontend_utils.General_utils
open Clang_ast_t
module L = Logging
@ -108,14 +106,14 @@ let add_class_to_tenv tenv class_name decl_list obj_c_interface_decl_info =
let fields, superclasses, methods =
match Sil.tenv_lookup tenv interface_name with
| Some Sil.Tstruct(saved_fields, _, _, _, saved_superclasses, saved_methods, _) ->
append_no_duplicates_fields fields saved_fields,
append_no_duplicates_csu superclasses saved_superclasses,
append_no_duplicates_methods methods saved_methods
General_utils.append_no_duplicates_fields fields saved_fields,
General_utils.append_no_duplicates_csu superclasses saved_superclasses,
General_utils.append_no_duplicates_methods methods saved_methods
| _ -> fields, superclasses, methods in
let fields = append_no_duplicates_fields fields fields_sc in
let fields = General_utils.append_no_duplicates_fields fields fields_sc in
(* We add the special hidden counter_field for implementing reference counting *)
let fields = append_no_duplicates_fields [Sil.objc_ref_counter_field] fields in
let fields = CFrontend_utils.General_utils.sort_fields fields in
let fields = General_utils.append_no_duplicates_fields [Sil.objc_ref_counter_field] fields in
let fields = General_utils.sort_fields fields in
Printing.log_out "Class %s field:\n" class_name;
list_iter (fun (fn, ft, _) ->
Printing.log_out "-----> field: '%s'\n" (Ident.fieldname_to_string fn)) fields;
@ -162,13 +160,14 @@ let interface_impl_declaration tenv class_name decl_list idi =
(* ...Full definition of the interface I *)
let lookup_late_defined_interface tenv cname =
let rec scan decls =
let open Clang_ast_t in
match decls with
| [] -> ()
| ObjCInterfaceDecl(decl_info, name_info, decl_list, decl_context_info, obj_c_interface_decl_info)
| ObjCInterfaceDecl (decl_info, name_info, decl_list, decl_context_info, obj_c_interface_decl_info)
:: decls'
when (Mangled.from_string name_info.Clang_ast_t.ni_name) = cname ->
scan decls'
| ObjCInterfaceDecl(decl_info, name_info, decl_list, decl_context_info, obj_c_interface_decl_info)
| ObjCInterfaceDecl (decl_info, name_info, decl_list, decl_context_info, obj_c_interface_decl_info)
:: decls'
when (Mangled.from_string name_info.Clang_ast_t.ni_name) = cname ->
(* Assumption: here we assume that the first interface declaration with non empty set of fields is the *)

@ -17,8 +17,7 @@
open Utils
open CFrontend_utils
open CFrontend_config
open Clang_ast_t
module L = Logging
open CContext
@ -122,11 +121,11 @@ struct
let print_item key (qt, attributes, decl_info, getter, setter, ivar) =
let getter_str =
match getter with
| getter_name, Some (ObjCMethodDecl(_, _, _), defined1) ->
| getter_name, Some (Clang_ast_t.ObjCMethodDecl _, defined1) ->
getter_name
| _ -> "" in
let setter_str = match setter with
| setter_name, Some (ObjCMethodDecl(_, _, _), defined2) ->
| setter_name, Some (Clang_ast_t.ObjCMethodDecl _, defined2) ->
setter_name
| _ -> "" in
Logging.out "Property item %s accessors %s and %s \n"
@ -254,7 +253,7 @@ let get_memory_management_attribute attributes =
with Not_found -> None
let create_generated_method_name name_info =
{ ni_name = name_info.Clang_ast_t.ni_name;
{ Clang_ast_t.ni_name = name_info.Clang_ast_t.ni_name;
ni_qual_name = CFrontend_config.generated_suffix:: name_info.Clang_ast_t.ni_qual_name;
}
@ -267,6 +266,7 @@ let make_getter curr_class prop_name prop_type =
match prop_type with
| qt, attributes, decl_info, (getter_name, getter), (setter_name, setter), ivar_opt ->
let ivar_name = get_ivar_name prop_name ivar_opt in
let open Clang_ast_t in
match getter with
| Some (ObjCMethodDecl(di, name_info, mdi), _) ->
let dummy_info = Ast_expressions.dummy_decl_info_in_curr_file di in
@ -286,6 +286,7 @@ let make_setter curr_class prop_name prop_type =
match prop_type with
| qt, attributes, decl_info, (getter_name, getter), (setter_name, setter), ivar_opt ->
let ivar_name = get_ivar_name prop_name ivar_opt in
let open Clang_ast_t in
match setter with
| Some (ObjCMethodDecl(di, name, mdi), _) when not (is_property_read_only attributes) ->
let dummy_info = Ast_expressions.dummy_decl_info_in_curr_file di in
@ -308,12 +309,12 @@ let make_setter curr_class prop_name prop_type =
let code =
if Ast_utils.is_retain memory_management_attribute then
let param_decl = Ast_expressions.make_decl_ref_exp_var (param_name, qt_param, decl_ptr) `ParmVar stmt_info in
let retain_call = Ast_expressions.make_message_expr qt_param retain param_decl stmt_info true in
let release_call = Ast_expressions.make_message_expr qt_param release lhs_exp stmt_info true in
let retain_call = Ast_expressions.make_message_expr qt_param CFrontend_config.retain param_decl stmt_info true in
let release_call = Ast_expressions.make_message_expr qt_param CFrontend_config.release lhs_exp stmt_info true in
[retain_call; release_call; setter]
else if Ast_utils.is_copy memory_management_attribute then
let param_decl = Ast_expressions.make_decl_ref_exp_var (param_name, qt_param, decl_ptr) `ParmVar stmt_info in
let copy_call = Ast_expressions.make_message_expr qt_param copy param_decl stmt_info true in
let copy_call = Ast_expressions.make_message_expr qt_param CFrontend_config.copy param_decl stmt_info true in
let setter = Ast_expressions.make_binary_stmt lhs_exp copy_call stmt_info expr_info boi in
[setter]
else [setter] in
@ -349,12 +350,12 @@ let make_getter_setter curr_class decl_info prop_name =
let add_properties_to_table curr_class decl_list =
let add_property_to_table dec =
match dec with
| ObjCPropertyDecl(decl_info, name_info, pdi) ->
| Clang_ast_t.ObjCPropertyDecl(decl_info, name_info, pdi) ->
(* Property declaration register the property on the property table to be *)
let pname = name_info.Clang_ast_t.ni_name in
Printing.log_out "ADDING: ObjCPropertyDecl for property '%s' " pname;
Printing.log_out " pointer= '%s' \n" decl_info.Clang_ast_t.di_pointer;
Property.add_property (curr_class, pname) pdi.opdi_qual_type pdi.opdi_property_attributes decl_info;
Property.add_property (curr_class, pname) pdi.Clang_ast_t.opdi_qual_type pdi.Clang_ast_t.opdi_property_attributes decl_info;
| _ -> () in
list_iter add_property_to_table decl_list
@ -364,7 +365,7 @@ let get_methods curr_class decl_list =
add_properties_to_table curr_class decl_list;
let get_method decl list_methods =
match decl with
ObjCMethodDecl(decl_info, name_info, method_decl_info) ->
| Clang_ast_t.ObjCMethodDecl (decl_info, name_info, method_decl_info) ->
let is_instance = method_decl_info.Clang_ast_t.omdi_is_instance_method in
let method_kind = Procname.objc_method_kind_of_bool is_instance in
let method_name = name_info.Clang_ast_t.ni_name in

Loading…
Cancel
Save