[ppx] convert Typ to ppx normalization

Summary: Replace hand-written hash normalizers in Typ.ml with ppx.

Reviewed By: jvillard

Differential Revision:
D49730891

Privacy Context Container: L1122176

fbshipit-source-id: e06519fe2b616de97e0cb53071064f1321b2f7a9

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

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

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

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

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}
 

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
 

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)
 

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
 

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

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

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}
 

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
 

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

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 ())