[objc] Remove class information from CContext

Summary: `CContext.curr_class` contained information about a class for a method as a string, while it's better to use pointer for this.

Reviewed By: jvillard

Differential Revision: D4666613

fbshipit-source-id: 1c0735b
master
Andrzej Kotulski 8 years ago committed by Facebook Github Bot
parent 0675e88571
commit b52a17eb75

@ -256,6 +256,6 @@ let get_class_type_np tenv expr_info obj_c_message_expr_info =
| _ -> expr_info.Clang_ast_t.ei_type_ptr in | _ -> expr_info.Clang_ast_t.ei_type_ptr in
type_ptr_to_sil_type tenv tp type_ptr_to_sil_type tenv tp
let get_type_curr_class_objc curr_class_opt = let get_type_curr_class_objc curr_class =
let name = CContext.get_curr_class_name curr_class_opt in let name = CContext.get_curr_class_name curr_class in
Typ.Tstruct (TN_csu (Class Objc, (Mangled.from_string name))) Typ.Tstruct (TN_csu (Class Objc, (Mangled.from_string name)))

@ -17,17 +17,7 @@ module L = Logging
type pointer (* = Clang_ast_t.pointer *) = int [@@deriving compare] type pointer (* = Clang_ast_t.pointer *) = int [@@deriving compare]
type _super = string option
let compare__super _ _ = 0
type _protos = string list
let compare__protos _ _ = 0
type curr_class = type curr_class =
| ContextCls of string * _super * _protos
(*class name and name of (optional) super class , and a list of protocols *)
| ContextCategory of string * string (* category name and corresponding class *)
| ContextProtocol of string (* category name and corresponding class *)
| ContextClsDeclPtr of pointer | ContextClsDeclPtr of pointer
| ContextNoCls | ContextNoCls
[@@deriving compare] [@@deriving compare]
@ -86,40 +76,35 @@ let rec get_curr_class context =
get_curr_class outer_context get_curr_class outer_context
| _ -> context.curr_class | _ -> context.curr_class
let get_curr_class_name curr_class =
match curr_class with
| ContextCls (name, _, _) -> name
| ContextCategory (_, cls) -> cls
| ContextProtocol name -> name
| ContextClsDeclPtr _ -> assert false
| ContextNoCls -> assert false
let get_curr_class_decl_ptr curr_class = let get_curr_class_decl_ptr curr_class =
match curr_class with match curr_class with
| ContextClsDeclPtr ptr -> ptr | ContextClsDeclPtr ptr -> ptr
| _ -> assert false | _ -> assert false
let get_curr_class_name curr_class =
let decl_ptr = get_curr_class_decl_ptr curr_class in
let get_ptr_from_decl_ref = function
| Some dr -> dr.Clang_ast_t.dr_decl_pointer
| None -> assert false in
(* Resolve categories to their class names *)
let class_decl_ptr = match CAst_utils.get_decl decl_ptr with
| Some ObjCCategoryDecl (_, _, _, _, ocdi) ->
get_ptr_from_decl_ref ocdi.odi_class_interface
| Some ObjCCategoryImplDecl (_, _, _, _, ocidi) ->
get_ptr_from_decl_ref ocidi.ocidi_class_interface
| _ -> decl_ptr in
let _, name_info = match Option.bind
(CAst_utils.get_decl class_decl_ptr)
Clang_ast_proj.get_named_decl_tuple with
| Some result -> result
| None -> assert false in
CAst_utils.get_qualified_name name_info
let curr_class_to_string curr_class = let curr_class_to_string curr_class =
match curr_class with match curr_class with
| ContextCls (name, superclass, protocols) ->
("class " ^ name ^ ", superclass: " ^ (Option.value ~default:"" superclass) ^
", protocols: " ^ (IList.to_string (fun x -> x) protocols))
| ContextCategory (name, cls) -> ("category " ^ name ^ " of class " ^ cls)
| ContextProtocol name -> ("protocol " ^ name)
| ContextClsDeclPtr ptr -> ("decl_ptr: " ^ string_of_int ptr) | ContextClsDeclPtr ptr -> ("decl_ptr: " ^ string_of_int ptr)
| ContextNoCls -> "no class" | ContextNoCls -> "no class"
let create_curr_class tenv class_name ck =
let class_tn_name = Typename.TN_csu (Csu.Class ck, (Mangled.from_string class_name)) in
match Tenv.lookup tenv class_tn_name with
| Some { supers } ->
(let supers_names = List.map ~f:Typename.name supers in
match supers_names with
| superclass:: protocols ->
ContextCls (class_name, Some superclass, protocols)
| [] -> ContextCls (class_name, None, []))
| _ -> assert false
let add_block_static_var context block_name static_var_typ = let add_block_static_var context block_name static_var_typ =
match context.outer_context, static_var_typ with match context.outer_context, static_var_typ with
| Some outer_context, (static_var, _) when Pvar.is_global static_var -> | Some outer_context, (static_var, _) when Pvar.is_global static_var ->

@ -13,10 +13,6 @@ open! IStd
(** and the cg, cfg, and tenv corresponding to the current file. *) (** and the cg, cfg, and tenv corresponding to the current file. *)
type curr_class = type curr_class =
| ContextCls of string * string option * string list
(*class name and name of (optional) super class , and a list of protocols *)
| ContextCategory of string * string (* category name and corresponding class *)
| ContextProtocol of string (* category name and corresponding class *)
| ContextClsDeclPtr of int | ContextClsDeclPtr of int
| ContextNoCls | ContextNoCls
[@@deriving compare] [@@deriving compare]
@ -62,8 +58,6 @@ val get_tenv : t -> Tenv.t
val create_context : CFrontend_config.translation_unit_context -> Tenv.t -> Cg.t -> Cfg.cfg -> val create_context : CFrontend_config.translation_unit_context -> Tenv.t -> Cg.t -> Cfg.cfg ->
Procdesc.t -> curr_class -> Typ.t option -> bool -> t option -> t Procdesc.t -> curr_class -> Typ.t option -> bool -> t option -> t
val create_curr_class : Tenv.t -> string -> Csu.class_kind -> curr_class
val add_block_static_var : t -> Procname.t -> (Pvar.t * Typ.t) -> unit val add_block_static_var : t -> Procname.t -> (Pvar.t * Typ.t) -> unit
val static_vars_for_block : t -> Procname.t -> (Pvar.t * Typ.t) list val static_vars_for_block : t -> Procname.t -> (Pvar.t * Typ.t) list

@ -54,10 +54,10 @@ let build_sil_field type_ptr_to_sil_type tenv field_name type_ptr prop_attribute
fname, typ, item_annotations fname, typ, item_annotations
(* Given a list of declarations in an interface returns a list of fields *) (* Given a list of declarations in an interface returns a list of fields *)
let rec get_fields type_ptr_to_sil_type tenv curr_class decl_list = let rec get_fields type_ptr_to_sil_type tenv decl_list =
let open Clang_ast_t in let open Clang_ast_t in
let add_field name_info qt attributes decl_list' = let add_field name_info qt attributes decl_list' =
let fields = get_fields type_ptr_to_sil_type tenv curr_class decl_list' in 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 let field_tuple = build_sil_field type_ptr_to_sil_type tenv
name_info qt.Clang_ast_t.qt_type_ptr attributes in name_info qt.Clang_ast_t.qt_type_ptr attributes in
CGeneral_utils.append_no_duplicates_fields [field_tuple] fields in CGeneral_utils.append_no_duplicates_fields [field_tuple] fields in
@ -69,11 +69,11 @@ let rec get_fields type_ptr_to_sil_type tenv curr_class decl_list =
| Some (ObjCIvarDecl (_, name_info, type_ptr, _, _)) -> | Some (ObjCIvarDecl (_, name_info, type_ptr, _, _)) ->
let attributes = obj_c_property_decl_info.Clang_ast_t.opdi_property_attributes in let attributes = obj_c_property_decl_info.Clang_ast_t.opdi_property_attributes in
add_field name_info type_ptr attributes decl_list' add_field name_info type_ptr attributes decl_list'
| _ -> get_fields type_ptr_to_sil_type tenv curr_class decl_list') | _ -> get_fields type_ptr_to_sil_type tenv decl_list')
| ObjCIvarDecl (_, name_info, type_ptr, _, _) :: decl_list' -> | ObjCIvarDecl (_, name_info, type_ptr, _, _) :: decl_list' ->
add_field name_info type_ptr [] decl_list' add_field name_info type_ptr [] decl_list'
| _ :: decl_list' -> | _ :: decl_list' ->
get_fields type_ptr_to_sil_type tenv curr_class decl_list' get_fields type_ptr_to_sil_type tenv decl_list'
(* Add potential extra fields defined only in the implementation of the class *) (* Add potential extra fields defined only in the implementation of the class *)
(* to the info given in the interface. Update the tenv accordingly. *) (* to the info given in the interface. Update the tenv accordingly. *)

@ -13,8 +13,8 @@ open! IStd
type field_type = Ident.fieldname * Typ.t * (Annot.t * bool) list type field_type = Ident.fieldname * Typ.t * (Annot.t * bool) list
val get_fields : CAst_utils.type_ptr_to_sil_type -> Tenv.t -> CContext.curr_class -> val get_fields : CAst_utils.type_ptr_to_sil_type -> Tenv.t -> Clang_ast_t.decl list ->
Clang_ast_t.decl list -> field_type list field_type list
val fields_superclass : val fields_superclass :
Tenv.t -> Clang_ast_t.obj_c_interface_decl_info -> Csu.class_kind -> field_type list Tenv.t -> Clang_ast_t.obj_c_interface_decl_info -> Csu.class_kind -> field_type list

@ -171,38 +171,35 @@ struct
Ident.NameGenerator.reset (); Ident.NameGenerator.reset ();
let translate = translate_one_declaration trans_unit_ctx tenv cg cfg decl_trans_context in let translate = translate_one_declaration trans_unit_ctx tenv cg cfg decl_trans_context in
(if should_translate_decl trans_unit_ctx dec decl_trans_context then (if should_translate_decl trans_unit_ctx dec decl_trans_context then
let dec_ptr = (Clang_ast_proj.get_decl_tuple dec).di_pointer in
match dec with match dec with
| FunctionDecl(_, _, _, _) -> | FunctionDecl(_, _, _, _) ->
function_decl trans_unit_ctx tenv cfg cg dec None function_decl trans_unit_ctx tenv cfg cg dec None
| ObjCInterfaceDecl(_, name_info, decl_list, _, oi_decl_info) -> | ObjCInterfaceDecl(_, _, decl_list, _, _) ->
let name = CAst_utils.get_qualified_name name_info in let curr_class = CContext.ContextClsDeclPtr dec_ptr in
let curr_class = ObjcInterface_decl.get_curr_class name oi_decl_info in
ignore ignore
(ObjcInterface_decl.interface_declaration CType_decl.type_ptr_to_sil_type tenv dec); (ObjcInterface_decl.interface_declaration CType_decl.type_ptr_to_sil_type tenv dec);
process_methods trans_unit_ctx tenv cg cfg curr_class decl_list process_methods trans_unit_ctx tenv cg cfg curr_class decl_list
| ObjCProtocolDecl(_, name_info, decl_list, _, _) -> | ObjCProtocolDecl(_, _, decl_list, _, _) ->
let name = CAst_utils.get_qualified_name name_info in let curr_class = CContext.ContextClsDeclPtr dec_ptr in
let curr_class = CContext.ContextProtocol name in
ignore (ObjcProtocol_decl.protocol_decl CType_decl.type_ptr_to_sil_type tenv dec); ignore (ObjcProtocol_decl.protocol_decl CType_decl.type_ptr_to_sil_type tenv dec);
process_methods trans_unit_ctx tenv cg cfg curr_class decl_list process_methods trans_unit_ctx tenv cg cfg curr_class decl_list
| ObjCCategoryDecl(_, name_info, decl_list, _, ocdi) -> | ObjCCategoryDecl(_, _, decl_list, _, _) ->
let name = CAst_utils.get_qualified_name name_info in let curr_class = CContext.ContextClsDeclPtr dec_ptr in
let curr_class = ObjcCategory_decl.get_curr_class_from_category_decl name ocdi in
ignore (ObjcCategory_decl.category_decl CType_decl.type_ptr_to_sil_type tenv dec); ignore (ObjcCategory_decl.category_decl CType_decl.type_ptr_to_sil_type tenv dec);
process_methods trans_unit_ctx tenv cg cfg curr_class decl_list process_methods trans_unit_ctx tenv cg cfg curr_class decl_list
| ObjCCategoryImplDecl(_, name_info, decl_list, _, ocidi) -> | ObjCCategoryImplDecl(_, _, decl_list, _, _) ->
let name = CAst_utils.get_qualified_name name_info in let curr_class = CContext.ContextClsDeclPtr dec_ptr in
let curr_class = ObjcCategory_decl.get_curr_class_from_category_impl name ocidi in
ignore (ObjcCategory_decl.category_impl_decl CType_decl.type_ptr_to_sil_type tenv dec); ignore (ObjcCategory_decl.category_impl_decl CType_decl.type_ptr_to_sil_type tenv dec);
process_methods trans_unit_ctx tenv cg cfg curr_class decl_list; process_methods trans_unit_ctx tenv cg cfg curr_class decl_list;
| ObjCImplementationDecl(decl_info, _, decl_list, _, idi) -> | ObjCImplementationDecl(decl_info, name_info, decl_list, _, _) ->
let curr_class = ObjcInterface_decl.get_curr_class_impl idi in let curr_class = CContext.ContextClsDeclPtr dec_ptr in
let class_name = CContext.get_curr_class_name curr_class in let class_name = CAst_utils.get_qualified_name name_info in
let type_ptr_to_sil_type = CType_decl.type_ptr_to_sil_type 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); ignore (ObjcInterface_decl.interface_impl_declaration type_ptr_to_sil_type tenv dec);
CMethod_trans.add_default_method_for_class trans_unit_ctx class_name decl_info; CMethod_trans.add_default_method_for_class trans_unit_ctx class_name decl_info;

@ -227,25 +227,31 @@ let get_method_name_from_clang tenv ms_opt =
| None -> None | None -> None
let get_superclass_curr_class_objc context = let get_superclass_curr_class_objc context =
let retrive_super cname super_opt = let open Clang_ast_t in
let iname = Typename.TN_csu (Csu.Class Csu.Objc, Mangled.from_string cname) in let super_of_decl_ref_opt decl_ref =
Logging.out_debug "Checking for superclass = '%s'\n\n%!" (Typename.to_string iname); match decl_ref
match Tenv.lookup (CContext.get_tenv context) iname with |> Option.value_map ~f:(fun dr -> dr.dr_name) ~default:None
| Some { supers = super_name :: _ } -> |> Option.map ~f:CAst_utils.get_qualified_name with
Typename.name super_name | Some name -> name
| _ -> | None -> assert false
Logging.err_debug "NOT FOUND superclass = '%s'\n\n%!" (Typename.to_string iname); in
(match super_opt with let retreive_super_name ptr = match CAst_utils.get_decl ptr with
| Some super -> super | Some ObjCInterfaceDecl (_, _, _, _, otdi) -> super_of_decl_ref_opt otdi.otdi_super
| _ -> assert false) in | Some ObjCImplementationDecl (_, _, _, _, oi) -> (
match oi.Clang_ast_t.oidi_class_interface
|> Option.map ~f:(fun dr -> dr.dr_decl_pointer)
|> Option.value_map ~f:CAst_utils.get_decl ~default:None with
| Some ObjCInterfaceDecl (_, _, _, _, otdi) -> super_of_decl_ref_opt otdi.otdi_super
| _ -> assert false
)
| Some ObjCCategoryDecl (_, _, _, _, ocdi) ->
super_of_decl_ref_opt ocdi.odi_class_interface
| Some ObjCCategoryImplDecl (_, _, _, _, ocidi) ->
super_of_decl_ref_opt ocidi.ocidi_class_interface
| _ -> assert false in
match CContext.get_curr_class context with match CContext.get_curr_class context with
| CContext.ContextCls (cname, super_opt, _) -> | CContext.ContextClsDeclPtr ptr -> retreive_super_name ptr
retrive_super cname super_opt | CContext.ContextNoCls -> assert false
| CContext.ContextCategory (_, cls) ->
retrive_super cls None
| CContext.ContextNoCls
| CContext.ContextClsDeclPtr _
| CContext.ContextProtocol _ -> assert false
(* Gets the class name from a method signature found by clang, if search is successful *) (* Gets the class name from a method signature found by clang, if search is successful *)
let get_class_name_method_call_from_clang trans_unit_ctx tenv obj_c_message_expr_info = let get_class_name_method_call_from_clang trans_unit_ctx tenv obj_c_message_expr_info =

@ -23,18 +23,16 @@ let cat_class_decl dr =
| Some n -> CAst_utils.get_qualified_name n | Some n -> CAst_utils.get_qualified_name n
| _ -> assert false | _ -> assert false
let get_curr_class_from_category name decl_ref_opt = let get_classname decl_ref_opt =
match decl_ref_opt with match decl_ref_opt with
| Some dr -> | Some dr -> cat_class_decl dr
let class_name = cat_class_decl dr in
CContext.ContextCategory (name, class_name)
| _ -> assert false | _ -> assert false
let get_curr_class_from_category_decl name ocdi = let get_classname_from_category_decl ocdi =
get_curr_class_from_category name ocdi.Clang_ast_t.odi_class_interface get_classname ocdi.Clang_ast_t.odi_class_interface
let get_curr_class_from_category_impl name ocidi = let get_classname_from_category_impl ocidi =
get_curr_class_from_category name ocidi.Clang_ast_t.ocidi_class_interface 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 type_ptr_to_sil_type tenv category_impl_info =
let decl_ref_opt = category_impl_info.Clang_ast_t.ocidi_category_decl in let decl_ref_opt = category_impl_info.Clang_ast_t.ocidi_category_decl in
@ -67,9 +65,8 @@ let get_base_class_name_from_category decl =
(* Add potential extra fields defined only in the category *) (* Add potential extra fields defined only in the category *)
(* to the corresponding class. Update the tenv accordingly.*) (* to the corresponding class. Update the tenv accordingly.*)
let process_category type_ptr_to_sil_type tenv curr_class decl_info decl_list = 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 curr_class decl_list in let decl_fields = CField_decl.get_fields type_ptr_to_sil_type tenv decl_list in
let class_name = CContext.get_curr_class_name curr_class in
let mang_name = Mangled.from_string class_name in let mang_name = Mangled.from_string class_name in
let class_tn_name = Typename.TN_csu (Csu.Class Csu.Objc, mang_name) in let class_tn_name = Typename.TN_csu (Csu.Class Csu.Objc, mang_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
@ -89,10 +86,10 @@ let category_decl type_ptr_to_sil_type tenv decl =
match decl with match decl with
| ObjCCategoryDecl (decl_info, name_info, decl_list, _, cdi) -> | ObjCCategoryDecl (decl_info, name_info, decl_list, _, cdi) ->
let name = CAst_utils.get_qualified_name name_info in let name = CAst_utils.get_qualified_name name_info in
let curr_class = get_curr_class_from_category_decl name cdi in let class_name = get_classname_from_category_decl cdi in
Logging.out_debug "ADDING: ObjCCategoryDecl for '%s'\n" name; Logging.out_debug "ADDING: ObjCCategoryDecl for '%s'\n" name;
let _ = add_class_decl type_ptr_to_sil_type tenv cdi in let _ = add_class_decl type_ptr_to_sil_type tenv cdi in
let typ = process_category type_ptr_to_sil_type tenv curr_class decl_info decl_list 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_category_implementation type_ptr_to_sil_type tenv cdi in
typ typ
| _ -> assert false | _ -> assert false
@ -102,9 +99,9 @@ let category_impl_decl type_ptr_to_sil_type tenv decl =
match decl with match decl with
| ObjCCategoryImplDecl (decl_info, name_info, decl_list, _, cii) -> | ObjCCategoryImplDecl (decl_info, name_info, decl_list, _, cii) ->
let name = CAst_utils.get_qualified_name name_info in let name = CAst_utils.get_qualified_name name_info in
let curr_class = get_curr_class_from_category_impl name cii in let class_name = get_classname_from_category_impl cii in
Logging.out_debug "ADDING: ObjCCategoryImplDecl for '%s'\n" name; Logging.out_debug "ADDING: ObjCCategoryImplDecl for '%s'\n" name;
let _ = add_category_decl type_ptr_to_sil_type tenv cii in let _ = add_category_decl type_ptr_to_sil_type tenv cii in
let typ = process_category type_ptr_to_sil_type tenv curr_class decl_info decl_list in let typ = process_category type_ptr_to_sil_type tenv class_name decl_info decl_list in
typ typ
| _ -> assert false | _ -> assert false

@ -18,10 +18,4 @@ val category_impl_decl : CAst_utils.type_ptr_to_sil_type -> Tenv.t -> Clang_ast_
val noname_category : string -> string val noname_category : string -> string
val get_curr_class_from_category_decl : string -> Clang_ast_t.obj_c_category_decl_info ->
CContext.curr_class
val get_curr_class_from_category_impl : string -> Clang_ast_t.obj_c_category_impl_decl_info ->
CContext.curr_class
val get_base_class_name_from_category : Clang_ast_t.decl -> string option val get_base_class_name_from_category : Clang_ast_t.decl -> string option

@ -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

@ -19,7 +19,3 @@ val interface_impl_declaration : CAst_utils.type_ptr_to_sil_type -> Tenv.t -> Cl
Typ.t Typ.t
val is_pointer_to_objc_class : Typ.t -> bool val is_pointer_to_objc_class : Typ.t -> bool
val get_curr_class : string -> Clang_ast_t.obj_c_interface_decl_info -> CContext.curr_class
val get_curr_class_impl : Clang_ast_t.obj_c_implementation_decl_info -> CContext.curr_class

Loading…
Cancel
Save