You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
100 lines
4.5 KiB
100 lines
4.5 KiB
(*
|
|
* Copyright (c) 2013 - present Facebook, Inc.
|
|
* All rights reserved.
|
|
*
|
|
* This source code is licensed under the BSD style license found in the
|
|
* LICENSE file in the root directory of this source tree. An additional grant
|
|
* of patent rights can be found in the PATENTS file in the same directory.
|
|
*)
|
|
|
|
open! Utils
|
|
|
|
(** Utility module to retrieve fields of structs of classes *)
|
|
|
|
open CFrontend_utils
|
|
|
|
module L = Logging
|
|
|
|
type field_type = Ident.fieldname * Typ.t * (Typ.annotation * bool) list
|
|
|
|
let rec get_fields_super_classes tenv super_class =
|
|
Printing.log_out " ... Getting fields of superclass '%s'\n" (Typename.to_string super_class);
|
|
match Tenv.lookup tenv super_class with
|
|
| None -> []
|
|
| Some { fields; supers = super_class :: _ } ->
|
|
let sc_fields = get_fields_super_classes tenv super_class in
|
|
General_utils.append_no_duplicates_fields fields sc_fields
|
|
| Some { fields } -> fields
|
|
|
|
let fields_superclass tenv interface_decl_info ck =
|
|
match interface_decl_info.Clang_ast_t.otdi_super with
|
|
| Some dr ->
|
|
(match dr.Clang_ast_t.dr_name with
|
|
| Some sc ->
|
|
let classname = CTypes.mk_classname (Ast_utils.get_qualified_name sc) ck in
|
|
get_fields_super_classes tenv classname
|
|
| _ -> [])
|
|
| _ -> []
|
|
|
|
let build_sil_field type_ptr_to_sil_type tenv field_name type_ptr prop_attributes =
|
|
let prop_atts = IList.map Clang_ast_j.string_of_property_attribute prop_attributes in
|
|
let annotation_from_type t =
|
|
match t with
|
|
| Typ.Tptr (_, Typ.Pk_objc_weak) -> [Config.weak]
|
|
| Typ.Tptr (_, Typ.Pk_objc_unsafe_unretained) -> [Config.unsafe_unret]
|
|
| _ -> [] in
|
|
let fname = General_utils.mk_class_field_name field_name in
|
|
let typ = type_ptr_to_sil_type tenv type_ptr in
|
|
let item_annotations = match prop_atts with
|
|
| [] ->
|
|
[({ Typ.class_name = Config.ivar_attributes; parameters = annotation_from_type typ }, true)]
|
|
| _ ->
|
|
[({ Typ.class_name = Config.property_attributes; parameters = prop_atts }, true)] in
|
|
fname, typ, item_annotations
|
|
|
|
(* Given a list of declarations in an interface returns a list of fields *)
|
|
let rec get_fields type_ptr_to_sil_type tenv curr_class decl_list =
|
|
let open Clang_ast_t in
|
|
let add_field name_info qt attributes decl_list' =
|
|
let fields = get_fields type_ptr_to_sil_type tenv curr_class decl_list' in
|
|
let field_tuple = build_sil_field type_ptr_to_sil_type tenv
|
|
name_info qt.Clang_ast_t.qt_type_ptr attributes in
|
|
General_utils.append_no_duplicates_fields [field_tuple] fields in
|
|
match decl_list with
|
|
| [] -> []
|
|
| ObjCPropertyDecl (_, _, obj_c_property_decl_info) :: decl_list' ->
|
|
(let ivar_decl_ref = obj_c_property_decl_info.Clang_ast_t.opdi_ivar_decl in
|
|
match Ast_utils.get_decl_opt_with_decl_ref ivar_decl_ref with
|
|
| Some (ObjCIvarDecl (_, name_info, type_ptr, _, _)) ->
|
|
let attributes = obj_c_property_decl_info.Clang_ast_t.opdi_property_attributes in
|
|
add_field name_info type_ptr attributes decl_list'
|
|
| _ -> get_fields type_ptr_to_sil_type tenv curr_class decl_list')
|
|
| ObjCIvarDecl (_, name_info, type_ptr, _, _) :: decl_list' ->
|
|
add_field name_info type_ptr [] decl_list'
|
|
| _ :: decl_list' ->
|
|
get_fields type_ptr_to_sil_type tenv curr_class decl_list'
|
|
|
|
(* Add potential extra fields defined only in the implementation of the class *)
|
|
(* to the info given in the interface. Update the tenv accordingly. *)
|
|
let add_missing_fields tenv class_name ck missing_fields =
|
|
let mang_name = Mangled.from_string class_name in
|
|
let class_tn_name = Typename.TN_csu (Csu.Class ck, mang_name) in
|
|
match Tenv.lookup tenv class_tn_name with
|
|
| Some ({ fields } as struct_typ) ->
|
|
let new_fields = General_utils.append_no_duplicates_fields fields missing_fields in
|
|
ignore (Tenv.mk_struct tenv ~default:struct_typ ~fields:new_fields ~statics:[] class_tn_name);
|
|
Printing.log_out " Updating info for class '%s' in tenv\n" class_name
|
|
| _ -> ()
|
|
|
|
let modelled_fields_in_classes = [("NSData", "_bytes", Typ.Tptr (Typ.Tvoid, Typ.Pk_pointer))]
|
|
|
|
let modelled_field class_name_info =
|
|
let modelled_field_in_class res (class_name, field_name, typ) =
|
|
if class_name = class_name_info.Clang_ast_t.ni_name then
|
|
let class_name_qualified = class_name_info.Clang_ast_t.ni_qual_name in
|
|
let field_name_qualified = Ast_utils.make_qual_name_decl class_name_qualified field_name in
|
|
let name = General_utils.mk_class_field_name field_name_qualified in
|
|
(name, typ, Typ.item_annotation_empty) :: res
|
|
else res in
|
|
IList.fold_left modelled_field_in_class [] modelled_fields_in_classes
|