[clang frontend] Pass type qualifiers through frontend

Summary:
Backend needs to know whether type is const or not. In order to achieve it, frontend needs to know it first.
This diff changes bunch of things:
- update clang plugin to have AST exporter actually export that info most of the time
- change types of functions in clang frontend until it compiles
- replace `type_ptr` with `qual_type` and `tp` with `qt` in names where applicable
- cleanup some things in the process
update-submodule: facebook-clang-plugins

Reviewed By: jvillard

Differential Revision: D4938567

fbshipit-source-id: 716b3ef
master
Andrzej Kotulski 8 years ago committed by Facebook Github Bot
parent 233d6a53c0
commit db3c07a631

@ -1 +1 @@
Subproject commit ee26293dd046acc5c2dd862d3201aa9f7dace96a
Subproject commit 21d4222b325650c67944a4ad9cc2b72c7e37fefd

@ -34,7 +34,7 @@ let get_template_info tenv (fdi : Clang_ast_t.function_decl_info) : Typ.template
| Some spec_info -> Typ.Template (
QualifiedCppName.empty,
List.map spec_info.tsi_specialization_args ~f:(function
| `Type type_ptr -> Some (CType_decl.type_ptr_to_sil_type tenv type_ptr)
| `Type qual_type -> Some (CType_decl.qual_type_to_sil_type tenv qual_type)
| _ -> None))
| None -> Typ.NoTemplate

@ -36,34 +36,35 @@ let is_class typ =
String.equal (Typ.Name.name name) CFrontend_config.objc_class
| _ -> false
let rec return_type_of_function_type_ptr type_ptr =
let rec return_type_of_function_qual_type (qual_type : Clang_ast_t.qual_type) =
let open Clang_ast_t in
match CAst_utils.get_type type_ptr with
match CAst_utils.get_type qual_type.qt_type_ptr with
| Some FunctionProtoType (_, function_type_info, _)
| Some FunctionNoProtoType (_, function_type_info) ->
function_type_info.Clang_ast_t.fti_return_type
| Some BlockPointerType (_, in_type_ptr) ->
return_type_of_function_type_ptr in_type_ptr
| Some BlockPointerType (_, in_qual) ->
return_type_of_function_qual_type in_qual
| Some _ ->
Logging.err_debug "Warning: Type pointer %s is not a function type."
(Clang_ast_extend.type_ptr_to_string type_ptr);
Clang_ast_extend.ErrorType
(Clang_ast_extend.type_ptr_to_string qual_type.qt_type_ptr);
{qual_type with qt_type_ptr=Clang_ast_extend.ErrorType}
| None ->
Logging.err_debug "Warning: Type pointer %s not found."
(Clang_ast_extend.type_ptr_to_string type_ptr);
Clang_ast_extend.ErrorType
(Clang_ast_extend.type_ptr_to_string qual_type.qt_type_ptr);
{qual_type with qt_type_ptr=Clang_ast_extend.ErrorType}
let return_type_of_function_type tp =
return_type_of_function_type_ptr tp
let return_type_of_function_type qual_type =
return_type_of_function_qual_type qual_type
let is_block_type tp =
let is_block_type {Clang_ast_t.qt_type_ptr} =
let open Clang_ast_t in
match CAst_utils.get_desugared_type tp with
match CAst_utils.get_desugared_type qt_type_ptr with
| Some BlockPointerType _ -> true
| _ -> false
let is_reference_type tp =
match CAst_utils.get_desugared_type tp with
let is_reference_type {Clang_ast_t.qt_type_ptr} =
match CAst_utils.get_desugared_type qt_type_ptr with
| Some Clang_ast_t.LValueReferenceType _ -> true
| Some Clang_ast_t.RValueReferenceType _ -> true
| _ -> false

@ -19,10 +19,10 @@ val remove_pointer_to_typ : Typ.t -> Typ.t
val is_class : Typ.t -> bool
val return_type_of_function_type : Clang_ast_t.type_ptr -> Clang_ast_t.type_ptr
val return_type_of_function_type : Clang_ast_t.qual_type -> Clang_ast_t.qual_type
val is_block_type : Clang_ast_t.type_ptr -> bool
val is_block_type : Clang_ast_t.qual_type -> bool
val is_reference_type : Clang_ast_t.type_ptr -> bool
val is_reference_type : Clang_ast_t.qual_type -> bool
val get_name_from_type_pointer : string -> string * string

@ -93,7 +93,7 @@ let rec get_struct_fields tenv decl =
let do_one_decl decl = match decl with
| FieldDecl (_, name_info, qt, _) ->
let id = CGeneral_utils.mk_class_field_name name_info in
let typ = type_ptr_to_sil_type tenv qt.Clang_ast_t.qt_type_ptr in
let typ = qual_type_to_sil_type tenv qt in
let annotation_items = [] in (* For the moment we don't use them*)
[(id, typ, annotation_items)]
| _ -> [] in
@ -113,7 +113,7 @@ and get_record_custom_type tenv definition_decl =
match definition_decl with
| ClassTemplateSpecializationDecl (_, _, _, _, decl_list, _, _, _, _)
| CXXRecordDecl (_, _, _, _, decl_list, _, _, _) ->
Option.map ~f:(type_ptr_to_sil_type tenv) (get_translate_as_friend_decl decl_list)
Option.map ~f:(qual_type_to_sil_type tenv) (get_translate_as_friend_decl decl_list)
| _ -> None
and get_template_specialization tenv = function
@ -122,7 +122,7 @@ and get_template_specialization tenv = function
| Some decl -> get_class_template_name decl
| None -> assert false in
let args_in_sil = List.map spec_info.tsi_specialization_args ~f:(function
| `Type t_ptr -> Some (type_ptr_to_sil_type tenv t_ptr)
| `Type qual_type -> Some (qual_type_to_sil_type tenv qual_type)
| _ -> None) in
Typ.Template (tname, args_in_sil)
| _ -> Typ.NoTemplate
@ -202,30 +202,30 @@ and add_types_from_decl_to_tenv tenv decl =
match decl with
| ClassTemplateSpecializationDecl _ | CXXRecordDecl _ | RecordDecl _ ->
get_record_declaration_type tenv decl
| ObjCInterfaceDecl _ -> ObjcInterface_decl.interface_declaration type_ptr_to_sil_type tenv decl
| ObjCInterfaceDecl _ -> ObjcInterface_decl.interface_declaration qual_type_to_sil_type tenv decl
| ObjCImplementationDecl _ ->
ObjcInterface_decl.interface_impl_declaration type_ptr_to_sil_type tenv decl
| ObjCProtocolDecl _ -> ObjcProtocol_decl.protocol_decl type_ptr_to_sil_type tenv decl
| ObjCCategoryDecl _ -> ObjcCategory_decl.category_decl type_ptr_to_sil_type tenv decl
| ObjCCategoryImplDecl _ -> ObjcCategory_decl.category_impl_decl type_ptr_to_sil_type tenv decl
ObjcInterface_decl.interface_impl_declaration qual_type_to_sil_type tenv decl
| ObjCProtocolDecl _ -> ObjcProtocol_decl.protocol_decl qual_type_to_sil_type tenv decl
| ObjCCategoryDecl _ -> ObjcCategory_decl.category_decl qual_type_to_sil_type tenv decl
| ObjCCategoryImplDecl _ -> ObjcCategory_decl.category_impl_decl qual_type_to_sil_type tenv decl
| EnumDecl _ -> CEnum_decl.enum_decl decl
| _ -> assert false
and type_ptr_to_sil_type tenv tp =
CType_to_sil_type.type_ptr_to_sil_type add_types_from_decl_to_tenv tenv tp
and qual_type_to_sil_type tenv qual_type =
CType_to_sil_type.qual_type_to_sil_type add_types_from_decl_to_tenv tenv qual_type
let get_type_from_expr_info ei tenv =
let tp = ei.Clang_ast_t.ei_type_ptr in
type_ptr_to_sil_type tenv tp
let qt = ei.Clang_ast_t.ei_qual_type in
qual_type_to_sil_type tenv qt
let class_from_pointer_type tenv type_ptr =
match (type_ptr_to_sil_type tenv type_ptr).Typ.desc with
let class_from_pointer_type tenv qual_type =
match (qual_type_to_sil_type tenv qual_type).Typ.desc with
| Tptr({desc=Tstruct typename}, _) -> typename
| _ -> assert false
let get_class_type_np tenv expr_info obj_c_message_expr_info =
let tp =
let qt =
match obj_c_message_expr_info.Clang_ast_t.omei_receiver_kind with
| `Class tp -> tp
| _ -> expr_info.Clang_ast_t.ei_type_ptr in
type_ptr_to_sil_type tenv tp
| `Class qt -> qt
| _ -> expr_info.Clang_ast_t.ei_qual_type in
qual_type_to_sil_type tenv qt

@ -19,9 +19,9 @@ val add_types_from_decl_to_tenv : Tenv.t -> Clang_ast_t.decl -> Typ.t
(* and Class, which is a pointer to objc_class. *)
val add_predefined_types : Tenv.t -> unit
val type_ptr_to_sil_type : Tenv.t -> Clang_ast_t.type_ptr -> Typ.t
val qual_type_to_sil_type : Tenv.t -> Clang_ast_t.qual_type -> Typ.t
val class_from_pointer_type : Tenv.t -> Clang_ast_t.type_ptr -> Typ.Name.t
val class_from_pointer_type : Tenv.t -> Clang_ast_t.qual_type -> Typ.Name.t
val get_class_type_np : Tenv.t -> Clang_ast_t.expr_info ->
Clang_ast_t.obj_c_message_expr_info -> Typ.t

@ -143,7 +143,7 @@ let component_factory_function_advice context an =
match an with
| Ctl_parser_types.Decl (Clang_ast_t.FunctionDecl (decl_info, _, (qual_type: Clang_ast_t.qual_type), _)) ->
let objc_interface =
CAst_utils.type_ptr_to_objc_interface qual_type.qt_type_ptr in
CAst_utils.qual_type_to_objc_interface qual_type in
let condition =
is_ck_context context an && is_component_if objc_interface in
if condition then

@ -66,49 +66,47 @@ let stmt_info_with_fresh_pointer stmt_info = {
let create_qual_type ?(is_const=false) qt_type_ptr =
{ Clang_ast_t.qt_type_ptr; qt_is_const=is_const }
let builtin_to_type_ptr kind = Clang_ast_extend.Builtin kind
let builtin_to_qual_type kind = create_qual_type (Clang_ast_extend.Builtin kind)
let pointerof_type_ptr type_ptr = Clang_ast_extend.PointerOf type_ptr
let create_pointer_qual_type ~is_const typ =
create_qual_type ~is_const (Clang_ast_extend.PointerOf typ)
let create_reference_qual_type ~is_const typ =
create_qual_type ~is_const (Clang_ast_extend.ReferenceOf typ)
(* We translate function types as the return type of the function *)
let function_type_ptr return_type = return_type
let create_int_type = builtin_to_type_ptr `Int
let create_int_type = builtin_to_qual_type `Int
let create_void_type = builtin_to_type_ptr `Void
let create_void_type = builtin_to_qual_type `Void
let create_void_star_type = pointerof_type_ptr create_void_type
let create_void_star_type = create_pointer_qual_type ~is_const:false create_void_type
let create_id_type = pointerof_type_ptr (builtin_to_type_ptr `ObjCId)
let create_id_type = create_pointer_qual_type ~is_const:false (builtin_to_qual_type `ObjCId)
let create_char_type = builtin_to_type_ptr `Char_S
let create_char_star_type = pointerof_type_ptr create_char_type
let create_char_star_qual_type ~is_const = create_qual_type ~is_const create_char_star_type
let create_char_type = builtin_to_qual_type `Char_S
let create_char_star_type ~is_const = create_pointer_qual_type ~is_const create_char_type
let create_BOOL_type = builtin_to_type_ptr `SChar
let create_BOOL_type = builtin_to_qual_type `SChar
let create_unsigned_long_type = builtin_to_type_ptr `ULong
let create_unsigned_long_type = builtin_to_qual_type `ULong
let create_void_unsigned_long_type = function_type_ptr create_void_type
let create_void_void_type = function_type_ptr create_void_type
let create_class_type typename = Clang_ast_extend.ClassType typename
let create_class_qual_type ?(is_const=false) typename =
create_qual_type ~is_const @@ create_class_type typename
let make_objc_class_type class_name =
create_class_type (Typ.Name.Objc.from_string class_name)
let create_pointer_type typ = Clang_ast_extend.PointerOf typ
let create_pointer_qual_type ~is_const typ = create_qual_type ~is_const @@ create_pointer_type typ
create_qual_type ~is_const (Clang_ast_extend.ClassType typename)
let create_reference_type typ = Clang_ast_extend.ReferenceOf typ
let make_objc_class_qual_type class_name =
create_class_qual_type (Typ.Name.Objc.from_string class_name)
let create_integer_literal n =
let stmt_info = dummy_stmt_info () in
let expr_info = {
Clang_ast_t.ei_type_ptr = create_int_type;
Clang_ast_t.ei_qual_type = create_int_type;
ei_value_kind = `RValue;
ei_object_kind = `Ordinary;
} in
@ -119,9 +117,9 @@ let create_integer_literal n =
} in
Clang_ast_t.IntegerLiteral (stmt_info, [], expr_info, integer_literal_info)
let create_cstyle_cast_expr stmt_info stmts tp =
let create_cstyle_cast_expr stmt_info stmts qt =
let expr_info = {
Clang_ast_t.ei_type_ptr = create_void_star_type;
Clang_ast_t.ei_qual_type = create_void_star_type;
ei_value_kind = `RValue;
ei_object_kind = `Ordinary;
} in
@ -129,11 +127,11 @@ let create_cstyle_cast_expr stmt_info stmts tp =
Clang_ast_t.cei_cast_kind = `NullToPointer;
cei_base_path = [];
} in
Clang_ast_t.CStyleCastExpr (stmt_info, stmts, expr_info, cast_expr, tp)
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_type_ptr = create_void_star_type;
Clang_ast_t.ei_qual_type = create_void_star_type;
ei_value_kind = `RValue;
ei_object_kind = `Ordinary;
} in
@ -141,7 +139,7 @@ let create_parent_expr stmt_info stmts =
let create_implicit_cast_expr stmt_info stmts typ cast_kind =
let expr_info = {
Clang_ast_t.ei_type_ptr = typ;
Clang_ast_t.ei_qual_type = typ;
ei_value_kind = `RValue;
ei_object_kind = `Ordinary;
} in
@ -167,14 +165,14 @@ let make_stmt_info di = {
si_source_range = di.Clang_ast_t.di_source_range;
}
let make_expr_info tp vk objc_kind = {
Clang_ast_t.ei_type_ptr = tp;
let make_expr_info qt vk objc_kind = {
Clang_ast_t.ei_qual_type = qt;
ei_value_kind = vk;
ei_object_kind = objc_kind;
}
let make_expr_info_with_objc_kind tp objc_kind =
make_expr_info tp `LValue objc_kind
let make_expr_info_with_objc_kind qt objc_kind =
make_expr_info qt `LValue objc_kind
let make_decl_ref_exp stmt_info expr_info drei =
let stmt_info = {
@ -190,57 +188,43 @@ let make_obj_c_message_expr_info_instance sel = {
omei_decl_pointer = None; (* TODO look into it *)
}
let make_obj_c_message_expr_info_class selector tp pointer = {
let make_obj_c_message_expr_info_class selector tname pointer = {
Clang_ast_t.omei_selector = selector;
omei_receiver_kind = `Class (create_class_type tp);
omei_receiver_kind = `Class (create_class_qual_type tname);
omei_is_definition_found = false;
omei_decl_pointer = pointer
}
let make_decl_ref k decl_ptr name is_hidden tp_opt = {
let make_decl_ref k decl_ptr name is_hidden qt_opt = {
Clang_ast_t.dr_kind = k;
dr_decl_pointer = decl_ptr;
dr_name = Some name;
dr_is_hidden = is_hidden ;
dr_type_ptr = tp_opt
dr_qual_type = qt_opt
}
let make_decl_ref_tp k decl_ptr name is_hidden tp =
make_decl_ref k decl_ptr name is_hidden (Some tp)
let make_decl_ref_qt k decl_ptr name is_hidden qt =
make_decl_ref k decl_ptr name is_hidden (Some qt)
let make_decl_ref_no_tp k decl_ptr name is_hidden =
let make_decl_ref_no_qt k decl_ptr name is_hidden =
make_decl_ref k decl_ptr name is_hidden None
let make_decl_ref_invalid k name is_hidden tp =
make_decl_ref k (CAst_utils.get_invalid_pointer ()) name is_hidden (Some tp)
let make_decl_ref_invalid k name is_hidden qt =
make_decl_ref k (CAst_utils.get_invalid_pointer ()) name is_hidden (Some qt)
let make_decl_ref_expr_info decl_ref = {
Clang_ast_t.drti_decl_ref = Some decl_ref;
drti_found_decl_ref = None;
}
let make_objc_ivar_decl decl_info tp ivar_name =
let field_decl_info = {
Clang_ast_t.fldi_is_mutable = true;
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*)
ovdi_access_control = `Private;
} in
let qt = create_qual_type tp in
Clang_ast_t.ObjCIvarDecl (decl_info, ivar_name, qt, field_decl_info, obj_c_ivar_decl_info)
let make_expr_info tp = {
Clang_ast_t.ei_type_ptr = tp;
let make_expr_info qt = {
Clang_ast_t.ei_qual_type = qt;
ei_value_kind = `LValue;
ei_object_kind = `ObjCProperty
}
let make_general_expr_info tp vk ok = {
Clang_ast_t.ei_type_ptr = tp;
let make_general_expr_info qt vk ok = {
Clang_ast_t.ei_qual_type = qt;
ei_value_kind = vk;
ei_object_kind = ok
}
@ -249,15 +233,15 @@ let make_ObjCBoolLiteralExpr stmt_info value =
let ei = make_expr_info create_BOOL_type in
Clang_ast_t.ObjCBoolLiteralExpr((fresh_stmt_info stmt_info),[], ei, value)
let make_message_expr param_tp selector decl_ref_exp stmt_info add_cast =
let make_message_expr param_qt selector decl_ref_exp stmt_info add_cast =
let stmt_info = stmt_info_with_fresh_pointer stmt_info in
let parameters =
if add_cast then
let cast_expr = create_implicit_cast_expr stmt_info [decl_ref_exp] param_tp `LValueToRValue in
let cast_expr = create_implicit_cast_expr stmt_info [decl_ref_exp] param_qt `LValueToRValue in
[cast_expr]
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_tp `ObjCProperty in
let expr_info = make_expr_info_with_objc_kind param_qt `ObjCProperty in
Clang_ast_t.ObjCMessageExpr (stmt_info, parameters, expr_info, obj_c_message_expr_info)
let make_binary_stmt stmt1 stmt2 stmt_info expr_info boi =
@ -268,17 +252,16 @@ let make_next_object_exp stmt_info item items =
let var_decl_ref, var_type =
match item with
| Clang_ast_t.DeclStmt (_, _, [Clang_ast_t.VarDecl(di, name_info, var_qual_type, _)]) ->
let var_type = var_qual_type.Clang_ast_t.qt_type_ptr in
let decl_ptr = di.Clang_ast_t.di_pointer in
let decl_ref = make_decl_ref_tp `Var decl_ptr name_info false var_type in
let decl_ref = make_decl_ref_qt `Var decl_ptr name_info false var_qual_type in
let stmt_info_var = {
Clang_ast_t.si_pointer = di.Clang_ast_t.di_pointer;
si_source_range = di.Clang_ast_t.di_source_range
} in
let expr_info = make_expr_info_with_objc_kind var_type `ObjCProperty in
let expr_info = make_expr_info_with_objc_kind var_qual_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
var_qual_type
| _ -> assert false in
let message_call = make_message_expr create_id_type
CFrontend_config.next_object items stmt_info false in
@ -302,16 +285,15 @@ let translate_dispatch_function stmt_info stmt_list n =
CallExpr (stmt_info, [arg_stmt], expr_info_call)
| _ -> assert false
(* Create declaration statement: tp vname = iexp *)
let make_DeclStmt stmt_info di tp vname old_vdi iexp =
(* Create declaration statement: qt vname = iexp *)
let make_DeclStmt stmt_info di qt vname old_vdi iexp =
let init_expr_opt, init_expr_l = match iexp with
| Some iexp' ->
let ie = create_implicit_cast_expr stmt_info [iexp'] tp `IntegralCast in
let ie = create_implicit_cast_expr stmt_info [iexp'] qt `IntegralCast in
Some ie, [ie]
| None -> None, [] in
let var_decl_info = { old_vdi with Clang_ast_t.vdi_init_expr = init_expr_opt } in
let di = fresh_decl_info di in
let qt = create_qual_type tp 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])
@ -319,40 +301,40 @@ let build_OpaqueValueExpr si source_expr ei =
let opaque_value_expr_info = { Clang_ast_t.ovei_source_expr = Some source_expr } in
Clang_ast_t.OpaqueValueExpr (si, [], ei, opaque_value_expr_info)
let pseudo_object_tp () = make_objc_class_type CFrontend_config.pseudo_object_type
let pseudo_object_qt = make_objc_class_qual_type CFrontend_config.pseudo_object_type
(* Create expression PseudoObjectExpr for 'o.m' *)
let build_PseudoObjectExpr tp_m o_cast_decl_ref_exp mname =
let build_PseudoObjectExpr qt_m o_cast_decl_ref_exp mname =
match o_cast_decl_ref_exp with
| Clang_ast_t.ImplicitCastExpr (si, _, ei, _) ->
let ove = build_OpaqueValueExpr si o_cast_decl_ref_exp ei in
let ei_opre = make_expr_info (pseudo_object_tp ()) in
let ei_opre = make_expr_info pseudo_object_qt in
let count_name = CAst_utils.make_name_decl CFrontend_config.count in
let pointer = si.Clang_ast_t.si_pointer in
let obj_c_property_ref_expr_info = {
Clang_ast_t.oprei_kind =
`PropertyRef (make_decl_ref_no_tp `ObjCProperty pointer count_name false);
`PropertyRef (make_decl_ref_no_qt `ObjCProperty pointer count_name false);
oprei_is_super_receiver = false;
oprei_is_messaging_getter = true;
oprei_is_messaging_setter = false;
} in
let opre = Clang_ast_t.ObjCPropertyRefExpr (si, [ove], ei_opre, obj_c_property_ref_expr_info) in
let ome = make_message_expr tp_m mname o_cast_decl_ref_exp si false in
let poe_ei = make_general_expr_info tp_m `LValue `Ordinary 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
Clang_ast_t.PseudoObjectExpr (si, [opre; ove; ome], poe_ei)
| _ -> assert false
let create_call stmt_info decl_pointer function_name tp parameters =
let create_call stmt_info decl_pointer function_name qt parameters =
let expr_info_call = {
Clang_ast_t.ei_type_ptr = create_void_star_type;
Clang_ast_t.ei_qual_type = create_void_star_type;
ei_value_kind = `XValue;
ei_object_kind = `Ordinary
} in
let expr_info_dre = make_expr_info_with_objc_kind tp `Ordinary in
let decl_ref = make_decl_ref_tp `Function decl_pointer function_name false tp 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 = 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] tp `FunctionToPointerDecay in
let cast = create_implicit_cast_expr (fresh_stmt_info stmt_info) [decl_ref_exp] qt `FunctionToPointerDecay in
Clang_ast_t.CallExpr (stmt_info, cast:: parameters, expr_info_call)
(* For a of type NSArray* Translate
@ -383,8 +365,8 @@ let translate_block_enumerate block_name stmt_info stmt_list ei =
let rec get_name_pointers lp =
match lp with
| [] -> []
| Clang_ast_t.ParmVarDecl (di, name, tp, _) :: lp' ->
(name.Clang_ast_t.ni_name, di.Clang_ast_t.di_pointer, tp):: get_name_pointers 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 =
@ -392,51 +374,48 @@ let translate_block_enumerate block_name stmt_info stmt_list ei =
| Clang_ast_t.ParmVarDecl (di_idx, name_idx, qt_idx, vdi) ->
let zero = create_integer_literal "0" in
(* qt_idx idx = 0; *)
let tp_idx = qt_idx.Clang_ast_t.qt_type_ptr in
let idx_decl_stmt = make_DeclStmt (fresh_stmt_info stmt_info) di_idx tp_idx
let idx_decl_stmt = make_DeclStmt (fresh_stmt_info stmt_info) di_idx qt_idx
name_idx vdi (Some zero) in
let idx_ei = make_expr_info tp_idx in
let idx_ei = make_expr_info qt_idx in
let pointer = di_idx.Clang_ast_t.di_pointer in
let idx_decl_ref = make_decl_ref_tp `Var pointer name_idx false tp_idx in
let idx_decl_ref = make_decl_ref_qt `Var pointer name_idx 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]
tp_idx `LValueToRValue in
idx_decl_stmt, idx_decl_ref_exp, idx_cast, tp_idx
qt_idx `LValueToRValue in
idx_decl_stmt, idx_decl_ref_exp, idx_cast, qt_idx
| _ -> assert false in
let cast_expr decl_ref tp =
let ei = make_expr_info tp in
let cast_expr decl_ref qt =
let ei = make_expr_info qt in
let drei = make_decl_ref_expr_info decl_ref in
let decl_ref_exp = make_decl_ref_exp (fresh_stmt_info stmt_info) ei drei in
create_implicit_cast_expr (fresh_stmt_info stmt_info) [decl_ref_exp] tp `LValueToRValue in
create_implicit_cast_expr (fresh_stmt_info stmt_info) [decl_ref_exp] qt `LValueToRValue in
(* build statement BOOL *stop = malloc(sizeof(BOOL)); *)
let build_stop pstop =
match pstop with
| Clang_ast_t.ParmVarDecl (di, name, qt, vdi) ->
let tp_fun = create_void_unsigned_long_type in
let qt_fun = create_void_unsigned_long_type in
let type_opt = Some create_BOOL_type in
let parameter = Clang_ast_t.UnaryExprOrTypeTraitExpr
((fresh_stmt_info stmt_info), [],
make_general_expr_info create_unsigned_long_type `RValue `Ordinary,
{ Clang_ast_t.uttei_kind = `SizeOf; Clang_ast_t.uttei_type_ptr = type_opt}) in
{ Clang_ast_t.uttei_kind = `SizeOf; Clang_ast_t.uttei_qual_type = type_opt}) in
let pointer = di.Clang_ast_t.di_pointer in
let stmt_info = fresh_stmt_info stmt_info in
let malloc_name = CAst_utils.make_name_decl CFrontend_config.malloc in
let malloc = create_call stmt_info pointer malloc_name tp_fun [parameter] in
let tp = qt.Clang_ast_t.qt_type_ptr in
let init_exp = create_implicit_cast_expr (fresh_stmt_info stmt_info) [malloc] tp `BitCast in
make_DeclStmt (fresh_stmt_info stmt_info) di tp name vdi (Some init_exp)
let malloc = create_call stmt_info pointer malloc_name 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 vdi (Some init_exp)
| _ -> assert false in
(* BOOL *stop =NO; *)
let stop_equal_no pstop =
match pstop with
| Clang_ast_t.ParmVarDecl (di, name, qt, _) ->
let tp = qt.Clang_ast_t.qt_type_ptr in
let decl_ref = make_decl_ref_tp `Var di.Clang_ast_t.di_pointer name false tp in
let cast = cast_expr decl_ref tp in
let decl_ref = make_decl_ref_qt `Var di.Clang_ast_t.di_pointer name false qt in
let cast = cast_expr decl_ref qt 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
@ -448,28 +427,27 @@ let translate_block_enumerate block_name stmt_info stmt_list ei =
let free_stop pstop =
match pstop with
| Clang_ast_t.ParmVarDecl (di, name, qt, _) ->
let tp = qt.Clang_ast_t.qt_type_ptr in
let tp_fun = create_void_void_type in
let decl_ref = make_decl_ref_tp `Var di.Clang_ast_t.di_pointer name false tp in
let cast = cast_expr decl_ref tp in
let qt_fun = create_void_void_type in
let decl_ref = make_decl_ref_qt `Var di.Clang_ast_t.di_pointer name false qt in
let cast = cast_expr decl_ref qt in
let free_name = CAst_utils.make_name_decl CFrontend_config.free in
let parameter =
create_implicit_cast_expr (fresh_stmt_info stmt_info) [cast] create_void_star_type `BitCast in
let pointer = di.Clang_ast_t.di_pointer in
create_call (fresh_stmt_info stmt_info) pointer free_name tp_fun [parameter]
create_call (fresh_stmt_info stmt_info) pointer free_name qt_fun [parameter]
| _ -> assert false in
(* idx<a.count *)
let bin_op pidx array_decl_ref_exp =
let _, _, idx_cast, idx_tp = build_idx_decl pidx in
let rhs = build_PseudoObjectExpr idx_tp array_decl_ref_exp CFrontend_config.count in
let _, _, idx_cast, idx_qt = build_idx_decl pidx in
let rhs = build_PseudoObjectExpr idx_qt array_decl_ref_exp CFrontend_config.count in
let lt = { Clang_ast_t.boi_kind = `LT } in
let exp_info = make_expr_info create_int_type in
Clang_ast_t.BinaryOperator (fresh_stmt_info stmt_info, [idx_cast; rhs], exp_info, lt) in
(* idx++ *)
let un_op idx_decl_ref_expr tp_idx =
let idx_ei = make_expr_info tp_idx in
let un_op idx_decl_ref_expr qt_idx =
let idx_ei = make_expr_info qt_idx 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
@ -483,14 +461,13 @@ let translate_block_enumerate block_name stmt_info stmt_list ei =
let open Clang_ast_t in
match pobj with
| ParmVarDecl(di_obj, name_obj, qt_obj, _) ->
let tp_obj = qt_obj.Clang_ast_t.qt_type_ptr in
let poe_ei = make_general_expr_info tp_obj `RValue `Ordinary in
let poe_ei = make_general_expr_info qt_obj `RValue `Ordinary in
let ei_array = get_ei_from_cast decl_ref_expr_array in
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],
make_expr_info (pseudo_object_tp ()),
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
@ -503,28 +480,26 @@ let translate_block_enumerate block_name stmt_info stmt_list ei =
(* NSArray *objects = a *)
let objects_array_DeclStmt init =
let di = { empty_decl_info with Clang_ast_t.di_pointer = CAst_utils.get_fresh_pointer () } in
let tp = create_qual_type @@ create_pointer_type @@
make_objc_class_type CFrontend_config.nsarray_cl in
let qt = create_pointer_qual_type ~is_const:false @@
make_objc_class_qual_type CFrontend_config.nsarray_cl in
(* init should be ImplicitCastExpr of array a *)
let vdi = { empty_var_decl_info with Clang_ast_t.vdi_init_expr = Some (init) } in
let objects_name = CAst_utils.make_name_decl CFrontend_config.objects in
let var_decl = Clang_ast_t.VarDecl (di, objects_name, tp, vdi) in
Clang_ast_t.DeclStmt (fresh_stmt_info stmt_info, [init], [var_decl]), [(CFrontend_config.objects, di.Clang_ast_t.di_pointer, tp)] in
let var_decl = Clang_ast_t.VarDecl (di, objects_name, 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
| Clang_ast_t.DeclStmt (si, _, [Clang_ast_t.VarDecl (_, name, qt, _)]) ->
let tp = qt.Clang_ast_t.qt_type_ptr in
let decl_ref = make_decl_ref_tp `Var si.Clang_ast_t.si_pointer name false tp in
cast_expr decl_ref tp
let decl_ref = make_decl_ref_qt `Var si.Clang_ast_t.si_pointer name false qt in
cast_expr decl_ref qt
| _ -> assert false in
let build_cast_decl_ref_expr_from_parm p =
match p with
| Clang_ast_t.ParmVarDecl (di, name, qt, _) ->
let tp = qt.Clang_ast_t.qt_type_ptr in
let decl_ref = make_decl_ref_tp `Var di.Clang_ast_t.di_pointer name false tp in
cast_expr decl_ref tp
let decl_ref = make_decl_ref_qt `Var di.Clang_ast_t.di_pointer name false qt in
cast_expr decl_ref qt
| _ -> assert false in
let qual_block_name = CAst_utils.make_name_decl block_name in
@ -534,41 +509,41 @@ let translate_block_enumerate block_name stmt_info stmt_list ei =
| Clang_ast_t.BlockExpr (bsi, _, bei, _) ->
let di = { empty_decl_info with di_pointer = CAst_utils.get_fresh_pointer () } in
let vdi = { empty_var_decl_info with Clang_ast_t.vdi_init_expr = Some (be) } in
let qt = create_qual_type bei.Clang_ast_t.ei_type_ptr in
let qt = bei.Clang_ast_t.ei_qual_type in
let var_decl = Clang_ast_t.VarDecl (di, qual_block_name, qt, vdi) in
Clang_ast_t.DeclStmt (bsi, [be], [var_decl]), [(block_name, di.Clang_ast_t.di_pointer, qt)]
| _ -> assert false in
let make_block_call block_tp object_cast idx_cast stop_cast =
let decl_ref = make_decl_ref_invalid `Var qual_block_name false block_tp in
let fun_cast = cast_expr decl_ref block_tp in
let make_block_call block_qt object_cast idx_cast stop_cast =
let decl_ref = make_decl_ref_invalid `Var qual_block_name false block_qt in
let fun_cast = cast_expr decl_ref block_qt in
let ei_call = make_expr_info create_void_star_type 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_tp = create_BOOL_type in
let ei = make_expr_info bool_tp in
let bool_qt = create_BOOL_type in
let ei = make_expr_info bool_qt 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_tp `LValueToRValue in
let cond = create_implicit_cast_expr (fresh_stmt_info stmt_info) [unary_op] bool_qt `LValueToRValue 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(); dummy_stmt (); cond; break_stmt; dummy_stmt ()]) in
let translate params array_cast_decl_ref_exp block_decl block_tp =
let translate params array_cast_decl_ref_exp block_decl block_qt =
match params with
| [pobj; pidx; pstop] ->
let objects_decl, op = objects_array_DeclStmt array_cast_decl_ref_exp in
let decl_stop = build_stop pstop in
let assign_stop = stop_equal_no pstop in
let objects = make_object_cast_decl_ref_expr objects_decl in
let idx_decl_stmt, idx_decl_ref_exp, idx_cast, tp_idx = build_idx_decl pidx in
let idx_decl_stmt, idx_decl_ref_exp, idx_cast, qt_idx = build_idx_decl pidx in
let guard = bin_op pidx objects in
let incr = un_op idx_decl_ref_exp tp_idx in
let incr = un_op idx_decl_ref_exp qt_idx in
let obj_assignment = build_object_DeclStmt pobj objects idx_cast in
let object_cast = build_cast_decl_ref_expr_from_parm pobj in
let stop_cast = build_cast_decl_ref_expr_from_parm pstop in
let call_block = make_block_call block_tp object_cast idx_cast stop_cast in
let call_block = make_block_call block_qt object_cast idx_cast stop_cast in
let if_stop = build_if_stop stop_cast in
let free_stop = free_stop pstop in
[ objects_decl; block_decl; decl_stop; assign_stop;
@ -580,7 +555,7 @@ let translate_block_enumerate block_name stmt_info stmt_list ei =
| [s; BlockExpr (_, _, bei, BlockDecl (_, bdi)) as be] ->
let block_decl, bv = make_block_decl be in
let vars_to_register = get_name_pointers bdi.bdi_parameters in
let translated_stmt, op = translate bdi.bdi_parameters s block_decl bei.ei_type_ptr 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 *)
Logging.out_debug "WARNING: Block Enumeration called at %s not translated."
@ -592,27 +567,3 @@ let translate_block_enumerate block_name stmt_info stmt_list ei =
let trans_negation_with_conditional stmt_info expr_info stmt_list =
let stmt_list_cond = stmt_list @ [create_integer_literal "0"] @ [create_integer_literal "1"] in
Clang_ast_t.ConditionalOperator (stmt_info, stmt_list_cond, expr_info)
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
let boi = { Clang_ast_t.boi_kind = `NE } in
let decl_ptr = decl_info.Clang_ast_t.di_pointer in
let decl_ref = make_decl_ref_tp `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 = Clang_ast_t.DeclRefExpr (stmt_info_var, [], (make_expr_info var_type), decl_ref_info) in
let var_decl_ptr = CAst_utils.get_invalid_pointer () in
let expr_info = {
Clang_ast_t.ei_type_ptr = var_type;
ei_value_kind = `RValue;
ei_object_kind = `Ordinary
} 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 "0" in
let bin_op_expr_info = make_general_expr_info create_BOOL_type `RValue `Ordinary in
let bin_op = make_binary_stmt decl_ref_exp_cast null_expr stmt_info bin_op_expr_info boi in
let parameters = [bin_op] in
let procname = Typ.Procname.to_string BuiltinDecl.__infer_assume in
let qual_procname = CAst_utils.make_name_decl procname in
create_call stmt_info var_decl_ptr qual_procname create_void_star_type parameters

@ -19,49 +19,34 @@ val dummy_source_range : unit -> source_range
val dummy_stmt_info : unit -> stmt_info
val create_qual_type : ?is_const:bool -> type_ptr -> qual_type
val create_class_qual_type : ?is_const:bool -> Typ.Name.t -> qual_type
val create_char_star_type : type_ptr
val create_char_star_qual_type : is_const:bool -> qual_type
val create_pointer_qual_type : is_const:bool -> qual_type -> qual_type
val create_id_type : type_ptr
val create_reference_qual_type : is_const:bool -> qual_type -> qual_type
val create_void_type : type_ptr
val create_char_star_type : is_const:bool -> qual_type
val create_int_type : type_ptr
val create_id_type : qual_type
val create_BOOL_type : type_ptr
val create_void_type : qual_type
val create_class_type : Typ.Name.t -> type_ptr
val create_class_qual_type : ?is_const:bool -> Typ.Name.t -> qual_type
val create_int_type : qual_type
val create_pointer_type : type_ptr -> type_ptr
val create_pointer_qual_type : is_const:bool -> type_ptr -> qual_type
val create_BOOL_type : qual_type
val create_integer_literal : string -> stmt
val create_reference_type : type_ptr -> type_ptr
val make_objc_ivar_decl : decl_info -> type_ptr -> named_decl_info -> decl
val make_stmt_info : decl_info -> stmt_info
val make_decl_ref_tp : decl_kind -> pointer -> named_decl_info -> bool -> type_ptr -> decl_ref
val make_decl_ref_expr_info : decl_ref -> decl_ref_expr_info
val make_general_expr_info : type_ptr -> value_kind -> object_kind -> expr_info
val make_expr_info : type_ptr -> expr_info
val make_next_object_exp : stmt_info -> stmt -> Clang_ast_t.stmt ->
Clang_ast_t.stmt * Clang_ast_t.stmt
val create_nil : stmt_info -> stmt
val create_implicit_cast_expr : stmt_info -> stmt list -> type_ptr -> cast_kind -> stmt
val make_message_expr : type_ptr -> string -> stmt -> stmt_info -> bool -> stmt
val create_implicit_cast_expr : stmt_info -> stmt list -> qual_type -> cast_kind -> stmt
val make_binary_stmt : stmt -> stmt -> stmt_info -> expr_info -> binary_operator_info -> stmt
@ -78,5 +63,3 @@ val translate_block_enumerate : string -> stmt_info -> stmt list -> expr_info
(* We translate the logical negation of an integer with a conditional*)
(* !x <=> x?0:1 *)
val trans_negation_with_conditional : stmt_info -> expr_info -> stmt list -> stmt
val create_assume_not_null_call : decl_info -> named_decl_info -> type_ptr -> stmt

@ -15,7 +15,7 @@ open! PVariant
module L = Logging
module F = Format
type type_ptr_to_sil_type = Tenv.t -> Clang_ast_t.type_ptr -> Typ.t
type qual_type_to_sil_type = Tenv.t -> Clang_ast_t.qual_type -> Typ.t
let sanitize_name = Str.global_replace (Str.regexp "[/ ]") "_"
let get_qual_name qual_name_list =
@ -56,7 +56,7 @@ let get_invalid_pointer () =
CFrontend_config.invalid_pointer
let type_from_unary_expr_or_type_trait_expr_info info =
match info.Clang_ast_t.uttei_type_ptr with
match info.Clang_ast_t.uttei_qual_type with
| Some tp -> Some tp
| None -> None
@ -145,16 +145,7 @@ let get_decl_from_typ_ptr typ_ptr =
| Clang_ast_t.ObjCInterfaceType (_, decl_ptr) -> get_decl decl_ptr
| _ -> None
(* TODO take the attributes into account too. To be done after we get the attribute's arguments. *)
let is_type_nonnull type_ptr =
let open Clang_ast_t in
match get_type type_ptr with
| Some AttributedType (_, attr_info) ->
attr_info.ati_attr_kind = `Nonnull
| _ ->
false
let sil_annot_of_type type_ptr =
let sil_annot_of_type {Clang_ast_t.qt_type_ptr} =
let default_visibility = true in
let mk_annot annot_name_opt =
match annot_name_opt with
@ -162,7 +153,7 @@ let sil_annot_of_type type_ptr =
[{ Annot.class_name = annot_name; parameters = []; }, default_visibility]
| None -> Annot.Item.empty in
let annot_name_opt =
match get_type type_ptr with
match get_type qt_type_ptr with
| Some AttributedType (_, attr_info) ->
if attr_info.ati_attr_kind = `Nullable then Some Annotations.nullable
else if attr_info.ati_attr_kind = `Nonnull then Some Annotations.nonnull
@ -177,8 +168,8 @@ let name_of_typedef_type_info {Clang_ast_t.tti_decl_ptr} =
get_qualified_name name_decl_info
| _ -> QualifiedCppName.empty
let name_opt_of_typedef_type_ptr type_ptr =
match get_type type_ptr with
let name_opt_of_typedef_qual_type qual_type =
match get_type qual_type.Clang_ast_t.qt_type_ptr with
| Some Clang_ast_t.TypedefType (_, typedef_type_info) ->
Some (name_of_typedef_type_info typedef_type_info)
| _ -> None
@ -188,16 +179,24 @@ let string_of_qual_type {Clang_ast_t.qt_type_ptr; qt_is_const} =
(if qt_is_const then "is_const " else "")
(Clang_ast_extend.type_ptr_to_string qt_type_ptr)
let add_type_from_decl_ref type_ptr_to_sil_type tenv decl_ref_opt fail_if_not_found =
let qual_type_of_decl_ptr decl_ptr = {
(* This function needs to be in this module - CAst_utils can't depend on
Ast_expressions *)
Clang_ast_t.qt_type_ptr=Clang_ast_extend.DeclPtr decl_ptr;
qt_is_const=false
}
let add_type_from_decl_ref qual_type_to_sil_type tenv dr =
let qual_type = qual_type_of_decl_ptr dr.Clang_ast_t.dr_decl_pointer in
ignore (qual_type_to_sil_type tenv qual_type)
let add_type_from_decl_ref_opt qual_type_to_sil_type tenv decl_ref_opt fail_if_not_found =
match decl_ref_opt with (* translate interface first if found *)
| Some dr ->
ignore (type_ptr_to_sil_type tenv (Clang_ast_extend.DeclPtr dr.Clang_ast_t.dr_decl_pointer));
| Some dr -> add_type_from_decl_ref qual_type_to_sil_type tenv dr
| _ -> if fail_if_not_found then assert false else ()
let add_type_from_decl_ref_list type_ptr_to_sil_type tenv decl_ref_list =
let add_elem dr =
ignore (type_ptr_to_sil_type tenv (Clang_ast_extend.DeclPtr dr.Clang_ast_t.dr_decl_pointer)) in
List.iter ~f:add_elem decl_ref_list
let add_type_from_decl_ref_list qual_type_to_sil_type tenv decl_ref_list =
List.iter ~f:(add_type_from_decl_ref qual_type_to_sil_type tenv) decl_ref_list
let get_function_decl_with_body decl_ptr =
let open Clang_ast_t in
@ -216,8 +215,8 @@ let get_function_decl_with_body decl_ptr =
let get_info_from_decl_ref decl_ref =
let name_info = match decl_ref.Clang_ast_t.dr_name with Some ni -> ni | _ -> assert false in
let decl_ptr = decl_ref.Clang_ast_t.dr_decl_pointer in
let type_ptr = match decl_ref.Clang_ast_t.dr_type_ptr with Some tp -> tp | _ -> assert false in
name_info, decl_ptr, type_ptr
let qual_type = match decl_ref.Clang_ast_t.dr_qual_type with Some tp -> tp | _ -> assert false in
name_info, decl_ptr, qual_type
(* st |= EF (atomic_pred param) *)
let rec exists_eventually_st atomic_pred param st =
@ -349,20 +348,20 @@ let rec is_objc_if_descendant ?(blacklist = default_blacklist) if_decl ancestors
|| is_objc_if_descendant ~blacklist:blacklist (get_super_if if_decl) ancestors)
| _ -> false
let rec type_ptr_to_objc_interface type_ptr =
let typ_opt = get_desugared_type type_ptr in
let rec qual_type_to_objc_interface qual_type =
let typ_opt = get_desugared_type (qual_type.Clang_ast_t.qt_type_ptr) in
ctype_to_objc_interface typ_opt
and ctype_to_objc_interface typ_opt =
match (typ_opt : Clang_ast_t.c_type option) with
| Some ObjCInterfaceType (_, decl_ptr) -> get_decl decl_ptr
| Some ObjCObjectPointerType (_, (inner_qual_type: Clang_ast_t.qual_type)) ->
type_ptr_to_objc_interface inner_qual_type.qt_type_ptr
qual_type_to_objc_interface inner_qual_type
| Some FunctionProtoType (_, function_type_info, _)
| Some FunctionNoProtoType (_, function_type_info) ->
type_ptr_to_objc_interface function_type_info.Clang_ast_t.fti_return_type
qual_type_to_objc_interface function_type_info.Clang_ast_t.fti_return_type
| _ -> None
let type_ptr_is_typedef_named type_ptr (type_name: string): bool =
let qual_type_is_typedef_named qual_type (type_name: string): bool =
let is_decl_name_match decl_opt =
let tuple_opt = match decl_opt with
| Some decl -> Clang_ast_proj.get_named_decl_tuple decl
@ -371,7 +370,7 @@ let type_ptr_is_typedef_named type_ptr (type_name: string): bool =
| Some (_, ni) ->
String.equal type_name ni.ni_name
| _ -> false in
match get_type type_ptr with
match get_type qual_type.Clang_ast_t.qt_type_ptr with
| Some TypedefType (_, tti) ->
let decl_opt = get_decl tti.tti_decl_ptr in
is_decl_name_match decl_opt
@ -383,8 +382,8 @@ let if_decl_to_di_pointer_opt if_decl =
Some if_decl_info.di_pointer
| _ -> None
let is_instance_type type_ptr =
match name_opt_of_typedef_type_ptr type_ptr with
let is_instance_type qual_type =
match name_opt_of_typedef_qual_type qual_type with
| Some name -> String.equal (QualifiedCppName.to_qual_string name) "instancetype"
| None -> false
@ -392,7 +391,7 @@ let return_type_matches_class_type rtp type_decl_pointer =
if is_instance_type rtp then
true
else
let return_type_decl_opt = type_ptr_to_objc_interface rtp in
let return_type_decl_opt = qual_type_to_objc_interface rtp in
let return_type_decl_pointer_opt =
Option.map ~f:if_decl_to_di_pointer_opt return_type_decl_opt in
[%compare.equal : int option option] (Some type_decl_pointer) return_type_decl_pointer_opt

@ -11,14 +11,12 @@ open! IStd
(** Functions for transformations of ast nodes *)
val is_type_nonnull : Clang_ast_t.type_ptr -> bool
val get_fresh_pointer : unit -> Clang_ast_t.pointer
val get_invalid_pointer : unit -> Clang_ast_t.pointer
val type_from_unary_expr_or_type_trait_expr_info :
Clang_ast_t.unary_expr_or_type_trait_expr_info -> Clang_ast_t.type_ptr option
Clang_ast_t.unary_expr_or_type_trait_expr_info -> Clang_ast_t.qual_type option
val get_decl : Clang_ast_t.pointer -> Clang_ast_t.decl option
@ -62,8 +60,8 @@ val get_decl_from_typ_ptr : Clang_ast_t.type_ptr -> Clang_ast_t.decl option
val name_of_typedef_type_info : Clang_ast_t.typedef_type_info -> QualifiedCppName.t
(** returns name of typedef if type_ptr points to Typedef, None otherwise *)
val name_opt_of_typedef_type_ptr : Clang_ast_t.type_ptr -> QualifiedCppName.t option
(** returns name of typedef if qual_type points to Typedef, None otherwise *)
val name_opt_of_typedef_qual_type : Clang_ast_t.qual_type -> QualifiedCppName.t option
val string_of_qual_type : Clang_ast_t.qual_type -> string
@ -71,18 +69,20 @@ val make_name_decl : string -> Clang_ast_t.named_decl_info
val make_qual_name_decl : string list -> string -> Clang_ast_t.named_decl_info
type type_ptr_to_sil_type = Tenv.t -> Clang_ast_t.type_ptr -> Typ.t
type qual_type_to_sil_type = Tenv.t -> Clang_ast_t.qual_type -> Typ.t
val qual_type_of_decl_ptr : Clang_ast_t.pointer -> Clang_ast_t.qual_type
val add_type_from_decl_ref : type_ptr_to_sil_type -> Tenv.t -> Clang_ast_t.decl_ref option ->
val add_type_from_decl_ref_opt : qual_type_to_sil_type -> Tenv.t -> Clang_ast_t.decl_ref option ->
bool -> unit
val add_type_from_decl_ref_list : type_ptr_to_sil_type -> Tenv.t -> Clang_ast_t.decl_ref list ->
val add_type_from_decl_ref_list : qual_type_to_sil_type -> Tenv.t -> Clang_ast_t.decl_ref list ->
unit
val get_function_decl_with_body : Clang_ast_t.pointer -> Clang_ast_t.decl option
val get_info_from_decl_ref : Clang_ast_t.decl_ref ->
Clang_ast_t.named_decl_info * Clang_ast_t.pointer * Clang_ast_t.type_ptr
Clang_ast_t.named_decl_info * Clang_ast_t.pointer * Clang_ast_t.qual_type
val exists_eventually_st : ('a -> Clang_ast_t.stmt -> bool) -> 'a -> Clang_ast_t.stmt -> bool
@ -131,13 +131,13 @@ val get_super_ObjCImplementationDecl :
val is_objc_if_descendant :
?blacklist:string list -> Clang_ast_t.decl option -> string list -> bool
val type_ptr_to_objc_interface : Clang_ast_t.type_ptr -> Clang_ast_t.decl option
val qual_type_to_objc_interface : Clang_ast_t.qual_type -> Clang_ast_t.decl option
val type_ptr_is_typedef_named : Clang_ast_t.type_ptr -> string -> bool
val qual_type_is_typedef_named : Clang_ast_t.qual_type -> string -> bool
(** A class method that returns an instance of the class is a factory method. *)
val is_objc_factory_method : Clang_ast_t.decl -> Clang_ast_t.decl -> bool
val name_of_decl_ref_opt : Clang_ast_t.decl_ref option -> string option
val sil_annot_of_type : Clang_ast_t.type_ptr -> Annot.Item.t
val sil_annot_of_type : Clang_ast_t.qual_type -> Annot.Item.t

@ -34,7 +34,7 @@ let fields_superclass tenv interface_decl_info =
| _ -> [])
| _ -> []
let build_sil_field type_ptr_to_sil_type tenv field_name type_ptr prop_attributes =
let build_sil_field qual_type_to_sil_type tenv field_name qual_type prop_attributes =
let prop_atts = List.map ~f:Clang_ast_j.string_of_property_attribute prop_attributes in
let annotation_from_type t =
match t.Typ.desc with
@ -42,7 +42,7 @@ let build_sil_field type_ptr_to_sil_type tenv field_name type_ptr prop_attribute
| Typ.Tptr (_, Typ.Pk_objc_unsafe_unretained) -> [Config.unsafe_unret]
| _ -> [] in
let fname = CGeneral_utils.mk_class_field_name field_name in
let typ = type_ptr_to_sil_type tenv type_ptr in
let typ = qual_type_to_sil_type tenv qual_type in
let item_annotations = match prop_atts with
| [] ->
({ Annot.class_name = Config.ivar_attributes; parameters = annotation_from_type typ },
@ -50,30 +50,30 @@ let build_sil_field type_ptr_to_sil_type tenv field_name type_ptr prop_attribute
| _ ->
({ Annot.class_name = Config.property_attributes; parameters = prop_atts },
true) in
let item_annotations = item_annotations :: (CAst_utils.sil_annot_of_type type_ptr) in
let item_annotations = item_annotations :: (CAst_utils.sil_annot_of_type qual_type) in
fname, typ, item_annotations
(* Given a list of declarations in an interface returns a list of fields *)
let rec get_fields type_ptr_to_sil_type tenv decl_list =
let rec get_fields qual_type_to_sil_type tenv decl_list =
let open Clang_ast_t in
let add_field name_info qt attributes decl_list' =
let fields = get_fields type_ptr_to_sil_type tenv decl_list' in
let field_tuple = build_sil_field type_ptr_to_sil_type tenv
name_info qt.Clang_ast_t.qt_type_ptr attributes in
let add_field name_info (qt : qual_type) attributes decl_list' =
let fields = get_fields qual_type_to_sil_type tenv decl_list' in
let field_tuple = build_sil_field qual_type_to_sil_type tenv
name_info qt attributes in
CGeneral_utils.append_no_duplicates_fields [field_tuple] fields in
match decl_list with
| [] -> []
| ObjCPropertyDecl (_, _, obj_c_property_decl_info) :: decl_list' ->
(let ivar_decl_ref = obj_c_property_decl_info.Clang_ast_t.opdi_ivar_decl in
match CAst_utils.get_decl_opt_with_decl_ref ivar_decl_ref with
| Some (ObjCIvarDecl (_, name_info, type_ptr, _, _)) ->
| Some (ObjCIvarDecl (_, name_info, qual_type, _, _)) ->
let attributes = obj_c_property_decl_info.Clang_ast_t.opdi_property_attributes in
add_field name_info type_ptr attributes decl_list'
| _ -> get_fields type_ptr_to_sil_type tenv decl_list')
| ObjCIvarDecl (_, name_info, type_ptr, _, _) :: decl_list' ->
add_field name_info type_ptr [] decl_list'
add_field name_info qual_type attributes decl_list'
| _ -> get_fields qual_type_to_sil_type tenv decl_list')
| ObjCIvarDecl (_, name_info, qual_type, _, _) :: decl_list' ->
add_field name_info qual_type [] decl_list'
| _ :: decl_list' ->
get_fields type_ptr_to_sil_type tenv decl_list'
get_fields qual_type_to_sil_type tenv 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. *)

@ -13,14 +13,11 @@ open! IStd
type field_type = Fieldname.t * Typ.t * (Annot.t * bool) list
val get_fields : CAst_utils.type_ptr_to_sil_type -> Tenv.t -> Clang_ast_t.decl list ->
val get_fields : CAst_utils.qual_type_to_sil_type -> Tenv.t -> Clang_ast_t.decl list ->
field_type list
val fields_superclass : Tenv.t -> Clang_ast_t.obj_c_interface_decl_info -> field_type list
val build_sil_field : CAst_utils.type_ptr_to_sil_type -> Tenv.t -> Clang_ast_t.named_decl_info ->
Clang_ast_t.type_ptr -> Clang_ast_t.property_attribute list -> field_type
val add_missing_fields : Tenv.t -> QualifiedCppName.t -> field_type list -> unit
val modelled_field : Clang_ast_t.named_decl_info -> field_type list

@ -184,29 +184,29 @@ struct
| ObjCInterfaceDecl(_, _, decl_list, _, _) ->
let curr_class = CContext.ContextClsDeclPtr dec_ptr in
ignore
(ObjcInterface_decl.interface_declaration CType_decl.type_ptr_to_sil_type tenv dec);
(ObjcInterface_decl.interface_declaration CType_decl.qual_type_to_sil_type tenv dec);
process_methods trans_unit_ctx tenv cg cfg curr_class decl_list
| ObjCProtocolDecl(_, _, decl_list, _, _) ->
let curr_class = CContext.ContextClsDeclPtr dec_ptr in
ignore (ObjcProtocol_decl.protocol_decl CType_decl.type_ptr_to_sil_type tenv dec);
ignore (ObjcProtocol_decl.protocol_decl CType_decl.qual_type_to_sil_type tenv dec);
process_methods trans_unit_ctx tenv cg cfg curr_class decl_list
| ObjCCategoryDecl(_, _, decl_list, _, _) ->
let curr_class = CContext.ContextClsDeclPtr dec_ptr in
ignore (ObjcCategory_decl.category_decl CType_decl.type_ptr_to_sil_type tenv dec);
ignore (ObjcCategory_decl.category_decl CType_decl.qual_type_to_sil_type tenv dec);
process_methods trans_unit_ctx tenv cg cfg curr_class decl_list
| ObjCCategoryImplDecl(_, _, decl_list, _, _) ->
let curr_class = CContext.ContextClsDeclPtr dec_ptr in
ignore (ObjcCategory_decl.category_impl_decl CType_decl.type_ptr_to_sil_type tenv dec);
ignore (ObjcCategory_decl.category_impl_decl CType_decl.qual_type_to_sil_type tenv dec);
process_methods trans_unit_ctx tenv cg cfg curr_class decl_list;
| ObjCImplementationDecl(decl_info, _, decl_list, _, _) ->
let curr_class = CContext.ContextClsDeclPtr dec_ptr in
let class_typename = CType_decl.get_record_typename ~tenv dec in
let type_ptr_to_sil_type = CType_decl.type_ptr_to_sil_type in
ignore (ObjcInterface_decl.interface_impl_declaration type_ptr_to_sil_type tenv dec);
let qual_type_to_sil_type = CType_decl.qual_type_to_sil_type in
ignore (ObjcInterface_decl.interface_impl_declaration qual_type_to_sil_type tenv dec);
CMethod_trans.add_default_method_for_class trans_unit_ctx class_typename decl_info;
process_methods trans_unit_ctx tenv cg cfg curr_class decl_list;

@ -154,8 +154,8 @@ let mk_sil_global_var {CFrontend_config.source_file} ?(mk_name=fun _ x -> x)
~is_static_local:(var_decl_info.Clang_ast_t.vdi_is_static_local)
(mk_name name_string simple_name) translation_unit
let mk_sil_var trans_unit_ctx named_decl_info decl_info_type_ptr_opt procname outer_procname =
match decl_info_type_ptr_opt with
let mk_sil_var trans_unit_ctx named_decl_info decl_info_qual_type_opt procname outer_procname =
match decl_info_qual_type_opt with
| Some (decl_info, qt, var_decl_info, should_be_mangled) ->
let name_string, simple_name = get_var_name_mangled named_decl_info var_decl_info in
if var_decl_info.Clang_ast_t.vdi_is_global then

@ -15,7 +15,7 @@ open! IStd
type method_signature = {
mutable name : Typ.Procname.t;
args : (Mangled.t * Clang_ast_t.qual_type) list;
ret_type : Clang_ast_t.type_ptr;
ret_type : Clang_ast_t.qual_type;
attributes : Clang_ast_t.attribute list;
loc : Clang_ast_t.source_range;
is_instance : bool;
@ -101,5 +101,5 @@ let ms_to_string ms =
IList.to_string
(fun (s1, s2) -> (Mangled.to_string s1) ^ ", " ^ (CAst_utils.string_of_qual_type s2))
ms.args
^ "->" ^ (Clang_ast_extend.type_ptr_to_string ms.ret_type) ^ " " ^
^ "->" ^ (Clang_ast_extend.type_ptr_to_string ms.ret_type.Clang_ast_t.qt_type_ptr) ^ " " ^
Clang_ast_j.string_of_source_range ms.loc

@ -21,7 +21,7 @@ val ms_set_name : method_signature -> Typ.Procname.t -> unit
val ms_get_args : method_signature ->
(Mangled.t * Clang_ast_t.qual_type) list
val ms_get_ret_type : method_signature -> Clang_ast_t.type_ptr
val ms_get_ret_type : method_signature -> Clang_ast_t.qual_type
val ms_get_attributes : method_signature -> Clang_ast_t.attribute list
@ -43,7 +43,7 @@ val ms_is_getter : method_signature -> bool
val ms_is_setter : method_signature -> bool
val make_ms : Typ.Procname.t -> (Mangled.t * Clang_ast_t.qual_type) list -> Clang_ast_t.type_ptr
val make_ms : Typ.Procname.t -> (Mangled.t * Clang_ast_t.qual_type) list -> Clang_ast_t.qual_type
-> Clang_ast_t.attribute list -> Clang_ast_t.source_range -> bool -> ?is_cpp_virtual:bool
-> CFrontend_config.clang_lang -> Clang_ast_t.pointer option -> Clang_ast_t.pointer option
-> Typ.t option -> method_signature

@ -28,10 +28,10 @@ type method_call_type =
let equal_method_call_type = [%compare.equal : method_call_type]
type function_method_decl_info =
| Func_decl_info of Clang_ast_t.function_decl_info * Clang_ast_t.type_ptr
| Cpp_Meth_decl_info of Clang_ast_t.function_decl_info * Clang_ast_t.cxx_method_decl_info * Clang_ast_t.pointer * Clang_ast_t.type_ptr
| Func_decl_info of Clang_ast_t.function_decl_info * Clang_ast_t.qual_type
| Cpp_Meth_decl_info of Clang_ast_t.function_decl_info * Clang_ast_t.cxx_method_decl_info * Clang_ast_t.pointer * Clang_ast_t.qual_type
| ObjC_Meth_decl_info of Clang_ast_t.obj_c_method_decl_info * Clang_ast_t.pointer
| Block_decl_info of Clang_ast_t.block_decl_info * Clang_ast_t.type_ptr * CContext.t
| Block_decl_info of Clang_ast_t.block_decl_info * Clang_ast_t.qual_type * CContext.t
let is_instance_method function_method_decl_info =
match function_method_decl_info with
@ -52,10 +52,10 @@ let get_class_param function_method_decl_info =
if (is_instance_method function_method_decl_info) then
match function_method_decl_info with
| Cpp_Meth_decl_info (_, _, class_decl_ptr, _) ->
let class_type = Ast_expressions.create_qual_type (Clang_ast_extend.DeclPtr class_decl_ptr) in
let class_type = CAst_utils.qual_type_of_decl_ptr class_decl_ptr in
[(Mangled.from_string CFrontend_config.this, class_type)]
| ObjC_Meth_decl_info (_, class_decl_ptr) ->
let class_type = Ast_expressions.create_qual_type (Clang_ast_extend.DeclPtr class_decl_ptr) in
let class_type = CAst_utils.qual_type_of_decl_ptr class_decl_ptr in
[(Mangled.from_string CFrontend_config.self, class_type)]
| _ -> []
else []
@ -73,11 +73,11 @@ let is_objc_method function_method_decl_info =
let get_return_param tenv function_method_decl_info =
let is_objc_method = is_objc_method function_method_decl_info in
let return_type_ptr = get_original_return_type function_method_decl_info in
let return_typ = CType_decl.type_ptr_to_sil_type tenv return_type_ptr in
let return_qual_type = get_original_return_type function_method_decl_info in
let return_typ = CType_decl.qual_type_to_sil_type tenv return_qual_type in
if should_add_return_param return_typ ~is_objc_method then
[(Mangled.from_string CFrontend_config.return_param,
Ast_expressions.create_pointer_qual_type ~is_const:false return_type_ptr)]
Ast_expressions.create_pointer_qual_type ~is_const:false return_qual_type)]
else
[]
@ -110,25 +110,25 @@ let get_parameters trans_unit_ctx tenv function_method_decl_info =
match par with
| Clang_ast_t.ParmVarDecl (_, name_info, qt, var_decl_info) ->
let _, mangled = CGeneral_utils.get_var_name_mangled name_info var_decl_info in
let param_typ = CType_decl.type_ptr_to_sil_type tenv qt.Clang_ast_t.qt_type_ptr in
let qt_type_ptr =
let param_typ = CType_decl.qual_type_to_sil_type tenv qt in
let new_qt =
match param_typ.Typ.desc with
| Tstruct _ when CGeneral_utils.is_cpp_translation trans_unit_ctx ->
Ast_expressions.create_reference_type qt.Clang_ast_t.qt_type_ptr
| _ -> qt.Clang_ast_t.qt_type_ptr in
(mangled, {qt with qt_type_ptr})
Ast_expressions.create_reference_qual_type ~is_const:false qt
| _ -> qt in
(mangled, new_qt)
| _ -> assert false in
let pars = List.map ~f:par_to_ms_par (get_param_decls function_method_decl_info) in
get_class_param function_method_decl_info @ pars @ get_return_param tenv function_method_decl_info
(** get return type of the function and optionally type of function's return parameter *)
let get_return_val_and_param_types tenv function_method_decl_info =
let return_type_ptr = get_original_return_type function_method_decl_info in
let return_typ = CType_decl.type_ptr_to_sil_type tenv return_type_ptr in
let return_qual_type = get_original_return_type function_method_decl_info in
let return_typ = CType_decl.qual_type_to_sil_type tenv return_qual_type in
let is_objc_method = is_objc_method function_method_decl_info in
if should_add_return_param return_typ ~is_objc_method then
Ast_expressions.create_void_type, Some (CType.add_pointer_to_typ return_typ)
else return_type_ptr, None
else return_qual_type, None
let build_method_signature trans_unit_ctx tenv decl_info procname function_method_decl_info
parent_pointer pointer_to_property_opt =
@ -151,7 +151,7 @@ let method_signature_of_decl trans_unit_ctx tenv meth_decl block_data_opt =
let open Clang_ast_t in
match meth_decl, block_data_opt with
| FunctionDecl (decl_info, _, qt, fdi), _ ->
let func_decl = Func_decl_info (fdi, qt.Clang_ast_t.qt_type_ptr) in
let func_decl = Func_decl_info (fdi, qt) in
let procname = CProcname.from_decl trans_unit_ctx ~tenv meth_decl in
let ms = build_method_signature trans_unit_ctx tenv decl_info procname func_decl None None in
ms, fdi.Clang_ast_t.fdi_body, []
@ -161,7 +161,7 @@ let method_signature_of_decl trans_unit_ctx tenv meth_decl block_data_opt =
| CXXDestructorDecl (decl_info, _, qt, fdi, mdi), _ ->
let procname = CProcname.from_decl trans_unit_ctx ~tenv meth_decl in
let parent_ptr = Option.value_exn decl_info.di_parent_pointer in
let method_decl = Cpp_Meth_decl_info (fdi, mdi, parent_ptr, qt.Clang_ast_t.qt_type_ptr) in
let method_decl = Cpp_Meth_decl_info (fdi, mdi, parent_ptr, qt) in
let parent_pointer = decl_info.Clang_ast_t.di_parent_pointer in
let ms = build_method_signature
trans_unit_ctx tenv decl_info procname method_decl parent_pointer None in
@ -258,8 +258,8 @@ let get_class_name_method_call_from_clang trans_unit_ctx tenv obj_c_message_expr
(* Get class name from a method call accorsing to the info given by the receiver kind *)
let get_class_name_method_call_from_receiver_kind context obj_c_message_expr_info act_params =
match obj_c_message_expr_info.Clang_ast_t.omei_receiver_kind with
| `Class tp ->
let sil_type = CType_decl.type_ptr_to_sil_type context.CContext.tenv tp in
| `Class qt ->
let sil_type = CType_decl.qual_type_to_sil_type context.CContext.tenv qt in
(CType.objc_classname_of_type sil_type)
| `Instance ->
(match act_params with
@ -282,7 +282,7 @@ let get_formal_parameters tenv ms =
let rec defined_parameters pl =
match pl with
| [] -> []
| (mangled, {Clang_ast_t.qt_type_ptr}):: pl' ->
| (mangled, qual_type):: pl' ->
let should_add_pointer name ms =
let is_objc_self =
String.equal name CFrontend_config.self &&
@ -293,16 +293,16 @@ let get_formal_parameters tenv ms =
CFrontend_config.equal_clang_lang
(CMethod_signature.ms_get_lang ms) CFrontend_config.CPP in
(is_objc_self && CMethod_signature.ms_is_instance ms) || is_cxx_this in
let tp = if should_add_pointer (Mangled.to_string mangled) ms then
(Ast_expressions.create_pointer_type qt_type_ptr)
else qt_type_ptr in
let typ = CType_decl.type_ptr_to_sil_type tenv tp in
let qt = if should_add_pointer (Mangled.to_string mangled) ms then
(Ast_expressions.create_pointer_qual_type ~is_const:false qual_type)
else qual_type in
let typ = CType_decl.qual_type_to_sil_type tenv qt in
(mangled, typ):: defined_parameters pl' in
defined_parameters (CMethod_signature.ms_get_args ms)
let get_return_type tenv ms =
let return_type = CMethod_signature.ms_get_ret_type ms in
CType_decl.type_ptr_to_sil_type tenv return_type
CType_decl.qual_type_to_sil_type tenv return_type
let sil_func_attributes_of_attributes attrs =
let rec do_translation acc al = match al with
@ -327,12 +327,13 @@ let should_create_procdesc cfg procname defined set_objc_accessor_attr =
| None -> true
let sil_method_annotation_of_args args method_type : Annot.Method.t =
let args_types = List.map ~f:(fun (_, qt) -> qt.Clang_ast_t.qt_type_ptr) args in
let args_types = List.map ~f:snd args in
let param_annots = List.map ~f:CAst_utils.sil_annot_of_type args_types in
let retval_annot = CAst_utils.sil_annot_of_type method_type in
retval_annot, param_annots
let is_pointer_to_const type_ptr = match CAst_utils.get_type type_ptr with
let is_pointer_to_const {Clang_ast_t.qt_type_ptr} =
match CAst_utils.get_type qt_type_ptr with
| Some PointerType (_, {Clang_ast_t.qt_is_const})
| Some ObjCObjectPointerType (_, {Clang_ast_t.qt_is_const})
| Some RValueReferenceType (_, {Clang_ast_t.qt_is_const})
@ -348,9 +349,9 @@ let get_const_args_indices ~shift args =
let rec aux result = function
| [] ->
List.rev result
| (_, {Clang_ast_t.qt_type_ptr})::tl ->
| (_, qual_type)::tl ->
incr i;
if is_pointer_to_const qt_type_ptr then
if is_pointer_to_const qual_type then
aux (!i - 1::result) tl
else
aux result tl in

@ -9,7 +9,7 @@
open! IStd
type block_data = CContext.t * Clang_ast_t.type_ptr * Typ.Procname.t * (Pvar.t * Typ.t) list
type block_data = CContext.t * Clang_ast_t.qual_type * Typ.Procname.t * (Pvar.t * Typ.t) list
type instr_type = [
| `ClangStmt of Clang_ast_t.stmt

@ -95,7 +95,7 @@ let _is_object_of_class_named comp receiver cname =
| PseudoObjectExpr (_, _, ei)
| ImplicitCastExpr (_, _, ei, _)
| ParenExpr (_, _, ei) ->
(match CAst_utils.type_ptr_to_objc_interface ei.ei_type_ptr with
(match CAst_utils.qual_type_to_objc_interface ei.ei_qual_type with
| Some interface -> comp (Ctl_parser_types.Decl interface) cname
| _ -> false)
| _ -> false
@ -126,7 +126,7 @@ let is_receiver_kind_class comp omei cname =
let open Clang_ast_t in
match omei.omei_receiver_kind with
| `Class ptr ->
(match CAst_utils.get_desugared_type ptr with
(match CAst_utils.get_desugared_type ptr.Clang_ast_t.qt_type_ptr with
| Some ObjCInterfaceType (_, ptr) ->
(match CAst_utils.get_decl ptr with
| Some ObjCInterfaceDecl (_, ndi, _, _, _) ->
@ -219,7 +219,7 @@ let is_property_pointer_type an =
let open Clang_ast_t in
match an with
| Ctl_parser_types.Decl (ObjCPropertyDecl (_, _, pdi)) ->
(match CAst_utils.get_desugared_type pdi.opdi_type_ptr with
(match CAst_utils.get_desugared_type pdi.opdi_qual_type.Clang_ast_t.qt_type_ptr with
| Some MemberPointerType _
| Some ObjCObjectPointerType _
| Some BlockPointerType _ -> true
@ -319,7 +319,7 @@ let isa classname an =
| Ctl_parser_types.Stmt stmt ->
(match Clang_ast_proj.get_expr_tuple stmt with
| Some (_, _, expr_info) ->
let typ = CAst_utils.get_desugared_type expr_info.ei_type_ptr in
let typ = CAst_utils.get_desugared_type expr_info.ei_qual_type.qt_type_ptr in
CAst_utils.is_ptr_to_objc_class typ classname
| _ -> false)
| _ -> false

@ -93,7 +93,7 @@ struct
let objc_exp_of_type_block fun_exp_stmt =
match fun_exp_stmt with
| Clang_ast_t.ImplicitCastExpr(_, _, ei, _)
when CType.is_block_type ei.Clang_ast_t.ei_type_ptr -> true
when CType.is_block_type ei.Clang_ast_t.ei_qual_type -> true
| _ -> false
(* This function add in tenv a class representing an objc block. *)
@ -261,8 +261,8 @@ struct
Pvar.mk_tmp var_name_suffix procname
let mk_temp_sil_var_for_expr tenv procdesc var_name_prefix expr_info =
let type_ptr = expr_info.Clang_ast_t.ei_type_ptr in
let typ = CType_decl.type_ptr_to_sil_type tenv type_ptr in
let qual_type = expr_info.Clang_ast_t.ei_qual_type in
let typ = CType_decl.qual_type_to_sil_type tenv qual_type in
(mk_temp_sil_var procdesc var_name_prefix, typ)
let create_var_exp_tmp_var trans_state expr_info var_name =
@ -412,15 +412,15 @@ struct
(* The stmt seems to be always empty *)
let unaryExprOrTypeTraitExpr_trans trans_state expr_info unary_expr_or_type_trait_expr_info =
let tenv = trans_state.context.CContext.tenv in
let typ = CType_decl.type_ptr_to_sil_type tenv expr_info.Clang_ast_t.ei_type_ptr in
let typ = CType_decl.qual_type_to_sil_type tenv expr_info.Clang_ast_t.ei_qual_type in
match unary_expr_or_type_trait_expr_info.Clang_ast_t.uttei_kind with
| `SizeOf ->
let tp =
let qt_opt =
CAst_utils.type_from_unary_expr_or_type_trait_expr_info
unary_expr_or_type_trait_expr_info in
let sizeof_typ =
match tp with
| Some tp -> CType_decl.type_ptr_to_sil_type tenv tp
match qt_opt with
| Some qt -> CType_decl.qual_type_to_sil_type tenv qt
| None -> typ (* Some default type since the type is missing *) in
{ empty_res_trans with
exps = [(Exp.Sizeof (sizeof_typ, None, Subtype.exact), sizeof_typ)] }
@ -437,7 +437,7 @@ struct
let root_node' = GotoLabel.find_goto_label trans_state.context label_name sil_loc in
{ empty_res_trans with root_nodes = [root_node']; leaf_nodes = trans_state.succ_nodes }
let get_builtin_pname_opt trans_unit_ctx qual_name decl_opt type_ptr =
let get_builtin_pname_opt trans_unit_ctx qual_name decl_opt (qual_type : Clang_ast_t.qual_type) =
let get_annotate_attr_arg decl =
let open Clang_ast_t in
let decl_info = Clang_ast_proj.get_decl_tuple decl in
@ -458,9 +458,9 @@ struct
Some (Typ.Procname.from_string_c_fun attr)
| _ when CTrans_models.is_modeled_builtin name ->
Some (Typ.Procname.from_string_c_fun (CFrontend_config.infer ^ name))
| _ when CTrans_models.is_release_builtin name type_ptr ->
| _ when CTrans_models.is_release_builtin name qual_type.qt_type_ptr ->
Some BuiltinDecl.__objc_release_cf
| _ when CTrans_models.is_retain_builtin name type_ptr ->
| _ when CTrans_models.is_retain_builtin name qual_type.qt_type_ptr ->
Some BuiltinDecl.__objc_retain_cf
| _ when String.equal name CFrontend_config.malloc &&
CGeneral_utils.is_objc_extension trans_unit_ctx ->
@ -471,13 +471,13 @@ struct
let function_deref_trans trans_state decl_ref =
let open CContext in
let context = trans_state.context in
let name_info, decl_ptr, type_ptr = CAst_utils.get_info_from_decl_ref decl_ref in
let name_info, decl_ptr, qual_type = CAst_utils.get_info_from_decl_ref decl_ref in
let decl_opt = CAst_utils.get_function_decl_with_body decl_ptr in
Option.iter ~f:(call_translation context) decl_opt;
let qual_name = CAst_utils.get_qualified_name name_info in
let typ = CType_decl.type_ptr_to_sil_type context.tenv type_ptr in
let typ = CType_decl.qual_type_to_sil_type context.tenv qual_type in
let pname =
match get_builtin_pname_opt context.translation_unit_context qual_name decl_opt type_ptr with
match get_builtin_pname_opt context.translation_unit_context qual_name decl_opt qual_type with
| Some builtin_pname -> builtin_pname
| None ->
let name = QualifiedCppName.to_qual_string qual_name in
@ -488,9 +488,9 @@ struct
let open CContext in
let context = trans_state.context in
let sil_loc = CLocation.get_sil_location stmt_info context in
let name_info, _, type_ptr = CAst_utils.get_info_from_decl_ref decl_ref in
let name_info, _, qual_type = CAst_utils.get_info_from_decl_ref decl_ref in
Logging.out_debug "!!!!! Dealing with field '%s' @." name_info.Clang_ast_t.ni_name;
let field_typ = CType_decl.type_ptr_to_sil_type context.tenv type_ptr in
let field_typ = CType_decl.qual_type_to_sil_type context.tenv qual_type in
let (obj_sil, class_typ) = extract_exp_from_list pre_trans_result.exps
"WARNING: in Field dereference we expect to know the object\n" in
let is_pointer_typ = match class_typ.desc with
@ -511,7 +511,7 @@ struct
(* it's done in var_deref_trans. The only exception is during field initialization in*)
(* constructor's initializer list (when reference itself is initialized) *)
let should_add_deref = (not is_pointer_typ) ||
(not is_constructor_init && CType.is_reference_type type_ptr) in
(not is_constructor_init && CType.is_reference_type qual_type) in
let exp, deref_instrs = if should_add_deref then
let id = Ident.create_fresh Ident.knormal in
let deref_instr = Sil.Load (id, field_exp, field_typ, sil_loc) in
@ -525,12 +525,12 @@ struct
let open CContext in
let context = trans_state.context in
let sil_loc = CLocation.get_sil_location stmt_info context in
let name_info, decl_ptr, type_ptr = CAst_utils.get_info_from_decl_ref decl_ref in
let name_info, decl_ptr, qual_type = CAst_utils.get_info_from_decl_ref decl_ref in
let decl_opt = CAst_utils.get_function_decl_with_body decl_ptr in
Option.iter ~f:(call_translation context) decl_opt;
let method_name = CAst_utils.get_unqualified_name name_info in
Logging.out_debug "!!!!! Dealing with method '%s' @." method_name;
let method_typ = CType_decl.type_ptr_to_sil_type context.tenv type_ptr in
let method_typ = CType_decl.qual_type_to_sil_type context.tenv qual_type in
let ms_opt = CMethod_trans.method_signature_of_pointer
context.translation_unit_context context.tenv decl_ptr in
let is_instance_method = match ms_opt with
@ -566,7 +566,7 @@ struct
let qual_method_name = CAst_utils.get_qualified_name name_info in
let pname =
match get_builtin_pname_opt context.translation_unit_context qual_method_name decl_opt
type_ptr with
qual_type with
| Some builtin_pname -> builtin_pname
| None ->
let class_typename = Typ.Name.Cpp.from_qual_name Typ.NoTemplate
@ -580,9 +580,10 @@ struct
instrs = pre_trans_result.instrs @ extra_instrs;
}
let destructor_deref_trans trans_state pvar_trans_result class_type_ptr si =
let destructor_deref_trans trans_state pvar_trans_result class_qual_type si =
let open Clang_ast_t in
let destruct_decl_ref_opt = match CAst_utils.get_decl_from_typ_ptr class_type_ptr with
let destruct_decl_ref_opt =
match CAst_utils.get_decl_from_typ_ptr class_qual_type.Clang_ast_t.qt_type_ptr with
| Some CXXRecordDecl (_, _, _ , _, _, _, _, cxx_record_info)
| Some ClassTemplateSpecializationDecl (_, _, _, _, _, _, _, cxx_record_info, _) ->
cxx_record_info.xrdi_destructor
@ -592,20 +593,20 @@ struct
method_deref_trans trans_state pvar_trans_result decl_ref si `CXXDestructor
| None -> empty_res_trans
let this_expr_trans trans_state sil_loc class_type_ptr =
let this_expr_trans trans_state sil_loc class_qual_type =
let context = trans_state.context in
let procname = Procdesc.get_proc_name context.CContext.procdesc in
let name = CFrontend_config.this in
let pvar = Pvar.mk (Mangled.from_string name) procname in
let exp = Exp.Lvar pvar in
let typ = CType_decl.type_ptr_to_sil_type context.CContext.tenv class_type_ptr in
let typ = CType_decl.qual_type_to_sil_type context.CContext.tenv class_qual_type in
let exps = [(exp, typ)] in
(* there is no cast operation in AST, but backend needs it *)
dereference_value_from_result sil_loc { empty_res_trans with exps = exps } ~strip_pointer:false
let cxxThisExpr_trans trans_state stmt_info expr_info =
let sil_loc = CLocation.get_sil_location stmt_info trans_state.context in
this_expr_trans trans_state sil_loc expr_info.Clang_ast_t.ei_type_ptr
this_expr_trans trans_state sil_loc expr_info.Clang_ast_t.ei_qual_type
let rec labelStmt_trans trans_state stmt_info stmt_list label_name =
let context = trans_state.context in
@ -622,8 +623,8 @@ struct
and var_deref_trans trans_state stmt_info (decl_ref : Clang_ast_t.decl_ref) =
let context = trans_state.context in
let _, _, type_ptr = CAst_utils.get_info_from_decl_ref decl_ref in
let ast_typ = CType_decl.type_ptr_to_sil_type context.tenv type_ptr in
let _, _, qual_type = CAst_utils.get_info_from_decl_ref decl_ref in
let ast_typ = CType_decl.qual_type_to_sil_type context.tenv qual_type in
let typ =
match ast_typ.Typ.desc with
| Tstruct _ when decl_ref.dr_kind = `ParmVar ->
@ -713,8 +714,8 @@ struct
and enum_constant_trans trans_state decl_ref =
let context = trans_state.context in
let _, _, type_ptr = CAst_utils.get_info_from_decl_ref decl_ref in
let typ = CType_decl.type_ptr_to_sil_type context.CContext.tenv type_ptr in
let _, _, qual_type = CAst_utils.get_info_from_decl_ref decl_ref in
let typ = CType_decl.qual_type_to_sil_type context.CContext.tenv qual_type in
let const_exp = get_enum_constant_expr context decl_ref.Clang_ast_t.dr_decl_pointer in
{ empty_res_trans with exps = [(const_exp, typ)] }
@ -770,7 +771,7 @@ struct
let trans_state' = { trans_state_pri with succ_nodes = [] } in
let sil_loc = CLocation.get_sil_location stmt_info context in
let typ =
CType_decl.type_ptr_to_sil_type context.CContext.tenv expr_info.Clang_ast_t.ei_type_ptr in
CType_decl.qual_type_to_sil_type context.CContext.tenv expr_info.Clang_ast_t.ei_qual_type in
match stmt_list with
| [s1; s2] -> (* Assumption: We expect precisely 2 stmt corresponding to the 2 operands*)
let rhs_owning_method = CTrans_utils.is_owning_method s2 in
@ -992,9 +993,9 @@ struct
params_stmt si (Typ.mk Tvoid) false extra_res_trans in
{ res_trans with exps=extra_res_trans.exps }
and cxx_destructor_call_trans trans_state si this_res_trans class_type_ptr =
and cxx_destructor_call_trans trans_state si this_res_trans class_qual_type =
let trans_state_pri = PriorityNode.try_claim_priority_node trans_state si in
let res_trans_callee = destructor_deref_trans trans_state this_res_trans class_type_ptr si in
let res_trans_callee = destructor_deref_trans trans_state this_res_trans class_qual_type si in
let is_cpp_call_virtual = res_trans_callee.is_cpp_call_virtual in
if res_trans_callee.exps <> [] then
cxx_method_construct_call_trans trans_state_pri res_trans_callee [] si (Typ.mk Tvoid)
@ -1015,11 +1016,11 @@ struct
else if String.equal selector CFrontend_config.alloc ||
String.equal selector CFrontend_config.new_str then
match receiver_kind with
| `Class type_ptr ->
| `Class qual_type ->
let class_opt =
CMethod_trans.get_class_name_method_call_from_clang
context.translation_unit_context context.CContext.tenv obj_c_message_expr_info in
Some (new_or_alloc_trans trans_state_pri sil_loc si type_ptr class_opt selector)
Some (new_or_alloc_trans trans_state_pri sil_loc si qual_type class_opt selector)
| _ -> None
(* assertions *)
else if CTrans_models.is_handleFailureInMethod selector then
@ -1135,8 +1136,8 @@ struct
(match stmt_list with
| [cond; exp1; exp2] ->
let typ =
CType_decl.type_ptr_to_sil_type
context.CContext.tenv expr_info.Clang_ast_t.ei_type_ptr in
CType_decl.qual_type_to_sil_type
context.CContext.tenv expr_info.Clang_ast_t.ei_qual_type in
let var_typ = add_reference_if_glvalue typ expr_info in
let join_node = create_node (Procdesc.Node.Join_node) [] sil_loc context in
Procdesc.node_set_succs_exn context.procdesc join_node succ_nodes [];
@ -1622,7 +1623,7 @@ struct
let trans_state_pri = PriorityNode.try_claim_priority_node trans_state stmt_info in
let sil_loc = CLocation.get_sil_location stmt_info context in
let var_type =
CType_decl.type_ptr_to_sil_type context.CContext.tenv expr_info.Clang_ast_t.ei_type_ptr in
CType_decl.qual_type_to_sil_type context.CContext.tenv expr_info.Clang_ast_t.ei_qual_type in
let lh = var_or_zero_in_init_list tenv var_exp var_type ~return_zero:false in
let res_trans_subexpr_list =
initListExpr_initializers_trans trans_state var_exp 0 stmts typ false stmt_info in
@ -1722,19 +1723,17 @@ struct
let do_var_dec (di, var_name, qual_type, vdi) next_node =
let var_decl = VarDecl (di, var_name, qual_type, vdi) in
let pvar = CVar_decl.sil_var_of_decl context var_decl procname in
let typ = CType_decl.type_ptr_to_sil_type
context.CContext.tenv
qual_type.Clang_ast_t.qt_type_ptr in
let typ = CType_decl.qual_type_to_sil_type context.CContext.tenv qual_type in
CVar_decl.add_var_to_locals procdesc var_decl typ pvar;
let trans_state' = { trans_state with succ_nodes = next_node } in
init_expr_trans trans_state' (Exp.Lvar pvar, typ) stmt_info vdi.Clang_ast_t.vdi_init_expr in
match var_decls with
| [] -> { empty_res_trans with root_nodes = next_nodes }
| VarDecl (di, n, tp, vdi) :: var_decls' ->
| VarDecl (di, n, qt, vdi) :: var_decls' ->
(* Var are defined when procdesc is created, here we only take care of initialization*)
let res_trans_vd = collect_all_decl trans_state var_decls' next_nodes stmt_info in
let res_trans_tmp = do_var_dec (di, n, tp, vdi) res_trans_vd.root_nodes in
let res_trans_tmp = do_var_dec (di, n, qt, vdi) res_trans_vd.root_nodes in
{ empty_res_trans with
root_nodes = res_trans_tmp.root_nodes; leaf_nodes = [];
instrs = res_trans_tmp.instrs @ res_trans_vd.instrs;
@ -1824,7 +1823,7 @@ struct
"WARNING: In CastExpr There must be only one stmt defining the expression to be cast.\n" in
let res_trans_stmt = instruction trans_state stmt in
let typ =
CType_decl.type_ptr_to_sil_type context.CContext.tenv expr_info.Clang_ast_t.ei_type_ptr in
CType_decl.qual_type_to_sil_type context.CContext.tenv expr_info.Clang_ast_t.ei_qual_type in
let cast_kind = cast_expr_info.Clang_ast_t.cei_cast_kind in
(* This gives the differnece among cast operations kind*)
let is_objc_bridged_cast_expr _ stmt =
@ -1872,8 +1871,8 @@ struct
extract_exp_from_list res_trans_stmt.exps
"\nWARNING: Missing operand in unary operator. NEED FIXING.\n" in
let ret_typ =
CType_decl.type_ptr_to_sil_type
context.CContext.tenv expr_info.Clang_ast_t.ei_type_ptr in
CType_decl.qual_type_to_sil_type
context.CContext.tenv expr_info.Clang_ast_t.ei_qual_type in
let exp_op, instr_op =
CArithmetic_trans.unary_operation_instruction
context.translation_unit_context unary_operator_info sil_e' ret_typ sil_loc in
@ -1954,7 +1953,7 @@ struct
and objCBoxedExpr_trans trans_state info sel stmt_info stmts =
let typ =
CType_decl.class_from_pointer_type
trans_state.context.CContext.tenv info.Clang_ast_t.ei_type_ptr in
trans_state.context.CContext.tenv info.Clang_ast_t.ei_qual_type in
let obj_c_message_expr_info = Ast_expressions.make_obj_c_message_expr_info_class sel typ None in
let message_stmt =
Clang_ast_t.ObjCMessageExpr (stmt_info, stmts, info, obj_c_message_expr_info) in
@ -1963,7 +1962,7 @@ struct
and objCArrayLiteral_trans trans_state info stmt_info stmts =
let typ =
CType_decl.class_from_pointer_type
trans_state.context.CContext.tenv info.Clang_ast_t.ei_type_ptr in
trans_state.context.CContext.tenv info.Clang_ast_t.ei_qual_type in
let meth = CFrontend_config.array_with_objects_count_m in
let obj_c_mes_expr_info = Ast_expressions.make_obj_c_message_expr_info_class meth typ None in
let stmts = stmts @ [Ast_expressions.create_nil stmt_info] in
@ -1973,7 +1972,7 @@ struct
and objCDictionaryLiteral_trans trans_state info stmt_info stmts =
let typ =
CType_decl.class_from_pointer_type
trans_state.context.CContext.tenv info.Clang_ast_t.ei_type_ptr in
trans_state.context.CContext.tenv info.Clang_ast_t.ei_qual_type in
let dictionary_literal_pname = BuiltinDecl.__objc_dictionary_literal in
let dictionary_literal_s = Typ.Procname.get_method dictionary_literal_pname in
let obj_c_message_expr_info =
@ -1987,10 +1986,10 @@ struct
and objCStringLiteral_trans trans_state stmt_info stmts info =
let stmts = [Ast_expressions.create_implicit_cast_expr stmt_info stmts
Ast_expressions.create_char_star_type `ArrayToPointerDecay] in
(Ast_expressions.create_char_star_type ~is_const:true) `ArrayToPointerDecay] in
let typ =
CType_decl.class_from_pointer_type
trans_state.context.CContext.tenv info.Clang_ast_t.ei_type_ptr in
trans_state.context.CContext.tenv info.Clang_ast_t.ei_qual_type in
let meth = CFrontend_config.string_with_utf8_m in
let obj_c_mess_expr_info = Ast_expressions.make_obj_c_message_expr_info_class meth typ None in
let message_stmt = Clang_ast_t.ObjCMessageExpr (stmt_info, stmts, info, obj_c_mess_expr_info) in
@ -2040,9 +2039,9 @@ struct
match decl with
| Clang_ast_t.BlockDecl (_, block_decl_info) ->
let open CContext in
let type_ptr = expr_info.Clang_ast_t.ei_type_ptr in
let qual_type = expr_info.Clang_ast_t.ei_qual_type in
let block_pname = CProcname.mk_fresh_block_procname procname in
let typ = CType_decl.type_ptr_to_sil_type context.tenv type_ptr in
let typ = CType_decl.qual_type_to_sil_type context.tenv qual_type in
(* We need to set the explicit dependency between the newly created block and the *)
(* defining procedure. We add an edge in the call graph.*)
Cg.add_edge context.cg procname block_pname;
@ -2050,7 +2049,7 @@ struct
let captureds = CVar_decl.captured_vars_from_block_info context captured_block_vars in
let ids_instrs = List.map ~f:assign_captured_var captureds in
let ids, instrs = List.unzip ids_instrs in
let block_data = (context, type_ptr, block_pname, captureds) in
let block_data = (context, qual_type, block_pname, captureds) in
F.function_decl context.translation_unit_context context.tenv context.cfg context.cg decl
(Some block_data);
let captured_vars =
@ -2095,12 +2094,12 @@ struct
and lambdaExpr_trans trans_state expr_info decl =
let open CContext in
let type_ptr = expr_info.Clang_ast_t.ei_type_ptr in
let qual_type = expr_info.Clang_ast_t.ei_qual_type in
let context = trans_state.context in
call_translation context decl;
let procname = Procdesc.get_proc_name context.procdesc in
let lambda_pname = CMethod_trans.get_procname_from_cpp_lambda context decl in
let typ = CType_decl.type_ptr_to_sil_type context.tenv type_ptr in
let typ = CType_decl.qual_type_to_sil_type context.tenv qual_type in
(* We need to set the explicit dependency between the newly created lambda and the *)
(* defining procedure. We add an edge in the call graph.*)
Cg.add_edge context.cg procname lambda_pname;
@ -2216,14 +2215,14 @@ struct
let trans_state' = { trans_state with var_exp_typ = var_exp_typ } in
instruction trans_state' stmt
and cxxDynamicCastExpr_trans trans_state stmt_info stmts cast_type_ptr =
and cxxDynamicCastExpr_trans trans_state stmt_info stmts cast_qual_type =
let trans_state_pri = PriorityNode.try_claim_priority_node trans_state stmt_info in
let trans_state' = { trans_state_pri with succ_nodes = [] } in
let context = trans_state.context in
let subtypes = Subtype.subtypes_cast in
let tenv = context.CContext.tenv in
let sil_loc = CLocation.get_sil_location stmt_info context in
let cast_type = CType_decl.type_ptr_to_sil_type tenv cast_type_ptr in
let cast_type = CType_decl.qual_type_to_sil_type tenv cast_qual_type in
let sizeof_expr = match cast_type.desc with
| Typ.Tptr (typ, _) -> Exp.Sizeof (typ, None, subtypes)
| _ -> assert false in
@ -2308,8 +2307,7 @@ struct
let context = trans_state.context in
let tenv = context.CContext.tenv in
let sil_loc = CLocation.get_sil_location stmt_info trans_state.context in
let type_pointer = expr_info.Clang_ast_t.ei_type_ptr in
let typ = CType_decl.type_ptr_to_sil_type tenv type_pointer in
let typ = CType_decl.qual_type_to_sil_type tenv expr_info.Clang_ast_t.ei_qual_type in
let fun_name = Typ.Procname.from_string_c_fun CFrontend_config.infer_skip_fun in
let trans_state_pri = PriorityNode.try_claim_priority_node trans_state stmt_info in
let trans_state_param = { trans_state_pri with succ_nodes = [] } in
@ -2606,8 +2604,8 @@ struct
(* right now we ignore this expression and try to translate the child node *)
parenExpr_trans trans_state stmt_list
| CXXDynamicCastExpr (stmt_info, stmts, _, _, type_ptr, _) ->
cxxDynamicCastExpr_trans trans_state stmt_info stmts type_ptr
| CXXDynamicCastExpr (stmt_info, stmts, _, _, qual_type, _) ->
cxxDynamicCastExpr_trans trans_state stmt_info stmts qual_type
| CXXDefaultArgExpr (_, _, _, default_expr_info)
| CXXDefaultInitExpr (_, _, _, default_expr_info) ->
@ -2676,8 +2674,9 @@ struct
let child_stmt_info =
{ (Ast_expressions.dummy_stmt_info ()) with Clang_ast_t.si_source_range = source_range } in
let trans_state' = PriorityNode.try_claim_priority_node trans_state this_stmt_info in
let class_type_ptr = Ast_expressions.create_pointer_type (Clang_ast_extend.DeclPtr class_ptr) in
let this_res_trans = this_expr_trans trans_state' sil_loc class_type_ptr in
let class_qual_type = Ast_expressions.create_pointer_qual_type ~is_const:false
(CAst_utils.qual_type_of_decl_ptr class_ptr) in
let this_res_trans = this_expr_trans trans_state' sil_loc class_qual_type in
let var_res_trans = match ctor_init.Clang_ast_t.xci_subject with
| `Delegating _ | `BaseClass _ ->
let this_exp, this_typ = extract_exp_from_list this_res_trans.exps

@ -73,7 +73,7 @@ let is_modeled_attribute attr_name =
let get_first_param_typedef_string_opt type_ptr =
match CAst_utils.get_desugared_type type_ptr with
| Some Clang_ast_t.FunctionProtoType (_, _, {pti_params_type = [param_ptr]}) ->
CAst_utils.name_opt_of_typedef_type_ptr param_ptr
CAst_utils.name_opt_of_typedef_qual_type param_ptr
|> Option.map ~f:QualifiedCppName.to_qual_string
| _ -> None
@ -150,7 +150,7 @@ let get_predefined_ms_stringWithUTF8String class_name method_name mk_procname la
String.equal method_name CFrontend_config.string_with_utf8_m in
let id_type = Ast_expressions.create_id_type in
let args = [(Mangled.from_string "x",
Ast_expressions.create_char_star_qual_type ~is_const:true)] in
Ast_expressions.create_char_star_type ~is_const:true)] in
get_predefined_ms_method condition class_name method_name Typ.Procname.ObjCClassMethod
mk_procname lang args id_type [] None

@ -351,9 +351,9 @@ let objc_new_trans trans_state loc stmt_info cls_name function_type =
PriorityNode.compute_results_to_parent trans_state loc nname stmt_info [res_trans_tmp] in
{ res_trans with exps = [(Exp.Var init_ret_id, alloc_ret_type)]}
let new_or_alloc_trans trans_state loc stmt_info type_ptr class_name_opt selector =
let new_or_alloc_trans trans_state loc stmt_info qual_type class_name_opt selector =
let tenv = trans_state.context.CContext.tenv in
let function_type = CType_decl.type_ptr_to_sil_type tenv type_ptr in
let function_type = CType_decl.qual_type_to_sil_type tenv qual_type in
let class_name =
match class_name_opt with
| Some class_name -> class_name
@ -548,20 +548,20 @@ let extract_stmt_from_singleton stmt_list warning_string =
let rec get_type_from_exp_stmt stmt =
let do_decl_ref_exp i =
match i.Clang_ast_t.drti_decl_ref with
| Some d -> (match d.Clang_ast_t.dr_type_ptr with
| Some d -> (match d.Clang_ast_t.dr_qual_type with
| 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_type_ptr
| MemberExpr (_, _, ei, _) -> ei.Clang_ast_t.ei_type_ptr
| ParenExpr (_, _, ei) -> ei.Clang_ast_t.ei_type_ptr
| ArraySubscriptExpr(_, _, ei) -> ei.Clang_ast_t.ei_type_ptr
| ObjCIvarRefExpr (_, _, ei, _) -> ei.Clang_ast_t.ei_type_ptr
| ObjCMessageExpr (_, _, ei, _ ) -> ei.Clang_ast_t.ei_type_ptr
| PseudoObjectExpr(_, _, ei) -> ei.Clang_ast_t.ei_type_ptr
| CallExpr(_, _, ei) -> ei.Clang_ast_t.ei_qual_type
| MemberExpr (_, _, ei, _) -> ei.Clang_ast_t.ei_qual_type
| ParenExpr (_, _, ei) -> ei.Clang_ast_t.ei_qual_type
| ArraySubscriptExpr(_, _, ei) -> ei.Clang_ast_t.ei_qual_type
| ObjCIvarRefExpr (_, _, ei, _) -> ei.Clang_ast_t.ei_qual_type
| ObjCMessageExpr (_, _, ei, _ ) -> ei.Clang_ast_t.ei_qual_type
| PseudoObjectExpr(_, _, ei) -> ei.Clang_ast_t.ei_qual_type
| CStyleCastExpr(_, stmt_list, _, _, _)
| UnaryOperator(_, stmt_list, _, _)
| ImplicitCastExpr(_, stmt_list, _, _) ->
@ -658,7 +658,7 @@ let rec contains_opaque_value_expr s =
(* checks if a unary operator is a logic negation applied to integers*)
let is_logical_negation_of_int tenv ei uoi =
match (CType_decl.type_ptr_to_sil_type tenv ei.Clang_ast_t.ei_type_ptr).desc,
match (CType_decl.qual_type_to_sil_type tenv ei.Clang_ast_t.ei_qual_type).desc,
uoi.Clang_ast_t.uoi_kind with
| Typ.Tint _,`LNot -> true
| _, _ -> false
@ -668,8 +668,8 @@ let rec is_block_stmt stmt =
match stmt with
| BlockExpr _ -> true
| DeclRefExpr (_, _, expr_info, _) ->
let tp = expr_info.Clang_ast_t.ei_type_ptr in
CType.is_block_type tp
let qt = expr_info.Clang_ast_t.ei_qual_type in
CType.is_block_type qt
| _ -> (match snd (Clang_ast_proj.get_stmt_tuple stmt) with
| [sub_stmt] -> is_block_stmt sub_stmt
| _ -> false)

@ -76,7 +76,7 @@ val is_enumeration_constant : Clang_ast_t.stmt -> bool
val is_member_exp : Clang_ast_t.stmt -> bool
val get_type_from_exp_stmt : Clang_ast_t.stmt -> Clang_ast_t.type_ptr
val get_type_from_exp_stmt : Clang_ast_t.stmt -> Clang_ast_t.qual_type
(** Given trans_result with ONE expression, create temporary variable with dereferenced value of an
expression assigned to it *)
@ -109,7 +109,7 @@ val alloc_trans :
Typ.Procname.t option -> trans_result
val new_or_alloc_trans : trans_state -> Location.t -> Clang_ast_t.stmt_info ->
Clang_ast_t.type_ptr -> Typ.Name.t option -> string -> trans_result
Clang_ast_t.qual_type -> Typ.Name.t option -> string -> trans_result
val cpp_new_trans : Location.t -> Typ.t -> Exp.t option -> trans_result

@ -59,8 +59,8 @@ let pointer_attribute_of_objc_attribute attr_info =
| `OCL_Weak -> Typ.Pk_objc_weak
| `OCL_Autoreleasing -> Typ.Pk_objc_autoreleasing
let rec build_array_type translate_decl tenv type_ptr n_opt =
let array_type = type_ptr_to_sil_type translate_decl tenv type_ptr in
let rec build_array_type translate_decl tenv (qual_type : Clang_ast_t.qual_type) n_opt =
let array_type = qual_type_to_sil_type translate_decl tenv qual_type in
let len = Option.map ~f:(fun n -> IntLit.of_int64 (Int64.of_int n)) n_opt in
Typ.mk (Tarray (array_type, len))
@ -68,8 +68,8 @@ and sil_type_of_attr_type translate_decl tenv type_info attr_info =
match type_info.Clang_ast_t.ti_desugared_type with
| Some type_ptr ->
(match CAst_utils.get_type type_ptr with
| Some Clang_ast_t.ObjCObjectPointerType (_, {Clang_ast_t.qt_type_ptr}) ->
let typ = type_ptr_to_sil_type translate_decl tenv qt_type_ptr in
| Some Clang_ast_t.ObjCObjectPointerType (_, qual_type) ->
let typ = qual_type_to_sil_type translate_decl tenv qual_type in
Typ.mk (Tptr (typ, pointer_attribute_of_objc_attribute attr_info))
| _ -> type_ptr_to_sil_type translate_decl tenv type_ptr)
| None -> Typ.mk Tvoid
@ -80,48 +80,48 @@ and sil_type_of_c_type translate_decl tenv c_type : Typ.t =
| NoneType _ -> Typ.mk Tvoid
| BuiltinType (_, builtin_type_kind) ->
sil_type_of_builtin_type_kind builtin_type_kind
| PointerType (_, {Clang_ast_t.qt_type_ptr})
| ObjCObjectPointerType (_, {Clang_ast_t.qt_type_ptr}) ->
let typ = type_ptr_to_sil_type translate_decl tenv qt_type_ptr in
| PointerType (_, qual_type)
| ObjCObjectPointerType (_, qual_type) ->
let typ = qual_type_to_sil_type translate_decl tenv qual_type in
if Typ.equal typ (get_builtin_objc_type `ObjCClass) then
typ
else Typ.mk (Tptr (typ, Typ.Pk_pointer))
| ObjCObjectType (_, objc_object_type_info) ->
type_ptr_to_sil_type translate_decl tenv objc_object_type_info.Clang_ast_t.base_type
| BlockPointerType (_, type_ptr) ->
let typ = type_ptr_to_sil_type translate_decl tenv type_ptr in
| BlockPointerType (_, qual_type) ->
let typ = qual_type_to_sil_type translate_decl tenv qual_type in
Typ.mk (Tptr (typ, Typ.Pk_pointer))
| IncompleteArrayType (_, type_ptr)
| DependentSizedArrayType (_, type_ptr)
| VariableArrayType (_, type_ptr) ->
build_array_type translate_decl tenv type_ptr None
| ConstantArrayType (_, type_ptr, n) ->
build_array_type translate_decl tenv type_ptr (Some n)
| IncompleteArrayType (_, qual_type)
| DependentSizedArrayType (_, qual_type)
| VariableArrayType (_, qual_type) ->
build_array_type translate_decl tenv qual_type None
| ConstantArrayType (_, qual_type, n) ->
build_array_type translate_decl tenv qual_type (Some n)
| FunctionProtoType _
| FunctionNoProtoType _ ->
Typ.mk (Tfun false)
| ParenType (_, type_ptr) ->
type_ptr_to_sil_type translate_decl tenv type_ptr
| DecayedType (_, type_ptr) ->
type_ptr_to_sil_type translate_decl tenv type_ptr
| ParenType (_, qual_type) ->
qual_type_to_sil_type translate_decl tenv qual_type
| DecayedType (_, qual_type) ->
qual_type_to_sil_type translate_decl tenv qual_type
| RecordType (_, pointer)
| EnumType (_, pointer) ->
decl_ptr_to_sil_type translate_decl tenv pointer
| ElaboratedType (type_info) ->
(match type_info.Clang_ast_t.ti_desugared_type with
(match type_info.Clang_ast_t.ti_desugared_type with (* TODO desugar to qualtype *)
Some type_ptr -> type_ptr_to_sil_type translate_decl tenv type_ptr
| None -> Typ.mk Tvoid)
| ObjCInterfaceType (_, pointer) ->
decl_ptr_to_sil_type translate_decl tenv pointer
| RValueReferenceType (_, {Clang_ast_t.qt_type_ptr})
| LValueReferenceType (_, {Clang_ast_t.qt_type_ptr}) ->
let typ = type_ptr_to_sil_type translate_decl tenv qt_type_ptr in
| RValueReferenceType (_, qual_type)
| LValueReferenceType (_, qual_type) ->
let typ = qual_type_to_sil_type translate_decl tenv qual_type in
Typ.mk (Tptr (typ, Typ.Pk_reference))
| AttributedType (type_info, attr_info) ->
| AttributedType (type_info, attr_info) -> (* TODO desugar to qualtyp *)
sil_type_of_attr_type translate_decl tenv type_info attr_info
| _ -> (* TypedefType, etc *)
let type_info = Clang_ast_proj.get_type_tuple c_type in
match type_info.Clang_ast_t.ti_desugared_type with
match type_info.Clang_ast_t.ti_desugared_type with (* TODO desugar typedeftype to qualtype *)
| Some typ -> type_ptr_to_sil_type translate_decl tenv typ
| None -> Typ.mk Tvoid
@ -165,13 +165,16 @@ and type_ptr_to_sil_type translate_decl tenv type_ptr =
| Clang_ast_types.TypePtr.Ptr _ -> clang_type_ptr_to_sil_type translate_decl tenv type_ptr
| Clang_ast_extend.Builtin kind -> sil_type_of_builtin_type_kind kind
| Clang_ast_extend.PointerOf typ ->
let sil_typ = type_ptr_to_sil_type translate_decl tenv typ in
let sil_typ = qual_type_to_sil_type translate_decl tenv typ in
Typ.mk (Tptr (sil_typ, Pk_pointer))
| Clang_ast_extend.ReferenceOf typ ->
let sil_typ = type_ptr_to_sil_type translate_decl tenv typ in
let sil_typ = qual_type_to_sil_type translate_decl tenv typ in
Typ.mk (Tptr (sil_typ, Pk_reference))
| Clang_ast_extend.ClassType typename ->
Typ.mk (Tstruct typename)
| Clang_ast_extend.DeclPtr ptr -> decl_ptr_to_sil_type translate_decl tenv ptr
| Clang_ast_extend.ErrorType -> Typ.mk Tvoid
| _ -> raise (invalid_arg "unknown variant for type_ptr")
and qual_type_to_sil_type translate_decl tenv qual_type =
type_ptr_to_sil_type translate_decl tenv qual_type.Clang_ast_t.qt_type_ptr (* FIXME *)

@ -17,3 +17,6 @@ val sil_type_of_builtin_type_kind : Clang_ast_t.builtin_type_kind -> Typ.t
val type_ptr_to_sil_type : (Tenv.t -> Clang_ast_t.decl -> Typ.t) ->
Tenv.t -> Clang_ast_t.type_ptr -> Typ.t
val qual_type_to_sil_type : (Tenv.t -> Clang_ast_t.decl -> Typ.t) ->
Tenv.t -> Clang_ast_t.qual_type -> Typ.t

@ -68,9 +68,9 @@ let compute_autorelease_pool_vars context stmts =
| Clang_ast_t.DeclRefExpr (_, _, _, drei):: stmts' ->
let map1 = match drei.Clang_ast_t.drti_decl_ref with
| Some decl_ref ->
(match decl_ref.Clang_ast_t.dr_type_ptr with
| Some type_ptr when decl_ref.Clang_ast_t.dr_kind = `Var ->
let typ = CType_decl.type_ptr_to_sil_type context.CContext.tenv type_ptr in
(match decl_ref.Clang_ast_t.dr_qual_type with
| Some qual_type when decl_ref.Clang_ast_t.dr_kind = `Var ->
let typ = CType_decl.qual_type_to_sil_type context.CContext.tenv qual_type in
let procname = Procdesc.get_proc_name context.CContext.procdesc in
let pvar = sil_var_of_decl_ref context decl_ref procname in
if Pvar.is_local pvar then
@ -93,15 +93,15 @@ let captured_vars_from_block_info context cvl =
let sil_var_of_captured_var cv vars =
match cv.Clang_ast_t.bcv_variable with
| Some dr ->
(match dr.Clang_ast_t.dr_name, dr.Clang_ast_t.dr_type_ptr with
| Some name_info, Some type_ptr ->
(match dr.Clang_ast_t.dr_name, dr.Clang_ast_t.dr_qual_type with
| Some name_info, Some qual_type ->
let n = name_info.Clang_ast_t.ni_name in
if String.equal n CFrontend_config.self &&
not (CContext.is_objc_instance context) then
vars
else
let pvar = sil_var_of_decl_ref context dr procname in
let typ = CType_decl.type_ptr_to_sil_type context.CContext.tenv type_ptr in
let typ = CType_decl.qual_type_to_sil_type context.CContext.tenv qual_type in
(pvar, typ) :: vars
| _ -> assert false)
| _ -> assert false in

@ -17,8 +17,8 @@ open! IStd
(* Type pointers *)
type Clang_ast_types.TypePtr.t +=
| Builtin of Clang_ast_t.builtin_type_kind
| PointerOf of Clang_ast_types.TypePtr.t
| ReferenceOf of Clang_ast_types.TypePtr.t
| PointerOf of Clang_ast_t.qual_type
| ReferenceOf of Clang_ast_t.qual_type
| ClassType of Typ.Name.t
| DeclPtr of int
| ErrorType
@ -33,10 +33,10 @@ module TypePointerOrd = struct
| Builtin a, Builtin b -> Polymorphic_compare.compare a b
| Builtin _, _ -> 1
| _, Builtin _ -> -1
| PointerOf a, PointerOf b -> compare a b
| PointerOf a, PointerOf b -> compare_qual_type a b
| PointerOf _, _ -> 1
| _, PointerOf _ -> -1
| ReferenceOf a, ReferenceOf b -> compare a b
| ReferenceOf a, ReferenceOf b -> compare_qual_type a b
| ReferenceOf _, _ -> 1
| _, ReferenceOf _ -> -1
| ClassType a, ClassType b -> Typ.Name.compare a b
@ -47,6 +47,11 @@ module TypePointerOrd = struct
| _, DeclPtr _ -> -1
| ErrorType, ErrorType -> 0
| _ -> raise (invalid_arg ("unexpected type_ptr variants: "))
and compare_qual_type (qt1 : Clang_ast_t.qual_type) (qt2 : Clang_ast_t.qual_type) =
let (<>) = Int.(<>) in
let qt_cmp = compare qt1.qt_type_ptr qt2.qt_type_ptr in
if qt_cmp <> 0 then qt_cmp else
Bool.compare qt1.qt_is_const qt2.qt_is_const
end
module TypePointerMap = Caml.Map.Make(TypePointerOrd)
@ -55,8 +60,8 @@ module TypePointerMap = Caml.Map.Make(TypePointerOrd)
let rec type_ptr_to_string = function
| Clang_ast_types.TypePtr.Ptr raw -> "clang_ptr_" ^ (string_of_int raw)
| Builtin t -> "sil_" ^ (Clang_ast_j.string_of_builtin_type_kind t)
| PointerOf typ -> "pointer_of_" ^ type_ptr_to_string typ
| ReferenceOf typ -> "reference_of_" ^ type_ptr_to_string typ
| PointerOf typ -> "pointer_of_" ^ type_ptr_to_string typ.Clang_ast_t.qt_type_ptr
| ReferenceOf typ -> "reference_of_" ^ type_ptr_to_string typ.Clang_ast_t.qt_type_ptr
| ClassType name -> "class_name_" ^ Typ.Name.name name
| DeclPtr raw -> "decl_ptr_" ^ (string_of_int raw)
| ErrorType -> "error_type"

@ -34,17 +34,17 @@ let get_classname_from_category_decl ocdi =
let get_classname_from_category_impl ocidi =
get_classname ocidi.Clang_ast_t.ocidi_class_interface
let add_category_decl type_ptr_to_sil_type tenv category_impl_info =
let add_category_decl qual_type_to_sil_type tenv category_impl_info =
let decl_ref_opt = category_impl_info.Clang_ast_t.ocidi_category_decl in
CAst_utils.add_type_from_decl_ref type_ptr_to_sil_type tenv decl_ref_opt true
CAst_utils.add_type_from_decl_ref_opt qual_type_to_sil_type tenv decl_ref_opt true
let add_class_decl type_ptr_to_sil_type tenv category_decl_info =
let add_class_decl qual_type_to_sil_type tenv category_decl_info =
let decl_ref_opt = category_decl_info.Clang_ast_t.odi_class_interface in
CAst_utils.add_type_from_decl_ref type_ptr_to_sil_type tenv decl_ref_opt true
CAst_utils.add_type_from_decl_ref_opt qual_type_to_sil_type tenv decl_ref_opt true
let add_category_implementation type_ptr_to_sil_type tenv category_decl_info =
let add_category_implementation qual_type_to_sil_type tenv category_decl_info =
let decl_ref_opt = category_decl_info.Clang_ast_t.odi_implementation in
CAst_utils.add_type_from_decl_ref type_ptr_to_sil_type tenv decl_ref_opt false
CAst_utils.add_type_from_decl_ref_opt qual_type_to_sil_type tenv decl_ref_opt false
let get_base_class_name_from_category decl =
let open Clang_ast_t in
@ -65,8 +65,8 @@ let get_base_class_name_from_category decl =
(* Add potential extra fields defined only in the category *)
(* to the corresponding class. Update the tenv accordingly.*)
let process_category type_ptr_to_sil_type tenv class_name decl_info decl_list =
let decl_fields = CField_decl.get_fields type_ptr_to_sil_type tenv decl_list in
let process_category qual_type_to_sil_type tenv class_name decl_info decl_list =
let decl_fields = CField_decl.get_fields qual_type_to_sil_type tenv decl_list in
let class_tn_name = Typ.Name.Objc.from_qual_name class_name in
let class_tn_type = Typ.mk (Typ.Tstruct class_tn_name) in
let decl_key = Clang_ast_extend.DeclPtr decl_info.Clang_ast_t.di_pointer in
@ -81,27 +81,27 @@ let process_category type_ptr_to_sil_type tenv class_name decl_info decl_list =
| _ -> ());
class_tn_type
let category_decl type_ptr_to_sil_type tenv decl =
let category_decl qual_type_to_sil_type tenv decl =
let open Clang_ast_t in
match decl with
| ObjCCategoryDecl (decl_info, name_info, decl_list, _, cdi) ->
let name = CAst_utils.get_qualified_name name_info in
let class_name = get_classname_from_category_decl cdi in
Logging.out_debug "ADDING: ObjCCategoryDecl for '%a'\n" QualifiedCppName.pp name;
let _ = add_class_decl type_ptr_to_sil_type tenv cdi in
let typ = process_category type_ptr_to_sil_type tenv class_name decl_info decl_list in
let _ = add_category_implementation type_ptr_to_sil_type tenv cdi in
let _ = add_class_decl qual_type_to_sil_type tenv cdi in
let typ = process_category qual_type_to_sil_type tenv class_name decl_info decl_list in
let _ = add_category_implementation qual_type_to_sil_type tenv cdi in
typ
| _ -> assert false
let category_impl_decl type_ptr_to_sil_type tenv decl =
let category_impl_decl qual_type_to_sil_type tenv decl =
let open Clang_ast_t in
match decl with
| ObjCCategoryImplDecl (decl_info, name_info, decl_list, _, cii) ->
let name = CAst_utils.get_qualified_name name_info in
let class_name = get_classname_from_category_impl cii in
Logging.out_debug "ADDING: ObjCCategoryImplDecl for '%a'\n" QualifiedCppName.pp name;
let _ = add_category_decl type_ptr_to_sil_type tenv cii in
let typ = process_category type_ptr_to_sil_type tenv class_name decl_info decl_list in
let _ = add_category_decl qual_type_to_sil_type tenv cii in
let typ = process_category qual_type_to_sil_type tenv class_name decl_info decl_list in
typ
| _ -> assert false

@ -12,9 +12,9 @@ open! IStd
(** In this module an ObjC category declaration or implementation is processed. The category *)
(** is saved in the tenv as a struct with the corresponding fields and methods , and the class it belongs to *)
val category_decl : CAst_utils.type_ptr_to_sil_type -> Tenv.t -> Clang_ast_t.decl -> Typ.t
val category_decl : CAst_utils.qual_type_to_sil_type -> Tenv.t -> Clang_ast_t.decl -> Typ.t
val category_impl_decl : CAst_utils.type_ptr_to_sil_type -> Tenv.t -> Clang_ast_t.decl -> Typ.t
val category_impl_decl : CAst_utils.qual_type_to_sil_type -> Tenv.t -> Clang_ast_t.decl -> Typ.t
val noname_category : string -> string

@ -36,23 +36,23 @@ let get_protocols protocols =
) protocols in
protocol_names
let add_class_decl type_ptr_to_sil_type tenv idi =
let add_class_decl qual_type_to_sil_type tenv idi =
let decl_ref_opt = idi.Clang_ast_t.oidi_class_interface in
CAst_utils.add_type_from_decl_ref type_ptr_to_sil_type tenv decl_ref_opt true
CAst_utils.add_type_from_decl_ref_opt qual_type_to_sil_type tenv decl_ref_opt true
let add_super_class_decl type_ptr_to_sil_type tenv ocdi =
let add_super_class_decl qual_type_to_sil_type tenv ocdi =
let decl_ref_opt = ocdi.Clang_ast_t.otdi_super in
CAst_utils.add_type_from_decl_ref type_ptr_to_sil_type tenv decl_ref_opt false
CAst_utils.add_type_from_decl_ref_opt qual_type_to_sil_type tenv decl_ref_opt false
let add_protocols_decl type_ptr_to_sil_type tenv protocols =
CAst_utils.add_type_from_decl_ref_list type_ptr_to_sil_type tenv protocols
let add_protocols_decl qual_type_to_sil_type tenv protocols =
CAst_utils.add_type_from_decl_ref_list qual_type_to_sil_type tenv protocols
let add_categories_decl type_ptr_to_sil_type tenv categories =
CAst_utils.add_type_from_decl_ref_list type_ptr_to_sil_type tenv categories
let add_categories_decl qual_type_to_sil_type tenv categories =
CAst_utils.add_type_from_decl_ref_list qual_type_to_sil_type tenv categories
let add_class_implementation type_ptr_to_sil_type tenv idi =
let add_class_implementation qual_type_to_sil_type tenv idi =
let decl_ref_opt = idi.Clang_ast_t.otdi_implementation in
CAst_utils.add_type_from_decl_ref type_ptr_to_sil_type tenv decl_ref_opt false
CAst_utils.add_type_from_decl_ref_opt qual_type_to_sil_type tenv decl_ref_opt false
(*The superclass is the first element in the list of super classes of structs in the tenv, *)
(* then come the protocols and categories. *)
@ -65,16 +65,16 @@ let get_interface_supers super_opt protocols =
let super_classes = super_class@protocol_names in
super_classes
let create_supers_fields type_ptr_to_sil_type tenv decl_list
let create_supers_fields qual_type_to_sil_type tenv decl_list
otdi_super otdi_protocols =
let super = get_super_interface_decl otdi_super in
let protocols = get_protocols otdi_protocols in
let supers = get_interface_supers super protocols in
let fields = CField_decl.get_fields type_ptr_to_sil_type tenv decl_list in
let fields = CField_decl.get_fields qual_type_to_sil_type tenv decl_list in
supers, fields
(* Adds pairs (interface name, interface_type_info) to the global environment. *)
let add_class_to_tenv type_ptr_to_sil_type tenv decl_info name_info decl_list ocidi =
let add_class_to_tenv qual_type_to_sil_type tenv decl_info name_info decl_list ocidi =
let class_name = CAst_utils.get_qualified_name name_info in
Logging.out_debug "ADDING: ObjCInterfaceDecl for '%a'\n" QualifiedCppName.pp class_name;
let interface_name = Typ.Name.Objc.from_qual_name class_name in
@ -82,7 +82,7 @@ let add_class_to_tenv type_ptr_to_sil_type tenv decl_info name_info decl_list oc
let decl_key = Clang_ast_extend.DeclPtr decl_info.Clang_ast_t.di_pointer in
CAst_utils.update_sil_types_map decl_key interface_type;
let decl_supers, decl_fields =
create_supers_fields type_ptr_to_sil_type tenv decl_list
create_supers_fields qual_type_to_sil_type tenv decl_list
ocidi.Clang_ast_t.otdi_super
ocidi.Clang_ast_t.otdi_protocols in
let fields_sc = CField_decl.fields_superclass tenv ocidi in
@ -117,30 +117,30 @@ let add_class_to_tenv type_ptr_to_sil_type tenv decl_info name_info decl_list oc
interface_type
(* Interface_type_info has the name of instance variables and the name of methods. *)
let interface_declaration type_ptr_to_sil_type tenv decl =
let interface_declaration qual_type_to_sil_type tenv decl =
let open Clang_ast_t in
match decl with
| ObjCInterfaceDecl (decl_info, name_info, decl_list, _, ocidi) ->
let typ = add_class_to_tenv type_ptr_to_sil_type tenv decl_info name_info
let typ = add_class_to_tenv qual_type_to_sil_type tenv decl_info name_info
decl_list ocidi in
let _ = add_class_implementation type_ptr_to_sil_type tenv ocidi in
let _ = add_super_class_decl type_ptr_to_sil_type tenv ocidi in
let _ = add_protocols_decl type_ptr_to_sil_type tenv ocidi.Clang_ast_t.otdi_protocols in
let _ = add_class_implementation qual_type_to_sil_type tenv ocidi in
let _ = add_super_class_decl qual_type_to_sil_type tenv ocidi in
let _ = add_protocols_decl qual_type_to_sil_type tenv ocidi.Clang_ast_t.otdi_protocols in
let known_categories = ocidi.Clang_ast_t.otdi_known_categories in
let _ = add_categories_decl type_ptr_to_sil_type tenv known_categories in
let _ = add_categories_decl qual_type_to_sil_type tenv known_categories in
typ
| _ -> assert false
(* Translate the methods defined in the implementation.*)
let interface_impl_declaration type_ptr_to_sil_type tenv decl =
let interface_impl_declaration qual_type_to_sil_type tenv decl =
let open Clang_ast_t in
match decl with
| ObjCImplementationDecl (decl_info, name_info, decl_list, _, idi) ->
let class_name = CAst_utils.get_qualified_name name_info in
Logging.out_debug
"ADDING: ObjCImplementationDecl for class '%a'\n" QualifiedCppName.pp class_name;
let _ = add_class_decl type_ptr_to_sil_type tenv idi in
let fields = CField_decl.get_fields type_ptr_to_sil_type tenv decl_list in
let _ = add_class_decl qual_type_to_sil_type tenv idi in
let fields = CField_decl.get_fields qual_type_to_sil_type tenv decl_list in
CField_decl.add_missing_fields tenv class_name fields;
let class_tn_name = Typ.Name.Objc.from_qual_name class_name in
let decl_key = Clang_ast_extend.DeclPtr decl_info.Clang_ast_t.di_pointer in

@ -12,10 +12,10 @@ open! IStd
(** In this module an ObjC interface declaration is processed. The class is saved in the tenv as a
struct with the corresponding fields, potential superclass and list of defined methods *)
val interface_declaration : CAst_utils.type_ptr_to_sil_type -> Tenv.t -> Clang_ast_t.decl ->
val interface_declaration : CAst_utils.qual_type_to_sil_type -> Tenv.t -> Clang_ast_t.decl ->
Typ.t
val interface_impl_declaration : CAst_utils.type_ptr_to_sil_type -> Tenv.t -> Clang_ast_t.decl ->
val interface_impl_declaration : CAst_utils.qual_type_to_sil_type -> Tenv.t -> Clang_ast_t.decl ->
Typ.t
val is_pointer_to_objc_class : Typ.t -> bool

@ -11,11 +11,11 @@ open! IStd
module L = Logging
let add_protocol_super type_ptr_to_sil_type tenv obj_c_protocol_decl_info =
let add_protocol_super qual_type_to_sil_type tenv obj_c_protocol_decl_info =
let protocols = obj_c_protocol_decl_info.Clang_ast_t.opcdi_protocols in
CAst_utils.add_type_from_decl_ref_list type_ptr_to_sil_type tenv protocols
CAst_utils.add_type_from_decl_ref_list qual_type_to_sil_type tenv protocols
let protocol_decl type_ptr_to_sil_type tenv decl =
let protocol_decl qual_type_to_sil_type tenv decl =
let open Clang_ast_t in
match decl with
| ObjCProtocolDecl(decl_info, name_info, _, _, obj_c_protocol_decl_info) ->
@ -30,7 +30,7 @@ let protocol_decl type_ptr_to_sil_type tenv decl =
let decl_key = Clang_ast_extend.DeclPtr decl_info.Clang_ast_t.di_pointer in
CAst_utils.update_sil_types_map decl_key protocol_type;
ignore( Tenv.mk_struct tenv ~methods:[] protocol_name );
add_protocol_super type_ptr_to_sil_type tenv obj_c_protocol_decl_info;
add_protocol_super qual_type_to_sil_type tenv obj_c_protocol_decl_info;
protocol_type
| _ -> assert false

@ -12,6 +12,6 @@ open! IStd
(** In this module an ObjC protocol declaration or implementation is processed. The protocol *)
(** is saved in the tenv as a struct with the corresponding methods *)
val protocol_decl : CAst_utils.type_ptr_to_sil_type -> Tenv.t -> Clang_ast_t.decl -> Typ.t
val protocol_decl : CAst_utils.qual_type_to_sil_type -> Tenv.t -> Clang_ast_t.decl -> Typ.t
val is_protocol : Clang_ast_t.decl -> bool

Loading…
Cancel
Save