[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

infer/src/clang/CType_decl.ml

@@ -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
   type_ptr_to_sil_type tenv tp
 
-let get_type_curr_class_objc curr_class_opt =
-  let name = CContext.get_curr_class_name curr_class_opt in
+let get_type_curr_class_objc curr_class =
+  let name = CContext.get_curr_class_name curr_class in
   Typ.Tstruct (TN_csu (Class Objc, (Mangled.from_string name)))

infer/src/clang/cContext.ml

@@ -17,17 +17,7 @@ module L = Logging
 
 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 =
-  | 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
   | ContextNoCls
 [@@deriving compare]
@@ -86,40 +76,35 @@ let rec get_curr_class context =
       get_curr_class outer_context
   |  _ -> 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 =
   match curr_class with
   | ContextClsDeclPtr ptr -> ptr
   | _ -> 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 =
   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)
   | 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 =
   match context.outer_context, static_var_typ with
   | Some outer_context, (static_var, _) when Pvar.is_global static_var ->

infer/src/clang/cContext.mli

@@ -13,10 +13,6 @@ open! IStd
 (** and the cg, cfg, and tenv corresponding to the current file. *)
 
 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
   | ContextNoCls
 [@@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 ->
   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 static_vars_for_block : t -> Procname.t -> (Pvar.t * Typ.t) list

infer/src/clang/cField_decl.ml

@@ -54,10 +54,10 @@ let build_sil_field type_ptr_to_sil_type tenv field_name type_ptr prop_attribute
   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 rec get_fields type_ptr_to_sil_type tenv 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 fields = get_fields type_ptr_to_sil_type tenv 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
     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, _, _)) ->
            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')
+       | _ -> get_fields type_ptr_to_sil_type tenv 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'
+      get_fields type_ptr_to_sil_type tenv 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. *)

infer/src/clang/cField_decl.mli

@@ -13,8 +13,8 @@ open! IStd
 
 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 ->
-  Clang_ast_t.decl list -> field_type list
+val get_fields : CAst_utils.type_ptr_to_sil_type -> Tenv.t -> Clang_ast_t.decl list ->
+  field_type list
 
 val fields_superclass :
   Tenv.t -> Clang_ast_t.obj_c_interface_decl_info -> Csu.class_kind -> field_type list

infer/src/clang/cFrontend_decl.ml

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

infer/src/clang/cMethod_trans.ml

@@ -227,25 +227,31 @@ let get_method_name_from_clang tenv ms_opt =
   | None -> None
 
 let get_superclass_curr_class_objc context =
-  let retrive_super cname super_opt =
-    let iname = Typename.TN_csu (Csu.Class Csu.Objc, Mangled.from_string cname) in
-    Logging.out_debug "Checking for superclass = '%s'\n\n%!" (Typename.to_string iname);
-    match Tenv.lookup (CContext.get_tenv context) iname with
-    | Some { supers = super_name :: _ } ->
-        Typename.name super_name
-    | _ ->
-        Logging.err_debug "NOT FOUND superclass = '%s'\n\n%!" (Typename.to_string iname);
-        (match super_opt with
-         | Some super -> super
-         | _ -> assert false) in
+  let open Clang_ast_t in
+  let super_of_decl_ref_opt decl_ref =
+    match decl_ref
+          |> Option.value_map ~f:(fun dr -> dr.dr_name) ~default:None
+          |> Option.map ~f:CAst_utils.get_qualified_name with
+    | Some name -> name
+    | None -> assert false
+  in
+  let retreive_super_name ptr = match CAst_utils.get_decl ptr with
+    | Some ObjCInterfaceDecl (_, _, _, _, otdi) -> super_of_decl_ref_opt otdi.otdi_super
+    | 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
-  | CContext.ContextCls (cname, super_opt, _) ->
-      retrive_super cname super_opt
-  | CContext.ContextCategory (_, cls) ->
-      retrive_super cls None
-  | CContext.ContextNoCls
-  | CContext.ContextClsDeclPtr _
-  | CContext.ContextProtocol _ -> assert false
+  | CContext.ContextClsDeclPtr ptr -> retreive_super_name ptr
+  | CContext.ContextNoCls -> assert false
 
 (* 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 =

infer/src/clang/objcCategory_decl.ml

@@ -23,18 +23,16 @@ let cat_class_decl dr =
   | Some n -> CAst_utils.get_qualified_name n
   | _ -> assert false
 
-let get_curr_class_from_category name decl_ref_opt =
+let get_classname decl_ref_opt =
   match decl_ref_opt with
-  | Some dr ->
-      let class_name = cat_class_decl dr in
-      CContext.ContextCategory (name, class_name)
+  | Some dr -> cat_class_decl dr
   | _ -> assert false
 
-let get_curr_class_from_category_decl name ocdi =
-  get_curr_class_from_category name ocdi.Clang_ast_t.odi_class_interface
+let get_classname_from_category_decl ocdi =
+  get_classname ocdi.Clang_ast_t.odi_class_interface
 
-let get_curr_class_from_category_impl name ocidi =
-  get_curr_class_from_category name ocidi.Clang_ast_t.ocidi_class_interface
+let get_classname_from_category_impl ocidi =
+  get_classname ocidi.Clang_ast_t.ocidi_class_interface
 
 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
@@ -67,9 +65,8 @@ let get_base_class_name_from_category decl =
 
 (* Add potential extra fields defined only in the category *)
 (* to the corresponding class. Update the tenv accordingly.*)
-let process_category type_ptr_to_sil_type tenv curr_class decl_info decl_list =
-  let decl_fields = CField_decl.get_fields type_ptr_to_sil_type tenv curr_class decl_list in
-  let class_name = CContext.get_curr_class_name curr_class in
+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 decl_list 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 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
   | ObjCCategoryDecl (decl_info, name_info, decl_list, _, cdi) ->
       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;
       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
       typ
   | _ -> assert false
@@ -102,9 +99,9 @@ let category_impl_decl type_ptr_to_sil_type tenv decl =
   match decl with
   | ObjCCategoryImplDecl (decl_info, name_info, decl_list, _, cii) ->
       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;
       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
   | _ -> assert false

infer/src/clang/objcCategory_decl.mli

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

infer/src/clang/objcInterface_decl.ml

@@ -36,22 +36,6 @@ let get_protocols protocols =
     ) protocols in
   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 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
@@ -83,23 +67,23 @@ let get_interface_supers super_opt protocols =
   let super_classes = super_class@protocol_names in
   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 =
   let super = get_super_interface_decl otdi_super in
   let protocols = get_protocols otdi_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
 
 (* 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
   Logging.out_debug "ADDING: ObjCInterfaceDecl for '%s'\n" class_name;
   let interface_name = CType.mk_classname class_name Csu.Objc 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);
   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_protocols 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
   match decl with
   | ObjCInterfaceDecl (decl_info, name_info, decl_list, _, ocidi) ->
-      let name = CAst_utils.get_qualified_name name_info in
-      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
+      let typ = add_class_to_tenv type_ptr_to_sil_type tenv decl_info name_info
           decl_list 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
@@ -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
       Logging.out_debug "ADDING: ObjCImplementationDecl for class '%s'\n" class_name;
       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 curr_class decl_list in
+      let fields = CField_decl.get_fields type_ptr_to_sil_type tenv decl_list in
       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 decl_key = `DeclPtr decl_info.Clang_ast_t.di_pointer in

infer/src/clang/objcInterface_decl.mli

@@ -19,7 +19,3 @@ val interface_impl_declaration : CAst_utils.type_ptr_to_sil_type -> Tenv.t -> Cl
   Typ.t
 
 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