@ -36,22 +36,6 @@ let get_protocols protocols =
) protocols in
) protocols in
protocol_names
protocol_names
let get_curr_class class_name ocdi =
let super = get_super_interface_decl ocdi . Clang_ast_t . otdi_super in
let protocols = get_protocols ocdi . Clang_ast_t . otdi_protocols in
CContext . ContextCls ( class_name , super , protocols )
let get_curr_class_impl oi =
let open Clang_ast_t in
match oi . Clang_ast_t . oidi_class_interface with
| Some decl_ref ->
( match CAst_utils . get_decl decl_ref . Clang_ast_t . dr_decl_pointer with
| Some ObjCInterfaceDecl ( _ , name_info , _ , _ , obj_c_interface_decl_info ) ->
let class_name = CAst_utils . get_qualified_name name_info in
get_curr_class class_name obj_c_interface_decl_info
| _ -> assert false )
| _ -> assert false
let add_class_decl type_ptr_to_sil_type tenv idi =
let add_class_decl type_ptr_to_sil_type tenv idi =
let decl_ref_opt = idi . Clang_ast_t . oidi_class_interface in
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 type_ptr_to_sil_type tenv decl_ref_opt true
@ -83,23 +67,23 @@ let get_interface_supers super_opt protocols =
let super_classes = super_class @ protocol_names in
let super_classes = super_class @ protocol_names in
super_classes
super_classes
let create_supers_fields type_ptr_to_sil_type tenv curr_class decl_list
let create_supers_fields type_ptr_to_sil_type tenv decl_list
otdi_super otdi_protocols =
otdi_super otdi_protocols =
let super = get_super_interface_decl otdi_super in
let super = get_super_interface_decl otdi_super in
let protocols = get_protocols otdi_protocols in
let protocols = get_protocols otdi_protocols in
let supers = get_interface_supers super protocols in
let supers = get_interface_supers super protocols in
let fields = CField_decl . get_fields type_ptr_to_sil_type tenv curr_class decl_list in
let fields = CField_decl . get_fields type_ptr_to_sil_type tenv decl_list in
supers , fields
supers , fields
(* Adds pairs ( interface name, interface_type_info ) to the global environment. *)
(* Adds pairs ( interface name, interface_type_info ) to the global environment. *)
let add_class_to_tenv type_ptr_to_sil_type tenv curr_class decl_info name_info decl_list ocidi =
let add_class_to_tenv type_ptr_to_sil_type tenv decl_info name_info decl_list ocidi =
let class_name = CAst_utils . get_qualified_name name_info in
let class_name = CAst_utils . get_qualified_name name_info in
Logging . out_debug " ADDING: ObjCInterfaceDecl for '%s' \n " class_name ;
Logging . out_debug " ADDING: ObjCInterfaceDecl for '%s' \n " class_name ;
let interface_name = CType . mk_classname class_name Csu . Objc in
let interface_name = CType . mk_classname class_name Csu . Objc in
let decl_key = ` DeclPtr decl_info . Clang_ast_t . di_pointer in
let decl_key = ` DeclPtr decl_info . Clang_ast_t . di_pointer in
CAst_utils . update_sil_types_map decl_key ( Typ . Tstruct interface_name ) ;
CAst_utils . update_sil_types_map decl_key ( Typ . Tstruct interface_name ) ;
let decl_supers , decl_fields =
let decl_supers , decl_fields =
create_supers_fields type_ptr_to_sil_type tenv curr_class decl_list
create_supers_fields type_ptr_to_sil_type tenv decl_list
ocidi . Clang_ast_t . otdi_super
ocidi . Clang_ast_t . otdi_super
ocidi . Clang_ast_t . otdi_protocols in
ocidi . Clang_ast_t . otdi_protocols in
let fields_sc = CField_decl . fields_superclass tenv ocidi Csu . Objc in
let fields_sc = CField_decl . fields_superclass tenv ocidi Csu . Objc in
@ -138,9 +122,7 @@ let interface_declaration type_ptr_to_sil_type tenv decl =
let open Clang_ast_t in
let open Clang_ast_t in
match decl with
match decl with
| ObjCInterfaceDecl ( decl_info , name_info , decl_list , _ , ocidi ) ->
| ObjCInterfaceDecl ( decl_info , name_info , decl_list , _ , ocidi ) ->
let name = CAst_utils . get_qualified_name name_info in
let typ = add_class_to_tenv type_ptr_to_sil_type tenv decl_info name_info
let curr_class = get_curr_class name ocidi in
let typ = add_class_to_tenv type_ptr_to_sil_type tenv curr_class decl_info name_info
decl_list ocidi in
decl_list ocidi in
let _ = add_class_implementation type_ptr_to_sil_type tenv 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_super_class_decl type_ptr_to_sil_type tenv ocidi in
@ -158,8 +140,7 @@ let interface_impl_declaration type_ptr_to_sil_type tenv decl =
let class_name = CAst_utils . get_qualified_name name_info in
let class_name = CAst_utils . get_qualified_name name_info in
Logging . out_debug " ADDING: ObjCImplementationDecl for class '%s' \n " class_name ;
Logging . out_debug " ADDING: ObjCImplementationDecl for class '%s' \n " class_name ;
let _ = add_class_decl type_ptr_to_sil_type tenv idi in
let _ = add_class_decl type_ptr_to_sil_type tenv idi in
let curr_class = get_curr_class_impl idi in
let fields = CField_decl . get_fields type_ptr_to_sil_type tenv decl_list in
let fields = CField_decl . get_fields type_ptr_to_sil_type tenv curr_class decl_list in
CField_decl . add_missing_fields tenv class_name Csu . Objc fields ;
CField_decl . add_missing_fields tenv class_name Csu . Objc fields ;
let class_tn_name = Typename . TN_csu ( Csu . Class Csu . Objc , ( Mangled . from_string class_name ) ) in
let class_tn_name = Typename . TN_csu ( Csu . Class Csu . Objc , ( Mangled . from_string class_name ) ) in
let decl_key = ` DeclPtr decl_info . Clang_ast_t . di_pointer in
let decl_key = ` DeclPtr decl_info . Clang_ast_t . di_pointer in