@ -76,43 +76,43 @@ let stmt_info_with_fresh_pointer stmt_info = {
si_source_range = stmt_info . Clang_ast_t . si_source_range ;
}
let create_ qual_ type_with_just_pointer pointer = pointer
let create_ type_ptr _with_just_pointer pointer = pointer
let get_constant_ qual_ type s =
let get_constant_ type_ptr s =
let pointer = CFrontend_config . type_pointer_prefix ^ s in
pointer
(* Whenever new type are added manually to the translation here, *)
(* they should be added to the map in cTypes_decl too!! *)
let create_int_type =
get_constant_ qual_ type " int "
get_constant_ type_ptr " int "
let create_void_type =
get_constant_ qual_ type " void "
get_constant_ type_ptr " void "
let create_void_star_type =
get_constant_ qual_ type " void * "
get_constant_ type_ptr " void * "
let create_id_type =
get_constant_ qual_ type CFrontend_config . id_cl
get_constant_ type_ptr CFrontend_config . id_cl
let create_nsarray_star_type =
get_constant_ qual_ type ( CFrontend_config . nsarray_cl ^ " * " )
get_constant_ type_ptr ( CFrontend_config . nsarray_cl ^ " * " )
let create_char_star_type =
get_constant_ qual_ type " char * "
get_constant_ type_ptr " char * "
let create_BOOL_type =
get_constant_ qual_ type " signed char "
get_constant_ type_ptr " signed char "
let create_unsigned_long_type =
get_constant_ qual_ type " unsigned long "
get_constant_ type_ptr " unsigned long "
let create_void_unsigned_long_type =
get_constant_ qual_ type " void *(unsigned long) "
get_constant_ type_ptr " void *(unsigned long) "
let create_void_void_type =
get_constant_ qual_ type " void (void *) "
get_constant_ type_ptr " void (void *) "
let create_class_type class_name = " custom_class_name* " ^ class_name
@ -123,7 +123,7 @@ let create_pointer_type class_type = "custom_pointer_" ^ class_type
let create_integer_literal stmt_info n =
let stmt_info = dummy_stmt_info () in
let expr_info = {
Clang_ast_t . ei_ qual_ type = create_int_type ;
Clang_ast_t . ei_ type_ptr = create_int_type ;
ei_value_kind = ` RValue ;
ei_object_kind = ` Ordinary ;
} in
@ -134,9 +134,9 @@ let create_integer_literal stmt_info n =
} in
Clang_ast_t . IntegerLiteral ( stmt_info , [] , expr_info , integer_literal_info )
let create_cstyle_cast_expr stmt_info stmts q t =
let create_cstyle_cast_expr stmt_info stmts tp =
let expr_info = {
Clang_ast_t . ei_ qual_ type = create_void_star_type ;
Clang_ast_t . ei_ type_ptr = create_void_star_type ;
ei_value_kind = ` RValue ;
ei_object_kind = ` Ordinary ;
} in
@ -144,11 +144,11 @@ let create_cstyle_cast_expr stmt_info stmts qt =
Clang_ast_t . cei_cast_kind = ` NullToPointer ;
cei_base_path = [] ;
} in
Clang_ast_t . CStyleCastExpr ( stmt_info , stmts , expr_info , cast_expr , q t)
Clang_ast_t . CStyleCastExpr ( stmt_info , stmts , expr_info , cast_expr , tp )
let create_parent_expr stmt_info stmts =
let expr_info = {
Clang_ast_t . ei_ qual_ type = create_void_star_type ;
Clang_ast_t . ei_ type_ptr = create_void_star_type ;
ei_value_kind = ` RValue ;
ei_object_kind = ` Ordinary ;
} in
@ -156,7 +156,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_ qual_ type = typ ;
Clang_ast_t . ei_ type_ptr = typ ;
ei_value_kind = ` RValue ;
ei_object_kind = ` Ordinary ;
} in
@ -182,17 +182,17 @@ let make_stmt_info di = {
si_source_range = di . Clang_ast_t . di_source_range ;
}
let make_expr_info q t vk objc_kind = {
Clang_ast_t . ei_ qual_ type = q t;
let make_expr_info tp vk objc_kind = {
Clang_ast_t . ei_ type_ptr = tp ;
ei_value_kind = vk ;
ei_object_kind = objc_kind ;
}
let make_expr_info_with_objc_kind q t objc_kind =
make_expr_info q t ` LValue objc_kind
let make_expr_info_with_objc_kind tp objc_kind =
make_expr_info tp ` LValue objc_kind
let make_lvalue_obc_prop_expr_info q t =
make_expr_info q t ` LValue ` ObjCProperty
let make_lvalue_obc_prop_expr_info tp =
make_expr_info tp ` LValue ` ObjCProperty
let make_method_decl_info mdi body =
{ mdi with Clang_ast_t . omdi_body = Some body ; }
@ -211,36 +211,36 @@ 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 q t = {
let make_obj_c_message_expr_info_class selector tp = {
Clang_ast_t . omei_selector = selector ;
omei_receiver_kind = ` Class ( create_class_type q t) ;
omei_receiver_kind = ` Class ( create_class_type tp ) ;
omei_is_definition_found = false ;
omei_decl_pointer = None (* TODO look into it *)
}
let make_decl_ref k decl_ptr name is_hidden q t_opt = {
let make_decl_ref k decl_ptr name is_hidden tp _opt = {
Clang_ast_t . dr_kind = k ;
dr_decl_pointer = decl_ptr ;
dr_name = Some name ;
dr_is_hidden = is_hidden ;
dr_ qual_ type = q t_opt
dr_ type_ptr = tp _opt
}
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_ tp k decl_ptr name is_hidden tp =
make_decl_ref k decl_ptr name is_hidden ( Some tp )
let make_decl_ref_no_ q t k decl_ptr name is_hidden =
let make_decl_ref_no_ tp 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 q t =
make_decl_ref k ( Ast_utils . get_invalid_pointer () ) name is_hidden ( Some q t)
let make_decl_ref_invalid k name is_hidden tp =
make_decl_ref k ( Ast_utils . get_invalid_pointer () ) name is_hidden ( Some tp )
let make_decl_ref_self ptr q t = {
let make_decl_ref_self ptr tp = {
Clang_ast_t . dr_kind = ` ImplicitParam ;
dr_decl_pointer = ptr ;
dr_name = Some ( Ast_utils . make_name_decl " self " ) ;
dr_is_hidden = false ;
dr_ qual_ type = Some q t
dr_ type_ptr = Some tp
}
let make_decl_ref_expr_info decl_ref = {
@ -248,15 +248,15 @@ let make_decl_ref_expr_info decl_ref = {
drti_found_decl_ref = None ;
}
let make_obj_c_ivar_ref_expr_info k ptr n q t = {
Clang_ast_t . ovrei_decl_ref = make_decl_ref_ q t k ptr n false q t;
let make_obj_c_ivar_ref_expr_info k ptr n tp = {
Clang_ast_t . ovrei_decl_ref = make_decl_ref_ tp k ptr n false tp ;
ovrei_pointer = Ast_utils . get_fresh_pointer () ;
ovrei_is_free_ivar = true ;
}
(* Build an AST cast expression of a decl_ref_expr *)
let make_cast_expr q t di decl_ref_expr_info objc_kind =
let expr_info = make_expr_info_with_objc_kind q t objc_kind in
let make_cast_expr tp di decl_ref_expr_info objc_kind =
let expr_info = make_expr_info_with_objc_kind tp objc_kind in
let stmt_info = make_stmt_info di in
let decl_ref_exp = make_decl_ref_exp stmt_info expr_info decl_ref_expr_info in
let cast_expr = {
@ -268,21 +268,21 @@ let make_cast_expr qt di decl_ref_expr_info objc_kind =
cast_exp_rhs
(* Build AST expression self.field_name as `LValue *)
let make_self_field class_type di q t field_name =
let q t_class = create_pointer_type ( create_class_type class_type ) in
let expr_info = make_expr_info_with_objc_kind q t ` ObjCProperty in
let make_self_field class_type di tp field_name =
let tp _class = create_pointer_type ( create_class_type class_type ) in
let expr_info = make_expr_info_with_objc_kind tp ` ObjCProperty in
let stmt_info = make_stmt_info di in
let cast_exp = make_cast_expr q t_class di ( make_decl_ref_expr_info ( make_decl_ref_self di . Clang_ast_t . di_pointer q t_class) ) ` ObjCProperty in
let obj_c_ivar_ref_expr_info = make_obj_c_ivar_ref_expr_info ( ` ObjCIvar ) di . Clang_ast_t . di_pointer field_name q t in
let cast_exp = make_cast_expr tp _class di ( make_decl_ref_expr_info ( make_decl_ref_self di . Clang_ast_t . di_pointer tp _class) ) ` ObjCProperty in
let obj_c_ivar_ref_expr_info = make_obj_c_ivar_ref_expr_info ( ` ObjCIvar ) di . Clang_ast_t . di_pointer field_name tp in
let ivar_ref_exp =
Clang_ast_t . ObjCIvarRefExpr ( stmt_info , [ cast_exp ] , expr_info , obj_c_ivar_ref_expr_info ) in
ivar_ref_exp
(* Build AST expression for self.field_name casted as `RValue. *)
let make_deref_self_field class_decl_opt di q t field_name =
let make_deref_self_field class_decl_opt di tp field_name =
let stmt_info = make_stmt_info di in
let ivar_ref_exp = make_self_field class_decl_opt di q t field_name in
let expr_info' = make_expr_info_with_objc_kind q t ` ObjCProperty in
let ivar_ref_exp = make_self_field class_decl_opt di tp field_name in
let expr_info' = make_expr_info_with_objc_kind tp ` ObjCProperty in
let cast_exp_info = {
Clang_ast_t . cei_cast_kind = ` LValueToRValue ;
cei_base_path = [] ;
@ -291,7 +291,7 @@ let make_deref_self_field class_decl_opt di qt field_name =
Clang_ast_t . ImplicitCastExpr ( stmt_info , [ ivar_ref_exp ] , expr_info' , cast_exp_info ) in
cast_exp'
let make_objc_ivar_decl decl_info q t property_impl_decl_info ivar_name =
let make_objc_ivar_decl decl_info tp property_impl_decl_info ivar_name =
let field_decl_info = {
Clang_ast_t . fldi_is_mutable = true ;
fldi_is_module_private = true ;
@ -302,16 +302,16 @@ let make_objc_ivar_decl decl_info qt property_impl_decl_info ivar_name =
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
Clang_ast_t . ObjCIvarDecl ( decl_info , ivar_name , q t, field_decl_info , obj_c_ivar_decl_info )
Clang_ast_t . ObjCIvarDecl ( decl_info , ivar_name , tp , field_decl_info , obj_c_ivar_decl_info )
let make_expr_info q t = {
Clang_ast_t . ei_ qual_ type = q t;
let make_expr_info tp = {
Clang_ast_t . ei_ type_ptr = tp ;
ei_value_kind = ` LValue ;
ei_object_kind = ` ObjCProperty
}
let make_general_expr_info q t vk ok = {
Clang_ast_t . ei_ qual_ type = q t;
let make_general_expr_info tp vk ok = {
Clang_ast_t . ei_ type_ptr = tp ;
ei_value_kind = vk ;
ei_object_kind = ok
}
@ -320,21 +320,21 @@ 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_decl_ref_exp_var ( var_name , var_ q t, var_ptr ) var_kind stmt_info =
let make_decl_ref_exp_var ( var_name , var_ tp , var_ptr ) var_kind stmt_info =
let stmt_info = stmt_info_with_fresh_pointer stmt_info in
let decl_ref = make_decl_ref_ q t var_kind var_ptr var_name false var_ q t in
let expr_info = make_expr_info var_ q t in
let decl_ref = make_decl_ref_ tp var_kind var_ptr var_name false var_ tp in
let expr_info = make_expr_info var_ tp in
make_decl_ref_exp stmt_info expr_info ( make_decl_ref_expr_info decl_ref )
let make_message_expr param_ q t selector decl_ref_exp stmt_info add_cast =
let make_message_expr param_ tp 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_ q t ` LValueToRValue in
let cast_expr = create_implicit_cast_expr stmt_info [ decl_ref_exp ] param_ tp ` 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_ q t ` ObjCProperty in
let expr_info = make_expr_info_with_objc_kind param_ tp ` ObjCProperty in
Clang_ast_t . ObjCMessageExpr ( stmt_info , parameters , expr_info , obj_c_message_expr_info )
let make_compound_stmt stmts stmt_info =
@ -350,7 +350,7 @@ let make_next_object_exp stmt_info item items =
match item with
| Clang_ast_t . DeclStmt ( stmt_info , _ , [ Clang_ast_t . VarDecl ( di , name_info , var_type , _ ) ] ) ->
let decl_ptr = di . Clang_ast_t . di_pointer in
let decl_ref = make_decl_ref_ q t ` Var decl_ptr name_info false var_type in
let decl_ref = make_decl_ref_ tp ` Var decl_ptr name_info false var_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
@ -383,75 +383,75 @@ let translate_dispatch_function block_name stmt_info stmt_list ei n =
let open Clang_ast_t in
match block_expr with
| BlockExpr ( bsi , bsl , bei , bd ) ->
let q t = bei . ei_ qual_ type in
let tp = bei . ei_ type_ptr in
let cast_info = { cei_cast_kind = ` BitCast ; cei_base_path = [] } in
let block_def = ImplicitCastExpr ( stmt_info , [ block_expr ] , bei , cast_info ) in
let decl_info = { empty_decl_info
with di_pointer = stmt_info . si_pointer ; di_source_range = stmt_info . si_source_range } in
let var_decl_info = { empty_var_decl with vdi_init_expr = Some block_def } in
let block_var_decl = VarDecl ( decl_info , block_name_info , ei . ei_ qual_ type, var_decl_info ) in
let block_var_decl = VarDecl ( decl_info , block_name_info , ei . ei_ type_ptr , var_decl_info ) in
let decl_stmt = DeclStmt ( stmt_info , [] , [ block_var_decl ] ) in
let expr_info_call = make_general_expr_info create_void_star_type ` XValue ` Ordinary in
let expr_info_dre = make_expr_info_with_objc_kind q t ` Ordinary in
let decl_ref = make_decl_ref_ q t ` Var stmt_info . si_pointer block_name_info false q t in
let expr_info_dre = make_expr_info_with_objc_kind tp ` Ordinary in
let decl_ref = make_decl_ref_ tp ` Var stmt_info . si_pointer block_name_info false tp in
let decl_ref_expr_info = make_decl_ref_expr_info decl_ref in
let cast_info_call = { cei_cast_kind = ` LValueToRValue ; cei_base_path = [] } in
let decl_ref_exp = DeclRefExpr ( stmt_info , [] , expr_info_dre , decl_ref_expr_info ) in
let stmt_call = ImplicitCastExpr ( stmt_info , [ decl_ref_exp ] , bei , cast_info_call ) in
let call_block_var = CallExpr ( stmt_info , [ stmt_call ] , expr_info_call ) in
CompoundStmt ( stmt_info , [ decl_stmt ; call_block_var ] ) , q t
CompoundStmt ( stmt_info , [ decl_stmt ; call_block_var ] ) , tp
| _ -> assert false (* when we call this function we have already checked that this cannot be possible *)
(* Create declaration statement: q t vname = iexp *)
let make_DeclStmt stmt_info di q t vname iexp =
(* Create declaration statement: tp vname = iexp *)
let make_DeclStmt stmt_info di tp vname iexp =
let init_expr_opt , init_expr_l = match iexp with
| Some iexp' ->
let ie = create_implicit_cast_expr stmt_info [ iexp' ] q t ` IntegralCast in
let ie = create_implicit_cast_expr stmt_info [ iexp' ] tp ` IntegralCast in
Some ie , [ ie ]
| None -> None , [] in
let var_decl_info = { empty_var_decl_info with Clang_ast_t . vdi_init_expr = init_expr_opt } in
let var_decl = Clang_ast_t . VarDecl ( di , vname , q t, var_decl_info ) in
let var_decl = Clang_ast_t . VarDecl ( di , vname , tp , var_decl_info ) in
Clang_ast_t . DeclStmt ( stmt_info , init_expr_l , [ var_decl ] )
let build_OpaqueValueExpr si source_expr ei =
let opaque_value_expr_info = { Clang_ast_t . ovei_source_expr = Some source_expr } in
Clang_ast_t . OpaqueValueExpr ( si , [] , ei , opaque_value_expr_info )
let pseudo_object_ q t () = create_class_type CFrontend_config . pseudo_object_type
let pseudo_object_ tp () = create_class_type CFrontend_config . pseudo_object_type
(* Create expression PseudoObjectExpr for 'o.m' *)
let build_PseudoObjectExpr q t_m o_cast_decl_ref_exp mname =
let build_PseudoObjectExpr tp _m o_cast_decl_ref_exp mname =
match o_cast_decl_ref_exp with
| Clang_ast_t . ImplicitCastExpr ( si , stmt_list , ei , cast_expr_info ) ->
let ove = build_OpaqueValueExpr si o_cast_decl_ref_exp ei in
let ei_opre = make_expr_info ( pseudo_object_ q t () ) in
let ei_opre = make_expr_info ( pseudo_object_ tp () ) in
let count_name = Ast_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_ q t ` ObjCProperty pointer count_name false ) ;
` PropertyRef ( make_decl_ref_no_ tp ` 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 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
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
Clang_ast_t . PseudoObjectExpr ( si , [ opre ; ove ; ome ] , poe_ei )
| _ -> assert false
let create_call stmt_info decl_pointer function_name q t parameters =
let create_call stmt_info decl_pointer function_name tp parameters =
let expr_info_call = {
Clang_ast_t . ei_ qual_ type = create_void_star_type ;
Clang_ast_t . ei_ type_ptr = create_void_star_type ;
ei_value_kind = ` XValue ;
ei_object_kind = ` Ordinary
} 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 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 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 ] q t ` FunctionToPointerDecay in
let cast = create_implicit_cast_expr ( fresh_stmt_info stmt_info ) [ decl_ref_exp ] tp ` FunctionToPointerDecay in
Clang_ast_t . CallExpr ( stmt_info , cast :: parameters , expr_info_call )
(* For a of type NSArray * Translate *)
@ -481,55 +481,55 @@ 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 , q t, _ ) :: lp' ->
( name . Clang_ast_t . ni_name , di . Clang_ast_t . di_pointer , q t) :: get_name_pointers lp'
| 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'
| _ -> assert false in
let build_idx_decl pidx =
match pidx with
| Clang_ast_t . ParmVarDecl ( di_idx , name_idx , q t_idx, _ ) ->
| Clang_ast_t . ParmVarDecl ( di_idx , name_idx , tp _idx, _ ) ->
let zero = create_integer_literal stmt_info " 0 " in
(* q t_idx idx = 0; *)
let idx_decl_stmt = make_DeclStmt ( fresh_stmt_info stmt_info ) di_idx q t_idx name_idx ( Some zero ) in
let idx_ei = make_expr_info q t_idx in
(* tp _idx idx = 0; *)
let idx_decl_stmt = make_DeclStmt ( fresh_stmt_info stmt_info ) di_idx tp _idx name_idx ( Some zero ) in
let idx_ei = make_expr_info tp _idx in
let pointer = di_idx . Clang_ast_t . di_pointer in
let idx_decl_ref = make_decl_ref_ q t ` Var pointer name_idx false q t_idx in
let idx_decl_ref = make_decl_ref_ tp ` Var pointer name_idx false tp _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 ] q t_idx ` LValueToRValue in
idx_decl_stmt , idx_decl_ref_exp , idx_cast , q t_idx
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
| _ -> assert false in
let cast_expr decl_ref q t =
let ei = make_expr_info q t in
let cast_expr decl_ref tp =
let ei = make_expr_info tp 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 ] q t ` LValueToRValue in
create_implicit_cast_expr ( fresh_stmt_info stmt_info ) [ decl_ref_exp ] tp ` LValueToRValue in
(* build statement BOOL * stop = malloc ( sizeof ( BOOL ) ) ; *)
let build_stop pstop =
match pstop with
| Clang_ast_t . ParmVarDecl ( di , name , q t, _ ) ->
let q t_fun = create_void_unsigned_long_type in
| Clang_ast_t . ParmVarDecl ( di , name , tp , _ ) ->
let tp _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_expr_info create_unsigned_long_type ,
{ Clang_ast_t . uttei_kind = ` SizeOf ; Clang_ast_t . uttei_ qual_ type = type_opt } ) in
{ Clang_ast_t . uttei_kind = ` SizeOf ; Clang_ast_t . uttei_ type_ptr = type_opt } ) in
let pointer = di . Clang_ast_t . di_pointer in
let stmt_info = fresh_stmt_info stmt_info in
let malloc_name = Ast_utils . make_name_decl CFrontend_config . malloc in
let malloc = create_call stmt_info pointer malloc_name q t_fun [ parameter ] in
let init_exp = create_implicit_cast_expr ( fresh_stmt_info stmt_info ) [ malloc ] q t ` BitCast in
make_DeclStmt ( fresh_stmt_info stmt_info ) di q t name ( Some init_exp )
let malloc = create_call stmt_info pointer malloc_name tp _fun [ parameter ] 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 ( Some init_exp )
| _ -> assert false in
(* BOOL * stop =NO; *)
let stop_equal_no pstop =
match pstop with
| Clang_ast_t . ParmVarDecl ( di , name , q t, _ ) ->
let decl_ref = make_decl_ref_ q t ` Var di . Clang_ast_t . di_pointer name false q t in
let cast = cast_expr decl_ref q t in
| Clang_ast_t . ParmVarDecl ( di , name , tp , _ ) ->
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 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
@ -540,28 +540,28 @@ let translate_block_enumerate block_name stmt_info stmt_list ei =
(* build statement free ( stop ) ; *)
let free_stop pstop =
match pstop with
| Clang_ast_t . ParmVarDecl ( di , name , q t, _ ) ->
let q t_fun = create_void_void_type in
let decl_ref = make_decl_ref_ q t ` Var di . Clang_ast_t . di_pointer name false q t in
let cast = cast_expr decl_ref q t in
| Clang_ast_t . ParmVarDecl ( di , name , tp , _ ) ->
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 free_name = Ast_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 q t_fun [ parameter ]
create_call ( fresh_stmt_info stmt_info ) pointer free_name tp _fun [ parameter ]
| _ -> assert false in
(* idx<a.count *)
let bin_op pidx array_decl_ref_exp =
let idx_decl_stmt , idx_decl_ref_exp , idx_cast , idx_ q t = build_idx_decl pidx in
let rhs = build_PseudoObjectExpr idx_ q t array_decl_ref_exp CFrontend_config . count in
let idx_decl_stmt , idx_decl_ref_exp , idx_cast , idx_ tp = build_idx_decl pidx in
let rhs = build_PseudoObjectExpr idx_ tp 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 q t_idx =
let idx_ei = make_expr_info q t_idx in
let un_op idx_decl_ref_expr tp _idx =
let idx_ei = make_expr_info tp _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
@ -571,48 +571,48 @@ let translate_block_enumerate block_name stmt_info stmt_list ei =
| _ -> assert false in
(* id object= objects[idx]; *)
let build_object_DeclStmt pobj decl_ref_expr_array decl_ref_expr_idx q t_idx =
let build_object_DeclStmt pobj decl_ref_expr_array decl_ref_expr_idx tp _idx =
let open Clang_ast_t in
match pobj with
| ParmVarDecl ( di_obj , name_obj , q t_obj, _ ) ->
let poe_ei = make_general_expr_info q t_obj ` LValue ` Ordinary in
| ParmVarDecl ( di_obj , name_obj , tp _obj, _ ) ->
let poe_ei = make_general_expr_info tp _obj ` LValue ` 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_ q t () ) ,
make_expr_info ( pseudo_object_ tp () ) ,
{ osrei_kind = ` ArraySubscript ; osrei_getter = None ; osrei_setter = None ; } ) in
let obj_c_message_expr_info = make_obj_c_message_expr_info_instance CFrontend_config . object_at_indexed_subscript_m in
let ome = ObjCMessageExpr ( fresh_stmt_info stmt_info , [ ove_array ; ove_idx ] , poe_ei , obj_c_message_expr_info ) in
let pseudo_obj_expr = PseudoObjectExpr ( fresh_stmt_info stmt_info , [ objc_sre ; ove_array ; ove_idx ; ome ] , poe_ei ) in
let vdi = { empty_var_decl_info with vdi_init_expr = Some ( pseudo_obj_expr ) } in
let var_decl = VarDecl ( di_obj , name_obj , q t_obj, vdi ) in
let var_decl = VarDecl ( di_obj , name_obj , tp _obj, vdi ) in
DeclStmt ( fresh_stmt_info stmt_info , [ pseudo_obj_expr ] , [ var_decl ] )
| _ -> assert false in
(* NSArray * objects = a *)
let objects_array_DeclStmt init =
let di = { empty_decl_info with Clang_ast_t . di_pointer = Ast_utils . get_fresh_pointer () } in
let q t = create_pointer_type ( create_class_type CFrontend_config . nsarray_cl ) in
let tp = create_pointer_type ( create_class_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 = Ast_utils . make_name_decl CFrontend_config . objects 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 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 make_object_cast_decl_ref_expr objects =
match objects with
| Clang_ast_t . DeclStmt ( si , _ , [ Clang_ast_t . VarDecl ( di , name , q t, vdi ) ] ) ->
let decl_ref = make_decl_ref_ q t ` Var si . Clang_ast_t . si_pointer name false q t in
cast_expr decl_ref q t
| Clang_ast_t . DeclStmt ( si , _ , [ Clang_ast_t . VarDecl ( di , name , tp , vdi ) ] ) ->
let decl_ref = make_decl_ref_ tp ` Var si . Clang_ast_t . si_pointer name false tp in
cast_expr decl_ref tp
| _ -> assert false in
let build_cast_decl_ref_expr_from_parm p =
match p with
| Clang_ast_t . ParmVarDecl ( di , name , q t, _ ) ->
let decl_ref = make_decl_ref_ q t ` Var di . Clang_ast_t . di_pointer name false q t in
cast_expr decl_ref q t
| Clang_ast_t . ParmVarDecl ( di , name , tp , _ ) ->
let decl_ref = make_decl_ref_ tp ` Var di . Clang_ast_t . di_pointer name false tp in
cast_expr decl_ref tp
| _ -> assert false in
let qual_block_name = Ast_utils . make_name_decl block_name in
@ -622,40 +622,40 @@ let translate_block_enumerate block_name stmt_info stmt_list ei =
| Clang_ast_t . BlockExpr ( bsi , _ , bei , _ ) ->
let di = { empty_decl_info with Clang_ast_t . di_pointer = Ast_utils . get_fresh_pointer () } in
let vdi = { empty_var_decl_info with Clang_ast_t . vdi_init_expr = Some ( be ) } in
let q t = bei . Clang_ast_t . ei_ qual_ type in
let var_decl = Clang_ast_t . VarDecl ( di , qual_block_name , q t, vdi ) in
Clang_ast_t . DeclStmt ( bsi , [ be ] , [ var_decl ] ) , [ ( block_name , di . Clang_ast_t . di_pointer , bei . Clang_ast_t . ei_ qual_ type) ]
let tp = bei . Clang_ast_t . ei_ type_ptr in
let var_decl = Clang_ast_t . VarDecl ( di , qual_block_name , tp , vdi ) in
Clang_ast_t . DeclStmt ( bsi , [ be ] , [ var_decl ] ) , [ ( block_name , di . Clang_ast_t . di_pointer , bei . Clang_ast_t . ei_ type_ptr ) ]
| _ -> assert false 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 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 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_ q t = create_BOOL_type in
let ei = make_expr_info bool_ q t in
let bool_ tp = create_BOOL_type in
let ei = make_expr_info bool_ tp 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_ q t ` LValueToRValue in
let cond = create_implicit_cast_expr ( fresh_stmt_info stmt_info ) [ unary_op ] bool_ tp ` 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 () ; cond ; break_stmt ; dummy_stmt () ] ) in
let translate params array_cast_decl_ref_exp block_decl block_ q t =
let translate params array_cast_decl_ref_exp block_decl block_ tp =
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 , q t_idx = build_idx_decl pidx in
let idx_decl_stmt , idx_decl_ref_exp , idx_cast , tp _idx = build_idx_decl pidx in
let guard = bin_op pidx objects in
let incr = un_op idx_decl_ref_exp q t_idx in
let obj_assignment = build_object_DeclStmt pobj objects idx_cast q t_idx in
let incr = un_op idx_decl_ref_exp tp _idx in
let obj_assignment = build_object_DeclStmt pobj objects idx_cast tp _idx 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_ q t object_cast idx_cast stop_cast in
let call_block = make_block_call block_ tp 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 ;
@ -667,7 +667,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_ qual_ type in
let translated_stmt , op = translate bdi . bdi_parameters s block_decl bei . ei_ type_ptr in
CompoundStmt ( stmt_info , translated_stmt ) , vars_to_register @ op @ bv
| _ -> (* When it is not the method we expect with only one parameter, we don't translate *)
Printing . log_out " WARNING: Block Enumeration called at %s not translated. " ( Clang_ast_j . string_of_stmt_info stmt_info ) ;
@ -679,14 +679,14 @@ let trans_negation_with_conditional stmt_info expr_info stmt_list =
let stmt_list_cond = stmt_list @ [ create_integer_literal stmt_info " 0 " ] @ [ create_integer_literal stmt_info " 1 " ] in
Clang_ast_t . ConditionalOperator ( stmt_info , stmt_list_cond , expr_info )
let create_call stmt_info decl_pointer function_name q t parameters =
let create_call stmt_info decl_pointer function_name tp parameters =
let expr_info_call = {
Clang_ast_t . ei_ qual_ type = q t;
Clang_ast_t . ei_ type_ptr = tp ;
ei_value_kind = ` XValue ;
ei_object_kind = ` Ordinary
} 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 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 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
Clang_ast_t . CallExpr ( stmt_info , decl_ref_exp :: parameters , expr_info_call )
@ -695,13 +695,13 @@ 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 = Ast_utils . get_invalid_pointer () in
let decl_ref = make_decl_ref_ q t ` Var decl_ptr var_name false var_type 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 = Ast_utils . get_invalid_pointer () in
let expr_info = {
Clang_ast_t . ei_ qual_ type = var_type ;
Clang_ast_t . ei_ type_ptr = var_type ;
ei_value_kind = ` RValue ;
ei_object_kind = ` Ordinary
} in