[IR] Simplify Typ.Name.t type by inlining Csu.t type

Summary: There was a lot of indirection going on in `Typ.Name` type definition. Inline all those indirections into single variant type

Reviewed By: jberdine

Differential Revision: D4737644

fbshipit-source-id: c5e181b

infer/src/IR/Csu.re

@@ -1,37 +0,0 @@
-/*
- * Copyright (c) 2015 - 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! IStd;
-
-
-/** Internal representation of data structure for Java, Objective-C and C++ classes,
-    C-style structs struct and union,
-    And Objective C protocol */
-type class_kind =
-  | CPP
-  | Java
-  | Objc
-[@@deriving compare];
-
-let equal_class_kind = [%compare.equal : class_kind];
-
-type t =
-  | Class class_kind
-  | Struct
-  | Union
-  | Protocol
-[@@deriving compare];
-
-let name =
-  fun
-  | Class _ => "class"
-  | Struct => "struct"
-  | Union => "union"
-  | Protocol => "protocol";
-
-let equal = [%compare.equal : t];

infer/src/IR/Csu.rei

@@ -1,32 +0,0 @@
-/*
- * Copyright (c) 2015 - 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! IStd;
-
-
-/** Internal representation of data structure for Java, Objective-C and C++ classes,
-    C-style structs struct and union,
-    And Objective C protocol */
-type class_kind =
-  | CPP
-  | Java
-  | Objc
-[@@deriving compare];
-
-let equal_class_kind: class_kind => class_kind => bool;
-
-type t =
-  | Class class_kind
-  | Struct
-  | Union
-  | Protocol
-[@@deriving compare];
-
-let equal: t => t => bool;
-
-let name: t => string;

infer/src/IR/Localise.ml

@@ -755,7 +755,7 @@ let desc_leak hpred_type_opt value_str_opt resource_opt resource_action_opt loc
           MF.monospaced_to_string s, " to ", " on " in
     let typ_str =
       match hpred_type_opt with
-      | Some (Exp.Sizeof (Tstruct (TN_csu (Class _, _, _) as name), _, _)) ->
+      | Some (Exp.Sizeof (Tstruct name, _, _)) when Typ.Name.is_class name ->
           " of type " ^ MF.monospaced_to_string (Typ.Name.name name) ^ " "
       | _ -> " " in
     let desc_str =

infer/src/IR/Subtype.re

@@ -58,14 +58,13 @@ let max_result res1 res2 =>
 
 let is_interface tenv (class_name: Typ.Name.t) =>
   switch (class_name, Tenv.lookup tenv class_name) {
-  | (TN_csu (Class Java) _ _, Some {fields: [], methods: []}) => true
+  | (JavaClass _, Some {fields: [], methods: []}) => true
   | _ => false
   };
 
 let is_root_class class_name =>
   switch class_name {
-  | Typ.TN_csu (Csu.Class Csu.Java) _ _ => Typ.Name.equal class_name Typ.Name.Java.java_lang_object
+  | Typ.JavaClass _ => Typ.Name.equal class_name Typ.Name.Java.java_lang_object
-  | Typ.TN_csu (Csu.Class Csu.CPP) _ _ => false
   | _ => false
   };
 

infer/src/IR/Tenv.re

@@ -75,12 +75,12 @@ let lookup tenv name :option Typ.Struct.t =>
   | Not_found =>
     /* ToDo: remove the following additional lookups once C/C++ interop is resolved */
     switch (name: Typ.Name.t) {
-    | TN_csu Struct m templ =>
+    | CStruct m =>
-      try (Some (TypenameHash.find tenv (TN_csu (Class CPP) m templ))) {
+      try (Some (TypenameHash.find tenv (CppClass m NoTemplate))) {
       | Not_found => None
       }
-    | TN_csu (Class CPP) m templ =>
+    | CppClass m NoTemplate =>
-      try (Some (TypenameHash.find tenv (TN_csu Struct m templ))) {
+      try (Some (TypenameHash.find tenv (CStruct m))) {
       | Not_found => None
       }
     | _ => None

infer/src/IR/Typ.re

@@ -135,7 +135,12 @@ let module T = {
     | Tarray t static_length /** array type with statically fixed length */
   [@@deriving compare]
   and name =
-    | TN_csu Csu.t Mangled.t template_spec_info
+    | CStruct Mangled.t
+    | CUnion Mangled.t
+    | CppClass Mangled.t template_spec_info
+    | JavaClass Mangled.t
+    | ObjcClass Mangled.t
+    | ObjcProtocol Mangled.t
   [@@deriving compare]
   and template_spec_info =
     | NoTemplate
@@ -150,47 +155,78 @@ include T;
 let module Name = {
   type t = name [@@deriving compare];
   let equal = [%compare.equal : t];
-  let to_string =
-    fun
-    | TN_csu csu name _ => Csu.name csu ^ " " ^ Mangled.to_string name;
-  let pp f typename => F.fprintf f "%s" (to_string typename);
   let name =
     fun
-    | TN_csu _ name _ => Mangled.to_string name;
+    | CStruct name
-  let from_string_kind class_kind class_name_str =>
+    | CUnion name
-    TN_csu (Csu.Class class_kind) (Mangled.from_string class_name_str) NoTemplate;
+    | CppClass name _
-  let is_class_kind class_kind =>
+    | JavaClass name
+    | ObjcClass name
+    | ObjcProtocol name => Mangled.to_string name;
+  let to_string tname => {
+    let prefix =
+      fun
+      | CStruct _ => "struct"
+      | CUnion _ => "union"
+      | CppClass _ _
+      | JavaClass _
+      | ObjcClass _ => "class"
+      | ObjcProtocol _ => "protocol";
+    prefix tname ^ " " ^ name tname
+  };
+  let pp f typename => F.fprintf f "%s" (to_string typename);
+  let is_class =
     fun
-    | TN_csu (Class kind) _ _ when Csu.equal_class_kind class_kind kind => true
+    | CppClass _ _
+    | JavaClass _
+    | ObjcClass _ => true
     | _ => false;
+  let is_same_type t1 t2 =>
+    switch (t1, t2) {
+    | (CStruct _, CStruct _)
+    | (CUnion _, CUnion _)
+    | (CppClass _ _, CppClass _ _)
+    | (JavaClass _, JavaClass _)
+    | (ObjcClass _, ObjcClass _)
+    | (ObjcProtocol _, ObjcProtocol _) => true
+    | _ => false
+    };
   let module C = {
-    let from_string name_str => TN_csu Csu.Struct (Mangled.from_string name_str) NoTemplate;
+    let from_string name_str => CStruct (Mangled.from_string name_str);
-    let union_from_string name_str => TN_csu Csu.Union (Mangled.from_string name_str) NoTemplate;
+    let union_from_string name_str => CUnion (Mangled.from_string name_str);
   };
   let module Java = {
-    let from_string = from_string_kind Csu.Java;
+    let from_string name_str => JavaClass (Mangled.from_string name_str);
     let from_package_class package_name class_name =>
       if (String.equal package_name "") {
         from_string class_name
       } else {
         from_string (package_name ^ "." ^ class_name)
       };
-    let is_class = is_class_kind Csu.Java;
+    let is_class =
+      fun
+      | JavaClass _ => true
+      | _ => false;
     let java_lang_object = from_string "java.lang.Object";
     let java_io_serializable = from_string "java.io.Serializable";
     let java_lang_cloneable = from_string "java.lang.Cloneable";
   };
   let module Cpp = {
-    let from_string = from_string_kind Csu.CPP;
+    let from_string name_str => CppClass (Mangled.from_string name_str) NoTemplate;
     let from_template_string template_spec_info name =>
-      TN_csu (Csu.Class Csu.CPP) (Mangled.from_string name) template_spec_info;
+      CppClass (Mangled.from_string name) template_spec_info;
-    let is_class = is_class_kind Csu.CPP;
+    let is_class =
+      fun
+      | CppClass _ => true
+      | _ => false;
   };
   let module Objc = {
-    let from_string = from_string_kind Csu.Objc;
+    let from_string name_str => ObjcClass (Mangled.from_string name_str);
-    let protocol_from_string name_str =>
+    let protocol_from_string name_str => ObjcProtocol (Mangled.from_string name_str);
-      TN_csu Csu.Protocol (Mangled.from_string name_str) NoTemplate;
+    let is_class =
-    let is_class = is_class_kind Csu.Objc;
+      fun
+      | ObjcClass _ => true
+      | _ => false;
   };
   let module Set = Caml.Set.Make {
     type nonrec t = t;
@@ -292,17 +328,17 @@ let array_elem default_opt =>
   | Tarray t_el _ => t_el
   | _ => unsome "array_elem" default_opt;
 
-let is_class_of_kind typ ck =>
+let is_class_of_kind check_fun typ =>
   switch typ {
-  | Tstruct (TN_csu (Class ck') _ _) => Csu.equal_class_kind ck ck'
+  | Tstruct tname => check_fun tname
   | _ => false
   };
 
-let is_objc_class typ => is_class_of_kind typ Csu.Objc;
+let is_objc_class = is_class_of_kind Name.Objc.is_class;
 
-let is_cpp_class typ => is_class_of_kind typ Csu.CPP;
+let is_cpp_class = is_class_of_kind Name.Cpp.is_class;
 
-let is_java_class typ => is_class_of_kind typ Csu.Java;
+let is_java_class = is_class_of_kind Name.Java.is_class;
 
 let rec is_array_of_cpp_class typ =>
   switch typ {

infer/src/IR/Typ.rei

@@ -81,7 +81,12 @@ type t =
   | Tarray t static_length /** array type with statically fixed length */
 [@@deriving compare]
 and name =
-  | TN_csu Csu.t Mangled.t template_spec_info
+  | CStruct Mangled.t
+  | CUnion Mangled.t
+  | CppClass Mangled.t template_spec_info
+  | JavaClass Mangled.t
+  | ObjcClass Mangled.t
+  | ObjcProtocol Mangled.t
 [@@deriving compare]
 and template_spec_info =
   | NoTemplate
@@ -100,6 +105,12 @@ let module Name: {
   let to_string: t => string;
   let pp: Format.formatter => t => unit;
 
+  /** [is_class name] holds if [name] names CPP/Objc/Java class */
+  let is_class: t => bool;
+
+  /** [is_class name1 name2] holds if [name1] and [name2] name same kind of type */
+  let is_same_type: t => t => bool;
+
   /** name of the typename without qualifier */
   let name: t => string;
   let module C: {let from_string: string => t; let union_from_string: string => t;};

infer/src/backend/BuiltinDefn.ml

@@ -756,7 +756,7 @@ let execute_alloc mk can_return_null
         evaluate_char_sizeof (Exp.Const (Const.Cint len))
     | Exp.Sizeof _ -> e in
   let size_exp, procname = match args with
-    | [(Exp.Sizeof (Tstruct (TN_csu (Class Objc, _, _) as name) as s, len, subt), _)] ->
+    | [(Exp.Sizeof (Tstruct (ObjcClass _ as name) as s, len, subt), _)] ->
         let struct_type =
           match AttributesTable.get_correct_type_from_objc_class_name name with
           | Some struct_type -> struct_type

infer/src/backend/prover.ml

@@ -1549,13 +1549,13 @@ struct
   (** check if t1 is a subtype of t2, in Java *)
   let rec check_subtype_java tenv (t1: Typ.t) (t2: Typ.t) =
     match t1, t2 with
-    | Tstruct (TN_csu (Class Java, _, _) as cn1), Tstruct (TN_csu (Class Java, _, _) as cn2) ->
+    | Tstruct (JavaClass _ as cn1), Tstruct (JavaClass _ as cn2) ->
         Subtype.is_known_subtype tenv cn1 cn2
     | Tarray (dom_type1, _), Tarray (dom_type2, _) ->
         check_subtype_java tenv dom_type1 dom_type2
     | Tptr (dom_type1, _), Tptr (dom_type2, _) ->
         check_subtype_java tenv dom_type1 dom_type2
-    | Tarray _, Tstruct (TN_csu (Class Java, _, _) as cn2) ->
+    | Tarray _, Tstruct (JavaClass _ as cn2) ->
         Typ.Name.equal cn2 Typ.Name.Java.java_io_serializable
         || Typ.Name.equal cn2 Typ.Name.Java.java_lang_cloneable
         || Typ.Name.equal cn2 Typ.Name.Java.java_lang_object
@@ -1573,9 +1573,9 @@ struct
 
   let rec case_analysis_type tenv ((t1: Typ.t), st1) ((t2: Typ.t), st2) =
     match t1, t2 with
-    | Tstruct (TN_csu (Class Java, _, _) as cn1), Tstruct (TN_csu (Class Java, _, _) as cn2) ->
+    | Tstruct (JavaClass _ as cn1), Tstruct (JavaClass _ as cn2) ->
         Subtype.case_analysis tenv (cn1, st1) (cn2, st2)
-    | Tstruct (TN_csu (Class Java, _, _) as cn1), Tarray _
+    | Tstruct (JavaClass _ as cn1), Tarray _
       when (Typ.Name.equal cn1 Typ.Name.Java.java_io_serializable
             || Typ.Name.equal cn1 Typ.Name.Java.java_lang_cloneable
             || Typ.Name.equal cn1 Typ.Name.Java.java_lang_object) &&

infer/src/backend/symExec.ml

@@ -487,8 +487,8 @@ let resolve_method tenv class_name proc_name =
       visited := Typ.Name.Set.add class_name !visited;
       let right_proc_name =
         Typ.Procname.replace_class proc_name class_name in
-      match class_name, Tenv.lookup tenv class_name with
+      match Tenv.lookup tenv class_name with
-      | TN_csu (Class _, _, _), Some { methods; supers } ->
+      | Some { methods; supers } when Typ.Name.is_class class_name ->
           if method_exists right_proc_name methods then
             Some right_proc_name
           else

infer/src/backend/tabulation.ml

@@ -471,8 +471,8 @@ let texp_star tenv texp1 texp2 =
           | _ -> ftal_sub ftal1 ftal2' end in
   let typ_star (t1: Typ.t) (t2: Typ.t) =
     match t1, t2 with
-    | Tstruct (TN_csu (csu1, _, _) as name1), Tstruct (TN_csu (csu2, _, _) as name2)
+    | Tstruct name1, Tstruct name2
-      when Csu.equal csu1 csu2 -> (
+      when Typ.Name.is_same_type name1 name2 -> (
         match Tenv.lookup tenv name1, Tenv.lookup tenv name2 with
         | Some { fields = fields1 }, Some { fields = fields2 } when ftal_sub fields1 fields2 ->
             t2

infer/src/clang/CType_decl.ml

@@ -164,7 +164,7 @@ and get_record_typename ?tenv decl =
       CAst_utils.get_qualified_name name_info |> create_c_record_typename opt_type
   | CXXRecordDecl (_, name_info, _, _, _, _, _, _)
   | ClassTemplateSpecializationDecl (_, name_info, _, _, _, _, _, _, _) ->
-      (* we use Csu.Class for C++ because we expect Csu.Class csu from *)
+      (* we use Typ.CppClass for C++ because we expect Typ.CppClass from *)
       (* types that have methods. And in C++ struct/class/union can have methods *)
       let name_str = CAst_utils.get_qualified_name name_info in
       let templ_info = match tenv with

infer/src/eradicate/eradicateChecks.ml

@@ -118,7 +118,7 @@ let check_condition tenv case_zero find_canonical_duplicate curr_pdesc
     let loc = Procdesc.Node.get_loc node in
     let throwable_found = ref false in
     let typ_is_throwable = function
-      | Typ.Tstruct (TN_csu (Class Java, _, _) as name) ->
+      | Typ.Tstruct (Typ.JavaClass _ as name) ->
           String.equal (Typ.Name.name name) "java.lang.Throwable"
       | _ -> false in
     let do_instr = function

infer/src/harness/harness.ml

@@ -18,7 +18,7 @@ module F = Format
     constituting a lifecycle trace *)
 let try_create_lifecycle_trace name lifecycle_name lifecycle_procs tenv =
   match name with
-  | Typ.TN_csu (Class Java, _, _) ->
+  | Typ.JavaClass _ ->
       if PatternMatch.is_subtype tenv name lifecycle_name &&
          not (AndroidFramework.is_android_lib_class name) then
         let ptr_to_struct_typ = Some (Typ.Tptr (Tstruct name, Pk_pointer)) in

infer/src/harness/inhabit.ml

@@ -96,9 +96,9 @@ let rec inhabit_typ tenv typ cfg env =
            * we are already inhabiting one of their argument types *)
           let get_all_suitable_constructors (typ: Typ.t) =
             match typ with
-            | Tstruct name -> (
+            | Tstruct name when Typ.Name.is_class name -> (
-                match name, Tenv.lookup tenv name with
+                match Tenv.lookup tenv name with
-                | TN_csu (Class _, _, _), Some { methods } ->
+                | Some { methods } ->
                     let is_suitable_constructor p =
                       let try_get_non_receiver_formals p =
                         get_non_receiver_formals (formals_from_name cfg p) in

infer/src/java/jTransType.ml

@@ -88,7 +88,7 @@ let rec create_array_type typ dim =
 
 let extract_cn_no_obj typ =
   match typ with
-  | Typ.Tptr (Tstruct (TN_csu (Class _, _, _) as name), Pk_pointer) ->
+  | Typ.Tptr (Tstruct (JavaClass _ as name), Pk_pointer) ->
       let class_name = JBasics.make_cn (Typ.Name.name name) in
       if JBasics.cn_equal class_name JBasics.java_lang_object then None
       else