From bbec1661745984c2d364538338c8296d71f5db54 Mon Sep 17 00:00:00 2001 From: Josh Berdine Date: Tue, 14 Jun 2016 03:18:56 -0700 Subject: [PATCH] Refactor Sil.typ into separate Typ module Summary: Now that array types record only static - and therefore constant - lengths, Sil typ and exp no longer need to be mutually recursive. This diff: - splits the recursion in the type definitions of typ and exp, - splits the recursion in the comparison and pretty-printing functions, - and then refactors typ into a separate module. Reviewed By: cristianoc Differential Revision: D3423575 fbshipit-source-id: 6130630 --- infer/src/IR/AttributesTable.re | 2 +- infer/src/IR/AttributesTable.rei | 2 +- infer/src/IR/Cfg.re | 8 +- infer/src/IR/Cfg.rei | 14 +- infer/src/IR/ProcAttributes.re | 14 +- infer/src/IR/ProcAttributes.rei | 10 +- infer/src/IR/Sil.re | 840 +++--------------- infer/src/IR/Sil.rei | 346 +------- infer/src/IR/Tenv.re | 36 +- infer/src/IR/Tenv.rei | 18 +- infer/src/IR/Typ.re | 602 +++++++++++++ infer/src/IR/Typ.rei | 268 ++++++ infer/src/backend/abs.ml | 34 +- infer/src/backend/absarray.ml | 43 +- infer/src/backend/autounit.ml | 60 +- infer/src/backend/autounit.mli | 2 +- infer/src/backend/builtin.ml | 2 +- infer/src/backend/builtin.mli | 2 +- infer/src/backend/dom.ml | 25 +- infer/src/backend/dotty.ml | 10 +- infer/src/backend/dotty.mli | 6 +- infer/src/backend/errdesc.ml | 18 +- infer/src/backend/errdesc.mli | 12 +- infer/src/backend/interproc.ml | 2 +- infer/src/backend/localise.ml | 26 +- infer/src/backend/localise.mli | 10 +- infer/src/backend/match.ml | 6 +- infer/src/backend/mleak_buckets.mli | 2 +- infer/src/backend/modelBuiltins.ml | 48 +- infer/src/backend/objc_models.ml | 6 +- infer/src/backend/objc_models.mli | 4 +- infer/src/backend/preanal.ml | 2 +- infer/src/backend/printer.ml | 8 +- infer/src/backend/prop.ml | 64 +- infer/src/backend/prop.mli | 10 +- infer/src/backend/propgraph.ml | 2 +- infer/src/backend/prover.ml | 125 +-- infer/src/backend/prover.mli | 10 +- infer/src/backend/rearrange.ml | 113 +-- infer/src/backend/rearrange.mli | 2 +- infer/src/backend/serialization.ml | 2 +- infer/src/backend/specs.ml | 6 +- infer/src/backend/specs.mli | 8 +- infer/src/backend/symExec.ml | 86 +- infer/src/backend/symExec.mli | 2 +- infer/src/backend/tabulation.ml | 6 +- infer/src/backend/tabulation.mli | 2 +- infer/src/backend/taint.ml | 6 +- infer/src/backend/taint.mli | 2 +- infer/src/checkers/addressTaken.ml | 2 +- infer/src/checkers/annotationReachability.ml | 22 +- infer/src/checkers/annotations.ml | 56 +- infer/src/checkers/annotations.mli | 70 +- infer/src/checkers/checkers.ml | 16 +- infer/src/checkers/copyPropagation.ml | 2 +- .../checkers/fragmentRetainsViewChecker.ml | 6 +- infer/src/checkers/patternMatch.ml | 66 +- infer/src/checkers/patternMatch.mli | 30 +- infer/src/checkers/printfArgs.ml | 2 +- infer/src/clang/cArithmetic_trans.ml | 10 +- infer/src/clang/cArithmetic_trans.mli | 6 +- infer/src/clang/cContext.ml | 6 +- infer/src/clang/cContext.mli | 10 +- infer/src/clang/cEnum_decl.ml | 2 +- infer/src/clang/cEnum_decl.mli | 2 +- infer/src/clang/cField_decl.ml | 22 +- infer/src/clang/cField_decl.mli | 4 +- infer/src/clang/cFrontend_checkers.ml | 4 +- infer/src/clang/cFrontend_checkers.mli | 2 +- infer/src/clang/cFrontend_config.mli | 2 +- infer/src/clang/cFrontend_utils.ml | 28 +- infer/src/clang/cFrontend_utils.mli | 20 +- infer/src/clang/cMethod_signature.ml | 2 +- infer/src/clang/cMethod_signature.mli | 4 +- infer/src/clang/cMethod_trans.ml | 16 +- infer/src/clang/cMethod_trans.mli | 8 +- infer/src/clang/cModule_type.ml | 2 +- infer/src/clang/cTrans.ml | 78 +- infer/src/clang/cTrans_models.ml | 3 +- infer/src/clang/cTrans_models.mli | 2 +- infer/src/clang/cTrans_utils.ml | 44 +- infer/src/clang/cTrans_utils.mli | 38 +- infer/src/clang/cType_to_sil_type.ml | 124 +-- infer/src/clang/cType_to_sil_type.mli | 8 +- infer/src/clang/cTypes.ml | 32 +- infer/src/clang/cTypes.mli | 12 +- infer/src/clang/cTypes_decl.ml | 34 +- infer/src/clang/cTypes_decl.mli | 14 +- infer/src/clang/cVar_decl.mli | 6 +- infer/src/clang/objcCategory_decl.ml | 8 +- infer/src/clang/objcCategory_decl.mli | 4 +- infer/src/clang/objcInterface_decl.ml | 30 +- infer/src/clang/objcInterface_decl.mli | 6 +- infer/src/clang/objcProtocol_decl.ml | 6 +- infer/src/clang/objcProtocol_decl.mli | 2 +- infer/src/eradicate/eradicate.mli | 2 +- infer/src/eradicate/eradicateChecks.ml | 4 +- infer/src/eradicate/typeAnnotation.mli | 2 +- infer/src/eradicate/typeCheck.ml | 18 +- infer/src/eradicate/typeCheck.mli | 2 +- infer/src/eradicate/typeErr.ml | 2 +- infer/src/eradicate/typeErr.mli | 2 +- infer/src/eradicate/typeOrigin.ml | 2 +- infer/src/eradicate/typeState.ml | 8 +- infer/src/eradicate/typeState.mli | 4 +- infer/src/harness/androidFramework.ml | 4 +- infer/src/harness/androidFramework.mli | 12 +- infer/src/harness/harness.ml | 6 +- infer/src/harness/inhabit.ml | 24 +- infer/src/harness/inhabit.mli | 2 +- infer/src/harness/stacktrace.ml | 2 +- infer/src/java/jAnnotation.ml | 14 +- infer/src/java/jAnnotation.mli | 4 +- infer/src/java/jContext.ml | 2 +- infer/src/java/jContext.mli | 4 +- infer/src/java/jTrans.ml | 22 +- infer/src/java/jTransExn.ml | 6 +- infer/src/java/jTransStaticField.mli | 3 +- infer/src/java/jTransType.ml | 76 +- infer/src/java/jTransType.mli | 30 +- infer/src/llvm/lTrans.ml | 16 +- infer/src/unit/addressTakenTests.ml | 6 +- infer/src/unit/analyzerTester.ml | 4 +- infer/src/unit/livenessTests.ml | 2 +- 124 files changed, 2073 insertions(+), 2019 deletions(-) create mode 100644 infer/src/IR/Typ.re create mode 100644 infer/src/IR/Typ.rei diff --git a/infer/src/IR/AttributesTable.re b/infer/src/IR/AttributesTable.re index a13c6f73f..0871c82c3 100644 --- a/infer/src/IR/AttributesTable.re +++ b/infer/src/IR/AttributesTable.re @@ -92,7 +92,7 @@ let get_correct_type_from_objc_class_name c => { | None => None | Some tenv => let type_name = Typename.TN_csu (Csu.Class Csu.Objc) c; - Option.map (fun st => Sil.Tstruct st) (Tenv.lookup tenv type_name) + Option.map (fun st => Typ.Tstruct st) (Tenv.lookup tenv type_name) } }; diff --git a/infer/src/IR/AttributesTable.rei b/infer/src/IR/AttributesTable.rei index 88ffa8921..4da254e76 100644 --- a/infer/src/IR/AttributesTable.rei +++ b/infer/src/IR/AttributesTable.rei @@ -30,7 +30,7 @@ let find_tenv_from_class_of_proc: Procname.t => option Tenv.t; /** Given an ObjC class c, extract the type from the tenv where the class was */ /** defined. We do this by adding a method that is unique to each class, and then */ /** finding the tenv that corresponds to the class definition. */ -let get_correct_type_from_objc_class_name: Mangled.t => option Sil.typ; +let get_correct_type_from_objc_class_name: Mangled.t => option Typ.t; /** Returns true if the method is defined as a C++ model */ diff --git a/infer/src/IR/Cfg.re b/infer/src/IR/Cfg.re index d906cdf48..1d1effacf 100644 --- a/infer/src/IR/Cfg.re +++ b/infer/src/IR/Cfg.re @@ -92,7 +92,7 @@ let module Node = { let id_map = ref IntMap.empty; /* formals are the same if their types are the same */ let formals_eq formals1 formals2 => - IList.equal (fun (_, typ1) (_, typ2) => Sil.typ_compare typ1 typ2) formals1 formals2; + IList.equal (fun (_, typ1) (_, typ2) => Typ.compare typ1 typ2) formals1 formals2; let nodes_eq n1s n2s => /* nodes are the same if they have the same id, instructions, and succs/preds up to renaming with [exp_map] and [id_map] */ @@ -133,7 +133,7 @@ let module Node = { let att1 = pd1.pd_attributes and att2 = pd2.pd_attributes; att1.ProcAttributes.is_defined == att2.ProcAttributes.is_defined && - Sil.typ_equal att1.ProcAttributes.ret_type att2.ProcAttributes.ret_type && + Typ.equal att1.ProcAttributes.ret_type att2.ProcAttributes.ret_type && formals_eq att1.ProcAttributes.formals att2.ProcAttributes.formals && nodes_eq pd1.pd_nodes pd2.pd_nodes }; @@ -660,7 +660,7 @@ let module Node = { | exp => exp; let extract_class_name = fun - | Sil.Tptr (Sil.Tstruct {Sil.struct_name: struct_name}) _ when struct_name != None => + | Typ.Tptr (Typ.Tstruct {Typ.struct_name: struct_name}) _ when struct_name != None => Mangled.to_string (Option.get struct_name) | _ => failwith "Expecting classname for Java types"; let subst_map = ref Ident.IdentMap.empty; @@ -683,7 +683,7 @@ let module Node = { | Sil.Letderef id (Sil.Var origin_id as origin_exp) origin_typ loc => { let updated_typ = switch (Ident.IdentMap.find origin_id !subst_map) { - | Sil.Tptr typ _ => typ + | Typ.Tptr typ _ => typ | _ => failwith "Expecting a pointer type" | exception Not_found => origin_typ }; diff --git a/infer/src/IR/Cfg.rei b/infer/src/IR/Cfg.rei index e37622c8d..88e7d2670 100644 --- a/infer/src/IR/Cfg.rei +++ b/infer/src/IR/Cfg.rei @@ -57,16 +57,16 @@ let module Procdesc: { let get_flags: t => proc_flags; /** Return name and type of formal parameters */ - let get_formals: t => list (Mangled.t, Sil.typ); + let get_formals: t => list (Mangled.t, Typ.t); /** Return loc information for the procedure */ let get_loc: t => Location.t; /** Return name and type of local variables */ - let get_locals: t => list (Mangled.t, Sil.typ); + let get_locals: t => list (Mangled.t, Typ.t); /** Return name and type of block's captured variables */ - let get_captured: t => list (Mangled.t, Sil.typ); + let get_captured: t => list (Mangled.t, Typ.t); /** Return the visibility attribute */ let get_access: t => Sil.access; @@ -80,7 +80,7 @@ let module Procdesc: { let get_proc_name: t => Procname.t; /** Return the return type of the procedure and type string */ - let get_ret_type: t => Sil.typ; + let get_ret_type: t => Typ.t; let get_ret_var: t => Pvar.t; let get_start_node: t => node; @@ -120,7 +120,7 @@ let module Procdesc: { let set_start_node: t => node => unit; /** append a list of new local variables to the existing list of local variables */ - let append_locals: t => list (Mangled.t, Sil.typ) => unit; + let append_locals: t => list (Mangled.t, Typ.t) => unit; }; @@ -154,7 +154,7 @@ let module Node: { let prepend_instrs: t => list Sil.instr => unit; /** Add declarations for local variables and return variable to the node */ - let add_locals_ret_declaration: t => list (Mangled.t, Sil.typ) => unit; + let add_locals_ret_declaration: t => list (Mangled.t, Typ.t) => unit; /** Compare two nodes */ let compare: t => t => int; @@ -331,4 +331,4 @@ let remove_seed_captured_vars_block: list Mangled.t => Prop.t Prop.normal => Pro (name, typ) where name is a parameter. The resulting procdesc is isomorphic but all the type of the parameters are replaced in the instructions according to the list. The virtual calls are also replaced to match the parameter types */ -let specialize_types: Procdesc.t => Procname.t => list (Sil.exp, Sil.typ) => Procdesc.t; +let specialize_types: Procdesc.t => Procname.t => list (Sil.exp, Typ.t) => Procdesc.t; diff --git a/infer/src/IR/ProcAttributes.re b/infer/src/IR/ProcAttributes.re index e1e0da5d6..2bf1f6806 100644 --- a/infer/src/IR/ProcAttributes.re +++ b/infer/src/IR/ProcAttributes.re @@ -24,11 +24,11 @@ type objc_accessor_type = | Objc_getter of Ident.fieldname | Objc_setter of Iden type t = { access: Sil.access, /** visibility access */ - captured: list (Mangled.t, Sil.typ), /** name and type of variables captured in blocks */ + captured: list (Mangled.t, Typ.t), /** name and type of variables captured in blocks */ mutable changed: bool, /** true if proc has changed since last analysis */ err_log: Errlog.t, /** Error log for the procedure */ exceptions: list string, /** exceptions thrown by the procedure */ - formals: list (Mangled.t, Sil.typ), /** name and type of formal parameters */ + formals: list (Mangled.t, Typ.t), /** name and type of formal parameters */ func_attributes: list Sil.func_attribute, is_abstract: bool, /** the procedure is abstract */ mutable is_bridge_method: bool, /** the procedure is a bridge method */ @@ -39,12 +39,12 @@ type t = { mutable is_synthetic_method: bool, /** the procedure is a synthetic method */ language: Config.language, /** language of the procedure */ loc: Location.t, /** location of this procedure in the source code */ - mutable locals: list (Mangled.t, Sil.typ), /** name and type of local variables */ - method_annotation: Sil.method_annotation, /** annotations for java methods */ + mutable locals: list (Mangled.t, Typ.t), /** name and type of local variables */ + method_annotation: Typ.method_annotation, /** annotations for java methods */ objc_accessor: option objc_accessor_type, /** type of ObjC accessor, if any */ proc_flags: proc_flags, /** flags of the procedure */ proc_name: Procname.t, /** name of the procedure */ - ret_type: Sil.typ /** return type */ + ret_type: Typ.t /** return type */ }; let default proc_name language => { @@ -65,9 +65,9 @@ let default proc_name language => { language, loc: Location.dummy, locals: [], - method_annotation: Sil.method_annotation_empty, + method_annotation: Typ.method_annotation_empty, objc_accessor: None, proc_flags: proc_flags_empty (), proc_name, - ret_type: Sil.Tvoid + ret_type: Typ.Tvoid }; diff --git a/infer/src/IR/ProcAttributes.rei b/infer/src/IR/ProcAttributes.rei index a58d74ee0..f219a7ac2 100644 --- a/infer/src/IR/ProcAttributes.rei +++ b/infer/src/IR/ProcAttributes.rei @@ -18,11 +18,11 @@ type objc_accessor_type = | Objc_getter of Ident.fieldname | Objc_setter of Iden type t = { access: Sil.access, /** visibility access */ - captured: list (Mangled.t, Sil.typ), /** name and type of variables captured in blocks */ + captured: list (Mangled.t, Typ.t), /** name and type of variables captured in blocks */ mutable changed: bool, /** true if proc has changed since last analysis */ err_log: Errlog.t, /** Error log for the procedure */ exceptions: list string, /** exceptions thrown by the procedure */ - formals: list (Mangled.t, Sil.typ), /** name and type of formal parameters */ + formals: list (Mangled.t, Typ.t), /** name and type of formal parameters */ func_attributes: list Sil.func_attribute, is_abstract: bool, /** the procedure is abstract */ mutable is_bridge_method: bool, /** the procedure is a bridge method */ @@ -33,12 +33,12 @@ type t = { mutable is_synthetic_method: bool, /** the procedure is a synthetic method */ language: Config.language, /** language of the procedure */ loc: Location.t, /** location of this procedure in the source code */ - mutable locals: list (Mangled.t, Sil.typ), /** name and type of local variables */ - method_annotation: Sil.method_annotation, /** annotations for java methods */ + mutable locals: list (Mangled.t, Typ.t), /** name and type of local variables */ + method_annotation: Typ.method_annotation, /** annotations for java methods */ objc_accessor: option objc_accessor_type, /** type of ObjC accessor, if any */ proc_flags: proc_flags, /** flags of the procedure */ proc_name: Procname.t, /** name of the procedure */ - ret_type: Sil.typ /** return type */ + ret_type: Typ.t /** return type */ }; diff --git a/infer/src/IR/Sil.re b/infer/src/IR/Sil.re index 77c10ac7e..195df5a18 100644 --- a/infer/src/IR/Sil.re +++ b/infer/src/IR/Sil.re @@ -21,21 +21,6 @@ let module F = Format; /** {2 Programs and Types} */ -/** Type to represent one @Annotation. */ -type annotation = { - class_name: string, /* name of the annotation */ - parameters: list string - /* currently only one string parameter */ -}; - - -/** Annotation for one item: a list of annotations with visibility. */ -type item_annotation = list (annotation, bool); - - -/** Annotation for a method: return value and list of parameters. */ -type method_annotation = (item_annotation, list item_annotation); - type func_attribute = | FA_sentinel of int int /** __attribute__((sentinel(int, int))) */; @@ -44,79 +29,6 @@ type func_attribute = type access = | Default | Public | Private | Protected; -/** Compare function for annotations. */ -let annotation_compare a1 a2 => { - let n = string_compare a1.class_name a2.class_name; - if (n != 0) { - n - } else { - IList.compare string_compare a1.parameters a2.parameters - } -}; - - -/** Compare function for annotation items. */ -let item_annotation_compare ia1 ia2 => { - let cmp (a1, b1) (a2, b2) => { - let n = annotation_compare a1 a2; - if (n != 0) { - n - } else { - bool_compare b1 b2 - } - }; - IList.compare cmp ia1 ia2 -}; - - -/** Compare function for Method annotations. */ -let method_annotation_compare (ia1, ial1) (ia2, ial2) => - IList.compare item_annotation_compare [ia1, ...ial1] [ia2, ...ial2]; - - -/** Empty item annotation. */ -let item_annotation_empty = []; - - -/** Empty method annotation. */ -let method_annotation_empty = ([], []); - - -/** Check if the item annodation is empty. */ -let item_annotation_is_empty ia => ia == []; - - -/** Check if the method annodation is empty. */ -let method_annotation_is_empty (ia, ial) => IList.for_all item_annotation_is_empty [ia, ...ial]; - - -/** Pretty print an annotation. */ -let pp_annotation fmt annotation => F.fprintf fmt "@@%s" annotation.class_name; - - -/** Pretty print an item annotation. */ -let pp_item_annotation fmt item_annotation => { - let pp fmt (a, _) => pp_annotation fmt a; - F.fprintf fmt "<%a>" (pp_seq pp) item_annotation -}; - -let item_annotation_to_string ann => { - let pp fmt () => pp_item_annotation fmt ann; - pp_to_string pp () -}; - - -/** Pretty print a method annotation. */ -let pp_method_annotation s fmt (ia, ial) => - F.fprintf fmt "%a %s(%a)" pp_item_annotation ia s (pp_seq pp_item_annotation) ial; - -let module AnnotMap = PrettyPrintable.MakePPMap { - type t = annotation; - let compare = annotation_compare; - let pp_key = pp_annotation; -}; - - /** Return the value of the FA_sentinel attribute in [attr_list] if it is found */ let get_sentinel_func_attribute_value attr_list => switch attr_list { @@ -158,31 +70,6 @@ type binop = | PtrFld /** field offset via pointer to field: takes the address of a Csu.t and a Cptr_to_fld constant to form an Lfield expression (see prop.ml) */; - -/** Kinds of integers */ -type ikind = - | IChar /** [char] */ - | ISChar /** [signed char] */ - | IUChar /** [unsigned char] */ - | IBool /** [bool] */ - | IInt /** [int] */ - | IUInt /** [unsigned int] */ - | IShort /** [short] */ - | IUShort /** [unsigned short] */ - | ILong /** [long] */ - | IULong /** [unsigned long] */ - | ILongLong /** [long long] (or [_int64] on Microsoft Visual C) */ - | IULongLong /** [unsigned long long] (or [unsigned _int64] on Microsoft Visual C) */ - | I128 /** [__int128_t] */ - | IU128 /** [__uint128_t] */; - - -/** Kinds of floating-point numbers*/ -type fkind = - | FFloat /** [float] */ - | FDouble /** [double] */ - | FLongDouble /** [long double] */; - type mem_kind = | Mmalloc /** memory allocated with malloc */ | Mnew /** memory allocated with new */ @@ -209,15 +96,6 @@ type dangling_kind = | DAminusone; -/** kind of pointer */ -type ptr_kind = - | Pk_pointer /* C/C++, Java, Objc standard/__strong pointer*/ - | Pk_reference /* C++ reference */ - | Pk_objc_weak /* Obj-C __weak pointer*/ - | Pk_objc_unsafe_unretained /* Obj-C __unsafe_unretained pointer */ - | Pk_objc_autoreleasing /* Obj-C __autoreleasing pointer */; - - /** position in a path: proc name, node id */ type path_pos = (Procname.t, int); @@ -527,13 +405,22 @@ let cf_default = { cf_targets: [] }; +type taint_kind = + | Tk_unverified_SSL_socket + | Tk_shared_preferences_data + | Tk_privacy_annotation + | Tk_integrity_annotation + | Tk_unknown; + +type taint_info = {taint_source: Procname.t, taint_kind: taint_kind}; + /** expression representing the result of decompilation */ type dexp = | Darray of dexp dexp | Dbinop of binop dexp dexp | Dconst of const - | Dsizeof of typ (option exp) Subtype.t + | Dsizeof of Typ.t (option exp) Subtype.t | Dderef of dexp | Dfcall of dexp (list dexp) Location.t call_flags | Darrow of dexp Ident.fieldname @@ -554,20 +441,13 @@ and res_action = { ra_loc: Location.t, /** location of the acquire/release */ ra_vpath: vpath /** vpath of the resource value */ } -and taint_kind = - | Tk_unverified_SSL_socket - | Tk_shared_preferences_data - | Tk_privacy_annotation - | Tk_integrity_annotation - | Tk_unknown -and taint_info = {taint_source: Procname.t, taint_kind: taint_kind} /** Attributes */ and attribute = | Aresource of res_action /** resource acquire/release */ | Aautorelease | Adangling of dangling_kind /** dangling pointer */ /** undefined value obtained by calling the given procedure, plus its return value annots */ - | Aundef of Procname.t item_annotation Location.t path_pos + | Aundef of Procname.t Typ.item_annotation Location.t path_pos | Ataint of taint_info | Auntaint of taint_info | Alocked @@ -577,23 +457,12 @@ and attribute = /** the exp. is null because of a call to a method with exp as a null receiver */ | Aobjc_null of exp /** value was returned from a call to the given procedure, plus the annots of the return value */ - | Aretval of Procname.t item_annotation + | Aretval of Procname.t Typ.item_annotation /** denotes an object registered as an observers to a notification center */ | Aobserver /** denotes an object unsubscribed from observers of a notification center */ | Aunsubscribed_observer -/** Categories of attributes */ -and attribute_category = - | ACresource - | ACautorelease - | ACtaint - | AClock - | ACdiv0 - | ACobjc_null - | ACundef - | ACretval - | ACobserver -and closure = {name: Procname.t, captured_vars: list (exp, Pvar.t, typ)} +and closure = {name: Procname.t, captured_vars: list (exp, Pvar.t, Typ.t)} /** Constants */ and const = | Cint of IntLit.t /** integer constants */ @@ -603,50 +472,27 @@ and const = | Cattribute of attribute /** attribute used in disequalities to annotate a value */ | Cexn of exp /** exception */ | Cclass of Ident.name /** class constant */ - | Cptr_to_fld of Ident.fieldname typ /** pointer to field constant, - and type of the surrounding Csu.t type */ + | Cptr_to_fld of Ident.fieldname Typ.t /** pointer to field constant, + and type of the surrounding Csu.t type */ | Cclosure of closure /** anonymous function */ -and struct_fields = list (Ident.fieldname, typ, item_annotation) -/** Type for a structured value. */ -and struct_typ = { - instance_fields: struct_fields, /** non-static fields */ - static_fields: struct_fields, /** static fields */ - csu: Csu.t, /** class/struct/union */ - struct_name: option Mangled.t, /** name */ - superclasses: list Typename.t, /** list of superclasses */ - def_methods: list Procname.t, /** methods defined */ - struct_annotations: item_annotation /** annotations */ -} -/** statically determined length of an array type, if any */ -and static_length = option IntLit.t /** dynamically determined length of an array value, if any */ and dynamic_length = option exp -/** types for sil (structured) expressions */ -and typ = - | Tvar of Typename.t /** named type */ - | Tint of ikind /** integer type */ - | Tfloat of fkind /** float type */ - | Tvoid /** void type */ - | Tfun of bool /** function type with noreturn attribute */ - | Tptr of typ ptr_kind /** pointer type */ - | Tstruct of struct_typ /** Type for a structured value */ - | Tarray of typ static_length /** array type with statically fixed length */ /** Program expressions. */ and exp = /** Pure variable: it is not an lvalue */ | Var of Ident.t /** Unary operator with type of the result if known */ - | UnOp of unop exp (option typ) + | UnOp of unop exp (option Typ.t) /** Binary operator */ | BinOp of binop exp exp /** Constants */ | Const of const /** Type cast */ - | Cast of typ exp + | Cast of Typ.t exp /** The address of a program variable */ | Lvar of Pvar.t /** A field offset, the type is the surrounding struct type */ - | Lfield of exp Ident.fieldname typ + | Lfield of exp Ident.fieldname Typ.t /** An array index offset: [exp1\[exp2\]] */ | Lindex of exp exp /** A sizeof expression. [Sizeof (Tarray elt (Some static_length)) (Some dynamic_length)] @@ -654,19 +500,7 @@ and exp = The [dynamic_length], tracked by symbolic execution, may differ from the [static_length] obtained from the type definition, e.g. when an array is over-allocated. For struct types, the [dynamic_length] is that of the final extensible array, if any. */ - | Sizeof of typ dynamic_length Subtype.t; - - -/** the element typ of the final extensible array in the given typ, if any */ -let rec get_extensible_array_element_typ = - fun - | Tarray typ _ => Some typ - | Tstruct {instance_fields} => - Option.map_default - (fun (_, fld_typ, _) => get_extensible_array_element_typ fld_typ) - None - (IList.last instance_fields) - | _ => None; + | Sizeof of Typ.t dynamic_length Subtype.t; /** Kind of prune instruction */ @@ -690,21 +524,21 @@ type stackop = /** An instruction. */ type instr = /** declaration [let x = *lexp:typ] where [typ] is the root type of [lexp] */ - | Letderef of Ident.t exp typ Location.t + | Letderef of Ident.t exp Typ.t Location.t /** assignment [*lexp1:typ = exp2] where [typ] is the root type of [lexp1] */ - | Set of exp typ exp Location.t + | Set of exp Typ.t exp Location.t /** prune the state based on [exp=1], the boolean indicates whether true branch */ | Prune of exp Location.t bool if_kind /** [Call (ret_id1..ret_idn, e_fun, arg_ts, loc, call_flags)] represents an instructions [ret_id1..ret_idn = e_fun(arg_ts);] where n = 0 for void return and n > 1 for struct return */ - | Call of (list Ident.t) exp (list (exp, typ)) Location.t call_flags + | Call of (list Ident.t) exp (list (exp, Typ.t)) Location.t call_flags /** nullify stack variable */ | Nullify of Pvar.t Location.t | Abstract of Location.t /** apply abstraction */ | Remove_temps of (list Ident.t) Location.t /** remove temporaries */ | Stackop of stackop Location.t /** operation on the stack of propsets */ - | Declare_locals of (list (Pvar.t, typ)) Location.t /** declare local variables */; + | Declare_locals of (list (Pvar.t, Typ.t)) Location.t /** declare local variables */; /** Check if an instruction is auxiliary, or if it comes from source instructions. */ @@ -722,7 +556,7 @@ let instr_is_auxiliary = /** offset for an lvalue */ -type offset = | Off_fld of Ident.fieldname typ | Off_index of exp; +type offset = | Off_fld of Ident.fieldname Typ.t | Off_index of exp; /** {2 Components of Propositions} */ @@ -820,70 +654,20 @@ let hpred_get_lhs h => | Hdllseg _ _ e _ _ _ _ => e }; -let objc_ref_counter_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); - /** {2 Comparision and Inspection Functions} */ -let is_objc_ref_counter_field (fld, _, a) => - Ident.fieldname_is_hidden fld && item_annotation_compare a objc_ref_counter_annot == 0; - let has_objc_ref_counter hpred => switch hpred { | Hpointsto _ _ (Sizeof (Tstruct struct_typ) _ _) => - IList.exists is_objc_ref_counter_field struct_typ.instance_fields + IList.exists Typ.is_objc_ref_counter_field struct_typ.instance_fields | _ => false }; -let objc_class_str = "ObjC-Class"; - -let cpp_class_str = "Cpp-Class"; - -let class_annotation class_string => [({class_name: class_string, parameters: []}, true)]; - -let objc_class_annotation = class_annotation objc_class_str; - -let cpp_class_annotation = class_annotation cpp_class_str; - -let is_class_of_kind typ ck => - switch typ { - | Tstruct {csu: Csu.Class ck'} => ck == ck' - | _ => false - }; - -let is_objc_class typ => is_class_of_kind typ Csu.Objc; - -let is_cpp_class typ => is_class_of_kind typ Csu.CPP; - -let is_java_class typ => is_class_of_kind typ Csu.Java; - -let rec is_array_of_cpp_class typ => - switch typ { - | Tarray typ _ => is_array_of_cpp_class typ - | _ => is_cpp_class typ - }; - -let is_pointer_to_cpp_class typ => - switch typ { - | Tptr t _ => is_cpp_class t - | _ => false - }; - - -/** turn a *T into a T. fails if [typ] is not a pointer type */ -let typ_strip_ptr = - fun - | Tptr t _ => t - | _ => assert false; - let zero_value_of_numerical_type typ => switch typ { - | Tint _ => Const (Cint IntLit.zero) - | Tfloat _ => Const (Cfloat 0.0) - | Tptr _ => Const (Cint IntLit.null) + | Typ.Tint _ => Const (Cint IntLit.zero) + | Typ.Tfloat _ => Const (Cfloat 0.0) + | Typ.Tptr _ => Const (Cint IntLit.null) | _ => assert false }; @@ -903,10 +687,6 @@ let is_static_local_name pname pvar => } }; -let fld_compare (fld1: Ident.fieldname) fld2 => Ident.fieldname_compare fld1 fld2; - -let fld_equal fld1 fld2 => fld_compare fld1 fld2 == 0; - let exp_is_zero = fun | Const (Cint n) => IntLit.iszero n @@ -922,24 +702,6 @@ let exp_is_this = | Lvar pvar => Pvar.is_this pvar | _ => false; -let ikind_is_char = - fun - | IChar - | ISChar - | IUChar => true - | _ => false; - -let ikind_is_unsigned = - fun - | IUChar - | IUInt - | IUShort - | IULong - | IULongLong => true - | _ => false; - -let int_of_int64_kind i ik => IntLit.of_int64_unsigned i (ikind_is_unsigned ik); - let unop_compare o1 o2 => switch (o1, o2) { | (Neg, Neg) => 0 @@ -1162,6 +924,19 @@ let taint_kind_compare tk1 tk2 => let taint_info_compare {taint_source: ts1, taint_kind: tk1} {taint_source: ts2, taint_kind: tk2} => taint_kind_compare tk1 tk2 |> next Procname.compare ts1 ts2; + +/** Categories of attributes */ +type attribute_category = + | ACresource + | ACautorelease + | ACtaint + | AClock + | ACdiv0 + | ACobjc_null + | ACundef + | ACretval + | ACobserver; + let attribute_category_compare (ac1: attribute_category) (ac2: attribute_category) :int => Pervasives.compare ac1 ac2; @@ -1189,90 +964,6 @@ let attr_is_undef = | Aundef _ => true | _ => false; -let cname_opt_compare nameo1 nameo2 => - switch (nameo1, nameo2) { - | (None, None) => 0 - | (None, _) => (-1) - | (_, None) => 1 - | (Some n1, Some n2) => Mangled.compare n1 n2 - }; - - -/** comparison for ikind */ -let ikind_compare k1 k2 => - switch (k1, k2) { - | (IChar, IChar) => 0 - | (IChar, _) => (-1) - | (_, IChar) => 1 - | (ISChar, ISChar) => 0 - | (ISChar, _) => (-1) - | (_, ISChar) => 1 - | (IUChar, IUChar) => 0 - | (IUChar, _) => (-1) - | (_, IUChar) => 1 - | (IBool, IBool) => 0 - | (IBool, _) => (-1) - | (_, IBool) => 1 - | (IInt, IInt) => 0 - | (IInt, _) => (-1) - | (_, IInt) => 1 - | (IUInt, IUInt) => 0 - | (IUInt, _) => (-1) - | (_, IUInt) => 1 - | (IShort, IShort) => 0 - | (IShort, _) => (-1) - | (_, IShort) => 1 - | (IUShort, IUShort) => 0 - | (IUShort, _) => (-1) - | (_, IUShort) => 1 - | (ILong, ILong) => 0 - | (ILong, _) => (-1) - | (_, ILong) => 1 - | (IULong, IULong) => 0 - | (IULong, _) => (-1) - | (_, IULong) => 1 - | (ILongLong, ILongLong) => 0 - | (ILongLong, _) => (-1) - | (_, ILongLong) => 1 - | (IULongLong, IULongLong) => 0 - | (IULongLong, _) => (-1) - | (_, IULongLong) => 1 - | (I128, I128) => 0 - | (I128, _) => (-1) - | (_, I128) => 1 - | (IU128, IU128) => 0 - }; - - -/** comparison for fkind */ -let fkind_compare k1 k2 => - switch (k1, k2) { - | (FFloat, FFloat) => 0 - | (FFloat, _) => (-1) - | (_, FFloat) => 1 - | (FDouble, FDouble) => 0 - | (FDouble, _) => (-1) - | (_, FDouble) => 1 - | (FLongDouble, FLongDouble) => 0 - }; - -let ptr_kind_compare pk1 pk2 => - switch (pk1, pk2) { - | (Pk_pointer, Pk_pointer) => 0 - | (Pk_pointer, _) => (-1) - | (_, Pk_pointer) => 1 - | (Pk_reference, Pk_reference) => 0 - | (_, Pk_reference) => (-1) - | (Pk_reference, _) => 1 - | (Pk_objc_weak, Pk_objc_weak) => 0 - | (Pk_objc_weak, _) => (-1) - | (_, Pk_objc_weak) => 1 - | (Pk_objc_unsafe_unretained, Pk_objc_unsafe_unretained) => 0 - | (Pk_objc_unsafe_unretained, _) => (-1) - | (_, Pk_objc_unsafe_unretained) => 1 - | (Pk_objc_autoreleasing, Pk_objc_autoreleasing) => 0 - }; - let const_kind_equal c1 c2 => { let const_kind_number = fun @@ -1288,131 +979,7 @@ let const_kind_equal c1 c2 => { const_kind_number c1 == const_kind_number c2 }; -let rec const_compare (c1: const) (c2: const) :int => - switch (c1, c2) { - | (Cint i1, Cint i2) => IntLit.compare i1 i2 - | (Cint _, _) => (-1) - | (_, Cint _) => 1 - | (Cfun fn1, Cfun fn2) => Procname.compare fn1 fn2 - | (Cfun _, _) => (-1) - | (_, Cfun _) => 1 - | (Cstr s1, Cstr s2) => string_compare s1 s2 - | (Cstr _, _) => (-1) - | (_, Cstr _) => 1 - | (Cfloat f1, Cfloat f2) => float_compare f1 f2 - | (Cfloat _, _) => (-1) - | (_, Cfloat _) => 1 - | (Cattribute att1, Cattribute att2) => attribute_compare att1 att2 - | (Cattribute _, _) => (-1) - | (_, Cattribute _) => 1 - | (Cexn e1, Cexn e2) => exp_compare e1 e2 - | (Cexn _, _) => (-1) - | (_, Cexn _) => 1 - | (Cclass c1, Cclass c2) => Ident.name_compare c1 c2 - | (Cclass _, _) => (-1) - | (_, Cclass _) => 1 - | (Cptr_to_fld fn1 t1, Cptr_to_fld fn2 t2) => - let n = fld_compare fn1 fn2; - if (n != 0) { - n - } else { - typ_compare t1 t2 - } - | (Cptr_to_fld _, _) => (-1) - | (_, Cptr_to_fld _) => 1 - | (Cclosure {name: n1, captured_vars: c1}, Cclosure {name: n2, captured_vars: c2}) => - let captured_var_compare acc (e1, pvar1, typ1) (e2, pvar2, typ2) => - if (acc != 0) { - acc - } else { - let n = exp_compare e1 e2; - if (n != 0) { - n - } else { - let n = Pvar.compare pvar1 pvar2; - if (n != 0) { - n - } else { - typ_compare typ1 typ2 - } - } - }; - let n = Procname.compare n1 n2; - if (n != 0) { - n - } else { - IList.fold_left2 captured_var_compare 0 c1 c2 - } - } -and struct_typ_compare struct_typ1 struct_typ2 => - if (struct_typ1.csu == Csu.Class Csu.Java && struct_typ2.csu == Csu.Class Csu.Java) { - cname_opt_compare struct_typ1.struct_name struct_typ2.struct_name - } else { - let n = fld_typ_ann_list_compare struct_typ1.instance_fields struct_typ2.instance_fields; - if (n != 0) { - n - } else { - let n = fld_typ_ann_list_compare struct_typ1.static_fields struct_typ2.static_fields; - if (n != 0) { - n - } else { - let n = Csu.compare struct_typ1.csu struct_typ2.csu; - if (n != 0) { - n - } else { - cname_opt_compare struct_typ1.struct_name struct_typ2.struct_name - } - } - } - } -and struct_typ_equal struct_typ1 struct_typ2 => struct_typ_compare struct_typ1 struct_typ2 == 0 -/** Comparision for types. */ -and typ_compare t1 t2 => - if (t1 === t2) { - 0 - } else { - switch (t1, t2) { - | (Tvar tn1, Tvar tn2) => Typename.compare tn1 tn2 - | (Tvar _, _) => (-1) - | (_, Tvar _) => 1 - | (Tint ik1, Tint ik2) => ikind_compare ik1 ik2 - | (Tint _, _) => (-1) - | (_, Tint _) => 1 - | (Tfloat fk1, Tfloat fk2) => fkind_compare fk1 fk2 - | (Tfloat _, _) => (-1) - | (_, Tfloat _) => 1 - | (Tvoid, Tvoid) => 0 - | (Tvoid, _) => (-1) - | (_, Tvoid) => 1 - | (Tfun noreturn1, Tfun noreturn2) => bool_compare noreturn1 noreturn2 - | (Tfun _, _) => (-1) - | (_, Tfun _) => 1 - | (Tptr t1' pk1, Tptr t2' pk2) => - let n = typ_compare t1' t2'; - if (n != 0) { - n - } else { - ptr_kind_compare pk1 pk2 - } - | (Tptr _, _) => (-1) - | (_, Tptr _) => 1 - | (Tstruct struct_typ1, Tstruct struct_typ2) => struct_typ_compare struct_typ1 struct_typ2 - | (Tstruct _, _) => (-1) - | (_, Tstruct _) => 1 - | (Tarray t1 _, Tarray t2 _) => typ_compare t1 t2 - } - } -and typ_opt_compare to1 to2 => - switch (to1, to2) { - | (None, None) => 0 - | (None, Some _) => (-1) - | (Some _, None) => 1 - | (Some t1, Some t2) => typ_compare t1 t2 - } -and fld_typ_ann_compare fta1 fta2 => - triple_compare fld_compare typ_compare item_annotation_compare fta1 fta2 -and fld_typ_ann_list_compare ftal1 ftal2 => IList.compare fld_typ_ann_compare ftal1 ftal2 -and attribute_compare (att1: attribute) (att2: attribute) :int => +let rec attribute_compare (att1: attribute) (att2: attribute) :int => switch (att1, att2) { | (Aresource ra1, Aresource ra2) => let n = res_act_kind_compare ra1.ra_kind ra2.ra_kind; @@ -1455,7 +1022,7 @@ and attribute_compare (att1: attribute) (att2: attribute) :int => if (n != 0) { n } else { - item_annotation_compare annots1 annots2 + Typ.item_annotation_compare annots1 annots2 } | (Aretval _, _) => (-1) | (_, Aretval _) => 1 @@ -1466,6 +1033,62 @@ and attribute_compare (att1: attribute) (att2: attribute) :int => | (Aunsubscribed_observer, _) => (-1) | (_, Aunsubscribed_observer) => 1 } +and const_compare (c1: const) (c2: const) :int => + switch (c1, c2) { + | (Cint i1, Cint i2) => IntLit.compare i1 i2 + | (Cint _, _) => (-1) + | (_, Cint _) => 1 + | (Cfun fn1, Cfun fn2) => Procname.compare fn1 fn2 + | (Cfun _, _) => (-1) + | (_, Cfun _) => 1 + | (Cstr s1, Cstr s2) => string_compare s1 s2 + | (Cstr _, _) => (-1) + | (_, Cstr _) => 1 + | (Cfloat f1, Cfloat f2) => float_compare f1 f2 + | (Cfloat _, _) => (-1) + | (_, Cfloat _) => 1 + | (Cattribute att1, Cattribute att2) => attribute_compare att1 att2 + | (Cattribute _, _) => (-1) + | (_, Cattribute _) => 1 + | (Cexn e1, Cexn e2) => exp_compare e1 e2 + | (Cexn _, _) => (-1) + | (_, Cexn _) => 1 + | (Cclass c1, Cclass c2) => Ident.name_compare c1 c2 + | (Cclass _, _) => (-1) + | (_, Cclass _) => 1 + | (Cptr_to_fld fn1 t1, Cptr_to_fld fn2 t2) => + let n = Ident.fieldname_compare fn1 fn2; + if (n != 0) { + n + } else { + Typ.compare t1 t2 + } + | (Cptr_to_fld _, _) => (-1) + | (_, Cptr_to_fld _) => 1 + | (Cclosure {name: n1, captured_vars: c1}, Cclosure {name: n2, captured_vars: c2}) => + let captured_var_compare acc (e1, pvar1, typ1) (e2, pvar2, typ2) => + if (acc != 0) { + acc + } else { + let n = exp_compare e1 e2; + if (n != 0) { + n + } else { + let n = Pvar.compare pvar1 pvar2; + if (n != 0) { + n + } else { + Typ.compare typ1 typ2 + } + } + }; + let n = Procname.compare n1 n2; + if (n != 0) { + n + } else { + IList.fold_left2 captured_var_compare 0 c1 c2 + } + } /** Compare epressions. Variables come before other expressions. */ and exp_compare (e1: exp) (e2: exp) :int => switch (e1, e2) { @@ -1481,7 +1104,7 @@ and exp_compare (e1: exp) (e2: exp) :int => if (n != 0) { n } else { - typ_opt_compare to1 to2 + opt_compare Typ.compare to1 to2 } } | (UnOp _, _) => (-1) @@ -1508,7 +1131,7 @@ and exp_compare (e1: exp) (e2: exp) :int => if (n != 0) { n } else { - typ_compare t1 t2 + Typ.compare t1 t2 } | (Cast _, _) => (-1) | (_, Cast _) => 1 @@ -1520,11 +1143,11 @@ and exp_compare (e1: exp) (e2: exp) :int => if (n != 0) { n } else { - let n = fld_compare f1 f2; + let n = Ident.fieldname_compare f1 f2; if (n != 0) { n } else { - typ_compare t1 t2 + Typ.compare t1 t2 } } | (Lfield _, _) => (-1) @@ -1539,7 +1162,7 @@ and exp_compare (e1: exp) (e2: exp) :int => | (Lindex _, _) => (-1) | (_, Lindex _) => 1 | (Sizeof t1 l1 s1, Sizeof t2 l2 s2) => - let n = typ_compare t1 t2; + let n = Typ.compare t1 t2; if (n != 0) { n } else { @@ -1554,8 +1177,6 @@ and exp_compare (e1: exp) (e2: exp) :int => let const_equal c1 c2 => const_compare c1 c2 == 0; -let typ_equal t1 t2 => typ_compare t1 t2 == 0; - let exp_equal e1 e2 => exp_compare e1 e2 == 0; let rec exp_is_array_index_of exp1 exp2 => @@ -1633,7 +1254,7 @@ let rec strexp_compare se1 se2 => } } } -and fld_strexp_compare fse1 fse2 => pair_compare fld_compare strexp_compare fse1 fse2 +and fld_strexp_compare fse1 fse2 => pair_compare Ident.fieldname_compare strexp_compare fse1 fse2 and fld_strexp_list_compare fsel1 fsel2 => IList.compare fld_strexp_compare fsel1 fsel2 and exp_strexp_compare ese1 ese2 => pair_compare exp_compare strexp_compare ese1 ese2 and exp_strexp_list_compare esel1 esel2 => IList.compare exp_strexp_compare esel1 esel2 @@ -1783,55 +1404,6 @@ let hpara_equal hpara1 hpara2 => hpara_compare hpara1 hpara2 == 0; let hpara_dll_equal hpara1 hpara2 => hpara_dll_compare hpara1 hpara2 == 0; -/** if [struct_typ] is a class, return its class kind (Java, CPP, or Obj-C) */ -let struct_typ_get_class_kind struct_typ => - switch struct_typ.csu { - | Csu.Class class_kind => Some class_kind - | _ => None - }; - - -/** return true if [struct_typ] is a Java class */ -let struct_typ_is_java_class struct_typ => - switch (struct_typ_get_class_kind struct_typ) { - | Some Csu.Java => true - | _ => false - }; - - -/** return true if [struct_typ] is a C++ class. Note that this returns false for raw structs. */ -let struct_typ_is_cpp_class struct_typ => - switch (struct_typ_get_class_kind struct_typ) { - | Some Csu.CPP => true - | _ => false - }; - - -/** return true if [struct_typ] is an Obj-C class. Note that this returns false for raw structs. */ -let struct_typ_is_objc_class struct_typ => - switch (struct_typ_get_class_kind struct_typ) { - | Some Csu.Objc => true - | _ => false - }; - - -/** {2 Sets and maps of types} */ -let module StructTypSet = Set.Make { - type t = struct_typ; - let compare = struct_typ_compare; -}; - -let module TypSet = Set.Make { - type t = typ; - let compare = typ_compare; -}; - -let module TypMap = Map.Make { - type t = typ; - let compare = typ_compare; -}; - - /** {2 Sets of expressions} */ let module ExpSet = Set.Make { type t = exp; @@ -1970,37 +1542,6 @@ let str_binop pe binop => | _ => text_binop binop }; -let ikind_to_string = - fun - | IChar => "char" - | ISChar => "signed char" - | IUChar => "unsigned char" - | IBool => "_Bool" - | IInt => "int" - | IUInt => "unsigned int" - | IShort => "short" - | IUShort => "unsigned short" - | ILong => "long" - | IULong => "unsigned long" - | ILongLong => "long long" - | IULongLong => "unsigned long long" - | I128 => "__int128_t" - | IU128 => "__uint128_t"; - -let fkind_to_string = - fun - | FFloat => "float" - | FDouble => "double" - | FLongDouble => "long double"; - -let ptr_kind_string = - fun - | Pk_reference => "&" - | Pk_pointer => "*" - | Pk_objc_weak => "__weak *" - | Pk_objc_unsafe_unretained => "__unsafe_unretained *" - | Pk_objc_autoreleasing => "__autoreleasing *"; - let java () => !Config.curr_language == Config.Java; let eradicate_java () => Config.eradicate && java (); @@ -2091,7 +1632,7 @@ let rec dexp_to_string = ampersand ^ s } | Dunop op de => str_unop op ^ dexp_to_string de - | Dsizeof typ _ _ => pp_to_string (pp_typ_full pe_text) typ + | Dsizeof typ _ _ => pp_to_string (Typ.pp_full pe_text) typ | Dunknown => "unknown" | Dretcall de _ _ _ => "returned by " ^ dexp_to_string de /** Pretty print a dexp. */ @@ -2203,69 +1744,6 @@ and pp_const pe f => let id_exps = IList.map (fun (id_exp, _, _) => id_exp) captured_vars; F.fprintf f "(%a)" (pp_comma_seq (pp_exp pe)) [Const (Cfun name), ...id_exps] } -/** Pretty print a type. Do nothing by default. */ -and pp_typ pe f te => - if Config.print_types { - pp_typ_full pe f te - } else { - () - } -and pp_struct_typ pe pp_base f struct_typ => - switch struct_typ.struct_name { - | Some name when false => - /* remove "when false" to print the details of struct */ - F.fprintf - f - "%s %a {%a} %a" - (Csu.name struct_typ.csu) - Mangled.pp - name - (pp_seq (fun f (fld, t, _) => F.fprintf f "%a %a" (pp_typ_full pe) t Ident.pp_fieldname fld)) - struct_typ.instance_fields - pp_base - () - | Some name => F.fprintf f "%s %a %a" (Csu.name struct_typ.csu) Mangled.pp name pp_base () - | None => - F.fprintf - f - "%s {%a} %a" - (Csu.name struct_typ.csu) - (pp_seq (fun f (fld, t, _) => F.fprintf f "%a %a" (pp_typ_full pe) t Ident.pp_fieldname fld)) - struct_typ.instance_fields - pp_base - () - } -/** Pretty print a type declaration. - pp_base prints the variable for a declaration, or can be skip to print only the type - pp_static_len prints the expression for the array length */ -and pp_type_decl pe pp_base pp_static_len f => - fun - | Tvar tname => F.fprintf f "%s %a" (Typename.to_string tname) pp_base () - | Tint ik => F.fprintf f "%s %a" (ikind_to_string ik) pp_base () - | Tfloat fk => F.fprintf f "%s %a" (fkind_to_string fk) pp_base () - | Tvoid => F.fprintf f "void %a" pp_base () - | Tfun false => F.fprintf f "_fn_ %a" pp_base () - | Tfun true => F.fprintf f "_fn_noreturn_ %a" pp_base () - | Tptr ((Tarray _ | Tfun _) as typ) pk => { - let pp_base' fmt () => F.fprintf fmt "(%s%a)" (ptr_kind_string pk) pp_base (); - pp_type_decl pe pp_base' pp_static_len f typ - } - | Tptr typ pk => { - let pp_base' fmt () => F.fprintf fmt "%s%a" (ptr_kind_string pk) pp_base (); - pp_type_decl pe pp_base' pp_static_len f typ - } - | Tstruct struct_typ => pp_struct_typ pe pp_base f struct_typ - | Tarray typ static_len => { - let pp_array_static_len fmt => ( - fun - | Some static_len => pp_static_len pe fmt (Const (Cint static_len)) - | None => F.fprintf fmt "_" - ); - let pp_base' fmt () => F.fprintf fmt "%a[%a]" pp_base () pp_array_static_len static_len; - pp_type_decl pe pp_base' pp_static_len f typ - } -/** Pretty print a type with all the details, using the C syntax. */ -and pp_typ_full pe => pp_type_decl pe (fun _ () => ()) pp_exp_full /** Pretty print an expression. */ and _pp_exp pe0 pp_t f e0 => { let (pe, changed) = color_pre_wrapper pe0 f e0; @@ -2310,24 +1788,10 @@ and _pp_exp pe0 pp_t f e0 => { }; color_post_wrapper changed pe0 f } -and pp_exp pe f e => _pp_exp pe (pp_typ pe) f e -and pp_exp_full pe f e => _pp_exp pe (pp_typ_full pe) f e +and pp_exp pe f e => _pp_exp pe (Typ.pp pe) f e /** Convert an expression to a string */ and exp_to_string e => pp_to_string (pp_exp pe_text) e; -let typ_to_string typ => { - let pp fmt () => pp_typ_full pe_text fmt typ; - pp_to_string pp () -}; - - -/** dump a type with all the details. */ -let d_typ_full (t: typ) => L.add_print_action (L.PTtyp_full, Obj.repr t); - - -/** dump a list of types. */ -let d_typ_list (tl: list typ) => L.add_print_action (L.PTtyp_list, Obj.repr tl); - /** dump an expression. */ let d_exp (e: exp) => L.add_print_action (L.PTexp, Obj.repr e); @@ -2344,7 +1808,7 @@ let pp_texp pe f => fun | Sizeof t l s => { let pp_len f l => Option.map_default (F.fprintf f "[%a]" (pp_exp pe)) () l; - F.fprintf f "%a%a%a" (pp_typ pe) t pp_len l Subtype.pp s + F.fprintf f "%a%a%a" (Typ.pp pe) t pp_len l Subtype.pp s } | e => (pp_exp pe) f e; @@ -2354,9 +1818,9 @@ let pp_texp_full pe f => fun | Sizeof t l s => { let pp_len f l => Option.map_default (F.fprintf f "[%a]" (pp_exp pe)) () l; - F.fprintf f "%a%a%a" (pp_typ_full pe) t pp_len l Subtype.pp s + F.fprintf f "%a%a%a" (Typ.pp_full pe) t pp_len l Subtype.pp s } - | e => (_pp_exp pe) (pp_typ_full pe) f e; + | e => (_pp_exp pe) (Typ.pp_full pe) f e; /** Dump a type expression with all the details. */ @@ -2385,7 +1849,7 @@ let rec pp_offset_list pe f => /** Dump a list of offsets */ let d_offset_list (offl: list offset) => L.add_print_action (L.PToff_list, Obj.repr offl); -let pp_exp_typ pe f (e, t) => F.fprintf f "%a:%a" (pp_exp pe) e (pp_typ pe) t; +let pp_exp_typ pe f (e, t) => F.fprintf f "%a:%a" (pp_exp pe) e (Typ.pp pe) t; /** Get the location of the instruction */ @@ -2432,9 +1896,9 @@ let pp_instr pe0 f instr => { let (pe, changed) = color_pre_wrapper pe0 f instr; switch instr { | Letderef id e t loc => - F.fprintf f "%a=*%a:%a %a" (Ident.pp pe) id (pp_exp pe) e (pp_typ pe) t Location.pp loc + F.fprintf f "%a=*%a:%a %a" (Ident.pp pe) id (pp_exp pe) e (Typ.pp pe) t Location.pp loc | Set e1 t e2 loc => - F.fprintf f "*%a:%a=%a %a" (pp_exp pe) e1 (pp_typ pe) t (pp_exp pe) e2 Location.pp loc + F.fprintf f "*%a:%a=%a %a" (pp_exp pe) e1 (Typ.pp pe) t (pp_exp pe) e2 Location.pp loc | Prune cond loc true_branch _ => F.fprintf f "PRUNE(%a, %b); %a" (pp_exp pe) cond true_branch Location.pp loc | Call ret_ids e arg_ts loc cf => @@ -2472,19 +1936,9 @@ let pp_instr pe0 f instr => { color_post_wrapper changed pe0 f }; -let has_block_prefix s => - switch (Str.split_delim (Str.regexp_string Config.anonymous_block_prefix) s) { - | [_, _, ..._] => true - | _ => false - }; - - -/** Check if type is a type for a block in objc */ -let is_block_type typ => has_block_prefix (typ_to_string typ); - /** Check if a pvar is a local pointing to a block in objc */ -let is_block_pvar pvar => has_block_prefix (Mangled.to_string (Pvar.get_name pvar)); +let is_block_pvar pvar => Typ.has_block_prefix (Mangled.to_string (Pvar.get_name pvar)); /* A block pvar used to explain retain cycles */ let block_pvar = Pvar.mk (Mangled.from_string "block") (Procname.from_string_c_fun ""); @@ -3190,46 +2644,12 @@ let hpred_list_get_lexps (filter: exp => bool) (hlist: list hpred) :list exp => /** {2 Utility Functions for Expressions} */ -let unsome_typ s => - fun - | Some default_typ => default_typ - | None => { - L.err "No default typ in %s@." s; - assert false - }; - - /** Turn an expression representing a type into the type it represents If not a sizeof, return the default type if given, otherwise raise an exception */ let texp_to_typ default_opt => fun | Sizeof t _ _ => t - | _ => unsome_typ "texp_to_typ" default_opt; - - -/** 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 default_opt f => { - let def () => unsome_typ "struct_typ_fld" default_opt; - fun - | Tstruct struct_typ => - try ( - (fun (_, y, _) => y) ( - IList.find (fun (_f, _, _) => Ident.fieldname_equal _f f) struct_typ.instance_fields - ) - ) { - | Not_found => def () - } - | _ => def () -}; - - -/** If an array type, return the type of the element. - If not, return the default type if given, otherwise raise an exception */ -let array_typ_elem default_opt => - fun - | Tarray t_el _ => t_el - | _ => unsome_typ "array_typ_elem" default_opt; + | _ => Typ.unsome "texp_to_typ" default_opt; /** Return the root of [lexp]. */ @@ -3833,12 +3253,6 @@ let sub_symmetric_difference sub1_in sub2_in => { diff [] [] [] sub1_in sub2_in }; -let module Typtbl = Hashtbl.Make { - type t = typ; - let equal = typ_equal; - let hash = Hashtbl.hash; -}; - /** [sub_find filter sub] returns the expression associated to the first identifier that satisfies [filter]. Raise [Not_found] if there isn't one. */ @@ -3991,7 +3405,7 @@ let exp_typ_compare (exp1, typ1) (exp2, typ2) => { if (n != 0) { n } else { - typ_compare typ1 typ2 + Typ.compare typ1 typ2 } }; @@ -4006,7 +3420,7 @@ let instr_compare instr1 instr2 => if (n != 0) { n } else { - let n = typ_compare t1 t2; + let n = Typ.compare t1 t2; if (n != 0) { n } else { @@ -4021,7 +3435,7 @@ let instr_compare instr1 instr2 => if (n != 0) { n } else { - let n = typ_compare t1 t2; + let n = Typ.compare t1 t2; if (n != 0) { n } else { @@ -4114,7 +3528,7 @@ let instr_compare instr1 instr2 => if (n != 0) { n } else { - typ_compare t1 t2 + Typ.compare t1 t2 } }; let n = IList.compare pt_compare ptl1 ptl2; @@ -4151,7 +3565,7 @@ let rec exp_compare_structural e1 e2 exp_map => { if (n != 0) { n } else { - typ_opt_compare to1 to2 + opt_compare Typ.compare to1 to2 }, exp_map ) @@ -4174,7 +3588,7 @@ let rec exp_compare_structural e1 e2 exp_map => { if (n != 0) { n } else { - typ_compare t1 t2 + Typ.compare t1 t2 }, exp_map ) @@ -4185,11 +3599,11 @@ let rec exp_compare_structural e1 e2 exp_map => { if (n != 0) { n } else { - let n = fld_compare f1 f2; + let n = Ident.fieldname_compare f1 f2; if (n != 0) { n } else { - typ_compare t1 t2 + Typ.compare t1 t2 } }, exp_map @@ -4211,7 +3625,7 @@ let exp_typ_compare_structural (e1, t1) (e2, t2) exp_map => { if (n != 0) { n } else { - typ_compare t1 t2 + Typ.compare t1 t2 }, exp_map ) @@ -4252,7 +3666,7 @@ let instr_compare_structural instr1 instr2 exp_map => { if (n != 0) { n } else { - typ_compare t1 t2 + Typ.compare t1 t2 }, exp_map ) @@ -4262,7 +3676,7 @@ let instr_compare_structural instr1 instr2 exp_map => { if (n != 0) { (n, exp_map) } else { - let n = typ_compare t1 t2; + let n = Typ.compare t1 t2; if (n != 0) { (n, exp_map) } else { @@ -4343,7 +3757,7 @@ let instr_compare_structural instr1 instr2 exp_map => { if (n != 0) { (n, exp_map) } else { - (typ_compare t1 t2, exp_map) + (Typ.compare t1 t2, exp_map) } } ) diff --git a/infer/src/IR/Sil.rei b/infer/src/IR/Sil.rei index bcfc95214..71417e6f1 100644 --- a/infer/src/IR/Sil.rei +++ b/infer/src/IR/Sil.rei @@ -19,21 +19,6 @@ let module F = Format; /** {2 Programs and Types} */ -/** Type to represent one @Annotation. */ -type annotation = { - class_name: string, /* name of the annotation */ - parameters: list string - /* currently only one string parameter */ -}; - - -/** Annotation for one item: a list of annotations with visibility. */ -type item_annotation = list (annotation, bool); - - -/** Annotation for a method: return value and list of parameters. */ -type method_annotation = (item_annotation, list item_annotation); - type func_attribute = | FA_sentinel of int int; @@ -74,31 +59,6 @@ type binop = | PtrFld /** field offset via pointer to field: takes the address of a Csu.t and a Cptr_to_fld constant to form an Lfield expression (see prop.ml) */; - -/** Kinds of integers */ -type ikind = - | IChar /** [char] */ - | ISChar /** [signed char] */ - | IUChar /** [unsigned char] */ - | IBool /** [bool] */ - | IInt /** [int] */ - | IUInt /** [unsigned int] */ - | IShort /** [short] */ - | IUShort /** [unsigned short] */ - | ILong /** [long] */ - | IULong /** [unsigned long] */ - | ILongLong /** [long long] (or [_int64] on Microsoft Visual C) */ - | IULongLong /** [unsigned long long] (or [unsigned _int64] on Microsoft Visual C) */ - | I128 /** [__int128_t] */ - | IU128 /** [__uint128_t] */; - - -/** Kinds of floating-point numbers*/ -type fkind = - | FFloat /** [float] */ - | FDouble /** [double] */ - | FLongDouble /** [long double] */; - type mem_kind = | Mmalloc /** memory allocated with malloc */ | Mnew /** memory allocated with new */ @@ -124,15 +84,6 @@ type dangling_kind = | DAminusone; -/** kind of pointer */ -type ptr_kind = - | Pk_pointer /* C/C++, Java, Objc standard/__strong pointer*/ - | Pk_reference /* C++ reference */ - | Pk_objc_weak /* Obj-C __weak pointer*/ - | Pk_objc_unsafe_unretained /* Obj-C __unsafe_unretained pointer */ - | Pk_objc_autoreleasing /* Obj-C __autoreleasing pointer */; - - /** position in a path: proc name, node id */ type path_pos = (Procname.t, int); @@ -181,13 +132,22 @@ type call_flags = { /** Default value for call_flags where all fields are set to false */ let cf_default: call_flags; +type taint_kind = + | Tk_unverified_SSL_socket + | Tk_shared_preferences_data + | Tk_privacy_annotation + | Tk_integrity_annotation + | Tk_unknown; + +type taint_info = {taint_source: Procname.t, taint_kind: taint_kind}; + /** expression representing the result of decompilation */ type dexp = | Darray of dexp dexp | Dbinop of binop dexp dexp | Dconst of const - | Dsizeof of typ (option exp) Subtype.t + | Dsizeof of Typ.t (option exp) Subtype.t | Dderef of dexp | Dfcall of dexp (list dexp) Location.t call_flags | Darrow of dexp Ident.fieldname @@ -208,20 +168,13 @@ and res_action = { ra_loc: Location.t, /** location of the acquire/release */ ra_vpath: vpath /** vpath of the resource value */ } -and taint_kind = - | Tk_unverified_SSL_socket - | Tk_shared_preferences_data - | Tk_privacy_annotation - | Tk_integrity_annotation - | Tk_unknown -and taint_info = {taint_source: Procname.t, taint_kind: taint_kind} /** Attributes */ and attribute = | Aresource of res_action /** resource acquire/release */ | Aautorelease | Adangling of dangling_kind /** dangling pointer */ - /** undefined value obtained by calling the given procedure */ - | Aundef of Procname.t item_annotation Location.t path_pos + /** undefined value obtained by calling the given procedure, plus its return value annots */ + | Aundef of Procname.t Typ.item_annotation Location.t path_pos | Ataint of taint_info | Auntaint of taint_info | Alocked @@ -230,24 +183,13 @@ and attribute = | Adiv0 of path_pos /** the exp. is null because of a call to a method with exp as a null receiver */ | Aobjc_null of exp - /** value was returned from a call to the given procedure */ - | Aretval of Procname.t item_annotation + /** value was returned from a call to the given procedure, plus the annots of the return value */ + | Aretval of Procname.t Typ.item_annotation /** denotes an object registered as an observers to a notification center */ | Aobserver /** denotes an object unsubscribed from observers of a notification center */ | Aunsubscribed_observer -/** Categories of attributes */ -and attribute_category = - | ACresource - | ACautorelease - | ACtaint - | AClock - | ACdiv0 - | ACobjc_null - | ACundef - | ACretval - | ACobserver -and closure = {name: Procname.t, captured_vars: list (exp, Pvar.t, typ)} +and closure = {name: Procname.t, captured_vars: list (exp, Pvar.t, Typ.t)} /** Constants */ and const = | Cint of IntLit.t /** integer constants */ @@ -257,90 +199,35 @@ and const = | Cattribute of attribute /** attribute used in disequalities to annotate a value */ | Cexn of exp /** exception */ | Cclass of Ident.name /** class constant */ - | Cptr_to_fld of Ident.fieldname typ /** pointer to field constant, - and type of the surrounding Csu.t type */ + | Cptr_to_fld of Ident.fieldname Typ.t /** pointer to field constant, + and type of the surrounding Csu.t type */ | Cclosure of closure /** anonymous function */ -and struct_fields = list (Ident.fieldname, typ, item_annotation) -/** Type for a structured value. */ -and struct_typ = { - instance_fields: struct_fields, /** non-static fields */ - static_fields: struct_fields, /** static fields */ - csu: Csu.t, /** class/struct/union */ - struct_name: option Mangled.t, /** name */ - superclasses: list Typename.t, /** list of superclasses */ - def_methods: list Procname.t, /** methods defined */ - struct_annotations: item_annotation /** annotations */ -} -/** statically determined length of an array type, if any */ -and static_length = option IntLit.t /** dynamically determined length of an array value, if any */ and dynamic_length = option exp -/** Types for sil (structured) expressions. */ -and typ = - | Tvar of Typename.t /** named type */ - | Tint of ikind /** integer type */ - | Tfloat of fkind /** float type */ - | Tvoid /** void type */ - | Tfun of bool /** function type with noreturn attribute */ - | Tptr of typ ptr_kind /** pointer type */ - | Tstruct of struct_typ /** Type for a structured value */ - | Tarray of typ static_length /** array type with statically fixed length */ /** Program expressions. */ and exp = /** Pure variable: it is not an lvalue */ | Var of Ident.t /** Unary operator with type of the result if known */ - | UnOp of unop exp (option typ) + | UnOp of unop exp (option Typ.t) /** Binary operator */ | BinOp of binop exp exp /** Constants */ | Const of const /** Type cast */ - | Cast of typ exp + | Cast of Typ.t exp /** The address of a program variable */ | Lvar of Pvar.t /** A field offset, the type is the surrounding struct type */ - | Lfield of exp Ident.fieldname typ + | Lfield of exp Ident.fieldname Typ.t /** An array index offset: [exp1\[exp2\]] */ | Lindex of exp exp - /** A sizeof expression. [Sizeof typ (Some len)] represents the size of a value of type [typ] - which ends in an extensible array of length [len]. The length in [Tarray] records the - statically determined length, while the length in [Sizeof] records the dynamic length. */ - | Sizeof of typ dynamic_length Subtype.t; - - -/** the element typ of the final extensible array in the given typ, if any */ -let get_extensible_array_element_typ: typ => option typ; - -let struct_typ_equal: struct_typ => struct_typ => bool; - - -/** if [struct_typ] is a class, return its class kind (Java, CPP, or Obj-C) */ -let struct_typ_get_class_kind: struct_typ => option Csu.class_kind; - - -/** return true if [struct_typ] is a Java class */ -let struct_typ_is_java_class: struct_typ => bool; - - -/** return true if [struct_typ] is a C++ class. Note that this returns false for raw structs. */ -let struct_typ_is_cpp_class: struct_typ => bool; - - -/** return true if [struct_typ] is an Obj-C class. Note that this returns false for raw structs. */ -let struct_typ_is_objc_class: struct_typ => bool; - - -/** Sets of types. */ -let module StructTypSet: Set.S with type elt = struct_typ; - -let module TypSet: Set.S with type elt = typ; - - -/** Maps with type keys. */ -let module TypMap: Map.S with type key = typ; - -let module AnnotMap: PrettyPrintable.PPMap with type key = annotation; + /** A sizeof expression. [Sizeof (Tarray elt (Some static_length)) (Some dynamic_length)] + represents the size of an array value consisting of [dynamic_length] elements of type [elt]. + The [dynamic_length], tracked by symbolic execution, may differ from the [static_length] + obtained from the type definition, e.g. when an array is over-allocated. For struct types, + the [dynamic_length] is that of the final extensible array, if any. */ + | Sizeof of Typ.t dynamic_length Subtype.t; /** Sets of expressions. */ @@ -380,21 +267,21 @@ type stackop = /** An instruction. */ type instr = /** declaration [let x = *lexp:typ] where [typ] is the root type of [lexp] */ - | Letderef of Ident.t exp typ Location.t + | Letderef of Ident.t exp Typ.t Location.t /** assignment [*lexp1:typ = exp2] where [typ] is the root type of [lexp1] */ - | Set of exp typ exp Location.t + | Set of exp Typ.t exp Location.t /** prune the state based on [exp=1], the boolean indicates whether true branch */ | Prune of exp Location.t bool if_kind /** [Call (ret_id1..ret_idn, e_fun, arg_ts, loc, call_flags)] represents an instructions [ret_id1..ret_idn = e_fun(arg_ts);] where n = 0 for void return and n > 1 for struct return */ - | Call of (list Ident.t) exp (list (exp, typ)) Location.t call_flags + | Call of (list Ident.t) exp (list (exp, Typ.t)) Location.t call_flags /** nullify stack variable */ | Nullify of Pvar.t Location.t | Abstract of Location.t /** apply abstraction */ | Remove_temps of (list Ident.t) Location.t /** remove temporaries */ | Stackop of stackop Location.t /** operation on the stack of propsets */ - | Declare_locals of (list (Pvar.t, typ)) Location.t /** declare local variables */; + | Declare_locals of (list (Pvar.t, Typ.t)) Location.t /** declare local variables */; /** Check if an instruction is auxiliary, or if it comes from source instructions. */ @@ -402,7 +289,7 @@ let instr_is_auxiliary: instr => bool; /** Offset for an lvalue. */ -type offset = | Off_fld of Ident.fieldname typ | Off_index of exp; +type offset = | Off_fld of Ident.fieldname Typ.t | Off_index of exp; /** {2 Components of Propositions} */ @@ -561,24 +448,8 @@ let hpred_compact: sharing_env => hpred => hpred; /** {2 Comparision And Inspection Functions} */ -let is_objc_ref_counter_field: (Ident.fieldname, typ, item_annotation) => bool; - let has_objc_ref_counter: hpred => bool; -let objc_class_annotation: list (annotation, bool); - -let cpp_class_annotation: list (annotation, bool); - -let is_objc_class: typ => bool; - -let is_cpp_class: typ => bool; - -let is_java_class: typ => bool; - -let is_array_of_cpp_class: typ => bool; - -let is_pointer_to_cpp_class: typ => bool; - let exp_is_zero: exp => bool; let exp_is_null_literal: exp => bool; @@ -589,11 +460,7 @@ let exp_is_this: exp => bool; let path_pos_equal: path_pos => path_pos => bool; - -/** turn a *T into a T. fails if [typ] is not a pointer type */ -let typ_strip_ptr: typ => typ; - -let zero_value_of_numerical_type: typ => exp; +let zero_value_of_numerical_type: Typ.t => exp; /** Make a static local name in objc */ @@ -610,48 +477,6 @@ let block_pvar: Pvar.t; /** Check if a pvar is a local pointing to a block in objc */ let is_block_pvar: Pvar.t => bool; - -/** Check if type is a type for a block in objc */ -let is_block_type: typ => bool; - - -/** Comparision for fieldnames. */ -let fld_compare: Ident.fieldname => Ident.fieldname => int; - - -/** Equality for fieldnames. */ -let fld_equal: Ident.fieldname => Ident.fieldname => bool; - - -/** Check wheter the integer kind is a char */ -let ikind_is_char: ikind => bool; - - -/** Check wheter the integer kind is unsigned */ -let ikind_is_unsigned: ikind => bool; - - -/** Convert an int64 into an IntLit.t given the kind: - the int64 is interpreted as unsigned according to the kind */ -let int_of_int64_kind: int64 => ikind => IntLit.t; - - -/** Comparision for ptr_kind */ -let ptr_kind_compare: ptr_kind => ptr_kind => int; - - -/** Comparision for types. */ -let typ_compare: typ => typ => int; - - -/** Equality for types. */ -let typ_equal: typ => typ => bool; - - -/** Comparision for fieldnames * types * item annotations. */ -let fld_typ_ann_compare: - (Ident.fieldname, typ, item_annotation) => (Ident.fieldname, typ, item_annotation) => int; - let unop_equal: unop => unop => bool; let binop_equal: binop => binop => bool; @@ -684,6 +509,19 @@ let attribute_compare: attribute => attribute => int; let attribute_equal: attribute => attribute => bool; + +/** Categories of attributes */ +type attribute_category = + | ACresource + | ACautorelease + | ACtaint + | AClock + | ACdiv0 + | ACobjc_null + | ACundef + | ACretval + | ACobserver; + let attribute_category_compare: attribute_category => attribute_category => int; let attribute_category_equal: attribute_category => attribute_category => bool; @@ -712,7 +550,7 @@ let exp_is_array_index_of: exp => exp => bool; let call_flags_compare: call_flags => call_flags => int; -let exp_typ_compare: (exp, typ) => (exp, typ) => int; +let exp_typ_compare: (exp, Typ.t) => (exp, Typ.t) => int; let instr_compare: instr => instr => int; @@ -762,38 +600,6 @@ let exp_strexp_compare: (exp, strexp) => (exp, strexp) => int; let hpred_get_lhs: hpred => exp; -/** Field used for objective-c reference counting */ -let objc_ref_counter_field: (Ident.fieldname, typ, item_annotation); - - -/** Compare function for annotations. */ -let annotation_compare: annotation => annotation => int; - - -/** Compare function for annotation items. */ -let item_annotation_compare: item_annotation => item_annotation => int; - - -/** Compare function for Method annotations. */ -let method_annotation_compare: method_annotation => method_annotation => int; - - -/** Empty item annotation. */ -let item_annotation_empty: item_annotation; - - -/** Empty method annotation. */ -let method_annotation_empty: method_annotation; - - -/** Check if the item annodation is empty. */ -let item_annotation_is_empty: item_annotation => bool; - - -/** Check if the method annodation is empty. */ -let method_annotation_is_empty: method_annotation => bool; - - /** Return the value of the FA_sentinel attribute in [attr_list] if it is found */ let get_sentinel_func_attribute_value: list func_attribute => option (int, int); @@ -823,56 +629,10 @@ let mem_alloc_pname: mem_kind => Procname.t; let mem_dealloc_pname: mem_kind => Procname.t; -/** Pretty print an annotation. */ -let pp_annotation: F.formatter => annotation => unit; - - /** Pretty print a const. */ let pp_const: printenv => F.formatter => const => unit; -/** Pretty print an item annotation. */ -let pp_item_annotation: F.formatter => item_annotation => unit; - -let item_annotation_to_string: item_annotation => string; - - -/** Pretty print a method annotation. */ -let pp_method_annotation: string => F.formatter => method_annotation => unit; - - -/** Pretty print a type. */ -let pp_typ: printenv => F.formatter => typ => unit; - -let pp_struct_typ: printenv => (F.formatter => unit => unit) => F.formatter => struct_typ => unit; - - -/** Pretty print a type with all the details. */ -let pp_typ_full: printenv => F.formatter => typ => unit; - -let typ_to_string: typ => string; - - -/** [pp_type_decl pe pp_base pp_len f typ] pretty prints a type declaration. - pp_base prints the variable for a declaration, or can be skip to print only the type - pp_len prints the expression for the array length */ -let pp_type_decl: - printenv => - (F.formatter => unit => unit) => - (printenv => F.formatter => exp => unit) => - F.formatter => - typ => - unit; - - -/** Dump a type with all the details. */ -let d_typ_full: typ => unit; - - -/** Dump a list of types. */ -let d_typ_list: list typ => unit; - - /** convert the attribute to a string */ let attribute_to_string: printenv => attribute => string; @@ -890,7 +650,7 @@ let pp_exp: printenv => F.formatter => exp => unit; /** Pretty print an expression with type. */ -let pp_exp_typ: printenv => F.formatter => (exp, typ) => unit; +let pp_exp_typ: printenv => F.formatter => (exp, Typ.t) => unit; /** Convert an expression to a string */ @@ -1094,17 +854,7 @@ let hpred_list_get_lexps: (exp => bool) => list hpred => list exp; /** {2 Utility Functions for Expressions} */ /** Turn an expression representing a type into the type it represents If not a sizeof, return the default type if given, otherwise raise an exception */ -let texp_to_typ: option typ => exp => typ; - - -/** 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: option typ => Ident.fieldname => typ => typ; - - -/** If an array type, return the type of the element. - If not, return the default type if given, otherwise raise an exception */ -let array_typ_elem: option typ => typ => typ; +let texp_to_typ: option Typ.t => exp => Typ.t; /** Return the root of [lexp]. */ diff --git a/infer/src/IR/Tenv.re b/infer/src/IR/Tenv.re index a47488ce6..7ff6aa864 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 Sil.struct_typ; +type t = TypenameHash.t Typ.struct_typ; /** Create a new type environment. */ @@ -46,19 +46,19 @@ let lookup_java_typ_from_string tenv typ_str => { let rec loop = fun | "" - | "void" => Some Sil.Tvoid - | "int" => Some (Sil.Tint Sil.IInt) - | "byte" => Some (Sil.Tint Sil.IShort) - | "short" => Some (Sil.Tint Sil.IShort) - | "boolean" => Some (Sil.Tint Sil.IBool) - | "char" => Some (Sil.Tint Sil.IChar) - | "long" => Some (Sil.Tint Sil.ILong) - | "float" => Some (Sil.Tfloat Sil.FFloat) - | "double" => Some (Sil.Tfloat Sil.FDouble) + | "void" => Some Typ.Tvoid + | "int" => Some (Typ.Tint Typ.IInt) + | "byte" => Some (Typ.Tint Typ.IShort) + | "short" => Some (Typ.Tint Typ.IShort) + | "boolean" => Some (Typ.Tint Typ.IBool) + | "char" => Some (Typ.Tint Typ.IChar) + | "long" => Some (Typ.Tint Typ.ILong) + | "float" => Some (Typ.Tfloat Typ.FFloat) + | "double" => Some (Typ.Tfloat Typ.FDouble) | typ_str when String.contains typ_str '[' => { let stripped_typ = String.sub typ_str 0 (String.length typ_str - 2); switch (loop stripped_typ) { - | Some typ => Some (Sil.Tptr (Sil.Tarray typ None) Sil.Pk_pointer) + | Some typ => Some (Typ.Tptr (Typ.Tarray typ None) Typ.Pk_pointer) | None => None } } @@ -67,7 +67,7 @@ let lookup_java_typ_from_string tenv typ_str => { { let typename = Typename.Java.from_string typ_str; switch (lookup tenv typename) { - | Some struct_typ => Some (Sil.Tstruct struct_typ) + | Some struct_typ => Some (Typ.Tstruct struct_typ) | None => None } }; @@ -79,7 +79,7 @@ let lookup_java_typ_from_string tenv typ_str => { typs, use [lookup_java_typ_from_string] */ let lookup_java_class_from_string tenv typ_str => switch (lookup_java_typ_from_string tenv typ_str) { - | Some (Sil.Tstruct struct_typ) => Some struct_typ + | Some (Typ.Tstruct struct_typ) => Some struct_typ | _ => None }; @@ -102,7 +102,7 @@ let proc_extract_return_typ tenv pname_java => let get_overriden_method tenv pname_java => { let struct_typ_get_def_method_by_name struct_typ method_name => IList.find - (fun def_method => method_name == Procname.get_method def_method) struct_typ.Sil.def_methods; + (fun def_method => method_name == Procname.get_method def_method) struct_typ.Typ.def_methods; let rec get_overriden_method_in_superclasses pname_java superclasses => switch superclasses { | [superclass, ...superclasses_tail] => @@ -113,7 +113,7 @@ let get_overriden_method tenv pname_java => { ) { | Not_found => get_overriden_method_in_superclasses - pname_java (superclasses_tail @ struct_typ.Sil.superclasses) + pname_java (superclasses_tail @ struct_typ.Typ.superclasses) } | None => get_overriden_method_in_superclasses pname_java superclasses_tail } @@ -130,10 +130,10 @@ let get_overriden_method tenv pname_java => { /** expand a type if it is a typename by looking it up in the type environment */ let expand_type tenv typ => switch typ { - | Sil.Tvar tname => + | Typ.Tvar tname => switch (lookup tenv tname) { | None => assert false - | Some struct_typ => Sil.Tstruct struct_typ + | Some struct_typ => Typ.Tstruct struct_typ } | _ => typ }; @@ -168,7 +168,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@." (Sil.pp_struct_typ pe_text (fun _ () => ())) typ + Format.fprintf fmt "@[<6>TYPE: %a@." (Typ.pp_struct_typ pe_text (fun _ () => ())) typ } ) tenv; diff --git a/infer/src/IR/Tenv.rei b/infer/src/IR/Tenv.rei index fc134949f..0cb0671dc 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 => Sil.struct_typ => unit; +let add: t => Typename.t => Typ.struct_typ => unit; /** Create a new type environment. */ @@ -26,15 +26,15 @@ let create: unit => t; /** Expand a type if it is a typename by looking it up in the type environment. */ -let expand_type: t => Sil.typ => Sil.typ; +let expand_type: t => Typ.t => Typ.t; /** Fold a function over the elements of the type environment. */ -let fold: (Typename.t => Sil.struct_typ => 'a => 'a) => t => 'a => 'a; +let fold: (Typename.t => Typ.struct_typ => 'a => 'a) => t => 'a => 'a; /** iterate over a type environment */ -let iter: (Typename.t => Sil.struct_typ => unit) => t => unit; +let iter: (Typename.t => Typ.struct_typ => unit) => t => unit; /** Load a type environment from a file */ @@ -42,24 +42,24 @@ let load_from_file: DB.filename => option t; /** Look up a name in the global type environment. */ -let lookup: t => Typename.t => option Sil.struct_typ; +let lookup: t => Typename.t => option Typ.struct_typ; /** Lookup Java types by name. */ -let lookup_java_typ_from_string: t => string => option Sil.typ; +let lookup_java_typ_from_string: t => string => option Typ.t; /** resolve a type string to a Java *class* type. For strings that may represent primitive or array typs, use [lookup_java_typ_from_string]. */ -let lookup_java_class_from_string: t => string => option Sil.struct_typ; +let lookup_java_class_from_string: t => string => option Typ.struct_typ; /** Return the declaring class type of [pname_java] */ -let proc_extract_declaring_class_typ: t => Procname.java => option Sil.struct_typ; +let proc_extract_declaring_class_typ: t => Procname.java => option Typ.struct_typ; /** Return the return type of [pname_java]. */ -let proc_extract_return_typ: t => Procname.java => option Sil.typ; +let proc_extract_return_typ: t => Procname.java => option Typ.t; /** Check if typename is found in t */ diff --git a/infer/src/IR/Typ.re b/infer/src/IR/Typ.re new file mode 100644 index 000000000..f80add569 --- /dev/null +++ b/infer/src/IR/Typ.re @@ -0,0 +1,602 @@ +/* + * 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: Types */ +let module L = Logging; + +let module F = Format; + + +/** Type to represent one @Annotation. */ +type annotation = { + class_name: string, /** name of the annotation */ + parameters: list string /** currently only one string parameter */ +}; + + +/** Compare function for annotations. */ +let annotation_compare a1 a2 => { + let n = string_compare a1.class_name a2.class_name; + if (n != 0) { + n + } else { + IList.compare string_compare a1.parameters a2.parameters + } +}; + + +/** Pretty print an annotation. */ +let pp_annotation fmt annotation => F.fprintf fmt "@@%s" annotation.class_name; + +let module AnnotMap = PrettyPrintable.MakePPMap { + type t = annotation; + let compare = annotation_compare; + let pp_key = pp_annotation; +}; + + +/** Annotation for one item: a list of annotations with visibility. */ +type item_annotation = list (annotation, bool); + + +/** Compare function for annotation items. */ +let item_annotation_compare ia1 ia2 => { + let cmp (a1, b1) (a2, b2) => { + let n = annotation_compare a1 a2; + if (n != 0) { + n + } else { + bool_compare b1 b2 + } + }; + IList.compare cmp ia1 ia2 +}; + + +/** Pretty print an item annotation. */ +let pp_item_annotation fmt item_annotation => { + let pp fmt (a, _) => pp_annotation fmt a; + F.fprintf fmt "<%a>" (pp_seq pp) item_annotation +}; + +let item_annotation_to_string ann => { + let pp fmt () => pp_item_annotation fmt ann; + pp_to_string pp () +}; + + +/** Empty item annotation. */ +let item_annotation_empty = []; + + +/** Check if the item annodation is empty. */ +let item_annotation_is_empty ia => ia == []; + +let objc_class_str = "ObjC-Class"; + +let cpp_class_str = "Cpp-Class"; + +let class_annotation class_string => [({class_name: class_string, parameters: []}, true)]; + +let objc_class_annotation = class_annotation objc_class_str; + +let cpp_class_annotation = class_annotation cpp_class_str; + + +/** Annotation for a method: return value and list of parameters. */ +type method_annotation = (item_annotation, list item_annotation); + + +/** Compare function for Method annotations. */ +let method_annotation_compare (ia1, ial1) (ia2, ial2) => + IList.compare item_annotation_compare [ia1, ...ial1] [ia2, ...ial2]; + + +/** Pretty print a method annotation. */ +let pp_method_annotation s fmt (ia, ial) => + F.fprintf fmt "%a %s(%a)" pp_item_annotation ia s (pp_seq pp_item_annotation) ial; + + +/** Empty method annotation. */ +let method_annotation_empty = ([], []); + + +/** Check if the method annodation is empty. */ +let method_annotation_is_empty (ia, ial) => IList.for_all item_annotation_is_empty [ia, ...ial]; + + +/** Kinds of integers */ +type ikind = + | IChar /** [char] */ + | ISChar /** [signed char] */ + | IUChar /** [unsigned char] */ + | IBool /** [bool] */ + | IInt /** [int] */ + | IUInt /** [unsigned int] */ + | IShort /** [short] */ + | IUShort /** [unsigned short] */ + | ILong /** [long] */ + | IULong /** [unsigned long] */ + | ILongLong /** [long long] (or [_int64] on Microsoft Visual C) */ + | IULongLong /** [unsigned long long] (or [unsigned _int64] on Microsoft Visual C) */ + | I128 /** [__int128_t] */ + | IU128 /** [__uint128_t] */; + + +/** comparison for ikind */ +let ikind_compare k1 k2 => + switch (k1, k2) { + | (IChar, IChar) => 0 + | (IChar, _) => (-1) + | (_, IChar) => 1 + | (ISChar, ISChar) => 0 + | (ISChar, _) => (-1) + | (_, ISChar) => 1 + | (IUChar, IUChar) => 0 + | (IUChar, _) => (-1) + | (_, IUChar) => 1 + | (IBool, IBool) => 0 + | (IBool, _) => (-1) + | (_, IBool) => 1 + | (IInt, IInt) => 0 + | (IInt, _) => (-1) + | (_, IInt) => 1 + | (IUInt, IUInt) => 0 + | (IUInt, _) => (-1) + | (_, IUInt) => 1 + | (IShort, IShort) => 0 + | (IShort, _) => (-1) + | (_, IShort) => 1 + | (IUShort, IUShort) => 0 + | (IUShort, _) => (-1) + | (_, IUShort) => 1 + | (ILong, ILong) => 0 + | (ILong, _) => (-1) + | (_, ILong) => 1 + | (IULong, IULong) => 0 + | (IULong, _) => (-1) + | (_, IULong) => 1 + | (ILongLong, ILongLong) => 0 + | (ILongLong, _) => (-1) + | (_, ILongLong) => 1 + | (IULongLong, IULongLong) => 0 + | (IULongLong, _) => (-1) + | (_, IULongLong) => 1 + | (I128, I128) => 0 + | (I128, _) => (-1) + | (_, I128) => 1 + | (IU128, IU128) => 0 + }; + +let ikind_to_string = + fun + | IChar => "char" + | ISChar => "signed char" + | IUChar => "unsigned char" + | IBool => "_Bool" + | IInt => "int" + | IUInt => "unsigned int" + | IShort => "short" + | IUShort => "unsigned short" + | ILong => "long" + | IULong => "unsigned long" + | ILongLong => "long long" + | IULongLong => "unsigned long long" + | I128 => "__int128_t" + | IU128 => "__uint128_t"; + +let ikind_is_char = + fun + | IChar + | ISChar + | IUChar => true + | _ => false; + +let ikind_is_unsigned = + fun + | IUChar + | IUInt + | IUShort + | IULong + | IULongLong => true + | _ => false; + +let int_of_int64_kind i ik => IntLit.of_int64_unsigned i (ikind_is_unsigned ik); + + +/** Kinds of floating-point numbers */ +type fkind = + | FFloat /** [float] */ + | FDouble /** [double] */ + | FLongDouble /** [long double] */; + + +/** comparison for fkind */ +let fkind_compare k1 k2 => + switch (k1, k2) { + | (FFloat, FFloat) => 0 + | (FFloat, _) => (-1) + | (_, FFloat) => 1 + | (FDouble, FDouble) => 0 + | (FDouble, _) => (-1) + | (_, FDouble) => 1 + | (FLongDouble, FLongDouble) => 0 + }; + +let fkind_to_string = + fun + | FFloat => "float" + | FDouble => "double" + | FLongDouble => "long double"; + + +/** kind of pointer */ +type ptr_kind = + | Pk_pointer /** C/C++, Java, Objc standard/__strong pointer */ + | Pk_reference /** C++ reference */ + | Pk_objc_weak /** Obj-C __weak pointer */ + | Pk_objc_unsafe_unretained /** Obj-C __unsafe_unretained pointer */ + | Pk_objc_autoreleasing /** Obj-C __autoreleasing pointer */; + +let ptr_kind_compare pk1 pk2 => + switch (pk1, pk2) { + | (Pk_pointer, Pk_pointer) => 0 + | (Pk_pointer, _) => (-1) + | (_, Pk_pointer) => 1 + | (Pk_reference, Pk_reference) => 0 + | (_, Pk_reference) => (-1) + | (Pk_reference, _) => 1 + | (Pk_objc_weak, Pk_objc_weak) => 0 + | (Pk_objc_weak, _) => (-1) + | (_, Pk_objc_weak) => 1 + | (Pk_objc_unsafe_unretained, Pk_objc_unsafe_unretained) => 0 + | (Pk_objc_unsafe_unretained, _) => (-1) + | (_, Pk_objc_unsafe_unretained) => 1 + | (Pk_objc_autoreleasing, Pk_objc_autoreleasing) => 0 + }; + +let ptr_kind_string = + fun + | Pk_reference => "&" + | Pk_pointer => "*" + | Pk_objc_weak => "__weak *" + | Pk_objc_unsafe_unretained => "__unsafe_unretained *" + | Pk_objc_autoreleasing => "__autoreleasing *"; + + +/** statically determined length of an array type, if any */ +type static_length = option IntLit.t; + +type struct_fields = list (Ident.fieldname, t, item_annotation) +/** Type for a structured value. */ +and struct_typ = { + instance_fields: struct_fields, /** non-static fields */ + static_fields: struct_fields, /** static fields */ + csu: Csu.t, /** class/struct/union */ + struct_name: option Mangled.t, /** name */ + superclasses: list Typename.t, /** list of superclasses */ + def_methods: list Procname.t, /** methods defined */ + struct_annotations: item_annotation /** annotations */ +} +/** types for sil (structured) expressions */ +and t = + | Tvar of Typename.t /** named type */ + | Tint of ikind /** integer type */ + | Tfloat of fkind /** float type */ + | Tvoid /** void type */ + | Tfun of bool /** function type with noreturn attribute */ + | Tptr of t ptr_kind /** pointer type */ + | Tstruct of struct_typ /** Type for a structured value */ + | Tarray of t static_length /** array type with statically fixed length */; + +let cname_opt_compare nameo1 nameo2 => + switch (nameo1, nameo2) { + | (None, None) => 0 + | (None, _) => (-1) + | (_, None) => 1 + | (Some n1, Some n2) => Mangled.compare n1 n2 + }; + +let rec fld_typ_ann_compare fta1 fta2 => + triple_compare Ident.fieldname_compare compare item_annotation_compare fta1 fta2 +and fld_typ_ann_list_compare ftal1 ftal2 => IList.compare fld_typ_ann_compare ftal1 ftal2 +and struct_typ_compare struct_typ1 struct_typ2 => + if (struct_typ1.csu == Csu.Class Csu.Java && struct_typ2.csu == Csu.Class Csu.Java) { + cname_opt_compare struct_typ1.struct_name struct_typ2.struct_name + } else { + let n = fld_typ_ann_list_compare struct_typ1.instance_fields struct_typ2.instance_fields; + if (n != 0) { + n + } else { + let n = fld_typ_ann_list_compare struct_typ1.static_fields struct_typ2.static_fields; + if (n != 0) { + n + } else { + let n = Csu.compare struct_typ1.csu struct_typ2.csu; + if (n != 0) { + n + } else { + cname_opt_compare struct_typ1.struct_name struct_typ2.struct_name + } + } + } + } +/** Comparision for types. */ +and compare t1 t2 => + if (t1 === t2) { + 0 + } else { + switch (t1, t2) { + | (Tvar tn1, Tvar tn2) => Typename.compare tn1 tn2 + | (Tvar _, _) => (-1) + | (_, Tvar _) => 1 + | (Tint ik1, Tint ik2) => ikind_compare ik1 ik2 + | (Tint _, _) => (-1) + | (_, Tint _) => 1 + | (Tfloat fk1, Tfloat fk2) => fkind_compare fk1 fk2 + | (Tfloat _, _) => (-1) + | (_, Tfloat _) => 1 + | (Tvoid, Tvoid) => 0 + | (Tvoid, _) => (-1) + | (_, Tvoid) => 1 + | (Tfun noreturn1, Tfun noreturn2) => bool_compare noreturn1 noreturn2 + | (Tfun _, _) => (-1) + | (_, Tfun _) => 1 + | (Tptr t1' pk1, Tptr t2' pk2) => + let n = compare t1' t2'; + if (n != 0) { + n + } else { + ptr_kind_compare pk1 pk2 + } + | (Tptr _, _) => (-1) + | (_, Tptr _) => 1 + | (Tstruct struct_typ1, Tstruct struct_typ2) => struct_typ_compare struct_typ1 struct_typ2 + | (Tstruct _, _) => (-1) + | (_, Tstruct _) => 1 + | (Tarray t1 _, Tarray t2 _) => compare t1 t2 + } + }; + +let struct_typ_equal struct_typ1 struct_typ2 => struct_typ_compare struct_typ1 struct_typ2 == 0; + +let equal t1 t2 => compare t1 t2 == 0; + +let rec pp_struct_typ pe pp_base f struct_typ => + switch struct_typ.struct_name { + | Some name when false => + /* remove "when false" to print the details of struct */ + F.fprintf + f + "%s %a {%a} %a" + (Csu.name struct_typ.csu) + Mangled.pp + name + (pp_seq (fun f (fld, t, _) => F.fprintf f "%a %a" (pp_full pe) t Ident.pp_fieldname fld)) + struct_typ.instance_fields + pp_base + () + | Some name => F.fprintf f "%s %a %a" (Csu.name struct_typ.csu) Mangled.pp name pp_base () + | None => + F.fprintf + f + "%s {%a} %a" + (Csu.name struct_typ.csu) + (pp_seq (fun f (fld, t, _) => F.fprintf f "%a %a" (pp_full pe) t Ident.pp_fieldname fld)) + struct_typ.instance_fields + pp_base + () + } +/** Pretty print a type declaration. + pp_base prints the variable for a declaration, or can be skip to print only the type */ +and pp_decl pe pp_base f => + fun + | Tvar tname => F.fprintf f "%s %a" (Typename.to_string tname) pp_base () + | Tint ik => F.fprintf f "%s %a" (ikind_to_string ik) pp_base () + | Tfloat fk => F.fprintf f "%s %a" (fkind_to_string fk) pp_base () + | Tvoid => F.fprintf f "void %a" pp_base () + | Tfun false => F.fprintf f "_fn_ %a" pp_base () + | Tfun true => F.fprintf f "_fn_noreturn_ %a" pp_base () + | Tptr ((Tarray _ | Tfun _) as typ) pk => { + let pp_base' fmt () => F.fprintf fmt "(%s%a)" (ptr_kind_string pk) pp_base (); + pp_decl pe pp_base' f typ + } + | Tptr typ pk => { + let pp_base' fmt () => F.fprintf fmt "%s%a" (ptr_kind_string pk) pp_base (); + pp_decl pe pp_base' f typ + } + | Tstruct struct_typ => pp_struct_typ pe pp_base f struct_typ + | Tarray typ static_len => { + let pp_array_static_len fmt => ( + fun + | Some static_len => IntLit.pp fmt static_len + | None => F.fprintf fmt "_" + ); + let pp_base' fmt () => F.fprintf fmt "%a[%a]" pp_base () pp_array_static_len static_len; + pp_decl pe pp_base' f typ + } +/** Pretty print a type with all the details, using the C syntax. */ +and pp_full pe => pp_decl pe (fun _ () => ()) +/** Pretty print a type. Do nothing by default. */ +and pp pe f te => + if Config.print_types { + pp_full pe f te + } else { + () + }; + +let to_string typ => { + let pp fmt () => pp_full pe_text fmt typ; + pp_to_string pp () +}; + + +/** dump a type with all the details. */ +let d_full (t: t) => L.add_print_action (L.PTtyp_full, Obj.repr t); + + +/** dump a list of types. */ +let d_list (tl: list t) => L.add_print_action (L.PTtyp_list, Obj.repr tl); + + +/** {2 Sets and maps of types} */ +let module StructSet = Set.Make { + type t = struct_typ; + let compare = struct_typ_compare; +}; + +let module Set = Set.Make { + type nonrec t = t; + let compare = compare; +}; + +let module Map = Map.Make { + type nonrec t = t; + let compare = compare; +}; + +let module Tbl = Hashtbl.Make { + type nonrec t = t; + let equal = equal; + let hash = Hashtbl.hash; +}; + +let unsome s => + fun + | Some default_typ => default_typ + | None => { + L.err "No default typ in %s@." s; + assert false + }; + + +/** turn a *T into a T. fails if [typ] is not a pointer type */ +let strip_ptr = + fun + | Tptr t _ => t + | _ => assert false; + + +/** If an array type, return the type of the element. + If not, return the default type if given, otherwise raise an exception */ +let array_elem default_opt => + fun + | 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 = + fun + | Tarray typ _ => Some typ + | Tstruct {instance_fields} => + Option.map_default + (fun (_, fld_typ, _) => get_extensible_array_element_typ fld_typ) + None + (IList.last instance_fields) + | _ => None; + + +/** 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 default_opt f => { + let def () => unsome "struct_typ_fld" default_opt; + fun + | Tstruct struct_typ => + try ( + (fun (_, y, _) => y) ( + IList.find (fun (_f, _, _) => Ident.fieldname_equal _f f) struct_typ.instance_fields + ) + ) { + | Not_found => def () + } + | _ => def () +}; + + +/** if [struct_typ] is a class, return its class kind (Java, CPP, or Obj-C) */ +let struct_typ_get_class_kind struct_typ => + switch struct_typ.csu { + | Csu.Class class_kind => Some class_kind + | _ => None + }; + + +/** return true if [struct_typ] is a Java class */ +let struct_typ_is_java_class struct_typ => + switch (struct_typ_get_class_kind struct_typ) { + | Some Csu.Java => true + | _ => false + }; + + +/** return true if [struct_typ] is a C++ class. Note that this returns false for raw structs. */ +let struct_typ_is_cpp_class struct_typ => + switch (struct_typ_get_class_kind struct_typ) { + | Some Csu.CPP => true + | _ => false + }; + + +/** return true if [struct_typ] is an Obj-C class. Note that this returns false for raw structs. */ +let struct_typ_is_objc_class struct_typ => + switch (struct_typ_get_class_kind struct_typ) { + | Some Csu.Objc => true + | _ => false + }; + +let is_class_of_kind typ ck => + switch typ { + | Tstruct {csu: Csu.Class ck'} => ck == ck' + | _ => false + }; + +let is_objc_class typ => is_class_of_kind typ Csu.Objc; + +let is_cpp_class typ => is_class_of_kind typ Csu.CPP; + +let is_java_class typ => is_class_of_kind typ Csu.Java; + +let rec is_array_of_cpp_class typ => + switch typ { + | Tarray typ _ => is_array_of_cpp_class typ + | _ => is_cpp_class typ + }; + +let is_pointer_to_cpp_class typ => + switch typ { + | Tptr t _ => is_cpp_class t + | _ => false + }; + +let has_block_prefix s => + switch (Str.split_delim (Str.regexp_string Config.anonymous_block_prefix) s) { + | [_, _, ..._] => true + | _ => false + }; + + +/** 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 = [({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 && item_annotation_compare a objc_ref_counter_annot == 0; diff --git a/infer/src/IR/Typ.rei b/infer/src/IR/Typ.rei new file mode 100644 index 000000000..165a94012 --- /dev/null +++ b/infer/src/IR/Typ.rei @@ -0,0 +1,268 @@ +/* + * 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: Types */ +let module F = Format; + + +/** Type to represent one @Annotation. */ +type annotation = { + class_name: string, /** name of the annotation */ + parameters: list string /** currently only one string parameter */ +}; + + +/** Compare function for annotations. */ +let annotation_compare: annotation => annotation => int; + + +/** Pretty print an annotation. */ +let pp_annotation: F.formatter => annotation => unit; + +let module AnnotMap: PrettyPrintable.PPMap with type key = annotation; + + +/** Annotation for one item: a list of annotations with visibility. */ +type item_annotation = list (annotation, bool); + + +/** Compare function for annotation items. */ +let item_annotation_compare: item_annotation => item_annotation => int; + + +/** Pretty print an item annotation. */ +let pp_item_annotation: F.formatter => item_annotation => unit; + +let item_annotation_to_string: item_annotation => string; + + +/** Empty item annotation. */ +let item_annotation_empty: item_annotation; + + +/** Check if the item annodation is empty. */ +let item_annotation_is_empty: item_annotation => bool; + +let objc_class_annotation: item_annotation; + +let cpp_class_annotation: item_annotation; + + +/** Annotation for a method: return value and list of parameters. */ +type method_annotation = (item_annotation, list item_annotation); + + +/** Compare function for Method annotations. */ +let method_annotation_compare: method_annotation => method_annotation => int; + + +/** Empty method annotation. */ +let method_annotation_empty: method_annotation; + + +/** Check if the method annodation is empty. */ +let method_annotation_is_empty: method_annotation => bool; + + +/** Pretty print a method annotation. */ +let pp_method_annotation: string => F.formatter => method_annotation => unit; + + +/** Kinds of integers */ +type ikind = + | IChar /** [char] */ + | ISChar /** [signed char] */ + | IUChar /** [unsigned char] */ + | IBool /** [bool] */ + | IInt /** [int] */ + | IUInt /** [unsigned int] */ + | IShort /** [short] */ + | IUShort /** [unsigned short] */ + | ILong /** [long] */ + | IULong /** [unsigned long] */ + | ILongLong /** [long long] (or [_int64] on Microsoft Visual C) */ + | IULongLong /** [unsigned long long] (or [unsigned _int64] on Microsoft Visual C) */ + | I128 /** [__int128_t] */ + | IU128 /** [__uint128_t] */; + + +/** Check wheter the integer kind is a char */ +let ikind_is_char: ikind => bool; + + +/** Check wheter the integer kind is unsigned */ +let ikind_is_unsigned: ikind => bool; + + +/** Convert an int64 into an IntLit.t given the kind: + the int64 is interpreted as unsigned according to the kind */ +let int_of_int64_kind: int64 => ikind => IntLit.t; + + +/** Kinds of floating-point numbers */ +type fkind = + | FFloat /** [float] */ + | FDouble /** [double] */ + | FLongDouble /** [long double] */; + + +/** kind of pointer */ +type ptr_kind = + | Pk_pointer /** C/C++, Java, Objc standard/__strong pointer */ + | Pk_reference /** C++ reference */ + | Pk_objc_weak /** Obj-C __weak pointer */ + | Pk_objc_unsafe_unretained /** Obj-C __unsafe_unretained pointer */ + | Pk_objc_autoreleasing /** Obj-C __autoreleasing pointer */; + + +/** Comparision for ptr_kind */ +let ptr_kind_compare: ptr_kind => ptr_kind => int; + + +/** statically determined length of an array type, if any */ +type static_length = option IntLit.t; + +type struct_fields = list (Ident.fieldname, t, item_annotation) +/** Type for a structured value. */ +and struct_typ = { + instance_fields: struct_fields, /** non-static fields */ + static_fields: struct_fields, /** static fields */ + csu: Csu.t, /** class/struct/union */ + struct_name: option Mangled.t, /** name */ + superclasses: list Typename.t, /** list of superclasses */ + def_methods: list Procname.t, /** methods defined */ + struct_annotations: item_annotation /** annotations */ +} +/** types for sil (structured) expressions */ +and t = + | Tvar of Typename.t /** named type */ + | Tint of ikind /** integer type */ + | Tfloat of fkind /** float type */ + | Tvoid /** void type */ + | Tfun of bool /** function type with noreturn attribute */ + | Tptr of t ptr_kind /** pointer type */ + | Tstruct of struct_typ /** Type for a structured value */ + | Tarray of t static_length /** array type with statically fixed length */; + + +/** Comparision for fieldnames * types * item annotations. */ +let fld_typ_ann_compare: + (Ident.fieldname, t, item_annotation) => (Ident.fieldname, t, item_annotation) => int; + +let struct_typ_equal: struct_typ => struct_typ => bool; + + +/** Comparision for types. */ +let compare: t => t => int; + + +/** Equality for types. */ +let equal: t => t => bool; + +let pp_struct_typ: printenv => (F.formatter => unit => unit) => 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 */ +let pp_decl: printenv => (F.formatter => unit => unit) => F.formatter => t => unit; + + +/** Pretty print a type with all the details. */ +let pp_full: printenv => F.formatter => t => unit; + + +/** Pretty print a type. */ +let pp: printenv => F.formatter => t => unit; + +let to_string: t => string; + + +/** Dump a type with all the details. */ +let d_full: t => unit; + + +/** Dump a list of types. */ +let d_list: list t => unit; + + +/** Sets of types. */ +let module StructSet: Set.S with type elt = struct_typ; + +let module Set: Set.S with type elt = t; + + +/** Maps with type keys. */ +let module Map: Map.S with type key = t; + +let module Tbl: Hashtbl.S with type key = t; + + +/** turn a *T into a T. fails if [t] is not a pointer type */ +let strip_ptr: t => t; + + +/** If an array type, return the type of the element. + 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: 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: option t => Ident.fieldname => t => t; + + +/** if [struct_typ] is a class, return its class kind (Java, CPP, or Obj-C) */ +let struct_typ_get_class_kind: struct_typ => option Csu.class_kind; + + +/** return true if [struct_typ] is a Java class */ +let struct_typ_is_java_class: struct_typ => bool; + + +/** return true if [struct_typ] is a C++ class. Note that this returns false for raw structs. */ +let struct_typ_is_cpp_class: struct_typ => bool; + + +/** return true if [struct_typ] is an Obj-C class. Note that this returns false for raw structs. */ +let struct_typ_is_objc_class: struct_typ => bool; + +let is_objc_class: t => bool; + +let is_cpp_class: t => bool; + +let is_java_class: t => bool; + +let is_array_of_cpp_class: t => bool; + +let is_pointer_to_cpp_class: t => bool; + +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, item_annotation); + +let is_objc_ref_counter_field: (Ident.fieldname, t, item_annotation) => bool; + +let unsome: string => option t => t; diff --git a/infer/src/backend/abs.ml b/infer/src/backend/abs.ml index a8ccdb98c..f1c069638 100644 --- a/infer/src/backend/abs.ml +++ b/infer/src/backend/abs.ml @@ -408,25 +408,25 @@ let mk_rules_for_dll (para : Sil.hpara_dll) : rule list = let typ_get_recursive_flds tenv typ_exp = let filter typ (_, t, _) = match t with - | Sil.Tvar _ | Sil.Tint _ | Sil.Tfloat _ | Sil.Tvoid | Sil.Tfun _ -> false - | Sil.Tptr (Sil.Tvar tname', _) -> + | Typ.Tvar _ | Typ.Tint _ | Typ.Tfloat _ | Typ.Tvoid | Typ.Tfun _ -> false + | Typ.Tptr (Typ.Tvar tname', _) -> let typ' = match Tenv.lookup tenv tname' with | None -> L.err "@.typ_get_recursive: Undefined type %s@." (Typename.to_string tname'); t - | Some st -> Sil.Tstruct st in - Sil.typ_equal typ' typ - | Sil.Tptr _ | Sil.Tstruct _ | Sil.Tarray _ -> + | Some st -> Typ.Tstruct st in + Typ.equal typ' typ + | Typ.Tptr _ | Typ.Tstruct _ | Typ.Tarray _ -> false in match typ_exp with | Sil.Sizeof (typ, _, _) -> (match Tenv.expand_type tenv typ with - | Sil.Tint _ | Sil.Tvoid | Sil.Tfun _ | Sil.Tptr _ | Sil.Tfloat _ -> [] - | Sil.Tstruct { Sil.instance_fields } -> + | Typ.Tint _ | Typ.Tvoid | Typ.Tfun _ | Typ.Tptr _ | Typ.Tfloat _ -> [] + | Typ.Tstruct { Typ.instance_fields } -> IList.map (fun (x, _, _) -> x) (IList.filter (filter typ) instance_fields) - | Sil.Tarray _ -> [] - | Sil.Tvar _ -> assert false) + | Typ.Tarray _ -> [] + | Typ.Tvar _ -> assert false) | Sil.Var _ -> [] (* type of |-> not known yet *) | Sil.Const _ -> [] | _ -> @@ -469,7 +469,7 @@ let discover_para_candidates tenv p = let edges = ref [] in let add_edge edg = edges := edg :: !edges in let get_edges_strexp rec_flds root se = - let is_rec_fld fld = IList.exists (Sil.fld_equal fld) rec_flds in + let is_rec_fld fld = IList.exists (Ident.fieldname_equal fld) rec_flds in match se with | Sil.Eexp _ | Sil.Earray _ -> () | Sil.Estruct (fsel, _) -> @@ -505,7 +505,7 @@ let discover_para_dll_candidates tenv p = let edges = ref [] in let add_edge edg = (edges := edg :: !edges) in let get_edges_strexp rec_flds root se = - let is_rec_fld fld = IList.exists (Sil.fld_equal fld) rec_flds in + let is_rec_fld fld = IList.exists (Ident.fieldname_equal fld) rec_flds in match se with | Sil.Eexp _ | Sil.Earray _ -> () | Sil.Estruct (fsel, _) -> @@ -885,7 +885,8 @@ let get_cycle root prop = IList.iter (fun ((e, t), f, e') -> match e, e' with | Sil.Eexp (e, _), Sil.Eexp (e', _) -> - L.d_str ("("^(Sil.exp_to_string e)^": "^(Sil.typ_to_string t)^", "^(Ident.fieldname_to_string f)^", "^(Sil.exp_to_string e')^")") + L.d_str ("("^(Sil.exp_to_string e)^": "^(Typ.to_string t)^", " + ^(Ident.fieldname_to_string f)^", "^(Sil.exp_to_string e')^")") | _ -> ()) cyc; L.d_strln "") in (* perform a dfs of a graph stopping when e_root is reached. *) @@ -950,7 +951,7 @@ let get_var_retain_cycle _prop = let is_hpred_block v h = match h, v with | Sil.Hpointsto (e, _, Sil.Sizeof (typ, _, _)), Sil.Eexp (e', _) - when Sil.exp_equal e e' && Sil.is_block_type typ -> true + when Sil.exp_equal e e' && Typ.is_block_type typ -> true | _, _ -> false in let find v = try @@ -994,7 +995,7 @@ let cycle_has_weak_or_unretained_or_assign_field cycle = (* returns items annotation for field fn in struct t *) let get_item_annotation t fn = match t with - | Sil.Tstruct { Sil.instance_fields; static_fields } -> + | Typ.Tstruct { Typ.instance_fields; static_fields } -> let ia = ref [] in IList.iter (fun (fn', _, ia') -> if Ident.fieldname_equal fn fn' then ia := ia') @@ -1007,8 +1008,9 @@ let cycle_has_weak_or_unretained_or_assign_field cycle = | att:: _ when Config.unsafe_unret = att || Config.weak = att || Config.assign = att -> true | _:: params' -> has_weak_or_unretained_or_assign params' in let do_annotation (a, _) = - ((a.Sil.class_name = Config.property_attributes) || - (a.Sil.class_name = Config.ivar_attributes)) && has_weak_or_unretained_or_assign a.Sil.parameters in + ((a.Typ.class_name = Config.property_attributes) || + (a.Typ.class_name = Config.ivar_attributes)) + && has_weak_or_unretained_or_assign a.Typ.parameters in let rec do_cycle c = match c with | [] -> false diff --git a/infer/src/backend/absarray.ml b/infer/src/backend/absarray.ml index abda08c79..cf4efe05a 100644 --- a/infer/src/backend/absarray.ml +++ b/infer/src/backend/absarray.ml @@ -29,7 +29,7 @@ module StrexpMatch : sig val path_from_exp_offsets : Sil.exp -> Sil.offset list -> path (** path to the root, length, elements and type of a new_array *) - type strexp_data = path * Sil.strexp * Sil.typ + type strexp_data = path * Sil.strexp * Typ.t (** sigma with info about a current array *) type t @@ -58,7 +58,7 @@ module StrexpMatch : sig end = struct (** syntactic offset *) - type syn_offset = Field of Ident.fieldname * Sil.typ | Index of Sil.exp + type syn_offset = Field of Ident.fieldname * Typ.t | Index of Sil.exp (** path through an Estruct *) type path = Sil.exp * (syn_offset list) @@ -67,19 +67,19 @@ end = struct let rec get_strexp_at_syn_offsets se t syn_offs = match se, t, syn_offs with | _, _, [] -> (se, t) - | Sil.Estruct (fsel, _), Sil.Tstruct { Sil.instance_fields }, Field (fld, _) :: syn_offs' -> - let se' = snd (IList.find (fun (f', _) -> Sil.fld_equal f' fld) fsel) in + | Sil.Estruct (fsel, _), Typ.Tstruct { Typ.instance_fields }, Field (fld, _) :: syn_offs' -> + let se' = snd (IList.find (fun (f', _) -> Ident.fieldname_equal f' fld) fsel) in let t' = (fun (_,y,_) -> y) (IList.find (fun (f', _, _) -> - Sil.fld_equal f' fld) instance_fields) in + Ident.fieldname_equal f' fld) instance_fields) in get_strexp_at_syn_offsets se' t' syn_offs' - | Sil.Earray (_, esel, _), Sil.Tarray (t', _), Index ind :: syn_offs' -> + | Sil.Earray (_, esel, _), Typ.Tarray (t', _), Index ind :: syn_offs' -> let se' = snd (IList.find (fun (i', _) -> Sil.exp_equal i' ind) esel) in get_strexp_at_syn_offsets se' t' syn_offs' | _ -> L.d_strln "Failure of get_strexp_at_syn_offsets"; L.d_str "se: "; Sil.d_sexp se; L.d_ln (); - L.d_str "t: "; Sil.d_typ_full t; L.d_ln (); + L.d_str "t: "; Typ.d_full t; L.d_ln (); assert false (** Replace a strexp at the given syntactic offset list *) @@ -87,15 +87,18 @@ end = struct match se, t, syn_offs with | _, _, [] -> update se - | Sil.Estruct (fsel, inst), Sil.Tstruct { Sil.instance_fields }, Field (fld, _) :: syn_offs' -> - let se' = snd (IList.find (fun (f', _) -> Sil.fld_equal f' fld) fsel) in + | Sil.Estruct (fsel, inst), Typ.Tstruct { Typ.instance_fields }, Field (fld, _) :: syn_offs' -> + let se' = snd (IList.find (fun (f', _) -> Ident.fieldname_equal f' fld) fsel) in let t' = (fun (_,y,_) -> y) (IList.find (fun (f', _, _) -> - Sil.fld_equal f' fld) instance_fields) in + Ident.fieldname_equal f' fld) instance_fields) in let se_mod = replace_strexp_at_syn_offsets se' t' syn_offs' update in - let fsel' = IList.map (fun (f'', se'') -> if Sil.fld_equal f'' fld then (fld, se_mod) else (f'', se'')) fsel in + let fsel' = + IList.map (fun (f'', se'') -> + if Ident.fieldname_equal f'' fld then (fld, se_mod) else (f'', se'') + ) fsel in Sil.Estruct (fsel', inst) - | Sil.Earray (len, esel, inst), Sil.Tarray (t', _), Index idx :: syn_offs' -> + | Sil.Earray (len, esel, inst), Typ.Tarray (t', _), Index idx :: syn_offs' -> let se' = snd (IList.find (fun (i', _) -> Sil.exp_equal i' idx) esel) in let se_mod = replace_strexp_at_syn_offsets se' t' syn_offs' update in let esel' = IList.map (fun ese -> if Sil.exp_equal (fst ese) idx then (idx, se_mod) else ese) esel in @@ -125,7 +128,7 @@ end = struct (root, syn_offs) (** path to the root, len, elements and type of a new_array *) - type strexp_data = path * Sil.strexp * Sil.typ + type strexp_data = path * Sil.strexp * Typ.t (** Store hpred using physical equality, and offset list for an array *) type t = sigma * Sil.hpred * (syn_offset list) @@ -147,9 +150,9 @@ end = struct if pred (path, se, typ) then found := (sigma, hpred, offs') :: !found else begin match se, typ with - | Sil.Estruct (fsel, _), Sil.Tstruct { Sil.instance_fields } -> + | Sil.Estruct (fsel, _), Typ.Tstruct { Typ.instance_fields } -> find_offset_fsel sigma_other hpred root offs fsel instance_fields typ - | Sil.Earray (_, esel, _), Sil.Tarray (t, _) -> + | Sil.Earray (_, esel, _), Typ.Tarray (t, _) -> find_offset_esel sigma_other hpred root offs esel t | _ -> () end @@ -158,7 +161,7 @@ end = struct | (f, se) :: fsel' -> begin try - let t = (fun (_,y,_) -> y) (IList.find (fun (f', _, _) -> Sil.fld_equal f' f) ftal) in + let t = snd3 (IList.find (fun (f', _, _) -> Ident.fieldname_equal f' f) ftal) in find_offset_sexp sigma_other hpred root ((Field (f, typ)) :: offs) se t with Not_found -> L.d_strln ("Can't find field " ^ (Ident.fieldname_to_string f) ^ " in StrexpMatch.find") @@ -428,7 +431,7 @@ let keep_only_indices (** If the type is array, check whether we should do abstraction *) let array_typ_can_abstract = function - | Sil.Tarray (Sil.Tptr (Sil.Tfun _, _), _) -> false (* don't abstract arrays of pointers *) + | Typ.Tarray (Typ.Tptr (Typ.Tfun _, _), _) -> false (* don't abstract arrays of pointers *) | _ -> true (** This function checks whether we can apply an abstraction to a strexp *) @@ -524,18 +527,18 @@ let check_after_array_abstraction prop = let rec check_se root offs typ = function | Sil.Eexp _ -> () | Sil.Earray (_, esel, _) -> (* check that no more than 2 elements are in the array *) - let typ_elem = Sil.array_typ_elem (Some Sil.Tvoid) typ in + let typ_elem = Typ.array_elem (Some Typ.Tvoid) typ in if IList.length esel > 2 && array_typ_can_abstract typ then if IList.for_all (check_index root offs) esel then () else report_error 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 = Sil.struct_typ_fld (Some Sil.Tvoid) f typ in + let typ_f = Typ.struct_typ_fld (Some Typ.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) -> - let typ = Sil.texp_to_typ (Some Sil.Tvoid) texp in + let typ = Sil.texp_to_typ (Some Typ.Tvoid) texp in check_se root [] typ se | Sil.Hlseg _ | Sil.Hdllseg _ -> () in let check_sigma sigma = IList.iter check_hpred sigma in diff --git a/infer/src/backend/autounit.ml b/infer/src/backend/autounit.ml index d9e4317cd..76d713c7c 100644 --- a/infer/src/backend/autounit.ml +++ b/infer/src/backend/autounit.ml @@ -275,7 +275,7 @@ end = struct end type varinfo = - { typ: Sil.typ; (* type of the variable *) + { typ: Typ.t; (* type of the variable *) alloc: bool (* whether the variable needs allocation (on lhs of |->, lists) *) } @@ -303,23 +303,23 @@ let create_idmap sigma : idmap = do_exp e2 typ | Sil.BinOp (Sil.PlusPI, e1, e2), _ -> do_exp e1 typ; - do_exp e2 (Sil.Tint Sil.IULong) + do_exp e2 (Typ.Tint Typ.IULong) | Sil.Lfield (e1, _, _), _ -> do_exp e1 typ | Sil.Sizeof _, _ -> () | _ -> - L.err "Unmatched exp: %a : %a@." (Sil.pp_exp pe) e (Sil.pp_typ_full pe) typ; + L.err "Unmatched exp: %a : %a@." (Sil.pp_exp pe) e (Typ.pp_full pe) typ; assert false in let rec do_se se typ = match se, typ with | Sil.Eexp (e, _), _ -> do_exp e typ - | Sil.Estruct (fsel, _), Sil.Tstruct { Sil.instance_fields } -> + | Sil.Estruct (fsel, _), Typ.Tstruct { Typ.instance_fields } -> do_struct fsel instance_fields - | Sil.Earray (len, esel, _), Sil.Tarray (typ, _) -> - do_se (Sil.Eexp (len, Sil.inst_none)) (Sil.Tint Sil.IULong); + | Sil.Earray (len, esel, _), Typ.Tarray (typ, _) -> + do_se (Sil.Eexp (len, Sil.inst_none)) (Typ.Tint Typ.IULong); do_array esel typ | _ -> - L.err "Unmatched sexp: %a : %a@." (Sil.pp_sexp pe) se (Sil.pp_typ_full pe) typ; + L.err "Unmatched sexp: %a : %a@." (Sil.pp_sexp pe) se (Typ.pp_full pe) typ; assert false and do_struct fsel ftal = match fsel, ftal with | [], _ -> () @@ -331,7 +331,7 @@ let create_idmap sigma : idmap = | _:: _, [] -> assert false and do_array esel typ = match esel with | (e, se):: esel' -> - do_se (Sil.Eexp (e, Sil.inst_none)) (Sil.Tint Sil.IULong); + do_se (Sil.Eexp (e, Sil.inst_none)) (Typ.Tint Typ.IULong); do_se se typ; do_array esel' typ | [] -> () in @@ -341,12 +341,12 @@ let create_idmap sigma : idmap = | _ -> () in let do_hpred = function | Sil.Hpointsto (e, se, Sil.Sizeof (typ, _, _)) -> - do_lhs_e e (Sil.Tptr (typ, Sil.Pk_pointer)); + do_lhs_e e (Typ.Tptr (typ, Typ.Pk_pointer)); do_se se typ | Sil.Hlseg (_, _, e, f, el) -> - do_lhs_e e (Sil.Tptr (Sil.Tvoid, Sil.Pk_pointer)); - do_se (Sil.Eexp (f, Sil.inst_none)) (Sil.Tptr (Sil.Tvoid, Sil.Pk_pointer)); - IList.iter (fun e -> do_se (Sil.Eexp (e, Sil.inst_none)) Sil.Tvoid) el + do_lhs_e e (Typ.Tptr (Typ.Tvoid, Typ.Pk_pointer)); + do_se (Sil.Eexp (f, Sil.inst_none)) (Typ.Tptr (Typ.Tvoid, Typ.Pk_pointer)); + IList.iter (fun e -> do_se (Sil.Eexp (e, Sil.inst_none)) Typ.Tvoid) el | hpred -> L.err "do_hpred not implemented %a@." (Sil.pp_hpred pe) hpred in IList.iter do_hpred sigma; @@ -405,7 +405,7 @@ let rec pp_exp_c pe fmt = function (** pretty print a type in C *) let pp_typ_c pe typ = let pp_nil _ () = () in - Sil.pp_type_decl pe pp_nil pp_exp_c typ + Typ.pp_decl pe pp_nil typ (** Convert a pvar to a string by just extracting the name *) let to_string pvar = @@ -424,16 +424,16 @@ let mk_size_name id = let pp_texp_for_malloc fmt = let rec handle_arr_len typ = match typ with - | Sil.Tvar _ | Sil.Tint _ | Sil.Tfloat _ | Sil.Tvoid | Sil.Tfun _ -> + | Typ.Tvar _ | Typ.Tint _ | Typ.Tfloat _ | Typ.Tvoid | Typ.Tfun _ -> typ - | Sil.Tptr (t, pk) -> - Sil.Tptr (handle_arr_len t, pk) - | Sil.Tstruct struct_typ -> + | Typ.Tptr (t, pk) -> + Typ.Tptr (handle_arr_len t, pk) + | Typ.Tstruct struct_typ -> let instance_fields = - IList.map (fun (f, t, a) -> (f, handle_arr_len t, a)) struct_typ.Sil.instance_fields in - Sil.Tstruct { struct_typ with Sil.instance_fields } - | Sil.Tarray (t, e) -> - Sil.Tarray (handle_arr_len t, e) in + IList.map (fun (f, t, a) -> (f, handle_arr_len t, a)) struct_typ.Typ.instance_fields in + Typ.Tstruct { struct_typ with Typ.instance_fields } + | Typ.Tarray (t, e) -> + Typ.Tarray (handle_arr_len t, e) in function | Sil.Sizeof (typ, _, _) -> let typ' = handle_arr_len typ in @@ -501,11 +501,11 @@ let gen_init_equalities code pure = let gen_var_decl code idmap parameters = let do_parameter (name, typ) = let pp_name f () = Mangled.pp f name in - let pp f () = F.fprintf f "%a;" (Sil.pp_type_decl pe pp_name pp_exp_c) typ in + let pp f () = F.fprintf f "%a;" (Typ.pp_decl pe pp_name) typ in Code.add_from_pp code pp in let do_vinfo id { typ } = let pp_var f () = pp_id_c f id in - let pp f () = F.fprintf f "%a;" (Sil.pp_type_decl pe pp_var pp_exp_c) typ in + let pp f () = F.fprintf f "%a;" (Typ.pp_decl pe pp_var) typ in Code.add_from_pp code pp in IList.iter do_parameter parameters; IdMap.iter do_vinfo idmap @@ -518,20 +518,20 @@ let gen_init_vars code solutions idmap = let do_vinfo id { typ = typ; alloc = alloc } = if not alloc then let const = match typ with - | Sil.Tint _ | Sil.Tvoid -> + | Typ.Tint _ | Typ.Tvoid -> get_const id (Sil.Cint IntLit.zero) - | Sil.Tfloat _ -> + | Typ.Tfloat _ -> Sil.Cfloat 0.0 - | Sil.Tptr _ -> + | Typ.Tptr _ -> get_const id (Sil.Cint IntLit.zero) - | Sil.Tfun _ -> + | Typ.Tfun _ -> Sil.Cint IntLit.zero | typ -> - L.err "do_vinfo type undefined: %a@." (Sil.pp_typ_full pe) typ; + L.err "do_vinfo type undefined: %a@." (Typ.pp_full pe) typ; assert false in let pp fmt () = F.fprintf fmt "%a = (%a) %a;" - pp_id_c id (Sil.pp_typ_full pe) typ (Sil.pp_exp pe) (Sil.Const const) in + pp_id_c id (Typ.pp_full pe) typ (Sil.pp_exp pe) (Sil.Const const) in Code.add_from_pp code pp in IdMap.iter do_vinfo idmap @@ -592,7 +592,7 @@ let gen_hpara code proc_name spec_num env id hpara = let gen_hpara_dll _ _ _ _ _ _ = assert false (** Generate epilog for the test case *) -let gen_epilog code proc_name (parameters : (Mangled.t * Sil.typ) list) = +let gen_epilog code proc_name (parameters : (Mangled.t * Typ.t) list) = let pp_parameter fmt (name, _) = Mangled.pp fmt name in let pp f () = F.fprintf f "%a(%a);" Procname.pp proc_name (pp_comma_seq pp_parameter) parameters in let line1 = pp_to_string pp () in diff --git a/infer/src/backend/autounit.mli b/infer/src/backend/autounit.mli index 837c31e10..bd2f90458 100644 --- a/infer/src/backend/autounit.mli +++ b/infer/src/backend/autounit.mli @@ -19,7 +19,7 @@ type code val pp_code : Format.formatter -> code -> unit (** generate a unit test form a spec *) -val genunit : string -> Procname.t -> int -> (Mangled.t * Sil.typ) list +val genunit : string -> Procname.t -> int -> (Mangled.t * Typ.t) list -> Prop.normal Specs.spec -> code (** generate code for a main calling all the unit test functions passed as argument *) diff --git a/infer/src/backend/builtin.ml b/infer/src/backend/builtin.ml index 68614e7b1..7a86f1ca4 100644 --- a/infer/src/backend/builtin.ml +++ b/infer/src/backend/builtin.ml @@ -18,7 +18,7 @@ type args = { prop_ : Prop.normal Prop.t; path : Paths.Path.t; ret_ids : Ident.t list; - args : (Sil.exp * Sil.typ) list; + args : (Sil.exp * Typ.t) list; proc_name : Procname.t; loc : Location.t; } diff --git a/infer/src/backend/builtin.mli b/infer/src/backend/builtin.mli index 6d73f34a3..9e407b9e6 100644 --- a/infer/src/backend/builtin.mli +++ b/infer/src/backend/builtin.mli @@ -18,7 +18,7 @@ type args = { prop_ : Prop.normal Prop.t; path : Paths.Path.t; ret_ids : Ident.t list; - args : (Sil.exp * Sil.typ) list; + args : (Sil.exp * Typ.t) list; proc_name : Procname.t; loc : Location.t; } diff --git a/infer/src/backend/dom.ml b/infer/src/backend/dom.ml index 6f2875ec8..d15bf22c8 100644 --- a/infer/src/backend/dom.ml +++ b/infer/src/backend/dom.ml @@ -928,7 +928,7 @@ let rec exp_partial_join (e1: Sil.exp) (e2: Sil.exp) : Sil.exp = let e_res = Rename.extend (Sil.exp_int c1') (Sil.Var id2) Rename.ExtFresh in Sil.BinOp(Sil.PlusA, e_res, Sil.exp_int c2) | Sil.Cast(t1, e1), Sil.Cast(t2, e2) -> - if not (Sil.typ_equal t1 t2) then (L.d_strln "failure reason 22"; raise IList.Fail) + if not (Typ.equal t1 t2) then (L.d_strln "failure reason 22"; raise IList.Fail) else let e1'' = exp_partial_join e1 e2 in Sil.Cast (t1, e1'') @@ -951,7 +951,7 @@ let rec exp_partial_join (e1: Sil.exp) (e2: Sil.exp) : Sil.exp = if not (Pvar.equal pvar1 pvar2) then (L.d_strln "failure reason 25"; raise IList.Fail) else e1 | Sil.Lfield(e1, f1, t1), Sil.Lfield(e2, f2, _) -> - if not (Sil.fld_equal f1 f2) then (L.d_strln "failure reason 26"; raise IList.Fail) + if not (Ident.fieldname_equal f1 f2) then (L.d_strln "failure reason 26"; raise IList.Fail) else Sil.Lfield(exp_partial_join e1 e2, f1, t1) (* should be t1 = t2 *) | Sil.Lindex(e1, e1'), Sil.Lindex(e2, e2') -> let e1'' = exp_partial_join e1 e2 in @@ -982,15 +982,16 @@ and dynamic_length_partial_join l1 l2 = option_partial_join (fun len1 len2 -> Some (length_partial_join len1 len2)) l1 l2 and typ_partial_join t1 t2 = match t1, t2 with - | Sil.Tptr (t1, pk1), Sil.Tptr (t2, pk2) when Sil.ptr_kind_compare pk1 pk2 = 0 -> - Sil.Tptr (typ_partial_join t1 t2, pk1) - | Sil.Tarray (typ1, len1), Sil.Tarray (typ2, len2) -> + | Typ.Tptr (t1, pk1), Typ.Tptr (t2, pk2) when Typ.ptr_kind_compare pk1 pk2 = 0 -> + Typ.Tptr (typ_partial_join t1 t2, pk1) + | Typ.Tarray (typ1, len1), Typ.Tarray (typ2, len2) -> let t = typ_partial_join typ1 typ2 in let len = static_length_partial_join len1 len2 in - Sil.Tarray (t, len) - | _ when Sil.typ_equal t1 t2 -> t1 (* common case *) + Typ.Tarray (t, len) + | _ when Typ.equal t1 t2 -> t1 (* common case *) | _ -> - L.d_str "typ_partial_join no match "; Sil.d_typ_full t1; L.d_str " "; Sil.d_typ_full t2; L.d_ln (); + L.d_str "typ_partial_join no match "; + Typ.d_full t1; L.d_str " "; Typ.d_full t2; L.d_ln (); raise IList.Fail let rec exp_partial_meet (e1: Sil.exp) (e2: Sil.exp) : Sil.exp = @@ -1008,7 +1009,7 @@ let rec exp_partial_meet (e1: Sil.exp) (e2: Sil.exp) : Sil.exp = | Sil.Const c1, Sil.Const c2 -> if (Sil.const_equal c1 c2) then e1 else (L.d_strln "failure reason 29"; raise IList.Fail) | Sil.Cast(t1, e1), Sil.Cast(t2, e2) -> - if not (Sil.typ_equal t1 t2) then (L.d_strln "failure reason 30"; raise IList.Fail) + if not (Typ.equal t1 t2) then (L.d_strln "failure reason 30"; raise IList.Fail) else let e1'' = exp_partial_meet e1 e2 in Sil.Cast (t1, e1'') @@ -1033,7 +1034,7 @@ let rec exp_partial_meet (e1: Sil.exp) (e2: Sil.exp) : Sil.exp = if not (Pvar.equal pvar1 pvar2) then (L.d_strln "failure reason 35"; raise IList.Fail) else e1 | Sil.Lfield(e1, f1, t1), Sil.Lfield(e2, f2, _) -> - if not (Sil.fld_equal f1 f2) then (L.d_strln "failure reason 36"; raise IList.Fail) + if not (Ident.fieldname_equal f1 f2) then (L.d_strln "failure reason 36"; raise IList.Fail) else Sil.Lfield(exp_partial_meet e1 e2, f1, t1) (* should be t1 = t2 *) | Sil.Lindex(e1, e1'), Sil.Lindex(e2, e2') -> let e1'' = exp_partial_meet e1 e2 in @@ -1060,7 +1061,7 @@ let rec strexp_partial_join mode (strexp1: Sil.strexp) (strexp2: Sil.strexp) : S | JoinState.Post -> Sil.Estruct (IList.rev acc, inst) end | (fld1, se1):: fld_se_list1', (fld2, se2):: fld_se_list2' -> - let comparison = Sil.fld_compare fld1 fld2 in + let comparison = Ident.fieldname_compare fld1 fld2 in if comparison = 0 then let strexp' = strexp_partial_join mode se1 se2 in let fld_se_list_new = (fld1, strexp') :: acc in @@ -1124,7 +1125,7 @@ let rec strexp_partial_meet (strexp1: Sil.strexp) (strexp2: Sil.strexp) : Sil.st | _, [] -> Sil.Estruct (construct Lhs acc fld_se_list1, inst) | (fld1, se1):: fld_se_list1', (fld2, se2):: fld_se_list2' -> - let comparison = Sil.fld_compare fld1 fld2 in + let comparison = Ident.fieldname_compare fld1 fld2 in if comparison < 0 then let se' = strexp_construct_fresh Lhs se1 in let acc_new = (fld1, se'):: acc in diff --git a/infer/src/backend/dotty.ml b/infer/src/backend/dotty.ml index cd15eebb6..5abf03b3e 100644 --- a/infer/src/backend/dotty.ml +++ b/infer/src/backend/dotty.ml @@ -66,7 +66,7 @@ type dotty_node = | Dotstruct of coordinate * Sil.exp * (Ident.fieldname * Sil.strexp) list * string * Sil.exp (* Dotarray(coo,e1,e2,l,t,c): array box for expression e1 with field list l at coordinate coo and color c*) (* e2 is the len and t is the type *) - | Dotarray of coordinate * Sil.exp * Sil.exp * (Sil.exp * Sil.strexp) list * Sil.typ * string + | Dotarray of coordinate * Sil.exp * Sil.exp * (Sil.exp * Sil.strexp) list * Typ.t * string (* Dotlseg(coo,e1,e2,k,h,c): list box from e1 to e2 at coordinate coo and color c*) | Dotlseg of coordinate * Sil.exp * Sil.exp * Sil.lseg_kind * Sil.hpred list * string (* Dotlseg(coo,e1,e2,e3,e4,k,h,c): doubly linked-list box from with parameters (e1,e2,e3,e4) at coordinate coo and color c*) @@ -294,7 +294,7 @@ let rec dotty_mk_node pe sigma = let n = !dotty_state_count in incr dotty_state_count; let do_hpred_lambda exp_color = function - | (Sil.Hpointsto (e, Sil.Earray (e', l, _), Sil.Sizeof (Sil.Tarray (t, _), _, _)), lambda) -> + | (Sil.Hpointsto (e, Sil.Earray (e', l, _), Sil.Sizeof (Typ.Tarray (t, _), _, _)), lambda) -> incr dotty_state_count; (* increment once more n+1 is the box for the array *) let e_color_str = color_to_str (exp_color e) in let e_color_str'= color_to_str (exp_color e') in @@ -675,7 +675,7 @@ let filter_useless_spec_dollar_box (nodes: dotty_node list) (links: link list) = let rec print_struct f pe e te l coo c = let print_type = match te with | Sil.Sizeof (t, _, _) -> - let str_t = Sil.typ_to_string t in + let str_t = Typ.to_string t in (match Str.split_delim (Str.regexp_string Config.anonymous_block_prefix) str_t with | [_; _] -> "BLOCK object" | _ -> str_t) @@ -929,11 +929,11 @@ let pp_cfgnodename fmt (n : Cfg.Node.t) = let pp_etlist fmt etl = IList.iter (fun (id, ty) -> - Format.fprintf fmt " %a:%a" Mangled.pp id (Sil.pp_typ_full pe_text) ty) etl + Format.fprintf fmt " %a:%a" Mangled.pp id (Typ.pp_full pe_text) ty) etl let pp_local_list fmt etl = IList.iter (fun (id, ty) -> - Format.fprintf fmt " %a:%a" Mangled.pp id (Sil.pp_typ_full pe_text) ty) etl + Format.fprintf fmt " %a:%a" Mangled.pp id (Typ.pp_full pe_text) ty) etl let pp_cfgnodelabel fmt (n : Cfg.Node.t) = let pp_label fmt n = diff --git a/infer/src/backend/dotty.mli b/infer/src/backend/dotty.mli index 788086c95..23db8ea60 100644 --- a/infer/src/backend/dotty.mli +++ b/infer/src/backend/dotty.mli @@ -23,7 +23,7 @@ type kind_of_dotty_prop = val reset_proposition_counter : unit -> unit val pp_dotty : Format.formatter -> kind_of_dotty_prop -> Prop.normal Prop.t -> - ((Sil.strexp * Sil.typ) * Ident.fieldname * Sil.strexp) list option -> unit + ((Sil.strexp * Typ.t) * Ident.fieldname * Sil.strexp) list option -> unit (** {2 Sets and lists of propositions} *) @@ -47,10 +47,10 @@ val pp_speclist_dotty_file : DB.filename -> Prop.normal Specs.spec list -> unit (* create a dotty file with a single proposition *) val dotty_prop_to_dotty_file : string -> Prop.normal Prop.t -> - ((Sil.strexp * Sil.typ) * Ident.fieldname * Sil.strexp) list -> unit + ((Sil.strexp * Typ.t) * Ident.fieldname * Sil.strexp) list -> unit val dotty_prop_to_str : Prop.normal Prop.t -> - ((Sil.strexp * Sil.typ) * Ident.fieldname * Sil.strexp) list -> string option + ((Sil.strexp * Typ.t) * Ident.fieldname * Sil.strexp) list -> string option (** reset the counter used for node and heap identifiers *) val reset_node_counter : unit -> unit diff --git a/infer/src/backend/errdesc.ml b/infer/src/backend/errdesc.ml index 8ee289d81..8cb11780f 100644 --- a/infer/src/backend/errdesc.ml +++ b/infer/src/backend/errdesc.ml @@ -504,12 +504,12 @@ let explain_leak tenv hpred prop alloc_att_opt bucket = (Pvar.is_local pvar || Pvar.is_global pvar) && not (pvar_is_frontend_tmp pvar) && match hpred_typ_opt, find_typ_without_ptr prop pvar with - | Some (Sil.Sizeof (t1, _, _)), Some (Sil.Sizeof (Sil.Tptr (t2_, _), _, _)) -> + | Some (Sil.Sizeof (t1, _, _)), Some (Sil.Sizeof (Typ.Tptr (t2_, _), _, _)) -> (try let t2 = Tenv.expand_type tenv t2_ in - Sil.typ_equal t1 t2 + Typ.equal t1 t2 with exn when SymOp.exn_not_failure exn -> false) - | Some (Sil.Sizeof (Sil.Tint _, _, _)), Some (Sil.Sizeof (Sil.Tint _, _, _)) + | Some (Sil.Sizeof (Typ.Tint _, _, _)), Some (Sil.Sizeof (Typ.Tint _, _, _)) when is_file -> (* must be a file opened with "open" *) true | _ -> false in @@ -568,7 +568,7 @@ let explain_leak tenv hpred prop alloc_att_opt bucket = (** find the dexp, if any, where the given value is stored also return the type of the value if found *) -let vpath_find prop _exp : Sil.dexp option * Sil.typ option = +let vpath_find prop _exp : Sil.dexp option * Typ.t option = if verbose then (L.d_str "in vpath_find exp:"; Sil.d_exp _exp; L.d_ln ()); let rec find sigma_acc sigma_todo exp = let do_fse res sigma_acc' sigma_todo' lexp texp (f, se) = match se with @@ -577,12 +577,12 @@ let vpath_find prop _exp : Sil.dexp option * Sil.typ option = (match lexp with | Sil.Lvar pv -> let typo = match texp with - | Sil.Sizeof (Sil.Tstruct struct_typ, _, _) -> + | Sil.Sizeof (Typ.Tstruct struct_typ, _, _) -> (try let _, t, _ = IList.find (fun (f', _, _) -> Ident.fieldname_equal f' f) - struct_typ.Sil.instance_fields in + struct_typ.Typ.instance_fields in Some t with Not_found -> None) | _ -> None in @@ -650,7 +650,7 @@ let vpath_find prop _exp : Sil.dexp option * Sil.typ option = | Some de, typo -> L.d_str "vpath_find: found "; L.d_str (Sil.dexp_to_string de); L.d_str " : "; match typo with | None -> L.d_str " No type" - | Some typ -> Sil.d_typ_full typ; + | Some typ -> Typ.d_full typ; L.d_ln () end; res @@ -1057,7 +1057,7 @@ let explain_divide_by_zero exp node loc = (** explain a return expression required *) let explain_return_expression_required loc typ = let typ_str = - let pp fmt () = Sil.pp_typ_full pe_text fmt typ in + let pp fmt () = Typ.pp_full pe_text fmt typ in pp_to_string pp () in Localise.desc_return_expression_required typ_str loc @@ -1127,7 +1127,7 @@ let explain_unary_minus_applied_to_unsigned_expression exp typ node loc = | Some de -> Some (Sil.dexp_to_string de) | None -> None in let typ_str = - let pp fmt () = Sil.pp_typ_full pe_text fmt typ in + let pp fmt () = Typ.pp_full pe_text fmt typ in pp_to_string pp () in Localise.desc_unary_minus_applied_to_unsigned_expression exp_str_opt typ_str loc diff --git a/infer/src/backend/errdesc.mli b/infer/src/backend/errdesc.mli index 98fbc95d6..83dc439e5 100644 --- a/infer/src/backend/errdesc.mli +++ b/infer/src/backend/errdesc.mli @@ -14,7 +14,7 @@ open! Utils (** find the dexp, if any, where the given value is stored also return the type of the value if found *) -val vpath_find : 'a Prop.t -> Sil.exp -> Sil.vpath * Sil.typ option +val vpath_find : 'a Prop.t -> Sil.exp -> Sil.vpath * Typ.t option (** Return true if [id] is assigned to a program variable which is then nullified *) val id_is_assigned_then_dead : Cfg.Node.t -> Ident.t -> bool @@ -41,8 +41,8 @@ val find_boolean_assignment : Cfg.Node.t -> Pvar.t -> bool -> Cfg.Node.t option val exp_rv_dexp : Cfg.Node.t -> Sil.exp -> Sil.dexp option (** Produce a description of a persistent reference to an Android Context *) -val explain_context_leak : Procname.t -> Sil.typ -> Ident.fieldname -> - (Ident.fieldname option * Sil.typ) list -> Localise.error_desc +val explain_context_leak : Procname.t -> Typ.t -> Ident.fieldname -> + (Ident.fieldname option * Typ.t) list -> Localise.error_desc (** Produce a description of a pointer dangerously coerced to a boolean in a comparison *) val explain_bad_pointer_comparison : Sil.exp -> Cfg.Node.t -> Location.t -> Localise.error_desc @@ -80,7 +80,7 @@ val explain_dereference_as_caller_expression : val explain_divide_by_zero : Sil.exp -> Cfg.Node.t -> Location.t -> Localise.error_desc (** explain a return expression required *) -val explain_return_expression_required : Location.t -> Sil.typ -> Localise.error_desc +val explain_return_expression_required : Location.t -> Typ.t -> Localise.error_desc (** explain a comparing floats for equality *) val explain_comparing_floats_for_equality : Location.t -> Localise.error_desc @@ -104,12 +104,12 @@ val explain_return_statement_missing : Location.t -> Localise.error_desc (** explain a retain cycle *) val explain_retain_cycle : - Prop.normal Prop.t -> ((Sil.strexp * Sil.typ) * Ident.fieldname * Sil.strexp) list -> + Prop.normal Prop.t -> ((Sil.strexp * Typ.t) * Ident.fieldname * Sil.strexp) list -> Location.t -> string option -> Localise.error_desc (** explain unary minus applied to unsigned expression *) val explain_unary_minus_applied_to_unsigned_expression : - Sil.exp -> Sil.typ -> Cfg.Node.t -> Location.t -> Localise.error_desc + Sil.exp -> Typ.t -> Cfg.Node.t -> Location.t -> Localise.error_desc (** Explain a tainted value error *) val explain_tainted_value_reaching_sensitive_function : diff --git a/infer/src/backend/interproc.ml b/infer/src/backend/interproc.ml index e1b53e106..f8b7c05b0 100644 --- a/infer/src/backend/interproc.ml +++ b/infer/src/backend/interproc.ml @@ -632,7 +632,7 @@ let report_context_leaks pname sigma tenv = | Some path -> path | None -> assert false in (* a path must exist in order for a leak to be reported *) let err_desc = - Errdesc.explain_context_leak pname (Sil.Tstruct struct_typ) fld_name leak_path in + Errdesc.explain_context_leak pname (Typ.Tstruct struct_typ) fld_name leak_path in let exn = Exceptions.Context_leak (err_desc, __POS__) in Reporting.log_error pname exn) context_exps in diff --git a/infer/src/backend/localise.ml b/infer/src/backend/localise.ml index a20d7321c..ce8b958ec 100644 --- a/infer/src/backend/localise.ml +++ b/infer/src/backend/localise.ml @@ -244,14 +244,14 @@ let by_call_to_ra tags ra = "by " ^ call_to_at_line tags ra.Sil.ra_pname ra.Sil.ra_loc let rec format_typ = function - | Sil.Tptr (typ, _) when !Config.curr_language = Config.Java -> + | Typ.Tptr (typ, _) when !Config.curr_language = Config.Java -> format_typ typ - | Sil.Tstruct { Sil.struct_name = Some name } -> + | Typ.Tstruct { Typ.struct_name = Some name } -> Mangled.to_string name - | Sil.Tvar tname -> + | Typ.Tvar tname -> Typename.name tname | typ -> - Sil.typ_to_string typ + Typ.to_string typ let format_field f = if !Config.curr_language = Config.Java @@ -360,7 +360,7 @@ let deref_str_dangling dangling_kind_opt = (** dereference strings for a pointer size mismatch *) let deref_str_pointer_size_mismatch typ_from_instr typ_of_object = let str_from_typ typ = - let pp f () = Sil.pp_typ_full pe_text f typ in + let pp f () = Typ.pp_full pe_text f typ in pp_to_string pp () in { tags = Tags.create (); value_pre = Some (pointer_or_object ()); @@ -413,10 +413,10 @@ let desc_context_leak pname context_typ fieldname leak_path : error_desc = let leak_path_entry_to_str acc entry = let entry_str = match entry with | (Some fld, _) -> Ident.fieldname_to_string fld - | (None, typ) -> Sil.typ_to_string typ in + | (None, typ) -> Typ.to_string typ in (* intentionally omit space; [typ_to_string] adds an extra space *) acc ^ entry_str ^ " |->\n " in - let context_str = Sil.typ_to_string context_typ in + let context_str = Typ.to_string context_typ in let path_str = let path_prefix = if leak_path = [] then "Leaked " @@ -684,9 +684,9 @@ let desc_leak hpred_type_opt value_str_opt resource_opt resource_action_opt loc s, " to ", " on " in let typ_str = match hpred_type_opt with - | Some (Sil.Sizeof (Sil.Tstruct - { Sil.csu = Csu.Class _; - Sil.struct_name = Some classname; + | Some (Sil.Sizeof (Typ.Tstruct + { Typ.csu = Csu.Class _; + Typ.struct_name = Some classname; }, _, _)) -> " of type " ^ Mangled.to_string classname ^ " " | _ -> " " in @@ -773,7 +773,11 @@ let desc_retain_cycle prop cycle loc cycle_dotty = str_cycle:=!str_cycle^" ("^(string_of_int !ct)^") object "^e_str^" retaining "^e_str^"."^(Ident.fieldname_to_string f)^", "; ct:=!ct +1 | Sil.Eexp (Sil.Sizeof (typ, _, _), _) -> - str_cycle:=!str_cycle^" ("^(string_of_int !ct)^") an object of "^(Sil.typ_to_string typ)^" retaining another object via instance variable "^(Ident.fieldname_to_string f)^", "; + let step = + " (" ^ (string_of_int !ct) ^ ") an object of " + ^ (Typ.to_string typ) ^ " retaining another object via instance variable " + ^ (Ident.fieldname_to_string f) ^ ", " in + str_cycle := !str_cycle ^ step; ct:=!ct +1 | _ -> () in IList.iter do_edge cycle; diff --git a/infer/src/backend/localise.mli b/infer/src/backend/localise.mli index 7ff4f3677..3301b6cdf 100644 --- a/infer/src/backend/localise.mli +++ b/infer/src/backend/localise.mli @@ -165,7 +165,7 @@ val deref_str_uninitialized : Sil.attribute option -> deref_str val deref_str_nil_argument_in_variadic_method : Procname.t -> int -> int -> deref_str (** dereference strings for a pointer size mismatch *) -val deref_str_pointer_size_mismatch : Sil.typ -> Sil.typ -> deref_str +val deref_str_pointer_size_mismatch : Typ.t -> Typ.t -> deref_str (** type of access *) type access = @@ -218,11 +218,11 @@ val desc_null_test_after_dereference : string -> int -> Location.t -> error_desc val java_unchecked_exn_desc : Procname.t -> Typename.t -> string -> error_desc val desc_context_leak : - Procname.t -> Sil.typ -> Ident.fieldname -> - (Ident.fieldname option * Sil.typ) list -> error_desc + Procname.t -> Typ.t -> Ident.fieldname -> + (Ident.fieldname option * Typ.t) list -> error_desc val desc_fragment_retains_view : - Sil.typ -> Ident.fieldname -> Sil.typ -> Procname.t -> error_desc + Typ.t -> Ident.fieldname -> Typ.t -> Procname.t -> error_desc (* Create human-readable error description for assertion failures *) val desc_custom_error : Location.t -> error_desc @@ -238,7 +238,7 @@ val desc_precondition_not_met : pnm_kind option -> Procname.t -> Location.t -> e val desc_return_expression_required : string -> Location.t -> error_desc val desc_retain_cycle : - Prop.normal Prop.t -> ((Sil.strexp * Sil.typ) * Ident.fieldname * Sil.strexp) list -> + Prop.normal Prop.t -> ((Sil.strexp * Typ.t) * Ident.fieldname * Sil.strexp) list -> Location.t -> string option -> error_desc val registered_observer_being_deallocated_str : string -> string diff --git a/infer/src/backend/match.ml b/infer/src/backend/match.ml index 08b0545cb..3e4a93912 100644 --- a/infer/src/backend/match.ml +++ b/infer/src/backend/match.ml @@ -70,7 +70,7 @@ let rec exp_match e1 sub vars e2 : (Sil.subst * Ident.t list) option = None (* Naive *) | Sil.Lvar _, _ | _, Sil.Lvar _ -> check_equal sub vars e1 e2 - | Sil.Lfield(e1', fld1, _), Sil.Lfield(e2', fld2, _) when (Sil.fld_equal fld1 fld2) -> + | Sil.Lfield(e1', fld1, _), Sil.Lfield(e2', fld2, _) when (Ident.fieldname_equal fld1 fld2) -> exp_match e1' sub vars e2' | Sil.Lfield _, _ | _, Sil.Lfield _ -> None @@ -117,7 +117,7 @@ and fsel_match fsel1 sub vars fsel2 = if (Config.abs_struct <= 0) then None else Some (sub, vars) (* This can lead to great information loss *) | (fld1, se1') :: fsel1', (fld2, se2') :: fsel2' -> - let n = Sil.fld_compare fld1 fld2 in + let n = Ident.fieldname_compare fld1 fld2 in if (n = 0) then begin match strexp_match se1' sub vars se2' with | None -> None @@ -513,7 +513,7 @@ and generate_todos_from_fel mode todos fel1 fel2 = | _, [] -> if mode == LFieldForget then Some todos else None | (fld1, strexp1) :: fel1', (fld2, strexp2) :: fel2' -> - let n = Sil.fld_compare fld1 fld2 in + let n = Ident.fieldname_compare fld1 fld2 in if (n = 0) then begin match generate_todos_from_strexp mode todos strexp1 strexp2 with diff --git a/infer/src/backend/mleak_buckets.mli b/infer/src/backend/mleak_buckets.mli index 7ef8bf020..1481e9190 100644 --- a/infer/src/backend/mleak_buckets.mli +++ b/infer/src/backend/mleak_buckets.mli @@ -17,7 +17,7 @@ val objc_arc_flag : string (* If cf is passed, then check leaks from Core Foundation. *) (* If arc is passed, check leaks from code that compiles with arc*) (* If no arc is passed check the leaks from code that compiles without arc *) -val should_raise_objc_leak : Sil.typ -> string option +val should_raise_objc_leak : Typ.t -> string option (* Returns whether a memory leak should be raised for a C++ object.*) (* If ml_buckets contains cpp, then check leaks from C++ objects. *) diff --git a/infer/src/backend/modelBuiltins.ml b/infer/src/backend/modelBuiltins.ml index 3481f5158..332b233ee 100644 --- a/infer/src/backend/modelBuiltins.ml +++ b/infer/src/backend/modelBuiltins.ml @@ -40,12 +40,12 @@ let mk_empty_array_rearranged len = let extract_array_type typ = if (!Config.curr_language = Config.Java) then match typ with - | Sil.Tptr (Sil.Tarray _ as arr, _) -> Some arr + | Typ.Tptr (Typ.Tarray _ as arr, _) -> Some arr | _ -> None else match typ with - | Sil.Tarray _ as arr -> Some arr - | Sil.Tptr (elt, _) -> Some (Sil.Tarray (elt, None)) + | Typ.Tarray _ as arr -> Some arr + | Typ.Tptr (elt, _) -> Some (Typ.Tarray (elt, None)) | _ -> None (** Return a result from a procedure call. *) @@ -152,13 +152,13 @@ let create_type tenv n_lexp typ prop = with Not_found -> let mhpred = match typ with - | Sil.Tptr (typ', _) -> + | Typ.Tptr (typ', _) -> let sexp = Sil.Estruct ([], Sil.inst_none) in let typ'' = Tenv.expand_type tenv typ' in let texp = Sil.Sizeof (typ'', None, Sil.Subtype.subtypes) in let hpred = Prop.mk_ptsto n_lexp sexp texp in Some hpred - | Sil.Tarray _ -> + | Typ.Tarray _ -> let len = Sil.Var (Ident.create_fresh Ident.kfootprint) in let sexp = mk_empty_array len in let texp = Sil.Sizeof (typ, None, Sil.Subtype.subtypes) in @@ -237,7 +237,7 @@ let execute___instanceof_cast ~instof let texp2, prop = check_arith_norm_exp pname texp2_ prop__ in let is_cast_to_reference = match typ1 with - | Sil.Tptr (_, Sil.Pk_reference) -> true + | Typ.Tptr (_, Typ.Pk_reference) -> true | _ -> false in (* In Java, we throw an exception, in C++ we return 0 in case of a cast to a pointer, *) (* and throw an exception in case of a cast to a reference. *) @@ -462,12 +462,12 @@ let execute___objc_counter_update match args with | [(lexp, typ)] -> let typ' = (match Tenv.expand_type tenv typ with - | Sil.Tstruct _ as s -> s - | Sil.Tptr(t, _) -> Tenv.expand_type tenv t + | Typ.Tstruct _ as s -> s + | Typ.Tptr(t, _) -> Tenv.expand_type tenv t | s' -> L.d_str ("Trying to update hidden field of not a struc. Type: " ^ - (Sil.typ_to_string s')); + (Typ.to_string s')); assert false) in (* Assumes that lexp is a temp n$1 that has the value of the object. *) (* This is the case as a call f(o) it's translates as n$1=*&o; f(n$1) *) @@ -492,7 +492,7 @@ let execute___objc_counter_update removed from the list of args. *) let get_suppress_npe_flag args = match args with - | (Sil.Const (Sil.Cint i), Sil.Tint Sil.IBool):: args' when IntLit.isone i -> + | (Sil.Const (Sil.Cint i), Typ.Tint Typ.IBool):: args' when IntLit.isone i -> false, args' (* this is a CFRelease/CFRetain *) | _ -> true, args @@ -758,15 +758,15 @@ let execute_alloc mk can_return_null | Sil.BinOp (bop, e1', e2') -> Sil.BinOp (bop, evaluate_char_sizeof e1', evaluate_char_sizeof e2') | Sil.Const _ | Sil.Cast _ | Sil.Lvar _ | Sil.Lfield _ | Sil.Lindex _ -> e - | Sil.Sizeof (Sil.Tarray (Sil.Tint ik, _), Some len, _) when Sil.ikind_is_char ik -> + | Sil.Sizeof (Typ.Tarray (Typ.Tint ik, _), Some len, _) when Typ.ikind_is_char ik -> evaluate_char_sizeof len - | Sil.Sizeof (Sil.Tarray (Sil.Tint ik, Some len), None, _) when Sil.ikind_is_char ik -> + | Sil.Sizeof (Typ.Tarray (Typ.Tint ik, Some len), None, _) when Typ.ikind_is_char ik -> evaluate_char_sizeof (Sil.Const (Sil.Cint len)) | Sil.Sizeof _ -> e in let size_exp, procname = match args with | [(Sil.Sizeof - (Sil.Tstruct - { Sil.csu = Csu.Class Csu.Objc; struct_name = Some c } as s, len, subt), _)] -> + (Typ.Tstruct + { Typ.csu = Csu.Class Csu.Objc; struct_name = Some c } as s, len, subt), _)] -> let struct_type = match AttributesTable.get_correct_type_from_objc_class_name c with | Some struct_type -> struct_type @@ -786,7 +786,7 @@ let execute_alloc mk can_return_null let n_size_exp' = evaluate_char_sizeof n_size_exp in Prop.exp_normalize_prop prop n_size_exp', prop in let cnt_te = - Sil.Sizeof (Sil.Tarray (Sil.Tint Sil.IChar, None), Some size_exp', Sil.Subtype.exact) in + Sil.Sizeof (Typ.Tarray (Typ.Tint Typ.IChar, None), Some size_exp', Sil.Subtype.exact) in let id_new = Ident.create_fresh Ident.kprimed in let exp_new = Sil.Var id_new in let ptsto_new = @@ -825,8 +825,8 @@ let execute___cxx_typeid ({ Builtin.pdesc; tenv; prop_; args; loc} as r) | Sil.Hpointsto (_, _, Sil.Sizeof (dynamic_type, _, _)) -> dynamic_type | _ -> typ with Not_found -> typ in - let typ_string = Sil.typ_to_string typ in - let set_instr = Sil.Set (field_exp, Sil.Tvoid, Sil.Const (Sil.Cstr typ_string), loc) in + let typ_string = Typ.to_string typ in + let set_instr = Sil.Set (field_exp, Typ.Tvoid, Sil.Const (Sil.Cstr typ_string), loc) in SymExec.instrs ~mask_errors:true tenv pdesc [set_instr] res | _ -> res) | _ -> raise (Exceptions.Wrong_argument_number __POS__) @@ -867,7 +867,7 @@ let execute_scan_function skip_n_arguments ({ Builtin.args } as call_args) SymExec.unknown_or_scan_call ~is_scan:true None - Sil.item_annotation_empty + Typ.item_annotation_empty { call_args with args = !varargs } | _ -> raise (Exceptions.Wrong_argument_number __POS__) @@ -942,7 +942,7 @@ let execute___infer_fail { Builtin.pdesc; tenv; prop_; path; args; loc; } | _ -> raise (Exceptions.Wrong_argument_number __POS__) in let set_instr = - Sil.Set (Sil.Lvar Sil.custom_error, Sil.Tvoid, Sil.Const (Sil.Cstr error_str), loc) in + Sil.Set (Sil.Lvar Sil.custom_error, Typ.Tvoid, Sil.Const (Sil.Cstr error_str), loc) in SymExec.instrs ~mask_errors:true tenv pdesc [set_instr] [(prop_, path)] (* translate builtin assertion failure *) @@ -955,7 +955,7 @@ let execute___assert_fail { Builtin.pdesc; tenv; prop_; path; args; loc; } | _ -> raise (Exceptions.Wrong_argument_number __POS__) in let set_instr = - Sil.Set (Sil.Lvar Sil.custom_error, Sil.Tvoid, Sil.Const (Sil.Cstr error_str), loc) in + Sil.Set (Sil.Lvar Sil.custom_error, Typ.Tvoid, Sil.Const (Sil.Cstr error_str), loc) in SymExec.instrs ~mask_errors:true tenv pdesc [set_instr] [(prop_, path)] let __assert_fail = Builtin.register @@ -1156,11 +1156,11 @@ let execute_objc_alloc_no_fail symb_state typ alloc_fun_opt { Builtin.pdesc; tenv; ret_ids; loc; } = let alloc_fun = Sil.Const (Sil.Cfun __objc_alloc_no_fail) in - let ptr_typ = Sil.Tptr (typ, Sil.Pk_pointer) in + let ptr_typ = Typ.Tptr (typ, Typ.Pk_pointer) in let sizeof_typ = Sil.Sizeof (typ, None, Sil.Subtype.exact) in let alloc_fun_exp = match alloc_fun_opt with - | Some pname -> [Sil.Const (Sil.Cfun pname), Sil.Tvoid] + | Some pname -> [Sil.Const (Sil.Cfun pname), Typ.Tvoid] | None -> [] in let alloc_instr = Sil.Call (ret_ids, alloc_fun, [(sizeof_typ, ptr_typ)] @ alloc_fun_exp, loc, Sil.cf_default) in @@ -1180,7 +1180,7 @@ let arrayWithObjectsCount_pname = mk_objc_class_method "NSArray" "arrayWithObjec let execute_objc_NSArray_alloc_no_fail ({ Builtin.tenv; } as builtin_args) symb_state pname = let nsarray_typ_ = - Sil.Tvar (Typename.TN_csu (Csu.Class Csu.Objc, Mangled.from_string "NSArray")) in + Typ.Tvar (Typename.TN_csu (Csu.Class Csu.Objc, Mangled.from_string "NSArray")) in let nsarray_typ = Tenv.expand_type tenv nsarray_typ_ in execute_objc_alloc_no_fail symb_state nsarray_typ (Some pname) builtin_args @@ -1204,7 +1204,7 @@ let execute_objc_NSDictionary_alloc_no_fail symb_state pname ({ Builtin.tenv; } as builtin_args) = let nsdictionary_typ_ = - Sil.Tvar (Typename.TN_csu (Csu.Class Csu.Objc, Mangled.from_string "NSDictionary")) in + Typ.Tvar (Typename.TN_csu (Csu.Class Csu.Objc, Mangled.from_string "NSDictionary")) in let nsdictionary_typ = Tenv.expand_type tenv nsdictionary_typ_ in execute_objc_alloc_no_fail symb_state nsdictionary_typ (Some pname) builtin_args diff --git a/infer/src/backend/objc_models.ml b/infer/src/backend/objc_models.ml index 3b6ab4210..6766e0b48 100644 --- a/infer/src/backend/objc_models.ml +++ b/infer/src/backend/objc_models.ml @@ -206,10 +206,10 @@ struct let rec is_core_lib lib typ = match typ with - | Sil.Tptr (styp, _ ) -> + | Typ.Tptr (styp, _ ) -> is_core_lib lib styp - | Sil.Tvar (Typename.TN_csu (_, name) ) - | Sil.Tstruct { Sil.struct_name = Some name } -> + | Typ.Tvar (Typename.TN_csu (_, name) ) + | Typ.Tstruct { Typ.struct_name = Some name } -> let core_lib_types = core_lib_to_type_list lib in IList.mem (=) (Mangled.to_string name) core_lib_types | _ -> false diff --git a/infer/src/backend/objc_models.mli b/infer/src/backend/objc_models.mli index ffba9fde8..108ff1d77 100644 --- a/infer/src/backend/objc_models.mli +++ b/infer/src/backend/objc_models.mli @@ -20,7 +20,7 @@ sig val is_core_lib_release : string -> string -> bool - val is_core_lib_create : Sil.typ -> string -> bool + val is_core_lib_create : Typ.t -> string -> bool val is_core_lib_retain : string -> string -> bool @@ -31,4 +31,4 @@ sig end -val is_core_lib_type : Sil.typ -> bool +val is_core_lib_type : Typ.t -> bool diff --git a/infer/src/backend/preanal.ml b/infer/src/backend/preanal.ml index 32325c4b5..95c06d7da 100644 --- a/infer/src/backend/preanal.ml +++ b/infer/src/backend/preanal.ml @@ -30,7 +30,7 @@ let add_dispatch_calls pdesc cg tenv = (* the frontend should not populate the list of targets *) assert (call_flags.Sil.cf_targets = []); let receiver_typ_no_ptr = match receiver_typ with - | Sil.Tptr (typ', _) -> + | Typ.Tptr (typ', _) -> typ' | _ -> receiver_typ in diff --git a/infer/src/backend/printer.ml b/infer/src/backend/printer.ml index a6cda35cf..254cce3a6 100644 --- a/infer/src/backend/printer.ml +++ b/infer/src/backend/printer.ml @@ -306,11 +306,11 @@ let force_delayed_print fmt = let (te: Sil.exp) = Obj.obj te in Sil.pp_texp_full pe_default fmt te | (L.PTtyp_full, t) -> - let (t: Sil.typ) = Obj.obj t in - Sil.pp_typ_full pe_default fmt t + let (t: Typ.t) = Obj.obj t in + Typ.pp_full pe_default fmt t | (L.PTtyp_list, tl) -> - let (tl: Sil.typ list) = Obj.obj tl in - (pp_seq (Sil.pp_typ pe_default)) fmt tl + let (tl: Typ.t list) = Obj.obj tl in + (pp_seq (Typ.pp pe_default)) fmt tl | (L.PTerror, s) -> let (s: string) = Obj.obj s in if Config.write_html diff --git a/infer/src/backend/prop.ml b/infer/src/backend/prop.ml index a1f483b30..422221a40 100644 --- a/infer/src/backend/prop.ml +++ b/infer/src/backend/prop.ml @@ -456,11 +456,11 @@ let sym_eval abs e = Sil.Const (Sil.Cclosure { c with captured_vars; }) | Sil.Const _ -> e - | Sil.Sizeof (Sil.Tarray (Sil.Tint ik, _), Some l, _) - when Sil.ikind_is_char ik && !Config.curr_language = Config.Clang -> + | Sil.Sizeof (Typ.Tarray (Typ.Tint ik, _), Some l, _) + when Typ.ikind_is_char ik && !Config.curr_language = Config.Clang -> eval l - | Sil.Sizeof (Sil.Tarray (Sil.Tint ik, Some l), _, _) - when Sil.ikind_is_char ik && !Config.curr_language = Config.Clang -> + | Sil.Sizeof (Typ.Tarray (Typ.Tint ik, Some l), _, _) + when Typ.ikind_is_char ik && !Config.curr_language = Config.Clang -> Sil.Const (Sil.Cint l) | Sil.Sizeof _ -> e @@ -610,7 +610,7 @@ let sym_eval abs e = | _ -> Sil.BinOp (ominus, x, y) in (* 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 (Sil.typ_equal elt) false (Sil.get_extensible_array_element_typ typ) in + Option.map_default (Typ.equal elt) false (Typ.get_extensible_array_element_typ typ) in begin match e1', e2' with (* pattern for arrays and extensible structs: @@ -729,13 +729,13 @@ let sym_eval abs e = Sil.exp_int (IntLit.div n m) | Sil.Const (Sil.Cfloat v), Sil.Const (Sil.Cfloat w) -> Sil.exp_float (v /.w) - | Sil.Sizeof (Sil.Tarray (elt, _), Some len, _), Sil.Sizeof (elt2, None, _) + | Sil.Sizeof (Typ.Tarray (elt, _), Some len, _), Sil.Sizeof (elt2, None, _) (* pattern: sizeof(elt[len]) / sizeof(elt) = len *) - when Sil.typ_equal elt elt2 -> + when Typ.equal elt elt2 -> len - | Sil.Sizeof (Sil.Tarray (elt, Some len), None, _), Sil.Sizeof (elt2, None, _) + | Sil.Sizeof (Typ.Tarray (elt, Some len), None, _), Sil.Sizeof (elt2, None, _) (* pattern: sizeof(elt[len]) / sizeof(elt) = len *) - when Sil.typ_equal elt elt2 -> + when Typ.equal elt elt2 -> Sil.Const (Sil.Cint len) | _ -> if abs then Sil.exp_get_undefined false else Sil.BinOp (Sil.Div, e1', e2') @@ -1007,7 +1007,7 @@ let atom_normalize sub a0 = (* n1-e1 == n2 -> e1==n1-n2 *) (e1, Sil.exp_int (n1 -- n2)) | Sil.Lfield (e1', fld1, _), Sil.Lfield (e2', fld2, _) -> - if Sil.fld_equal fld1 fld2 + if Ident.fieldname_equal fld1 fld2 then normalize_eq (e1', e2') else eq | Sil.Lindex (e1', idx1), Sil.Lindex (e2', idx2) -> @@ -1090,14 +1090,14 @@ let rec create_strexp_of_type tenvo struct_init_mode typ len inst = if !Config.curr_language = Config.Java && inst = Sil.Ialloc then match typ with - | Sil.Tfloat _ -> Sil.Const (Sil.Cfloat 0.0) + | Typ.Tfloat _ -> Sil.Const (Sil.Cfloat 0.0) | _ -> Sil.exp_zero else create_fresh_var () in match typ, len with - | (Sil.Tint _ | Sil.Tfloat _ | Sil.Tvoid | Sil.Tfun _ | Sil.Tptr _), None -> + | (Typ.Tint _ | Typ.Tfloat _ | Typ.Tvoid | Typ.Tfun _ | Typ.Tptr _), None -> Sil.Eexp (init_value (), inst) - | Sil.Tstruct { Sil.instance_fields }, _ -> ( + | Typ.Tstruct { Typ.instance_fields }, _ -> ( match struct_init_mode with | No_init -> Sil.Estruct ([], inst) @@ -1105,22 +1105,22 @@ let rec create_strexp_of_type tenvo struct_init_mode typ len inst = (* 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 Sil.is_objc_ref_counter_field (fld, t, a) then + if Typ.is_objc_ref_counter_field (fld, t, a) then ((fld, Sil.Eexp (Sil.exp_one, inst)) :: flds, None) else ((fld, create_strexp_of_type tenvo struct_init_mode t len inst) :: flds, None) in let flds, _ = IList.fold_right f instance_fields ([], len) in Sil.Estruct (flds, inst) ) - | Sil.Tarray (_, len_opt), None -> + | Typ.Tarray (_, len_opt), None -> let len = match len_opt with | None -> Sil.exp_get_undefined false | Some len -> Sil.Const (Sil.Cint len) in Sil.Earray (len, [], inst) - | Sil.Tarray _, Some len -> + | Typ.Tarray _, Some len -> Sil.Earray (len, [], inst) - | Sil.Tvar _, _ - | (Sil.Tint _ | Sil.Tfloat _ | Sil.Tvoid | Sil.Tfun _ | Sil.Tptr _), Some _ -> + | Typ.Tvar _, _ + | (Typ.Tint _ | Typ.Tfloat _ | Typ.Tvoid | Typ.Tfun _ | Typ.Tptr _), Some _ -> assert false (** Sil.Construct a pointsto. *) @@ -1163,22 +1163,22 @@ let rec hpred_normalize sub hpred = let normalized_cnt = strexp_normalize sub cnt in let normalized_te = texp_normalize sub te in begin match normalized_cnt, normalized_te with - | Sil.Earray (Sil.Sizeof _ as size, [], inst), Sil.Sizeof (Sil.Tarray _, _, _) -> + | Sil.Earray (Sil.Sizeof _ as size, [], inst), Sil.Sizeof (Typ.Tarray _, _, _) -> (* check for an empty array whose size expression is (Sizeof type), and turn the array into a strexp of the given type *) let hpred' = mk_ptsto_exp None Fld_init (root, size, None) inst in replace_hpred hpred' | ( Sil.Earray (Sil.BinOp (Sil.Mult, Sil.Sizeof (t, None, st1), x), esel, inst) | Sil.Earray (Sil.BinOp (Sil.Mult, x, Sil.Sizeof (t, None, st1)), esel, inst)), - Sil.Sizeof (Sil.Tarray (elt, _) as arr, _, _) - when Sil.typ_equal t elt -> + Sil.Sizeof (Typ.Tarray (elt, _) as arr, _, _) + when Typ.equal t elt -> let len = Some x in let hpred' = mk_ptsto_exp None Fld_init (root, Sil.Sizeof (arr, len, st1), None) inst in replace_hpred (replace_array_contents hpred' esel) | ( Sil.Earray (Sil.BinOp (Sil.Mult, Sil.Sizeof (t, Some len, st1), x), esel, inst) | Sil.Earray (Sil.BinOp (Sil.Mult, x, Sil.Sizeof (t, Some len, st1)), esel, inst)), - Sil.Sizeof (Sil.Tarray (elt, _) as arr, _, _) - when Sil.typ_equal t elt -> + Sil.Sizeof (Typ.Tarray (elt, _) as arr, _, _) + when Typ.equal t elt -> let len = Some (Sil.BinOp(Sil.Mult, x, len)) in let hpred' = mk_ptsto_exp None Fld_init (root, Sil.Sizeof (arr, len, st1), None) inst in replace_hpred (replace_array_contents hpred' esel) @@ -1291,8 +1291,8 @@ let rec pi_sorted_remove_redundant = function let sigma_get_unsigned_exps sigma = let uexps = ref [] in let do_hpred = function - | Sil.Hpointsto (_, Sil.Eexp (e, _), Sil.Sizeof (Sil.Tint ik, _, _)) - when Sil.ikind_is_unsigned ik -> + | Sil.Hpointsto (_, Sil.Eexp (e, _), Sil.Sizeof (Typ.Tint ik, _, _)) + when Typ.ikind_is_unsigned ik -> uexps := e :: !uexps | _ -> () in IList.iter do_hpred sigma; @@ -1391,11 +1391,11 @@ let lexp_normalize_prop p lexp = to ensure the soundness of this collapsing. *) let exp_collapse_consecutive_indices_prop typ exp = let typ_is_base = function - | Sil.Tint _ | Sil.Tfloat _ | Sil.Tstruct _ | Sil.Tvoid | Sil.Tfun _ -> true + | Typ.Tint _ | Typ.Tfloat _ | Typ.Tstruct _ | Typ.Tvoid | Typ.Tfun _ -> true | _ -> false in let typ_is_one_step_from_base = match typ with - | Sil.Tptr (t, _) | Sil.Tarray (t, _) -> typ_is_base t + | Typ.Tptr (t, _) | Typ.Tarray (t, _) -> typ_is_base t | _ -> false in let rec exp_remove e0 = match e0 with @@ -1966,7 +1966,7 @@ type arith_problem = | Div0 of Sil.exp (* unary minus of unsigned type applied to the given expression *) - | UminusUnsigned of Sil.exp * Sil.typ + | UminusUnsigned of Sil.exp * Typ.t (** Look for an arithmetic problem in [exp] *) let find_arithmetic_problem proc_node_session prop exp = @@ -1982,8 +1982,8 @@ let find_arithmetic_problem proc_node_session prop exp = let rec walk = function | Sil.Var _ -> () | Sil.UnOp (Sil.Neg, e, Some ( - (Sil.Tint - (Sil.IUChar | Sil.IUInt | Sil.IUShort | Sil.IULong | Sil.IULongLong) as typ))) -> + (Typ.Tint + (Typ.IUChar | Typ.IUInt | Typ.IUShort | Typ.IULong | Typ.IULongLong) as typ))) -> uminus_unsigned := (e, typ) :: !uminus_unsigned | Sil.UnOp(_, e, _) -> walk e | Sil.BinOp(op, e1, e2) -> @@ -2821,7 +2821,7 @@ let find_equal_formal_path e prop = match strexp with | Sil.Eexp (exp2, _) when Sil.exp_equal exp2 e -> (match find_in_sigma exp1 seen_hpreds with - | Some exp' -> Some (Sil.Lfield (exp', field, Sil.Tvoid)) + | Some exp' -> Some (Sil.Lfield (exp', field, Typ.Tvoid)) | None -> None) | _ -> None) fields None | _ -> None) (get_sigma prop) None in @@ -3008,7 +3008,7 @@ let prop_replace_sub sub p = { p with sub = nsub } let unstructured_type = function - | Sil.Tstruct _ | Sil.Tarray _ -> false + | Typ.Tstruct _ | Typ.Tarray _ -> false | _ -> true let rec pp_ren pe f = function diff --git a/infer/src/backend/prop.mli b/infer/src/backend/prop.mli index 75e297790..31d16455b 100644 --- a/infer/src/backend/prop.mli +++ b/infer/src/backend/prop.mli @@ -165,7 +165,7 @@ type arith_problem = | Div0 of Sil.exp (* unary minus of unsigned type applied to the given expression *) - | UminusUnsigned of Sil.exp * Sil.typ + | UminusUnsigned of Sil.exp * Typ.t (** Look for an arithmetic problem in [exp] *) val find_arithmetic_problem : path_pos -> normal t -> Sil.exp -> arith_problem option * normal t @@ -181,7 +181,7 @@ val exp_normalize_noabs : Sil.subst -> Sil.exp -> Sil.exp (** Collapse consecutive indices that should be added. For instance, this function reduces x[1][1] to x[2]. The [typ] argument is used to ensure the soundness of this collapsing. *) -val exp_collapse_consecutive_indices_prop : Sil.typ -> Sil.exp -> Sil.exp +val exp_collapse_consecutive_indices_prop : Typ.t -> Sil.exp -> Sil.exp (** Normalize [exp] used for the address of a heap cell. This normalization does not combine two offsets inside [exp]. *) @@ -222,7 +222,7 @@ val mk_eq : exp -> exp -> atom (** create a strexp of the given type, populating the structures if [expand_structs] is true *) val create_strexp_of_type : - Tenv.t option -> struct_init_mode -> Sil.typ -> Sil.exp option -> Sil.inst -> Sil.strexp + Tenv.t option -> struct_init_mode -> Typ.t -> Sil.exp option -> Sil.inst -> Sil.strexp (** Construct a pointsto. *) val mk_ptsto : exp -> strexp -> exp -> hpred @@ -320,7 +320,7 @@ val add_or_replace_exp_attribute_check_changed : (Sil.attribute -> Sil.attribute val add_or_replace_exp_attribute : normal t -> exp -> attribute -> normal t (** mark Sil.Var's or Sil.Lvar's as undefined *) -val mark_vars_as_undefined : normal t -> Sil.exp list -> Procname.t -> Sil.item_annotation -> +val mark_vars_as_undefined : normal t -> Sil.exp list -> Procname.t -> Typ.item_annotation -> Location.t -> Sil.path_pos -> normal t (** Remove an attribute from all the atoms in the heap *) @@ -501,7 +501,7 @@ val compute_reachable_hpreds : hpred list -> Sil.ExpSet.t -> Sil.HpredSet.t * Si (** if possible, produce a (fieldname, typ) path from one of the [src_exps] to [snk_exp] using [reachable_hpreds]. *) val get_fld_typ_path_opt : Sil.ExpSet.t -> Sil.exp -> Sil.HpredSet.t -> - (Ident.fieldname option * Sil.typ) list option + (Ident.fieldname option * Typ.t) list option (** filter [pi] by removing the pure atoms that do not contain an expression in [exps] *) val compute_reachable_atoms : pi -> Sil.ExpSet.t -> pi diff --git a/infer/src/backend/propgraph.ml b/infer/src/backend/propgraph.ml index d78a3d5d8..9a6810f50 100644 --- a/infer/src/backend/propgraph.ml +++ b/infer/src/backend/propgraph.ml @@ -131,7 +131,7 @@ let rec compute_sexp_diff (se1: Sil.strexp) (se2: Sil.strexp) : Obj.t list = mat and compute_fsel_diff fsel1 fsel2 : Obj.t list = match fsel1, fsel2 with | ((f1, se1):: fsel1'), (((f2, se2) as x):: fsel2') -> - (match Sil.fld_compare f1 f2 with + (match Ident.fieldname_compare f1 f2 with | n when n < 0 -> compute_fsel_diff fsel1' fsel2 | 0 -> compute_sexp_diff se1 se2 @ compute_fsel_diff fsel1' fsel2' | _ -> (Obj.repr x) :: compute_fsel_diff fsel1 fsel2') diff --git a/infer/src/backend/prover.ml b/infer/src/backend/prover.ml index 79864d241..bf297f71d 100644 --- a/infer/src/backend/prover.ml +++ b/infer/src/backend/prover.ml @@ -41,8 +41,8 @@ let rec remove_redundancy have_same_key acc = function else remove_redundancy have_same_key (x:: acc) l let rec is_java_class = function - | Sil.Tstruct struct_typ -> Sil.struct_typ_is_java_class struct_typ - | Sil.Tarray (inner_typ, _) | Tptr (inner_typ, _) -> is_java_class inner_typ + | Typ.Tstruct struct_typ -> Typ.struct_typ_is_java_class struct_typ + | Typ.Tarray (inner_typ, _) | Tptr (inner_typ, _) -> is_java_class inner_typ | _ -> false (** {2 Ordinary Theorem Proving} *) @@ -164,24 +164,24 @@ end (** Return true if the two types have sizes which can be compared *) let type_size_comparable t1 t2 = match t1, t2 with - | Sil.Tint _, Sil.Tint _ -> true + | Typ.Tint _, Typ.Tint _ -> true | _ -> false (** Compare the size of comparable types *) let type_size_compare t1 t2 = let ik_compare ik1 ik2 = let ik_size = function - | Sil.IChar | Sil.ISChar | Sil.IUChar | Sil.IBool -> 1 - | Sil.IShort | Sil.IUShort -> 2 - | Sil.IInt | Sil.IUInt -> 3 - | Sil.ILong | Sil.IULong -> 4 - | Sil.ILongLong | Sil.IULongLong -> 5 - | Sil.I128 | Sil.IU128 -> 6 in + | Typ.IChar | Typ.ISChar | Typ.IUChar | Typ.IBool -> 1 + | Typ.IShort | Typ.IUShort -> 2 + | Typ.IInt | Typ.IUInt -> 3 + | Typ.ILong | Typ.IULong -> 4 + | Typ.ILongLong | Typ.IULongLong -> 5 + | Typ.I128 | Typ.IU128 -> 6 in let n1 = ik_size ik1 in let n2 = ik_size ik2 in n1 - n2 in match t1, t2 with - | Sil.Tint ik1, Sil.Tint ik2 -> + | Typ.Tint ik1, Typ.Tint ik2 -> Some (ik_compare ik1 ik2) | _ -> None @@ -371,7 +371,7 @@ end = struct let add_lt_minus1_e e = lts := (Sil.exp_minus_one, e)::!lts in let texp_is_unsigned = function - | Sil.Sizeof (Sil.Tint ik, _, _) -> Sil.ikind_is_unsigned ik + | Sil.Sizeof (Typ.Tint ik, _, _) -> Typ.ikind_is_unsigned ik | _ -> false in let strexp_lt_minus1 = function | Sil.Eexp (e, _) -> add_lt_minus1_e e @@ -1233,7 +1233,8 @@ let array_len_imply calc_missing subs len1 len2 indices2 = [se1[sub1]] is an instance of [se2[sub2]]. Raise IMPL_FALSE if not possible. *) let rec sexp_imply source calc_index_frame calc_missing subs se1 se2 typ2 : subst2 * (Sil.strexp option) * (Sil.strexp option) = - (* L.d_str "sexp_imply "; Sil.d_sexp se1; L.d_str " "; Sil.d_sexp se2; L.d_str " : "; Sil.d_typ_full typ2; L.d_ln(); *) + (* L.d_str "sexp_imply "; Sil.d_sexp se1; L.d_str " "; Sil.d_sexp se2; + L.d_str " : "; Typ.d_full typ2; L.d_ln(); *) match se1, se2 with | Sil.Eexp (e1, _), Sil.Eexp (e2, _) -> (exp_imply calc_missing subs e1 e2, None, None) @@ -1280,10 +1281,10 @@ let rec sexp_imply source calc_index_frame calc_missing subs se1 se2 typ2 : subs sexp_imply source calc_index_frame calc_missing subs se1' se2 typ2 | Sil.Earray (len, _, _), Sil.Eexp (_, inst) -> let se2' = Sil.Earray (len, [(Sil.exp_zero, se2)], inst) in - let typ2' = Sil.Tarray (typ2, None) 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 Sil.struct_typ_fld, Sil.Lfield, - Sil.struct_typ_fld, or Sil.array_typ_elem. None of these are sensitive to the length field + argument is only used by eventually passing its value to Typ.struct_typ_fld, Sil.Lfield, + Typ.struct_typ_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 source true calc_missing subs se1 se2' typ2' (* calculate index_frame because the rhs is a singleton array *) | _ -> @@ -1297,7 +1298,7 @@ and struct_imply source calc_missing subs fsel1 fsel2 typ2 : subst2 * ((Ident.fi begin match Ident.fieldname_compare f1 f2 with | 0 -> - let typ' = Sil.struct_typ_fld (Some Sil.Tvoid) f2 typ2 in + let typ' = Typ.struct_typ_fld (Some Typ.Tvoid) f2 typ2 in let subs', se_frame, se_missing = sexp_imply (Sil.Lfield (source, f2, typ2)) false calc_missing subs se1 se2 typ' in let subs'', fld_frame, fld_missing = struct_imply source calc_missing subs' fsel1' fsel2' typ2 in let fld_frame' = match se_frame with @@ -1311,14 +1312,14 @@ and struct_imply source calc_missing subs fsel1 fsel2 typ2 : subst2 * ((Ident.fi let subs', fld_frame, fld_missing = struct_imply source calc_missing subs fsel1' fsel2 typ2 in subs', ((f1, se1) :: fld_frame), fld_missing | _ -> - let typ' = Sil.struct_typ_fld (Some Sil.Tvoid) f2 typ2 in + let typ' = Typ.struct_typ_fld (Some Typ.Tvoid) f2 typ2 in let subs' = sexp_imply_nolhs (Sil.Lfield (source, f2, typ2)) calc_missing subs se2 typ' in let subs', fld_frame, fld_missing = struct_imply source calc_missing subs' fsel1 fsel2' typ2 in let fld_missing' = (f2, se2) :: fld_missing in subs', fld_frame, fld_missing' end | [], (f2, se2) :: fsel2' -> - let typ' = Sil.struct_typ_fld (Some Sil.Tvoid) f2 typ2 in + let typ' = Typ.struct_typ_fld (Some Typ.Tvoid) f2 typ2 in let subs' = sexp_imply_nolhs (Sil.Lfield (source, f2, typ2)) calc_missing subs se2 typ' in let subs'', fld_frame, fld_missing = struct_imply source calc_missing subs' [] fsel2' typ2 in subs'', fld_frame, (f2, se2):: fld_missing @@ -1326,7 +1327,7 @@ and struct_imply source calc_missing subs fsel1 fsel2 typ2 : subst2 * ((Ident.fi and array_imply source calc_index_frame calc_missing subs esel1 esel2 typ2 : subst2 * ((Sil.exp * Sil.strexp) list) * ((Sil.exp * Sil.strexp) list) = - let typ_elem = Sil.array_typ_elem (Some Sil.Tvoid) typ2 in + let typ_elem = Typ.array_elem (Some Typ.Tvoid) typ2 in match esel1, esel2 with | _,[] -> subs, esel1, [] | (e1, se1) :: esel1', (e2, se2) :: esel2' -> @@ -1429,19 +1430,19 @@ let expand_hpred_pointer calc_index_frame hpred : bool * bool * Sil.hpred = let rec expand changed calc_index_frame hpred = match hpred with | Sil.Hpointsto (Sil.Lfield (e, fld, typ_fld), se, t) -> let t' = match t, typ_fld with - | _, Sil.Tstruct _ -> (* the struct type of fld is known *) + | _, Typ.Tstruct _ -> (* the struct type of fld is known *) Sil.Sizeof (typ_fld, None, Sil.Subtype.exact) | Sil.Sizeof (t1, len, st), _ -> (* the struct type of fld is not known -- typically Tvoid *) Sil.Sizeof - (Sil.Tstruct - { Sil.instance_fields = [(fld, t1, Sil.item_annotation_empty)]; + (Typ.Tstruct + { Typ.instance_fields = [(fld, t1, Typ.item_annotation_empty)]; static_fields = []; csu = Csu.Struct; struct_name = None; - Sil.superclasses = []; - Sil.def_methods = []; - Sil.struct_annotations = Sil.item_annotation_empty; + Typ.superclasses = []; + Typ.def_methods = []; + Typ.struct_annotations = Typ.item_annotation_empty; }, len, st) (* None as we don't know the stuct name *) | _ -> raise (Failure "expand_hpred_pointer: Unexpected non-sizeof type in Lfield") in @@ -1449,7 +1450,7 @@ let expand_hpred_pointer calc_index_frame hpred : bool * bool * Sil.hpred = expand true true hpred' | Sil.Hpointsto (Sil.Lindex (e, ind), se, t) -> let t' = match t with - | Sil.Sizeof (t_, len, st) -> Sil.Sizeof (Sil.Tarray (t_, None), len, st) + | Sil.Sizeof (t_, len, st) -> Sil.Sizeof (Typ.Tarray (t_, None), len, st) | _ -> raise (Failure "expand_hpred_pointer: Unexpected non-sizeof type in Lindex") in let len = match t' with | Sil.Sizeof (_, Some len, _) -> len @@ -1476,9 +1477,9 @@ struct let is_interface tenv class_name = match Tenv.lookup tenv class_name with - | Some ({ Sil.csu = Csu.Class Csu.Java; struct_name = Some _ } as struct_typ) -> - (IList.length struct_typ.Sil.instance_fields = 0) && - (IList.length struct_typ.Sil.def_methods = 0) + | Some ({ Typ.csu = Csu.Class Csu.Java; struct_name = Some _ } as struct_typ) -> + (IList.length struct_typ.Typ.instance_fields = 0) && + (IList.length struct_typ.Typ.def_methods = 0) | _ -> false let is_root_class class_name = @@ -1494,7 +1495,7 @@ struct let rec check cn = Typename.equal cn c2 || is_root_class c2 || match Tenv.lookup tenv cn with - | Some ({ Sil.struct_name = Some _; csu = Csu.Class _; superclasses }) -> + | Some ({ Typ.struct_name = Some _; csu = Csu.Class _; superclasses }) -> IList.exists check superclasses | _ -> false in check c1 @@ -1506,28 +1507,28 @@ struct (** check that t1 and t2 are the same primitive type *) let check_subtype_basic_type t1 t2 = match t2 with - | Sil.Tint Sil.IInt | Sil.Tint Sil.IBool - | Sil.Tint Sil.IChar | Sil.Tfloat Sil.FDouble - | Sil.Tfloat Sil.FFloat | Sil.Tint Sil.ILong - | Sil.Tint Sil.IShort -> Sil.typ_equal t1 t2 + | Typ.Tint Typ.IInt | Typ.Tint Typ.IBool + | Typ.Tint Typ.IChar | Typ.Tfloat Typ.FDouble + | Typ.Tfloat Typ.FFloat | Typ.Tint Typ.ILong + | Typ.Tint Typ.IShort -> Typ.equal t1 t2 | _ -> false (** check if t1 is a subtype of t2, in Java *) let rec check_subtype_java tenv t1 t2 = match t1, t2 with - | Sil.Tstruct { Sil.csu = Csu.Class Csu.Java; struct_name = Some c1 }, - Sil.Tstruct { Sil.csu = Csu.Class Csu.Java; struct_name = Some c2 } -> + | Typ.Tstruct { Typ.csu = Csu.Class Csu.Java; struct_name = Some c1 }, + Typ.Tstruct { Typ.csu = Csu.Class Csu.Java; struct_name = Some c2 } -> let cn1 = Typename.TN_csu (Csu.Class Csu.Java, c1) and cn2 = Typename.TN_csu (Csu.Class Csu.Java, c2) in check_subclass tenv cn1 cn2 - | Sil.Tarray (dom_type1, _), Sil.Tarray (dom_type2, _) -> + | Typ.Tarray (dom_type1, _), Typ.Tarray (dom_type2, _) -> check_subtype_java tenv dom_type1 dom_type2 - | Sil.Tptr (dom_type1, _), Sil.Tptr (dom_type2, _) -> + | Typ.Tptr (dom_type1, _), Typ.Tptr (dom_type2, _) -> check_subtype_java tenv dom_type1 dom_type2 - | Sil.Tarray _, Sil.Tstruct { Sil.csu = Csu.Class Csu.Java; struct_name = Some c2 } -> + | Typ.Tarray _, Typ.Tstruct { Typ.csu = Csu.Class Csu.Java; struct_name = Some c2 } -> let cn2 = Typename.TN_csu (Csu.Class Csu.Java, c2) in Typename.equal cn2 serializable_type || Typename.equal cn2 cloneable_type @@ -1536,7 +1537,7 @@ struct let get_cpp_objc_type_name t = match t with - | Sil.Tstruct { Sil.csu = Csu.Class csu; struct_name = Some c } + | Typ.Tstruct { Typ.csu = Csu.Class csu; struct_name = Some c } when csu = Csu.CPP || csu = Csu.Objc -> Some (Typename.TN_csu (Csu.Class csu, c)) | _ -> None @@ -1553,20 +1554,20 @@ struct let rec case_analysis_type_java tenv (t1, st1) (t2, st2) = match t1, t2 with - | Sil.Tstruct { Sil.csu = Csu.Class Csu.Java; struct_name = Some c1 }, - Sil.Tstruct { Sil.csu = Csu.Class Csu.Java; struct_name = Some c2 } -> + | Typ.Tstruct { Typ.csu = Csu.Class Csu.Java; struct_name = Some c1 }, + Typ.Tstruct { Typ.csu = Csu.Class Csu.Java; struct_name = Some c2 } -> let cn1 = Typename.TN_csu (Csu.Class Csu.Java, c1) and cn2 = Typename.TN_csu (Csu.Class Csu.Java, c2) in Sil.Subtype.case_analysis (cn1, st1) (cn2, st2) (check_subclass tenv) (is_interface tenv) - | Sil.Tarray (dom_type1, _), Sil.Tarray (dom_type2, _) -> + | Typ.Tarray (dom_type1, _), Typ.Tarray (dom_type2, _) -> case_analysis_type_java tenv (dom_type1, st1) (dom_type2, st2) - | Sil.Tptr (dom_type1, _), Sil.Tptr (dom_type2, _) -> + | Typ.Tptr (dom_type1, _), Typ.Tptr (dom_type2, _) -> case_analysis_type_java tenv (dom_type1, st1) (dom_type2, st2) - | Sil.Tstruct { Sil.csu = Csu.Class Csu.Java; struct_name = Some c1 }, Sil.Tarray _ -> + | Typ.Tstruct { Typ.csu = Csu.Class Csu.Java; struct_name = Some c1 }, Typ.Tarray _ -> let cn1 = Typename.TN_csu (Csu.Class Csu.Java, c1) in if (Typename.equal cn1 serializable_type || Typename.equal cn1 cloneable_type @@ -1628,13 +1629,13 @@ let cast_exception tenv texp1 texp2 e1 subs = Note: [pname] wil never be included in the returned result *) let get_overrides_of tenv supertype pname = let typ_has_method pname = function - | Sil.Tstruct { Sil.def_methods } -> + | Typ.Tstruct { Typ.def_methods } -> IList.exists (fun m -> Procname.equal pname m) def_methods | _ -> false in let gather_overrides tname struct_typ overrides_acc = - let typ = Sil.Tstruct struct_typ in + let typ = Typ.Tstruct struct_typ in (* get all types in the type environment that are non-reflexive subtypes of [supertype] *) - if not (Sil.typ_equal typ supertype) && Subtyping_check.check_subtype tenv typ supertype then + if not (Typ.equal typ supertype) && Subtyping_check.check_subtype tenv typ supertype then (* only select the ones that implement [pname] as overrides *) let resolved_pname = Procname.replace_class pname (Typename.name tname) in @@ -1646,7 +1647,7 @@ let get_overrides_of tenv supertype pname = (** Check the equality of two types ignoring flags in the subtyping components *) let texp_equal_modulo_subtype_flag texp1 texp2 = match texp1, texp2 with | Sil.Sizeof (t1, len1, st1), Sil.Sizeof (t2, len2, st2) -> - Sil.typ_equal t1 t2 + Typ.equal t1 t2 && (opt_equal Sil.exp_equal len1 len2) && Sil.Subtype.equal_modulo_flag st1 st2 | _ -> Sil.exp_equal texp1 texp2 @@ -1657,15 +1658,15 @@ let texp_imply tenv subs texp1 texp2 e1 calc_missing = (* classes and arrays in Java, and just classes in C++ and ObjC *) let types_subject_to_dynamic_cast = match texp1, texp2 with - | Sil.Sizeof ((Sil.Tstruct _) as typ1, _, _), Sil.Sizeof (Sil.Tstruct _, _, _) - | Sil.Sizeof ((Sil.Tarray _) as typ1, _, _), Sil.Sizeof (Sil.Tarray _, _, _) - | Sil.Sizeof ((Sil.Tarray _) as typ1, _, _), Sil.Sizeof (Sil.Tstruct _, _, _) - | Sil.Sizeof ((Sil.Tstruct _) as typ1, _, _), Sil.Sizeof (Sil.Tarray _, _, _) + | Sil.Sizeof ((Typ.Tstruct _) as typ1, _, _), Sil.Sizeof (Typ.Tstruct _, _, _) + | Sil.Sizeof ((Typ.Tarray _) as typ1, _, _), Sil.Sizeof (Typ.Tarray _, _, _) + | Sil.Sizeof ((Typ.Tarray _) as typ1, _, _), Sil.Sizeof (Typ.Tstruct _, _, _) + | Sil.Sizeof ((Typ.Tstruct _) as typ1, _, _), Sil.Sizeof (Typ.Tarray _, _, _) when is_java_class typ1 -> true | Sil.Sizeof (typ1, _, _), Sil.Sizeof (typ2, _, _) -> - (Sil.is_cpp_class typ1 && Sil.is_cpp_class typ2) || - (Sil.is_objc_class typ1 && Sil.is_objc_class typ2) + (Typ.is_cpp_class typ1 && Typ.is_cpp_class typ2) || + (Typ.is_objc_class typ1 && Typ.is_objc_class typ2) | _ -> false in if types_subject_to_dynamic_cast then begin @@ -1723,14 +1724,14 @@ let handle_parameter_subtype tenv prop1 sigma2 subs (e1, se1, texp1) (se2, texp2 | _ -> false in if IList.exists filter sigma2 then !sub_opt else None in let add_subtype () = match texp1, texp2, se1, se2 with - | Sil.Sizeof (Sil.Tptr (t1_, _), None, _), Sil.Sizeof (Sil.Tptr (t2_, _), None, _), + | Sil.Sizeof (Typ.Tptr (t1_, _), None, _), Sil.Sizeof (Typ.Tptr (t2_, _), None, _), Sil.Eexp (e1', _), Sil.Eexp (e2', _) when not (is_allocated_lhs e1') -> begin let t1, t2 = Tenv.expand_type tenv t1_, Tenv.expand_type tenv t2_ in match type_rhs e2' with | Some (t2_ptsto, len2, sub2) -> - if not (Sil.typ_equal t1 t2) && Subtyping_check.check_subtype tenv t1 t2 + if not (Typ.equal t1 t2) && Subtyping_check.check_subtype tenv t1 t2 then begin let pos_type_opt, _ = Subtyping_check.subtype_case_analysis tenv @@ -1765,7 +1766,7 @@ let rec hpred_imply tenv calc_index_frame calc_missing subs prop1 sigma2 hpred2 (match Prop.prop_iter_current iter1' with | Sil.Hpointsto (e1, se1, texp1), _ -> (try - let typ2 = Sil.texp_to_typ (Some Sil.Tvoid) texp2 in + let typ2 = Sil.texp_to_typ (Some Typ.Tvoid) texp2 in let typing_frame, typing_missing = texp_imply tenv subs texp1 texp2 e1 calc_missing in let se1' = sexp_imply_preprocess se1 texp1 se2 in let subs', fld_frame, fld_missing = sexp_imply e1 calc_index_frame calc_missing subs se1' se2 typ2 in @@ -1966,14 +1967,14 @@ and sigma_imply tenv calc_index_frame calc_missing subs prop1 sigma2 : (subst2 * let const_string_texp = match !Config.curr_language with | Config.Clang -> - Sil.Sizeof (Sil.Tarray (Sil.Tint Sil.IChar, Some len), None, Sil.Subtype.exact) + Sil.Sizeof (Typ.Tarray (Typ.Tint Typ.IChar, Some len), None, Sil.Subtype.exact) | Config.Java -> let object_type = Typename.TN_csu (Csu.Class Csu.Java, Mangled.from_string "java.lang.String") in let typ = match Tenv.lookup tenv object_type with | Some typ -> typ | None -> assert false in - Sil.Sizeof (Sil.Tstruct typ, None, Sil.Subtype.exact) in + Sil.Sizeof (Typ.Tstruct typ, None, Sil.Subtype.exact) in Sil.Hpointsto (root, sexp, const_string_texp) in let mk_constant_class_hpred s = (* creat an hpred from a constant class *) let root = Sil.Const (Sil.Cclass (Ident.string_to_name s)) in @@ -1985,7 +1986,7 @@ and sigma_imply tenv calc_index_frame calc_missing subs prop1 sigma2 : (subst2 * let typ = match Tenv.lookup tenv class_type with | Some typ -> typ | None -> assert false in - Sil.Sizeof (Sil.Tstruct typ, None, Sil.Subtype.exact) in + Sil.Sizeof (Typ.Tstruct typ, None, Sil.Subtype.exact) in Sil.Hpointsto (root, sexp, class_texp) in try (match move_primed_lhs_from_front subs sigma2 with @@ -2019,7 +2020,7 @@ and sigma_imply tenv calc_index_frame calc_missing subs prop1 sigma2 : (subst2 * | None -> let subs' = match hpred2' with | Sil.Hpointsto (e2, se2, te2) -> - let typ2 = Sil.texp_to_typ (Some Sil.Tvoid) te2 in + let typ2 = Sil.texp_to_typ (Some Typ.Tvoid) te2 in sexp_imply_nolhs e2 calc_missing subs se2 typ2 | _ -> subs in ProverState.add_missing_sigma [hpred2']; diff --git a/infer/src/backend/prover.mli b/infer/src/backend/prover.mli index 8fdd956f4..9187f5ebb 100644 --- a/infer/src/backend/prover.mli +++ b/infer/src/backend/prover.mli @@ -28,13 +28,13 @@ val check_disequal : Prop.normal Prop.t -> exp -> exp -> bool val check_le : Prop.normal Prop.t -> exp -> exp -> bool (** Return true if the two types have sizes which can be compared *) -val type_size_comparable : Sil.typ -> Sil.typ -> bool +val type_size_comparable : Typ.t -> Typ.t -> bool (** Check <= on the size of comparable types *) -val check_type_size_leq : Sil.typ -> Sil.typ -> bool +val check_type_size_leq : Typ.t -> Typ.t -> bool (** Check < on the size of comparable types *) -val check_type_size_lt : Sil.typ -> Sil.typ -> bool +val check_type_size_lt : Typ.t -> Typ.t -> bool (** Check whether [prop |- a]. Result [false] means "don't know". *) val check_atom : Prop.normal Prop.t -> atom -> bool @@ -99,7 +99,7 @@ module Subtyping_check : sig (** check_subtype t1 t2 checks whether t1 is a subtype of t2, given the type environment tenv. *) - val check_subtype : Tenv.t -> Sil.typ -> Sil.typ -> bool + val check_subtype : Tenv.t -> Typ.t -> Typ.t -> bool (** subtype_case_analysis tenv tecp1 texp2 performs case analysis on [texp1 <: texp2], and returns the updated types in the true and false case, if they are possible *) @@ -107,7 +107,7 @@ sig end -val get_overrides_of : Tenv.t -> Sil.typ -> Procname.t -> (typ * Procname.t) list +val get_overrides_of : Tenv.t -> Typ.t -> Procname.t -> (Typ.t * Procname.t) list diff --git a/infer/src/backend/rearrange.ml b/infer/src/backend/rearrange.ml index 5a9ed5f0d..d2657929e 100644 --- a/infer/src/backend/rearrange.ml +++ b/infer/src/backend/rearrange.ml @@ -85,12 +85,12 @@ let bounds_check pname prop len e = check_bad_index pname prop len e let rec create_struct_values pname tenv orig_prop footprint_part kind max_stamp t - (off: Sil.offset list) inst : Sil.atom list * Sil.strexp * Sil.typ = + (off: Sil.offset list) inst : Sil.atom list * Sil.strexp * Typ.t = if Config.trace_rearrange then begin L.d_increase_indent 1; L.d_strln "entering create_struct_values"; - L.d_str "typ: "; Sil.d_typ_full t; L.d_ln (); + L.d_str "typ: "; Typ.d_full t; L.d_ln (); L.d_str "off: "; Sil.d_offset_list off; L.d_ln (); L.d_ln () end; let new_id () = @@ -98,9 +98,9 @@ let rec create_struct_values pname tenv orig_prop footprint_part kind max_stamp Ident.create kind !max_stamp in let res = match t, off with - | Sil.Tstruct _, [] -> + | Typ.Tstruct _, [] -> ([], Sil.Estruct ([], inst), t) - | Sil.Tstruct ({ Sil.instance_fields; static_fields } as struct_typ ), + | Typ.Tstruct ({ Typ.instance_fields; static_fields } as struct_typ ), (Sil.Off_fld (f, _)):: off' -> let _, t', _ = try @@ -115,18 +115,18 @@ 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 instance_fields' = - IList.sort Sil.fld_typ_ann_compare (IList.map replace_typ_of_f instance_fields) in - (atoms', se, Sil.Tstruct { struct_typ with Sil.instance_fields = instance_fields'}) - | Sil.Tstruct _, (Sil.Off_index e):: off' -> + IList.sort Typ.fld_typ_ann_compare (IList.map replace_typ_of_f instance_fields) in + (atoms', se, Typ.Tstruct { struct_typ with Typ.instance_fields = instance_fields'}) + | Typ.Tstruct _, (Sil.Off_index e):: off' -> let atoms', se', res_t' = create_struct_values pname tenv orig_prop footprint_part kind max_stamp t off' inst in let e' = Sil.array_clean_new_index footprint_part e in let len = Sil.Var (new_id ()) in let se = Sil.Earray (len, [(e', se')], inst) in - let res_t = Sil.Tarray (res_t', None) in + let res_t = Typ.Tarray (res_t', None) in (Sil.Aeq(e, e') :: atoms', se, res_t) - | Sil.Tarray (t', len_), off -> + | Typ.Tarray (t', len_), off -> let len = match len_ with | None -> Sil.Var (new_id ()) | Some len -> Sil.Const (Sil.Cint len) in @@ -140,20 +140,20 @@ let rec create_struct_values pname tenv orig_prop footprint_part kind max_stamp pname tenv orig_prop footprint_part kind max_stamp t' off' inst in let e' = Sil.array_clean_new_index footprint_part e in let se = Sil.Earray (len, [(e', se')], inst) in - let res_t = Sil.Tarray (res_t', len_) in + let res_t = Typ.Tarray (res_t', len_) in (Sil.Aeq(e, e') :: atoms', se, res_t) | (Sil.Off_fld _) :: _ -> assert false ) - | Sil.Tint _, [] | Sil.Tfloat _, [] | Sil.Tvoid, [] | Sil.Tfun _, [] | Sil.Tptr _, [] -> + | Typ.Tint _, [] | Typ.Tfloat _, [] | Typ.Tvoid, [] | Typ.Tfun _, [] | Typ.Tptr _, [] -> let id = new_id () in ([], Sil.Eexp (Sil.Var id, inst), t) - | Sil.Tint _, [Sil.Off_index e] | Sil.Tfloat _, [Sil.Off_index e] - | Sil.Tvoid, [Sil.Off_index e] - | Sil.Tfun _, [Sil.Off_index e] | Sil.Tptr _, [Sil.Off_index e] -> + | Typ.Tint _, [Sil.Off_index e] | Typ.Tfloat _, [Sil.Off_index e] + | Typ.Tvoid, [Sil.Off_index e] + | Typ.Tfun _, [Sil.Off_index e] | Typ.Tptr _, [Sil.Off_index e] -> (* In this case, we lift t to the t array. *) let t' = match t with - | Sil.Tptr(t', _) -> t' + | Typ.Tptr(t', _) -> t' | _ -> t in let len = Sil.Var (new_id ()) in let atoms', se', res_t' = @@ -161,14 +161,16 @@ let rec create_struct_values pname tenv orig_prop footprint_part kind max_stamp pname tenv orig_prop footprint_part kind max_stamp t' [] inst in let e' = Sil.array_clean_new_index footprint_part e in let se = Sil.Earray (len, [(e', se')], inst) in - let res_t = Sil.Tarray (res_t', None) in + let res_t = Typ.Tarray (res_t', None) in (Sil.Aeq(e, e'):: atoms', se, res_t) - | Sil.Tint _, _ | Sil.Tfloat _, _ | Sil.Tvoid, _ | Sil.Tfun _, _ | Sil.Tptr _, _ -> - L.d_str "create_struct_values type:"; Sil.d_typ_full t; L.d_str " off: "; Sil.d_offset_list off; L.d_ln(); + | Typ.Tint _, _ | Typ.Tfloat _, _ | Typ.Tvoid, _ | Typ.Tfun _, _ | Typ.Tptr _, _ -> + L.d_str "create_struct_values type:"; Typ.d_full t; + L.d_str " off: "; Sil.d_offset_list off; L.d_ln(); raise (Exceptions.Bad_footprint __POS__) - | Sil.Tvar _, _ -> - L.d_str "create_struct_values type:"; Sil.d_typ_full t; L.d_str " off: "; Sil.d_offset_list off; L.d_ln(); + | Typ.Tvar _, _ -> + L.d_str "create_struct_values type:"; Typ.d_full t; + L.d_str " off: "; Sil.d_offset_list off; L.d_ln(); assert false in if Config.trace_rearrange then @@ -200,12 +202,12 @@ let rec _strexp_extend_values let off_new = Sil.Off_index(Sil.exp_zero):: off in _strexp_extend_values pname tenv orig_prop footprint_part kind max_stamp se typ off_new inst - | (Sil.Off_fld _) :: _, Sil.Earray _, Sil.Tarray _ -> + | (Sil.Off_fld _) :: _, Sil.Earray _, Typ.Tarray _ -> let off_new = Sil.Off_index(Sil.exp_zero):: off in _strexp_extend_values pname tenv orig_prop footprint_part kind max_stamp se typ off_new inst | (Sil.Off_fld (f, _)):: off', Sil.Estruct (fsel, inst'), - Sil.Tstruct ({ Sil.instance_fields; static_fields } as struct_typ) -> + Typ.Tstruct ({ Typ.instance_fields; static_fields } as struct_typ) -> let replace_fv new_v fv = if Ident.fieldname_equal (fst fv) f then (f, new_v) else fv in let _, typ', _ = try @@ -224,9 +226,9 @@ let rec _strexp_extend_values let res_fsel' = IList.sort Sil.fld_strexp_compare (IList.map replace_fse fsel) in let replace_fta (f, t, a) = let f', t' = replace_fv res_typ' (f, t) in (f', t', a) in let instance_fields' = - IList.sort Sil.fld_typ_ann_compare (IList.map replace_fta instance_fields) in + IList.sort Typ.fld_typ_ann_compare (IList.map replace_fta instance_fields) in let struct_typ = - Sil.Tstruct { struct_typ with Sil.instance_fields = instance_fields' } in + Typ.Tstruct { struct_typ with Typ.instance_fields = instance_fields' } in (res_atoms', Sil.Estruct (res_fsel', inst'), struct_typ) :: acc in IList.fold_left replace [] atoms_se_typ_list' with Not_found -> @@ -236,19 +238,19 @@ let rec _strexp_extend_values let res_fsel' = IList.sort Sil.fld_strexp_compare ((f, se'):: fsel) in let replace_fta (f', t', a') = if Ident.fieldname_equal f' f then (f, res_typ', a') else (f', t', a') in let instance_fields' = - IList.sort Sil.fld_typ_ann_compare (IList.map replace_fta instance_fields) in - let struct_typ = Sil.Tstruct { struct_typ with Sil.instance_fields = instance_fields' } in + IList.sort Typ.fld_typ_ann_compare (IList.map replace_fta instance_fields) in + let struct_typ = Typ.Tstruct { struct_typ with Typ.instance_fields = instance_fields' } in [(atoms', Sil.Estruct (res_fsel', inst'), struct_typ)] end | (Sil.Off_fld (_, _)):: _, _, _ -> raise (Exceptions.Bad_footprint __POS__) - | (Sil.Off_index _):: _, Sil.Eexp _, Sil.Tint _ - | (Sil.Off_index _):: _, Sil.Eexp _, Sil.Tfloat _ - | (Sil.Off_index _):: _, Sil.Eexp _, Sil.Tvoid - | (Sil.Off_index _):: _, Sil.Eexp _, Sil.Tfun _ - | (Sil.Off_index _):: _, Sil.Eexp _, Sil.Tptr _ - | (Sil.Off_index _):: _, Sil.Estruct _, Sil.Tstruct _ -> + | (Sil.Off_index _):: _, Sil.Eexp _, Typ.Tint _ + | (Sil.Off_index _):: _, Sil.Eexp _, Typ.Tfloat _ + | (Sil.Off_index _):: _, Sil.Eexp _, Typ.Tvoid + | (Sil.Off_index _):: _, Sil.Eexp _, Typ.Tfun _ + | (Sil.Off_index _):: _, Sil.Eexp _, Typ.Tptr _ + | (Sil.Off_index _):: _, Sil.Estruct _, Typ.Tstruct _ -> (* L.d_strln_color Orange "turn into an array"; *) let len = match se with | Sil.Eexp (_, Sil.Ialloc) -> Sil.exp_one (* if allocated explicitly, we know len is 1 *) @@ -256,10 +258,10 @@ let rec _strexp_extend_values if Config.type_size then Sil.exp_one (* Sil.Sizeof (typ, Sil.Subtype.exact) *) else Sil.Var (new_id ()) in let se_new = Sil.Earray (len, [(Sil.exp_zero, se)], inst) in - let typ_new = Sil.Tarray (typ, None) in + let typ_new = Typ.Tarray (typ, None) in _strexp_extend_values pname tenv orig_prop footprint_part kind max_stamp se_new typ_new off inst - | (Sil.Off_index e) :: off', Sil.Earray (len, esel, inst_arr), Sil.Tarray (typ', len_for_typ') -> + | (Sil.Off_index e) :: off', Sil.Earray (len, esel, inst_arr), Typ.Tarray (typ', len_for_typ') -> bounds_check pname orig_prop len e (State.get_loc ()); begin try @@ -270,10 +272,10 @@ let rec _strexp_extend_values let replace acc (res_atoms', res_se', res_typ') = let replace_ise ise = if Sil.exp_equal e (fst ise) then (e, res_se') else ise in let res_esel' = IList.map replace_ise esel in - if (Sil.typ_equal res_typ' typ') || (IList.length res_esel' = 1) then + if (Typ.equal res_typ' typ') || (IList.length res_esel' = 1) then ( res_atoms' , Sil.Earray (len, res_esel', inst_arr) - , Sil.Tarray (res_typ', len_for_typ') ) + , Typ.Tarray (res_typ', len_for_typ') ) :: acc else raise (Exceptions.Bad_footprint __POS__) in @@ -295,7 +297,7 @@ and array_case_analysis_index pname tenv orig_prop index off inst_arr inst = let check_sound t' = - if not (Sil.typ_equal typ_cont t' || array_cont == []) + if not (Typ.equal typ_cont t' || array_cont == []) then raise (Exceptions.Bad_footprint __POS__) in let index_in_array = IList.exists (fun (i, _) -> Prover.check_equal Prop.prop_emp index i) array_cont in @@ -306,7 +308,7 @@ and array_case_analysis_index pname tenv orig_prop if index_in_array then let array_default = Sil.Earray (array_len, array_cont, inst_arr) in - let typ_default = Sil.Tarray (typ_cont, typ_array_len) in + let typ_default = Typ.Tarray (typ_cont, typ_array_len) in [([], array_default, typ_default)] else if !Config.footprint then begin let atoms, elem_se, elem_typ = @@ -315,7 +317,7 @@ and array_case_analysis_index pname tenv orig_prop check_sound elem_typ; let cont_new = IList.sort Sil.exp_strexp_compare ((index, elem_se):: array_cont) in let array_new = Sil.Earray (array_len, cont_new, inst_arr) in - let typ_new = Sil.Tarray (elem_typ, typ_array_len) in + let typ_new = Typ.Tarray (elem_typ, typ_array_len) in [(atoms, array_new, typ_new)] end else begin @@ -328,7 +330,7 @@ and array_case_analysis_index pname tenv orig_prop check_sound elem_typ; let cont_new = IList.sort Sil.exp_strexp_compare ((index, elem_se):: array_cont) in let array_new = Sil.Earray (array_len, cont_new, inst_arr) in - let typ_new = Sil.Tarray (elem_typ, typ_array_len) in + let typ_new = Typ.Tarray (elem_typ, typ_array_len) in [(atoms, array_new, typ_new)] end in let rec handle_case acc isel_seen_rev = function @@ -343,7 +345,7 @@ and array_case_analysis_index pname tenv orig_prop let atoms_new = Sil.Aeq (index, i) :: atoms' in let isel_new = list_rev_and_concat isel_seen_rev ((i, se'):: isel_unseen) in let array_new = Sil.Earray (array_len, isel_new, inst_arr) in - let typ_new = Sil.Tarray (typ', typ_array_len) in + let typ_new = Typ.Tarray (typ', typ_array_len) in (atoms_new, array_new, typ_new):: acc' ) [] atoms_se_typ_list in let acc_new = atoms_se_typ_list' :: acc in @@ -391,7 +393,7 @@ let strexp_extend_values else off, [] in if Config.trace_rearrange then (L.d_str "entering strexp_extend_values se: "; Sil.d_sexp se; L.d_str " typ: "; - Sil.d_typ_full typ; L.d_str " off': "; Sil.d_offset_list off'; + Typ.d_full typ; L.d_str " off': "; Sil.d_offset_list off'; L.d_strln (if footprint_part then " FP" else " RE")); let atoms_se_typ_list = _strexp_extend_values @@ -438,11 +440,11 @@ let mk_ptsto_exp_footprint | Config.Clang -> Sil.Subtype.exact | Config.Java -> Sil.Subtype.subtypes in let create_ptsto footprint_part off0 = match root, off0, typ with - | Sil.Lvar pvar, [], Sil.Tfun _ -> + | Sil.Lvar pvar, [], Typ.Tfun _ -> let fun_name = Procname.from_string_c_fun (Mangled.to_string (Pvar.get_name pvar)) in let fun_exp = Sil.Const (Sil.Cfun fun_name) in ([], Prop.mk_ptsto root (Sil.Eexp (fun_exp, inst)) (Sil.Sizeof (typ, None, st))) - | _, [], Sil.Tfun _ -> + | _, [], Typ.Tfun _ -> let atoms, se, t = create_struct_values pname tenv orig_prop footprint_part Ident.kfootprint max_stamp typ off0 inst in @@ -472,7 +474,7 @@ let prop_iter_check_fields_ptsto_shallow iter lexp = (match se with | Sil.Estruct (fsel, _) -> (try - let _, se' = IList.find (fun (fld', _) -> Sil.fld_equal fld fld') fsel in + let _, se' = IList.find (fun (fld', _) -> Ident.fieldname_equal fld fld') fsel in check_offset se' off' with Not_found -> Some fld) | _ -> Some fld) @@ -621,7 +623,7 @@ let add_guarded_by_constraints prop lexp pdesc = let annot_extract_guarded_by_str (annot, _) = if Annotations.annot_ends_with annot Annotations.guarded_by then - match annot.Sil.parameters with + match annot.Typ.parameters with | [guarded_by_str] when not (excluded_guardedby_string guarded_by_str) -> Some guarded_by_str | _ -> @@ -930,14 +932,14 @@ let iter_rearrange_pe_dllseg_last recurse_on_iters default_case_iter iter para_d let type_at_offset texp off = let rec strip_offset off typ = match off, typ with | [], _ -> Some typ - | (Sil.Off_fld (f, _)):: off', Sil.Tstruct { Sil.instance_fields } -> + | (Sil.Off_fld (f, _)):: off', Typ.Tstruct { Typ.instance_fields } -> (try let typ' = (fun (_, y, _) -> y) (IList.find (fun (f', _, _) -> Ident.fieldname_equal f f') instance_fields) in strip_offset off' typ' with Not_found -> None) - | (Sil.Off_index _) :: off', Sil.Tarray (typ', _) -> + | (Sil.Off_index _) :: off', Typ.Tarray (typ', _) -> strip_offset off' typ' | _ -> None in match texp with @@ -950,10 +952,10 @@ let type_at_offset texp off = let check_type_size pname prop texp off typ_from_instr = L.d_strln_color Orange "check_type_size"; L.d_str "off: "; Sil.d_offset_list off; L.d_ln (); - L.d_str "typ_from_instr: "; Sil.d_typ_full typ_from_instr; L.d_ln (); + L.d_str "typ_from_instr: "; Typ.d_full typ_from_instr; L.d_ln (); match type_at_offset texp off with | Some typ_of_object -> - L.d_str "typ_o: "; Sil.d_typ_full typ_of_object; L.d_ln (); + L.d_str "typ_o: "; Typ.d_full typ_of_object; L.d_ln (); if Prover.type_size_comparable typ_from_instr typ_of_object && Prover.check_type_size_leq typ_from_instr typ_of_object = false then begin let deref_str = Localise.deref_str_pointer_size_mismatch typ_from_instr typ_of_object in @@ -980,12 +982,13 @@ let rec iter_rearrange pname tenv lexp typ_from_instr prop iter inst: (Sil.offset list) Prop.prop_iter list = let typ = match Sil.exp_get_offsets lexp with - | Sil.Off_fld (f, ((Sil.Tstruct _) as struct_typ)) :: _ -> (* access through field: get the struct type from the field *) + | Sil.Off_fld (f, ((Typ.Tstruct _) as struct_typ)) :: _ -> + (* access through field: get the struct type from the field *) if Config.trace_rearrange then begin L.d_increase_indent 1; L.d_str "iter_rearrange: root of lexp accesses field "; L.d_strln (Ident.fieldname_to_string f); - L.d_str " type from instruction: "; Sil.d_typ_full typ_from_instr; L.d_ln(); - L.d_str " struct type from field: "; Sil.d_typ_full struct_typ; L.d_ln(); + L.d_str " type from instruction: "; Typ.d_full typ_from_instr; L.d_ln(); + L.d_str " struct type from field: "; Typ.d_full struct_typ; L.d_ln(); L.d_decrease_indent 1; L.d_ln(); end; @@ -996,7 +999,7 @@ let rec iter_rearrange L.d_increase_indent 1; L.d_strln "entering iter_rearrange"; L.d_str "lexp: "; Sil.d_exp lexp; L.d_ln (); - L.d_str "typ: "; Sil.d_typ_full typ; L.d_ln (); + L.d_str "typ: "; Typ.d_full typ; L.d_ln (); L.d_strln "prop:"; Prop.d_prop prop; L.d_ln (); L.d_strln "iter:"; Prop.d_prop (Prop.prop_iter_to_prop iter); L.d_ln (); L.d_ln () @@ -1279,6 +1282,6 @@ let pp_off fmt off = | Sil.Off_index e -> F.fprintf fmt "%a " (Sil.pp_exp pe_text) e) off let sort_ftl ftl = - let compare (f1, _) (f2, _) = Sil.fld_compare f1 f2 in + let compare (f1, _) (f2, _) = Ident.fieldname_compare f1 f2 in IList.sort compare ftl *) diff --git a/infer/src/backend/rearrange.mli b/infer/src/backend/rearrange.mli index a28f38e35..073cf0be2 100644 --- a/infer/src/backend/rearrange.mli +++ b/infer/src/backend/rearrange.mli @@ -29,5 +29,5 @@ val check_call_to_objc_block_error : and the path (an [offsetlist]) which leads to [lexp] as the iterator state. *) val rearrange : ?report_deref_errors:bool -> Cfg.Procdesc.t -> Tenv.t -> Sil.exp -> - Sil.typ -> Prop.normal Prop.t -> + Typ.t -> Prop.normal Prop.t -> Location.t -> (Sil.offset list) Prop.prop_iter list diff --git a/infer/src/backend/serialization.ml b/infer/src/backend/serialization.ml index ccce64d7a..b610666c7 100644 --- a/infer/src/backend/serialization.ml +++ b/infer/src/backend/serialization.ml @@ -26,7 +26,7 @@ let tenv_key, summary_key, cfg_key, trace_key, cg_key, 799050016, 579094948, 972393003 (** version of the binary files, to be incremented for each change *) -let version = 25 +let version = 26 (** Retry the function while an exception filtered is thrown, diff --git a/infer/src/backend/specs.ml b/infer/src/backend/specs.ml index 11e7c93fa..7910440b3 100644 --- a/infer/src/backend/specs.ml +++ b/infer/src/backend/specs.ml @@ -324,7 +324,7 @@ module CallSiteSet = PrettyPrintable.MakePPSet(struct let pp_element = pp_call_site end) -type call_summary = CallSiteSet.t Sil.AnnotMap.t +type call_summary = CallSiteSet.t Typ.AnnotMap.t (** Payload: results of some analysis *) type payload = @@ -425,14 +425,14 @@ let get_signature summary = IList.iter (fun (p, typ) -> let pp_name f () = F.fprintf f "%a" Mangled.pp p in - let pp f () = Sil.pp_type_decl pe_text pp_name Sil.pp_exp f typ in + let pp f () = Typ.pp_decl pe_text pp_name f typ in let decl = pp_to_string pp () in s := if !s = "" then decl else !s ^ ", " ^ decl) summary.attributes.ProcAttributes.formals; let pp_procname f () = F.fprintf f "%a" Procname.pp summary.attributes.ProcAttributes.proc_name in let pp f () = - Sil.pp_type_decl pe_text pp_procname Sil.pp_exp f summary.attributes.ProcAttributes.ret_type in + Typ.pp_decl pe_text pp_procname f summary.attributes.ProcAttributes.ret_type in let decl = pp_to_string pp () in decl ^ "(" ^ !s ^ ")" diff --git a/infer/src/backend/specs.mli b/infer/src/backend/specs.mli index 73b166c50..bab411f46 100644 --- a/infer/src/backend/specs.mli +++ b/infer/src/backend/specs.mli @@ -122,7 +122,7 @@ type call_site = Procname.t * Location.t module CallSiteSet : PrettyPrintable.PPSet with type elt = call_site -type call_summary = CallSiteSet.t Sil.AnnotMap.t +type call_summary = CallSiteSet.t Typ.AnnotMap.t (** Payload: results of some analysis *) type payload = @@ -164,10 +164,10 @@ val get_proc_name : summary -> Procname.t val get_attributes : summary -> ProcAttributes.t (** Get the return type of the procedure *) -val get_ret_type : summary -> Sil.typ +val get_ret_type : summary -> Typ.t (** Get the formal paramters of the procedure *) -val get_formals : summary -> (Mangled.t * Sil.typ) list +val get_formals : summary -> (Mangled.t * Typ.t) list (** Get the flag with the given key for the procedure, if any *) val get_flag : Procname.t -> string -> string option @@ -185,7 +185,7 @@ val get_signature : summary -> string val get_specs : Procname.t -> Prop.normal spec list (** Return the specs and formal parameters for the proc in the spec table *) -val get_specs_formals : Procname.t -> Prop.normal spec list * (Mangled.t * Sil.typ) list +val get_specs_formals : Procname.t -> Prop.normal spec list * (Mangled.t * Typ.t) list (** Get the specs from the payload of the summary. *) val get_specs_from_payload : summary -> Prop.normal spec list diff --git a/infer/src/backend/symExec.ml b/infer/src/backend/symExec.ml index 7179ad811..9c083e761 100644 --- a/infer/src/backend/symExec.ml +++ b/infer/src/backend/symExec.ml @@ -17,30 +17,30 @@ module F = Format let rec fldlist_assoc fld = function | [] -> raise Not_found - | (fld', x, _):: l -> if Sil.fld_equal fld fld' then x else fldlist_assoc fld l + | (fld', x, _):: l -> if Ident.fieldname_equal fld fld' then x else fldlist_assoc fld l let rec unroll_type tenv typ off = match (typ, off) with - | Sil.Tvar _, _ -> + | Typ.Tvar _, _ -> let typ' = Tenv.expand_type tenv typ in unroll_type tenv typ' off - | Sil.Tstruct { Sil.instance_fields; static_fields }, Sil.Off_fld (fld, _) -> + | Typ.Tstruct { Typ.instance_fields; static_fields }, Sil.Off_fld (fld, _) -> begin try fldlist_assoc fld (instance_fields @ static_fields) with Not_found -> L.d_strln ".... Invalid Field Access ...."; L.d_strln ("Fld : " ^ Ident.fieldname_to_string fld); - L.d_str "Type : "; Sil.d_typ_full typ; L.d_ln (); + L.d_str "Type : "; Typ.d_full typ; L.d_ln (); raise (Exceptions.Bad_footprint __POS__) end - | Sil.Tarray (typ', _), Sil.Off_index _ -> + | Typ.Tarray (typ', _), Sil.Off_index _ -> typ' | _, Sil.Off_index (Sil.Const (Sil.Cint i)) when IntLit.iszero i -> typ | _ -> L.d_strln ".... Invalid Field Access ...."; L.d_str "Fld : "; Sil.d_offset off; L.d_ln (); - L.d_str "Type : "; Sil.d_typ_full typ; L.d_ln (); + L.d_str "Type : "; Typ.d_full typ; L.d_ln (); assert false (** Given a node, returns a list of pvar of blocks that have been nullified in the block. *) @@ -88,7 +88,7 @@ let rec apply_offlist L.d_strln ".... Invalid Field ...."; L.d_str "strexp : "; Sil.d_sexp strexp; L.d_ln (); L.d_str "offlist : "; Sil.d_offset_list offlist; L.d_ln (); - L.d_str "type : "; Sil.d_typ_full typ; L.d_ln (); + L.d_str "type : "; Typ.d_full typ; L.d_ln (); L.d_str "prop : "; Prop.d_prop p; L.d_ln (); L.d_ln () in match offlist, strexp with | [], Sil.Eexp (e, inst_curr) -> @@ -143,7 +143,7 @@ let rec apply_offlist let typ' = Tenv.expand_type tenv typ in let struct_typ = match typ' with - | Sil.Tstruct struct_typ -> + | Typ.Tstruct struct_typ -> struct_typ | _ -> assert false in let t' = unroll_type tenv typ (Sil.Off_fld (fld, fld_typ)) in @@ -153,12 +153,14 @@ let rec apply_offlist apply_offlist pdesc tenv p fp_root nullify_struct (root_lexp, se', t') offlist' f inst lookup_inst in - let replace_fse fse = if Sil.fld_equal fld (fst fse) then (fld, res_se') else fse in + let replace_fse fse = + if Ident.fieldname_equal fld (fst fse) then (fld, res_se') else fse in let res_se = Sil.Estruct (IList.map replace_fse fsel, inst') in - let replace_fta (f, t, a) = if Sil.fld_equal fld f then (fld, res_t', a) else (f, t, a) in - let instance_fields' = IList.map replace_fta struct_typ.Sil.instance_fields in + let replace_fta (f, t, a) = + if Ident.fieldname_equal fld f then (fld, res_t', a) else (f, t, a) in + let instance_fields' = IList.map replace_fta struct_typ.Typ.instance_fields in let res_t = - Sil.Tstruct { struct_typ with Sil.instance_fields = instance_fields' } in + Typ.Tstruct { struct_typ with Typ.instance_fields = instance_fields' } in (res_e', res_se, res_t, res_pred_insts_op') with Not_found -> pp_error(); @@ -174,7 +176,7 @@ let rec apply_offlist let nidx = Prop.exp_normalize_prop p idx in begin let typ' = Tenv.expand_type tenv typ in - let t', len' = match typ' with Sil.Tarray (t', len') -> (t', len') | _ -> assert false in + let t', len' = match typ' with Typ.Tarray (t', len') -> (t', len') | _ -> assert false in try let idx_ese', se' = IList.find (fun ese -> Prover.check_equal p nidx (fst ese)) esel in let res_e', res_se', res_t', res_pred_insts_op' = @@ -186,7 +188,7 @@ let rec apply_offlist then (idx_ese', res_se') else ese in let res_se = Sil.Earray (len, IList.map replace_ese esel, inst1) in - let res_t = Sil.Tarray (res_t', len') in + let res_t = Typ.Tarray (res_t', len') in (res_e', res_se, res_t, res_pred_insts_op') with Not_found -> (* return a nondeterministic value if the index is not found after rearrangement *) @@ -498,7 +500,7 @@ let resolve_method tenv class_name proc_name = let right_proc_name = Procname.replace_class proc_name (Typename.name class_name) in match Tenv.lookup tenv class_name with - | Some { Sil.csu = Csu.Class _; def_methods; superclasses } -> + | Some { Typ.csu = Csu.Class _; def_methods; superclasses } -> if method_exists right_proc_name def_methods then Some right_proc_name else @@ -526,8 +528,8 @@ let resolve_typename prop receiver_exp = | _ :: hpreds -> loop hpreds in loop (Prop.get_sigma prop) in match typexp_opt with - | Some (Sil.Sizeof (Sil.Tstruct { Sil.struct_name = None }, _, _)) -> None - | Some (Sil.Sizeof (Sil.Tstruct { Sil.csu = Csu.Class ck; struct_name = Some name }, _, _)) -> + | Some (Sil.Sizeof (Typ.Tstruct { Typ.struct_name = None }, _, _)) -> None + | Some (Sil.Sizeof (Typ.Tstruct { Typ.csu = Csu.Class ck; struct_name = Some name }, _, _)) -> Some (Typename.TN_csu (Csu.Class ck, name)) | _ -> None @@ -542,7 +544,7 @@ let resolve_virtual_pname tenv prop actuals callee_pname call_flags : Procname.t | Procname.Java pname_java -> begin match Tenv.proc_extract_declaring_class_typ tenv pname_java with - | Some struct_typ -> Sil.Tptr (Tstruct struct_typ, Pk_pointer) + | Some struct_typ -> Typ.Tptr (Tstruct struct_typ, Pk_pointer) | None -> fallback_typ end | _ -> @@ -550,7 +552,7 @@ let resolve_virtual_pname tenv prop actuals callee_pname call_flags : Procname.t let receiver_types_equal pname actual_receiver_typ = (* the type of the receiver according to the function signature *) let formal_receiver_typ = get_receiver_typ pname actual_receiver_typ in - Sil.typ_equal formal_receiver_typ actual_receiver_typ in + Typ.equal formal_receiver_typ actual_receiver_typ in let do_resolve called_pname receiver_exp actual_receiver_typ = if receiver_types_equal called_pname actual_receiver_typ then resolve receiver_exp called_pname prop @@ -823,7 +825,7 @@ let add_constraints_on_retval pdesc prop ret_exp ~has_nullable_annot typ callee_ prop (* don't assume nonnull if the procedure is annotated with @Nullable *) else match typ with - | Sil.Tptr _ -> Prop.conjoin_neq exp Sil.exp_zero prop + | Typ.Tptr _ -> Prop.conjoin_neq exp Sil.exp_zero prop | _ -> prop in let add_tainted_post ret_exp callee_pname prop = Prop.add_or_replace_exp_attribute prop ret_exp (Sil.Ataint callee_pname) in @@ -944,7 +946,7 @@ let load_ret_annots pname = let ret_annots, _ = attrs.ProcAttributes.method_annotation in ret_annots | None -> - Sil.item_annotation_empty + Typ.item_annotation_empty let execute_set ?(report_deref_errors=true) pname pdesc tenv lhs_exp typ rhs_exp loc prop_ = let execute_set_ pdesc tenv rhs_exp acc_in iter = @@ -1036,7 +1038,7 @@ let rec sym_exec tenv current_pdesc _instr (prop_: Prop.normal Prop.t) path true_branch && not skip_loop in (* in comparisons, nil is translated as (void * ) 0 rather than 0 *) let is_comparison_to_nil = function - | Sil.Cast ((Sil.Tptr (Sil.Tvoid, _)), exp) -> + | Sil.Cast ((Typ.Tptr (Typ.Tvoid, _)), exp) -> !Config.curr_language = Config.Clang && Sil.exp_is_zero exp | _ -> false in match Prop.exp_normalize_prop Prop.prop_emp cond with @@ -1052,13 +1054,13 @@ let rec sym_exec tenv current_pdesc _instr (prop_: Prop.normal Prop.t) path (* iOS: check that NSNumber *'s are not used in conditionals without comparing to nil *) let lhs_normal = Prop.exp_normalize_prop prop__ lhs in let is_nsnumber = function - | Sil.Tvar (Typename.TN_csu (Csu.Class _, name)) -> + | Typ.Tvar (Typename.TN_csu (Csu.Class _, name)) -> Mangled.to_string name = "NSNumber" | _ -> false in let lhs_is_ns_ptr () = IList.exists (function - | Sil.Hpointsto (_, Sil.Eexp (exp, _), Sil.Sizeof (Sil.Tptr (typ, _), _, _)) -> + | Sil.Hpointsto (_, Sil.Eexp (exp, _), Sil.Sizeof (Typ.Tptr (typ, _), _, _)) -> Sil.exp_equal exp lhs_normal && is_nsnumber typ | _ -> false) (Prop.get_sigma prop__) in @@ -1091,9 +1093,9 @@ let rec sym_exec tenv current_pdesc _instr (prop_: Prop.normal Prop.t) path | None -> let ret_typ = match Tenv.proc_extract_return_typ tenv callee_pname_java with - | Some (Sil.Tstruct _ as typ) -> Sil.Tptr (typ, Pk_pointer) + | Some (Typ.Tstruct _ as typ) -> Typ.Tptr (typ, Pk_pointer) | Some typ -> typ - | None -> Sil.Tvoid in + | None -> Typ.Tvoid in let ret_annots = load_ret_annots callee_pname in exec_skip_call resolved_pname ret_annots ret_typ | Some summary when call_should_be_skipped resolved_pname summary -> @@ -1121,9 +1123,9 @@ let rec sym_exec tenv current_pdesc _instr (prop_: Prop.normal Prop.t) path | None -> let ret_typ = match Tenv.proc_extract_return_typ tenv callee_pname_java with - | Some (Sil.Tstruct _ as typ) -> Sil.Tptr (typ, Pk_pointer) + | Some (Typ.Tstruct _ as typ) -> Typ.Tptr (typ, Pk_pointer) | Some typ -> typ - | None -> Sil.Tvoid in + | None -> Typ.Tvoid in let ret_annots = load_ret_annots callee_pname in exec_skip_call ret_annots ret_typ | Some summary when call_should_be_skipped pname summary -> @@ -1204,7 +1206,7 @@ let rec sym_exec tenv current_pdesc _instr (prop_: Prop.normal Prop.t) path L.d_str "Unknown function pointer "; Sil.d_exp fun_exp; L.d_strln ", returning undefined value."; let callee_pname = Procname.from_string_c_fun "__function_pointer__" in - unknown_or_scan_call ~is_scan:false None Sil.item_annotation_empty Builtin.{ + unknown_or_scan_call ~is_scan:false None Typ.item_annotation_empty Builtin.{ pdesc= current_pdesc; instr; tenv; prop_= prop_r; path; ret_ids; args= n_actual_params; proc_name= callee_pname; loc; } end @@ -1304,11 +1306,11 @@ and add_constraints_on_actuals_by_ref tenv prop actuals_by_ref callee_pname call else if !Config.footprint then let prop', abduced_strexp = match actual_typ with - | Sil.Tptr ((Sil.Tstruct _) as typ, _) -> + | Typ.Tptr ((Typ.Tstruct _) as typ, _) -> (* for struct types passed by reference, do abduction on the fields of the struct *) add_struct_value_to_footprint tenv abducted_ref_pv typ prop - | Sil.Tptr (typ, _) -> + | Typ.Tptr (typ, _) -> (* for pointer types passed by reference, do abduction directly on the pointer *) let (prop', fresh_fp_var) = add_to_footprint abducted_ref_pv typ prop in @@ -1316,7 +1318,7 @@ and add_constraints_on_actuals_by_ref tenv prop actuals_by_ref callee_pname call | typ -> failwith ("No need for abduction on non-pointer type " ^ - (Sil.typ_to_string typ)) in + (Typ.to_string typ)) in (* replace [actual] |-> _ with [actual] |-> [fresh_fp_var] *) let filtered_sigma = IList.map @@ -1353,7 +1355,7 @@ and add_constraints_on_actuals_by_ref tenv prop actuals_by_ref callee_pname call let havoc_actual_by_ref (actual, actual_typ) prop = let actual_pt_havocd_var = let havocd_var = Sil.Var (Ident.create_fresh Ident.kprimed) in - let sizeof_exp = Sil.Sizeof (Sil.typ_strip_ptr actual_typ, None, Sil.Subtype.subtypes) in + let sizeof_exp = Sil.Sizeof (Typ.strip_ptr actual_typ, None, Sil.Subtype.subtypes) in Prop.mk_ptsto actual (Sil.Eexp (havocd_var, Sil.Inone)) sizeof_exp in replace_actual_hpred actual actual_pt_havocd_var prop in IList.fold_left (fun p var -> havoc_actual_by_ref var p) prop actuals_by_ref @@ -1421,7 +1423,7 @@ and unknown_or_scan_call ~is_scan ret_type_option ret_annots let actuals_by_ref = IList.filter (function - | Sil.Lvar _, Sil.Tptr _ -> true + | Sil.Lvar _, Typ.Tptr _ -> true | _ -> false) args in let has_nullable_annot = Annotations.ia_is_nullable ret_annots in @@ -1513,8 +1515,8 @@ and sym_exec_objc_getter field_name ret_typ tenv ret_ids pdesc pname loc args pr match args with | [(lexp, typ)] -> let typ' = (match Tenv.expand_type tenv typ with - | Sil.Tstruct _ as s -> s - | Sil.Tptr (t, _) -> Tenv.expand_type tenv t + | Typ.Tstruct _ as s -> s + | Typ.Tptr (t, _) -> Tenv.expand_type tenv t | _ -> assert false) in let field_access_exp = Sil.Lfield (lexp, field_name, typ') in execute_letderef @@ -1527,8 +1529,8 @@ and sym_exec_objc_setter field_name _ tenv _ pdesc pname loc args prop = match args with | (lexp1, typ1) :: (lexp2, typ2)::_ -> let typ1' = (match Tenv.expand_type tenv typ1 with - | Sil.Tstruct _ as s -> s - | Sil.Tptr (t, _) -> Tenv.expand_type tenv t + | Typ.Tstruct _ as s -> s + | Typ.Tptr (t, _) -> Tenv.expand_type tenv t | _ -> assert false) in let field_access_exp = Sil.Lfield (lexp1, field_name, typ1') in execute_set ~report_deref_errors:false pname pdesc tenv field_access_exp typ2 lexp2 loc prop @@ -1554,8 +1556,8 @@ and proc_call summary {Builtin.pdesc; tenv; prop_= pre; path; ret_ids; args= act let check_return_value_ignored () = (* check if the return value of the call is ignored, and issue a warning *) let is_ignored = match ret_typ, ret_ids with - | Sil.Tvoid, _ -> false - | Sil.Tint _, _ when not (proc_is_defined callee_pname) -> + | Typ.Tvoid, _ -> false + | Typ.Tint _, _ when not (proc_is_defined callee_pname) -> (* if the proc returns Tint and is not defined, *) (* don't report ignored return value *) false @@ -1584,13 +1586,13 @@ and proc_call summary {Builtin.pdesc; tenv; prop_= pre; path; ret_ids; args= act "likely use of variable-arguments function, or function prototype missing"; L.d_ln(); L.d_str "actual parameters: "; Sil.d_exp_list (IList.map fst actual_pars); L.d_ln (); - L.d_str "formal parameters: "; Sil.d_typ_list formal_types; L.d_ln (); + L.d_str "formal parameters: "; Typ.d_list formal_types; L.d_ln (); actual_pars | [], _ -> L.d_str ("**** ERROR: Procedure " ^ Procname.to_string callee_pname); L.d_strln (" mismatch in the number of parameters ****"); L.d_str "actual parameters: "; Sil.d_exp_list (IList.map fst actual_pars); L.d_ln (); - L.d_str "formal parameters: "; Sil.d_typ_list formal_types; L.d_ln (); + L.d_str "formal parameters: "; Typ.d_list formal_types; L.d_ln (); raise (Exceptions.Wrong_argument_number __POS__) in let actual_params = comb actual_pars formal_types in (* Actual parameters are associated to their formal diff --git a/infer/src/backend/symExec.mli b/infer/src/backend/symExec.mli index ea7db25cb..dee9085bb 100644 --- a/infer/src/backend/symExec.mli +++ b/infer/src/backend/symExec.mli @@ -26,7 +26,7 @@ val diverge : Prop.normal Prop.t -> Paths.Path.t -> (Prop.normal Prop.t * Paths. val proc_call : Specs.summary -> Builtin.t -val unknown_or_scan_call : is_scan:bool -> Sil.typ option -> Sil.item_annotation -> Builtin.t +val unknown_or_scan_call : is_scan:bool -> Typ.t option -> Typ.item_annotation -> Builtin.t val check_variadic_sentinel : ?fails_on_nil:bool -> int -> int * int -> Builtin.t diff --git a/infer/src/backend/tabulation.ml b/infer/src/backend/tabulation.ml index 05b583d1e..f1bdbe0df 100644 --- a/infer/src/backend/tabulation.ml +++ b/infer/src/backend/tabulation.ml @@ -468,8 +468,8 @@ let texp_star texp1 texp2 = | 0 -> ftal_sub ftal1' ftal2' | _ -> ftal_sub ftal1 ftal2' end in let typ_star t1 t2 = match t1, t2 with - | Sil.Tstruct { Sil.instance_fields = instance_fields1; csu = csu1 }, - Sil.Tstruct { Sil.instance_fields = instance_fields2; csu = csu2 } when csu1 = csu2 -> + | Typ.Tstruct { Typ.instance_fields = instance_fields1; csu = csu1 }, + Typ.Tstruct { Typ.instance_fields = instance_fields2; csu = csu2 } when csu1 = csu2 -> if ftal_sub instance_fields1 instance_fields2 then t2 else t1 | _ -> t1 in match texp1, texp2 with @@ -629,7 +629,7 @@ let prop_get_exn_name pname prop = let ret_pvar = Sil.Lvar (Pvar.get_ret_pvar pname) in let rec search_exn e = function | [] -> None - | Sil.Hpointsto (e1, _, Sil.Sizeof (Sil.Tstruct { Sil.struct_name = Some name }, _, _)) :: _ + | Sil.Hpointsto (e1, _, Sil.Sizeof (Typ.Tstruct { Typ.struct_name = Some name }, _, _)) :: _ when Sil.exp_equal e1 e -> Some (Typename.TN_csu (Csu.Class Csu.Java, name)) | _ :: tl -> search_exn e tl in diff --git a/infer/src/backend/tabulation.mli b/infer/src/backend/tabulation.mli index bfb2c3e6b..14c67851d 100644 --- a/infer/src/backend/tabulation.mli +++ b/infer/src/backend/tabulation.mli @@ -45,5 +45,5 @@ val d_splitting : splitting -> unit (** Execute the function call and return the list of results with return value *) val exe_function_call: ProcAttributes.t -> Tenv.t -> Ident.t list -> Cfg.Procdesc.t -> Procname.t -> Location.t -> - (Sil.exp * Sil.typ) list -> Prop.normal Prop.t -> Paths.Path.t -> + (Sil.exp * Typ.t) list -> Prop.normal Prop.t -> Paths.Path.t -> (Prop.normal Prop.t * Paths.Path.t) list diff --git a/infer/src/backend/taint.ml b/infer/src/backend/taint.ml index f6364d72b..a8e5042ad 100644 --- a/infer/src/backend/taint.ml +++ b/infer/src/backend/taint.ml @@ -300,7 +300,7 @@ let func_with_tainted_params = let attrs_opt_get_annots = function | Some attrs -> attrs.ProcAttributes.method_annotation - | None -> Sil.method_annotation_empty + | None -> Typ.method_annotation_empty (* TODO: return a taint kind *) (** returns true if [callee_pname] returns a tainted value *) @@ -356,8 +356,8 @@ let has_taint_annotation fieldname struct_typ = 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.Sil.instance_fields || - IList.exists fld_has_taint_annot struct_typ.Sil.static_fields + IList.exists fld_has_taint_annot struct_typ.Typ.instance_fields || + IList.exists fld_has_taint_annot struct_typ.Typ.static_fields (* 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 b425178dd..d40d22dab 100644 --- a/infer/src/backend/taint.mli +++ b/infer/src/backend/taint.mli @@ -20,7 +20,7 @@ val accepts_sensitive_params : Procname.t -> ProcAttributes.t option -> (int * S val tainted_params : Procname.t -> (int * Sil.taint_kind) list (** returns the taint_kind of [fieldname] if it has a taint source annotation *) -val has_taint_annotation : Ident.fieldname -> Sil.struct_typ -> bool +val has_taint_annotation : Ident.fieldname -> Typ.struct_typ -> bool val add_tainting_attribute : Sil.attribute -> Pvar.t -> Prop.normal Prop.t -> Prop.normal Prop.t diff --git a/infer/src/checkers/addressTaken.ml b/infer/src/checkers/addressTaken.ml index ddafe3aad..ddd9cee78 100644 --- a/infer/src/checkers/addressTaken.ml +++ b/infer/src/checkers/addressTaken.ml @@ -40,7 +40,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct add_address_taken_pvars rhs_exp astate | Sil.Call (_, _, actuals, _, _) -> let add_actual_by_ref astate_acc = function - | actual_exp, Sil.Tptr _ -> add_address_taken_pvars actual_exp astate_acc + | actual_exp, Typ.Tptr _ -> add_address_taken_pvars actual_exp astate_acc | _ -> astate_acc in IList.fold_left add_actual_by_ref astate actuals | Sil.Set _ | Letderef _ | Prune _ | Nullify _ | Abstract _ | Remove_temps _ | Stackop _ diff --git a/infer/src/checkers/annotationReachability.ml b/infer/src/checkers/annotationReachability.ml index 013547977..0f205fae0 100644 --- a/infer/src/checkers/annotationReachability.ml +++ b/infer/src/checkers/annotationReachability.ml @@ -13,12 +13,12 @@ module F = Format module L = Logging module CallSiteSet = AbstractDomain.FiniteSet (Specs.CallSiteSet) -module CallsDomain = AbstractDomain.Map (Sil.AnnotMap) (CallSiteSet) +module CallsDomain = AbstractDomain.Map (Typ.AnnotMap) (CallSiteSet) let dummy_constructor_annot = "__infer_is_constructor" let annotation_of_str annot_str = - { Sil.class_name = annot_str; parameters = []; } + { Typ.class_name = annot_str; parameters = []; } (* TODO: read custom source/sink pairs from user code here *) let src_snk_pairs () = @@ -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 { Sil.struct_annotations; } = + let check_class_annots { Typ.struct_annotations; } = check struct_annotations in begin match Tenv.proc_extract_declaring_class_typ tenv java_pname with @@ -166,7 +166,7 @@ let method_overrides is_annotated tenv pname = overrides () let method_has_annot annot tenv pname = - let has_annot ia = Annotations.ia_ends_with ia annot.Sil.class_name in + let has_annot ia = Annotations.ia_ends_with ia annot.Typ.class_name in if Annotations.annot_ends_with annot dummy_constructor_annot then is_allocator tenv pname else if Annotations.annot_ends_with annot Annotations.expensive @@ -181,7 +181,7 @@ let lookup_annotation_calls annot pname = | Some { Specs.payload = { Specs.calls = Some call_map; }; } -> begin try - Sil.AnnotMap.find annot call_map + Typ.AnnotMap.find annot call_map |> Specs.CallSiteSet.elements with Not_found -> [] @@ -303,14 +303,14 @@ module TransferFunctions (CFG : ProcCfg.S) = struct (* TODO: generalize this to allow sanitizers for other annotation types, store it in [extras] so we can compute it just once *) let method_is_sanitizer annot tenv pname = - if annot.Sil.class_name = dummy_constructor_annot + if annot.Typ.class_name = dummy_constructor_annot then method_has_ignore_allocation_annot tenv pname else false let add_call call_map tenv callee_pname caller_pname call_site astate = let add_call_for_annot annot _ astate = let calls = - try Sil.AnnotMap.find annot call_map + try Typ.AnnotMap.find annot call_map with Not_found -> Specs.CallSiteSet.empty in if (not (Specs.CallSiteSet.is_empty calls) || method_has_annot annot tenv callee_pname) && (not (method_is_sanitizer annot tenv caller_pname)) @@ -323,7 +323,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct | Domain.NonBottom (map, _) -> (* for each annotation type T in domain(astate), check if method calls something annotated with T *) - Sil.AnnotMap.fold add_call_for_annot map astate + Typ.AnnotMap.fold add_call_for_annot map astate let exec_instr astate { ProcData.pdesc; tenv; } _ = function | Sil.Call ([id], Const (Cfun callee_pname), _, _, _) @@ -338,7 +338,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct | Some Domain.NonBottom (call_map, _) -> add_call call_map tenv callee_pname caller_pname call_site astate | None -> - add_call Sil.AnnotMap.empty tenv callee_pname caller_pname call_site astate + add_call Typ.AnnotMap.empty tenv callee_pname caller_pname call_site astate | Some Domain.Bottom -> astate end @@ -398,14 +398,14 @@ module Interprocedural = struct let report_src_snk_paths call_map (src_annot_list, snk_annot) = let extract_calls_with_annot annot call_map = try - Sil.AnnotMap.find annot call_map + Typ.AnnotMap.find annot call_map |> Specs.CallSiteSet.elements with Not_found -> [] in let report_src_snk_path calls src_annot = if method_overrides_annot src_annot tenv proc_name then let f_report = - report_annotation_stack src_annot.Sil.class_name snk_annot.Sil.class_name in + report_annotation_stack src_annot.Typ.class_name snk_annot.Typ.class_name in report_call_stack (method_has_annot snk_annot tenv) (lookup_annotation_calls snk_annot) diff --git a/infer/src/checkers/annotations.ml b/infer/src/checkers/annotations.ml index 08ce5f0ea..8329ba472 100644 --- a/infer/src/checkers/annotations.ml +++ b/infer/src/checkers/annotations.ml @@ -16,19 +16,19 @@ module L = Logging (** Method signature with annotations. *) type annotated_signature = - { ret : Sil.item_annotation * Sil.typ; (** Annotated return type. *) - params: (Mangled.t * Sil.item_annotation * Sil.typ) list } (** Annotated parameters. *) + { ret : Typ.item_annotation * Typ.t; (** Annotated return type. *) + params: (Mangled.t * Typ.item_annotation * Typ.t) list } (** Annotated parameters. *) let param_equal (s1, ia1, t1) (s2, ia2, t2) = Mangled.equal s1 s2 && - Sil.item_annotation_compare ia1 ia2 = 0 && - Sil.typ_equal t1 t2 + Typ.item_annotation_compare ia1 ia2 = 0 && + Typ.equal t1 t2 let equal as1 as2 = let ia1, t1 = as1.ret and ia2, t2 = as2.ret in - Sil.item_annotation_compare ia1 ia2 = 0 && - Sil.typ_equal t1 t2 && + Typ.item_annotation_compare ia1 ia2 = 0 && + Typ.equal t1 t2 && IList.for_all2 param_equal as1.params as2.params let visibleForTesting = "com.google.common.annotations.VisibleForTesting" @@ -36,12 +36,12 @@ let suppressLint = "android.annotation.SuppressLint" let get_field_type_and_annotation fn = function - | Sil.Tptr (Sil.Tstruct struct_typ, _) - | Sil.Tstruct struct_typ -> + | Typ.Tptr (Typ.Tstruct struct_typ, _) + | Typ.Tstruct struct_typ -> (try let (_, t, a) = IList.find (fun (f, _, _) -> - Sil.fld_equal f fn) - (struct_typ.Sil.instance_fields @ struct_typ.Sil.static_fields) in + Ident.fieldname_equal f fn) + (struct_typ.Typ.instance_fields @ struct_typ.Typ.static_fields) in Some (t, a) with Not_found -> None) | _ -> None @@ -49,19 +49,19 @@ let get_field_type_and_annotation fn = function (** Return the annotations on the declaring class of [pname]. Only works for Java *) let get_declaring_class_annotations pname tenv = match Tenv.proc_extract_declaring_class_typ tenv pname with - | Some { Sil.struct_annotations } -> Some struct_annotations + | Some { Typ.struct_annotations } -> Some struct_annotations | None -> None let ia_iter f = let ann_iter (a, _) = f a in IList.iter ann_iter -let ma_iter f ((ia, ial) : Sil.method_annotation) = +let ma_iter f ((ia, ial) : Typ.method_annotation) = IList.iter (ia_iter f) (ia:: ial) let ma_has_annotation_with - (ma: Sil.method_annotation) - (predicate: Sil.annotation -> bool): bool = + (ma: Typ.method_annotation) + (predicate: Typ.annotation -> bool): bool = let found = ref false in ma_iter (fun a -> if predicate a then found := true) @@ -69,8 +69,8 @@ let ma_has_annotation_with !found let ia_has_annotation_with - (ia: Sil.item_annotation) - (predicate: Sil.annotation -> bool): bool = + (ia: Typ.item_annotation) + (predicate: Typ.annotation -> bool): bool = let found = ref false in ia_iter (fun a -> if predicate a then found := true) @@ -83,7 +83,7 @@ let annot_ends_with annot ann_name = let sl = String.length s in let al = String.length ann_name in sl >= al && String.sub s (sl - al) al = ann_name in - filter annot.Sil.class_name + filter annot.Typ.class_name (** Check if there is an annotation in [ia] which ends with the given name *) let ia_ends_with ia ann_name = @@ -93,17 +93,19 @@ let ia_ends_with ia ann_name = let ia_contains ia ann_name = let found = ref false in - ia_iter (fun a -> if ann_name = a.Sil.class_name then found := true) ia; + ia_iter (fun a -> if ann_name = a.Typ.class_name then found := true) ia; !found let ia_get ia ann_name = let found = ref None in - ia_iter (fun a -> if ann_name = a.Sil.class_name then found := Some a) ia; + ia_iter (fun a -> if ann_name = a.Typ.class_name then found := Some a) ia; !found let ma_contains ma ann_names = let found = ref false in - ma_iter (fun a -> if IList.exists (string_equal a.Sil.class_name) ann_names then found := true) ma; + ma_iter (fun a -> + if IList.exists (string_equal a.Typ.class_name) ann_names then found := true + ) ma; !found let initializer_ = "Initializer" @@ -246,7 +248,7 @@ let get_annotated_signature proc_attributes : annotated_signature = | ia :: ial', (name, typ) :: parl' -> (name, ia, typ) :: extract ial' parl' | [], (name, typ) :: parl' -> - (name, Sil.item_annotation_empty, typ) :: extract [] parl' + (name, Typ.item_annotation_empty, typ) :: extract [] parl' | [], [] -> [] | _ :: _, [] -> @@ -261,7 +263,7 @@ let get_annotated_signature proc_attributes : annotated_signature = are called x0, x1, x2. *) let annotated_signature_is_anonymous_inner_class_wrapper ann_sig proc_name = let check_ret (ia, t) = - Sil.item_annotation_is_empty ia && PatternMatch.type_is_object t in + Typ.item_annotation_is_empty ia && PatternMatch.type_is_object t in let x_param_found = ref false in let name_is_x_number name = let name_str = Mangled.to_string name in @@ -280,7 +282,7 @@ let annotated_signature_is_anonymous_inner_class_wrapper ann_sig proc_name = if Mangled.to_string name = "this" then true else name_is_x_number name && - Sil.item_annotation_is_empty ia && + Typ.item_annotation_is_empty ia && PatternMatch.type_is_object t in Procname.java_is_anonymous_inner_class proc_name && check_ret ann_sig.ret @@ -296,17 +298,17 @@ let param_is_nullable pvar ann_sig = (** Pretty print a method signature with annotations. *) let pp_annotated_signature proc_name fmt annotated_signature = - let pp_ia fmt ia = if ia <> [] then F.fprintf fmt "%a " Sil.pp_item_annotation ia in + let pp_ia fmt ia = if ia <> [] then F.fprintf fmt "%a " Typ.pp_item_annotation ia in let pp_annotated_param fmt (p, ia, t) = - F.fprintf fmt " %a%a %a" pp_ia ia (Sil.pp_typ_full pe_text) t Mangled.pp p in + F.fprintf fmt " %a%a %a" pp_ia ia (Typ.pp_full pe_text) t Mangled.pp p in let ia, ret_type = annotated_signature.ret in F.fprintf fmt "%a%a %s (%a )" pp_ia ia - (Sil.pp_typ_full pe_text) ret_type + (Typ.pp_full pe_text) ret_type (Procname.to_simplified_string proc_name) (pp_comma_seq pp_annotated_param) annotated_signature.params -let mk_ann_str s = { Sil.class_name = s; Sil.parameters = [] } +let mk_ann_str s = { Typ.class_name = s; Typ.parameters = [] } let mk_ann = function | Nullable -> mk_ann_str nullable | Present -> mk_ann_str present diff --git a/infer/src/checkers/annotations.mli b/infer/src/checkers/annotations.mli index e78817cc4..ab4e302d8 100644 --- a/infer/src/checkers/annotations.mli +++ b/infer/src/checkers/annotations.mli @@ -24,8 +24,8 @@ type annotation = (** Method signature with annotations. *) type annotated_signature = - { ret : Sil.item_annotation * Sil.typ; (** Annotated return type. *) - params: (Mangled.t * Sil.item_annotation * Sil.typ) list } (** Annotated parameters. *) + { ret : Typ.item_annotation * Typ.t; (** Annotated return type. *) + params: (Mangled.t * Typ.item_annotation * Typ.t) list } (** Annotated parameters. *) (** Check if the annotated signature is for a wrapper of an anonymous inner class method. These wrappers have the same name as the original method, every type is Object, and the parameters @@ -54,67 +54,67 @@ val get_annotated_signature : ProcAttributes.t -> annotated_signature (** Return the type of the field [fn] and its annotation, None if [typ] has no field named [fn] *) val get_field_type_and_annotation : - Ident.fieldname -> Sil.typ -> (Sil.typ * Sil.item_annotation) option + Ident.fieldname -> Typ.t -> (Typ.t * Typ.item_annotation) option (** Return the annotations on the declaring class of [java_pname]. *) -val get_declaring_class_annotations : Procname.java -> Tenv.t -> Sil.item_annotation option +val get_declaring_class_annotations : Procname.java -> Tenv.t -> Typ.item_annotation option val nullable : string (** Return true if [annot] ends with [ann_name] *) -val annot_ends_with : Sil.annotation -> string -> bool +val annot_ends_with : Typ.annotation -> string -> bool (** Check if there is an annotation in [ia] which ends with the given name *) -val ia_ends_with : Sil.item_annotation -> string -> bool +val ia_ends_with : Typ.item_annotation -> string -> bool -val ia_contains : Sil.item_annotation -> string -> bool +val ia_contains : Typ.item_annotation -> string -> bool -val ia_has_annotation_with : Sil.item_annotation -> (Sil.annotation -> bool) -> bool +val ia_has_annotation_with : Typ.item_annotation -> (Typ.annotation -> bool) -> bool -val ia_get_strict : Sil.item_annotation -> Sil.annotation option +val ia_get_strict : Typ.item_annotation -> Typ.annotation option -val ia_is_false_on_null : Sil.item_annotation -> bool -val ia_is_initializer : Sil.item_annotation -> bool +val ia_is_false_on_null : Typ.item_annotation -> bool +val ia_is_initializer : Typ.item_annotation -> bool (** Annotations for readonly injectors. The injector framework initializes the field but does not write null into it. *) -val ia_is_field_injector_readonly : Sil.item_annotation -> bool +val ia_is_field_injector_readonly : Typ.item_annotation -> bool (** Annotations for read-write injectors. The injector framework initializes the field and can write null into it. *) -val ia_is_field_injector_readwrite : Sil.item_annotation -> bool +val ia_is_field_injector_readwrite : Typ.item_annotation -> bool -val ia_is_mutable : Sil.item_annotation -> bool -val ia_is_nonnull : Sil.item_annotation -> bool -val ia_is_nullable : Sil.item_annotation -> bool -val ia_is_present : Sil.item_annotation -> bool -val ia_is_true_on_null : Sil.item_annotation -> bool -val ia_is_verify : Sil.item_annotation -> bool -val ia_is_expensive : Sil.item_annotation -> bool -val ia_is_performance_critical : Sil.item_annotation -> bool -val ia_is_no_allocation : Sil.item_annotation -> bool -val ia_is_ignore_allocations : Sil.item_annotation -> bool -val ia_is_suppress_warnings : Sil.item_annotation -> bool -val ia_is_privacy_source : Sil.item_annotation -> bool -val ia_is_privacy_sink : Sil.item_annotation -> bool -val ia_is_integrity_source : Sil.item_annotation -> bool -val ia_is_integrity_sink : Sil.item_annotation -> bool -val ia_is_guarded_by : Sil.item_annotation -> bool +val ia_is_mutable : Typ.item_annotation -> bool +val ia_is_nonnull : Typ.item_annotation -> bool +val ia_is_nullable : Typ.item_annotation -> bool +val ia_is_present : Typ.item_annotation -> bool +val ia_is_true_on_null : Typ.item_annotation -> bool +val ia_is_verify : Typ.item_annotation -> bool +val ia_is_expensive : Typ.item_annotation -> bool +val ia_is_performance_critical : Typ.item_annotation -> bool +val ia_is_no_allocation : Typ.item_annotation -> bool +val ia_is_ignore_allocations : Typ.item_annotation -> bool +val ia_is_suppress_warnings : Typ.item_annotation -> bool +val ia_is_privacy_source : Typ.item_annotation -> bool +val ia_is_privacy_sink : Typ.item_annotation -> bool +val ia_is_integrity_source : Typ.item_annotation -> bool +val ia_is_integrity_sink : Typ.item_annotation -> bool +val ia_is_guarded_by : Typ.item_annotation -> bool -val ia_iter : (Sil.annotation -> unit) -> Sil.item_annotation -> unit +val ia_iter : (Typ.annotation -> unit) -> Typ.item_annotation -> unit -val ma_contains : Sil.method_annotation -> string list -> bool +val ma_contains : Typ.method_annotation -> string list -> bool -val ma_has_annotation_with : Sil.method_annotation -> (Sil.annotation -> bool) -> bool +val ma_has_annotation_with : Typ.method_annotation -> (Typ.annotation -> bool) -> bool -val ma_iter : (Sil.annotation -> unit) -> Sil.method_annotation -> unit +val ma_iter : (Typ.annotation -> unit) -> Typ.method_annotation -> unit (** Mark the return of the method_annotation with the given annotation. *) val method_annotation_mark_return : - annotation -> Sil.method_annotation -> Sil.method_annotation + annotation -> Typ.method_annotation -> Typ.method_annotation (** Add the annotation to the item_annotation. *) -val mk_ia : annotation -> Sil.item_annotation -> Sil.item_annotation +val mk_ia : annotation -> Typ.item_annotation -> Typ.item_annotation val pp_annotated_signature : Procname.t -> Format.formatter -> annotated_signature -> unit diff --git a/infer/src/checkers/checkers.ml b/infer/src/checkers/checkers.ml index 3b8f4f832..83ca5c11b 100644 --- a/infer/src/checkers/checkers.ml +++ b/infer/src/checkers/checkers.ml @@ -97,10 +97,10 @@ module ST = struct string_equal (normalize s1) (normalize s2) in let is_parameter_suppressed = - IList.mem string_equal a.Sil.class_name [Annotations.suppressLint] && - IList.mem normalized_equal kind a.Sil.parameters in + IList.mem string_equal a.Typ.class_name [Annotations.suppressLint] && + IList.mem normalized_equal kind a.Typ.parameters in let is_annotation_suppressed = - string_is_suffix (normalize (drop_prefix kind)) (normalize a.Sil.class_name) in + string_is_suffix (normalize (drop_prefix kind)) (normalize a.Typ.class_name) in is_parameter_suppressed || is_annotation_suppressed in @@ -204,7 +204,7 @@ let callback_check_write_to_parcel_java let class_name = Typename.TN_csu (Csu.Class Csu.Java, Mangled.from_string "android.os.Parcelable") in match this_type with - | Sil.Tptr (Sil.Tstruct struct_typ, _) | Sil.Tstruct struct_typ -> + | Typ.Tptr (Typ.Tstruct struct_typ, _) | Typ.Tstruct struct_typ -> PatternMatch.is_immediate_subtype struct_typ class_name | _ -> false in method_match () && expr_match () && type_match () in @@ -215,7 +215,7 @@ let callback_check_write_to_parcel_java proc_desc pname_java ["android.os.Parcel"] in let parcel_constructors = function - | Sil.Tptr (Sil.Tstruct { Sil.def_methods }, _) -> + | Typ.Tptr (Typ.Tstruct { Typ.def_methods }, _) -> IList.filter is_parcel_constructor def_methods | _ -> [] in @@ -319,10 +319,10 @@ let callback_monitor_nullcheck { Callbacks.proc_desc; idenv; proc_name } = let formals = Cfg.Procdesc.get_formals proc_desc in let class_formals = let is_class_type = function - | p, Sil.Tptr _ when Mangled.to_string p = "this" -> + | p, Typ.Tptr _ when Mangled.to_string p = "this" -> false (* no need to null check 'this' *) - | _, Sil.Tstruct _ -> true - | _, Sil.Tptr (Sil.Tstruct _, _) -> true + | _, Typ.Tstruct _ -> true + | _, Typ.Tptr (Typ.Tstruct _, _) -> true | _ -> false in IList.filter is_class_type formals in IList.map fst class_formals) in diff --git a/infer/src/checkers/copyPropagation.ml b/infer/src/checkers/copyPropagation.ml index a8b9c8f6b..cd0a8e137 100644 --- a/infer/src/checkers/copyPropagation.ml +++ b/infer/src/checkers/copyPropagation.ml @@ -105,7 +105,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct let kill_ret_ids astate_acc id = Domain.kill_copies_with_var (Var.of_id id) astate_acc in let kill_actuals_by_ref astate_acc = function - | (Sil.Lvar pvar, Sil.Tptr _) -> Domain.kill_copies_with_var (Var.of_pvar pvar) astate_acc + | (Sil.Lvar pvar, Typ.Tptr _) -> Domain.kill_copies_with_var (Var.of_pvar pvar) astate_acc | _ -> astate_acc in let astate' = IList.fold_left kill_ret_ids astate ret_ids in if !Config.curr_language = Config.Java diff --git a/infer/src/checkers/fragmentRetainsViewChecker.ml b/infer/src/checkers/fragmentRetainsViewChecker.ml index 989f85ec7..47893c6c5 100644 --- a/infer/src/checkers/fragmentRetainsViewChecker.ml +++ b/infer/src/checkers/fragmentRetainsViewChecker.ml @@ -27,7 +27,7 @@ let callback_fragment_retains_view_java let is_on_destroy_view = Procname.java_get_method pname_java = "onDestroyView" in (* this is needlessly complicated because field types are Tvars instead of Tstructs *) let fld_typ_is_view = function - | Sil.Tptr (Sil.Tvar tname, _) -> + | Typ.Tptr (Typ.Tvar tname, _) -> begin match Tenv.lookup tenv tname with | Some struct_typ -> AndroidFramework.is_view tenv struct_typ @@ -43,7 +43,7 @@ let callback_fragment_retains_view_java let class_typename = Typename.Java.from_string (Procname.java_get_class_name pname_java) in match Tenv.lookup tenv class_typename with - | Some ({ Sil.struct_name = Some _; instance_fields } as struct_typ) + | Some ({ Typ.struct_name = Some _; instance_fields } as struct_typ) when AndroidFramework.is_fragment tenv struct_typ -> let declared_view_fields = IList.filter (is_declared_view_typ class_typename) instance_fields in @@ -53,7 +53,7 @@ let callback_fragment_retains_view_java (fun (fname, fld_typ, _) -> if not (Ident.FieldSet.mem fname fields_nullified) then report_error - (Sil.Tstruct struct_typ) fname fld_typ + (Typ.Tstruct struct_typ) fname fld_typ (Procname.Java pname_java) proc_desc) declared_view_fields | _ -> () diff --git a/infer/src/checkers/patternMatch.ml b/infer/src/checkers/patternMatch.ml index 0c6a8be8c..435c92f98 100644 --- a/infer/src/checkers/patternMatch.ml +++ b/infer/src/checkers/patternMatch.ml @@ -27,7 +27,7 @@ type taint_spec = { let object_name = Mangled.from_string "java.lang.Object" let type_is_object = function - | Sil.Tptr (Sil.Tstruct { Sil.struct_name = Some name }, _) -> + | Typ.Tptr (Typ.Tstruct { Typ.struct_name = Some name }, _) -> Mangled.equal name object_name | _ -> false @@ -38,7 +38,7 @@ let java_proc_name_with_class_method pn_java class_with_path method_name = with _ -> false) let get_direct_supers tenv = function - | { Sil.csu = Csu.Class _; superclasses } -> + | { Typ.csu = Csu.Class _; superclasses } -> IList.map (Tenv.lookup tenv) superclasses |> IList.flatten_options | _ -> @@ -61,12 +61,12 @@ let strict_supertype_exists tenv f_typ orig_struct_typ = get_supers_rec orig_struct_typ let is_immediate_subtype this_type super_type_name = - IList.exists (Typename.equal super_type_name) this_type.Sil.superclasses + IList.exists (Typename.equal super_type_name) this_type.Typ.superclasses (** return true if [typ0] <: [typ1] *) let is_subtype tenv struct_typ0 struct_typ1 = - Sil.struct_typ_equal struct_typ0 struct_typ1 || - strict_supertype_exists tenv (Sil.struct_typ_equal struct_typ1) struct_typ0 + Typ.struct_typ_equal struct_typ0 struct_typ1 || + strict_supertype_exists tenv (Typ.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 @@ -81,61 +81,61 @@ let get_this_type proc_attributes = match proc_attributes.ProcAttributes.formals | _ -> None let type_get_direct_supertypes = function - | Sil.Tptr (Tstruct { superclasses }, _) - | Sil.Tstruct { superclasses } -> + | Typ.Tptr (Tstruct { superclasses }, _) + | Typ.Tstruct { superclasses } -> superclasses | _ -> [] let type_get_class_name t = match t with - | Sil.Tptr (Sil.Tstruct { Sil.struct_name = Some cn }, _) -> + | Typ.Tptr (Typ.Tstruct { Typ.struct_name = Some cn }, _) -> Some cn - | Sil.Tptr (Sil.Tvar (Typename.TN_csu (Csu.Class _, cn)), _) -> + | Typ.Tptr (Typ.Tvar (Typename.TN_csu (Csu.Class _, cn)), _) -> Some cn | _ -> None let type_get_annotation - (t: Sil.typ): Sil.item_annotation option = + (t: Typ.t): Typ.item_annotation option = match t with - | Sil.Tptr (Sil.Tstruct { Sil.struct_annotations }, _) - | Sil.Tstruct { Sil.struct_annotations } -> + | Typ.Tptr (Typ.Tstruct { Typ.struct_annotations }, _) + | Typ.Tstruct { Typ.struct_annotations } -> Some struct_annotations | _ -> None let type_has_class_name t name = type_get_class_name t = Some name -let type_has_direct_supertype (typ : Sil.typ) (class_name : Typename.t) = +let type_has_direct_supertype (typ : Typ.t) (class_name : Typename.t) = IList.exists (fun cn -> Typename.equal cn class_name) (type_get_direct_supertypes typ) let type_has_supertype (tenv: Tenv.t) - (typ: Sil.typ) + (typ: Typ.t) (class_name: Typename.t): bool = let rec has_supertype typ visited = - if Sil.TypSet.mem typ visited then + if Typ.Set.mem typ visited then false else begin match Tenv.expand_type tenv typ with - | Sil.Tptr (Sil.Tstruct { Sil.superclasses }, _) - | Sil.Tstruct { Sil.superclasses } -> + | Typ.Tptr (Typ.Tstruct { Typ.superclasses }, _) + | Typ.Tstruct { Typ.superclasses } -> let match_supertype cn = let match_name () = Typename.equal cn class_name in let has_indirect_supertype () = match Tenv.lookup tenv cn with | Some supertype -> - has_supertype (Sil.Tstruct supertype) (Sil.TypSet.add typ visited) + has_supertype (Typ.Tstruct supertype) (Typ.Set.add typ visited) | None -> false in (match_name () || has_indirect_supertype ()) in IList.exists match_supertype superclasses | _ -> false end in - has_supertype typ Sil.TypSet.empty + has_supertype typ Typ.Set.empty let type_is_nested_in_type t n = match t with - | Sil.Tptr (Sil.Tstruct { Sil.struct_name = Some name }, _) -> + | Typ.Tptr (Typ.Tstruct { Typ.struct_name = Some name }, _) -> string_is_prefix (Mangled.to_string n ^ "$") (Mangled.to_string name) | _ -> false @@ -144,18 +144,18 @@ let type_is_nested_in_direct_supertype t n = IList.exists (is_nested_in n) (type_get_direct_supertypes t) let rec get_type_name = function - | Sil.Tstruct { Sil.struct_name = Some name } -> + | Typ.Tstruct { Typ.struct_name = Some name } -> Mangled.to_string name - | Sil.Tptr (t, _) -> get_type_name t - | Sil.Tvar tn -> Typename.name tn + | Typ.Tptr (t, _) -> get_type_name t + | Typ.Tvar tn -> Typename.name tn | _ -> "_" let get_field_type_name - (typ: Sil.typ) + (typ: Typ.t) (fieldname: Ident.fieldname): string option = match typ with - | Sil.Tstruct { Sil.instance_fields } - | Sil.Tptr (Sil.Tstruct { Sil.instance_fields }, _) -> ( + | Typ.Tstruct { Typ.instance_fields } + | Typ.Tptr (Typ.Tstruct { Typ.instance_fields }, _) -> ( try let _, ft, _ = IList.find (function | (fn, _, _) -> Ident.fieldname_equal fn fieldname) @@ -265,10 +265,10 @@ let get_java_method_call_formal_signature = function let type_is_class = function - | Sil.Tptr (Sil.Tstruct _, _) -> true - | Sil.Tptr (Sil.Tvar _, _) -> true - | Sil.Tptr (Sil.Tarray _, _) -> true - | Sil.Tstruct _ -> true + | Typ.Tptr (Typ.Tstruct _, _) -> true + | Typ.Tptr (Typ.Tvar _, _) -> true + | Typ.Tptr (Typ.Tarray _, _) -> true + | Typ.Tstruct _ -> true | _ -> false let initializer_classes = @@ -292,7 +292,7 @@ let initializer_methods = [ (** Check if the type has in its supertypes from the initializer_classes list. *) let type_has_initializer (tenv: Tenv.t) - (t: Sil.typ): bool = + (t: Typ.t): bool = let check_candidate class_name = type_has_supertype tenv t class_name in IList.exists check_candidate initializer_classes @@ -357,7 +357,7 @@ let proc_iter_overridden_methods f tenv proc_name = let super_proc_name = Procname.replace_class proc_name (Typename.name super_class_name) in match Tenv.lookup tenv super_class_name with - | Some ({ Sil.def_methods }) -> + | Some ({ Typ.def_methods }) -> let is_override pname = Procname.equal pname super_proc_name && not (Procname.is_constructor pname) in @@ -377,7 +377,7 @@ let proc_iter_overridden_methods f tenv proc_name = | Some curr_struct_typ -> IList.iter (do_super_type tenv) - (type_get_direct_supertypes (Sil.Tstruct curr_struct_typ)) + (type_get_direct_supertypes (Typ.Tstruct curr_struct_typ)) | None -> ()) | _ -> diff --git a/infer/src/checkers/patternMatch.mli b/infer/src/checkers/patternMatch.mli index ed0bf5bac..bf2733d0d 100644 --- a/infer/src/checkers/patternMatch.mli +++ b/infer/src/checkers/patternMatch.mli @@ -30,10 +30,10 @@ val get_java_method_call_formal_signature : Sil.instr -> (string * string * string list * string) option (** Get the this type of a procedure *) -val get_this_type : ProcAttributes.t -> Sil.typ option +val get_this_type : ProcAttributes.t -> Typ.t option (** Get the name of a type *) -val get_type_name : Sil.typ -> string +val get_type_name : Typ.t -> string (** Get the type names of a variable argument *) val get_vararg_type_names : Cfg.Node.t -> Pvar.t -> string list @@ -51,19 +51,19 @@ val is_getter : Procname.java -> bool val is_setter : Procname.java -> bool (** Is the type a direct subtype of the typename? *) -val is_immediate_subtype : Sil.struct_typ -> Typename.t -> bool +val is_immediate_subtype : Typ.struct_typ -> Typename.t -> bool (** Is the type a transitive subtype of the typename? *) -val is_subtype : Tenv.t -> Sil.struct_typ -> Sil.struct_typ -> bool +val is_subtype : Tenv.t -> Typ.struct_typ -> Typ.struct_typ -> bool (** Resolve [typ_str] in [tenv], then check [typ] <: [typ_str] *) val is_subtype_of_str : Tenv.t -> Typename.t -> string -> bool (** get the superclasses of [typ]. does not include [typ] itself *) -val strict_supertype_iter : Tenv.t -> (Sil.struct_typ -> unit) -> Sil.struct_typ -> unit +val strict_supertype_iter : Tenv.t -> (Typ.struct_typ -> unit) -> Typ.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 +val strict_supertype_exists : Tenv.t -> (Typ.struct_typ -> bool) -> Typ.struct_typ -> bool (** Get the name of the type of a constant *) val java_get_const_type_name : Sil.const -> string @@ -84,27 +84,27 @@ val proc_calls : Only Java supported at the moment. *) val proc_iter_overridden_methods : (Procname.t -> unit) -> Tenv.t -> Procname.t -> unit -val type_get_annotation : Sil.typ -> Sil.item_annotation option +val type_get_annotation : Typ.t -> Typ.item_annotation option (** Get the class name of the type *) -val type_get_class_name : Sil.typ -> Mangled.t option +val type_get_class_name : Typ.t -> Mangled.t option -val type_get_direct_supertypes : Sil.typ -> Typename.t list +val type_get_direct_supertypes : Typ.t -> Typename.t list (** Is the type a class with the given name *) -val type_has_class_name : Sil.typ -> Mangled.t -> bool +val type_has_class_name : Typ.t -> Mangled.t -> bool -val type_has_direct_supertype : Sil.typ -> Typename.t -> bool +val type_has_direct_supertype : Typ.t -> Typename.t -> bool (** Is the type a class type *) -val type_is_class : Sil.typ -> bool +val type_is_class : Typ.t -> bool -val type_is_nested_in_direct_supertype : Sil.typ -> Typename.t -> bool +val type_is_nested_in_direct_supertype : Typ.t -> Typename.t -> bool -val type_is_nested_in_type : Sil.typ -> Mangled.t -> bool +val type_is_nested_in_type : Typ.t -> Mangled.t -> bool (** Is the type java.lang.Object *) -val type_is_object : Sil.typ -> bool +val type_is_object : Typ.t -> bool (** return the set of instance fields that are assigned to a null literal in [procdesc] *) val get_fields_nullified : Cfg.Procdesc.t -> Ident.FieldSet.t diff --git a/infer/src/checkers/printfArgs.ml b/infer/src/checkers/printfArgs.ml index 66e396987..0cf20b5cf 100644 --- a/infer/src/checkers/printfArgs.ml +++ b/infer/src/checkers/printfArgs.ml @@ -85,7 +85,7 @@ let format_type_matches_given_type (* The format string and the nvar for the fixed arguments and the nvar of the varargs array *) let format_arguments (printf: printf_signature) - (args: (Sil.exp * Sil.typ) list): (string option * (Sil.exp list) * (Sil.exp option)) = + (args: (Sil.exp * Typ.t) list): (string option * (Sil.exp list) * (Sil.exp option)) = let format_string = match IList.nth args printf.format_pos with | Sil.Const (Sil.Cstr fmt), _ -> Some fmt diff --git a/infer/src/clang/cArithmetic_trans.ml b/infer/src/clang/cArithmetic_trans.ml index 57eaadfa1..f2641c80c 100644 --- a/infer/src/clang/cArithmetic_trans.ml +++ b/infer/src/clang/cArithmetic_trans.ml @@ -29,7 +29,7 @@ let assignment_arc_mode e1 typ e2 loc rhs_owning_method is_e1_decl = let bi_retain = Sil.Const (Sil.Cfun procname) in Sil.Call([], bi_retain, [(e, t)], loc, Sil.cf_default) in match typ with - | Sil.Tptr (_, Sil.Pk_pointer) when not rhs_owning_method && not is_e1_decl -> + | Typ.Tptr (_, Typ.Pk_pointer) when not rhs_owning_method && not is_e1_decl -> (* for __strong e1 = e2 the semantics is*) (* retain(e2); tmp=e1; e1=e2; release(tmp); *) let retain = mk_call retain_pname e2 typ in @@ -37,15 +37,15 @@ let assignment_arc_mode e1 typ e2 loc rhs_owning_method is_e1_decl = let tmp_assign = Sil.Letderef(id, e1, typ, loc) in let release = mk_call release_pname (Sil.Var id) typ in (e1,[retain; tmp_assign; assign; release]) - | Sil.Tptr (_, Sil.Pk_pointer) when not rhs_owning_method && is_e1_decl -> + | Typ.Tptr (_, Typ.Pk_pointer) when not rhs_owning_method && is_e1_decl -> (* for A __strong *e1 = e2 the semantics is*) (* retain(e2); e1=e2; *) let retain = mk_call retain_pname e2 typ in (e1,[retain; assign]) - | Sil.Tptr (_, Sil.Pk_objc_weak) - | Sil.Tptr (_, Sil.Pk_objc_unsafe_unretained) -> + | Typ.Tptr (_, Typ.Pk_objc_weak) + | Typ.Tptr (_, Typ.Pk_objc_unsafe_unretained) -> (e1, [assign]) - | Sil.Tptr (_, Sil.Pk_objc_autoreleasing) -> + | Typ.Tptr (_, Typ.Pk_objc_autoreleasing) -> (* for __autoreleasing e1 = e2 the semantics is*) (* retain(e2); autorelease(e2); e1=e2; *) let retain = mk_call retain_pname e2 typ in diff --git a/infer/src/clang/cArithmetic_trans.mli b/infer/src/clang/cArithmetic_trans.mli index 0f24f1d5a..b2bbe14ce 100644 --- a/infer/src/clang/cArithmetic_trans.mli +++ b/infer/src/clang/cArithmetic_trans.mli @@ -14,13 +14,13 @@ open! Utils val bin_op_to_string : Clang_ast_t.binary_operator_info -> string val binary_operation_instruction : - CContext.t -> Clang_ast_t.binary_operator_info -> Sil.exp -> Sil.typ -> Sil.exp -> + CContext.t -> Clang_ast_t.binary_operator_info -> Sil.exp -> Typ.t -> Sil.exp -> Location.t -> bool -> Sil.exp * Sil.instr list val unary_operation_instruction : - Clang_ast_t.unary_operator_info -> Sil.exp -> Sil.typ -> Location.t -> Sil.exp * Sil.instr list + Clang_ast_t.unary_operator_info -> Sil.exp -> Typ.t -> Location.t -> Sil.exp * Sil.instr list val assignment_arc_mode : - Sil.exp -> Sil.typ -> Sil.exp -> Location.t -> bool -> bool -> Sil.exp * Sil.instr list + Sil.exp -> Typ.t -> Sil.exp -> Location.t -> bool -> bool -> Sil.exp * Sil.instr list val sil_const_plus_one : Sil.exp -> Sil.exp diff --git a/infer/src/clang/cContext.ml b/infer/src/clang/cContext.ml index 64e52a4a3..b40b7f830 100644 --- a/infer/src/clang/cContext.ml +++ b/infer/src/clang/cContext.ml @@ -31,10 +31,10 @@ type t = procdesc : Cfg.Procdesc.t; is_objc_method : bool; curr_class: curr_class; - return_param_typ : Sil.typ option; + return_param_typ : Typ.t option; is_callee_expression : bool; outer_context : t option; (* in case of objc blocks, the context of the method containing the block *) - mutable blocks_static_vars : ((Pvar.t * Sil.typ) list) Procname.Map.t; + mutable blocks_static_vars : ((Pvar.t * Typ.t) list) Procname.Map.t; label_map : str_node_map; } @@ -123,7 +123,7 @@ let curr_class_hash curr_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 { Sil.superclasses } -> + | Some { Typ.superclasses } -> (let superclasses_names = IList.map Typename.name superclasses in match superclasses_names with | superclass:: protocols -> diff --git a/infer/src/clang/cContext.mli b/infer/src/clang/cContext.mli index 2c2baa85b..d7a6137bf 100644 --- a/infer/src/clang/cContext.mli +++ b/infer/src/clang/cContext.mli @@ -29,10 +29,10 @@ type t = procdesc : Cfg.Procdesc.t; is_objc_method : bool; curr_class: curr_class; - return_param_typ : Sil.typ option; + return_param_typ : Typ.t option; is_callee_expression : bool; outer_context : t option; (* in case of objc blocks, the context of the method containing the block *) - mutable blocks_static_vars : ((Pvar.t * Sil.typ) list) Procname.Map.t; + mutable blocks_static_vars : ((Pvar.t * Typ.t) list) Procname.Map.t; label_map : str_node_map; } @@ -59,13 +59,13 @@ val is_objc_method : t -> bool val get_tenv : t -> Tenv.t val create_context : Tenv.t -> Cg.t -> Cfg.cfg -> Cfg.Procdesc.t -> - curr_class -> Sil.typ option -> bool -> t option -> 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 * Sil.typ) -> unit +val add_block_static_var : t -> Procname.t -> (Pvar.t * Typ.t) -> unit -val static_vars_for_block : t -> Procname.t -> (Pvar.t * Sil.typ) list +val static_vars_for_block : t -> Procname.t -> (Pvar.t * Typ.t) list val is_objc_instance : t -> bool diff --git a/infer/src/clang/cEnum_decl.ml b/infer/src/clang/cEnum_decl.ml index da1e62b6f..0eaab3e9f 100644 --- a/infer/src/clang/cEnum_decl.ml +++ b/infer/src/clang/cEnum_decl.ml @@ -46,7 +46,7 @@ let enum_decl decl = match decl with | EnumDecl (_, _, _, type_ptr, decl_list, _, _) -> add_enum_constants_to_map (IList.rev decl_list); - let sil_type = Sil.Tint Sil.IInt in + let sil_type = Typ.Tint Typ.IInt in Ast_utils.update_sil_types_map type_ptr sil_type; sil_type diff --git a/infer/src/clang/cEnum_decl.mli b/infer/src/clang/cEnum_decl.mli index 6bda1c472..278399981 100644 --- a/infer/src/clang/cEnum_decl.mli +++ b/infer/src/clang/cEnum_decl.mli @@ -12,4 +12,4 @@ open! Utils (** Translate an enumeration declaration by adding it to the tenv and *) (** translating the code and adding it to a fake procdesc *) -val enum_decl : Clang_ast_t.decl -> Sil.typ +val enum_decl : Clang_ast_t.decl -> Typ.t diff --git a/infer/src/clang/cField_decl.ml b/infer/src/clang/cField_decl.ml index 6f7ad2627..421193de7 100644 --- a/infer/src/clang/cField_decl.ml +++ b/infer/src/clang/cField_decl.ml @@ -15,16 +15,16 @@ open CFrontend_utils module L = Logging -type field_type = Ident.fieldname * Sil.typ * (Sil.annotation * bool) list +type field_type = Ident.fieldname * Typ.t * (Typ.annotation * bool) list let rec get_fields_super_classes tenv super_class = Printing.log_out " ... Getting fields of superclass '%s'\n" (Typename.to_string super_class); match Tenv.lookup tenv super_class with | None -> [] - | Some { Sil.instance_fields; superclasses = super_class :: _ } -> + | Some { Typ.instance_fields; superclasses = super_class :: _ } -> let sc_fields = get_fields_super_classes tenv super_class in General_utils.append_no_duplicates_fields instance_fields sc_fields - | Some { Sil.instance_fields } -> instance_fields + | Some { Typ.instance_fields } -> instance_fields let fields_superclass tenv interface_decl_info ck = match interface_decl_info.Clang_ast_t.otdi_super with @@ -40,16 +40,16 @@ let build_sil_field type_ptr_to_sil_type tenv field_name type_ptr prop_attribute let prop_atts = IList.map Clang_ast_j.string_of_property_attribute prop_attributes in let annotation_from_type t = match t with - | Sil.Tptr (_, Sil.Pk_objc_weak) -> [Config.weak] - | Sil.Tptr (_, Sil.Pk_objc_unsafe_unretained) -> [Config.unsafe_unret] + | Typ.Tptr (_, Typ.Pk_objc_weak) -> [Config.weak] + | Typ.Tptr (_, Typ.Pk_objc_unsafe_unretained) -> [Config.unsafe_unret] | _ -> [] in let fname = General_utils.mk_class_field_name field_name in let typ = type_ptr_to_sil_type tenv type_ptr in let item_annotations = match prop_atts with | [] -> - [({ Sil.class_name = Config.ivar_attributes; Sil.parameters = annotation_from_type typ }, true)] + [({ Typ.class_name = Config.ivar_attributes; parameters = annotation_from_type typ }, true)] | _ -> - [({ Sil.class_name = Config.property_attributes; Sil.parameters = prop_atts }, true)] in + [({ Typ.class_name = Config.property_attributes; parameters = prop_atts }, true)] in fname, typ, item_annotations (* Given a list of declarations in an interface returns a list of fields *) @@ -79,12 +79,12 @@ let add_missing_fields tenv class_name ck fields = let mang_name = Mangled.from_string class_name in let class_tn_name = Typename.TN_csu (Csu.Class ck, mang_name) in match Tenv.lookup tenv class_tn_name with - | Some ({ Sil.instance_fields } as struct_typ) -> + | Some ({ Typ.instance_fields } as struct_typ) -> let new_fields = General_utils.append_no_duplicates_fields instance_fields fields in let class_type_info = { struct_typ with - Sil.instance_fields = new_fields; + Typ.instance_fields = new_fields; static_fields = []; csu = Csu.Class ck; struct_name = Some mang_name; @@ -96,8 +96,8 @@ let add_missing_fields tenv class_name ck fields = (* checks if ivar is defined among a set of fields and if it is atomic *) let is_ivar_atomic ivar fields = let do_one_annot a = - (a.Sil.class_name = Config.property_attributes) && - IList.exists (fun p -> p = CFrontend_config.atomic_att) a.Sil.parameters in + (a.Typ.class_name = Config.property_attributes) && + IList.exists (fun p -> p = CFrontend_config.atomic_att) a.Typ.parameters in let has_atomic_annot ans = IList.exists (fun (a, _) -> do_one_annot a) ans in try diff --git a/infer/src/clang/cField_decl.mli b/infer/src/clang/cField_decl.mli index ee94940a0..3461f5dd0 100644 --- a/infer/src/clang/cField_decl.mli +++ b/infer/src/clang/cField_decl.mli @@ -12,7 +12,7 @@ open! Utils (** Utility module to retrieve fields of structs of classes *) open CFrontend_utils -type field_type = Ident.fieldname * Sil.typ * (Sil.annotation * bool) list +type field_type = Ident.fieldname * Typ.t * (Typ.annotation * bool) list val get_fields : Ast_utils.type_ptr_to_sil_type -> Tenv.t -> CContext.curr_class -> Clang_ast_t.decl list -> field_type list @@ -25,4 +25,4 @@ val build_sil_field : Ast_utils.type_ptr_to_sil_type -> Tenv.t -> Clang_ast_t.na val add_missing_fields : Tenv.t -> string -> Csu.class_kind -> field_type list -> unit -val is_ivar_atomic : Ident.fieldname -> Sil.struct_fields -> bool +val is_ivar_atomic : Ident.fieldname -> Typ.struct_fields -> bool diff --git a/infer/src/clang/cFrontend_checkers.ml b/infer/src/clang/cFrontend_checkers.ml index a01e05ccc..56f6b1e86 100644 --- a/infer/src/clang/cFrontend_checkers.ml +++ b/infer/src/clang/cFrontend_checkers.ml @@ -191,7 +191,7 @@ let direct_atomic_property_access_warning context stmt_info ivar_name = | _ -> Ident.create_fieldname (Mangled.from_string "") 0, "" in let tname = Typename.TN_csu (Csu.Class Csu.Objc, Mangled.from_string cname) in let condition = match Tenv.lookup tenv tname with - | Some { Sil.instance_fields; static_fields } -> + | Some { Typ.instance_fields; static_fields } -> (* We give the warning when: (1) the property has the atomic attribute and (2) the access of the ivar is not in a getter or setter method. @@ -218,7 +218,7 @@ let direct_atomic_property_access_warning context stmt_info ivar_name = let captured_cxx_ref_in_objc_block_warning stmt_info captured_vars = let is_cxx_ref (_, typ) = match typ with - | Sil.Tptr(_, Sil.Pk_reference) -> true + | Typ.Tptr(_, Typ.Pk_reference) -> true | _ -> false in let capt_refs = IList.filter is_cxx_ref captured_vars in let pvar_descs = diff --git a/infer/src/clang/cFrontend_checkers.mli b/infer/src/clang/cFrontend_checkers.mli index 6df6648fd..2d14c0414 100644 --- a/infer/src/clang/cFrontend_checkers.mli +++ b/infer/src/clang/cFrontend_checkers.mli @@ -34,7 +34,7 @@ val direct_atomic_property_access_warning : (* CXX_REFERENCE_CAPTURED_IN_OBJC_BLOCK: C++ references should not be captured in blocks. *) -val captured_cxx_ref_in_objc_block_warning : Clang_ast_t.stmt_info -> (Pvar.t * Sil.typ) list -> +val captured_cxx_ref_in_objc_block_warning : Clang_ast_t.stmt_info -> (Pvar.t * Typ.t) list -> warning_desc option (* REGISTERED_OBSERVER_BEING_DEALLOCATED: an object is registered in a notification center diff --git a/infer/src/clang/cFrontend_config.mli b/infer/src/clang/cFrontend_config.mli index 535f11153..ff4d1ed21 100644 --- a/infer/src/clang/cFrontend_config.mli +++ b/infer/src/clang/cFrontend_config.mli @@ -131,7 +131,7 @@ val pointer_type_index : Clang_ast_t.c_type Clang_ast_main.PointerMap.t ref (** Map from type pointers (clang pointers and types created later by frontend) to sil types Populated during frontend execution when new type is found *) -val sil_types_map : (Sil.typ Clang_ast_types.TypePointerMap.t) ref +val sil_types_map : (Typ.t Clang_ast_types.TypePointerMap.t) ref (** Map from enum constants pointers to their predecesor and their sil value *) val enum_map : (Clang_ast_t.pointer option * Sil.exp option) Clang_ast_main.PointerMap.t ref diff --git a/infer/src/clang/cFrontend_utils.ml b/infer/src/clang/cFrontend_utils.ml index f36282ca6..230267cf9 100644 --- a/infer/src/clang/cFrontend_utils.ml +++ b/infer/src/clang/cFrontend_utils.ml @@ -27,12 +27,12 @@ struct let annotation_to_string (annotation, _) = - "< " ^ annotation.Sil.class_name ^ " : " ^ - (IList.to_string (fun x -> x) annotation.Sil.parameters) ^ " >" + "< " ^ annotation.Typ.class_name ^ " : " ^ + (IList.to_string (fun x -> x) annotation.Typ.parameters) ^ " >" let field_to_string (fieldname, typ, annotation) = (Ident.fieldname_to_string fieldname) ^ " " ^ - (Sil.typ_to_string typ) ^ (IList.to_string annotation_to_string annotation) + (Typ.to_string typ) ^ (IList.to_string annotation_to_string annotation) let log_stats fmt = let pp = @@ -46,7 +46,7 @@ struct | Typename.TN_csu (Csu.Class _, _) | Typename.TN_csu (Csu.Protocol, _) -> print_endline ( (Typename.to_string typname) ^ " " ^ - (Sil.item_annotation_to_string struct_t.struct_annotations) ^ "\n" ^ + (Typ.item_annotation_to_string struct_t.struct_annotations) ^ "\n" ^ "---> superclass and protocols " ^ (IList.to_string (fun tn -> "\t" ^ (Typename.to_string tn) ^ "\n") struct_t.superclasses) ^ "---> methods " ^ @@ -64,15 +64,15 @@ struct (Typename.to_string typname)^"\n"^ "\t---> fields "^(IList.to_string (fun (fieldname, typ, _) -> match typ with - | Sil.Tvar tname -> "tvar"^(Typename.to_string tname) - | Sil.Tstruct _ | _ -> + | Typ.Tvar tname -> "tvar"^(Typename.to_string tname) + | Typ.Tstruct _ | _ -> "\t struct "^(Ident.fieldname_to_string fieldname)^" "^ - (Sil.typ_to_string typ)^"\n") struct_t.instance_fields + (Typ.to_string typ)^"\n") struct_t.instance_fields ) ) | Typename.TN_typedef typname -> print_endline - ((Mangled.to_string typname)^"-->"^(Sil.typ_to_string (Sil.Tstruct struct_t))) + ((Mangled.to_string typname)^"-->"^(Typ.to_string (Typ.Tstruct struct_t))) | _ -> () ) tenv @@ -100,7 +100,7 @@ end module Ast_utils = struct - type type_ptr_to_sil_type = Tenv.t -> Clang_ast_t.type_ptr -> Sil.typ + type type_ptr_to_sil_type = Tenv.t -> Clang_ast_t.type_ptr -> Typ.t let string_of_decl decl = let name = Clang_ast_proj.get_decl_kind_string decl in @@ -479,16 +479,16 @@ struct append_no_duplicates Procname.equal list1 list2 let append_no_duplicated_vars list1 list2 = - let eq (m1, t1) (m2, t2) = (Mangled.equal m1 m2) && (Sil.typ_equal t1 t2) in + let eq (m1, t1) (m2, t2) = (Mangled.equal m1 m2) && (Typ.equal t1 t2) in append_no_duplicates eq list1 list2 let append_no_duplicateds list1 list2 = - let eq (e1, t1) (e2, t2) = (Sil.exp_equal e1 e2) && (Sil.typ_equal t1 t2) in + let eq (e1, t1) (e2, t2) = (Sil.exp_equal e1 e2) && (Typ.equal t1 t2) in append_no_duplicates eq list1 list2 let append_no_duplicates_annotations list1 list2 = - let eq (annot1, _) (annot2, _) = annot1.Sil.class_name = annot2.Sil.class_name in + let eq (annot1, _) (annot2, _) = annot1.Typ.class_name = annot2.Typ.class_name in append_no_duplicates eq list1 list2 let add_no_duplicates_fields field_tuple l = @@ -496,7 +496,7 @@ struct match field_tuple, l with | (field, typ, annot), ((old_field, old_typ, old_annot) as old_field_tuple :: rest) -> let ret_list, ret_found = replace_field field_tuple rest found in - if Ident.fieldname_equal field old_field && Sil.typ_equal typ old_typ then + if Ident.fieldname_equal field old_field && Typ.equal typ old_typ then let annotations = append_no_duplicates_annotations annot old_annot in (field, typ, annotations) :: ret_list, true else old_field_tuple :: ret_list, ret_found @@ -520,7 +520,7 @@ struct let sort_fields_tenv tenv = let sort_fields_struct typname st = - let st' = { st with Sil.instance_fields = (sort_fields st.Sil.instance_fields) } in + let st' = { st with Typ.instance_fields = (sort_fields st.Typ.instance_fields) } in Tenv.add tenv typname st' in Tenv.iter sort_fields_struct tenv diff --git a/infer/src/clang/cFrontend_utils.mli b/infer/src/clang/cFrontend_utils.mli index 4c9f07208..1ab5bec24 100644 --- a/infer/src/clang/cFrontend_utils.mli +++ b/infer/src/clang/cFrontend_utils.mli @@ -33,7 +33,7 @@ sig val instrs_to_string : Sil.instr list -> string - val field_to_string : Ident.fieldname * Sil.typ * Sil.item_annotation -> string + val field_to_string : Ident.fieldname * Typ.t * Typ.item_annotation -> string end module Ast_utils : @@ -86,7 +86,7 @@ sig val get_decl_opt_with_decl_ref : Clang_ast_t.decl_ref option -> Clang_ast_t.decl option - val update_sil_types_map : Clang_ast_t.type_ptr -> Sil.typ -> unit + val update_sil_types_map : Clang_ast_t.type_ptr -> Typ.t -> unit val update_enum_map : Clang_ast_t.pointer -> Sil.exp -> unit @@ -120,7 +120,7 @@ sig val make_qual_name_decl : string list -> string -> Clang_ast_t.named_decl_info - type type_ptr_to_sil_type = Tenv.t -> Clang_ast_t.type_ptr -> Sil.typ + type type_ptr_to_sil_type = Tenv.t -> Clang_ast_t.type_ptr -> Typ.t val add_type_from_decl_ref : type_ptr_to_sil_type -> Tenv.t -> Clang_ast_t.decl_ref option -> bool -> unit @@ -156,9 +156,9 @@ sig val string_from_list : string list -> string - val append_no_duplicates_fields : (Ident.fieldname * Sil.typ * Sil.item_annotation) list -> - (Ident.fieldname * Sil.typ * Sil.item_annotation) list -> - (Ident.fieldname * Sil.typ * Sil.item_annotation) list + val append_no_duplicates_fields : (Ident.fieldname * Typ.t * Typ.item_annotation) list -> + (Ident.fieldname * Typ.t * Typ.item_annotation) list -> + (Ident.fieldname * Typ.t * Typ.item_annotation) list val append_no_duplicates_csu : Typename.t list -> Typename.t list -> Typename.t list @@ -166,14 +166,14 @@ sig val append_no_duplicates_methods : Procname.t list -> Procname.t list -> Procname.t list val append_no_duplicated_vars : - (Mangled.t * Sil.typ) list -> (Mangled.t * Sil.typ) list -> (Mangled.t * Sil.typ) list + (Mangled.t * Typ.t) list -> (Mangled.t * Typ.t) list -> (Mangled.t * Typ.t) list val append_no_duplicateds : - (Sil.exp * Sil.typ) list -> (Sil.exp * Sil.typ) list -> (Sil.exp * Sil.typ) list + (Sil.exp * Typ.t) list -> (Sil.exp * Typ.t) list -> (Sil.exp * Typ.t) list val sort_fields : - (Ident.fieldname * Sil.typ * Sil.item_annotation) list -> - (Ident.fieldname * Sil.typ * Sil.item_annotation) list + (Ident.fieldname * Typ.t * Typ.item_annotation) list -> + (Ident.fieldname * Typ.t * Typ.item_annotation) list val sort_fields_tenv : Tenv.t -> unit diff --git a/infer/src/clang/cMethod_signature.ml b/infer/src/clang/cMethod_signature.ml index 7e53a34ad..8e52b5eac 100644 --- a/infer/src/clang/cMethod_signature.ml +++ b/infer/src/clang/cMethod_signature.ml @@ -23,7 +23,7 @@ type method_signature = { language : Config.clang_lang; pointer_to_parent : Clang_ast_t.pointer option; pointer_to_property_opt : Clang_ast_t.pointer option; (* If set then method is a getter/setter *) - return_param_typ : Sil.typ option; + return_param_typ : Typ.t option; } let ms_get_name { name } = diff --git a/infer/src/clang/cMethod_signature.mli b/infer/src/clang/cMethod_signature.mli index 4026099ac..8c61d8f47 100644 --- a/infer/src/clang/cMethod_signature.mli +++ b/infer/src/clang/cMethod_signature.mli @@ -37,7 +37,7 @@ val ms_get_pointer_to_parent : method_signature -> Clang_ast_t.pointer option val ms_get_pointer_to_property_opt : method_signature -> Clang_ast_t.pointer option -val ms_get_return_param_typ : method_signature -> Sil.typ option +val ms_get_return_param_typ : method_signature -> Typ.t option val ms_is_getter : method_signature -> bool @@ -46,7 +46,7 @@ val ms_is_setter : method_signature -> bool val make_ms : Procname.t -> (string * Clang_ast_t.type_ptr) list -> Clang_ast_t.type_ptr -> Clang_ast_t.attribute list -> Clang_ast_t.source_range -> bool -> ?is_cpp_virtual:bool -> Config.clang_lang -> Clang_ast_t.pointer option -> Clang_ast_t.pointer option - -> Sil.typ option -> method_signature + -> Typ.t option -> method_signature val replace_name_ms : method_signature -> Procname.t -> method_signature diff --git a/infer/src/clang/cMethod_trans.ml b/infer/src/clang/cMethod_trans.ml index 59233fcbf..d091e3df1 100644 --- a/infer/src/clang/cMethod_trans.ml +++ b/infer/src/clang/cMethod_trans.ml @@ -64,7 +64,7 @@ let get_class_param function_method_decl_info = let should_add_return_param return_type ~is_objc_method = match return_type with - | Sil.Tstruct _ -> not is_objc_method + | Typ.Tstruct _ -> not is_objc_method | _ -> false let is_objc_method function_method_decl_info = @@ -112,7 +112,7 @@ let get_parameters tenv function_method_decl_info = let name = General_utils.get_var_name_string name_info var_decl_info in let param_typ = CTypes_decl.type_ptr_to_sil_type tenv type_ptr in let type_ptr' = match param_typ with - | Sil.Tstruct _ when General_utils.is_cpp_translation Config.clang_lang -> + | Typ.Tstruct _ when General_utils.is_cpp_translation Config.clang_lang -> Ast_expressions.create_reference_type type_ptr | _ -> type_ptr in (name, type_ptr') @@ -126,7 +126,7 @@ let get_return_type tenv function_method_decl_info = let return_typ = CTypes_decl.type_ptr_to_sil_type tenv return_type_ptr in let is_objc_method = is_objc_method function_method_decl_info in if should_add_return_param return_typ ~is_objc_method then - Ast_expressions.create_void_type, Some (Sil.Tptr (return_typ, Sil.Pk_pointer)) + Ast_expressions.create_void_type, Some (Typ.Tptr (return_typ, Typ.Pk_pointer)) else return_type_ptr, None let build_method_signature tenv decl_info procname function_method_decl_info @@ -238,7 +238,7 @@ let get_superclass_curr_class_objc context = let iname = Typename.TN_csu (Csu.Class Csu.Objc, Mangled.from_string cname) in Printing.log_out "Checking for superclass = '%s'\n\n%!" (Typename.to_string iname); match Tenv.lookup (CContext.get_tenv context) iname with - | Some { Sil.superclasses = super_name :: _ } -> + | Some { Typ.superclasses = super_name :: _ } -> Typename.name super_name | _ -> Printing.log_err "NOT FOUND superclass = '%s'\n\n%!" (Typename.to_string iname); @@ -277,7 +277,7 @@ let get_class_name_method_call_from_receiver_kind context obj_c_message_expr_inf (CTypes.classname_of_type sil_type) | `Instance -> (match act_params with - | (_, Sil.Tptr(t, _)):: _ + | (_, Typ.Tptr(t, _)):: _ | (_, t):: _ -> CTypes.classname_of_type t | _ -> assert false) | `SuperInstance ->get_superclass_curr_class_objc context @@ -343,10 +343,10 @@ let should_create_procdesc cfg procname defined = else false | None -> true -let sil_method_annotation_of_args args : Sil.method_annotation = +let sil_method_annotation_of_args args : Typ.method_annotation = let default_visibility = true in let mk_annot param_name annot_name = - let annot = { Sil.class_name = annot_name; Sil.parameters = [param_name]; } in + let annot = { Typ.class_name = annot_name; Typ.parameters = [param_name]; } in annot, default_visibility in let arg_to_sil_annot acc (arg_name, type_ptr) = if CFrontend_utils.Ast_utils.is_type_nullable type_ptr then @@ -417,7 +417,7 @@ let create_external_procdesc cfg proc_name is_objc_inst_method type_opt = (match type_opt with | Some (ret_type, arg_types) -> ret_type, IList.map (fun typ -> (Mangled.from_string "x", typ)) arg_types - | None -> Sil.Tvoid, []) in + | None -> Typ.Tvoid, []) in let loc = Location.dummy in let proc_attributes = { (ProcAttributes.default proc_name Config.Clang) with diff --git a/infer/src/clang/cMethod_trans.mli b/infer/src/clang/cMethod_trans.mli index f69645f64..1f1e9c153 100644 --- a/infer/src/clang/cMethod_trans.mli +++ b/infer/src/clang/cMethod_trans.mli @@ -22,18 +22,18 @@ type method_call_type = | MCNoVirtual | MCStatic -val should_add_return_param : Sil.typ -> is_objc_method:bool -> bool +val should_add_return_param : Typ.t -> is_objc_method:bool -> bool val create_local_procdesc : Cfg.cfg -> Tenv.t -> CMethod_signature.method_signature -> - Clang_ast_t.stmt list -> (Pvar.t * Sil.typ) list -> bool -> bool + Clang_ast_t.stmt list -> (Pvar.t * Typ.t) list -> bool -> bool -val create_external_procdesc : Cfg.cfg -> Procname.t -> bool -> (Sil.typ * Sil.typ list) option -> unit +val create_external_procdesc : Cfg.cfg -> Procname.t -> bool -> (Typ.t * Typ.t list) option -> unit val get_objc_method_data : Clang_ast_t.obj_c_message_expr_info -> (string * Clang_ast_t.pointer option * method_call_type) val get_class_name_method_call_from_receiver_kind : CContext.t -> - Clang_ast_t.obj_c_message_expr_info -> (Sil.exp * Sil.typ) list -> string + Clang_ast_t.obj_c_message_expr_info -> (Sil.exp * Typ.t) list -> string val get_class_name_method_call_from_clang : Tenv.t -> Clang_ast_t.obj_c_message_expr_info -> string option diff --git a/infer/src/clang/cModule_type.ml b/infer/src/clang/cModule_type.ml index 0359cfceb..deedd3bca 100644 --- a/infer/src/clang/cModule_type.ml +++ b/infer/src/clang/cModule_type.ml @@ -9,7 +9,7 @@ open! Utils -type block_data = CContext.t * Clang_ast_t.type_ptr * Procname.t * (Pvar.t * Sil.typ) list +type block_data = CContext.t * Clang_ast_t.type_ptr * Procname.t * (Pvar.t * Typ.t) list type instr_type = [ | `ClangStmt of Clang_ast_t.stmt diff --git a/infer/src/clang/cTrans.ml b/infer/src/clang/cTrans.ml index 84c63b8a2..5f2a9a111 100644 --- a/infer/src/clang/cTrans.ml +++ b/infer/src/clang/cTrans.ml @@ -117,7 +117,7 @@ struct let vname = Pvar.get_name var in let qual_name = Ast_utils.make_qual_name_decl [block_name] (Mangled.to_string vname) in let fname = General_utils.mk_class_field_name qual_name in - let item_annot = Sil.item_annotation_empty in + let item_annot = Typ.item_annotation_empty in fname, typ, item_annot in let fields = IList.map mk_field_from_captured_var captured_vars in Printing.log_out "Block %s field:\n" block_name; @@ -126,7 +126,7 @@ struct let mblock = Mangled.from_string block_name in let block_struct_typ = { - Sil.instance_fields = fields; + Typ.instance_fields = fields; static_fields = []; csu = Csu.Class Csu.Objc; struct_name = Some mblock; @@ -134,7 +134,7 @@ struct def_methods = []; struct_annotations = []; } in - let block_type = Sil.Tstruct block_struct_typ in + let block_type = Typ.Tstruct block_struct_typ in let block_name = Typename.TN_csu (Csu.Class Csu.Objc, mblock) in Tenv.add tenv block_name block_struct_typ; let trans_res = @@ -145,7 +145,7 @@ struct | _ -> assert false in let block_var = Pvar.mk mblock procname in let declare_block_local = - Sil.Declare_locals ([(block_var, Sil.Tptr (block_type, Sil.Pk_pointer))], loc) in + Sil.Declare_locals ([(block_var, Typ.Tptr (block_type, Typ.Pk_pointer))], loc) in let set_instr = Sil.Set (Sil.Lvar block_var, block_type, Sil.Var id_block, loc) in let create_field_exp (var, typ) = let id = Ident.create_fresh Ident.knormal in @@ -175,7 +175,7 @@ struct match es with | [] -> [] | (Sil.Const (Sil.Cclosure { name; captured_vars}), - (Sil.Tptr((Sil.Tfun _), _ ) as t)) :: es' -> + (Typ.Tptr((Typ.Tfun _), _ ) as t)) :: es' -> let app = let function_name = make_function_name t name in let args = IList.map (make_arg t) captured_vars in @@ -216,7 +216,7 @@ struct CTypes_decl.objc_class_name_to_sil_type trans_state.context.CContext.tenv class_name in let expanded_type = CTypes.expand_structured_type trans_state.context.CContext.tenv typ in { empty_res_trans with - exps = [(Sil.Sizeof(expanded_type, None, Sil.Subtype.exact), Sil.Tint Sil.IULong)] } + exps = [(Sil.Sizeof(expanded_type, None, Sil.Subtype.exact), Typ.Tint Typ.IULong)] } let add_reference_if_glvalue typ expr_info = (* glvalue definition per C++11:*) @@ -225,12 +225,12 @@ struct | `LValue | `XValue -> true | `RValue -> false in match is_glvalue, typ with - | true, Sil.Tptr (_, Sil.Pk_reference) -> + | true, Typ.Tptr (_, Typ.Pk_reference) -> (* reference of reference is not allowed in C++ - it's most likely frontend *) (* trying to add same reference to same type twice*) (* this is hacky and should be fixed (t9838691) *) typ - | true, _ -> Sil.Tptr (typ, Sil.Pk_reference) + | true, _ -> Typ.Tptr (typ, Typ.Pk_reference) | _ -> typ (** Execute translation and then possibly adjust the type of the result of translation: @@ -283,12 +283,12 @@ struct let create_call_instr trans_state return_type function_sil params_sil sil_loc call_flags ~is_objc_method = - let ret_id = if (Sil.typ_equal return_type Sil.Tvoid) then [] + let ret_id = if (Typ.equal return_type Typ.Tvoid) then [] else [Ident.create_fresh Ident.knormal] in let ret_id', params, initd_exps, ret_exps = (* Assumption: should_add_return_param will return true only for struct types *) if CMethod_trans.should_add_return_param return_type ~is_objc_method then - let param_type = Sil.Tptr (return_type, Sil.Pk_pointer) in + let param_type = Typ.Tptr (return_type, Typ.Pk_pointer) in let var_exp = match trans_state.var_exp_typ with | Some (exp, _) -> exp | _ -> @@ -396,8 +396,8 @@ struct let typ = CTypes_decl.get_type_from_expr_info expr_info trans_state.context.CContext.tenv in (* constant will be different depending on type *) let zero_opt = match typ with - | Sil.Tfloat _ | Sil.Tptr _ | Sil.Tint _ -> Some (Sil.zero_value_of_numerical_type typ) - | Sil.Tvoid -> None + | Typ.Tfloat _ | Typ.Tptr _ | Typ.Tint _ -> Some (Sil.zero_value_of_numerical_type typ) + | Typ.Tvoid -> None | _ -> Some (Sil.Const (Sil.Cint IntLit.zero)) in match zero_opt with | Some zero -> { empty_res_trans with exps = [(zero, typ)] } @@ -478,9 +478,9 @@ struct let _, _, type_ptr = Ast_utils.get_info_from_decl_ref decl_ref in let ast_typ = CTypes_decl.type_ptr_to_sil_type context.tenv type_ptr in let typ = match ast_typ with - | Sil.Tstruct _ when decl_ref.Clang_ast_t.dr_kind = `ParmVar -> + | Typ.Tstruct _ when decl_ref.Clang_ast_t.dr_kind = `ParmVar -> if General_utils.is_cpp_translation Config.clang_lang then - Sil.Tptr (ast_typ, Sil.Pk_reference) + Typ.Tptr (ast_typ, Typ.Pk_reference) else ast_typ | _ -> ast_typ in let procname = Cfg.Procdesc.get_proc_name context.procdesc in @@ -500,7 +500,7 @@ struct Printing.log_out "\n\n PVAR ='%s'\n\n" (Pvar.to_string pvar); let res_trans = { empty_res_trans with exps = exps } in match typ with - | Sil.Tptr (_, Sil.Pk_reference) -> + | Typ.Tptr (_, Typ.Pk_reference) -> (* dereference pvar due to the behavior of reference types in clang's AST *) dereference_value_from_result sil_loc res_trans ~strip_pointer:true | _ -> res_trans @@ -515,13 +515,13 @@ struct let (obj_sil, class_typ) = extract_exp_from_list pre_trans_result.exps "WARNING: in Field dereference we expect to know the object\n" in let is_pointer_typ = match class_typ with - | Sil.Tptr _ -> true + | Typ.Tptr _ -> true | _ -> false in let class_typ = match class_typ with - | Sil.Tptr (t, _) -> CTypes.expand_structured_type context.CContext.tenv t + | Typ.Tptr (t, _) -> CTypes.expand_structured_type context.CContext.tenv t | t -> t in - Printing.log_out "Type is '%s' @." (Sil.typ_to_string class_typ); + Printing.log_out "Type is '%s' @." (Typ.to_string class_typ); let field_name = General_utils.mk_class_field_name name_info in let field_exp = Sil.Lfield (obj_sil, field_name, class_typ) in (* In certain cases, there is be no LValueToRValue cast, but backend needs dereference*) @@ -570,12 +570,12 @@ struct | [] -> [], [] (* We need to add a dereference before a method call to find null dereferences when *) (* calling a method with null *) - | [(exp, Sil.Tptr (typ, _) )] when decl_kind <> `CXXConstructor -> + | [(exp, Typ.Tptr (typ, _) )] when decl_kind <> `CXXConstructor -> let typ = CTypes.expand_structured_type context.tenv typ in let extra_instrs, _ = CTrans_utils.dereference_var_sil (exp, typ) sil_loc in pre_trans_result.exps, extra_instrs - | [(_, Sil.Tptr _ )] -> pre_trans_result.exps, [] - | [(sil, typ)] -> [(sil, Sil.Tptr (typ, Sil.Pk_reference))], [] + | [(_, Typ.Tptr _ )] -> pre_trans_result.exps, [] + | [(sil, typ)] -> [(sil, Typ.Tptr (typ, Typ.Pk_reference))], [] | _ -> assert false ) else @@ -855,7 +855,7 @@ struct NEED TO BE FIXED\n\n"; fix_param_exps_mismatch params_stmt params) in let act_params = if is_cf_retain_release then - (Sil.Const (Sil.Cint IntLit.one), Sil.Tint Sil.IBool) :: act_params + (Sil.Const (Sil.Cint IntLit.one), Typ.Tint Typ.IBool) :: act_params else act_params in match CTrans_utils.builtin_trans trans_state_pri sil_loc si function_type callee_pname_opt with @@ -966,8 +966,8 @@ struct Sil.Lvar pvar, class_type in let this_type = match class_type with - | Sil.Tptr _ -> class_type - | _ -> Sil.Tptr (class_type, Sil.Pk_pointer) in + | Typ.Tptr _ -> class_type + | _ -> Typ.Tptr (class_type, Typ.Pk_pointer) in let this_res_trans = { empty_res_trans with exps = [(var_exp, this_type)]; initd_exps = [var_exp]; @@ -975,7 +975,7 @@ struct let res_trans_callee = decl_ref_trans trans_state this_res_trans si decl_ref ~is_constructor_init:false in let res_trans = cxx_method_construct_call_trans trans_state_pri res_trans_callee - params_stmt si Sil.Tvoid false in + params_stmt si Typ.Tvoid false in { res_trans with exps = [(var_exp, class_type)] } and cxx_destructor_call_trans trans_state si this_res_trans class_type_ptr = @@ -983,7 +983,7 @@ struct let res_trans_callee = destructor_deref_trans trans_state this_res_trans class_type_ptr si in let is_cpp_call_virtual = res_trans_callee.is_cpp_call_virtual in if res_trans_callee.exps <> [] then - cxx_method_construct_call_trans trans_state_pri res_trans_callee [] si Sil.Tvoid + cxx_method_construct_call_trans trans_state_pri res_trans_callee [] si Typ.Tvoid is_cpp_call_virtual else empty_res_trans @@ -1185,7 +1185,7 @@ struct Printing.log_out " No short-circuit condition\n"; let res_trans_cond = if is_null_stmt cond then { - empty_res_trans with exps = [(Sil.Const (Sil.Cint IntLit.one), (Sil.Tint Sil.IBool))] + empty_res_trans with exps = [(Sil.Const (Sil.Cint IntLit.one), (Typ.Tint Typ.IBool))] } (* Assumption: If it's a null_stmt, it is a loop with no bound, so we set condition to 1 *) else @@ -1584,7 +1584,7 @@ struct and initListExpr_trans trans_state stmt_info expr_info stmts = let context = trans_state.context in let tenv = context.tenv in - let is_array typ = match typ with | Sil.Tarray _ -> true | _ -> false in + let is_array typ = match typ with | Typ.Tarray _ -> true | _ -> false in let (var_exp, typ) = match trans_state.var_exp_typ with | Some var_exp_typ -> var_exp_typ @@ -1871,7 +1871,7 @@ struct let pvar = Pvar.mk (Mangled.from_string name) procname in let id = Ident.create_fresh Ident.knormal in let instr = Sil.Letderef (id, Sil.Lvar pvar, ret_param_typ, sil_loc) in - let ret_typ = match ret_param_typ with Sil.Tptr (t, _) -> t | _ -> assert false in + let ret_typ = match ret_param_typ with Typ.Tptr (t, _) -> t | _ -> assert false in Sil.Var id, ret_typ, [instr] | None -> Sil.Lvar (Cfg.Procdesc.get_ret_var procdesc), ret_type, [] in @@ -2032,8 +2032,8 @@ struct and initListExpr_initializers_trans trans_state var_exp n stmts typ is_dyn_array stmt_info = let (var_exp_inside, typ_inside) = match typ with - | Sil.Tarray (t, _) - | Sil.Tptr (t, _) when Sil.is_array_of_cpp_class typ || is_dyn_array -> + | Typ.Tarray (t, _) + | Typ.Tptr (t, _) when Typ.is_array_of_cpp_class typ || is_dyn_array -> Sil.Lindex (var_exp, Sil.Const (Sil.Cint (IntLit.of_int n))), t | _ -> var_exp, typ in let trans_state' = { trans_state with var_exp_typ = Some (var_exp_inside, typ_inside) } in @@ -2096,7 +2096,7 @@ struct let init_stmt_info = { stmt_info with Clang_ast_t.si_pointer = Ast_utils.get_fresh_pointer () } in let res_trans_init = - if is_dyn_array && Sil.is_pointer_to_cpp_class typ then + if is_dyn_array && Typ.is_pointer_to_cpp_class typ then let rec create_stmts stmt_opt size_exp_opt = match stmt_opt, size_exp_opt with | Some stmt, Some (Sil.Const (Sil.Cint n)) when not (IntLit.iszero n) -> @@ -2174,13 +2174,13 @@ struct let sil_loc = CLocation.get_sil_location stmt_info context in let cast_type = CTypes_decl.type_ptr_to_sil_type tenv cast_type_ptr in let sizeof_expr = match cast_type with - | Sil.Tptr (typ, _) -> Sil.Sizeof (typ, None, subtypes) + | Typ.Tptr (typ, _) -> Sil.Sizeof (typ, None, subtypes) | _ -> assert false in let builtin = Sil.Const (Sil.Cfun ModelBuiltins.__cast) in let stmt = match stmts with [stmt] -> stmt | _ -> assert false in let res_trans_stmt = exec_with_glvalue_as_reference instruction trans_state' stmt in let exp = match res_trans_stmt.exps with | [e] -> e | _ -> assert false in - let args = [exp; (sizeof_expr, Sil.Tvoid)] in + let args = [exp; (sizeof_expr, Typ.Tvoid)] in let ret_id = Ident.create_fresh Ident.knormal in let call = Sil.Call ([ret_id], builtin, args, sil_loc, Sil.cf_default) in let res_ex = Sil.Var ret_id in @@ -2216,7 +2216,7 @@ struct and cxxPseudoDestructorExpr_trans () = let fun_name = Procname.from_string_c_fun CFrontend_config.infer_skip_fun in - { empty_res_trans with exps = [(Sil.Const (Sil.Cfun fun_name), Sil.Tvoid)] } + { empty_res_trans with exps = [(Sil.Const (Sil.Cfun fun_name), Typ.Tvoid)] } and cxxTypeidExpr_trans trans_state stmt_info stmts expr_info = let tenv = trans_state.context.CContext.tenv in @@ -2232,12 +2232,12 @@ struct let fun_name = ModelBuiltins.__cxx_typeid in let sil_fun = Sil.Const (Sil.Cfun fun_name) in let ret_id = Ident.create_fresh Ident.knormal in - let type_info_objc = (Sil.Sizeof (typ, None, Sil.Subtype.exact), Sil.Tvoid) in + let type_info_objc = (Sil.Sizeof (typ, None, Sil.Subtype.exact), Typ.Tvoid) in let field_name_decl = Ast_utils.make_qual_name_decl ["type_info"; "std"] "__type_name" in let field_name = General_utils.mk_class_field_name field_name_decl in let ret_exp = Sil.Var ret_id in let field_exp = Sil.Lfield (ret_exp, field_name, typ) in - let args = [type_info_objc; (field_exp, Sil.Tvoid)] @ res_trans_subexpr.exps in + let args = [type_info_objc; (field_exp, Typ.Tvoid)] @ res_trans_subexpr.exps in let call_instr = Sil.Call ([ret_id], sil_fun, args, sil_loc, Sil.cf_default) in let res_trans_call = { empty_res_trans with instrs = [call_instr]; @@ -2553,7 +2553,7 @@ struct implicitValueInitExpr_trans trans_state expr_info | GenericSelectionExpr _ (* to be fixed when we dump the right info in the ast *) | SizeOfPackExpr _ -> - { empty_res_trans with exps = [(Sil.exp_get_undefined false, Sil.Tvoid)] } + { empty_res_trans with exps = [(Sil.exp_get_undefined false, Typ.Tvoid)] } | GCCAsmStmt (stmt_info, stmts) -> gccAstStmt_trans trans_state stmt_info stmts @@ -2599,7 +2599,7 @@ struct "WARNING: There should be one expression for 'this' in constructor. \n" in (* Hack: Strip pointer from type here since cxxConstructExpr_trans expects it this way *) (* it will add pointer back before making it a parameter to a call *) - let class_typ = match this_typ with Sil.Tptr (t, _) -> t | _ -> assert false in + let class_typ = match this_typ with Typ.Tptr (t, _) -> t | _ -> assert false in { this_res_trans with exps = [this_exp, class_typ] } | `Member (decl_ref) -> decl_ref_trans trans_state' this_res_trans child_stmt_info decl_ref diff --git a/infer/src/clang/cTrans_models.ml b/infer/src/clang/cTrans_models.ml index 7b927fcfb..2dc912894 100644 --- a/infer/src/clang/cTrans_models.ml +++ b/infer/src/clang/cTrans_models.ml @@ -31,7 +31,8 @@ let is_alloc_model typ funct = else let funct = Procname.to_string procname in (* if (Core_foundation_model.is_core_lib_create typ funct) then - print_endline ("\nCore Foundation create not modelled "^(Sil.typ_to_string typ)^" "^(funct));*) + print_endline ("\nCore Foundation create not modelled " + ^(Typ.to_string typ)^" "^(funct));*) Core_foundation_model.is_core_lib_create typ funct | None -> false diff --git a/infer/src/clang/cTrans_models.mli b/infer/src/clang/cTrans_models.mli index 62a05b1df..62b55edb9 100644 --- a/infer/src/clang/cTrans_models.mli +++ b/infer/src/clang/cTrans_models.mli @@ -13,7 +13,7 @@ val is_cf_non_null_alloc : Procname.t option -> bool val is_alloc : Procname.t option -> bool -val is_alloc_model : Sil.typ -> Procname.t option -> bool +val is_alloc_model : Typ.t -> Procname.t option -> bool val is_objc_memory_model_controlled : string -> bool diff --git a/infer/src/clang/cTrans_utils.ml b/infer/src/clang/cTrans_utils.ml index f3dc628aa..6f9ff327a 100644 --- a/infer/src/clang/cTrans_utils.ml +++ b/infer/src/clang/cTrans_utils.ml @@ -24,7 +24,7 @@ let extract_item_from_singleton l warning_string failure_val = | [item] -> item | _ -> Printing.log_err "%s" warning_string; failure_val -let dummy_exp = (Sil.exp_minus_one, Sil.Tint Sil.IInt) +let dummy_exp = (Sil.exp_minus_one, Typ.Tint Typ.IInt) (* Extract the element of a singleton list. If the list is not a singleton *) (* Gives a warning and return -1 as standard value indicating something *) @@ -130,9 +130,9 @@ type trans_state = { succ_nodes: Cfg.Node.t list; (* successor nodes in the cfg *) continuation: continuation option; (* current continuation *) priority: priority_node; - var_exp_typ: (Sil.exp * Sil.typ) option; - opaque_exp: (Sil.exp * Sil.typ) option; - obj_bridged_cast_typ : Sil.typ option + var_exp_typ: (Sil.exp * Typ.t) option; + opaque_exp: (Sil.exp * Typ.t) option; + obj_bridged_cast_typ : Typ.t option } (* A translation result. It is returned by the translation function. *) @@ -140,7 +140,7 @@ type trans_result = { root_nodes: Cfg.Node.t list; (* Top cfg nodes (root) created by the translation *) leaf_nodes: Cfg.Node.t list; (* Bottom cfg nodes (leaf) created by the translate *) instrs: Sil.instr list; (* list of SIL instruction that need to be placed in cfg nodes of the parent*) - exps: (Sil.exp * Sil.typ) list; (* SIL expressions resulting from the translation of the clang stmt *) + exps: (Sil.exp * Typ.t) list; (* SIL expressions resulting from translation of clang stmt *) initd_exps: Sil.exp list; is_cpp_call_virtual : bool; } @@ -289,20 +289,20 @@ end let create_alloc_instrs context sil_loc function_type fname size_exp_opt procname_opt = let function_type, function_type_np = match function_type with - | Sil.Tptr (styp, Sil.Pk_pointer) - | Sil.Tptr (styp, Sil.Pk_objc_weak) - | Sil.Tptr (styp, Sil.Pk_objc_unsafe_unretained) - | Sil.Tptr (styp, Sil.Pk_objc_autoreleasing) -> + | Typ.Tptr (styp, Typ.Pk_pointer) + | Typ.Tptr (styp, Typ.Pk_objc_weak) + | Typ.Tptr (styp, Typ.Pk_objc_unsafe_unretained) + | Typ.Tptr (styp, Typ.Pk_objc_autoreleasing) -> function_type, styp - | _ -> Sil.Tptr (function_type, Sil.Pk_pointer), function_type in + | _ -> Typ.Tptr (function_type, Typ.Pk_pointer), function_type in let function_type_np = CTypes.expand_structured_type context.CContext.tenv function_type_np in let sizeof_exp_ = Sil.Sizeof (function_type_np, None, Sil.Subtype.exact) in let sizeof_exp = match size_exp_opt with | Some exp -> Sil.BinOp (Sil.Mult, sizeof_exp_, exp) | None -> sizeof_exp_ in - let exp = (sizeof_exp, Sil.Tint Sil.IULong) in + let exp = (sizeof_exp, Typ.Tint Typ.IULong) in let procname_arg = match procname_opt with - | Some procname -> [Sil.Const (Sil.Cfun (procname)), Sil.Tvoid] + | Some procname -> [Sil.Const (Sil.Cfun (procname)), Typ.Tvoid] | None -> [] in let args = exp :: procname_arg in let ret_id = Ident.create_fresh Ident.knormal in @@ -368,7 +368,7 @@ let create_cast_instrs context exp cast_from_typ cast_to_typ sil_loc = let cast_typ_no_pointer = CTypes.expand_structured_type context.CContext.tenv typ in let sizeof_exp = Sil.Sizeof (cast_typ_no_pointer, None, Sil.Subtype.exact) in let pname = ModelBuiltins.__objc_cast in - let args = [(exp, cast_from_typ); (sizeof_exp, Sil.Tint Sil.IULong)] in + let args = [(exp, cast_from_typ); (sizeof_exp, Typ.Tint Typ.IULong)] in let stmt_call = Sil.Call([ret_id], (Sil.Const (Sil.Cfun pname)), args, sil_loc, Sil.cf_default) in (stmt_call, Sil.Var ret_id) @@ -398,7 +398,7 @@ let dereference_var_sil (exp, typ) sil_loc = let dereference_value_from_result sil_loc trans_result ~strip_pointer = let (obj_sil, class_typ) = extract_exp_from_list trans_result.exps "" in let cast_inst, cast_exp = dereference_var_sil (obj_sil, class_typ) sil_loc in - let typ_no_ptr = match class_typ with | Sil.Tptr (typ, _) -> typ | _ -> assert false in + let typ_no_ptr = match class_typ with | Typ.Tptr (typ, _) -> typ | _ -> assert false in let cast_typ = if strip_pointer then typ_no_ptr else class_typ in { trans_result with instrs = trans_result.instrs @ cast_inst; @@ -441,7 +441,7 @@ let cast_operation trans_state cast_kind exps cast_typ sil_loc is_objc_bridged = let trans_assertion_failure sil_loc context = let assert_fail_builtin = Sil.Const (Sil.Cfun ModelBuiltins.__infer_fail) in - let args = [Sil.Const (Sil.Cstr Config.default_failure_name), Sil.Tvoid] in + let args = [Sil.Const (Sil.Cstr Config.default_failure_name), Typ.Tvoid] in let call_instr = Sil.Call ([], assert_fail_builtin, args, sil_loc, Sil.cf_default) in let exit_node = Cfg.Procdesc.get_exit_node (CContext.get_procdesc context) and failure_node = @@ -621,7 +621,7 @@ let rec contains_opaque_value_expr s = (* checks if a unary operator is a logic negation applied to integers*) let is_logical_negation_of_int tenv ei uoi = match CTypes_decl.type_ptr_to_sil_type tenv ei.Clang_ast_t.ei_type_ptr, uoi.Clang_ast_t.uoi_kind with - | Sil.Tint Sil.IInt,`LNot -> true + | Typ.Tint Typ.IInt,`LNot -> true | _, _ -> false let rec is_block_stmt stmt = @@ -673,18 +673,18 @@ let var_or_zero_in_init_list tenv e typ ~return_zero:return_zero = let rec var_or_zero_in_init_list' e typ tns = let open General_utils in match typ with - | Sil.Tvar tn -> + | Typ.Tvar tn -> (match Tenv.lookup tenv tn with - | Some struct_typ -> var_or_zero_in_init_list' e (Sil.Tstruct struct_typ) tns + | Some struct_typ -> var_or_zero_in_init_list' e (Typ.Tstruct struct_typ) tns | _ -> [[(e, typ)]] (*This case is an error, shouldn't happen.*)) - | Sil.Tstruct { Sil.instance_fields } as type_struct -> + | Typ.Tstruct { Typ.instance_fields } as type_struct -> let lh_exprs = IList.map ( fun (fieldname, _, _) -> Sil.Lfield (e, fieldname, type_struct) ) instance_fields in let lh_types = IList.map ( fun (_, fieldtype, _) -> fieldtype) instance_fields in let exp_types = zip lh_exprs lh_types in IList.map (fun (e, t) -> IList.flatten (var_or_zero_in_init_list' e t tns)) exp_types - | Sil.Tarray (arrtyp, Some n) -> + | Typ.Tarray (arrtyp, Some n) -> let size = IntLit.to_int n in let indices = list_range 0 (size - 1) in let index_constants = @@ -695,10 +695,10 @@ let var_or_zero_in_init_list tenv e typ ~return_zero:return_zero = let exp_types = zip lh_exprs lh_types in IList.map (fun (e, t) -> IList.flatten (var_or_zero_in_init_list' e t tns)) exp_types - | Sil.Tint _ | Sil.Tfloat _ | Sil.Tptr _ -> + | Typ.Tint _ | Typ.Tfloat _ | Typ.Tptr _ -> let exp = if return_zero then Sil.zero_value_of_numerical_type typ else e in [ [(exp, typ)] ] - | Sil.Tfun _ | Sil.Tvoid | Sil.Tarray _ -> assert false in + | Typ.Tfun _ | Typ.Tvoid | Typ.Tarray _ -> assert false in IList.flatten (var_or_zero_in_init_list' e typ StringSet.empty) (* diff --git a/infer/src/clang/cTrans_utils.mli b/infer/src/clang/cTrans_utils.mli index 91574c16d..71415324c 100644 --- a/infer/src/clang/cTrans_utils.mli +++ b/infer/src/clang/cTrans_utils.mli @@ -26,16 +26,16 @@ type trans_state = { succ_nodes: Cfg.Node.t list; continuation: continuation option; priority: priority_node; - var_exp_typ: (Sil.exp * Sil.typ) option; - opaque_exp: (Sil.exp * Sil.typ) option; - obj_bridged_cast_typ : Sil.typ option + var_exp_typ: (Sil.exp * Typ.t) option; + opaque_exp: (Sil.exp * Typ.t) option; + obj_bridged_cast_typ : Typ.t option } type trans_result = { root_nodes: Cfg.Node.t list; leaf_nodes: Cfg.Node.t list; instrs: Sil.instr list; - exps: (Sil.exp * Sil.typ) list; + exps: (Sil.exp * Typ.t) list; initd_exps: Sil.exp list; is_cpp_call_virtual : bool; } @@ -44,7 +44,7 @@ val empty_res_trans: trans_result val collect_res_trans : Cfg.cfg -> trans_result list -> trans_result -val extract_var_exp_or_fail : trans_state -> Sil.exp * Sil.typ +val extract_var_exp_or_fail : trans_state -> Sil.exp * Typ.t val is_return_temp: continuation option -> bool @@ -56,15 +56,15 @@ val mk_cond_continuation : continuation option -> continuation option val extract_item_from_singleton : 'a list -> string -> 'a -> 'a -val extract_exp_from_list : (Sil.exp * Sil.typ) list -> string -> (Sil.exp * Sil.typ) +val extract_exp_from_list : (Sil.exp * Typ.t) list -> string -> (Sil.exp * Typ.t) -val fix_param_exps_mismatch : 'a list -> (Sil.exp * Sil.typ) list -> (Sil.exp * Sil.typ)list +val fix_param_exps_mismatch : 'a list -> (Sil.exp * Typ.t) list -> (Sil.exp * Typ.t)list val get_selector_receiver : Clang_ast_t.obj_c_message_expr_info -> string * Clang_ast_t.receiver_kind val define_condition_side_effects : - (Sil.exp * Sil.typ) list -> Sil.instr list -> Location.t -> - (Sil.exp * Sil.typ) list * Sil.instr list + (Sil.exp * Typ.t) list -> Sil.instr list -> Location.t -> + (Sil.exp * Typ.t) list * Sil.instr list val extract_stmt_from_singleton : Clang_ast_t.stmt list -> string -> Clang_ast_t.stmt @@ -81,8 +81,8 @@ val get_type_from_exp_stmt : Clang_ast_t.stmt -> Clang_ast_t.type_ptr val dereference_value_from_result : Location.t -> trans_result -> strip_pointer:bool -> trans_result val cast_operation : - trans_state -> Clang_ast_t.cast_kind -> (Sil.exp * Sil.typ) list -> Sil.typ -> Location.t -> - bool -> Sil.instr list * (Sil.exp * Sil.typ) + trans_state -> Clang_ast_t.cast_kind -> (Sil.exp * Typ.t) list -> Typ.t -> Location.t -> + bool -> Sil.instr list * (Sil.exp * Typ.t) val trans_assertion: Location.t -> CContext.t -> Cfg.Node.t list -> trans_result @@ -97,22 +97,22 @@ val contains_opaque_value_expr : Clang_ast_t.stmt -> bool val get_decl_ref_info : Clang_ast_t.stmt -> Clang_ast_t.decl_ref val builtin_trans : trans_state -> Location.t -> Clang_ast_t.stmt_info -> - Sil.typ -> Procname.t option -> trans_result option + Typ.t -> Procname.t option -> trans_result option val alloc_trans : - trans_state -> Location.t -> Clang_ast_t.stmt_info -> Sil.typ -> bool -> + trans_state -> Location.t -> Clang_ast_t.stmt_info -> Typ.t -> bool -> Procname.t option -> trans_result val new_or_alloc_trans : trans_state -> Location.t -> Clang_ast_t.stmt_info -> Clang_ast_t.type_ptr -> string option -> string -> trans_result -val cpp_new_trans : trans_state -> Location.t -> Sil.typ -> Sil.exp option -> trans_result +val cpp_new_trans : trans_state -> Location.t -> Typ.t -> Sil.exp option -> trans_result val cast_trans : - CContext.t -> (Sil.exp * Sil.typ) list -> Location.t -> Procname.t option -> Sil.typ -> + CContext.t -> (Sil.exp * Typ.t) list -> Location.t -> Procname.t option -> Typ.t -> (Sil.instr * Sil.exp) option -val dereference_var_sil : Sil.exp * Sil.typ -> Location.t -> Sil.instr list * Sil.exp +val dereference_var_sil : Sil.exp * Typ.t -> Location.t -> Sil.instr list * Sil.exp (** Module for creating cfg nodes and other utility functions related to them. *) module Nodes : @@ -126,7 +126,7 @@ sig val is_join_node : Cfg.Node.t -> bool val create_prune_node : - bool -> (Sil.exp * Sil.typ) list -> Sil.instr list -> Location.t -> Sil.if_kind -> + bool -> (Sil.exp * Typ.t) list -> Sil.instr list -> Location.t -> Sil.if_kind -> CContext.t -> Cfg.Node.t val is_prune_node : Cfg.Node.t -> bool @@ -216,5 +216,5 @@ val is_dispatch_function : Clang_ast_t.stmt list -> int option val is_block_enumerate_function : Clang_ast_t.obj_c_message_expr_info -> bool -val var_or_zero_in_init_list : Tenv.t -> Sil.exp -> Sil.typ -> return_zero:bool -> - (Sil.exp * Sil.typ) list +val var_or_zero_in_init_list : Tenv.t -> Sil.exp -> Typ.t -> return_zero:bool -> + (Sil.exp * Typ.t) list diff --git a/infer/src/clang/cType_to_sil_type.ml b/infer/src/clang/cType_to_sil_type.ml index 6f85183f4..05a15c0b8 100644 --- a/infer/src/clang/cType_to_sil_type.ml +++ b/infer/src/clang/cType_to_sil_type.ml @@ -17,54 +17,54 @@ let get_builtin_objc_typename builtin_type = | `ObjCClass -> Typename.TN_csu (Csu.Struct, (Mangled.from_string CFrontend_config.objc_class)) let get_builtin_objc_type builtin_type = - let typ = Sil.Tvar (get_builtin_objc_typename builtin_type) in + let typ = Typ.Tvar (get_builtin_objc_typename builtin_type) in match builtin_type with | `ObjCId -> typ - | `ObjCClass -> Sil.Tptr (typ, Sil.Pk_pointer) + | `ObjCClass -> Typ.Tptr (typ, Typ.Pk_pointer) let sil_type_of_builtin_type_kind builtin_type_kind = match builtin_type_kind with - | `Void -> Sil.Tvoid - | `Bool -> Sil.Tint Sil.IBool - | `Char_U -> Sil.Tint Sil.IUChar - | `UChar -> Sil.Tint Sil.IUChar - | `WChar_U -> Sil.Tint Sil.IUChar - | `Char_S -> Sil.Tint Sil.IChar - | `SChar -> Sil.Tint Sil.ISChar + | `Void -> Typ.Tvoid + | `Bool -> Typ.Tint Typ.IBool + | `Char_U -> Typ.Tint Typ.IUChar + | `UChar -> Typ.Tint Typ.IUChar + | `WChar_U -> Typ.Tint Typ.IUChar + | `Char_S -> Typ.Tint Typ.IChar + | `SChar -> Typ.Tint Typ.ISChar | `WChar_S | `Char16 - | `Char32 -> Sil.Tint Sil.IChar + | `Char32 -> Typ.Tint Typ.IChar | `UShort - | `Short -> Sil.Tint Sil.IShort + | `Short -> Typ.Tint Typ.IShort | `UInt - | `UInt128 -> Sil.Tint Sil.IUInt - | `ULong -> Sil.Tint Sil.IULong - | `ULongLong -> Sil.Tint Sil.IULongLong + | `UInt128 -> Typ.Tint Typ.IUInt + | `ULong -> Typ.Tint Typ.IULong + | `ULongLong -> Typ.Tint Typ.IULongLong | `Int - | `Int128 -> Sil.Tint Sil.IInt - | `Long -> Sil.Tint Sil.ILong - | `LongLong -> Sil.Tint Sil.ILongLong - | `Half -> Sil.Tint Sil.IShort (*?*) - | `Float -> Sil.Tfloat Sil.FFloat - | `Double -> Sil.Tfloat Sil.FDouble - | `LongDouble -> Sil.Tfloat Sil.FLongDouble - | `NullPtr -> Sil.Tint Sil.IInt + | `Int128 -> Typ.Tint Typ.IInt + | `Long -> Typ.Tint Typ.ILong + | `LongLong -> Typ.Tint Typ.ILongLong + | `Half -> Typ.Tint Typ.IShort (*?*) + | `Float -> Typ.Tfloat Typ.FFloat + | `Double -> Typ.Tfloat Typ.FDouble + | `LongDouble -> Typ.Tfloat Typ.FLongDouble + | `NullPtr -> Typ.Tint Typ.IInt | `ObjCId -> get_builtin_objc_type `ObjCId | `ObjCClass -> get_builtin_objc_type `ObjCClass - | _ -> Sil.Tvoid + | _ -> Typ.Tvoid let pointer_attribute_of_objc_attribute attr_info = match attr_info.Clang_ast_t.ati_lifetime with - | `OCL_None | `OCL_Strong -> Sil.Pk_pointer - | `OCL_ExplicitNone -> Sil.Pk_objc_unsafe_unretained - | `OCL_Weak -> Sil.Pk_objc_weak - | `OCL_Autoreleasing -> Sil.Pk_objc_autoreleasing + | `OCL_None | `OCL_Strong -> Typ.Pk_pointer + | `OCL_ExplicitNone -> Typ.Pk_objc_unsafe_unretained + | `OCL_Weak -> Typ.Pk_objc_weak + | `OCL_Autoreleasing -> Typ.Pk_objc_autoreleasing let rec build_array_type translate_decl tenv type_ptr n_opt = let array_type = type_ptr_to_sil_type translate_decl tenv type_ptr in let len = Option.map (fun n -> IntLit.of_int64 (Int64.of_int n)) n_opt in - Sil.Tarray (array_type, len) + Typ.Tarray (array_type, len) and sil_type_of_attr_type translate_decl tenv type_info attr_info = match type_info.Clang_ast_t.ti_desugared_type with @@ -72,27 +72,27 @@ and sil_type_of_attr_type translate_decl tenv type_info attr_info = (match Ast_utils.get_type type_ptr with | Some Clang_ast_t.ObjCObjectPointerType (_, type_ptr') -> let typ = type_ptr_to_sil_type translate_decl tenv type_ptr' in - Sil.Tptr (typ, pointer_attribute_of_objc_attribute attr_info) + Typ.Tptr (typ, pointer_attribute_of_objc_attribute attr_info) | _ -> type_ptr_to_sil_type translate_decl tenv type_ptr) - | None -> Sil.Tvoid + | None -> Typ.Tvoid and sil_type_of_c_type translate_decl tenv c_type = let open Clang_ast_t in match c_type with - | NoneType _ -> Sil.Tvoid + | NoneType _ -> Typ.Tvoid | BuiltinType (_, builtin_type_kind) -> sil_type_of_builtin_type_kind builtin_type_kind | PointerType (_, type_ptr) | ObjCObjectPointerType (_, type_ptr) -> let typ = type_ptr_to_sil_type translate_decl tenv type_ptr in - if Sil.typ_equal typ (get_builtin_objc_type `ObjCClass) then + if Typ.equal typ (get_builtin_objc_type `ObjCClass) then typ - else Sil.Tptr (typ, Sil.Pk_pointer) + else Typ.Tptr (typ, Typ.Pk_pointer) | ObjCObjectType (_, objc_object_type_info) -> type_ptr_to_sil_type translate_decl tenv objc_object_type_info.Clang_ast_t.base_type | BlockPointerType (_, type_ptr) -> let typ = type_ptr_to_sil_type translate_decl tenv type_ptr in - Sil.Tptr (typ, Sil.Pk_pointer) + Typ.Tptr (typ, Typ.Pk_pointer) | IncompleteArrayType (_, type_ptr) | DependentSizedArrayType (_, type_ptr) | VariableArrayType (_, type_ptr) -> @@ -101,7 +101,7 @@ and sil_type_of_c_type translate_decl tenv c_type = build_array_type translate_decl tenv type_ptr (Some n) | FunctionProtoType _ | FunctionNoProtoType _ -> - Sil.Tfun false + Typ.Tfun false | ParenType (_, type_ptr) -> type_ptr_to_sil_type translate_decl tenv type_ptr | DecayedType (_, type_ptr) -> @@ -112,44 +112,44 @@ and sil_type_of_c_type translate_decl tenv c_type = | ElaboratedType (type_info) -> (match type_info.Clang_ast_t.ti_desugared_type with Some type_ptr -> type_ptr_to_sil_type translate_decl tenv type_ptr - | None -> Sil.Tvoid) + | None -> Typ.Tvoid) | ObjCInterfaceType (_, pointer) -> decl_ptr_to_sil_type translate_decl tenv pointer | RValueReferenceType (_, type_ptr) | LValueReferenceType (_, type_ptr) -> let typ = type_ptr_to_sil_type translate_decl tenv type_ptr in - Sil.Tptr (typ, Sil.Pk_reference) + Typ.Tptr (typ, Typ.Pk_reference) | AttributedType (type_info, attr_info) -> sil_type_of_attr_type translate_decl tenv type_info attr_info | _ -> (* TypedefType, etc *) let type_info = Clang_ast_proj.get_type_tuple c_type in match type_info.Clang_ast_t.ti_desugared_type with | Some typ -> type_ptr_to_sil_type translate_decl tenv typ - | None -> Sil.Tvoid + | None -> Typ.Tvoid and decl_ptr_to_sil_type translate_decl tenv decl_ptr = let open Clang_ast_t in let typ = `DeclPtr decl_ptr in try Clang_ast_types.TypePointerMap.find typ !CFrontend_config.sil_types_map with Not_found -> - match Ast_utils.get_decl decl_ptr with - | Some (CXXRecordDecl _ as d) - | Some (RecordDecl _ as d) - | Some (ClassTemplateSpecializationDecl _ as d) - | Some (ObjCInterfaceDecl _ as d) - | Some (ObjCImplementationDecl _ as d) - | Some (ObjCProtocolDecl _ as d) - | Some (ObjCCategoryDecl _ as d) - | Some (ObjCCategoryImplDecl _ as d) - | Some (EnumDecl _ as d) -> translate_decl tenv d - | Some _ -> - Printing.log_err "Warning: Wrong decl found for pointer %s " - (Clang_ast_j.string_of_pointer decl_ptr); - Sil.Tvoid - | None -> - Printing.log_err "Warning: Decl pointer %s not found." - (Clang_ast_j.string_of_pointer decl_ptr); - Sil.Tvoid + match Ast_utils.get_decl decl_ptr with + | Some (CXXRecordDecl _ as d) + | Some (RecordDecl _ as d) + | Some (ClassTemplateSpecializationDecl _ as d) + | Some (ObjCInterfaceDecl _ as d) + | Some (ObjCImplementationDecl _ as d) + | Some (ObjCProtocolDecl _ as d) + | Some (ObjCCategoryDecl _ as d) + | Some (ObjCCategoryImplDecl _ as d) + | Some (EnumDecl _ as d) -> translate_decl tenv d + | Some _ -> + Printing.log_err "Warning: Wrong decl found for pointer %s " + (Clang_ast_j.string_of_pointer decl_ptr); + Typ.Tvoid + | None -> + Printing.log_err "Warning: Decl pointer %s not found." + (Clang_ast_j.string_of_pointer decl_ptr); + Typ.Tvoid and clang_type_ptr_to_sil_type translate_decl tenv type_ptr = try @@ -160,7 +160,7 @@ and clang_type_ptr_to_sil_type translate_decl tenv type_ptr = let sil_type = sil_type_of_c_type translate_decl tenv c_type in Ast_utils.update_sil_types_map type_ptr sil_type; sil_type - | _ -> Sil.Tvoid) + | _ -> Typ.Tvoid) and prebuilt_type_to_sil_type type_ptr = try @@ -176,13 +176,13 @@ and type_ptr_to_sil_type translate_decl tenv type_ptr = | `Prebuilt _ -> prebuilt_type_to_sil_type type_ptr | `PointerOf typ -> let sil_typ = type_ptr_to_sil_type translate_decl tenv typ in - Sil.Tptr (sil_typ, Sil.Pk_pointer) + Typ.Tptr (sil_typ, Typ.Pk_pointer) | `ReferenceOf typ -> let sil_typ = type_ptr_to_sil_type translate_decl tenv typ in - Sil.Tptr (sil_typ, Sil.Pk_reference) + Typ.Tptr (sil_typ, Typ.Pk_reference) | `ClassType (name, lang) -> let kind = match lang with `OBJC -> Csu.Objc | `CPP -> Csu.CPP in - Sil.Tvar (CTypes.mk_classname name kind) - | `StructType name -> Sil.Tvar (CTypes.mk_structname name) + Typ.Tvar (CTypes.mk_classname name kind) + | `StructType name -> Typ.Tvar (CTypes.mk_structname name) | `DeclPtr ptr -> decl_ptr_to_sil_type translate_decl tenv ptr - | `ErrorType -> Sil.Tvoid + | `ErrorType -> Typ.Tvoid diff --git a/infer/src/clang/cType_to_sil_type.mli b/infer/src/clang/cType_to_sil_type.mli index c50bc2ba4..edf42b3ae 100644 --- a/infer/src/clang/cType_to_sil_type.mli +++ b/infer/src/clang/cType_to_sil_type.mli @@ -11,9 +11,9 @@ open! Utils val get_builtin_objc_typename : [< `ObjCClass | `ObjCId ] -> Typename.t -val get_builtin_objc_type : [< `ObjCClass | `ObjCId ] -> Sil.typ +val get_builtin_objc_type : [< `ObjCClass | `ObjCId ] -> Typ.t -val sil_type_of_builtin_type_kind : Clang_ast_t.builtin_type_kind -> Sil.typ +val sil_type_of_builtin_type_kind : Clang_ast_t.builtin_type_kind -> Typ.t -val type_ptr_to_sil_type : (Tenv.t -> Clang_ast_t.decl -> Sil.typ) -> - Tenv.t -> Clang_ast_t.type_ptr -> Sil.typ +val type_ptr_to_sil_type : (Tenv.t -> Clang_ast_t.decl -> Typ.t) -> + Tenv.t -> Clang_ast_t.type_ptr -> Typ.t diff --git a/infer/src/clang/cTypes.ml b/infer/src/clang/cTypes.ml index 79b9956a6..0abbae25e 100644 --- a/infer/src/clang/cTypes.ml +++ b/infer/src/clang/cTypes.ml @@ -16,26 +16,26 @@ module L = Logging let get_name_from_struct s = match s with - | Sil.Tstruct { Sil.struct_name = Some n } -> n + | Typ.Tstruct { Typ.struct_name = Some n } -> n | _ -> assert false let add_pointer_to_typ typ = - Sil.Tptr(typ, Sil.Pk_pointer) + Typ.Tptr(typ, Typ.Pk_pointer) let remove_pointer_to_typ typ = match typ with - | Sil.Tptr(typ, Sil.Pk_pointer) -> typ + | Typ.Tptr(typ, Typ.Pk_pointer) -> typ | _ -> typ let classname_of_type typ = match typ with - | Sil.Tvar (Typename.TN_csu (_, name) ) - | Sil.Tstruct { Sil.struct_name = Some name } - | Sil.Tvar (Typename.TN_typedef name) -> Mangled.to_string name - | Sil.Tfun _ -> CFrontend_config.objc_object + | Typ.Tvar (Typename.TN_csu (_, name) ) + | Typ.Tstruct { Typ.struct_name = Some name } + | Typ.Tvar (Typename.TN_typedef name) -> Mangled.to_string name + | Typ.Tfun _ -> CFrontend_config.objc_object | _ -> Printing.log_out - "Classname of type cannot be extracted in type %s" (Sil.typ_to_string typ); + "Classname of type cannot be extracted in type %s" (Typ.to_string typ); "undefined" let mk_classname n ck = Typename.TN_csu (Csu.Class ck, Mangled.from_string n) @@ -46,8 +46,8 @@ let mk_enumname n = Typename.TN_enum (Mangled.from_string n) let is_class typ = match typ with - | Sil.Tptr (Sil.Tstruct { Sil.struct_name = Some name }, _) - | Sil.Tptr (Sil.Tvar (Typename.TN_csu (_, name) ), _) -> + | Typ.Tptr (Typ.Tstruct { Typ.struct_name = Some name }, _) + | Typ.Tptr (Typ.Tvar (Typename.TN_csu (_, name) ), _) -> (Mangled.to_string name) = CFrontend_config.objc_class | _ -> false @@ -86,16 +86,16 @@ let is_reference_type tp = (* Expand a named type Tvar if it has a definition in tenv. This is used for Tenum, Tstruct, etc. *) let rec expand_structured_type tenv typ = match typ with - | Sil.Tvar tn -> + | Typ.Tvar tn -> (match Tenv.lookup tenv tn with | Some ts -> - let t = Sil.Tstruct ts in - Printing.log_out " Type expanded with type '%s' found in tenv@." (Sil.typ_to_string t); - if Sil.typ_equal t typ then + let t = Typ.Tstruct ts in + Printing.log_out " Type expanded with type '%s' found in tenv@." (Typ.to_string t); + if Typ.equal t typ then typ else expand_structured_type tenv t | None -> typ) - | Sil.Tptr _ -> typ (*do not expand types under pointers *) + | Typ.Tptr _ -> typ (*do not expand types under pointers *) | _ -> typ (* To be called with strings of format "*" *) @@ -111,7 +111,7 @@ let rec get_type_list nn ll = | (n, t):: ll' -> (* Printing.log_out ">>>>>Searching for type '%s'. Seen '%s'.@." nn n; *) if n = nn then ( Printing.log_out ">>>>>>>>>>>>>>>>>>>>>>>NOW Found, Its type is: '%s'@." - (Sil.typ_to_string t); + (Typ.to_string t); [t] ) else get_type_list nn ll' *) diff --git a/infer/src/clang/cTypes.mli b/infer/src/clang/cTypes.mli index fb7760d66..330371604 100644 --- a/infer/src/clang/cTypes.mli +++ b/infer/src/clang/cTypes.mli @@ -11,9 +11,9 @@ open! Utils (** Utility module for retrieving types *) -val add_pointer_to_typ : Sil.typ -> Sil.typ +val add_pointer_to_typ : Typ.t -> Typ.t -val classname_of_type : Sil.typ -> string +val classname_of_type : Typ.t -> string val mk_classname : string -> Csu.class_kind -> Typename.t @@ -21,11 +21,11 @@ val mk_structname : string -> Typename.t val mk_enumname : string -> Typename.t -val get_name_from_struct: Sil.typ -> Mangled.t +val get_name_from_struct: Typ.t -> Mangled.t -val remove_pointer_to_typ : Sil.typ -> Sil.typ +val remove_pointer_to_typ : Typ.t -> Typ.t -val is_class : Sil.typ -> bool +val is_class : Typ.t -> bool val return_type_of_function_type : Clang_ast_t.type_ptr -> Clang_ast_t.type_ptr @@ -33,6 +33,6 @@ val is_block_type : Clang_ast_t.type_ptr -> bool val is_reference_type : Clang_ast_t.type_ptr -> bool -val expand_structured_type : Tenv.t -> Sil.typ -> Sil.typ +val expand_structured_type : Tenv.t -> Typ.t -> Typ.t val get_name_from_type_pointer : string -> string * string diff --git a/infer/src/clang/cTypes_decl.ml b/infer/src/clang/cTypes_decl.ml index 3adb28e2b..94df2a13b 100644 --- a/infer/src/clang/cTypes_decl.ml +++ b/infer/src/clang/cTypes_decl.ml @@ -19,7 +19,7 @@ let add_predefined_objc_types tenv = let class_typename = CType_to_sil_type.get_builtin_objc_typename `ObjCClass in let objc_class_type_info = { - Sil.instance_fields = []; + Typ.instance_fields = []; static_fields = []; csu = Csu.Struct; struct_name = Some (Mangled.from_string CFrontend_config.objc_class); @@ -31,7 +31,7 @@ let add_predefined_objc_types tenv = let id_typename = CType_to_sil_type.get_builtin_objc_typename `ObjCId in let objc_object_type_info = { - Sil.instance_fields = []; + Typ.instance_fields = []; static_fields = []; csu = Csu.Struct; struct_name = Some (Mangled.from_string CFrontend_config.objc_object); @@ -56,7 +56,7 @@ let add_predefined_basic_types () = Ast_utils.update_sil_types_map tp return_type in let sil_void_type = CType_to_sil_type.sil_type_of_builtin_type_kind `Void in let sil_char_type = CType_to_sil_type.sil_type_of_builtin_type_kind `Char_S in - let sil_nsarray_type = Sil.Tvar (CTypes.mk_classname CFrontend_config.nsarray_cl Csu.Objc) in + let sil_nsarray_type = Typ.Tvar (CTypes.mk_classname CFrontend_config.nsarray_cl Csu.Objc) in let sil_id_type = CType_to_sil_type.get_builtin_objc_type `ObjCId in add_basic_type create_int_type `Int; add_basic_type create_void_type `Void; @@ -140,7 +140,7 @@ let get_superclass_list_cpp decl = let add_struct_to_tenv tenv typ = let csu, struct_typ = match typ with - | Sil.Tstruct ({ Sil.csu } as struct_typ) -> csu, struct_typ + | Typ.Tstruct ({ Typ.csu } as struct_typ) -> csu, struct_typ | _ -> assert false in let mangled = CTypes.get_name_from_struct typ in let typename = Typename.TN_csu(csu, mangled) in @@ -176,21 +176,21 @@ and get_struct_cpp_class_declaration_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 - [Sil.objc_ref_counter_field] + [Typ.objc_ref_counter_field] else [] in let struct_annotations = - if csu = Csu.Class Csu.CPP then Sil.cpp_class_annotation - else Sil.item_annotation_empty in (* No annotations for structs *) + if csu = Csu.Class Csu.CPP then Typ.cpp_class_annotation + else Typ.item_annotation_empty in (* No annotations for structs *) if is_complete_definition then ( - Ast_utils.update_sil_types_map type_ptr (Sil.Tvar sil_typename); + Ast_utils.update_sil_types_map type_ptr (Typ.Tvar sil_typename); let non_static_fields = get_struct_fields tenv decl in let non_static_fields = General_utils.append_no_duplicates_fields non_static_fields extra_fields in let static_fields = [] in (* Note: We treat static field same as global variables *) let def_methods = get_class_methods name decl_list in (* C++ methods only *) let superclasses = get_superclass_list_cpp decl in - let sil_type = Sil.Tstruct { - Sil.instance_fields = non_static_fields; + let sil_type = Typ.Tstruct { + Typ.instance_fields = non_static_fields; static_fields; csu; struct_name = Some mangled_name; @@ -203,7 +203,7 @@ and get_struct_cpp_class_declaration_type tenv decl = sil_type ) else ( match Tenv.lookup tenv sil_typename with - | Some struct_typ -> Sil.Tstruct struct_typ (* just reuse what is already in tenv *) + | Some struct_typ -> Typ.Tstruct struct_typ (* just reuse what is already in tenv *) | None -> (* This is first forward definition seen so far. Instead of adding *) (* empty Tstruct to sil_types_map add Tvar so that frontend doeasn't expand *) @@ -211,9 +211,9 @@ and get_struct_cpp_class_declaration_type tenv decl = (* Later, when we see definition, it will be updated with a new value. *) (* Note: we know that this type will be wrapped with pointer type because *) (* there was no full definition of that type yet. *) - let tvar_type = Sil.Tvar sil_typename in - let empty_struct_type = Sil.Tstruct { - Sil.instance_fields = extra_fields; + let tvar_type = Typ.Tvar sil_typename in + let empty_struct_type = Typ.Tstruct { + Typ.instance_fields = extra_fields; static_fields = []; csu; struct_name = Some mangled_name; @@ -252,8 +252,8 @@ let get_type_from_expr_info ei tenv = let class_from_pointer_type tenv type_ptr = match type_ptr_to_sil_type tenv type_ptr with - | Sil.Tptr( Sil.Tvar (Typename.TN_typedef name), _) -> Mangled.to_string name - | Sil.Tptr( Sil.Tvar (Typename.TN_csu (_, name)), _) -> Mangled.to_string name + | Typ.Tptr( Typ.Tvar (Typename.TN_typedef name), _) -> Mangled.to_string name + | Typ.Tptr( Typ.Tvar (Typename.TN_csu (_, name)), _) -> Mangled.to_string name | _ -> assert false let get_class_type_np tenv expr_info obj_c_message_expr_info = @@ -265,5 +265,5 @@ let get_class_type_np tenv expr_info obj_c_message_expr_info = let get_type_curr_class_objc tenv curr_class_opt = let name = CContext.get_curr_class_name curr_class_opt in - let typ = Sil.Tvar (Typename.TN_csu (Csu.Class Csu.Objc, (Mangled.from_string name))) in + let typ = Typ.Tvar (Typename.TN_csu (Csu.Class Csu.Objc, (Mangled.from_string name))) in CTypes.expand_structured_type tenv typ diff --git a/infer/src/clang/cTypes_decl.mli b/infer/src/clang/cTypes_decl.mli index c48be6a23..5552288a1 100644 --- a/infer/src/clang/cTypes_decl.mli +++ b/infer/src/clang/cTypes_decl.mli @@ -11,25 +11,25 @@ open! Utils (** Processes types and record declarations by adding them to the tenv *) -val add_struct_to_tenv : Tenv.t -> Sil.typ -> unit +val add_struct_to_tenv : Tenv.t -> Typ.t -> unit val get_record_name : Clang_ast_t.decl -> string -val add_types_from_decl_to_tenv : Tenv.t -> Clang_ast_t.decl -> Sil.typ +val add_types_from_decl_to_tenv : Tenv.t -> Clang_ast_t.decl -> Typ.t (* Adds the predefined types objc_class which is a struct, *) (* and Class, which is a pointer to objc_class. *) val add_predefined_types : Tenv.t -> unit -val type_ptr_to_sil_type : Tenv.t -> Clang_ast_t.type_ptr -> Sil.typ +val type_ptr_to_sil_type : Tenv.t -> Clang_ast_t.type_ptr -> Typ.t val class_from_pointer_type : Tenv.t -> Clang_ast_t.type_ptr -> string val get_class_type_np : Tenv.t -> Clang_ast_t.expr_info -> - Clang_ast_t.obj_c_message_expr_info -> Sil.typ + Clang_ast_t.obj_c_message_expr_info -> Typ.t -val get_type_curr_class_objc : Tenv.t -> CContext.curr_class -> Sil.typ +val get_type_curr_class_objc : Tenv.t -> CContext.curr_class -> Typ.t -val get_type_from_expr_info : Clang_ast_t.expr_info -> Tenv.t -> Sil.typ +val get_type_from_expr_info : Clang_ast_t.expr_info -> Tenv.t -> Typ.t -val objc_class_name_to_sil_type : Tenv.t -> string -> Sil.typ +val objc_class_name_to_sil_type : Tenv.t -> string -> Typ.t diff --git a/infer/src/clang/cVar_decl.mli b/infer/src/clang/cVar_decl.mli index 30e4b8101..76203e043 100644 --- a/infer/src/clang/cVar_decl.mli +++ b/infer/src/clang/cVar_decl.mli @@ -16,9 +16,9 @@ val sil_var_of_decl : CContext.t -> Clang_ast_t.decl -> Procname.t -> Pvar.t val sil_var_of_decl_ref : CContext.t -> Clang_ast_t.decl_ref -> Procname.t -> Pvar.t -val add_var_to_locals : Cfg.Procdesc.t -> Clang_ast_t.decl -> Sil.typ -> Pvar.t -> unit +val add_var_to_locals : Cfg.Procdesc.t -> Clang_ast_t.decl -> Typ.t -> Pvar.t -> unit -val compute_autorelease_pool_vars : CContext.t -> Clang_ast_t.stmt list -> (Sil.exp * Sil.typ) list +val compute_autorelease_pool_vars : CContext.t -> Clang_ast_t.stmt list -> (Sil.exp * Typ.t) list val captured_vars_from_block_info : CContext.t -> Clang_ast_t.block_captured_variable list -> - (Pvar.t * Sil.typ) list + (Pvar.t * Typ.t) list diff --git a/infer/src/clang/objcCategory_decl.ml b/infer/src/clang/objcCategory_decl.ml index b03ef30df..4a9704843 100644 --- a/infer/src/clang/objcCategory_decl.ml +++ b/infer/src/clang/objcCategory_decl.ml @@ -76,15 +76,15 @@ let process_category type_ptr_to_sil_type tenv curr_class decl_info decl_list = 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 - Ast_utils.update_sil_types_map decl_key (Sil.Tvar class_tn_name); + Ast_utils.update_sil_types_map decl_key (Typ.Tvar class_tn_name); (match Tenv.lookup tenv class_tn_name with - | Some ({ Sil.instance_fields; def_methods } as struct_typ) -> + | Some ({ Typ.instance_fields; def_methods } as struct_typ) -> let new_fields = General_utils.append_no_duplicates_fields fields instance_fields in let new_methods = General_utils.append_no_duplicates_methods methods def_methods in let class_type_info = { struct_typ with - Sil.instance_fields = new_fields; + Typ.instance_fields = new_fields; static_fields = []; csu = Csu.Class Csu.Objc; struct_name = Some mang_name; @@ -93,7 +93,7 @@ let process_category type_ptr_to_sil_type tenv curr_class decl_info decl_list = Printing.log_out " Updating info for class '%s' in tenv\n" class_name; Tenv.add tenv class_tn_name class_type_info | _ -> ()); - Sil.Tvar class_tn_name + Typ.Tvar class_tn_name let category_decl type_ptr_to_sil_type tenv decl = let open Clang_ast_t in diff --git a/infer/src/clang/objcCategory_decl.mli b/infer/src/clang/objcCategory_decl.mli index d99f77bf5..1bfc61240 100644 --- a/infer/src/clang/objcCategory_decl.mli +++ b/infer/src/clang/objcCategory_decl.mli @@ -14,9 +14,9 @@ open! Utils open CFrontend_utils -val category_decl : Ast_utils.type_ptr_to_sil_type -> Tenv.t -> Clang_ast_t.decl -> Sil.typ +val category_decl : Ast_utils.type_ptr_to_sil_type -> Tenv.t -> Clang_ast_t.decl -> Typ.t -val category_impl_decl : Ast_utils.type_ptr_to_sil_type -> Tenv.t -> Clang_ast_t.decl -> Sil.typ +val category_impl_decl : Ast_utils.type_ptr_to_sil_type -> Tenv.t -> Clang_ast_t.decl -> Typ.t val noname_category : string -> string diff --git a/infer/src/clang/objcInterface_decl.ml b/infer/src/clang/objcInterface_decl.ml index 3919163ec..550f11913 100644 --- a/infer/src/clang/objcInterface_decl.ml +++ b/infer/src/clang/objcInterface_decl.ml @@ -22,11 +22,11 @@ module L = Logging let is_pointer_to_objc_class tenv typ = match typ with - | Sil.Tptr (Sil.Tvar (Typename.TN_csu (Csu.Class Csu.Objc, cname)), _) -> + | Typ.Tptr (Typ.Tvar (Typename.TN_csu (Csu.Class Csu.Objc, cname)), _) -> (match Tenv.lookup tenv (Typename.TN_csu (Csu.Class Csu.Objc, cname)) with - | Some struct_typ when Sil.is_objc_class (Sil.Tstruct struct_typ) -> true + | Some struct_typ when Typ.is_objc_class (Typ.Tstruct struct_typ) -> true | _ -> false) - | Sil.Tptr (typ, _) when Sil.is_objc_class typ -> true + | Typ.Tptr (typ, _) when Typ.is_objc_class typ -> true | _ -> false let get_super_interface_decl otdi_super = @@ -102,7 +102,7 @@ let add_class_to_tenv type_ptr_to_sil_type tenv curr_class decl_info class_name Printing.log_out "ADDING: ObjCInterfaceDecl for '%s'\n" class_name; let interface_name = CTypes.mk_classname class_name Csu.Objc in let decl_key = `DeclPtr decl_info.Clang_ast_t.di_pointer in - Ast_utils.update_sil_types_map decl_key (Sil.Tvar interface_name); + Ast_utils.update_sil_types_map decl_key (Typ.Tvar interface_name); let superclasses, fields = create_superclasses_fields type_ptr_to_sil_type tenv curr_class decl_list ocidi.Clang_ast_t.otdi_super @@ -111,57 +111,57 @@ let add_class_to_tenv type_ptr_to_sil_type tenv curr_class decl_info class_name let fields_sc = CField_decl.fields_superclass tenv ocidi Csu.Objc in IList.iter (fun (fn, ft, _) -> Printing.log_out "----->SuperClass field: '%s' " (Ident.fieldname_to_string fn); - Printing.log_out "type: '%s'\n" (Sil.typ_to_string ft)) fields_sc; + Printing.log_out "type: '%s'\n" (Typ.to_string ft)) fields_sc; (*In case we found categories, or partial definition of this class earlier and they are already in the tenv *) let fields, (superclasses : Typename.t list), methods = match Tenv.lookup tenv interface_name with - | Some ({ Sil.instance_fields; superclasses; def_methods }) -> + | Some ({ Typ.instance_fields; superclasses; def_methods }) -> General_utils.append_no_duplicates_fields fields instance_fields, General_utils.append_no_duplicates_csu superclasses superclasses, General_utils.append_no_duplicates_methods methods def_methods | _ -> fields, superclasses, 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 fields = General_utils.append_no_duplicates_fields [Sil.objc_ref_counter_field] fields in + let fields = General_utils.append_no_duplicates_fields [Typ.objc_ref_counter_field] fields in Printing.log_out "Class %s field:\n" class_name; IList.iter (fun (fn, _, _) -> Printing.log_out "-----> field: '%s'\n" (Ident.fieldname_to_string fn)) fields; let interface_type_info = { - Sil.instance_fields = fields; + Typ.instance_fields = fields; static_fields = []; csu = Csu.Class Csu.Objc; struct_name = Some (Mangled.from_string class_name); superclasses; def_methods = methods; - struct_annotations = Sil.objc_class_annotation; + struct_annotations = Typ.objc_class_annotation; } in Tenv.add tenv interface_name interface_type_info; Printing.log_out " >>>Verifying that Typename '%s' is in tenv\n" (Typename.to_string interface_name); (match Tenv.lookup tenv interface_name with - | Some st -> Printing.log_out " >>>OK. Found typ='%s'\n" (Sil.typ_to_string (Sil.Tstruct st)) + | Some st -> Printing.log_out " >>>OK. Found typ='%s'\n" (Typ.to_string (Typ.Tstruct st)) | None -> Printing.log_out " >>>NOT Found!!\n"); - Sil.Tvar interface_name + Typ.Tvar interface_name let add_missing_methods tenv class_name ck decl_info decl_list curr_class = let methods = ObjcProperty_decl.get_methods curr_class decl_list in let class_tn_name = Typename.TN_csu (Csu.Class ck, (Mangled.from_string class_name)) in let decl_key = `DeclPtr decl_info.Clang_ast_t.di_pointer in - Ast_utils.update_sil_types_map decl_key (Sil.Tvar class_tn_name); + Ast_utils.update_sil_types_map decl_key (Typ.Tvar class_tn_name); begin match Tenv.lookup tenv class_tn_name with - | Some ({ Sil.static_fields = []; + | Some ({ Typ.static_fields = []; csu = Csu.Class _; struct_name = Some _; def_methods; } as struct_typ) -> let methods = General_utils.append_no_duplicates_methods def_methods methods in - let struct_typ' = { struct_typ with Sil.def_methods = methods; } in + let struct_typ' = { struct_typ with Typ.def_methods = methods; } in Tenv.add tenv class_tn_name struct_typ' | _ -> () end; - Sil.Tvar class_tn_name + Typ.Tvar class_tn_name (* Interface_type_info has the name of instance variables and the name of methods. *) let interface_declaration type_ptr_to_sil_type tenv decl = diff --git a/infer/src/clang/objcInterface_decl.mli b/infer/src/clang/objcInterface_decl.mli index 65700d706..96b08c241 100644 --- a/infer/src/clang/objcInterface_decl.mli +++ b/infer/src/clang/objcInterface_decl.mli @@ -15,12 +15,12 @@ open! Utils open CFrontend_utils val interface_declaration : Ast_utils.type_ptr_to_sil_type -> Tenv.t -> Clang_ast_t.decl -> - Sil.typ + Typ.t val interface_impl_declaration : Ast_utils.type_ptr_to_sil_type -> Tenv.t -> Clang_ast_t.decl -> - Sil.typ + Typ.t -val is_pointer_to_objc_class : Tenv.t -> Sil.typ -> bool +val is_pointer_to_objc_class : Tenv.t -> Typ.t -> bool val get_curr_class : string -> Clang_ast_t.obj_c_interface_decl_info -> CContext.curr_class diff --git a/infer/src/clang/objcProtocol_decl.ml b/infer/src/clang/objcProtocol_decl.ml index e18227614..27399f2f7 100644 --- a/infer/src/clang/objcProtocol_decl.ml +++ b/infer/src/clang/objcProtocol_decl.ml @@ -31,11 +31,11 @@ let protocol_decl type_ptr_to_sil_type tenv decl = let mang_name = Mangled.from_string name in let protocol_name = Typename.TN_csu (Csu.Protocol, mang_name) in let decl_key = `DeclPtr decl_info.Clang_ast_t.di_pointer in - Ast_utils.update_sil_types_map decl_key (Sil.Tvar protocol_name); + Ast_utils.update_sil_types_map decl_key (Typ.Tvar protocol_name); let def_methods = ObjcProperty_decl.get_methods curr_class decl_list in let protocol_type_info = { - Sil.instance_fields = []; + Typ.instance_fields = []; static_fields = []; csu = Csu.Protocol; struct_name = Some mang_name; @@ -45,7 +45,7 @@ let protocol_decl type_ptr_to_sil_type tenv decl = } in Tenv.add tenv protocol_name protocol_type_info; add_protocol_super type_ptr_to_sil_type tenv obj_c_protocol_decl_info; - Sil.Tvar protocol_name + Typ.Tvar protocol_name | _ -> assert false let is_protocol decl = diff --git a/infer/src/clang/objcProtocol_decl.mli b/infer/src/clang/objcProtocol_decl.mli index f5b640cab..b10ddcce8 100644 --- a/infer/src/clang/objcProtocol_decl.mli +++ b/infer/src/clang/objcProtocol_decl.mli @@ -14,6 +14,6 @@ open! Utils open CFrontend_utils -val protocol_decl : Ast_utils.type_ptr_to_sil_type -> Tenv.t -> Clang_ast_t.decl -> Sil.typ +val protocol_decl : Ast_utils.type_ptr_to_sil_type -> Tenv.t -> Clang_ast_t.decl -> Typ.t val is_protocol : Clang_ast_t.decl -> bool diff --git a/infer/src/eradicate/eradicate.mli b/infer/src/eradicate/eradicate.mli index 599143888..9963c7fb5 100644 --- a/infer/src/eradicate/eradicate.mli +++ b/infer/src/eradicate/eradicate.mli @@ -17,7 +17,7 @@ val callback_check_return_type : TypeCheck.check_return_type -> Callbacks.proc_c (** Parameters of a call. *) -type parameters = (Sil.exp * Sil.typ) list +type parameters = (Sil.exp * Typ.t) list (** Type for a module that provides a main callback function *) diff --git a/infer/src/eradicate/eradicateChecks.ml b/infer/src/eradicate/eradicateChecks.ml index bdc0d0c75..e9a2e4dbf 100644 --- a/infer/src/eradicate/eradicateChecks.ml +++ b/infer/src/eradicate/eradicateChecks.ml @@ -136,7 +136,7 @@ let check_condition case_zero find_canonical_duplicate curr_pname let throwable_found = ref false in let throwable_class = Mangled.from_string "java.lang.Throwable" in let typ_is_throwable = function - | Sil.Tstruct { Sil.csu = Csu.Class _; struct_name = Some c } -> + | Typ.Tstruct { Typ.csu = Csu.Class _; struct_name = Some c } -> Mangled.equal c throwable_class | _ -> false in let do_instr = function @@ -257,7 +257,7 @@ let check_constructor_initialization if Procname.is_constructor curr_pname then begin match PatternMatch.get_this_type (Cfg.Procdesc.get_attributes curr_pdesc) with - | Some (Sil.Tptr (Sil.Tstruct { Sil.instance_fields; struct_name } as ts, _)) -> + | Some (Typ.Tptr (Typ.Tstruct { Typ.instance_fields; struct_name } as ts, _)) -> let do_field (fn, ft, _) = let annotated_with f = match get_field_annotation fn ts with | None -> false diff --git a/infer/src/eradicate/typeAnnotation.mli b/infer/src/eradicate/typeAnnotation.mli index 1b25c7842..784e7fa85 100644 --- a/infer/src/eradicate/typeAnnotation.mli +++ b/infer/src/eradicate/typeAnnotation.mli @@ -19,7 +19,7 @@ val const : Annotations.annotation -> bool -> TypeOrigin.t -> t val descr_origin : t -> TypeErr.origin_descr val equal : t -> t -> bool -val from_item_annotation : Sil.item_annotation -> TypeOrigin.t -> t +val from_item_annotation : Typ.item_annotation -> TypeOrigin.t -> t val get_origin : t -> TypeOrigin.t val get_value : Annotations.annotation -> t -> bool val join : t -> t -> t option diff --git a/infer/src/eradicate/typeCheck.ml b/infer/src/eradicate/typeCheck.ml index 06441bd4d..2fd4857f0 100644 --- a/infer/src/eradicate/typeCheck.ml +++ b/infer/src/eradicate/typeCheck.ml @@ -144,7 +144,7 @@ module ComplexExpressions = struct end (* ComplexExpressions *) type check_return_type = - Procname.t -> Cfg.Procdesc.t -> Sil.typ -> Sil.typ option -> Location.t -> unit + Procname.t -> Cfg.Procdesc.t -> Typ.t -> Typ.t option -> Location.t -> unit type find_canonical_duplicate = Cfg.Node.t -> Cfg.Node.t @@ -467,7 +467,7 @@ let typecheck_instr (* check if there are errors in exp1 *) let typecheck_expr_for_errors typestate1 exp1 loc1 : unit = - ignore (typecheck_expr_simple typestate1 exp1 Sil.Tvoid TypeOrigin.Undef loc1) in + ignore (typecheck_expr_simple typestate1 exp1 Typ.Tvoid TypeOrigin.Undef loc1) in match instr with | Sil.Remove_temps (idl, _) -> @@ -553,7 +553,7 @@ let typecheck_instr TypeState.add_id id ( - Sil.Tint (Sil.IInt), + Typ.Tint (Typ.IInt), TypeAnnotation.const Annotations.Nullable false TypeOrigin.New, [loc] ) @@ -585,13 +585,13 @@ let typecheck_instr etl_ in let ret_type = match Tenv.proc_extract_return_typ tenv callee_pname_java with - | Some (Sil.Tstruct _ as typ) -> - Sil.Tptr (typ, Pk_pointer) + | Some (Typ.Tstruct _ as typ) -> + Typ.Tptr (typ, Pk_pointer) | Some typ -> typ | None -> let ret_typ_string = Procname.java_get_return_type callee_pname_java in - Sil.Tptr (Tvar (Typename.Java.from_string ret_typ_string), Pk_pointer) in + Typ.Tptr (Tvar (Typename.Java.from_string ret_typ_string), Pk_pointer) in let proc_attributes = { (ProcAttributes.default callee_pname Config.Java) with ProcAttributes.formals; @@ -922,7 +922,7 @@ let typecheck_instr Pvar.mk (Mangled.from_string e_str) curr_pname in let e1 = Sil.Lvar pvar in let (typ, ta, _) = - typecheck_expr_simple typestate e1 Sil.Tvoid TypeOrigin.ONone loc in + typecheck_expr_simple typestate e1 Typ.Tvoid TypeOrigin.ONone loc in let range = (typ, ta, [loc]) in let typestate1 = TypeState.add pvar range typestate in typestate1, e1, EradicateChecks.From_containsKey @@ -955,7 +955,7 @@ let typecheck_instr typestate, e, EradicateChecks.From_condition in let e', typestate2 = convert_complex_exp_to_pvar node' false e1 typestate1 loc in let (typ, ta, _) = - typecheck_expr_simple typestate2 e' Sil.Tvoid TypeOrigin.ONone loc in + typecheck_expr_simple typestate2 e' Typ.Tvoid TypeOrigin.ONone loc in if checks.eradicate then EradicateChecks.check_zero @@ -1002,7 +1002,7 @@ let typecheck_instr end in let e', typestate2 = convert_complex_exp_to_pvar node' false e1 typestate1 loc in let (typ, ta, _) = - typecheck_expr_simple typestate2 e' Sil.Tvoid TypeOrigin.ONone loc in + typecheck_expr_simple typestate2 e' Typ.Tvoid TypeOrigin.ONone loc in if checks.eradicate then EradicateChecks.check_nonzero find_canonical_duplicate curr_pname diff --git a/infer/src/eradicate/typeCheck.mli b/infer/src/eradicate/typeCheck.mli index ade239c3b..888765f51 100644 --- a/infer/src/eradicate/typeCheck.mli +++ b/infer/src/eradicate/typeCheck.mli @@ -13,7 +13,7 @@ open! Utils (** Module type for the type checking functions. *) type check_return_type = - Procname.t -> Cfg.Procdesc.t -> Sil.typ -> Sil.typ option -> Location.t -> unit + Procname.t -> Cfg.Procdesc.t -> Typ.t -> Typ.t option -> Location.t -> unit type find_canonical_duplicate = Cfg.Node.t -> Cfg.Node.t diff --git a/infer/src/eradicate/typeErr.ml b/infer/src/eradicate/typeErr.ml index 0a574baa8..76c2f5f43 100644 --- a/infer/src/eradicate/typeErr.ml +++ b/infer/src/eradicate/typeErr.ml @@ -280,7 +280,7 @@ module Strict = struct (* Return (Some parameters) if there is a method call on a @Nullable object,*) (* where the origin of @Nullable in the analysis is the return value of a Strict method*) (* with parameters. A method is Strict if it or its class are annotated @Strict. *) - let err_instance_get_strict err_instance : Sil.annotation option = + let err_instance_get_strict err_instance : Typ.annotation option = match err_instance with | Call_receiver_annotation_inconsistent (Annotations.Nullable, _, _, origin_descr) | Null_field_access (_, _, origin_descr, _) -> diff --git a/infer/src/eradicate/typeErr.mli b/infer/src/eradicate/typeErr.mli index b3276f1a2..dd94f1c75 100644 --- a/infer/src/eradicate/typeErr.mli +++ b/infer/src/eradicate/typeErr.mli @@ -29,7 +29,7 @@ module InstrRef : InstrRefT module Strict : sig - val signature_get_strict : Annotations.annotated_signature -> Sil.annotation option + val signature_get_strict : Annotations.annotated_signature -> Typ.annotation option end (* Strict *) diff --git a/infer/src/eradicate/typeOrigin.ml b/infer/src/eradicate/typeOrigin.ml index 1270819c5..2053cb986 100644 --- a/infer/src/eradicate/typeOrigin.ml +++ b/infer/src/eradicate/typeOrigin.ml @@ -91,7 +91,7 @@ let get_description origin = let strict = match TypeErr.Strict.signature_get_strict po.annotated_signature with | Some ann -> let str = "@Strict" in - (match ann.Sil.parameters with + (match ann.Typ.parameters with | par1 :: _ -> Printf.sprintf "%s(%s) " str par1 | [] -> Printf.sprintf "%s " str) | None -> "" in diff --git a/infer/src/eradicate/typeState.ml b/infer/src/eradicate/typeState.ml index 700ef0b98..71cb69f68 100644 --- a/infer/src/eradicate/typeState.ml +++ b/infer/src/eradicate/typeState.ml @@ -16,7 +16,7 @@ module P = Printf (** Module for typestates: maps from expressions to annotated types, with extensions. *) (** Parameters of a call. *) -type parameters = (Sil.exp * Sil.typ) list +type parameters = (Sil.exp * Typ.t) list type get_proc_desc = Procname.t -> Cfg.Procdesc.t option @@ -36,7 +36,7 @@ module M = Map.Make (struct type t = Sil.exp let compare = Sil.exp_compare end) -type range = Sil.typ * TypeAnnotation.t * (Location.t list) +type range = Typ.t * TypeAnnotation.t * (Location.t list) type 'a t = { @@ -54,7 +54,7 @@ let locs_compare = IList.compare Location.compare let locs_equal locs1 locs2 = locs_compare locs1 locs2 = 0 let range_equal (typ1, ta1, locs1) (typ2, ta2, locs2) = - Sil.typ_equal typ1 typ2 && TypeAnnotation.equal ta1 ta2 && locs_equal locs1 locs2 + Typ.equal typ1 typ2 && TypeAnnotation.equal ta1 ta2 && locs_equal locs1 locs2 let equal t1 t2 = (* Ignore the calls field, which is a pure instrumentation *) @@ -67,7 +67,7 @@ let pp ext fmt typestate = F.fprintf fmt " %a -> [%s] %s %a%a@\n" (Sil.pp_exp pe_text) exp (TypeOrigin.to_string (TypeAnnotation.get_origin ta)) (TypeAnnotation.to_string ta) - (Sil.pp_typ_full pe_text) typ + (Typ.pp_full pe_text) typ pp_locs locs in let pp_map map = M.iter pp_one map in diff --git a/infer/src/eradicate/typeState.mli b/infer/src/eradicate/typeState.mli index 0220d08c7..7c24ab632 100644 --- a/infer/src/eradicate/typeState.mli +++ b/infer/src/eradicate/typeState.mli @@ -12,7 +12,7 @@ open! Utils (** Module for typestates: maps from expressions to annotated types, with extensions. *) (** Parameters of a call. *) -type parameters = (Sil.exp * Sil.typ) list +type parameters = (Sil.exp * Typ.t) list type get_proc_desc = Procname.t -> Cfg.Procdesc.t option @@ -30,7 +30,7 @@ type 'a ext = (** Typestate extended with elements of type 'a. *) type 'a t -type range = Sil.typ * TypeAnnotation.t * (Location.t list) +type range = Typ.t * TypeAnnotation.t * (Location.t list) val add_id : Ident.t -> range -> 'a t -> 'a t val add : Pvar.t -> range -> 'a t -> 'a t diff --git a/infer/src/harness/androidFramework.ml b/infer/src/harness/androidFramework.ml index 6f2e3ebfe..90b220cb1 100644 --- a/infer/src/harness/androidFramework.ml +++ b/infer/src/harness/androidFramework.ml @@ -11,7 +11,7 @@ open! Utils module L = Logging module F = Format -module TypSet = Sil.StructTypSet +module TypSet = Typ.StructSet (** Android lifecycle types and their lifecycle methods that are called by the framework *) @@ -87,7 +87,7 @@ let is_android_lib_class class_name = a list of method names [lifecycle_procs_strs], get the appropriate typ and procnames *) let get_lifecycle_for_framework_typ_opt tenv lifecycle_typ lifecycle_proc_strs = match Tenv.lookup tenv (Typename.TN_csu (Csu.Class Csu.Java, lifecycle_typ)) with - | Some ({ Sil.csu = Csu.Class _; struct_name = Some _; def_methods } as lifecycle_typ) -> + | Some ({ Typ.csu = Csu.Class _; struct_name = Some _; def_methods } as lifecycle_typ) -> (* TODO (t4645631): collect the procedures for which is_java is returning false *) let lookup_proc lifecycle_proc = IList.find (fun decl_proc -> diff --git a/infer/src/harness/androidFramework.mli b/infer/src/harness/androidFramework.mli index a045a8116..35853c898 100644 --- a/infer/src/harness/androidFramework.mli +++ b/infer/src/harness/androidFramework.mli @@ -15,18 +15,18 @@ open! Utils val get_lifecycles : (string * string * string list) list (** return true if [typ] <: android.content.Context *) -val is_context : Tenv.t -> Sil.struct_typ -> bool +val is_context : Tenv.t -> Typ.struct_typ -> bool (** return true if [struct_typ] <: android.app.Application *) -val is_application : Tenv.t -> Sil.struct_typ -> bool +val is_application : Tenv.t -> Typ.struct_typ -> bool (** return true if [struct_typ] <: android.app.Activity *) -val is_activity : Tenv.t -> Sil.struct_typ -> bool +val is_activity : Tenv.t -> Typ.struct_typ -> bool (** return true if [struct_typ] <: android.view.View *) -val is_view : Tenv.t -> Sil.struct_typ -> bool +val is_view : Tenv.t -> Typ.struct_typ -> bool -val is_fragment : Tenv.t -> Sil.struct_typ -> bool +val is_fragment : Tenv.t -> Typ.struct_typ -> bool (** return true if [procname] is a special lifecycle cleanup method *) val is_destroy_method : Procname.t -> bool @@ -34,7 +34,7 @@ val is_destroy_method : Procname.t -> bool (** given an Android framework type mangled string [lifecycle_typ] (e.g., android.app.Activity) and a list of method names [lifecycle_procs_strs], get the appropriate typ and procnames *) val get_lifecycle_for_framework_typ_opt : - Tenv.t -> Mangled.t -> string list -> (Sil.struct_typ * Procname.t list) option + Tenv.t -> Mangled.t -> string list -> (Typ.struct_typ * Procname.t list) option (** return true if [class_name] is the name of a class that belong to the Android framework *) val is_android_lib_class : Typename.t -> bool diff --git a/infer/src/harness/harness.ml b/infer/src/harness/harness.ml index 51182ea76..70f720a49 100644 --- a/infer/src/harness/harness.ml +++ b/infer/src/harness/harness.ml @@ -18,11 +18,11 @@ module F = Format constituting a lifecycle trace *) let try_create_lifecycle_trace struct_typ lifecycle_struct_typ lifecycle_procs tenv = match struct_typ with - | { Sil.csu = Csu.Class Java; struct_name = Some name } -> + | { Typ.csu = Csu.Class Java; struct_name = Some name } -> let class_name = Typename.TN_csu (Csu.Class Java, name) in 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 + let ptr_to_struct_typ = Some (Typ.Tptr (Tstruct struct_typ, Pk_pointer)) in IList.fold_left (fun trace lifecycle_proc -> (* given a lifecycle subclass T, resolve the call T.lifecycle_proc() to the procname @@ -50,7 +50,7 @@ let create_harness cfg cg tenv = | [] -> () | lifecycle_trace -> let harness_procname = - let harness_cls_name = match struct_typ.Sil.struct_name with + let harness_cls_name = match struct_typ.Typ.struct_name with | Some name -> Mangled.to_string name | None -> "NONE" in let pname = diff --git a/infer/src/harness/inhabit.ml b/infer/src/harness/inhabit.ml index be47ad873..530ba6593 100644 --- a/infer/src/harness/inhabit.ml +++ b/infer/src/harness/inhabit.ml @@ -16,10 +16,10 @@ module L = Logging module F = Format module P = Printf module IdSet = Ident.IdentSet -module TypSet = Sil.TypSet -module TypMap = Sil.TypMap +module TypSet = Typ.Set +module TypMap = Typ.Map -type lifecycle_trace = (Procname.t * Sil.typ option) list +type lifecycle_trace = (Procname.t * Typ.t option) list (** list of instrs and temporary variables created during inhabitation and a cache of types that * have already been inhabited *) @@ -74,7 +74,7 @@ let inhabit_alloc sizeof_typ sizeof_len ret_typ alloc_kind env = let call_instr = let fun_new = fun_exp_from_name alloc_kind in let sizeof_exp = Sil.Sizeof (sizeof_typ, sizeof_len, Sil.Subtype.exact) in - let args = [(sizeof_exp, Sil.Tptr (ret_typ, Sil.Pk_pointer))] in + let args = [(sizeof_exp, Typ.Tptr (ret_typ, Typ.Pk_pointer))] in Sil.Call ([retval], fun_new, args, env.pc, cf_alloc) in (inhabited_exp, env_add_instr call_instr env) @@ -84,18 +84,18 @@ let rec inhabit_typ typ cfg env = try (TypMap.find typ env.cache, env) with Not_found -> let inhabit_internal typ env = match typ with - | Sil.Tptr (Sil.Tarray (inner_typ, Some _), Sil.Pk_pointer) -> + | Typ.Tptr (Typ.Tarray (inner_typ, Some _), Typ.Pk_pointer) -> let len = Sil.Const (Sil.Cint (IntLit.one)) in - let arr_typ = Sil.Tarray (inner_typ, Some IntLit.one) in + let arr_typ = Typ.Tarray (inner_typ, Some IntLit.one) in inhabit_alloc arr_typ (Some len) typ ModelBuiltins.__new_array env - | Sil.Tptr (typ, Sil.Pk_pointer) as ptr_to_typ -> + | Typ.Tptr (typ, Typ.Pk_pointer) as ptr_to_typ -> (* TODO (t4575417): this case does not work correctly for enums, but they are currently * broken in Infer anyway (see t4592290) *) let (allocated_obj_exp, env) = inhabit_alloc typ None typ ModelBuiltins.__new env in (* select methods that are constructors and won't force us into infinite recursion because * we are already inhabiting one of their argument types *) let get_all_suitable_constructors typ = match typ with - | Sil.Tstruct { Sil.csu = Csu.Class _; def_methods } -> + | Typ.Tstruct { Typ.csu = Csu.Class _; def_methods } -> let is_suitable_constructor p = let try_get_non_receiver_formals p = get_non_receiver_formals (formals_from_name cfg p) in @@ -130,10 +130,10 @@ let rec inhabit_typ typ cfg env = let fresh_id = Ident.create_fresh Ident.knormal in let read_from_local_instr = Sil.Letderef (fresh_id, fresh_local_exp, ptr_to_typ, env'.pc) in (Sil.Var fresh_id, env_add_instr read_from_local_instr env') - | Sil.Tint (_) -> (Sil.Const (Sil.Cint (IntLit.zero)), env) - | Sil.Tfloat (_) -> (Sil.Const (Sil.Cfloat 0.0), env) + | Typ.Tint (_) -> (Sil.Const (Sil.Cint (IntLit.zero)), env) + | Typ.Tfloat (_) -> (Sil.Const (Sil.Cfloat 0.0), env) | typ -> - L.err "Couldn't inhabit typ: %a@." (Sil.pp_typ pe_text) typ; + L.err "Couldn't inhabit typ: %a@." (Typ.pp pe_text) typ; assert false in let (inhabited_exp, env') = inhabit_internal typ { env with cur_inhabiting = TypSet.add typ env.cur_inhabiting } in @@ -164,7 +164,7 @@ and inhabit_constructor constr_name (allocated_obj, obj_type) cfg env = let inhabit_call_with_args procname procdesc args env = let retval = - let is_void = Cfg.Procdesc.get_ret_type procdesc = Sil.Tvoid in + let is_void = Cfg.Procdesc.get_ret_type procdesc = Typ.Tvoid in if is_void then [] else [Ident.create_fresh Ident.knormal] in let call_instr = let fun_exp = fun_exp_from_name procname in diff --git a/infer/src/harness/inhabit.mli b/infer/src/harness/inhabit.mli index 9d5909d9e..a86dbc380 100644 --- a/infer/src/harness/inhabit.mli +++ b/infer/src/harness/inhabit.mli @@ -11,7 +11,7 @@ open! Utils (** Generate a procedure that calls a given sequence of methods. Useful for harness/test generation. *) -type lifecycle_trace = (Procname.t * Sil.typ option) list +type lifecycle_trace = (Procname.t * Typ.t option) list (** create a procedure named harness_name that calls each of the methods in trace add it to the cg/cfg *) diff --git a/infer/src/harness/stacktrace.ml b/infer/src/harness/stacktrace.ml index 8b2aa76a1..19ffd9ab4 100644 --- a/infer/src/harness/stacktrace.ml +++ b/infer/src/harness/stacktrace.ml @@ -44,7 +44,7 @@ let try_resolve_frame (str_frame : str_frame) exe_env tenv = * in the stack trace. Note that the stack trace does not have any type or argument information; * the name is all that we have to go on *) match Tenv.lookup tenv (Typename.TN_csu (Csu.Class Csu.Java, class_name)) with - | Some Sil.Tstruct { Sil.csu = Csu.Class _; def_methods } -> + | Some Typ.Tstruct { Typ.csu = Csu.Class _; def_methods } -> let possible_calls = IList.filter (fun proc -> Procname.java_get_method proc = str_frame.method_str) diff --git a/infer/src/java/jAnnotation.ml b/infer/src/java/jAnnotation.ml index 23a495216..3e6801fd8 100644 --- a/infer/src/java/jAnnotation.ml +++ b/infer/src/java/jAnnotation.ml @@ -17,12 +17,12 @@ let is_suppress_warnings_annotated = Inferconfig.suppress_warnings_matcher DB.source_file_empty let suppress_warnings = - ({ Sil.class_name = Annotations.suppress_warnings; - Sil.parameters = ["infer"] }, + ({ Typ.class_name = Annotations.suppress_warnings; + Typ.parameters = ["infer"] }, true) (** Translate an annotation. *) -let translate a : Sil.annotation = +let translate a : Typ.annotation = let class_name = JBasics.cn_name a.JBasics.kind in let translate_value_pair (_, value) = match value with @@ -32,12 +32,12 @@ let translate a : Sil.annotation = s | _ -> "?" in let element_value_pairs = a.JBasics.element_value_pairs in - { Sil.class_name = class_name; - Sil.parameters = IList.map translate_value_pair element_value_pairs } + { Typ.class_name = class_name; + Typ.parameters = IList.map translate_value_pair element_value_pairs } (** Translate an item annotation. *) -let translate_item avlist : Sil.item_annotation = +let translate_item avlist : Typ.item_annotation = let trans_vis = function | Javalib.RTVisible -> true | Javalib.RTInvisible -> false in @@ -46,7 +46,7 @@ let translate_item avlist : Sil.item_annotation = (** Translate a method annotation. *) -let translate_method proc_name_java ann : Sil.method_annotation = +let translate_method proc_name_java ann : Typ.method_annotation = let global_ann = ann.Javalib.ma_global in let param_ann = ann.Javalib.ma_parameters in let ret_item = diff --git a/infer/src/java/jAnnotation.mli b/infer/src/java/jAnnotation.mli index 2586b764e..f932f22a7 100644 --- a/infer/src/java/jAnnotation.mli +++ b/infer/src/java/jAnnotation.mli @@ -14,7 +14,7 @@ open Javalib_pack (** Translate an item annotation. *) -val translate_item : (JBasics.annotation * Javalib.visibility) list -> Sil.item_annotation +val translate_item : (JBasics.annotation * Javalib.visibility) list -> Typ.item_annotation (** Translate a method annotation. *) -val translate_method : Procname.java -> Javalib.method_annotations -> Sil.method_annotation +val translate_method : Procname.java -> Javalib.method_annotations -> Typ.method_annotation diff --git a/infer/src/java/jContext.ml b/infer/src/java/jContext.ml index f8bdd93c3..658e03b63 100644 --- a/infer/src/java/jContext.ml +++ b/infer/src/java/jContext.ml @@ -35,7 +35,7 @@ type t = { icfg : icfg; procdesc : Cfg.Procdesc.t; impl : JBir.t; - mutable var_map : (Pvar.t * Sil.typ * Sil.typ) JBir.VarMap.t; + mutable var_map : (Pvar.t * Typ.t * Typ.t) JBir.VarMap.t; if_jumps : int NodeTbl.t; goto_jumps : (int, jump_kind) Hashtbl.t; cn : JBasics.class_name; diff --git a/infer/src/java/jContext.mli b/infer/src/java/jContext.mli index 0843ea602..4c8a34f2d 100644 --- a/infer/src/java/jContext.mli +++ b/infer/src/java/jContext.mli @@ -103,10 +103,10 @@ val get_program : t -> JClasspath.program val get_node : t -> JCode.jcode Javalib.interface_or_class (** [set_pvar context var type] adds a variable with a type to the context *) -val set_pvar : t -> JBir.var -> Sil.typ -> Pvar.t +val set_pvar : t -> JBir.var -> Typ.t -> Pvar.t (** [get_var_type context var] returns the type of the variable, if the variable is in the context *) -val get_var_type : t -> JBir.var -> Sil.typ option +val get_var_type : t -> JBir.var -> Typ.t option (** resets the dynamic type of the variables in the context. *) val reset_pvar_type : t -> unit diff --git a/infer/src/java/jTrans.ml b/infer/src/java/jTrans.ml index 2784d80a1..73934f6f7 100644 --- a/infer/src/java/jTrans.ml +++ b/infer/src/java/jTrans.ml @@ -108,7 +108,7 @@ let retrieve_fieldname fieldname = let get_field_name program static tenv cn fs = match JTransType.get_class_type_no_pointer program tenv cn with - | Sil.Tstruct { Sil.instance_fields; static_fields; csu = Csu.Class _ } -> + | Typ.Tstruct { Typ.instance_fields; static_fields; csu = Csu.Class _ } -> let fieldname, _, _ = try IList.find @@ -160,7 +160,7 @@ let locals_formals program tenv cn impl meth_kind = let vname = Mangled.from_string (JBir.var_name_g var) in let names = (fst (IList.split l)) in if not (is_formal vname) && (not (IList.mem Mangled.equal vname names)) then - (vname, Sil.Tvoid):: l + (vname, Typ.Tvoid):: l else l in let vars = JBir.vars impl in @@ -373,7 +373,7 @@ let create_local_procdesc program linereader cfg tenv node m = let create_external_procdesc program cfg tenv cn ms kind = let return_type = match JBasics.ms_rtype ms with - | None -> Sil.Tvoid + | None -> Typ.Tvoid | Some vt -> JTransType.value_type program tenv vt in let formals = formals_from_signature program tenv cn ms kind in let proc_name_java = JTransType.get_method_procname cn ms kind in @@ -442,7 +442,7 @@ let rec expression context pc expr = | JBir.ArrayLength -> let array_typ_no_ptr = match type_of_ex with - | Sil.Tptr (typ, _) -> typ + | Typ.Tptr (typ, _) -> typ | _ -> type_of_ex in let deref = create_sil_deref sil_ex array_typ_no_ptr loc in let args = [(sil_ex, type_of_ex)] in @@ -466,7 +466,7 @@ let rec expression context pc expr = | JBir.InstanceOf _ -> Sil.Const (Sil.Cfun ModelBuiltins.__instanceof) | JBir.Cast _ -> Sil.Const (Sil.Cfun ModelBuiltins.__cast) | _ -> assert false) in - let args = [(sil_ex, type_of_ex); (sizeof_expr, Sil.Tvoid)] in + let args = [(sil_ex, type_of_ex); (sizeof_expr, Typ.Tvoid)] in let ret_id = Ident.create_fresh Ident.knormal in let call = Sil.Call([ret_id], builtin, args, loc, Sil.cf_default) in let res_ex = Sil.Var ret_id in @@ -479,7 +479,7 @@ let rec expression context pc expr = match binop with | JBir.ArrayLoad _ -> (* add an instruction that dereferences the array *) - let array_typ = Sil.Tarray (type_of_expr, None) in + let array_typ = Typ.Tarray (type_of_expr, None) in let deref_array_instr = create_sil_deref sil_ex1 array_typ loc in let id = Ident.create_fresh Ident.knormal in let letderef_instr = @@ -575,7 +575,7 @@ let method_invocation context loc pc var_opt cn ms sil_obj_opt expr_list invoke_ | Sil.Var _ when is_non_constructor_call && not Config.report_runtime_exceptions -> let obj_typ_no_ptr = match sil_obj_type with - | Sil.Tptr (typ, _) -> typ + | Typ.Tptr (typ, _) -> typ | _ -> sil_obj_type in [create_sil_deref sil_obj_expr obj_typ_no_ptr loc] | _ -> [] in @@ -597,7 +597,7 @@ let method_invocation context loc pc var_opt cn ms sil_obj_opt expr_list invoke_ let callee_fun = Sil.Const (Sil.Cfun callee_procname) in let return_type = match JBasics.ms_rtype ms with - | None -> Sil.Tvoid + | None -> Typ.Tvoid | Some vt -> JTransType.value_type program tenv vt in let call_ret_instrs sil_var = let ret_id = Ident.create_fresh Ident.knormal in @@ -647,7 +647,7 @@ let get_array_length context pc expr_list content_type = (instrs @ other_instrs, sil_len_expr :: other_exprs) in let (instrs, sil_len_exprs) = (IList.fold_right get_expr_instr expr_list ([],[])) in let get_array_type_len sil_len_expr (content_type, _) = - (Sil.Tarray (content_type, None), Some sil_len_expr) in + (Typ.Tarray (content_type, None), Some sil_len_expr) in let array_type, array_len = IList.fold_right get_array_type_len sil_len_exprs (content_type, None) in let array_size = Sil.Sizeof (array_type, array_len, Sil.Subtype.exact) in @@ -764,7 +764,7 @@ let assume_not_null loc sil_expr = let not_null_expr = Sil.BinOp (Sil.Ne, sil_expr, Sil.exp_null) in let assume_call_flag = { Sil.cf_default with Sil.cf_noreturn = true; } in - let call_args = [(not_null_expr, Sil.Tint Sil.IBool)] in + let call_args = [(not_null_expr, Typ.Tint Typ.IBool)] in Sil.Call ([], builtin_infer_assume, call_args, loc, assume_call_flag) let rec instruction context pc instr : translation = @@ -1087,7 +1087,7 @@ let rec instruction context pc instr : translation = and sizeof_expr = JTransType.sizeof_of_object_type program tenv object_type Sil.Subtype.subtypes_instof in let check_cast = Sil.Const (Sil.Cfun ModelBuiltins.__instanceof) in - let args = [(sil_expr, sil_type); (sizeof_expr, Sil.Tvoid)] in + let args = [(sil_expr, sil_type); (sizeof_expr, Typ.Tvoid)] in let call = Sil.Call([ret_id], check_cast, args, loc, Sil.cf_default) in let res_ex = Sil.Var ret_id in let is_instance_node = diff --git a/infer/src/java/jTransExn.ml b/infer/src/java/jTransExn.ml index 5dadc8ce1..3dd4fd987 100644 --- a/infer/src/java/jTransExn.ml +++ b/infer/src/java/jTransExn.ml @@ -62,14 +62,14 @@ let translate_exceptions context exit_nodes get_body_nodes handler_table = | None -> JBasics.make_cn "java.lang.Exception" | Some cn -> cn in match JTransType.get_class_type (JContext.get_program context) (JContext.get_tenv context) class_name with - | Sil.Tptr (typ, _) -> typ + | Typ.Tptr (typ, _) -> typ | _ -> assert false in let id_instanceof = Ident.create_fresh Ident.knormal in let instr_call_instanceof = let instanceof_builtin = Sil.Const (Sil.Cfun ModelBuiltins.__instanceof) in let args = [ - (Sil.Var id_exn_val, Sil.Tptr(exn_type, Sil.Pk_pointer)); - (Sil.Sizeof (exn_type, None, Sil.Subtype.exact), Sil.Tvoid)] in + (Sil.Var id_exn_val, Typ.Tptr(exn_type, Typ.Pk_pointer)); + (Sil.Sizeof (exn_type, None, Sil.Subtype.exact), Typ.Tvoid)] in Sil.Call ([id_instanceof], instanceof_builtin, args, loc, Sil.cf_default) in let if_kind = Sil.Ik_switch in let instr_prune_true = Sil.Prune (Sil.Var id_instanceof, loc, true, if_kind) in diff --git a/infer/src/java/jTransStaticField.mli b/infer/src/java/jTransStaticField.mli index c577237aa..bf3bdf432 100644 --- a/infer/src/java/jTransStaticField.mli +++ b/infer/src/java/jTransStaticField.mli @@ -18,7 +18,8 @@ val is_static_final_field : JContext.t -> JBasics.class_name -> JBasics.field_si val has_static_final_fields : JCode.jcode Javalib.interface_or_class -> bool -val translate_instr_static_field : JContext.t -> Cfg.Procdesc.t -> JBasics.field_signature -> Sil.typ -> +val translate_instr_static_field : + JContext.t -> Cfg.Procdesc.t -> JBasics.field_signature -> Typ.t -> Location.t -> Sil.instr list * Sil.exp diff --git a/infer/src/java/jTransType.ml b/infer/src/java/jTransType.ml index be6bed99f..81188e5fd 100644 --- a/infer/src/java/jTransType.ml +++ b/infer/src/java/jTransType.ml @@ -18,32 +18,32 @@ open Sawja_pack exception Type_tranlsation_error of string let basic_type = function - | `Int -> Sil.Tint Sil.IInt - | `Bool -> Sil.Tint Sil.IBool - | `Byte -> Sil.Tint Sil.IChar - | `Char -> Sil.Tint Sil.IChar - | `Double -> Sil.Tfloat Sil.FDouble - | `Float -> Sil.Tfloat Sil.FFloat - | `Long -> Sil.Tint Sil.ILong - | `Short -> Sil.Tint Sil.IShort + | `Int -> Typ.Tint Typ.IInt + | `Bool -> Typ.Tint Typ.IBool + | `Byte -> Typ.Tint Typ.IChar + | `Char -> Typ.Tint Typ.IChar + | `Double -> Typ.Tfloat Typ.FDouble + | `Float -> Typ.Tfloat Typ.FFloat + | `Long -> Typ.Tint Typ.ILong + | `Short -> Typ.Tint Typ.IShort let cast_type = function | JBir.F2I | JBir.L2I - | JBir.D2I -> Sil.Tint Sil.IInt + | JBir.D2I -> Typ.Tint Typ.IInt | JBir.D2L | JBir.F2L - | JBir.I2L -> Sil.Tint Sil.ILong + | JBir.I2L -> Typ.Tint Typ.ILong | JBir.I2F | JBir.L2F - | JBir.D2F -> Sil.Tfloat Sil.FFloat + | JBir.D2F -> Typ.Tfloat Typ.FFloat | JBir.L2D | JBir.F2D - | JBir.I2D -> Sil.Tfloat Sil.FDouble - | JBir.I2B -> Sil.Tint Sil.IBool - | JBir.I2C -> Sil.Tint Sil.IChar - | JBir.I2S -> Sil.Tint Sil.IShort + | JBir.I2D -> Typ.Tfloat Typ.FDouble + | JBir.I2B -> Typ.Tint Typ.IBool + | JBir.I2C -> Typ.Tint Typ.IChar + | JBir.I2S -> Typ.Tint Typ.IShort let const_type const = @@ -69,27 +69,27 @@ let rec get_named_type vt = match ot with | JBasics.TArray vt -> let content_type = get_named_type vt in - Sil.Tptr (Sil.Tarray (content_type, None), Sil.Pk_pointer) - | JBasics.TClass cn -> Sil.Tptr (Sil.Tvar (typename_of_classname cn), Sil.Pk_pointer) + Typ.Tptr (Typ.Tarray (content_type, None), Typ.Pk_pointer) + | JBasics.TClass cn -> Typ.Tptr (Typ.Tvar (typename_of_classname cn), Typ.Pk_pointer) end let extract_cn_type_np typ = match typ with - | Sil.Tptr(vtyp, Sil.Pk_pointer) -> + | Typ.Tptr(vtyp, Typ.Pk_pointer) -> vtyp | _ -> typ let rec create_array_type typ dim = if dim > 0 then let content_typ = create_array_type typ (dim - 1) in - Sil.Tptr(Sil.Tarray (content_typ, None), Sil.Pk_pointer) + Typ.Tptr(Typ.Tarray (content_typ, None), Typ.Pk_pointer) else typ let extract_cn_no_obj typ = match typ with - | Sil.Tptr (Sil.Tstruct { Sil.csu = Csu.Class _; struct_name = Some classname }, - Sil.Pk_pointer) -> + | Typ.Tptr (Typ.Tstruct { Typ.csu = Csu.Class _; struct_name = Some classname }, + Typ.Pk_pointer) -> let class_name = (Mangled.to_string classname) in if class_name = JConfig.object_cl then None else @@ -237,14 +237,14 @@ let collect_interface_field cn inf l = let dummy_type cn = let classname = Mangled.from_string (JBasics.cn_name cn) in - Sil.Tstruct { - Sil.instance_fields = []; + Typ.Tstruct { + Typ.instance_fields = []; static_fields = []; csu = Csu.Class Csu.Java; struct_name = Some classname; superclasses = []; def_methods = []; - struct_annotations = Sil.item_annotation_empty; + struct_annotations = Typ.item_annotation_empty; } @@ -253,13 +253,13 @@ let collect_models_class_fields classpath_field_map cn cf fields = let field_name, field_type, annotation = create_sil_class_field cn cf in try let classpath_ft = Ident.FieldMap.find field_name classpath_field_map in - if Sil.typ_equal classpath_ft field_type then fields + if Typ.equal classpath_ft field_type then fields else (* TODO (#6711750): fix type equality for arrays before failing here *) let () = Logging.stderr "Found inconsistent types for %s\n\tclasspath: %a\n\tmodels: %a\n@." (Ident.fieldname_to_string field_name) - (Sil.pp_typ_full pe_text) classpath_ft - (Sil.pp_typ_full pe_text) field_type in fields + (Typ.pp_full pe_text) classpath_ft + (Typ.pp_full pe_text) field_type in fields with Not_found -> if Javalib.is_static_field (Javalib.ClassField cf) then ((field_name, field_type, annotation):: static, nonstatic) @@ -289,7 +289,7 @@ let add_model_fields program classpath_fields cn = let rec get_all_fields program tenv cn = let extract_class_fields classname = match get_class_type_no_pointer program tenv classname with - | Sil.Tstruct { Sil.instance_fields; static_fields } -> (static_fields, instance_fields) + | Typ.Tstruct { Typ.instance_fields; static_fields } -> (static_fields, instance_fields) | _ -> assert false in let trans_fields classname = match JClasspath.lookup_node classname program with @@ -333,15 +333,15 @@ and create_sil_type program tenv cn = | Some super_cn -> let super_classname = match get_class_type_no_pointer program tenv super_cn with - | Sil.Tstruct { Sil.struct_name = Some classname } -> + | Typ.Tstruct { Typ.struct_name = Some classname } -> Typename.TN_csu (Csu.Class Csu.Java, classname) | _ -> assert false in super_classname :: interface_list in (super_classname_list, nonstatic_fields, static_fields, item_annotation) in let classname = Mangled.from_string (JBasics.cn_name cn) in let def_methods = IList.map (fun j -> Procname.Java j) (get_class_procnames cn node) in - Sil.Tstruct { - Sil.instance_fields; + Typ.Tstruct { + Typ.instance_fields; static_fields; csu = Csu.Class Csu.Java; struct_name = Some classname; @@ -355,15 +355,15 @@ and get_class_type_no_pointer program tenv cn = match Tenv.lookup tenv named_type with | None -> (match create_sil_type program tenv cn with - | (Sil.Tstruct struct_typ) as typ-> + | (Typ.Tstruct struct_typ) as typ-> Tenv.add tenv named_type struct_typ; typ | _ -> assert false) - | Some struct_typ -> Sil.Tstruct struct_typ + | Some struct_typ -> Typ.Tstruct struct_typ let get_class_type program tenv cn = let t = get_class_type_no_pointer program tenv cn in - Sil.Tptr (t, Sil.Pk_pointer) + Typ.Tptr (t, Typ.Pk_pointer) (** return true if [field_name] is the autogenerated C.$assertionsDisabled field for class C *) let is_autogenerated_assert_field field_name = @@ -382,7 +382,7 @@ let is_closeable program tenv typ = let rec object_type program tenv ot = match ot with | JBasics.TClass cn -> get_class_type program tenv cn - | JBasics.TArray at -> Sil.Tptr (Sil.Tarray (value_type program tenv at, None), Sil.Pk_pointer) + | JBasics.TArray at -> Typ.Tptr (Typ.Tarray (value_type program tenv at, None), Typ.Pk_pointer) (** translate a value type *) and value_type program tenv vt = match vt with @@ -393,7 +393,7 @@ and value_type program tenv vt = (** Translate object types into Sil.Sizeof expressions *) let sizeof_of_object_type program tenv ot subtypes = match object_type program tenv ot with - | Sil.Tptr (typ, _) -> + | Typ.Tptr (typ, _) -> Sil.Sizeof (typ, None, subtypes) | _ -> raise (Type_tranlsation_error "Pointer or array type expected in tenv") @@ -427,7 +427,7 @@ let get_var_type context var = let extract_array_type typ = match typ with - | Sil.Tptr(Sil.Tarray (vtyp, _), Sil.Pk_pointer) -> vtyp + | Typ.Tptr(Typ.Tarray (vtyp, _), Typ.Pk_pointer) -> vtyp | _ -> typ @@ -456,7 +456,7 @@ let return_type program tenv ms meth_kind = get_class_type program tenv (JBasics.make_cn JConfig.object_cl) else match JBasics.ms_rtype ms with - | None -> Sil.Tvoid + | None -> Typ.Tvoid | Some vt -> value_type program tenv vt diff --git a/infer/src/java/jTransType.mli b/infer/src/java/jTransType.mli index b021cefc1..537927de6 100644 --- a/infer/src/java/jTransType.mli +++ b/infer/src/java/jTransType.mli @@ -14,7 +14,7 @@ open Javalib_pack open Sawja_pack (** transforms a Java type into a Sil named type *) -val get_named_type : JBasics.value_type -> Sil.typ +val get_named_type : JBasics.value_type -> Typ.t (** transforms a Java class name into a Sil class name *) val typename_of_classname : JBasics.class_name -> Typename.t @@ -30,52 +30,52 @@ val get_method_procname : (** [get_class_type_no_pointer program tenv cn] returns the sil type representation of the class without the pointer part *) -val get_class_type_no_pointer: JClasspath.program -> Tenv.t -> JBasics.class_name -> Sil.typ +val get_class_type_no_pointer: JClasspath.program -> Tenv.t -> JBasics.class_name -> Typ.t (** [get_class_type program tenv cn] returns the sil type representation of the class *) -val get_class_type : JClasspath.program -> Tenv.t -> JBasics.class_name -> Sil.typ +val get_class_type : JClasspath.program -> Tenv.t -> JBasics.class_name -> Typ.t (** return true if [field_name] is the autogenerated C.$assertionsDisabled field for class C *) val is_autogenerated_assert_field : Ident.fieldname -> bool (** [is_closeable program tenv typ] check if typ is an implemtation of the Closeable interface *) -val is_closeable : JClasspath.program -> Tenv.t -> Sil.typ -> bool +val is_closeable : JClasspath.program -> Tenv.t -> Typ.t -> bool -(** transforms a Java object type to a Sil type *) -val object_type : JClasspath.program -> Tenv.t -> JBasics.object_type -> Sil.typ +(** transforms a Java object type to a Typ.t *) +val object_type : JClasspath.program -> Tenv.t -> JBasics.object_type -> Typ.t (** create sizeof expressions from the object type and the list of subtypes *) val sizeof_of_object_type : JClasspath.program -> Tenv.t -> JBasics.object_type -> Sil.Subtype.t -> Sil.exp -(** transforms a Java type to a Sil type. *) -val value_type : JClasspath.program -> Tenv.t -> JBasics.value_type -> Sil.typ +(** transforms a Java type to a Typ.t. *) +val value_type : JClasspath.program -> Tenv.t -> JBasics.value_type -> Typ.t (** return the type of a formal parameter, looking up the class name in case of "this" *) val param_type : - JClasspath.program -> Tenv.t -> JBasics.class_name -> JBir.var -> JBasics.value_type -> Sil.typ + JClasspath.program -> Tenv.t -> JBasics.class_name -> JBir.var -> JBasics.value_type -> Typ.t (** Returns the return type of the method based on the return type specified in ms. If the method is the initialiser, return the type Object instead. *) val return_type : - JClasspath.program -> Tenv.t -> JBasics.method_signature -> JContext.meth_kind -> Sil.typ + JClasspath.program -> Tenv.t -> JBasics.method_signature -> JContext.meth_kind -> Typ.t (** translates the type of an expression *) -val expr_type : JContext.t -> JBir.expr -> Sil.typ +val expr_type : JContext.t -> JBir.expr -> Typ.t (** translates a conversion type from Java to Sil. *) -val cast_type : JBir.conv -> Sil.typ +val cast_type : JBir.conv -> Typ.t val package_to_string : string list -> string option (** [create_array_type typ dim] creates an array type with dimension dim and content typ *) -val create_array_type : Sil.typ -> int -> Sil.typ +val create_array_type : Typ.t -> int -> Typ.t (** [extract_cn_type_np] returns the internal type of type when typ is a pointer type, otherwise returns typ *) -val extract_cn_type_np : Sil.typ -> Sil.typ +val extract_cn_type_np : Typ.t -> Typ.t (** [extract_cn_type_np] returns the Java class name of typ when typ is a pointer type, otherwise returns None *) -val extract_cn_no_obj : Sil.typ -> JBasics.class_name option +val extract_cn_no_obj : Typ.t -> JBasics.class_name option (** returns a string representation of a Java basic type. *) val string_of_basic_type : JBasics.java_basic_type -> string diff --git a/infer/src/llvm/lTrans.ml b/infer/src/llvm/lTrans.ml index 19a645edf..893e89bea 100644 --- a/infer/src/llvm/lTrans.ml +++ b/infer/src/llvm/lTrans.ml @@ -31,13 +31,13 @@ let trans_operand : LAst.operand -> Sil.exp = function | Var var -> trans_variable var | Const const -> trans_constant const -let rec trans_typ : LAst.typ -> Sil.typ = function - | Tint _i -> Sil.Tint Sil.IInt (* TODO: check what size int is needed here *) - | Tfloat -> Sil.Tfloat Sil.FFloat - | Tptr tp -> Sil.Tptr (trans_typ tp, Sil.Pk_pointer) +let rec trans_typ : LAst.typ -> Typ.t = function + | Tint _i -> Typ.Tint Typ.IInt (* TODO: check what size int is needed here *) + | Tfloat -> Typ.Tfloat Typ.FFloat + | Tptr tp -> Typ.Tptr (trans_typ tp, Typ.Pk_pointer) | Tvector (i, tp) - | Tarray (i, tp) -> Sil.Tarray (trans_typ tp, Some (IntLit.of_int i)) - | Tfunc _ -> Sil.Tfun false + | Tarray (i, tp) -> Typ.Tarray (trans_typ tp, Some (IntLit.of_int i)) + | Tfunc _ -> Typ.Tfun false | Tlabel -> raise (ImproperTypeError "Tried to generate Sil type from LLVM label type.") | Tmetadata -> raise (ImproperTypeError "Tried to generate Sil type from LLVM metadata type.") @@ -62,7 +62,7 @@ let procname_of_function_variable (func_var : LAst.variable) : Procname.t = (* Generate list of SIL instructions and list of local variables *) let rec trans_annotated_instructions (cfg : Cfg.cfg) (procdesc : Cfg.Procdesc.t) (metadata : LAst.metadata_map) - : LAst.annotated_instruction list -> Sil.instr list * (Mangled.t * Sil.typ) list = function + : LAst.annotated_instruction list -> Sil.instr list * (Mangled.t * Typ.t) list = function | [] -> ([], []) | (instr, anno) :: t -> let (sil_instrs, locals) = trans_annotated_instructions cfg procdesc metadata t in @@ -127,7 +127,7 @@ let trans_function_def (cfg : Cfg.cfg) (cg: Cg.t) (metadata : LAst.metadata_map) let proc_name = procname_of_function_variable func_name in let ret_type = match ret_tp_opt with - | None -> Sil.Tvoid + | None -> Typ.Tvoid | Some ret_tp -> trans_typ ret_tp in let (proc_attrs : ProcAttributes.t) = { (ProcAttributes.default proc_name Config.Clang) with diff --git a/infer/src/unit/addressTakenTests.ml b/infer/src/unit/addressTakenTests.ml index 71130b5d5..f3e323bf4 100644 --- a/infer/src/unit/addressTakenTests.ml +++ b/infer/src/unit/addressTakenTests.ml @@ -20,9 +20,9 @@ let tests = let open OUnit2 in let open AnalyzerTester.StructuredSil in let assert_empty = invariant "{ }" in - let int_typ = Sil.Tint IInt in - let int_ptr_typ = Sil.Tptr (int_typ, Pk_pointer) in - let fun_ptr_typ = Sil.Tptr (Tfun false, Pk_pointer) in + let int_typ = Typ.Tint IInt in + let int_ptr_typ = Typ.Tptr (int_typ, Pk_pointer) in + let fun_ptr_typ = Typ.Tptr (Tfun false, Pk_pointer) in let closure_exp captureds = let mk_captured_var str = (Sil.Var (ident_of_str str), pvar_of_str str, int_ptr_typ) in let captured_vars = IList.map mk_captured_var captureds in diff --git a/infer/src/unit/analyzerTester.ml b/infer/src/unit/analyzerTester.ml index eaa8ae29b..0a0e2f1c7 100644 --- a/infer/src/unit/analyzerTester.ml +++ b/infer/src/unit/analyzerTester.ml @@ -59,7 +59,7 @@ module StructuredSil = struct let pp_structured_program = pp_structured_instr_list - let dummy_typ = Sil.Tvoid + let dummy_typ = Typ.Tvoid let dummy_loc = Location.dummy let dummy_procname = Procname.empty_block @@ -115,7 +115,7 @@ module StructuredSil = struct let var_assign_int lhs rhs = let rhs_exp = Sil.exp_int (IntLit.of_int rhs) in - let rhs_typ = Sil.Tint Sil.IInt in + let rhs_typ = Typ.Tint Typ.IInt in var_assign_exp ~rhs_typ lhs rhs_exp let var_assign_id ?(rhs_typ=dummy_typ) lhs rhs = diff --git a/infer/src/unit/livenessTests.ml b/infer/src/unit/livenessTests.ml index 55817835a..5128eeae2 100644 --- a/infer/src/unit/livenessTests.ml +++ b/infer/src/unit/livenessTests.ml @@ -20,7 +20,7 @@ let tests = let open OUnit2 in let open AnalyzerTester.StructuredSil in let assert_empty = invariant "{ }" in - let fun_ptr_typ = Sil.Tptr (Tfun false, Pk_pointer) in + let fun_ptr_typ = Typ.Tptr (Tfun false, Pk_pointer) in let closure_exp captured_pvars = let mk_captured_var str = (Sil.Var (ident_of_str str), pvar_of_str str, dummy_typ) in let captured_vars = IList.map mk_captured_var captured_pvars in