[base] move `Config.language` to its own `Language` module

Summary:
I needed to do this for something, now I don't know if I want to do the thing
anymore but this seems generally useful to decrease a little bit the size of
Config.ml.

Reviewed By: sblackshear, mbouaziz

Differential Revision: D6796427

fbshipit-source-id: d9c009d

infer/src/IR/Annot.ml

@@ -26,7 +26,7 @@ let volatile = {class_name= "volatile"; parameters= []}
 let final = {class_name= "final"; parameters= []}
 
 (** Pretty print an annotation. *)
-let prefix = match Config.curr_language_is Config.Java with true -> "@" | false -> "_"
+let prefix = match Language.curr_language_is Java with true -> "@" | false -> "_"
 
 let pp fmt annotation = F.fprintf fmt "%s%s" prefix annotation.class_name
 

infer/src/IR/DecompiledExp.ml

@@ -34,9 +34,7 @@ type t =
     each expression represents a path, with Dpvar being the simplest one *)
 type vpath = t option
 
-let java () = Config.equal_language !Config.curr_language Config.Java
-
-let eradicate_java () = Config.eradicate && java ()
+let eradicate_java () = Config.eradicate && Language.curr_language_is Java
 
 (** convert a dexp to a string *)
 let rec to_string = function
@@ -87,13 +85,13 @@ let rec to_string = function
       (* this->fieldname *)
       Typ.Fieldname.to_simplified_string f
   | Darrow (de, f) ->
-      if java () then to_string de ^ "." ^ Typ.Fieldname.to_flat_string f
+      if Language.curr_language_is Java then to_string de ^ "." ^ Typ.Fieldname.to_flat_string f
       else to_string de ^ "->" ^ Typ.Fieldname.to_string f
   | Ddot (Dpvar _, fe) when eradicate_java () ->
       (* static field access *)
       Typ.Fieldname.to_simplified_string fe
   | Ddot (de, f) ->
-      if java () then to_string de ^ "." ^ Typ.Fieldname.to_flat_string f
+      if Language.curr_language_is Java then to_string de ^ "." ^ Typ.Fieldname.to_flat_string f
       else to_string de ^ "." ^ Typ.Fieldname.to_string f
   | Dpvar pv ->
       Mangled.to_string (Pvar.get_name pv)

infer/src/IR/Errlog.ml

@@ -240,8 +240,7 @@ let log_issue err_kind err_log loc (node_id, node_key) session ltr ?linters_def_
   let err_kind = match error.kind with Some err_kind -> err_kind | _ -> err_kind in
   let hide_java_loc_zero =
     (* hide java errors at location zero unless in -developer_mode *)
-    not Config.developer_mode && Config.curr_language_is Config.Java
-    && Int.equal loc.Location.line 0
+    not Config.developer_mode && Language.curr_language_is Java && Int.equal loc.Location.line 0
   in
   let hide_memory_error =
     match Localise.error_desc_get_bucket error.description with

infer/src/IR/Localise.ml

@@ -243,7 +243,7 @@ let add_by_call_to_opt problem_str tags proc_name_opt =
 
 let rec format_typ typ =
   match typ.Typ.desc with
-  | Typ.Tptr (t, _) when Config.curr_language_is Config.Java ->
+  | Typ.Tptr (t, _) when Language.curr_language_is Java ->
       format_typ t
   | Typ.Tstruct name ->
       Typ.Name.name name
@@ -252,7 +252,7 @@ let rec format_typ typ =
 
 
 let format_field f =
-  if Config.curr_language_is Config.Java then Typ.Fieldname.Java.get_field f
+  if Language.curr_language_is Java then Typ.Fieldname.Java.get_field f
   else Typ.Fieldname.to_string f
 
 
@@ -279,7 +279,7 @@ type deref_str =
   ; value_post: string option  (** string printed after the value being dereferenced *)
   ; problem_str: string  (** description of the problem *) }
 
-let pointer_or_object () = if Config.curr_language_is Config.Java then "object" else "pointer"
+let pointer_or_object () = if Language.curr_language_is Java then "object" else "pointer"
 
 let deref_str_null_ proc_name_opt problem_str_ tags =
   let problem_str = add_by_call_to_opt problem_str_ tags proc_name_opt in

infer/src/IR/Tenv.ml

@@ -130,6 +130,6 @@ let language_is tenv lang =
   | () ->
       false
   | exception Found JavaClass _ ->
-      Config.equal_language lang Java
+      Language.equal lang Java
   | exception Found _ ->
-      Config.equal_language lang Clang
+      Language.equal lang Clang

infer/src/IR/Tenv.mli

@@ -46,5 +46,5 @@ val sort_fields_tenv : t -> unit
 val pp : Format.formatter -> t -> unit  [@@warning "-32"]
 (** print a type environment *)
 
-val language_is : t -> Config.language -> bool
+val language_is : t -> Language.t -> bool
 (** Test the language from which the types in the tenv were translated *)

infer/src/IR/Typ.ml

@@ -835,17 +835,17 @@ module Procname = struct
   (** Return the language of the procedure. *)
   let get_language = function
     | ObjC_Cpp _ ->
-        Config.Clang
+        Language.Clang
     | C _ ->
-        Config.Clang
+        Language.Clang
     | Block _ ->
-        Config.Clang
+        Language.Clang
     | Linters_dummy_method ->
-        Config.Clang
+        Language.Clang
     | WithBlockParameters _ ->
-        Config.Clang
+        Language.Clang
     | Java _ ->
-        Config.Java
+        Language.Java
 
 
   let is_objc_constructor method_name =

infer/src/IR/Typ.mli

@@ -407,7 +407,7 @@ module Procname : sig
   val from_string_c_fun : string -> t
   (** Convert a string to a proc name. *)
 
-  val get_language : t -> Config.language
+  val get_language : t -> Language.t
   (** Return the language of the procedure. *)
 
   val get_method : t -> string

infer/src/backend/BuiltinDefn.ml

@@ -38,7 +38,7 @@ let mk_empty_array_rearranged len =
 
 
 let extract_array_type typ =
-  if Config.curr_language_is Config.Java then
+  if Language.curr_language_is Java then
     match typ.Typ.desc with Typ.Tptr (({Typ.desc= Tarray _} as arr), _) -> Some arr | _ -> None
   else
     match typ.Typ.desc with
@@ -270,7 +270,7 @@ let execute___instanceof_cast ~instof {Builtin.pdesc; tenv; prop_; path; ret_id;
       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. *)
-      let should_throw_exception = Config.curr_language_is Config.Java || is_cast_to_reference in
+      let should_throw_exception = Language.curr_language_is Java || is_cast_to_reference in
       let deal_with_failed_cast val1 texp1 texp2 =
         raise (Tabulation.create_cast_exception tenv __POS__ None texp1 texp2 val1)
       in

infer/src/backend/PropUtil.ml

@@ -138,8 +138,8 @@ let remove_abduced_retvars tenv p =
 let remove_locals tenv (curr_f: Procdesc.t) p =
   let names_of_locals = List.map ~f:(get_name_of_local curr_f) (Procdesc.get_locals curr_f) in
   let names_of_locals' =
-    match !Config.curr_language with
-    | Config.Clang ->
+    match !Language.curr_language with
+    | Language.Clang ->
         (* in ObjC to deal with block we need to remove static locals *)
         let names_of_static_locals = get_name_of_objc_static_locals curr_f p in
         let names_of_block_locals = get_name_of_objc_block_locals p in

infer/src/backend/abs.ml

@@ -1090,7 +1090,7 @@ let check_junk ?original_prop pname tenv prop =
             let ml_bucket_opt =
               match resource with
               | (PredSymb.Rmemory PredSymb.Mnew | PredSymb.Rmemory PredSymb.Mnew_array)
-                when Config.curr_language_is Config.Clang ->
+                when Language.curr_language_is Clang ->
                   Mleak_buckets.should_raise_cpp_leak
               | _ ->
                   None
@@ -1115,10 +1115,10 @@ let check_junk ?original_prop pname tenv prop =
                 | None ->
                     (true, exn_leak) )
               | (Some _, Rmemory Mnew | Some _, Rmemory Mnew_array)
-                when Config.curr_language_is Config.Clang ->
+                when Language.curr_language_is Clang ->
                   (is_none ml_bucket_opt, exn_leak)
               | Some _, Rmemory _ ->
-                  (Config.curr_language_is Config.Java, exn_leak)
+                  (Language.curr_language_is Java, exn_leak)
               | Some _, Rignore ->
                   (true, exn_leak)
               | Some _, Rfile when Config.tracing ->
@@ -1137,9 +1137,9 @@ let check_junk ?original_prop pname tenv prop =
                 | Some exn ->
                     (false, exn)
                 | None ->
-                    (Config.curr_language_is Config.Java, exn_leak) )
+                    (Language.curr_language_is Java, exn_leak) )
               | _ ->
-                  (Config.curr_language_is Config.Java, exn_leak)
+                  (Language.curr_language_is Java, exn_leak)
             in
             let already_reported () =
               let attr_opt_equal ao1 ao2 =
@@ -1158,7 +1158,7 @@ let check_junk ?original_prop pname tenv prop =
             let ignore_leak =
               !Config.allow_leak || ignore_resource || is_undefined || already_reported ()
             in
-            let report_and_continue = Config.curr_language_is Config.Java || !Config.footprint in
+            let report_and_continue = Language.curr_language_is Java || !Config.footprint in
             let report_leak () =
               if not report_and_continue then raise exn
               else (

infer/src/backend/buckets.ml

@@ -81,7 +81,7 @@ let check_access access_opt de_opt =
       let formal_ids = ref [] in
       let process_formal_letref = function
         | Sil.Load (id, Exp.Lvar pvar, _, _) ->
-            let is_java_this = Config.curr_language_is Config.Java && Pvar.is_this pvar in
+            let is_java_this = Language.curr_language_is Java && Pvar.is_this pvar in
             if not is_java_this && is_formal pvar then formal_ids := id :: !formal_ids
         | _ ->
             ()

infer/src/backend/callbacks.ml

@@ -46,13 +46,15 @@ let get_procedure_definition exe_env proc_name =
   Option.map ~f:(fun proc_desc -> (tenv, proc_desc)) (Exe_env.get_proc_desc exe_env proc_name)
 
 
-let get_language proc_name = if Typ.Procname.is_java proc_name then Config.Java else Config.Clang
+let get_language proc_name =
+  if Typ.Procname.is_java proc_name then Language.Java else Language.Clang
+
 
 (** Invoke all registered procedure callbacks on the given procedure. *)
 let iterate_procedure_callbacks get_proc_desc exe_env summary proc_desc =
   let proc_name = Procdesc.get_proc_name proc_desc in
   let procedure_language = get_language proc_name in
-  Config.curr_language := procedure_language ;
+  Language.curr_language := procedure_language ;
   let get_procs_in_file proc_name =
     match Exe_env.get_cfg exe_env proc_name with
     | Some cfg ->
@@ -64,7 +66,7 @@ let iterate_procedure_callbacks get_proc_desc exe_env summary proc_desc =
   let is_specialized = Procdesc.is_specialized proc_desc in
   List.fold ~init:summary
     ~f:(fun summary (language, resolved, proc_callback) ->
-      if Config.equal_language language procedure_language && (resolved || not is_specialized) then
+      if Language.equal language procedure_language && (resolved || not is_specialized) then
         proc_callback {get_proc_desc; get_procs_in_file; tenv; summary; proc_desc}
       else summary )
     !procedure_callbacks
@@ -77,7 +79,7 @@ let iterate_cluster_callbacks all_procs exe_env get_proc_desc =
   let language_matches language =
     match procedures with
     | (_, pdesc) :: _ ->
-        Config.equal_language language (get_language (Procdesc.get_proc_name pdesc))
+        Language.equal language (get_language (Procdesc.get_proc_name pdesc))
     | _ ->
         true
   in
@@ -118,7 +120,7 @@ let dump_duplicate_procs (exe_env: Exe_env.t) procs =
 
 (** Invoke all procedure and cluster callbacks on a given environment. *)
 let iterate_callbacks (exe_env: Exe_env.t) =
-  let saved_language = !Config.curr_language in
+  let saved_language = !Language.curr_language in
   let get_proc_desc proc_name =
     match Exe_env.get_proc_desc exe_env proc_name with
     | Some _ as pdesc_opt ->
@@ -146,4 +148,4 @@ let iterate_callbacks (exe_env: Exe_env.t) =
   iterate_cluster_callbacks procs_to_analyze exe_env get_proc_desc ;
   (* Unregister callbacks *)
   Ondemand.unset_callbacks () ;
-  Config.curr_language := saved_language
+  Language.curr_language := saved_language

infer/src/backend/callbacks.mli

@@ -30,11 +30,10 @@ type cluster_callback_args =
 
 type cluster_callback_t = cluster_callback_args -> unit
 
-val register_procedure_callback :
-  ?dynamic_dispath:bool -> Config.language -> proc_callback_t -> unit
+val register_procedure_callback : ?dynamic_dispath:bool -> Language.t -> proc_callback_t -> unit
 (** register a procedure callback *)
 
-val register_cluster_callback : Config.language -> cluster_callback_t -> unit
+val register_cluster_callback : Language.t -> cluster_callback_t -> unit
 (** register a cluster callback *)
 
 val iterate_callbacks : Exe_env.t -> unit

infer/src/backend/errdesc.ml

@@ -729,7 +729,7 @@ let access_opt ?(is_nullable= false) inst =
       Some (Localise.Last_accessed (n, is_nullable))
   | Sil.Ireturn_from_call n ->
       Some (Localise.Returned_from_call n)
-  | Sil.Ialloc when Config.curr_language_is Config.Java ->
+  | Sil.Ialloc when Language.curr_language_is Java ->
       Some Localise.Initialized_automatically
   | inst ->
       if verbose then
@@ -913,7 +913,7 @@ let create_dereference_desc proc_name tenv ?(use_buckets= false) ?(outermost_arr
   in
   let desc = Localise.dereference_string proc_name deref_str value_str access_opt' loc in
   let desc =
-    if Config.curr_language_is Config.Clang && not is_premature_nil then
+    if Language.curr_language_is Clang && not is_premature_nil then
       match de_opt with
       | Some DExp.Dpvar pvar | Some DExp.Dpvaraddr pvar -> (
         match Attribute.get_objc_null tenv prop (Exp.Lvar pvar) with

infer/src/backend/inferconfig.ml

@@ -48,7 +48,7 @@ let is_matching patterns source_file =
 (** Check if a proc name is matching the name given as string. *)
 let match_method language proc_name method_name =
   not (BuiltinDecl.is_declared proc_name)
-  && Config.equal_language (Typ.Procname.get_language proc_name) language
+  && Language.equal (Typ.Procname.get_language proc_name) language
   && String.equal (Typ.Procname.get_method proc_name) method_name
 
 
@@ -89,8 +89,8 @@ type method_pattern =
   {class_name: string; method_name: string option; parameters: string list option}
 
 type pattern =
-  | Method_pattern of Config.language * method_pattern
-  | Source_contains of Config.language * string
+  | Method_pattern of Language.t * method_pattern
+  | Source_contains of Language.t * string
 
 (* Module to create matcher based on source file names or class names and method names *)
 module FileOrProcMatcher = struct
@@ -163,12 +163,10 @@ module FileOrProcMatcher = struct
     and pp_source_contains fmt sc = Format.fprintf fmt "  pattern: %s@\n" sc in
     match pattern with
     | Method_pattern (language, mp) ->
-        Format.fprintf fmt "Method pattern (%s) {@\n%a}@\n"
-          (Config.string_of_language language)
+        Format.fprintf fmt "Method pattern (%s) {@\n%a}@\n" (Language.to_string language)
           pp_method_pattern mp
     | Source_contains (language, sc) ->
-        Format.fprintf fmt "Source contains (%s) {@\n%a}@\n"
-          (Config.string_of_language language)
+        Format.fprintf fmt "Source contains (%s) {@\n%a}@\n" (Language.to_string language)
           pp_source_contains sc
 end
 
@@ -189,11 +187,12 @@ end
 let patterns_of_json_with_key (json_key, json) =
   let default_method_pattern = {class_name= ""; method_name= None; parameters= None} in
   let default_source_contains = "" in
-  let language_of_string = function
-    | "Java" ->
-        Ok Config.Java
-    | l ->
-        Error ("JSON key " ^ json_key ^ " not supported for language " ^ l)
+  let language_of_string s =
+    match Language.of_string s with
+    | Some Language.Java ->
+        Ok Language.Java
+    | _ ->
+        Error ("JSON key " ^ json_key ^ " not supported for language " ^ s)
   in
   let rec detect_language = function
     | [] ->

infer/src/backend/interproc.ml

@@ -674,7 +674,7 @@ let extract_specs tenv pdesc pathset : Prop.normal Specs.spec list =
       let prop'' = Abs.abstract pname tenv prop' in
       let pre, post = Prop.extract_spec prop'' in
       let pre' = Prop.normalize tenv (Prop.prop_sub (`Exp sub) pre) in
-      if Config.curr_language_is Config.Java && Procdesc.get_access pdesc <> PredSymb.Private then
+      if Language.curr_language_is Java && Procdesc.get_access pdesc <> PredSymb.Private then
         report_context_leaks pname post.Prop.sigma tenv ;
       let post' =
         if Prover.check_inconsistency_base tenv prop then None
@@ -782,12 +782,12 @@ let prop_init_formals_seed tenv new_formals (prop: 'a Prop.t) : Prop.exposed Pro
   let sigma_new_formals =
     let do_formal (pv, typ) =
       let texp =
-        match !Config.curr_language with
-        | Config.Clang ->
+        match !Language.curr_language with
+        | Clang ->
             Exp.Sizeof {typ; nbytes= None; dynamic_length= None; subtype= Subtype.exact}
-        | Config.Java ->
+        | Java ->
             Exp.Sizeof {typ; nbytes= None; dynamic_length= None; subtype= Subtype.subtypes}
-        | Config.Python ->
+        | Python ->
             L.die InternalError "prop_init_formals_seed not implemented for Python"
       in
       Prop.mk_ptsto_lvar tenv Prop.Fld_init Sil.inst_formal (pv, texp, None)
@@ -991,7 +991,7 @@ let perform_analysis_phase tenv (summary: Specs.summary) (proc_cfg: ProcCfg.Exce
 
 let set_current_language proc_desc =
   let language = Typ.Procname.get_language (Procdesc.get_proc_name proc_desc) in
-  Config.curr_language := language
+  Language.curr_language := language
 
 
 (** reset global values before analysing a procedure *)
@@ -1038,7 +1038,7 @@ let custom_error_preconditions summary =
 let remove_this_not_null tenv prop =
   let collect_hpred (var_option, hpreds) = function
     | Sil.Hpointsto (Exp.Lvar pvar, Sil.Eexp (Exp.Var var, _), _)
-      when Config.curr_language_is Config.Java && Pvar.is_this pvar ->
+      when Language.curr_language_is Java && Pvar.is_this pvar ->
         (Some var, hpreds)
     | hpred ->
         (var_option, hpred :: hpreds)
@@ -1212,9 +1212,9 @@ let analyze_proc tenv proc_cfg : Specs.summary =
   let res = Timeout.exe_timeout go () in
   let specs, phase = get_results () in
   let updated_summary = update_summary tenv summary specs phase res in
-  if Config.curr_language_is Config.Clang && Config.report_custom_error then
+  if Language.curr_language_is Clang && Config.report_custom_error then
     report_custom_errors tenv updated_summary ;
-  if Config.curr_language_is Config.Java && Config.tracing then
+  if Language.curr_language_is Java && Config.tracing then
     report_runtime_exceptions tenv proc_desc updated_summary ;
   updated_summary
 

infer/src/backend/prop.ml

@@ -455,7 +455,7 @@ let rec create_strexp_of_type ~path tenv struct_init_mode (typ: Typ.t) len inst
       in
       Exp.Var fresh_id
     in
-    if Config.curr_language_is Config.Java && Sil.equal_inst inst Sil.Ialloc then
+    if Language.curr_language_is Java && Sil.equal_inst inst Sil.Ialloc then
       match typ.desc with Tfloat _ -> Exp.Const (Cfloat 0.0) | _ -> Exp.zero
     else create_fresh_var ()
   in
@@ -724,10 +724,10 @@ module Normalize = struct
       | Sizeof {nbytes= Some n} when destructive ->
           Exp.Const (Const.Cint (IntLit.of_int n))
       | Sizeof {typ= {desc= Tarray ({desc= Tint ik}, _, _)}; dynamic_length= Some l}
-        when Typ.ikind_is_char ik && Config.curr_language_is Config.Clang ->
+        when Typ.ikind_is_char ik && Language.curr_language_is Clang ->
           eval l
       | Sizeof {typ= {desc= Tarray ({desc= Tint ik}, Some l, _)}}
-        when Typ.ikind_is_char ik && Config.curr_language_is Config.Clang ->
+        when Typ.ikind_is_char ik && Language.curr_language_is Clang ->
           Const (Cint l)
       | Sizeof _ ->
           e

infer/src/backend/prover.ml

@@ -992,14 +992,14 @@ let check_inconsistency_base tenv prop =
     | Some (_, _, pdesc) ->
         let procedure_attr = Procdesc.get_attributes pdesc in
         let language = Typ.Procname.get_language (Procdesc.get_proc_name pdesc) in
-        let is_java_this pvar = Config.equal_language language Config.Java && Pvar.is_this pvar in
+        let is_java_this pvar = Language.equal language Java && Pvar.is_this pvar in
         let is_objc_instance_self pvar =
-          Config.equal_language language Config.Clang
+          Language.equal language Clang
           && Mangled.equal (Pvar.get_name pvar) (Mangled.from_string "self")
           && procedure_attr.ProcAttributes.is_objc_instance_method
         in
         let is_cpp_this pvar =
-          Config.equal_language language Config.Clang && Pvar.is_this pvar
+          Language.equal language Clang && Pvar.is_this pvar
           && procedure_attr.ProcAttributes.is_cpp_instance_method
         in
         let do_hpred = function
@@ -2329,10 +2329,10 @@ and sigma_imply tenv calc_index_frame calc_missing subs prop1 sigma2 : subst2 *
     let root = Exp.Const (Const.Cstr s) in
     let sexp =
       let index = Exp.int (IntLit.of_int (String.length s)) in
-      match !Config.curr_language with
-      | Config.Clang ->
+      match !Language.curr_language with
+      | Clang ->
           Sil.Earray (Exp.int len, [(index, Sil.Eexp (Exp.zero, Sil.inst_none))], Sil.inst_none)
-      | Config.Java ->
+      | Java ->
           let mk_fld_sexp s =
             let fld = Typ.Fieldname.Java.from_string s in
             let se = Sil.Eexp (Exp.Var (Ident.create_fresh Ident.kprimed), Sil.Inone) in
@@ -2345,25 +2345,25 @@ and sigma_imply tenv calc_index_frame calc_missing subs prop1 sigma2 : subst2 *
             ; "java.lang.String.value" ]
           in
           Sil.Estruct (List.map ~f:mk_fld_sexp fields, Sil.inst_none)
-      | Config.Python ->
+      | Python ->
           L.die InternalError "mk_constant_string_hpred not implemented for Python"
     in
     let const_string_texp =
-      match !Config.curr_language with
-      | Config.Clang ->
+      match !Language.curr_language with
+      | Clang ->
           Exp.Sizeof
             { typ= Typ.mk (Tarray (Typ.mk (Tint Typ.IChar), Some len, Some (IntLit.of_int 1)))
             ; nbytes= None
             ; dynamic_length= None
             ; subtype= Subtype.exact }
-      | Config.Java ->
+      | Java ->
           let object_type = Typ.Name.Java.from_string "java.lang.String" in
           Exp.Sizeof
             { typ= Typ.mk (Tstruct object_type)
             ; nbytes= None
             ; dynamic_length= None
             ; subtype= Subtype.exact }
-      | Config.Python ->
+      | Python ->
           L.die InternalError "const_string_texp not implemented for Python"
     in
     Sil.Hpointsto (root, sexp, const_string_texp)

infer/src/backend/rearrange.ml

@@ -471,12 +471,12 @@ let mk_ptsto_exp_footprint pname tenv orig_prop (lexp, typ) max_stamp inst
       raise (Exceptions.Dangling_pointer_dereference (None, err_desc, __POS__)) ) ;
   let off_foot, eqs = laundry_offset_for_footprint max_stamp off in
   let subtype =
-    match !Config.curr_language with
-    | Config.Clang ->
+    match !Language.curr_language with
+    | Clang ->
         Subtype.exact
-    | Config.Java ->
+    | Java ->
         Subtype.subtypes
-    | Config.Python ->
+    | Python ->
         L.die InternalError "Subtypes for Python not implemented"
   in
   let create_ptsto footprint_part off0 =
@@ -1719,8 +1719,7 @@ let check_call_to_objc_block_error tenv pdesc prop fun_exp loc =
     | _ ->
         (None, false)
   in
-  if Config.curr_language_is Config.Clang && fun_exp_may_be_null ()
-     && not (is_fun_exp_captured_var ())
+  if Language.curr_language_is Clang && fun_exp_may_be_null () && not (is_fun_exp_captured_var ())
   then
     let deref_str = Localise.deref_str_null None in
     let err_desc_nobuckets =

infer/src/backend/reporting.ml

@@ -46,7 +46,7 @@ let log_issue_from_summary err_kind summary ?loc ?node_id ?session ?ltr ?linters
         false
   in
   let should_suppress_lint =
-    Config.curr_language_is Config.Java
+    Language.curr_language_is Java
     && Annotations.ia_is_suppress_lint
          (fst (Specs.get_attributes summary).ProcAttributes.method_annotation)
   in

infer/src/backend/symExec.ml

@@ -514,7 +514,7 @@ let check_deallocate_static_memory prop_after =
 
 
 let method_exists right_proc_name methods =
-  if Config.curr_language_is Config.Java then
+  if Language.curr_language_is Java then
     List.exists ~f:(fun meth_name -> Typ.Procname.equal right_proc_name meth_name) methods
   else
     (* ObjC/C++ case : The attribute map will only exist when we have code for the method or
@@ -611,7 +611,7 @@ let resolve_virtual_pname tenv prop actuals callee_pname call_flags : Typ.Procna
       [callee_pname]
   | (receiver_exp, actual_receiver_typ) :: _
     -> (
-      if !Config.curr_language <> Config.Java then
+      if !Language.curr_language <> Language.Java then
         (* default mode for Obj-C/C++/Java virtual calls: resolution only *)
         [do_resolve callee_pname receiver_exp actual_receiver_typ]
       else
@@ -1135,7 +1135,8 @@ let rec sym_exec tenv current_pdesc instr_ (prop_: Prop.normal Prop.t) path
   | Sil.Prune (cond, loc, true_branch, ik) ->
       let prop__ = Attribute.nullify_exp_with_objc_null tenv prop_ cond in
       let check_condition_always_true_false () =
-        if !Config.curr_language <> Config.Clang || Config.report_condition_always_true_in_clang
+        if !Language.curr_language <> Language.Clang
+           || Config.report_condition_always_true_in_clang
         then
           let report_condition_always_true_false i =
             let skip_loop =
@@ -1256,7 +1257,7 @@ let rec sym_exec tenv current_pdesc instr_ (prop_: Prop.normal Prop.t) path
               let callee_pdesc_opt = Ondemand.get_proc_desc resolved_pname in
               let ret_typ_opt = Option.map ~f:Procdesc.get_ret_type callee_pdesc_opt in
               let sentinel_result =
-                if Config.curr_language_is Config.Clang then
+                if Language.curr_language_is Clang then
                   check_variadic_sentinel_if_present
                     (call_args prop_r callee_pname actual_params ret_id loc)
                 else [(prop_r, path)]
@@ -1746,7 +1747,7 @@ and proc_call callee_summary
   (* In case we call an objc instance method we add and extra spec *)
   (* were the receiver is null and the semantics of the call is nop*)
   (* let callee_attrs = Specs.get_attributes callee_summary in *)
-  if !Config.curr_language <> Config.Java
+  if !Language.curr_language <> Language.Java
      && (Specs.get_attributes callee_summary).ProcAttributes.is_objc_instance_method
   then
     handle_objc_instance_method_call actual_pars actual_params pre tenv ret_id pdesc callee_pname

infer/src/backend/tabulation.ml

@@ -985,8 +985,7 @@ let mk_posts tenv ret_id_opt prop callee_pname posts =
         List.filter ~f:(fun (prop, _) -> not (returns_null prop)) posts
       else posts
     in
-    if Config.idempotent_getters && Config.curr_language_is Config.Java then
-      mk_getter_idempotent posts
+    if Config.idempotent_getters && Language.curr_language_is Java then mk_getter_idempotent posts
     else posts
 
 
@@ -1327,8 +1326,7 @@ let exe_call_postprocess tenv ret_id trace_call callee_pname callee_attrs loc re
       | _ ->
           false
     in
-    Config.idempotent_getters && Config.curr_language_is Config.Java
-    && is_likely_getter callee_pname
+    Config.idempotent_getters && Language.curr_language_is Java && is_likely_getter callee_pname
     || returns_nullable ret_annot
   in
   match ret_id with

infer/src/base/Config.ml

@@ -45,12 +45,6 @@ let clang_frontend_action_symbols =
   [("lint", `Lint); ("capture", `Capture); ("lint_and_capture", `Lint_and_capture)]
 
 
-type language = Clang | Java | Python [@@deriving compare]
-
-let equal_language = [%compare.equal : language]
-
-let string_of_language = function Java -> "Java" | Clang -> "C/C++/ObjC" | Python -> "python"
-
 let ml_bucket_symbols =
   [ ("all", `MLeak_all)
   ; ("cf", `MLeak_cf)
@@ -2738,11 +2732,6 @@ let set_reference_and_call_function reference value f x =
 (** Current Objective-C Automatic Reference Counting (ARC) mode *)
 let arc_mode = ref false
 
-(** Current language *)
-let curr_language = ref Clang
-
-let curr_language_is lang = equal_language !curr_language lang
-
 (** Flag for footprint discovery mode *)
 let footprint = ref true
 

infer/src/base/Config.mli

@@ -29,12 +29,6 @@ val string_to_analyzer : (string * analyzer) list
 
 val string_of_analyzer : analyzer -> string
 
-type language = Clang | Java | Python [@@deriving compare]
-
-val equal_language : language -> language -> bool
-
-val string_of_language : language -> string
-
 type os_type = Unix | Win32 | Cygwin
 
 type compilation_database_dependencies =
@@ -648,10 +642,6 @@ val xcpretty : bool
 
 val arc_mode : bool ref
 
-val curr_language : language ref
-
-val curr_language_is : language -> bool
-
 val footprint : bool ref
 
 val run_in_footprint_mode : ('a -> 'b) -> 'a -> 'b

infer/src/base/Language.ml

@@ -0,0 +1,24 @@
+(*
+ * Copyright (c) 2018 - 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! IStd
+
+type t = Clang | Java | Python [@@deriving compare]
+
+let equal = [%compare.equal : t]
+
+let language_to_string = [(Clang, "C/C++/ObjC"); (Java, "Java"); (Python, "python")]
+
+let to_string lang = List.Assoc.find_exn language_to_string ~equal lang
+
+let of_string s = List.Assoc.find (List.Assoc.inverse language_to_string) ~equal:String.equal s
+
+(** Current language *)
+let curr_language = ref Clang
+
+let curr_language_is lang = equal !curr_language lang

infer/src/base/Language.mli

@@ -0,0 +1,22 @@
+(*
+ * Copyright (c) 2018 - 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! IStd
+
+type t = Clang | Java | Python [@@deriving compare]
+
+val equal : t -> t -> bool
+
+val to_string : t -> string
+
+val of_string : string -> t option
+
+val curr_language : t ref
+
+val curr_language_is : t -> bool

infer/src/checkers/registerCheckers.ml

@@ -22,7 +22,7 @@ type callback_fun =
   | DynamicDispatch of Callbacks.proc_callback_t
   | Cluster of Callbacks.cluster_callback_t
 
-type callback = callback_fun * Config.language
+type callback = callback_fun * Language.t
 
 type checker = {name: string; active: bool; callbacks: callback list}
 
@@ -31,58 +31,58 @@ let all_checkers =
      Currently, the checkers are run in the reverse order *)
   [ { name= "annotation reachability"
     ; active= Config.annotation_reachability
-    ; callbacks= [(Procedure AnnotationReachability.checker, Config.Java)] }
+    ; callbacks= [(Procedure AnnotationReachability.checker, Language.Java)] }
   ; { name= "nullable checks"
     ; active= Config.check_nullable
     ; callbacks=
-        [ (Procedure NullabilityCheck.checker, Config.Clang)
-        ; (Procedure NullabilityCheck.checker, Config.Java) ] }
+        [ (Procedure NullabilityCheck.checker, Language.Clang)
+        ; (Procedure NullabilityCheck.checker, Language.Java) ] }
   ; { name= "biabduction"
     ; active= Config.biabduction
     ; callbacks=
-        [ (Procedure Interproc.analyze_procedure, Config.Clang)
-        ; (DynamicDispatch Interproc.analyze_procedure, Config.Java) ] }
+        [ (Procedure Interproc.analyze_procedure, Language.Clang)
+        ; (DynamicDispatch Interproc.analyze_procedure, Language.Java) ] }
   ; { name= "buffer overrun"
     ; active= Config.bufferoverrun
     ; callbacks=
-        [ (Procedure BufferOverrunChecker.checker, Config.Clang)
-        ; (Procedure BufferOverrunChecker.checker, Config.Java) ] }
+        [ (Procedure BufferOverrunChecker.checker, Language.Clang)
+        ; (Procedure BufferOverrunChecker.checker, Language.Java) ] }
   ; { name= "crashcontext"
     ; active= Config.crashcontext
-    ; callbacks= [(Procedure BoundedCallTree.checker, Config.Java)] }
+    ; callbacks= [(Procedure BoundedCallTree.checker, Language.Java)] }
   ; { name= "eradicate"
     ; active= Config.eradicate
-    ; callbacks= [(Procedure Eradicate.callback_eradicate, Config.Java)] }
+    ; callbacks= [(Procedure Eradicate.callback_eradicate, Language.Java)] }
   ; { name= "fragment retains view"
     ; active= Config.fragment_retains_view
     ; callbacks=
-        [(Procedure FragmentRetainsViewChecker.callback_fragment_retains_view, Config.Java)] }
+        [(Procedure FragmentRetainsViewChecker.callback_fragment_retains_view, Language.Java)] }
   ; { name= "immutable cast"
     ; active= Config.immutable_cast
-    ; callbacks= [(Procedure ImmutableChecker.callback_check_immutable_cast, Config.Java)] }
+    ; callbacks= [(Procedure ImmutableChecker.callback_check_immutable_cast, Language.Java)] }
   ; { name= "liveness"
     ; active= Config.liveness
-    ; callbacks= [(Procedure Liveness.checker, Config.Clang)] }
+    ; callbacks= [(Procedure Liveness.checker, Language.Clang)] }
   ; { name= "printf args"
     ; active= Config.printf_args
-    ; callbacks= [(Procedure PrintfArgs.callback_printf_args, Config.Java)] }
+    ; callbacks= [(Procedure PrintfArgs.callback_printf_args, Language.Java)] }
   ; { name= "nullable suggestion"
     ; active= Config.suggest_nullable
     ; callbacks=
-        [ (Procedure NullabilitySuggest.checker, Config.Java)
-        ; (Procedure NullabilitySuggest.checker, Config.Clang) ] }
+        [ (Procedure NullabilitySuggest.checker, Language.Java)
+        ; (Procedure NullabilitySuggest.checker, Language.Clang) ] }
   ; { name= "quandary"
     ; active= Config.quandary
     ; callbacks=
-        [ (Procedure JavaTaintAnalysis.checker, Config.Java)
-        ; (Procedure ClangTaintAnalysis.checker, Config.Clang) ] }
+        [ (Procedure JavaTaintAnalysis.checker, Language.Java)
+        ; (Procedure ClangTaintAnalysis.checker, Language.Clang) ] }
   ; { name= "RacerD"
     ; active= Config.racerd
     ; callbacks=
-        [ (Procedure RacerD.analyze_procedure, Config.Clang)
-        ; (Procedure RacerD.analyze_procedure, Config.Java)
-        ; (Cluster RacerD.file_analysis, Config.Clang)
-        ; (Cluster RacerD.file_analysis, Config.Java) ] }
+        [ (Procedure RacerD.analyze_procedure, Language.Clang)
+        ; (Procedure RacerD.analyze_procedure, Language.Java)
+        ; (Cluster RacerD.file_analysis, Language.Clang)
+        ; (Cluster RacerD.file_analysis, Language.Java) ] }
     (* toy resource analysis to use in the infer lab, see the lab/ directory *)
   ; { name= "resource leak"
     ; active= Config.resource_leak
@@ -90,12 +90,12 @@ let all_checkers =
         [ ( (* the checked-in version is intraprocedural, but the lab asks to make it
                interprocedural later on *)
             Procedure ResourceLeaks.checker
-          , Config.Java ) ] }
-  ; {name= "litho"; active= Config.litho; callbacks= [(Procedure Litho.checker, Config.Java)]}
-  ; {name= "SIOF"; active= Config.siof; callbacks= [(Procedure Siof.checker, Config.Clang)]}
+          , Language.Java ) ] }
+  ; {name= "litho"; active= Config.litho; callbacks= [(Procedure Litho.checker, Language.Java)]}
+  ; {name= "SIOF"; active= Config.siof; callbacks= [(Procedure Siof.checker, Language.Clang)]}
   ; { name= "uninitialized variables"
     ; active= Config.uninit
-    ; callbacks= [(Procedure Uninit.checker, Config.Clang)] } ]
+    ; callbacks= [(Procedure Uninit.checker, Language.Clang)] } ]
 
 
 let get_active_checkers () =
@@ -119,11 +119,7 @@ let register checkers =
   List.iter ~f:register_one checkers
 
 
-module LanguageSet = Caml.Set.Make (struct
-  type t = Config.language
-
-  let compare = Config.compare_language
-end)
+module LanguageSet = Caml.Set.Make (Language)
 
 let pp_checker fmt {name; callbacks} =
   let langs_of_callbacks =
@@ -132,5 +128,5 @@ let pp_checker fmt {name; callbacks} =
     |> LanguageSet.elements
   in
   F.fprintf fmt "%s (%a)" name
-    (Pp.seq ~sep:", " (Pp.to_string ~f:Config.string_of_language))
+    (Pp.seq ~sep:", " (Pp.to_string ~f:Language.to_string))
     langs_of_callbacks

infer/src/clang/Capture.ml

@@ -34,7 +34,7 @@ let register_perf_stats_report source_file =
 let init_global_state_for_capture_and_linters source_file =
   L.(debug Capture Medium) "Processing %s" (Filename.basename (SourceFile.to_abs_path source_file)) ;
   if Config.developer_mode then register_perf_stats_report source_file ;
-  Config.curr_language := Config.Clang ;
+  Language.curr_language := Language.Clang ;
   if Config.capture then DB.Results_dir.init source_file ;
   CFrontend_config.reset_global_state ()
 

infer/src/java/jMain.ml

@@ -22,7 +22,7 @@ let register_perf_stats_report source_file =
 
 let init_global_state source_file =
   if Config.developer_mode then register_perf_stats_report source_file ;
-  Config.curr_language := Config.Java ;
+  Language.curr_language := Language.Java ;
   DB.Results_dir.init source_file ;
   Ident.NameGenerator.reset () ;
   JContext.reset_exn_node_table ()