diff --git a/infer/src/IR/CSharpClassName.ml b/infer/src/IR/CSharpClassName.ml index 41216f8d02e..d0207f6baf1 100644 --- a/infer/src/IR/CSharpClassName.ml +++ b/infer/src/IR/CSharpClassName.ml @@ -46,14 +46,3 @@ let classname {classname} = classname let pp_with_verbosity ~verbose fmt t = if verbose then pp fmt t else F.pp_print_string fmt (classname t) - - -module Normalizer : HashNormalizer.S with type t = t = struct - type nonrec t = t - - let normalize = hash_normalize - - let normalize_opt = hash_normalize_opt - - let normalize_list = hash_normalize_list -end diff --git a/infer/src/IR/CSharpClassName.mli b/infer/src/IR/CSharpClassName.mli index 8a3fcd3c904..45c21bf77e8 100644 --- a/infer/src/IR/CSharpClassName.mli +++ b/infer/src/IR/CSharpClassName.mli @@ -7,7 +7,7 @@ open! IStd -type t [@@deriving compare, equal, yojson_of, sexp, hash] +type t [@@deriving compare, equal, yojson_of, sexp, hash, normalize] val make : namespace:string option -> classname:string -> t @@ -23,5 +23,3 @@ val pp_with_verbosity : verbose:bool -> Format.formatter -> t -> unit (** if [verbose] then print namespace if present, otherwise only print class *) val classname : t -> string - -module Normalizer : HashNormalizer.S with type t = t diff --git a/infer/src/IR/ErlangTypeName.ml b/infer/src/IR/ErlangTypeName.ml index 0136f070434..339e1022062 100644 --- a/infer/src/IR/ErlangTypeName.ml +++ b/infer/src/IR/ErlangTypeName.ml @@ -18,7 +18,7 @@ type t = | Map | GenServerPid of {module_name: string option} | ModuleInfo -[@@deriving compare, equal, yojson_of, sexp, hash] +[@@deriving compare, equal, yojson_of, sexp, hash, normalize] let pp f = function | Any -> @@ -165,22 +165,3 @@ let erlang_namespace = "erlang" let unsupported = "__unsupported" let infer_erlang_namespace = "__infer__erlang" - -module Normalizer = struct - let tuple_cache_size = 256 - - let tuple = Array.init tuple_cache_size ~f:(fun size -> Tuple size) - - type nonrec t = t - - let normalize x = match x with Tuple size when size < tuple_cache_size -> tuple.(size) | x -> x - - let normalize_opt = function - | None -> - None - | some_t -> - IOption.map_changed some_t ~equal:phys_equal ~f:normalize - - - let normalize_list ts = IList.map_changed ts ~equal:phys_equal ~f:normalize -end diff --git a/infer/src/IR/ErlangTypeName.mli b/infer/src/IR/ErlangTypeName.mli index 41b10930c4e..4e98d54908d 100644 --- a/infer/src/IR/ErlangTypeName.mli +++ b/infer/src/IR/ErlangTypeName.mli @@ -16,7 +16,7 @@ type t = | Map | GenServerPid of {module_name: string option} | ModuleInfo -[@@deriving compare, equal, yojson_of, sexp, hash] +[@@deriving compare, equal, yojson_of, sexp, hash, normalize] val pp : Format.formatter -> t -> unit @@ -53,5 +53,3 @@ val erlang_namespace : string val unsupported : string val infer_erlang_namespace : string - -module Normalizer : HashNormalizer.S with type t = t diff --git a/infer/src/IR/HackClassName.ml b/infer/src/IR/HackClassName.ml index 54d9a618126..3ea705293bb 100644 --- a/infer/src/IR/HackClassName.ml +++ b/infer/src/IR/HackClassName.ml @@ -9,7 +9,7 @@ open! IStd module F = Format type t = {namespace: string option; classname: string} -[@@deriving compare, equal, yojson_of, sexp, hash] +[@@deriving compare, equal, yojson_of, sexp, hash, normalize] let make ?namespace classname = {namespace; classname} diff --git a/infer/src/IR/HackClassName.mli b/infer/src/IR/HackClassName.mli index 16907e811ad..43e7adb0200 100644 --- a/infer/src/IR/HackClassName.mli +++ b/infer/src/IR/HackClassName.mli @@ -8,7 +8,7 @@ open! IStd module F = Format -type t [@@deriving compare, equal, yojson_of, sexp, hash] +type t [@@deriving compare, equal, yojson_of, sexp, hash, normalize] val make : ?namespace:string -> string -> t diff --git a/infer/src/IR/IntLit.ml b/infer/src/IR/IntLit.ml index 1b3146322e7..ff1378f8691 100644 --- a/infer/src/IR/IntLit.ml +++ b/infer/src/IR/IntLit.ml @@ -9,13 +9,13 @@ open! IStd module F = Format module L = Logging -type signedness = Signed | Unsigned [@@deriving compare, sexp, hash] +type signedness = Signed | Unsigned [@@deriving compare, sexp, hash, equal, normalize] let join_signedness signedness1 signedness2 = match (signedness1, signedness2) with Signed, Signed -> Signed | _ -> Unsigned -type pointerness = NotPointer | Pointer [@@deriving sexp, hash] +type pointerness = NotPointer | Pointer [@@deriving sexp, hash, equal, normalize] let join_pointerness pointerness1 pointerness2 = match (pointerness1, pointerness2) with NotPointer, NotPointer -> NotPointer | _ -> Pointer @@ -31,10 +31,19 @@ module Z = struct let t_of_sexp sexp = Z.of_string ([%of_sexp: string] sexp) let hash_fold_t hash_state t = [%hash_fold: int] hash_state (Z.hash t) + + module Normalizer = HashNormalizer.Make (struct + type nonrec t = t [@@deriving equal, hash] + + let normalize = Fn.id + end) + + let hash_normalize = Normalizer.normalize end (** signed and unsigned integer literals *) -type t = {signedness: signedness; i: Z.t; pointerness: pointerness} [@@deriving compare, sexp, hash] +type t = {signedness: signedness; i: Z.t; pointerness: pointerness} +[@@deriving compare, sexp, hash, equal, normalize] let yojson_of_t {i} = [%yojson_of: string] (Z.to_string i) diff --git a/infer/src/IR/IntLit.mli b/infer/src/IR/IntLit.mli index 9c756d163bc..729b17c0efe 100644 --- a/infer/src/IR/IntLit.mli +++ b/infer/src/IR/IntLit.mli @@ -10,7 +10,7 @@ open! IStd module F = Format (** signed and unsigned integer literals *) -type t [@@deriving yojson_of, sexp, hash] +type t [@@deriving yojson_of, sexp, hash, normalize] exception OversizedShift diff --git a/infer/src/IR/JavaClassName.ml b/infer/src/IR/JavaClassName.ml index 8a4324f3ec3..ba578ea9add 100644 --- a/infer/src/IR/JavaClassName.ml +++ b/infer/src/IR/JavaClassName.ml @@ -109,14 +109,3 @@ let is_external_via_config t = let pp_with_verbosity ~verbose fmt t = if verbose then pp fmt t else F.pp_print_string fmt (classname t) - - -module Normalizer : HashNormalizer.S with type t = t = struct - type nonrec t = t - - let normalize = hash_normalize - - let normalize_opt = hash_normalize_opt - - let normalize_list = hash_normalize_list -end diff --git a/infer/src/IR/JavaClassName.mli b/infer/src/IR/JavaClassName.mli index 9e6e1721c1e..8ba30e4939c 100644 --- a/infer/src/IR/JavaClassName.mli +++ b/infer/src/IR/JavaClassName.mli @@ -7,7 +7,7 @@ open! IStd -type t [@@deriving compare, equal, yojson_of, sexp, hash] +type t [@@deriving compare, equal, yojson_of, sexp, hash, normalize] module Map : Caml.Map.S with type key = t @@ -52,5 +52,3 @@ val get_user_defined_class_if_anonymous_inner : t -> t option SomeClass$NestedClass$1$17$5. In this example, we should return SomeClass$NestedClass. If this is not an anonymous class, returns [None]. *) - -module Normalizer : HashNormalizer.S with type t = t diff --git a/infer/src/IR/PythonClassName.ml b/infer/src/IR/PythonClassName.ml index 824cd8a1c4f..05a7b4d6895 100644 --- a/infer/src/IR/PythonClassName.ml +++ b/infer/src/IR/PythonClassName.ml @@ -12,7 +12,7 @@ module F = Format - module names - nested classes *) -type t = {classname: string} [@@deriving compare, equal, yojson_of, sexp, hash] +type t = {classname: string} [@@deriving compare, equal, yojson_of, sexp, hash, normalize] let make classname = {classname} diff --git a/infer/src/IR/PythonClassName.mli b/infer/src/IR/PythonClassName.mli index 55b0e296b71..ecf82a246e9 100644 --- a/infer/src/IR/PythonClassName.mli +++ b/infer/src/IR/PythonClassName.mli @@ -8,7 +8,7 @@ open! IStd module F = Format -type t [@@deriving compare, equal, yojson_of, sexp, hash] +type t [@@deriving compare, equal, yojson_of, sexp, hash, normalize] val make : string -> t diff --git a/infer/src/IR/Typ.ml b/infer/src/IR/Typ.ml index 54c92b2cf86..6f4f1eb8ddf 100644 --- a/infer/src/IR/Typ.ml +++ b/infer/src/IR/Typ.ml @@ -29,7 +29,7 @@ type ikind = | IULongLong (** [unsigned long long] (or [unsigned int64_] on Microsoft Visual C) *) | I128 (** [__int128_t] *) | IU128 (** [__uint128_t] *) -[@@deriving compare, equal, yojson_of, sexp, hash] +[@@deriving compare, equal, yojson_of, sexp, hash, normalize] let ikind_to_string = function | IChar -> @@ -73,7 +73,7 @@ let ikind_is_char = function IChar | ISChar | IUChar -> true | _ -> false (** Kinds of floating-point numbers *) type fkind = FFloat (** [float] *) | FDouble (** [double] *) | FLongDouble (** [long double] *) -[@@deriving compare, equal, yojson_of, sexp, hash] +[@@deriving compare, equal, yojson_of, sexp, hash, normalize] let fkind_to_string = function | FFloat -> @@ -92,7 +92,7 @@ type ptr_kind = | Pk_objc_weak (** Obj-C __weak pointer *) | Pk_objc_unsafe_unretained (** Obj-C __unsafe_unretained pointer *) | Pk_objc_autoreleasing (** Obj-C __autoreleasing pointer *) -[@@deriving compare, equal, yojson_of, sexp, hash] +[@@deriving compare, equal, yojson_of, sexp, hash, normalize] let ptr_kind_string = function | Pk_lvalue_reference -> @@ -119,7 +119,7 @@ module T = struct ; is_restrict: bool ; is_trivially_copyable: bool [@ignore] ; is_volatile: bool } - [@@deriving compare, equal, yojson_of, sexp, hash] + [@@deriving compare, equal, yojson_of, sexp, hash, normalize] (** types for sil (structured) expressions *) type t = {desc: desc; quals: type_quals} @@ -154,7 +154,7 @@ module T = struct and template_spec_info = | NoTemplate | Template of {mangled: string option; args: template_arg list} - [@@deriving compare, equal, yojson_of] + [@@deriving compare, equal, yojson_of, hash, normalize] let yojson_of_name = [%yojson_of: _] @@ -390,111 +390,6 @@ let is_template_spec_info_empty = function false -module TypeQualsNormalizer = HashNormalizer.Make (struct - type t = type_quals [@@deriving equal, hash] - - let normalize = Fn.id -end) - -module rec DescNormalizer : (HashNormalizer.S with type t = desc) = HashNormalizer.Make (struct - type t = desc [@@deriving equal, hash] - - let normalize t = - match t with - | Tint _ | Tfloat _ | Tvoid | Tfun -> - t - | Tstruct name -> - let name' = NameNormalizer.normalize name in - if phys_equal name name' then t else Tstruct name' - | TVar str_var -> - let str_var' = HashNormalizer.String.hash_normalize str_var in - if phys_equal str_var str_var' then t else TVar str_var' - | Tptr (pointed, ptr_kind) -> - let pointed' = Normalizer.normalize pointed in - if phys_equal pointed pointed' then t else Tptr (pointed', ptr_kind) - | Tarray {elt; length; stride} -> - let elt' = Normalizer.normalize elt in - if phys_equal elt elt' then t else Tarray {elt= elt'; length; stride} -end) - -and Normalizer : (HashNormalizer.S with type t = t) = HashNormalizer.Make (struct - include T - - let normalize t = - let quals = TypeQualsNormalizer.normalize t.quals in - let desc = DescNormalizer.normalize t.desc in - if phys_equal desc t.desc && phys_equal quals t.quals then t else {desc; quals} -end) - -and TemplateArgNormalizer : (HashNormalizer.S with type t = template_arg) = -HashNormalizer.Make (struct - type t = template_arg [@@deriving equal, hash] - - let normalize t = - match t with - | TNull | TNullPtr | TOpaque | TInt _ -> - t - | TType typ -> - let typ' = Normalizer.normalize typ in - if phys_equal typ typ' then t else TType typ' -end) - -and TemplateSpecInfoNormalizer : (HashNormalizer.S with type t = template_spec_info) = -HashNormalizer.Make (struct - type t = template_spec_info [@@deriving equal, hash] - - let normalize t = - match t with - | NoTemplate -> - t - | Template {mangled; args} -> - let mangled' = - IOption.map_changed mangled ~equal:phys_equal ~f:HashNormalizer.String.hash_normalize - in - let args' = IList.map_changed args ~equal:phys_equal ~f:TemplateArgNormalizer.normalize in - if phys_equal mangled mangled' && phys_equal args args' then t - else Template {mangled= mangled'; args= args'} -end) - -and NameNormalizer : (HashNormalizer.S with type t = name) = HashNormalizer.Make (struct - type nonrec t = name [@@deriving equal, hash] - - let normalize t = - match t with - | HackClass _ -> - (* TODO *) - t - | PythonClass _ -> - (* TODO *) - t - | CStruct qualified_name -> - let qualified_name' = QualifiedCppName.Normalizer.normalize qualified_name in - if phys_equal qualified_name qualified_name' then t else CStruct qualified_name' - | CUnion qualified_name -> - let qualified_name' = QualifiedCppName.Normalizer.normalize qualified_name in - if phys_equal qualified_name qualified_name' then t else CUnion qualified_name' - | ObjcClass qualified_name -> - let qualified_name' = QualifiedCppName.Normalizer.normalize qualified_name in - if phys_equal qualified_name qualified_name' then t else ObjcClass qualified_name' - | ObjcProtocol qualified_name -> - let qualified_name' = QualifiedCppName.Normalizer.normalize qualified_name in - if phys_equal qualified_name qualified_name' then t else ObjcProtocol qualified_name' - | CppClass {name; template_spec_info; is_union} -> - let name' = QualifiedCppName.Normalizer.normalize name in - let template_spec_info' = TemplateSpecInfoNormalizer.normalize template_spec_info in - if phys_equal name name' && phys_equal template_spec_info template_spec_info' then t - else CppClass {name= name'; template_spec_info= template_spec_info'; is_union} - | ErlangType name -> - let name' = ErlangTypeName.Normalizer.normalize name in - if phys_equal name name' then t else ErlangType name' - | JavaClass java_class_name -> - let java_class_name' = JavaClassName.Normalizer.normalize java_class_name in - if phys_equal java_class_name java_class_name' then t else JavaClass java_class_name' - | CSharpClass cs_class_name -> - let cs_class_name' = CSharpClassName.Normalizer.normalize cs_class_name in - if phys_equal cs_class_name cs_class_name' then t else CSharpClass cs_class_name' -end) - module Name = struct type t = name [@@deriving compare, equal, yojson_of, sexp, hash] @@ -785,7 +680,15 @@ module Name = struct let hash = hash end) - module Normalizer = NameNormalizer + module Normalizer = struct + type t = name + + let normalize = hash_normalize_name + + let normalize_opt = hash_normalize_name_opt + + let normalize_list = hash_normalize_name_list + end end (** dump a type with all the details. *) @@ -1039,3 +942,14 @@ let rec is_java_type t = is_java_type elt | _ -> false + + +module Normalizer = struct + type nonrec t = t + + let normalize = hash_normalize + + let normalize_opt = hash_normalize_opt + + let normalize_list = hash_normalize_list +end diff --git a/infer/src/istd/HashNormalizer.ml b/infer/src/istd/HashNormalizer.ml index 4c652748c51..ab61ca2cebb 100644 --- a/infer/src/istd/HashNormalizer.ml +++ b/infer/src/istd/HashNormalizer.ml @@ -82,4 +82,16 @@ module String = struct let hash_normalize_list = StringListNormalizer.normalize end +module Int64 = struct + type t = int64 + + module T = Make (struct + type t = int64 [@@deriving equal, hash] + + let normalize : t -> t = Fn.id + end) + + let hash_normalize = T.normalize +end + let reset_all_normalizers () = List.iter !normalizer_reset_funs ~f:(fun f -> f ()) diff --git a/infer/src/istd/HashNormalizer.mli b/infer/src/istd/HashNormalizer.mli index 862d7df1865..84a3685e615 100644 --- a/infer/src/istd/HashNormalizer.mli +++ b/infer/src/istd/HashNormalizer.mli @@ -40,6 +40,12 @@ module String : sig val hash_normalize_list : t list -> t list end +module Int64 : sig + type t = int64 + + val hash_normalize : t -> t +end + val reset_all_normalizers : unit -> unit (** reset hashtables in all normalizers made with [Make] *)