[erl-frontend] Create (empty) Procdesc for Erlang functions.

Summary:
Each Erlang function now has a Procdesc in `results.db`. The
ProcAttributes record if a function is exported or not by using the
access Public or Private, respectively.

This adds also `ErlangTypeName`. We use a fixed set of "type names" for
the different types of values in Erlang (i.e., for Erlang's "dynamic types").

Reviewed By: jvillard

Differential Revision: D28385954

fbshipit-source-id: f8278505a

infer/src/IR/ErlangTypeName.ml

@@ -0,0 +1,15 @@
+(*
+ * Copyright (c) Facebook, Inc. and its affiliates.
+ *
+ * This source code is licensed under the MIT license found in the
+ * LICENSE file in the root directory of this source tree.
+ *)
+
+open! IStd
+
+(* TODO: Add other types as they are needed by translation (otherwise it's dead code). *)
+type t = Any [@@deriving compare, yojson_of]
+
+let pp f = function Any -> Format.fprintf f "ErlangAny"
+
+let to_string name = Format.asprintf "%a" pp name

infer/src/IR/Procname.ml

@@ -1023,14 +1023,16 @@ let describe f pn =
       F.pp_print_string f name
 
 
-let make_java ~class_name ~return_type ~method_name ~parameters ~kind () =
+let make_java ~class_name ~return_type ~method_name ~parameters ~kind =
   Java (Java.make ~class_name ~return_type ~method_name ~parameters ~kind ())
 
 
-let make_csharp ~class_name ~return_type ~method_name ~parameters ~kind () =
+let make_csharp ~class_name ~return_type ~method_name ~parameters ~kind =
   CSharp (CSharp.make ~class_name ~return_type ~method_name ~parameters ~kind ())
 
 
+let make_erlang ~module_name ~function_name ~arity = Erlang {module_name; function_name; arity}
+
 let make_objc_dealloc name = ObjC_Cpp (ObjC_Cpp.make_dealloc name)
 
 let make_objc_copyWithZone ~is_mutable name = ObjC_Cpp (ObjC_Cpp.make_copyWithZone ~is_mutable name)

infer/src/IR/Procname.mli

@@ -294,7 +294,6 @@ val make_java :
   -> method_name:string
   -> parameters:Typ.t list
   -> kind:Java.kind
-  -> unit
   -> t
 (** Create a Java procedure name. *)
 
@@ -304,10 +303,12 @@ val make_csharp :
   -> method_name:string
   -> parameters:Typ.t list
   -> kind:CSharp.kind
-  -> unit
   -> t
 (** Create a CSharp procedure name. *)
 
+val make_erlang : module_name:string -> function_name:string -> arity:int -> t
+(** Create an Erlang procedure name. *)
+
 val make_objc_dealloc : Typ.Name.t -> t
 (** Create a Objective-C dealloc name. This is a destructor for an Objective-C class. This procname
     is given by the class name, since it is always an instance method with the name "dealloc" *)

infer/src/IR/Struct.ml

@@ -276,7 +276,7 @@ let full_merge ~newer ~current =
 
 let merge typename ~newer ~current =
   match (typename : Typ.Name.t) with
-  | CStruct _ | CUnion _ | ObjcClass _ | ObjcProtocol _ | CppClass _ ->
+  | CStruct _ | CUnion _ | ErlangType _ | ObjcClass _ | ObjcProtocol _ | CppClass _ ->
       if not (is_dummy newer) then newer else current
   | JavaClass _ when is_dummy newer ->
       current

infer/src/IR/Tenv.ml

@@ -236,6 +236,8 @@ let resolve_method ~method_exists tenv class_name proc_name =
       else
         let supers_to_search =
           match (class_name : Typ.Name.t) with
+          | ErlangType _ ->
+              L.die InternalError "attempting to call a method on an Erlang value"
           | CStruct _ | CUnion _ | CppClass _ ->
               (* multiple inheritance possible, search all supers *)
               class_struct.supers

infer/src/IR/Typ.ml

@@ -187,6 +187,7 @@ module T = struct
         ; template_spec_info: template_spec_info
         ; is_union: bool [@compare.ignore] }
     | CSharpClass of CSharpClassName.t
+    | ErlangType of ErlangTypeName.t
     | JavaClass of JavaClassName.t
     | ObjcClass of QualifiedCppName.t * name list
     | ObjcProtocol of QualifiedCppName.t
@@ -312,6 +313,8 @@ and pp_name_c_syntax pe f = function
       F.fprintf f "%a%a" QualifiedCppName.pp name (pp_protocols pe) protocol_names
   | CppClass {name; template_spec_info} ->
       F.fprintf f "%a%a" QualifiedCppName.pp name (pp_template_spec_info pe) template_spec_info
+  | ErlangType name ->
+      ErlangTypeName.pp f name
   | JavaClass name ->
       JavaClassName.pp f name
   | CSharpClass name ->
@@ -390,6 +393,12 @@ module Name = struct
         -1
     | _, CSharpClass _ ->
         1
+    | ErlangType name1, ErlangType name2 ->
+        ErlangTypeName.compare name1 name2
+    | ErlangType _, _ ->
+        -1
+    | _, ErlangType _ ->
+        1
     | JavaClass name1, JavaClass name2 ->
         String.compare (JavaClassName.classname name1) (JavaClassName.classname name2)
     | JavaClass _, _ ->
@@ -418,7 +427,7 @@ module Name = struct
     | CppClass {name; template_spec_info} ->
         let template_suffix = F.asprintf "%a" (pp_template_spec_info Pp.text) template_spec_info in
         QualifiedCppName.append_template_args_to_last name ~args:template_suffix
-    | JavaClass _ | CSharpClass _ ->
+    | JavaClass _ | CSharpClass _ | ErlangType _ ->
         QualifiedCppName.empty
 
 
@@ -427,7 +436,7 @@ module Name = struct
         name
     | CppClass {name} ->
         name
-    | JavaClass _ | CSharpClass _ ->
+    | JavaClass _ | CSharpClass _ | ErlangType _ ->
         QualifiedCppName.empty
 
 
@@ -446,6 +455,8 @@ module Name = struct
         JavaClassName.to_string name
     | CSharpClass name ->
         CSharpClassName.to_string name
+    | ErlangType name ->
+        ErlangTypeName.to_string name
 
 
   let pp fmt tname =
@@ -456,6 +467,8 @@ module Name = struct
           "union"
       | CppClass _ | CSharpClass _ | JavaClass _ | ObjcClass _ ->
           "class"
+      | ErlangType _ ->
+          "erlang"
       | ObjcProtocol _ ->
           "protocol"
     in
@@ -594,7 +607,7 @@ module Name = struct
 
     let normalize t =
       match t with
-      | CStruct _ | CUnion _ | CppClass _ | ObjcClass _ | ObjcProtocol _ ->
+      | CStruct _ | CUnion _ | CppClass _ | ErlangType _ | ObjcClass _ | ObjcProtocol _ ->
           t
       | JavaClass java_class_name ->
           let java_class_name' = JavaClassName.Normalizer.normalize java_class_name in

infer/src/IR/Typ.mli

@@ -107,6 +107,7 @@ and name =
           "MyClass<int>", "InnerClass" *)
   | CppClass of {name: QualifiedCppName.t; template_spec_info: template_spec_info; is_union: bool}
   | CSharpClass of CSharpClassName.t
+  | ErlangType of ErlangTypeName.t
   | JavaClass of JavaClassName.t
   | ObjcClass of QualifiedCppName.t * name list
       (** ObjC class that conforms to a list of protocols, e.g. id<NSFastEnumeration, NSCopying> *)

infer/src/absint/ConcurrencyModels.ml

@@ -312,7 +312,13 @@ let is_android_lifecycle_method tenv pname =
     Procname.get_class_type_name procname
     |> Option.exists ~f:(fun typename ->
            match (typename : Typ.Name.t) with
-           | CUnion _ | CStruct _ | CppClass _ | CSharpClass _ | ObjcClass _ | ObjcProtocol _ ->
+           | CUnion _
+           | CStruct _
+           | CppClass _
+           | CSharpClass _
+           | ErlangType _
+           | ObjcClass _
+           | ObjcProtocol _ ->
                false
            | JavaClass java_class_name ->
                JavaClassName.package java_class_name

infer/src/absint/ProcnameDispatcher.ml

@@ -54,6 +54,8 @@ let templated_name_of_class_name class_name =
       (QualifiedCppName.of_list [JavaClassName.to_string mangled_name], [])
   | CSharpClass mangled_name ->
       (QualifiedCppName.of_list [CSharpClassName.to_string mangled_name], [])
+  | ErlangType mangled_name ->
+      (QualifiedCppName.of_list [ErlangTypeName.to_string mangled_name], [])
 
 
 let templated_name_of_java java =

infer/src/backend/InferAnalyzeJson.ml

@@ -78,11 +78,8 @@ let parse_cil_procname (json : Safe.t) : Procname.t =
       let params = List.map ~f:parse_cil_type_name param_types in
       let is_static = to_bool (member "is_static" json) in
       let method_kind = if is_static then Procname.CSharp.Static else Procname.CSharp.Non_Static in
-      let proc_name_cs =
-        Procname.(
-          make_csharp ~class_name ~return_type ~method_name ~parameters:params ~kind:method_kind)
-      in
-      proc_name_cs ()
+      Procname.make_csharp ~class_name ~return_type ~method_name ~parameters:params
+        ~kind:method_kind
 
 
 let parse_ikind (json : Safe.t) =

infer/src/biabduction/SymExec.ml

@@ -636,7 +636,7 @@ let call_constructor_url_update_args =
       ~class_name:(Typ.Name.Java.from_string "java.net.URL")
       ~return_type:None ~method_name:Procname.Java.constructor_method_name
       ~parameters:[StdTyp.Java.pointer_to_java_lang_string]
-      ~kind:Procname.Java.Non_Static ()
+      ~kind:Procname.Java.Non_Static
   in
   fun pname actual_params ->
     if Procname.equal url_pname pname then

infer/src/bufferoverrun/bufferOverrunModels.ml

@@ -1247,7 +1247,7 @@ module JavaClass = struct
             Procname.make_java
               ~class_name:(Typ.Name.Java.from_string class_name_str)
               ~return_type:(Some Typ.(mk_ptr (mk_array (mk_ptr (mk_struct class_name)))))
-              ~method_name:"values" ~parameters:[] ~kind:Procname.Java.Static ()
+              ~method_name:"values" ~parameters:[] ~kind:Procname.Java.Static
           in
           match get_summary enum_values_pname with
           | Some enum_values_mem ->

infer/src/concurrency/RacerDFileAnalysis.ml

@@ -614,7 +614,7 @@ let class_has_concurrent_method class_summaries =
 
 let should_report_on_class (classname : Typ.Name.t) class_summaries =
   match classname with
-  | JavaClass _ | CSharpClass _ ->
+  | JavaClass _ | CSharpClass _ | ErlangType _ ->
       true
   | CppClass _ | ObjcClass _ | ObjcProtocol _ | CStruct _ ->
       class_has_concurrent_method class_summaries

infer/src/cost/costDomain.ml

@@ -13,7 +13,7 @@ module BasicCost = struct
 
   (* NOTE: Increment the version number if you changed the [t] type.  This is for avoiding
      demarshalling failure of cost analysis results in running infer-reportdiff. *)
-  let version = 11
+  let version = 12
 end
 
 module BasicCostWithReason = struct

infer/src/erlang/ErlangTranslator.ml

@@ -9,6 +9,12 @@ open! IStd
 module Ast = ErlangAst
 module L = Logging
 
+let mangled_arg (n : int) : Mangled.t = Mangled.from_string (Printf.sprintf "$arg%d" n)
+
+let typ_of_name (name : ErlangTypeName.t) : Typ.t =
+  Typ.mk (Tptr (Typ.mk (Tstruct (ErlangType name)), Pk_pointer))
+
+
 module UnqualifiedFunction = struct
   module T = struct
     type t = {name: string; arity: int} [@@deriving sexp, compare]
@@ -16,6 +22,13 @@ module UnqualifiedFunction = struct
 
   include T
   include Comparable.Make (T)
+
+  let of_ast (f : Ast.function_) : t =
+    match f with
+    | {module_= ModuleMissing; function_= FunctionName name; arity} ->
+        {name; arity}
+    | _ ->
+        L.die InternalError "expected unqualified function"
 end
 
 type module_name = string [@@deriving sexp_of]
@@ -29,13 +42,6 @@ type names_env =
 [@@deriving sexp_of]
 
 let get_environment module_ : names_env =
-  let unqualified (f : Ast.function_) : UnqualifiedFunction.t =
-    match f with
-    | {module_= ModuleMissing; function_= FunctionName name; arity} ->
-        {name; arity}
-    | _ ->
-        L.die InternalError "expected unqualified function"
-  in
   let init =
     { exports= UnqualifiedFunction.Set.empty
     ; imports= UnqualifiedFunction.Map.empty (* TODO: auto-import from module "erlang" *)
@@ -44,12 +50,12 @@ let get_environment module_ : names_env =
   let f env (form : Ast.form) =
     match form.simple_form with
     | Export functions ->
-        let f exports function_ = Set.add exports (unqualified function_) in
+        let f exports function_ = Set.add exports (UnqualifiedFunction.of_ast function_) in
         let exports = List.fold ~init:env.exports ~f functions in
         {env with exports}
     | Import {module_name; functions} ->
         let f imports function_ =
-          let key = unqualified function_ in
+          let key = UnqualifiedFunction.of_ast function_ in
           match Map.add ~key ~data:module_name imports with
           | `Ok imports ->
               imports
@@ -66,7 +72,42 @@ let get_environment module_ : names_env =
   List.fold ~init ~f module_
 
 
-let translate_functions _names_env _cfg _module = (* TODO *) ()
+let translate_one_function source names_env cfg line function_ clauses =
+  let uf_name = UnqualifiedFunction.of_ast function_ in
+  let {UnqualifiedFunction.name= function_name; arity} = uf_name in
+  let name =
+    let module_name = names_env.current_module in
+    Procname.make_erlang ~module_name ~function_name ~arity
+  in
+  let attributes =
+    let default = ProcAttributes.default source name in
+    let access : ProcAttributes.access =
+      if Set.mem names_env.exports uf_name then Public else Private
+    in
+    let formals = List.init ~f:(fun i -> (mangled_arg i, typ_of_name Any)) arity in
+    let loc = {Location.line; col= -1; file= source} in
+    let ret_type = typ_of_name Any in
+    {default with access; formals; loc; ret_type}
+  in
+  let _proc = Cfg.create_proc_desc cfg attributes in
+  (* TODO: add nodes to proc *)
+  if List.is_empty clauses then
+    L.die InternalError "%s:%a has no clauses" names_env.current_module Procname.pp name
+
+
+let translate_functions source names_env cfg module_ =
+  let f (form : Ast.form) =
+    match form.simple_form with
+    | Function {function_; clauses} ->
+        translate_one_function source names_env cfg form.line function_ clauses
+    | _ ->
+        ()
+  in
+  List.iter module_ ~f ;
+  DB.Results_dir.init source ;
+  Cfg.store source cfg ;
+  SourceFiles.add source cfg Tenv.Global None
+
 
 let to_source_and_cfg module_ =
   let source =
@@ -85,7 +126,7 @@ let to_source_and_cfg module_ =
   let cfg =
     let cfg = Cfg.create () in
     let names_env = get_environment module_ in
-    translate_functions names_env cfg module_ ;
+    translate_functions source names_env cfg module_ ;
     cfg
   in
   (source, cfg)

infer/src/java/jTransType.ml

@@ -209,7 +209,7 @@ let rec get_method_procname program tenv cn ms kind =
   let (_ : Struct.t) = get_class_struct_typ program tenv cn in
   let return_type, method_name, parameters = method_signature_names ms in
   let class_name = Typ.Name.Java.from_string (JBasics.cn_name cn) in
-  Procname.make_java ~class_name ~return_type ~method_name ~parameters ~kind ()
+  Procname.make_java ~class_name ~return_type ~method_name ~parameters ~kind
 
 
 (* create a mangled procname from an abstract or concrete method *)

infer/src/test_determinator/JProcname.ml

@@ -265,4 +265,4 @@ let create_procname ~classname ~methodname:method_name ~signature ~use_signature
     else Some (JNI.to_typ return_type)
   in
   Procname.make_java ~class_name ~return_type ~method_name ~parameters
-    ~kind:Procname.Java.Non_Static ()
+    ~kind:Procname.Java.Non_Static

infer/src/unit/JavaProfilerSamplesTest.ml

@@ -154,7 +154,7 @@ let test_from_json_string_with_valid_input =
                   [ StdTyp.Java.pointer_to_java_lang_string
                   ; Typ.(mk_ptr (mk_array StdTyp.int))
                   ; StdTyp.long ]
-                ~kind:Java.Non_Static ())
+                ~kind:Java.Non_Static)
           ; Procname.(
               make_java
                 ~class_name:(Typ.Name.Java.from_string "ggg.hhh.Iii")
@@ -163,7 +163,7 @@ let test_from_json_string_with_valid_input =
                   [ StdTyp.Java.pointer_to_java_lang_string
                   ; Typ.(mk_ptr (mk_array StdTyp.int))
                   ; StdTyp.long ]
-                ~kind:Java.Non_Static ()) ] )
+                ~kind:Java.Non_Static) ] )
     ; ( "label2"
       , Procname.Set.of_list
           [ Procname.(
@@ -175,12 +175,12 @@ let test_from_json_string_with_valid_input =
                   [ StdTyp.Java.pointer_to_java_lang_string
                   ; Typ.(mk_ptr (mk_array StdTyp.int))
                   ; StdTyp.long ]
-                ~kind:Java.Non_Static ())
+                ~kind:Java.Non_Static)
           ; Procname.(
               make_java
                 ~class_name:(Typ.Name.Java.from_string "aaa.bbb.Ccc")
                 ~return_type:(Some StdTyp.void) ~method_name:"methodOne" ~parameters:[]
-                ~kind:Java.Non_Static ()) ] ) ]
+                ~kind:Java.Non_Static) ] ) ]
   in
   let expected3 =
     [ ( "label1"
@@ -189,24 +189,24 @@ let test_from_json_string_with_valid_input =
               make_java
                 ~class_name:(Typ.Name.Java.from_string "lll.mmm.Nnn")
                 ~return_type:None ~method_name:Java.constructor_method_name ~parameters:[]
-                ~kind:Java.Non_Static ())
+                ~kind:Java.Non_Static)
           ; Procname.(
               make_java
                 ~class_name:(Typ.Name.Java.from_string "ggg.hhh.Iii")
                 ~return_type:None ~method_name:Java.class_initializer_method_name ~parameters:[]
-                ~kind:Java.Non_Static ()) ] )
+                ~kind:Java.Non_Static) ] )
     ; ( "label2"
       , Procname.Set.of_list
           [ Procname.(
               make_java
                 ~class_name:(Typ.Name.Java.from_string "ddd.eee.Fff")
                 ~return_type:(Some StdTyp.void) ~method_name:"methodTwo" ~parameters:[]
-                ~kind:Java.Non_Static ())
+                ~kind:Java.Non_Static)
           ; Procname.(
               make_java
                 ~class_name:(Typ.Name.Java.from_string "aaa.bbb.Ccc")
                 ~return_type:(Some StdTyp.void) ~method_name:"methodOne" ~parameters:[]
-                ~kind:Java.Non_Static ()) ] ) ]
+                ~kind:Java.Non_Static) ] ) ]
   in
   [ ("test_from_json_string_1", input1, expected1, true)
   ; ("test_from_json_string_2", input2, expected2, true)