[IR] Put the procnames for c functions and blocks in designated modules

Reviewed By: mbouaziz

Differential Revision: D8331890

fbshipit-source-id: 87d9dde

infer/src/IR/ProcnameDispatcher.ml

@@ -21,7 +21,7 @@ and non_empty
 
 type typ = Typ.t
 
-type c = Typ.Procname.c
+type c = Typ.Procname.C.t
 
 type objc_cpp = Typ.Procname.ObjC_Cpp.t
 

infer/src/IR/Pvar.ml

@@ -261,7 +261,7 @@ let get_initializer_pname {pv_name; pv_kind} =
         | Some file ->
             let mangled = SourceFile.to_string file |> Utils.string_crc_hex32 in
             Typ.Procname.C
-              (Typ.Procname.c (QualifiedCppName.of_qual_string name) mangled [] Typ.NoTemplate)
+              (Typ.Procname.C.c (QualifiedCppName.of_qual_string name) mangled [] Typ.NoTemplate)
             |> Option.return
         | None ->
             None

infer/src/IR/Typ.ml

@@ -841,67 +841,76 @@ being the name of the struct, [None] means the parameter is of some other type.
           ^ Parameter.parameters_to_string osig.parameters ^ m_str
   end
 
-  (** Type of c procedure names. *)
-  type c =
-    { name: QualifiedCppName.t
-    ; mangled: string option
-    ; parameters: Parameter.t list
-    ; template_args: template_spec_info }
-  [@@deriving compare]
+  module C = struct
+    (** Type of c procedure names. *)
+    type t =
+      { name: QualifiedCppName.t
+      ; mangled: string option
+      ; parameters: Parameter.t list
+      ; template_args: template_spec_info }
+    [@@deriving compare]
 
-  (** Type of Objective C block names. *)
-  type block_name = string [@@deriving compare]
+    let c name mangled parameters template_args =
+      {name; mangled= Some mangled; parameters; template_args}
+
+
+    let from_string name =
+      { name= QualifiedCppName.of_qual_string name
+      ; mangled= None
+      ; parameters= []
+      ; template_args= NoTemplate }
+
+
+    (** to_string for C_function type *)
+    let to_string {name; mangled; parameters} verbose =
+      let plain = QualifiedCppName.to_qual_string name in
+      match verbose with
+      | Simple ->
+          plain ^ "()"
+      | Non_verbose ->
+          plain
+      | Verbose ->
+        match mangled with
+        | None ->
+            plain ^ Parameter.parameters_to_string parameters
+        | Some s ->
+            plain ^ Parameter.parameters_to_string parameters ^ "{" ^ s ^ "}"
+  end
+
+  module Block = struct
+    (** Type of Objective C block names. *)
+    type block_name = string [@@deriving compare]
+
+    type t = {name: block_name; parameters: Parameter.t list} [@@deriving compare]
+
+    let make name parameters = {name; parameters}
+
+    let to_string bsig detail_level =
+      match detail_level with
+      | Simple ->
+          "block"
+      | Non_verbose ->
+          bsig.name
+      | Verbose ->
+          bsig.name ^ Parameter.parameters_to_string bsig.parameters
+  end
 
   (** Type of procedure names. *)
   type t =
     | Java of Java.t
-    | C of c
+    | C of C.t
     | Linters_dummy_method
-    | Block of block_name * Parameter.t list
+    | Block of Block.t
     | ObjC_Cpp of ObjC_Cpp.t
-    | WithBlockParameters of t * block_name list
+    | WithBlockParameters of t * Block.block_name list
   [@@deriving compare]
 
   let equal = [%compare.equal : t]
 
   let hash = Hashtbl.hash
 
-  let block_name_of_procname procname =
-    match procname with
-    | Block (block_name, _) ->
-        block_name
-    | _ ->
-        Logging.die InternalError "Only to be called with Objective-C block names"
-
-
-  let empty_block = Block ("", [])
-
-  let c name mangled parameters template_args =
-    {name; mangled= Some mangled; parameters; template_args}
-
-
-  let from_string_c_fun (name: string) =
-    C
-      { name= QualifiedCppName.of_qual_string name
-      ; mangled= None
-      ; parameters= []
-      ; template_args= NoTemplate }
-
-
   let with_block_parameters base blocks = WithBlockParameters (base, blocks)
 
-  let mangled_objc_block name parameters = Block (name, parameters)
-
-  let objc_block_to_string (name, parameters) detail_level =
-    match detail_level with
-    | Simple ->
-        "block"
-    | Non_verbose ->
-        name
-    | Verbose ->
-        name ^ Parameter.parameters_to_string parameters
-
-
   let is_java = function Java _ -> true | _ -> false
 
   (* TODO: deprecate this unfortunately named function and use is_clang instead *)
@@ -916,6 +925,16 @@ being the name of the struct, [None] means the parameter is of some other type.
         is_c_function name
 
 
+  let block_name_of_procname procname =
+    match procname with
+    | Block block ->
+        block.name
+    | _ ->
+        Logging.die InternalError "Only to be called with Objective-C block names"
+
+
+  let empty_block = Block {name= ""; parameters= []}
+
   (** Replace the class name component of a procedure name.
       In case of Java, replace package and class name. *)
   let rec replace_class t (new_class: Name.t) =
@@ -952,7 +971,7 @@ being the name of the struct, [None] means the parameter is of some other type.
         get_method base
     | C {name} ->
         QualifiedCppName.to_qual_string name
-    | Block (name, _) ->
+    | Block {name} ->
         name
     | Java j ->
         j.method_name
@@ -1013,22 +1032,6 @@ being the name of the struct, [None] means the parameter is of some other type.
         None
 
 
-  (** to_string for C_function type *)
-  let c_function_to_string {name; mangled; parameters} verbose =
-    let plain = QualifiedCppName.to_qual_string name in
-    match verbose with
-    | Simple ->
-        plain ^ "()"
-    | Non_verbose ->
-        plain
-    | Verbose ->
-      match mangled with
-      | None ->
-          plain ^ Parameter.parameters_to_string parameters
-      | Some s ->
-          plain ^ Parameter.parameters_to_string parameters ^ "{" ^ s ^ "}"
-
-
   let with_blocks_parameters_to_string base blocks to_string_f =
     let base_id = to_string_f base in
     String.concat ~sep:"_" (base_id :: blocks)
@@ -1040,11 +1043,11 @@ being the name of the struct, [None] means the parameter is of some other type.
     | Java j ->
         Java.to_string j Verbose
     | C osig ->
-        c_function_to_string osig Verbose
+        C.to_string osig Verbose
     | ObjC_Cpp osig ->
         ObjC_Cpp.to_string osig Verbose
-    | Block (name, parameters) ->
-        objc_block_to_string (name, parameters) Verbose
+    | Block bsig ->
+        Block.to_string bsig Verbose
     | WithBlockParameters (base, blocks) ->
         with_blocks_parameters_to_string base blocks to_unique_id
     | Linters_dummy_method ->
@@ -1057,11 +1060,11 @@ being the name of the struct, [None] means the parameter is of some other type.
     | Java j ->
         Java.to_string j Non_verbose
     | C osig ->
-        c_function_to_string osig Non_verbose
+        C.to_string osig Non_verbose
     | ObjC_Cpp osig ->
         ObjC_Cpp.to_string osig Non_verbose
-    | Block (name, parameters) ->
-        objc_block_to_string (name, parameters) Non_verbose
+    | Block bsig ->
+        Block.to_string bsig Non_verbose
     | WithBlockParameters (base, blocks) ->
         with_blocks_parameters_to_string base blocks to_string
     | Linters_dummy_method ->
@@ -1074,17 +1077,19 @@ being the name of the struct, [None] means the parameter is of some other type.
     | Java j ->
         Java.to_string ~withclass j Simple
     | C osig ->
-        c_function_to_string osig Simple
+        C.to_string osig Simple
     | ObjC_Cpp osig ->
         ObjC_Cpp.to_string osig Simple
-    | Block (name, parameters) ->
-        objc_block_to_string (name, parameters) Simple
+    | Block bsig ->
+        Block.to_string bsig Simple
     | WithBlockParameters (base, _) ->
         to_simplified_string base
     | Linters_dummy_method ->
         to_unique_id p
 
 
+  let from_string_c_fun func = C (C.from_string func)
+
   let hashable_name p =
     match p with
     | Java pname ->

infer/src/IR/Typ.mli

@@ -425,15 +425,26 @@ module Procname : sig
     (** Return true if the procname is operator= *)
   end
 
-  (** Type of c procedure names. *)
-  type c = private
-    { name: QualifiedCppName.t
-    ; mangled: string option
-    ; parameters: Parameter.t list
-    ; template_args: template_spec_info }
+  module C : sig
+    (** Type of c procedure names. *)
+    type t = private
+      { name: QualifiedCppName.t
+      ; mangled: string option
+      ; parameters: Parameter.t list
+      ; template_args: template_spec_info }
+
+    val c : QualifiedCppName.t -> string -> Parameter.t list -> template_spec_info -> t
+    (** Create a C procedure name from plain and mangled name. *)
+  end
+
+  module Block : sig
+    (** Type of Objective C block names. *)
+    type block_name = string
+
+    type t = {name: block_name; parameters: Parameter.t list} [@@deriving compare]
 
-  (** Type of Objective C block names. *)
-  type block_name
+    val make : block_name -> Parameter.t list -> t
+  end
 
   (** Type of procedure names.
   WithBlockParameters is used for creating an instantiation of a method that contains block parameters
@@ -443,14 +454,14 @@ module Procname : sig
   where foo_my_block is created with WithBlockParameters (foo, [my_block]) *)
   type t =
     | Java of Java.t
-    | C of c
+    | C of C.t
     | Linters_dummy_method
-    | Block of block_name * Parameter.t list
+    | Block of Block.t
     | ObjC_Cpp of ObjC_Cpp.t
-    | WithBlockParameters of t * block_name list
+    | WithBlockParameters of t * Block.block_name list
   [@@deriving compare]
 
-  val block_name_of_procname : t -> block_name
+  val block_name_of_procname : t -> Block.block_name
 
   val equal : t -> t -> bool
 
@@ -473,15 +484,9 @@ module Procname : sig
 
   module SQLiteList : SqliteUtils.Data with type t = t list
 
-  val c : QualifiedCppName.t -> string -> Parameter.t list -> template_spec_info -> c
-  (** Create a C procedure name from plain and mangled name. *)
-
   val empty_block : t
   (** Empty block name. *)
 
-  val from_string_c_fun : string -> t
-  (** Convert a string to a proc name. *)
-
   val get_language : t -> Language.t
   (** Return the language of the procedure. *)
 
@@ -506,10 +511,7 @@ module Procname : sig
   val is_java : t -> bool
   (** Check if this is a Java procedure name. *)
 
-  val mangled_objc_block : string -> Parameter.t list -> t
-  (** Create an objc block name. *)
-
-  val with_block_parameters : t -> block_name list -> t
+  val with_block_parameters : t -> Block.block_name list -> t
   (** Create a procedure name instantiated with block parameters from a base procedure name
     and a list of block procedure names (the arguments). *)
 
@@ -537,6 +539,9 @@ module Procname : sig
   val to_simplified_string : ?withclass:bool -> t -> string
   (** Convert a proc name into a easy string for the user to see in an IDE. *)
 
+  val from_string_c_fun : string -> t
+  (** Convert a string to a c function name. *)
+
   val hashable_name : t -> string
   (** Print the procedure name in a format suitable for computing the bug hash *)
 

infer/src/clang/CType_decl.ml

@@ -547,7 +547,7 @@ and mk_c_function ?tenv name function_decl_info_opt parameters =
   let mangled = file ^ mangled_name in
   if String.is_empty mangled then
     Typ.Procname.from_string_c_fun (QualifiedCppName.to_qual_string name)
-  else Typ.Procname.C (Typ.Procname.c name mangled parameters template_info)
+  else Typ.Procname.C (Typ.Procname.C.c name mangled parameters template_info)
 
 
 and mk_cpp_method ?tenv class_name method_name ?meth_decl mangled parameters =
@@ -600,7 +600,7 @@ and objc_block_procname outer_proc_opt parameters =
       Config.anonymous_block_num_sep i
   in
   let name = block_procname_with_index (CFrontend_config.get_fresh_block_index ()) in
-  Typ.Procname.mangled_objc_block name parameters
+  Typ.Procname.Block (Typ.Procname.Block.make name parameters)
 
 
 and procname_from_decl ?tenv ?block_return_type ?outer_proc meth_decl =