@ -18,239 +18,15 @@
open Utils
open CFrontend_utils
module L = Logging
open CContext
type prop_getter_setter = string * ( Clang_ast_t . decl * bool ) option
(* * For each property, we save the getter and the setter method declarations ( no implementation ) . *)
(* * A property type is a tuple: *)
(* * ( type_ptr, property attributes, decl_info, ( getter_name, getter ) , ( setter_name, setter ) , ivar name ) *)
type property_type = Clang_ast_t . type_ptr * Clang_ast_t . property_attribute list *
Clang_ast_t . decl_info * prop_getter_setter * prop_getter_setter *
Clang_ast_t . named_decl_info option
(* * A table that record the property defined in the interface and its getter/setter. *)
(* * This info used later on in the implementation if the getter/setter need to automatically *)
(* * synthesized *)
module type PropertySig =
sig
type t
type property_key = ( CContext . curr_class * Clang_ast_t . named_decl_info )
val property_key_to_string : property_key -> string
val reset_property_table : unit -> unit
val find_property : CContext . curr_class -> Clang_ast_t . named_decl_info -> property_type
val find_properties_class : CContext . curr_class ->
( Clang_ast_t . named_decl_info * property_type ) list
val is_mem_property : property_key -> bool
val replace_property : property_key -> property_type -> unit
val add_property : property_key -> Clang_ast_t . type_ptr -> Clang_ast_t . obj_c_property_decl_info ->
Clang_ast_t . decl_info -> unit
val print_property_table : unit -> unit
val find_property_name_from_ivar : CContext . curr_class -> Clang_ast_t . named_decl_info ->
Clang_ast_t . named_decl_info option
end
module Property : PropertySig =
struct
type property_key = ( CContext . curr_class * Clang_ast_t . named_decl_info )
let property_key_to_string ( curr_class , property_name ) =
( ( CContext . curr_class_to_string curr_class ) ^ " - " ^ property_name . Clang_ast_t . ni_name )
(* * Hash table to implement error logs *)
module PropertyTableHash = Hashtbl . Make ( struct
type t = property_key
let hash ( curr_class , pname ) = ( CContext . curr_class_hash curr_class ) + Hashtbl . hash pname
let equal ( curr_class1 , property_name1 ) ( curr_class2 , property_name2 ) =
CContext . curr_class_equal curr_class1 curr_class2 &&
( String . compare property_name1 . Clang_ast_t . ni_name property_name2 . Clang_ast_t . ni_name = 0 )
end )
type t = property_type PropertyTableHash . t
let property_table : t = PropertyTableHash . create 100
let reset_property_table () =
PropertyTableHash . reset property_table
let rec find_property curr_class property_name =
try PropertyTableHash . find property_table ( curr_class , property_name )
with Not_found ->
match curr_class with
| ContextCls ( name , _ , protocols ) ->
let res_opt = IList . fold_right
( fun protocol found_procname_opt ->
match found_procname_opt with
| Some found_procname -> Some found_procname
| None ->
Some ( find_property ( ContextProtocol protocol ) property_name ) ) protocols None in
( match res_opt with
| Some res -> res
| None -> raise Not_found )
| _ -> raise Not_found
let find_property_name_from_ivar curr_class ivar =
let res = ref None in
PropertyTableHash . iter ( fun ( cl , pname ) ( _ , _ , _ , _ , _ , ivar' ) ->
match ivar' with
| Some s when ( CContext . curr_class_equal curr_class cl ) && s = ivar -> res := Some pname
| _ -> () ) property_table ;
! res
let is_mem_property property =
PropertyTableHash . mem property_table property
let replace_property property =
PropertyTableHash . replace property_table property
let print_property_table () =
let print_item key ( tp , attributes , decl_info , getter , setter , ivar ) =
let getter_str =
match getter with
| getter_name , Some ( Clang_ast_t . ObjCMethodDecl _ , defined1 ) ->
getter_name
| _ -> " " in
let setter_str = match setter with
| setter_name , Some ( Clang_ast_t . ObjCMethodDecl _ , defined2 ) ->
setter_name
| _ -> " " in
Logging . out " Property item %s accessors %s and %s \n "
( property_key_to_string key ) getter_str setter_str in
PropertyTableHash . iter print_item property_table
let find_properties_class curr_class =
let find_properties ( curr_class' , property_name ) property_type properties =
if ( CContext . curr_class_equal curr_class' curr_class ) then
( property_name , property_type ) :: properties
else properties in
PropertyTableHash . fold find_properties property_table []
let add_property ( curr_class , property_name ) tp ocpdi decl_info =
let key = ( curr_class , property_name ) in
let attributes = ocpdi . Clang_ast_t . opdi_property_attributes in
let getter = Ast_utils . get_decl_opt_with_decl_ref ocpdi . Clang_ast_t . opdi_getter_method in
let setter = Ast_utils . get_decl_opt_with_decl_ref ocpdi . Clang_ast_t . opdi_setter_method in
let getter_decl =
match getter with
| Some ( Clang_ast_t . ObjCMethodDecl ( _ , getter_name , getter_ocmdi ) as getter_d ) ->
getter_name . Clang_ast_t . ni_name , Some ( getter_d , false )
| _ -> " " , None in (* TODO refactor property map so that this is not needed t9330897 *)
let setter_decl =
match setter with
| Some ( Clang_ast_t . ObjCMethodDecl ( _ , setter_name , setter_ocmdi ) as setter_d ) ->
setter_name . Clang_ast_t . ni_name , Some ( setter_d , false )
| _ -> " " , None in (* TODO refactor property map so that this is not needed t9330897 *)
PropertyTableHash . add property_table key
( tp , attributes , decl_info , getter_decl , setter_decl , None )
end
let reset_property_table = Property . reset_property_table
let print_property_table () = Property . print_property_table ()
let find_properties_class = Property . find_properties_class
let upgrade_property_accessor property_key property_type meth_decl new_defined is_getter =
let is_defined meth_decl =
match meth_decl with
| Some ( method_decl , was_defined ) -> new_defined | | was_defined
| None -> new_defined in
match property_type with
| tp , attributes , decl_info , ( gname , getter ) , ( sname , setter ) , ivar ->
if is_getter then
let defined = is_defined getter in
Property . replace_property property_key
( tp , attributes , decl_info , ( gname , Some ( meth_decl , defined ) ) , ( sname , setter ) , ivar )
else let defined = is_defined setter in
Property . replace_property property_key
( tp , attributes , decl_info , ( gname , getter ) , ( sname , Some ( meth_decl , defined ) ) , ivar )
let check_for_property curr_class method_name meth_decl body =
let defined = Option . is_some body in
let properties_class = find_properties_class curr_class in
let check_property_accessor curr_class method_name is_getter =
let method_is_getter ( property_name , property_type ) =
match property_type with ( _ , _ , _ , ( getter_name , _ ) , ( setter_name , _ ) , _ ) ->
let found =
if is_getter then ( method_name = getter_name )
else ( method_name = setter_name ) in
if found then
( Printing . log_out " Found property '%s' defined in property table \n "
( Property . property_key_to_string ( curr_class , property_name ) ) ;
upgrade_property_accessor
( curr_class , property_name ) property_type meth_decl defined is_getter ) in
IList . iter method_is_getter properties_class in
check_property_accessor curr_class method_name true ;
check_property_accessor curr_class method_name false
let is_strong_property obj_c_property_decl_info =
let attrs = obj_c_property_decl_info . Clang_ast_t . opdi_property_attributes in
IList . exists ( fun a -> match a with
| ` Strong -> true
| _ -> false ) attrs
let prepare_dynamic_property curr_class decl_info property_impl_decl_info =
let pname = Ast_utils . property_name property_impl_decl_info in
let prop_name = pname . Clang_ast_t . ni_name in
let res = ( try
let tp' , atts , di , getter , setter , _ = Property . find_property curr_class pname in
let ivar = ( match property_impl_decl_info . Clang_ast_t . opidi_ivar_decl with
| Some dr -> ( match dr . Clang_ast_t . dr_name with
| Some name_info -> name_info
| None -> assert false )
| None -> Ast_utils . generated_ivar_name pname ) in
(* update property info with proper ivar name *)
Property . replace_property ( curr_class , pname ) ( tp' , atts , di , getter , setter , Some ivar ) ;
Printing . log_out " Updated property table by adding ivar name for property '%s' \n "
prop_name ;
Some ( tp' , ivar )
with Not_found ->
L . err " Property '%s' not found in the table. Ivar not updated.@. " prop_name ;
None ) in
match property_impl_decl_info . Clang_ast_t . opidi_implementation , res with
| ` Dynamic , Some ( tp , ivar ) ->
(* For Dynamic property we need to create the ObjCIvarDecl which specifies *)
(* the field of the property. In case of Dynamic this is not in the AST. *)
(* Once created the ObjCIvarDecl then we treat the property as synthesized *)
[ Ast_expressions . make_objc_ivar_decl decl_info tp property_impl_decl_info ivar ]
| _ ->
(* No names of fields/method to collect from ObjCPropertyImplDecl when Synthesized *)
[]
let add_properties_to_table curr_class decl_list =
let add_property_to_table dec =
match dec with
| Clang_ast_t . ObjCPropertyDecl ( decl_info , name_info , pdi ) ->
(* Property declaration register the property on the property table to be *)
let pname = name_info . Clang_ast_t . ni_name in
Printing . log_out " ADDING: ObjCPropertyDecl for property '%s' " pname ;
Printing . log_out " pointer= '%s' \n " decl_info . Clang_ast_t . di_pointer ;
Property . add_property ( curr_class , name_info ) pdi . Clang_ast_t . opdi_type_ptr
pdi decl_info ;
| _ -> () in
IList . iter add_property_to_table decl_list
(* Given a list of declarations in an interface returns list of methods *)
let get_methods curr_class decl_list =
let class_name = CContext . get_curr_class_name curr_class in
add_properties_to_table curr_class decl_list ;
let get_method decl list_methods =
match decl with
| Clang_ast_t . ObjCMethodDecl ( decl_info , name_info , method_decl_info ) ->
@ -258,7 +34,6 @@ let get_methods curr_class decl_list =
let method_kind = Procname . objc_method_kind_of_bool is_instance in
let method_name = name_info . Clang_ast_t . ni_name in
Printing . log_out " ...Adding Method '%s' \n " ( class_name ^ " _ " ^ method_name ) ;
let _ = check_for_property curr_class method_name decl method_decl_info . Clang_ast_t . omdi_body in
let meth_name = General_utils . mk_procname_from_objc_method class_name method_name method_kind in
meth_name :: list_methods
| _ -> list_methods in
Dulma Rodriguez
9 years ago
committed by
facebook-github-bot-5