refactoring get_strict_supertyps to use iteration for more flexibility

Reviewed By: jeremydubreil

Differential Revision: D3221249

fb-gh-sync-id: 249aa01
fbshipit-source-id: 249aa01

infer/src/checkers/patternMatch.ml

@@ -37,29 +37,39 @@ let java_proc_name_with_class_method pn_java class_with_path method_name =
    with _ -> false)
 
 (** get the superclasses of [typ]. does not include [typ] itself *)
-let get_strict_supertypes tenv orig_struct_typ =
+let strict_supertype_iter tenv f_typ orig_struct_typ =
   let get_direct_supers = function
-    | { Sil.csu = Csu.Class _; superclasses } -> superclasses
-    | _ -> [] in
-  let rec add_typ class_name struct_typs =
-    match Tenv.lookup tenv class_name with
-    | Some struct_typ -> get_supers_rec struct_typ (Sil.StructTypSet.add struct_typ struct_typs)
-    | None -> struct_typs
-  and get_supers_rec struct_typ all_supers =
+    | { Sil.csu = Csu.Class _; superclasses } ->
+        IList.map (Tenv.lookup tenv) superclasses
+        |> IList.flatten_options
+    | _ ->
+        [] in
+  let rec get_supers_rec struct_typ =
     let direct_supers = get_direct_supers struct_typ in
-    IList.fold_left
-      (fun struct_typs class_name -> add_typ class_name struct_typs)
-      all_supers
-      direct_supers in
-  get_supers_rec orig_struct_typ Sil.StructTypSet.empty
+    IList.iter f_typ direct_supers;
+    IList.iter get_supers_rec direct_supers in
+  get_supers_rec orig_struct_typ
+
+exception Found_supertype_match
+
+(** Return [true] if [f_typ] evaluates to true on a strict supertype of [orig_struct_typ] *)
+let strict_supertype_exists tenv f_typ orig_struct_typ =
+  let wrapped_f_typ struct_typ =
+    if f_typ struct_typ
+    then raise Found_supertype_match in
+  try
+    strict_supertype_iter tenv wrapped_f_typ orig_struct_typ;
+    false
+  with Found_supertype_match ->
+    true
 
 let is_immediate_subtype this_type super_type_name =
-  IList.exists (fun cn -> Typename.equal cn super_type_name) this_type.Sil.superclasses
+  IList.exists (Typename.equal super_type_name) this_type.Sil.superclasses
 
 (** return true if [typ0] <: [typ1] *)
 let is_subtype tenv struct_typ0 struct_typ1 =
   Sil.struct_typ_equal struct_typ0 struct_typ1 ||
-  Sil.StructTypSet.mem struct_typ1 (get_strict_supertypes tenv struct_typ0)
+  strict_supertype_exists tenv (Sil.struct_typ_equal struct_typ1) struct_typ0
 
 let is_subtype_of_str tenv cn1 classname_str =
   let typename = Typename.Java.from_string classname_str in

infer/src/checkers/patternMatch.mli

@@ -59,7 +59,10 @@ val is_subtype : Tenv.t -> Sil.struct_typ -> Sil.struct_typ -> bool
 val is_subtype_of_str : Tenv.t -> Typename.t -> string -> bool
 
 (** get the superclasses of [typ]. does not include [typ] itself *)
-val get_strict_supertypes : Tenv.t -> Sil.struct_typ -> Sil.StructTypSet.t
+val strict_supertype_iter : Tenv.t -> (Sil.struct_typ -> unit) -> Sil.struct_typ -> unit
+
+(** Return [true] if [f_typ] evaluates to true on a strict supertype of [orig_struct_typ] *)
+val strict_supertype_exists : Tenv.t -> (Sil.struct_typ -> bool) -> Sil.struct_typ -> bool
 
 (** Get the name of the type of a constant *)
 val java_get_const_type_name : Sil.const -> string

infer/src/harness/androidFramework.ml

@@ -78,10 +78,6 @@ let is_fragment tenv typ =
   is_subtype_package_class tenv typ "android.app" "Fragment" ||
   is_subtype_package_class tenv typ "android.support.v4.app" "Fragment"
 
-(** return true if [struct_typ] is a subclass of [lifecycle_struct_typ] *)
-let typ_is_lifecycle_typ tenv struct_typ lifecycle_struct_typ =
-  TypSet.mem lifecycle_struct_typ (PatternMatch.get_strict_supertypes tenv struct_typ)
-
 (** return true if [class_name] is the name of a class that belong to the Android framework *)
 let is_android_lib_class class_name =
   let class_str = Typename.name class_name in

infer/src/harness/androidFramework.mli

@@ -14,9 +14,6 @@ open! Utils
 (** return the complete list of (package, lifecycle_classname, lifecycle_methods) trios *)
 val get_lifecycles : (string * string * string list) list
 
-(** return true if [typ] is a subclass of [lifecycle_typ] *)
-val typ_is_lifecycle_typ : Tenv.t -> Sil.struct_typ -> Sil.struct_typ -> bool
-
 (** return true if [typ] <: android.content.Context *)
 val is_context : Tenv.t -> Sil.struct_typ -> bool
 

infer/src/harness/harness.ml

@@ -20,7 +20,7 @@ let try_create_lifecycle_trace struct_typ lifecycle_struct_typ lifecycle_procs t
   match struct_typ with
   | { Sil.csu = Csu.Class Java; struct_name = Some name } ->
       let class_name = Typename.TN_csu (Csu.Class Java, name) in
-      if AndroidFramework.typ_is_lifecycle_typ tenv struct_typ lifecycle_struct_typ &&
+      if PatternMatch.is_subtype tenv struct_typ lifecycle_struct_typ &&
          not (AndroidFramework.is_android_lib_class class_name) then
         let ptr_to_struct_typ = Some (Sil.Tptr (Tstruct struct_typ, Pk_pointer)) in
         IList.fold_left