@ -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 q t =
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 , q t)
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 q t vk objc_kind = {
Clang_ast_t . ei_ qual_ type = q t;
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 q t objc_kind =
make_expr_info q t ` 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 t p pointer = {
let make_obj_c_message_expr_info_class selector t name 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 q t_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 = q t_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_ q t k decl_ptr name is_hidden q t =
make_decl_ref k decl_ptr name is_hidden ( Some q t)
let make_decl_ref_no_ tp k decl_ptr name is_hidden =
let make_decl_ref_no_ q t 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 q t =
make_decl_ref k ( CAst_utils . get_invalid_pointer () ) name is_hidden ( Some q t)
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_ q t 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_ q t ` 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_ q t ` 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_ q t ` 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: q t vname = iexp *)
let make_DeclStmt stmt_info di q t 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' ] q t ` 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_ q t = 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 q t_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_ q t 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_ q t ` 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 q t_m mname o_cast_decl_ref_exp si false in
let poe_ei = make_general_expr_info q t_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 q t 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 q t ` Ordinary in
let decl_ref = make_decl_ref_ q t ` Function decl_pointer function_name false q t 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 ] q t ` 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 , q t, _ ) :: lp' ->
( name . Clang_ast_t . ni_name , di . Clang_ast_t . di_pointer , q t) :: 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 q t_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_ q t ` Var pointer name_idx false q t_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
q t_idx ` LValueToRValue in
idx_decl_stmt , idx_decl_ref_exp , idx_cast , q t_idx
| _ -> assert false in
let cast_expr decl_ref tp =
let ei = make_expr_info tp in
let cast_expr decl_ref q t =
let ei = make_expr_info q t 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 ] q t ` 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 q t_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 q t_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_ q t = build_idx_decl pidx in
let rhs = build_PseudoObjectExpr idx_ q t 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 q t_idx =
let idx_ei = make_expr_info q t_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_ q t,
{ 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_typ e @@
make_objc_class_ type CFrontend_config . nsarray_cl in
let qt = create_pointer_qual_type ~ is_const : fals e @@
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 , q t, vdi ) in
Clang_ast_t . DeclStmt ( fresh_stmt_info stmt_info , [ init ] , [ var_decl ] ) , [ ( CFrontend_config . objects , di . Clang_ast_t . di_pointer , q t) ] 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_ q t object_cast idx_cast stop_cast =
let decl_ref = make_decl_ref_invalid ` Var qual_block_name false block_ q t in
let fun_cast = cast_expr decl_ref block_ q t 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_ q t = create_BOOL_type in
let ei = make_expr_info bool_ q t 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_ q t ` 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_ q t =
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 , q t_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 q t_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_ q t 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