From ae632e281a5d1ca791bf3a7ae9295891a696f79a Mon Sep 17 00:00:00 2001 From: Josh Berdine Date: Wed, 28 Sep 2016 04:38:38 -0700 Subject: [PATCH] [IR] Refactor Typ.struct_typ into separate module Summary: Refactor Sil.struct_typ and associated operations into a separate StructTyp module. This is possible now that Typ.Tstruct only carries a type name instead of the definition directly, and is helpful to simplify module dependencies. Reviewed By: cristianoc Differential Revision: D3919357 fbshipit-source-id: a37a656 --- infer/src/IR/Sil.re | 2 +- infer/src/IR/StructTyp.re | 143 +++++++++++++++++++ infer/src/IR/StructTyp.rei | 73 ++++++++++ infer/src/IR/Tenv.re | 17 ++- infer/src/IR/Tenv.rei | 16 +-- infer/src/IR/Typ.re | 123 ---------------- infer/src/IR/Typ.rei | 54 ------- infer/src/backend/absarray.ml | 2 +- infer/src/backend/prop.ml | 4 +- infer/src/backend/prover.ml | 12 +- infer/src/backend/rearrange.ml | 12 +- infer/src/backend/taint.ml | 6 +- infer/src/backend/taint.mli | 2 +- infer/src/checkers/annotationReachability.ml | 2 +- infer/src/checkers/checkers.ml | 2 +- infer/src/checkers/patternMatch.mli | 2 +- infer/src/clang/cFrontend_utils.ml | 2 +- infer/src/clang/cTypes_decl.ml | 2 +- infer/src/clang/objcInterface_decl.ml | 4 +- infer/src/eradicate/eradicateChecks.ml | 2 +- infer/src/harness/androidFramework.mli | 8 +- infer/src/java/jTrans.ml | 2 +- infer/src/java/jTransType.ml | 2 +- infer/src/java/jTransType.mli | 2 +- 24 files changed, 267 insertions(+), 229 deletions(-) create mode 100644 infer/src/IR/StructTyp.re create mode 100644 infer/src/IR/StructTyp.rei diff --git a/infer/src/IR/Sil.re b/infer/src/IR/Sil.re index f28edf492..95b54b7d3 100644 --- a/infer/src/IR/Sil.re +++ b/infer/src/IR/Sil.re @@ -185,7 +185,7 @@ let has_objc_ref_counter tenv hpred => switch hpred { | Hpointsto _ _ (Sizeof (Tstruct name) _ _) => switch (Tenv.lookup tenv name) { - | Some {fields} => IList.exists Typ.is_objc_ref_counter_field fields + | Some {fields} => IList.exists StructTyp.is_objc_ref_counter_field fields | _ => false } | _ => false diff --git a/infer/src/IR/StructTyp.re b/infer/src/IR/StructTyp.re new file mode 100644 index 000000000..528bce3ac --- /dev/null +++ b/infer/src/IR/StructTyp.re @@ -0,0 +1,143 @@ +/* + * vim: set ft=rust: + * vim: set ft=reason: + * + * Copyright (c) 2009 - 2013 Monoidics ltd. + * Copyright (c) 2013 - 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! Utils; + + +/** The Smallfoot Intermediate Language: Struct Types */ +let module L = Logging; + +let module F = Format; + +type fields = list (Ident.fieldname, Typ.t, Annot.Item.t); + + +/** Type for a structured value. */ +type t = { + fields: fields, /** non-static fields */ + statics: fields, /** static fields */ + supers: list Typename.t, /** superclasses */ + methods: list Procname.t, /** methods defined */ + annots: Annot.Item.t /** annotations */ +}; + +type lookup = Typename.t => option t; + +let fld_typ_ann_compare fta1 fta2 => + triple_compare Ident.fieldname_compare Typ.compare Annot.Item.compare fta1 fta2; + +let pp pe pp_base name f {fields} => + if false { + /* change false to true to print the details of struct */ + F.fprintf + f + "%a {%a} %a" + Typename.pp + name + (pp_seq (fun f (fld, t, _) => F.fprintf f "%a %a" (Typ.pp_full pe) t Ident.pp_fieldname fld)) + fields + pp_base + () + } else { + F.fprintf f "%a %a" Typename.pp name pp_base () + }; + +let internal_mk_struct + default::default=? + fields::fields=? + statics::statics=? + methods::methods=? + supers::supers=? + annots::annots=? + () => { + let mk_struct_ + default::default={fields: [], statics: [], methods: [], supers: [], annots: Annot.Item.empty} + fields::fields=default.fields + statics::statics=default.statics + methods::methods=default.methods + supers::supers=default.supers + annots::annots=default.annots + () => { + fields, + statics, + methods, + supers, + annots + }; + mk_struct_ + default::?default + fields::?fields + statics::?statics + methods::?methods + supers::?supers + annots::?annots + () +}; + + +/** the element typ of the final extensible array in the given typ, if any */ +let rec get_extensible_array_element_typ lookup::lookup (typ: Typ.t) => + switch typ { + | Tarray typ _ => Some typ + | Tstruct name => + switch (lookup name) { + | Some {fields} => + switch (IList.last fields) { + | Some (_, fld_typ, _) => get_extensible_array_element_typ lookup::lookup fld_typ + | None => None + } + | None => None + } + | _ => None + }; + + +/** If a struct type with field f, return the type of f. If not, return the default */ +let fld_typ lookup::lookup default::default fn (typ: Typ.t) => + switch typ { + | Tstruct name => + switch (lookup name) { + | Some {fields} => + try (snd3 (IList.find (fun (f, _, _) => Ident.fieldname_equal f fn) fields)) { + | Not_found => default + } + | None => default + } + | _ => default + }; + +let get_field_type_and_annotation lookup::lookup fn (typ: Typ.t) => + switch typ { + | Tstruct name + | Tptr (Tstruct name) _ => + switch (lookup name) { + | Some {fields, statics} => + try { + let (_, t, a) = IList.find (fun (f, _, _) => Ident.fieldname_equal f fn) (fields @ statics); + Some (t, a) + } { + | Not_found => None + } + | None => None + } + | _ => None + }; + +let objc_ref_counter_annot = [({Annot.class_name: "ref_counter", parameters: []}, false)]; + + +/** Field used for objective-c reference counting */ +let objc_ref_counter_field = (Ident.fieldname_hidden, Typ.Tint IInt, objc_ref_counter_annot); + +let is_objc_ref_counter_field (fld, _, a) => + Ident.fieldname_is_hidden fld && Annot.Item.compare a objc_ref_counter_annot == 0; diff --git a/infer/src/IR/StructTyp.rei b/infer/src/IR/StructTyp.rei new file mode 100644 index 000000000..996e2be70 --- /dev/null +++ b/infer/src/IR/StructTyp.rei @@ -0,0 +1,73 @@ +/* + * vim: set ft=rust: + * vim: set ft=reason: + * + * Copyright (c) 2009 - 2013 Monoidics ltd. + * Copyright (c) 2013 - 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! Utils; + + +/** The Smallfoot Intermediate Language: Struct Types */ +let module F = Format; + +type fields = list (Ident.fieldname, Typ.t, Annot.Item.t); + + +/** Type for a structured value. */ +type t = private { + fields: fields, /** non-static fields */ + statics: fields, /** static fields */ + supers: list Typename.t, /** supers */ + methods: list Procname.t, /** methods defined */ + annots: Annot.Item.t /** annotations */ +}; + +type lookup = Typename.t => option t; + + +/** Comparision for fieldnames * types * item annotations. */ +let fld_typ_ann_compare: + (Ident.fieldname, Typ.t, Annot.Item.t) => (Ident.fieldname, Typ.t, Annot.Item.t) => int; + + +/** Pretty print a struct type. */ +let pp: printenv => (F.formatter => unit => unit) => Typename.t => F.formatter => t => unit; + + +/** Construct a struct_typ, normalizing field types */ +let internal_mk_struct: + default::t? => + fields::fields? => + statics::fields? => + methods::list Procname.t? => + supers::list Typename.t? => + annots::Annot.Item.t? => + unit => + t; + + +/** the element typ of the final extensible array in the given typ, if any */ +let get_extensible_array_element_typ: lookup::lookup => Typ.t => option Typ.t; + + +/** If a struct type with field f, return the type of f. + If not, return the default type if given, otherwise raise an exception */ +let fld_typ: lookup::lookup => default::Typ.t => Ident.fieldname => Typ.t => Typ.t; + + +/** Return the type of the field [fn] and its annotation, None if [typ] has no field named [fn] */ +let get_field_type_and_annotation: + lookup::lookup => Ident.fieldname => Typ.t => option (Typ.t, Annot.Item.t); + + +/** Field used for objective-c reference counting */ +let objc_ref_counter_field: (Ident.fieldname, Typ.t, Annot.Item.t); + +let is_objc_ref_counter_field: (Ident.fieldname, Typ.t, Annot.Item.t) => bool; diff --git a/infer/src/IR/Tenv.re b/infer/src/IR/Tenv.re index 83a3cd166..f30f2deff 100644 --- a/infer/src/IR/Tenv.re +++ b/infer/src/IR/Tenv.re @@ -23,7 +23,7 @@ let module TypenameHash = Hashtbl.Make { /** Type for type environment. */ -type t = TypenameHash.t Typ.struct_typ; +type t = TypenameHash.t StructTyp.t; /** Create a new type environment. */ @@ -41,7 +41,7 @@ let mk_struct annots::annots=? name => { let struct_typ = - Typ.internal_mk_struct + StructTyp.internal_mk_struct default::?default fields::?fields statics::?statics @@ -59,7 +59,7 @@ let mem tenv name => TypenameHash.mem tenv name; /** Look up a name in the global type environment. */ -let lookup tenv name => +let lookup tenv name :option StructTyp.t => try (Some (TypenameHash.find tenv name)) { | Not_found => /* ToDo: remove the following additional lookups once C/C++ interop is resolved */ @@ -83,23 +83,22 @@ let add tenv name struct_typ => TypenameHash.replace tenv name struct_typ; /** Get method that is being overriden by java_pname (if any) **/ let get_overriden_method tenv pname_java => { - let struct_typ_get_method_by_name struct_typ method_name => - IList.find (fun meth => method_name == Procname.get_method meth) struct_typ.Typ.methods; + let struct_typ_get_method_by_name (struct_typ: StructTyp.t) method_name => + IList.find (fun meth => method_name == Procname.get_method meth) struct_typ.methods; let rec get_overriden_method_in_supers pname_java supers => switch supers { | [superclass, ...supers_tail] => switch (lookup tenv superclass) { | Some struct_typ => try (Some (struct_typ_get_method_by_name struct_typ (Procname.java_get_method pname_java))) { - | Not_found => - get_overriden_method_in_supers pname_java (supers_tail @ struct_typ.Typ.supers) + | Not_found => get_overriden_method_in_supers pname_java (supers_tail @ struct_typ.supers) } | None => get_overriden_method_in_supers pname_java supers_tail } | [] => None }; switch (lookup tenv (Procname.java_get_class_type_name pname_java)) { - | Some {Typ.supers: supers} => get_overriden_method_in_supers pname_java supers + | Some {supers} => get_overriden_method_in_supers pname_java supers | _ => None } }; @@ -134,7 +133,7 @@ let pp fmt (tenv: t) => ( fun name typ => { Format.fprintf fmt "@[<6>NAME: %s@." (Typename.to_string name); - Format.fprintf fmt "@[<6>TYPE: %a@." (Typ.pp_struct_typ pe_text (fun _ () => ()) name) typ + Format.fprintf fmt "@[<6>TYPE: %a@." (StructTyp.pp pe_text (fun _ () => ()) name) typ } ) tenv; diff --git a/infer/src/IR/Tenv.rei b/infer/src/IR/Tenv.rei index 48206353f..fe8b9e077 100644 --- a/infer/src/IR/Tenv.rei +++ b/infer/src/IR/Tenv.rei @@ -18,7 +18,7 @@ type t; /** Type for type environment. */ /** Add a (name,typename) pair to the global type environment. */ -let add: t => Typename.t => Typ.struct_typ => unit; +let add: t => Typename.t => StructTyp.t => unit; /** Create a new type environment. */ @@ -26,11 +26,11 @@ let create: unit => t; /** Fold a function over the elements of the type environment. */ -let fold: (Typename.t => Typ.struct_typ => 'a => 'a) => t => 'a => 'a; +let fold: (Typename.t => StructTyp.t => 'a => 'a) => t => 'a => 'a; /** iterate over a type environment */ -let iter: (Typename.t => Typ.struct_typ => unit) => t => unit; +let iter: (Typename.t => StructTyp.t => unit) => t => unit; /** Load a type environment from a file */ @@ -38,20 +38,20 @@ let load_from_file: DB.filename => option t; /** Look up a name in the global type environment. */ -let lookup: t => Typename.t => option Typ.struct_typ; +let lookup: t => Typename.t => option StructTyp.t; /** Construct a struct_typ, normalizing field types */ let mk_struct: t => - default::Typ.struct_typ? => - fields::Typ.struct_fields? => - statics::Typ.struct_fields? => + default::StructTyp.t? => + fields::StructTyp.fields? => + statics::StructTyp.fields? => methods::list Procname.t? => supers::list Typename.t? => annots::Annot.Item.t? => Typename.t => - Typ.struct_typ; + StructTyp.t; /** Check if typename is found in t */ diff --git a/infer/src/IR/Typ.re b/infer/src/IR/Typ.re index e58b16338..6710bb0e6 100644 --- a/infer/src/IR/Typ.re +++ b/infer/src/IR/Typ.re @@ -193,20 +193,6 @@ type t = | Tstruct of Typename.t /** structured value type name */ | Tarray of t static_length /** array type with statically fixed length */; -type struct_fields = list (Ident.fieldname, t, Annot.Item.t); - - -/** Type for a structured value. */ -type struct_typ = { - fields: struct_fields, /** non-static fields */ - statics: struct_fields, /** static fields */ - supers: list Typename.t, /** superclasses */ - methods: list Procname.t, /** methods defined */ - annots: Annot.Item.t /** annotations */ -}; - -type lookup = Typename.t => option struct_typ; - /** Comparision for types. */ let rec compare t1 t2 => @@ -244,9 +230,6 @@ let rec compare t1 t2 => let equal t1 t2 => compare t1 t2 == 0; -let fld_typ_ann_compare fta1 fta2 => - triple_compare Ident.fieldname_compare compare Annot.Item.compare fta1 fta2; - /** Pretty print a type declaration. pp_base prints the variable for a declaration, or can be skip to print only the type */ @@ -289,22 +272,6 @@ let pp pe f te => () }; -let pp_struct_typ pe pp_base name f {fields} => - if false { - /* change false to true to print the details of struct */ - F.fprintf - f - "%a {%a} %a" - Typename.pp - name - (pp_seq (fun f (fld, t, _) => F.fprintf f "%a %a" (pp_full pe) t Ident.pp_fieldname fld)) - fields - pp_base - () - } else { - F.fprintf f "%a %a" Typename.pp name pp_base () - }; - let to_string typ => { let pp fmt () => pp_full pe_text fmt typ; pp_to_string pp () @@ -336,38 +303,6 @@ let module Tbl = Hashtbl.Make { let hash = Hashtbl.hash; }; -let internal_mk_struct - default::default=? - fields::fields=? - statics::statics=? - methods::methods=? - supers::supers=? - annots::annots=? - () => { - let mk_struct_ - default::default={fields: [], statics: [], methods: [], supers: [], annots: Annot.Item.empty} - fields::fields=default.fields - statics::statics=default.statics - methods::methods=default.methods - supers::supers=default.supers - annots::annots=default.annots - () => { - fields, - statics, - methods, - supers, - annots - }; - mk_struct_ - default::?default - fields::?fields - statics::?statics - methods::?methods - supers::?supers - annots::?annots - () -}; - let name = fun | Tstruct name => Some name @@ -396,55 +331,6 @@ let array_elem default_opt => | Tarray t_el _ => t_el | _ => unsome "array_elem" default_opt; - -/** the element typ of the final extensible array in the given typ, if any */ -let rec get_extensible_array_element_typ lookup::lookup typ => - switch typ { - | Tarray typ _ => Some typ - | Tstruct name => - switch (lookup name) { - | Some {fields} => - switch (IList.last fields) { - | Some (_, fld_typ, _) => get_extensible_array_element_typ lookup::lookup fld_typ - | None => None - } - | None => None - } - | _ => None - }; - - -/** If a struct type with field f, return the type of f. If not, return the default */ -let struct_typ_fld lookup::lookup default::default fn typ => - switch typ { - | Tstruct name => - switch (lookup name) { - | Some {fields} => - try (snd3 (IList.find (fun (f, _, _) => Ident.fieldname_equal f fn) fields)) { - | Not_found => default - } - | None => default - } - | _ => default - }; - -let get_field_type_and_annotation lookup::lookup fn typ => - switch typ { - | Tstruct name - | Tptr (Tstruct name) _ => - switch (lookup name) { - | Some {fields, statics} => - try { - let (_, t, a) = IList.find (fun (f, _, _) => Ident.fieldname_equal f fn) (fields @ statics); - Some (t, a) - } { - | Not_found => None - } - | None => None - } - | _ => None - }; - let is_class_of_kind typ ck => switch typ { | Tstruct (TN_csu (Class ck') _) => ck == ck' @@ -479,15 +365,6 @@ let has_block_prefix s => /** Check if type is a type for a block in objc */ let is_block_type typ => has_block_prefix (to_string typ); -let objc_ref_counter_annot = [({Annot.class_name: "ref_counter", parameters: []}, false)]; - - -/** Field used for objective-c reference counting */ -let objc_ref_counter_field = (Ident.fieldname_hidden, Tint IInt, objc_ref_counter_annot); - -let is_objc_ref_counter_field (fld, _, a) => - Ident.fieldname_is_hidden fld && Annot.Item.compare a objc_ref_counter_annot == 0; - /** Java types by name */ let rec java_from_string = diff --git a/infer/src/IR/Typ.rei b/infer/src/IR/Typ.rei index 16e931b4b..8d55ea223 100644 --- a/infer/src/IR/Typ.rei +++ b/infer/src/IR/Typ.rei @@ -83,25 +83,6 @@ type t = | Tstruct of Typename.t /** structured value type name */ | Tarray of t static_length /** array type with statically fixed length */; -type struct_fields = list (Ident.fieldname, t, Annot.Item.t); - - -/** Type for a structured value. */ -type struct_typ = private { - fields: struct_fields, /** non-static fields */ - statics: struct_fields, /** static fields */ - supers: list Typename.t, /** supers */ - methods: list Procname.t, /** methods defined */ - annots: Annot.Item.t /** annotations */ -}; - -type lookup = Typename.t => option struct_typ; - - -/** Comparision for fieldnames * types * item annotations. */ -let fld_typ_ann_compare: - (Ident.fieldname, t, Annot.Item.t) => (Ident.fieldname, t, Annot.Item.t) => int; - /** Comparision for types. */ let compare: t => t => int; @@ -110,9 +91,6 @@ let compare: t => t => int; /** Equality for types. */ let equal: t => t => bool; -let pp_struct_typ: - printenv => (F.formatter => unit => unit) => Typename.t => F.formatter => struct_typ => unit; - /** [pp_decl pe pp_base f typ] pretty prints a type declaration. pp_base prints the variable for a declaration, or can be skip to print only the type */ @@ -147,18 +125,6 @@ let module Map: Map.S with type key = t; let module Tbl: Hashtbl.S with type key = t; -/** Construct a struct_typ, normalizing field types */ -let internal_mk_struct: - default::struct_typ? => - fields::struct_fields? => - statics::struct_fields? => - methods::list Procname.t? => - supers::list Typename.t? => - annots::Annot.Item.t? => - unit => - struct_typ; - - /** The name of a type */ let name: t => option Typename.t; @@ -171,20 +137,6 @@ let strip_ptr: t => t; If not, return the default type if given, otherwise raise an exception */ let array_elem: option t => t => t; - -/** the element typ of the final extensible array in the given typ, if any */ -let get_extensible_array_element_typ: lookup::lookup => t => option t; - - -/** If a struct type with field f, return the type of f. - If not, return the default type if given, otherwise raise an exception */ -let struct_typ_fld: lookup::lookup => default::t => Ident.fieldname => t => t; - - -/** Return the type of the field [fn] and its annotation, None if [typ] has no field named [fn] */ -let get_field_type_and_annotation: - lookup::lookup => Ident.fieldname => t => option (t, Annot.Item.t); - let is_objc_class: t => bool; let is_cpp_class: t => bool; @@ -201,12 +153,6 @@ let has_block_prefix: string => bool; /** Check if type is a type for a block in objc */ let is_block_type: t => bool; - -/** Field used for objective-c reference counting */ -let objc_ref_counter_field: (Ident.fieldname, t, Annot.Item.t); - -let is_objc_ref_counter_field: (Ident.fieldname, t, Annot.Item.t) => bool; - let unsome: string => option t => t; diff --git a/infer/src/backend/absarray.ml b/infer/src/backend/absarray.ml index df8a17c9f..bf335957e 100644 --- a/infer/src/backend/absarray.ml +++ b/infer/src/backend/absarray.ml @@ -558,7 +558,7 @@ let check_after_array_abstraction tenv prop = else IList.iter (fun (ind, se) -> check_se root (offs @ [Sil.Off_index ind]) typ_elem se) esel | Sil.Estruct (fsel, _) -> IList.iter (fun (f, se) -> - let typ_f = Typ.struct_typ_fld ~lookup ~default:Tvoid f typ in + let typ_f = StructTyp.fld_typ ~lookup ~default:Tvoid f typ in check_se root (offs @ [Sil.Off_fld (f, typ)]) typ_f se) fsel in let check_hpred = function | Sil.Hpointsto (root, se, texp) -> diff --git a/infer/src/backend/prop.ml b/infer/src/backend/prop.ml index ee9a5c88a..89b12c233 100644 --- a/infer/src/backend/prop.ml +++ b/infer/src/backend/prop.ml @@ -510,7 +510,7 @@ let rec create_strexp_of_type tenv struct_init_mode (typ : Typ.t) len inst : Sil (* pass len as an accumulator, so that it is passed to create_strexp_of_type for the last field, but always return None so that only the last field receives len *) let f (fld, t, a) (flds, len) = - if Typ.is_objc_ref_counter_field (fld, t, a) then + if StructTyp.is_objc_ref_counter_field (fld, t, a) then ((fld, Sil.Eexp (Exp.one, inst)) :: flds, None) else ((fld, create_strexp_of_type tenv struct_init_mode t len inst) :: flds, None) in @@ -892,7 +892,7 @@ module Normalize = struct (* test if the extensible array at the end of [typ] has elements of type [elt] *) let extensible_array_element_typ_equal elt typ = Option.map_default (Typ.equal elt) false - (Typ.get_extensible_array_element_typ ~lookup typ) in + (StructTyp.get_extensible_array_element_typ ~lookup typ) in begin match e1', e2' with (* pattern for arrays and extensible structs: diff --git a/infer/src/backend/prover.ml b/infer/src/backend/prover.ml index ea7db4bab..fa21bbda4 100644 --- a/infer/src/backend/prover.ml +++ b/infer/src/backend/prover.ml @@ -402,7 +402,7 @@ end = struct | Sil.Estruct (fsel, _), t -> let get_field_type f = Option.map_default (fun t' -> - Option.map fst @@ Typ.get_field_type_and_annotation ~lookup f t' + Option.map fst @@ StructTyp.get_field_type_and_annotation ~lookup f t' ) None t in IList.iter (fun (f, se) -> strexp_extract (se, get_field_type f)) fsel | Sil.Earray (len, isel, _), t -> @@ -1320,8 +1320,8 @@ let rec sexp_imply tenv source calc_index_frame calc_missing subs se1 se2 typ2 : let se2' = Sil.Earray (len, [(Exp.zero, se2)], inst) in let typ2' = Typ.Tarray (typ2, None) in (* In the sexp_imply, struct_imply, array_imply, and sexp_imply_nolhs functions, the typ2 - argument is only used by eventually passing its value to Typ.struct_typ_fld, Exp.Lfield, - Typ.struct_typ_fld, or Typ.array_elem. None of these are sensitive to the length field + argument is only used by eventually passing its value to StructTyp.fld, Exp.Lfield, + StructTyp.fld, or Typ.array_elem. None of these are sensitive to the length field of Tarray, so forgetting the length of typ2' here is not a problem. *) sexp_imply tenv source true calc_missing subs se1 se2' typ2' (* calculate index_frame because the rhs is a singleton array *) | _ -> @@ -1336,7 +1336,7 @@ and struct_imply tenv source calc_missing subs fsel1 fsel2 typ2 : subst2 * ((Ide begin match Ident.fieldname_compare f1 f2 with | 0 -> - let typ' = Typ.struct_typ_fld ~lookup ~default:Typ.Tvoid f2 typ2 in + let typ' = StructTyp.fld_typ ~lookup ~default:Typ.Tvoid f2 typ2 in let subs', se_frame, se_missing = sexp_imply tenv (Exp.Lfield (source, f2, typ2)) false calc_missing subs se1 se2 typ' in let subs'', fld_frame, fld_missing = struct_imply tenv source calc_missing subs' fsel1' fsel2' typ2 in @@ -1351,7 +1351,7 @@ and struct_imply tenv source calc_missing subs fsel1 fsel2 typ2 : subst2 * ((Ide let subs', fld_frame, fld_missing = struct_imply tenv source calc_missing subs fsel1' fsel2 typ2 in subs', ((f1, se1) :: fld_frame), fld_missing | _ -> - let typ' = Typ.struct_typ_fld ~lookup ~default:Typ.Tvoid f2 typ2 in + let typ' = StructTyp.fld_typ ~lookup ~default:Typ.Tvoid f2 typ2 in let subs' = sexp_imply_nolhs tenv (Exp.Lfield (source, f2, typ2)) calc_missing subs se2 typ' in let subs', fld_frame, fld_missing = struct_imply tenv source calc_missing subs' fsel1 fsel2' typ2 in @@ -1359,7 +1359,7 @@ and struct_imply tenv source calc_missing subs fsel1 fsel2 typ2 : subst2 * ((Ide subs', fld_frame, fld_missing' end | [], (f2, se2) :: fsel2' -> - let typ' = Typ.struct_typ_fld ~lookup ~default:Typ.Tvoid f2 typ2 in + let typ' = StructTyp.fld_typ ~lookup ~default:Typ.Tvoid f2 typ2 in let subs' = sexp_imply_nolhs tenv (Exp.Lfield (source, f2, typ2)) calc_missing subs se2 typ' in let subs'', fld_frame, fld_missing = struct_imply tenv source calc_missing subs' [] fsel2' typ2 in subs'', fld_frame, (f2, se2):: fld_missing diff --git a/infer/src/backend/rearrange.ml b/infer/src/backend/rearrange.ml index df34a919a..5c3115df5 100644 --- a/infer/src/backend/rearrange.ml +++ b/infer/src/backend/rearrange.ml @@ -116,7 +116,7 @@ let rec create_struct_values pname tenv orig_prop footprint_part kind max_stamp let replace_typ_of_f (f', t', a') = if Ident.fieldname_equal f f' then (f, res_t', a') else (f', t', a') in let fields' = - IList.sort Typ.fld_typ_ann_compare (IList.map replace_typ_of_f fields) in + IList.sort StructTyp.fld_typ_ann_compare (IList.map replace_typ_of_f fields) in ignore (Tenv.mk_struct tenv ~default:struct_typ ~fields:fields' name) ; (atoms', se, t) | exception Not_found -> @@ -224,7 +224,7 @@ let rec _strexp_extend_values let f', t' = replace_fv res_typ' (f, t) in (f', t', a) in let fields' = - IList.sort Typ.fld_typ_ann_compare (IList.map replace_fta fields) in + IList.sort StructTyp.fld_typ_ann_compare (IList.map replace_fta fields) in ignore (Tenv.mk_struct tenv ~default:struct_typ ~fields:fields' name) ; (res_atoms', Sil.Estruct (res_fsel', inst'), typ) :: acc in IList.fold_left replace [] atoms_se_typ_list' @@ -236,7 +236,7 @@ let rec _strexp_extend_values let replace_fta (f', t', a') = if Ident.fieldname_equal f' f then (f, res_typ', a') else (f', t', a') in let fields' = - IList.sort Typ.fld_typ_ann_compare (IList.map replace_fta fields) in + IList.sort StructTyp.fld_typ_ann_compare (IList.map replace_fta fields) in ignore (Tenv.mk_struct tenv ~default:struct_typ ~fields:fields' name) ; [(atoms', Sil.Estruct (res_fsel', inst'), typ)] ) @@ -655,7 +655,7 @@ let add_guarded_by_constraints tenv prop lexp pdesc = IList.find_map_opt annot_extract_guarded_by_str item_annot in (* if [fld] is annotated with @GuardedBy("mLock"), return mLock *) let get_guarded_by_fld_str fld typ = - match Typ.get_field_type_and_annotation ~lookup fld typ with + match StructTyp.get_field_type_and_annotation ~lookup fld typ with | Some (_, item_annot) -> begin match extract_guarded_by_str item_annot with @@ -683,7 +683,7 @@ let add_guarded_by_constraints tenv prop lexp pdesc = try let fld, strexp = IList.find f flds in begin - match Typ.get_field_type_and_annotation ~lookup fld typ with + match StructTyp.get_field_type_and_annotation ~lookup fld typ with | Some (fld_typ, _) -> Some (strexp, fld_typ) | None -> None end @@ -1229,7 +1229,7 @@ let check_dereference_error tenv pdesc (prop : Prop.normal Prop.t) lexp loc = is_nullable || Pvar.is_local pvar | Sil.Hpointsto (_, Sil.Estruct (flds, _), Exp.Sizeof (typ, _, _)) -> let fld_is_nullable fld = - match Typ.get_field_type_and_annotation ~lookup fld typ with + match StructTyp.get_field_type_and_annotation ~lookup fld typ with | Some (_, annot) -> Annotations.ia_is_nullable annot | _ -> false in let is_strexp_pt_by_nullable_fld (fld, strexp) = diff --git a/infer/src/backend/taint.ml b/infer/src/backend/taint.ml index 247b0147a..f80501a65 100644 --- a/infer/src/backend/taint.ml +++ b/infer/src/backend/taint.ml @@ -351,12 +351,12 @@ let tainted_params callee_pname = IList.map (fun param_num -> param_num, taint_info.PredSymb.taint_kind) tainted_param_indices | None -> [] -let has_taint_annotation fieldname struct_typ = +let has_taint_annotation fieldname (struct_typ: StructTyp.t) = let fld_has_taint_annot (fname, _, annot) = Ident.fieldname_equal fieldname fname && (Annotations.ia_is_privacy_source annot || Annotations.ia_is_integrity_source annot) in - IList.exists fld_has_taint_annot struct_typ.Typ.fields || - IList.exists fld_has_taint_annot struct_typ.Typ.statics + IList.exists fld_has_taint_annot struct_typ.fields || + IList.exists fld_has_taint_annot struct_typ.statics (* add tainting attributes to a list of paramenters *) let get_params_to_taint tainted_param_nums formal_params = diff --git a/infer/src/backend/taint.mli b/infer/src/backend/taint.mli index ae600848b..c2ef11183 100644 --- a/infer/src/backend/taint.mli +++ b/infer/src/backend/taint.mli @@ -21,7 +21,7 @@ val accepts_sensitive_params : val tainted_params : Procname.t -> (int * PredSymb.taint_kind) list (** returns the taint_kind of [fieldname] if it has a taint source annotation *) -val has_taint_annotation : Ident.fieldname -> Typ.struct_typ -> bool +val has_taint_annotation : Ident.fieldname -> StructTyp.t -> bool val add_tainting_attribute : Tenv.t -> PredSymb.t -> Pvar.t -> Prop.normal Prop.t -> Prop.normal Prop.t diff --git a/infer/src/checkers/annotationReachability.ml b/infer/src/checkers/annotationReachability.ml index c96432009..a604f817b 100644 --- a/infer/src/checkers/annotationReachability.ml +++ b/infer/src/checkers/annotationReachability.ml @@ -136,7 +136,7 @@ let is_allocator tenv pname = let check_attributes check tenv pname = let check_class_attributes check tenv = function | Procname.Java java_pname -> - let check_class_annots _ { Typ.annots; } = check annots in + let check_class_annots _ { StructTyp.annots; } = check annots in PatternMatch.supertype_exists tenv check_class_annots (Procname.java_get_class_type_name java_pname) diff --git a/infer/src/checkers/checkers.ml b/infer/src/checkers/checkers.ml index c654d1f9b..c0fbec9d9 100644 --- a/infer/src/checkers/checkers.ml +++ b/infer/src/checkers/checkers.ml @@ -113,7 +113,7 @@ module ST = struct let is_field_suppressed = match field_name, PatternMatch.get_this_type proc_attributes with | Some field_name, Some t -> begin - match Typ.get_field_type_and_annotation ~lookup field_name t with + match StructTyp.get_field_type_and_annotation ~lookup field_name t with | Some (_, ia) -> Annotations.ia_has_annotation_with ia annotation_matches | None -> false end diff --git a/infer/src/checkers/patternMatch.mli b/infer/src/checkers/patternMatch.mli index 6c93c223c..c685b0a3d 100644 --- a/infer/src/checkers/patternMatch.mli +++ b/infer/src/checkers/patternMatch.mli @@ -60,7 +60,7 @@ val is_subtype : Tenv.t -> Typename.t -> Typename.t -> bool val is_subtype_of_str : Tenv.t -> Typename.t -> string -> bool (** Holds iff the predicate holds on a supertype of the named type, including the type itself *) -val supertype_exists : Tenv.t -> (Typename.t -> Typ.struct_typ -> bool) -> Typename.t -> bool +val supertype_exists : Tenv.t -> (Typename.t -> StructTyp.t -> bool) -> Typename.t -> bool (** Get the name of the type of a constant *) val java_get_const_type_name : Const.t -> string diff --git a/infer/src/clang/cFrontend_utils.ml b/infer/src/clang/cFrontend_utils.ml index ef513b88a..3cb87255e 100644 --- a/infer/src/clang/cFrontend_utils.ml +++ b/infer/src/clang/cFrontend_utils.ml @@ -525,7 +525,7 @@ struct let sort_fields_tenv tenv = - let sort_fields_struct name ({Typ.fields} as st) = + let sort_fields_struct name ({StructTyp.fields} as st) = ignore (Tenv.mk_struct tenv ~default:st ~fields:(sort_fields fields) name) in Tenv.iter sort_fields_struct tenv diff --git a/infer/src/clang/cTypes_decl.ml b/infer/src/clang/cTypes_decl.ml index 844e19a15..41bcaa155 100644 --- a/infer/src/clang/cTypes_decl.ml +++ b/infer/src/clang/cTypes_decl.ml @@ -179,7 +179,7 @@ and get_record_declaration_struct_type tenv decl = let is_complete_definition = record_decl_info.Clang_ast_t.rdi_is_complete_definition in let sil_typename = Typename.TN_csu (csu, mangled_name) in let extra_fields = if CTrans_models.is_objc_memory_model_controlled name then - [Typ.objc_ref_counter_field] + [StructTyp.objc_ref_counter_field] else [] in let annots = if csu = Csu.Class Csu.CPP then Annot.Class.cpp diff --git a/infer/src/clang/objcInterface_decl.ml b/infer/src/clang/objcInterface_decl.ml index 604bc8604..fa9ccba4c 100644 --- a/infer/src/clang/objcInterface_decl.ml +++ b/infer/src/clang/objcInterface_decl.ml @@ -119,7 +119,7 @@ let add_class_to_tenv type_ptr_to_sil_type tenv curr_class decl_info name_info d | _ -> fields, supers, methods in let fields = General_utils.append_no_duplicates_fields fields fields_sc in (* We add the special hidden counter_field for implementing reference counting *) - let modelled_fields = Typ.objc_ref_counter_field :: CField_decl.modelled_field name_info in + let modelled_fields = StructTyp.objc_ref_counter_field :: CField_decl.modelled_field name_info in let all_fields = General_utils.append_no_duplicates_fields modelled_fields fields in Printing.log_out "Class %s field:\n" class_name; IList.iter (fun (fn, _, _) -> @@ -132,7 +132,7 @@ let add_class_to_tenv type_ptr_to_sil_type tenv curr_class decl_info name_info d (match Tenv.lookup tenv interface_name with | Some st -> Printing.log_out " >>>OK. Found typ='%a'\n" - (Typ.pp_struct_typ pe_text (fun _ () -> ()) interface_name) st + (StructTyp.pp pe_text (fun _ () -> ()) interface_name) st | None -> Printing.log_out " >>>NOT Found!!\n"); Typ.Tstruct interface_name diff --git a/infer/src/eradicate/eradicateChecks.ml b/infer/src/eradicate/eradicateChecks.ml index 82b2b2c7e..f7b57b771 100644 --- a/infer/src/eradicate/eradicateChecks.ml +++ b/infer/src/eradicate/eradicateChecks.ml @@ -41,7 +41,7 @@ let check_library_calls = false let get_field_annotation tenv fn typ = let lookup = Tenv.lookup tenv in - match Typ.get_field_type_and_annotation ~lookup fn typ with + match StructTyp.get_field_type_and_annotation ~lookup fn typ with | None -> None | Some (t, ia) -> let ia' = diff --git a/infer/src/harness/androidFramework.mli b/infer/src/harness/androidFramework.mli index 691b245b6..ca9370c1c 100644 --- a/infer/src/harness/androidFramework.mli +++ b/infer/src/harness/androidFramework.mli @@ -14,16 +14,16 @@ 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] <: android.content.Context *) +(** return true if [typename] <: android.content.Context *) val is_context : Tenv.t -> Typename.t -> bool -(** return true if [struct_typ] <: android.app.Application *) +(** return true if [typename] <: android.app.Application *) val is_application : Tenv.t -> Typename.t -> bool -(** return true if [struct_typ] <: android.app.Activity *) +(** return true if [typename] <: android.app.Activity *) val is_activity : Tenv.t -> Typename.t -> bool -(** return true if [struct_typ] <: android.view.View *) +(** return true if [typename] <: android.view.View *) val is_view : Tenv.t -> Typename.t -> bool val is_fragment : Tenv.t -> Typename.t -> bool diff --git a/infer/src/java/jTrans.ml b/infer/src/java/jTrans.ml index a39562117..fd441c436 100644 --- a/infer/src/java/jTrans.ml +++ b/infer/src/java/jTrans.ml @@ -107,7 +107,7 @@ let retrieve_fieldname fieldname = let get_field_name program static tenv cn fs = - let { Typ.fields; statics; } = JTransType.get_class_struct_typ program tenv cn in + let { StructTyp.fields; statics; } = JTransType.get_class_struct_typ program tenv cn in match IList.find (fun (fieldname, _, _) -> retrieve_fieldname fieldname = JBasics.fs_name fs) diff --git a/infer/src/java/jTransType.ml b/infer/src/java/jTransType.ml index 9a0a668cd..49f4945e5 100644 --- a/infer/src/java/jTransType.ml +++ b/infer/src/java/jTransType.ml @@ -274,7 +274,7 @@ let add_model_fields program classpath_fields cn = let rec get_all_fields program tenv cn = let extract_class_fields classname = - let { Typ.fields; statics } = get_class_struct_typ program tenv classname in + let { StructTyp.fields; statics } = get_class_struct_typ program tenv classname in (statics, fields) in let trans_fields classname = match JClasspath.lookup_node classname program with diff --git a/infer/src/java/jTransType.mli b/infer/src/java/jTransType.mli index 00dcfa24e..76d94cbb0 100644 --- a/infer/src/java/jTransType.mli +++ b/infer/src/java/jTransType.mli @@ -29,7 +29,7 @@ val get_method_procname : JBasics.class_name -> JBasics.method_signature -> Procname.method_kind -> Procname.java (** [get_class_struct_typ program tenv cn] returns the struct_typ representation of the class *) -val get_class_struct_typ: JClasspath.program -> Tenv.t -> JBasics.class_name -> Typ.struct_typ +val get_class_struct_typ: JClasspath.program -> Tenv.t -> JBasics.class_name -> StructTyp.t (** [get_class_type_no_pointer program tenv cn] returns the sil type representation of the class without the pointer part *)