From 9a07318ab7d004f1217d27f1f4e5e21b654cceda Mon Sep 17 00:00:00 2001 From: Andrzej Kotulski Date: Mon, 20 Mar 2017 11:30:00 -0700 Subject: [PATCH] [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 | 37 ----------- infer/src/IR/Csu.rei | 32 ---------- infer/src/IR/Localise.ml | 2 +- infer/src/IR/Subtype.re | 5 +- infer/src/IR/Tenv.re | 8 +-- infer/src/IR/Typ.re | 88 ++++++++++++++++++-------- infer/src/IR/Typ.rei | 13 +++- infer/src/backend/BuiltinDefn.ml | 2 +- infer/src/backend/prover.ml | 8 +-- infer/src/backend/symExec.ml | 4 +- infer/src/backend/tabulation.ml | 4 +- infer/src/clang/CType_decl.ml | 2 +- infer/src/eradicate/eradicateChecks.ml | 2 +- infer/src/harness/harness.ml | 2 +- infer/src/harness/inhabit.ml | 6 +- infer/src/java/jTransType.ml | 2 +- 16 files changed, 97 insertions(+), 120 deletions(-) delete mode 100644 infer/src/IR/Csu.re delete mode 100644 infer/src/IR/Csu.rei diff --git a/infer/src/IR/Csu.re b/infer/src/IR/Csu.re deleted file mode 100644 index aeec7407b..000000000 --- a/infer/src/IR/Csu.re +++ /dev/null @@ -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]; diff --git a/infer/src/IR/Csu.rei b/infer/src/IR/Csu.rei deleted file mode 100644 index 90ea56cad..000000000 --- a/infer/src/IR/Csu.rei +++ /dev/null @@ -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; diff --git a/infer/src/IR/Localise.ml b/infer/src/IR/Localise.ml index 4311960e2..8f7a509d6 100644 --- a/infer/src/IR/Localise.ml +++ b/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 = diff --git a/infer/src/IR/Subtype.re b/infer/src/IR/Subtype.re index a0d090204..b14771b7a 100644 --- a/infer/src/IR/Subtype.re +++ b/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.TN_csu (Csu.Class Csu.CPP) _ _ => false + | Typ.JavaClass _ => Typ.Name.equal class_name Typ.Name.Java.java_lang_object | _ => false }; diff --git a/infer/src/IR/Tenv.re b/infer/src/IR/Tenv.re index 14abfdb50..888115374 100644 --- a/infer/src/IR/Tenv.re +++ b/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 => - try (Some (TypenameHash.find tenv (TN_csu (Class CPP) m templ))) { + | CStruct m => + try (Some (TypenameHash.find tenv (CppClass m NoTemplate))) { | Not_found => None } - | TN_csu (Class CPP) m templ => - try (Some (TypenameHash.find tenv (TN_csu Struct m templ))) { + | CppClass m NoTemplate => + try (Some (TypenameHash.find tenv (CStruct m))) { | Not_found => None } | _ => None diff --git a/infer/src/IR/Typ.re b/infer/src/IR/Typ.re index 5d7df2e7c..5bd1ceddc 100644 --- a/infer/src/IR/Typ.re +++ b/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; - let from_string_kind class_kind class_name_str => - TN_csu (Csu.Class class_kind) (Mangled.from_string class_name_str) NoTemplate; - let is_class_kind class_kind => + | CStruct name + | CUnion name + | CppClass name _ + | 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 union_from_string name_str => TN_csu Csu.Union (Mangled.from_string name_str) NoTemplate; + let from_string name_str => CStruct (Mangled.from_string name_str); + 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; - let is_class = is_class_kind Csu.CPP; + CppClass (Mangled.from_string name) template_spec_info; + let is_class = + fun + | CppClass _ => true + | _ => false; }; let module Objc = { - let from_string = from_string_kind Csu.Objc; - let protocol_from_string name_str => - TN_csu Csu.Protocol (Mangled.from_string name_str) NoTemplate; - let is_class = is_class_kind Csu.Objc; + let from_string name_str => ObjcClass (Mangled.from_string name_str); + let protocol_from_string name_str => ObjcProtocol (Mangled.from_string name_str); + let is_class = + 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 { diff --git a/infer/src/IR/Typ.rei b/infer/src/IR/Typ.rei index d980c9962..68567dd14 100644 --- a/infer/src/IR/Typ.rei +++ b/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;}; diff --git a/infer/src/backend/BuiltinDefn.ml b/infer/src/backend/BuiltinDefn.ml index ebda078ae..1b91e847a 100644 --- a/infer/src/backend/BuiltinDefn.ml +++ b/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 diff --git a/infer/src/backend/prover.ml b/infer/src/backend/prover.ml index 3db263607..479420163 100644 --- a/infer/src/backend/prover.ml +++ b/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) && diff --git a/infer/src/backend/symExec.ml b/infer/src/backend/symExec.ml index 45349a3ef..55ab7ae05 100644 --- a/infer/src/backend/symExec.ml +++ b/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 - | TN_csu (Class _, _, _), Some { methods; supers } -> + match Tenv.lookup tenv class_name with + | Some { methods; supers } when Typ.Name.is_class class_name -> if method_exists right_proc_name methods then Some right_proc_name else diff --git a/infer/src/backend/tabulation.ml b/infer/src/backend/tabulation.ml index 40ff95132..9b22d65ae 100644 --- a/infer/src/backend/tabulation.ml +++ b/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) - when Csu.equal csu1 csu2 -> ( + | Tstruct name1, Tstruct name2 + 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 diff --git a/infer/src/clang/CType_decl.ml b/infer/src/clang/CType_decl.ml index ce64ea4df..f54b50dd3 100644 --- a/infer/src/clang/CType_decl.ml +++ b/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 diff --git a/infer/src/eradicate/eradicateChecks.ml b/infer/src/eradicate/eradicateChecks.ml index f2c1a08e8..d30bdb427 100644 --- a/infer/src/eradicate/eradicateChecks.ml +++ b/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 diff --git a/infer/src/harness/harness.ml b/infer/src/harness/harness.ml index f30a90b18..69fcc29f1 100644 --- a/infer/src/harness/harness.ml +++ b/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 diff --git a/infer/src/harness/inhabit.ml b/infer/src/harness/inhabit.ml index b57bfa2c7..4f6d8e0e3 100644 --- a/infer/src/harness/inhabit.ml +++ b/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 -> ( - match name, Tenv.lookup tenv name with - | TN_csu (Class _, _, _), Some { methods } -> + | Tstruct name when Typ.Name.is_class name -> ( + match Tenv.lookup tenv name with + | Some { methods } -> let is_suitable_constructor p = let try_get_non_receiver_formals p = get_non_receiver_formals (formals_from_name cfg p) in diff --git a/infer/src/java/jTransType.ml b/infer/src/java/jTransType.ml index 01c3ed6fc..1bcb5989f 100644 --- a/infer/src/java/jTransType.ml +++ b/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