(* * Copyright (c) 2009 - 2013 Monoidics ltd. * Copyright (c) 2013 - 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. *) (** Module for Procedure Names *) module L = Logging module F = Format open Utils open Str type java_type = string option * string (* e.g. ("", "int") for primitive types or ("java.io", "PrintWriter") for objects *) type method_kind = | Static (* in Java, procedures called with invokestatic *) | Non_Static (* in Java, procedures called with invokevirtual, invokespecial, and invokeinterface *) (* java_signature extends base_signature with a classname and a package *) type java_signature = { classname: java_type; returntype: java_type option; (* option because constructors have no return type *) methodname: string; parameters: java_type list; kind: method_kind } type objc_method_kind = | Instance_objc_method | Class_objc_method let mangled_of_objc_method_kind kind = match kind with | Instance_objc_method -> Some "instance" | Class_objc_method -> Some "class" let objc_method_kind_of_bool is_instance = if is_instance then Instance_objc_method else Class_objc_method (* C++/ObjC method signature *) type c_method_signature = { class_name: string; method_name: string; mangled: string option; } type t = | JAVA of java_signature | C_FUNCTION of string * (string option) (* it is a pair (plain, mangled optional) *) | STATIC of string * (string option) (* it is a pair (plain name, filename optional) *) | C_METHOD of c_method_signature | OBJC_BLOCK of string (* Defines the level of verbosity of some to_string functions *) type detail_level = | VERBOSE | NON_VERBOSE | SIMPLE let is_verbose v = match v with | VERBOSE -> true | _ -> false type proc_name = t let mangled_compare so1 so2 = match so1, so2 with | None, None -> 0 | None, Some _ -> -1 | Some _, None -> 1 | Some s1, Some s2 -> string_compare s1 s2 let method_kind_compare k0 k1 = match k0, k1 with | _ when k0 = k1 -> 0 | Static, _ -> 1 | Non_Static, _ -> -1 (** A type is a pair (package, type_name) that is translated in a string package.type_name *) let java_type_to_string p verbosity = match p with | (None, typ) -> typ | (Some p, cls) -> if is_verbose verbosity then p ^ "." ^ cls else cls (** Given a list of types, it creates a unique string of types separated by commas *) let rec java_param_list_to_string inputList verbosity = match inputList with | [] -> "" | [head] -> java_type_to_string head verbosity | head :: rest -> (java_type_to_string head verbosity) ^ "," ^ (java_param_list_to_string rest verbosity) (** It is the same as java_type_to_string, but Java return types are optional because of constructors without type *) let java_return_type_to_string j verbosity = match j.returntype with | None -> "" | Some typ -> java_type_to_string typ verbosity let java_type_compare (p1, c1) (p2, c2) = string_compare c1 c2 |> next mangled_compare p1 p2 let rec java_type_list_compare jt1 jt2 = match jt1, jt2 with | [], [] -> 0 | [], _ -> -1 | _, [] -> 1 | (x1:: rest1), (x2:: rest2) -> java_type_compare x1 x2 |> next java_type_list_compare rest1 rest2 let java_return_type_compare jr1 jr2 = match jr1, jr2 with | None, None -> 0 | None, Some _ -> -1 | Some _, None -> 1 | Some jt1 , Some jt2 -> java_type_compare jt1 jt2 (** Compare java signatures. *) let java_sig_compare js1 js2 = string_compare js1.methodname js2.methodname |> next java_type_list_compare js1.parameters js2.parameters |> next java_type_compare js1.classname js2.classname |> next java_return_type_compare js1.returntype js2.returntype |> next method_kind_compare js1.kind js2.kind let c_function_mangled_compare mangled1 mangled2 = match mangled1, mangled2 with | Some mangled1, None -> 1 | None, Some mangled2 -> -1 | None, None -> 0 | Some mangled1, Some mangled2 -> string_compare mangled1 mangled2 (** Compare c_method signatures. *) let c_meth_sig_compare osig1 osig2 = string_compare osig1.method_name osig2.method_name |> next string_compare osig1.class_name osig2.class_name |> next c_function_mangled_compare osig1.mangled osig2.mangled (** Given a package.classname string, it looks for the latest dot and split the string in two (package, classname) *) let split_classname package_classname = string_split_character package_classname '.' let from_string_c_fun (s: string) = C_FUNCTION (s, None) let mangled_c_fun (plain: string) (mangled: string) = C_FUNCTION (plain, Some mangled) (** Create a static procedure name from a plain name and source file *) let mangled_static (plain: string) (source_file: DB.source_file) = let mangled = if !Config.long_static_proc_names then Some (DB.source_file_encoding source_file) else None in STATIC (plain, mangled) (** Creates a java procname, given classname, return type, method name and its parameters *) let mangled_java class_name ret_type method_name params _kind = JAVA { classname = class_name; returntype = ret_type; methodname = method_name; parameters = params; kind = _kind } (** Create an objc procedure name from a class_name and method_name. *) let mangled_c_method class_name method_name mangled = C_METHOD { class_name = class_name; method_name = method_name; mangled = mangled; } (** Create an objc procedure name from a class_name and method_name. *) let mangled_objc_block name = OBJC_BLOCK name let is_java = function | JAVA _ -> true | _ -> false let is_c_method = function | C_METHOD _ -> true | _ -> false (** Replace package and classname of a java procname. *) let java_replace_class p package_classname = match p with | JAVA j -> JAVA { j with classname = (split_classname package_classname) } | _ -> assert false (** Replace the class name of an objc procedure name. *) let c_method_replace_class t class_name = match t with | C_METHOD osig -> C_METHOD { osig with class_name = class_name } | _ -> assert false (** Get the class name of a Objective-C/C++ procedure name. *) let c_get_class t = match t with | C_METHOD osig -> osig.class_name | _ -> assert false (** Return the package.classname of a java procname. *) let java_get_class = function | JAVA j -> java_type_to_string j.classname VERBOSE | _ -> assert false (** Return path components of a java class name *) let java_get_class_components proc_name = Str.split (Str.regexp (Str.quote ".")) (java_get_class proc_name) (** Return the class name of a java procedure name. *) let java_get_simple_class proc_name = IList.hd (IList.rev (java_get_class_components proc_name)) (** Return the method of a java procname. *) let java_get_method = function | JAVA j -> j.methodname | _ -> assert false (** Replace the method of a java procname. *) let java_replace_method p mname = match p with | JAVA p -> JAVA { p with methodname = mname } | _ -> assert false (** Replace the return type of a java procname. *) let java_replace_return_type p ret_type = match p with | JAVA p -> JAVA { p with returntype = Some ret_type } | _ -> assert false (** Return the method of a objc/c++ procname. *) let c_get_method = function | C_METHOD name -> name.method_name | C_FUNCTION (name, _) -> name | OBJC_BLOCK name -> name | _ -> assert false (** Return the return type of a java procname. *) let java_get_return_type = function | JAVA j -> java_return_type_to_string j VERBOSE | _ -> assert false (** Return the parameters of a java procname. *) let java_get_parameters = function | JAVA j -> IList.map (fun param -> java_type_to_string param VERBOSE) j.parameters | _ -> assert false (** Return true if the java procedure is static *) let java_is_static = function | JAVA j -> j.kind = Static | _ -> assert false (** Prints a string of a java procname with the given level of verbosity *) let java_to_string ?(withclass = false) j verbosity = match verbosity with | VERBOSE | NON_VERBOSE -> (* if verbose, then package.class.method(params): rtype, else rtype package.class.method(params) verbose is used for example to create unique filenames, non_verbose to create reports *) let return_type = java_return_type_to_string j verbosity in let params = java_param_list_to_string j.parameters verbosity in let classname = java_type_to_string j.classname verbosity in let separator = match j.returntype, verbosity with | (None, _) -> "" | (Some _, VERBOSE) -> ":" | _ -> " " in let output = classname ^ "." ^ j.methodname ^ "(" ^ params ^ ")" in if verbosity = VERBOSE then output ^ separator ^ return_type else return_type ^ separator ^ output | SIMPLE -> (* methodname(...) or without ... if there are no parameters *) let cls_prefix = if withclass then java_type_to_string j.classname verbosity ^ "." else "" in let params = match j.parameters with | [] -> "" | _ -> "..." in let methodname = if j.methodname = "" then java_get_simple_class (JAVA j) else j.methodname in cls_prefix ^ methodname ^ "(" ^ params ^ ")" (** Check if the class name is for an anonymous inner class. *) let is_anonymous_inner_class_name class_name = match string_split_character class_name '$' with | Some _, s -> let is_int = try ignore (int_of_string (String.trim s)); true with Failure _ -> false in is_int | None, _ -> false (** Check if the procedure belongs to an anonymous inner class. *) let java_is_anonymous_inner_class = function | JAVA j -> is_anonymous_inner_class_name (snd j.classname) | _ -> false (** Check if the last parameter is a hidden inner class, and remove it if present. This is used in private constructors, where a proxy constructor is generated with an extra parameter and calls the normal constructor. *) let java_remove_hidden_inner_class_parameter = function | JAVA js -> (match IList.rev js.parameters with | (so, s) :: par' -> if is_anonymous_inner_class_name s then Some (JAVA { js with parameters = IList.rev par'}) else None | [] -> None) | _ -> None (** Check if the procedure name is an anonymous inner class constructor. *) let java_is_anonymous_inner_class_constructor = function | JAVA js -> let _, name = js.classname in is_anonymous_inner_class_name name | _ -> false (** Check if the procedure name is an acess method (e.g. access$100 used to access private members from a nested class. *) let java_is_access_method = function | JAVA js -> (match string_split_character js.methodname '$' with | Some "access", s -> let is_int = try ignore (int_of_string s); true with Failure _ -> false in is_int | _ -> false) | _ -> false (** Check if the proc name has the type of a java vararg. Note: currently only checks that the last argument has type Object[]. *) let java_is_vararg = function | JAVA js -> begin match (IList.rev js.parameters) with | (_,"java.lang.Object[]") :: _ -> true | _ -> false end | _ -> false (** [is_constructor pname] returns true if [pname] is a constructor *) let is_constructor = function | JAVA js -> js.methodname = "" | C_METHOD name -> Utils.string_is_prefix "init" name.method_name | _ -> false let java_is_close = function | JAVA js -> js.methodname = "close" | _ -> false (** [is_class_initializer pname] returns true if [pname] is a class initializer *) let is_class_initializer = function | JAVA js -> js.methodname = "" | _ -> false (** [is_infer_undefined pn] returns true if [pn] is a special Infer undefined proc *) let is_infer_undefined pn = match pn with | JAVA j -> let regexp = Str.regexp "com.facebook.infer.models.InferUndefined" in Str.string_match regexp (java_get_class pn) 0 | _ -> (* TODO: add cases for obj-c, c, c++ *) false (** to_string for C_FUNCTION and STATIC types *) let to_readable_string (c1, c2) verbose = let plain = c1 in if verbose then match c2 with | None -> plain | Some s -> plain ^ "{" ^ s ^ "}" else plain let c_method_to_string osig detail_level = match detail_level with | SIMPLE -> osig.method_name | NON_VERBOSE -> osig.class_name ^ "_" ^ osig.method_name | VERBOSE -> let m_str = match osig.mangled with | None -> "" | Some s -> "{" ^ s ^ "}" in osig.class_name ^ "_" ^ osig.method_name ^ m_str (** Very verbose representation of an existing Procname.t *) let to_unique_id pn = match pn with | JAVA j -> java_to_string j VERBOSE | C_FUNCTION (c1, c2) -> to_readable_string (c1, c2) true | STATIC (s1, s2) -> to_readable_string (s1, s2) true | C_METHOD osig -> c_method_to_string osig VERBOSE | OBJC_BLOCK name -> name (** Convert a proc name to a string for the user to see *) let to_string p = match p with | JAVA j -> (java_to_string j NON_VERBOSE) | C_FUNCTION (c1, c2) | STATIC (c1, c2) -> to_readable_string (c1, c2) false | C_METHOD osig -> c_method_to_string osig NON_VERBOSE | OBJC_BLOCK name -> name (** Convenient representation of a procname for external tools (e.g. eclipse plugin) *) let to_simplified_string ?(withclass = false) p = match p with | JAVA j -> (java_to_string ~withclass j SIMPLE) | C_FUNCTION (c1, c2) | STATIC (c1, c2) -> to_readable_string (c1, c2) false ^ "()" | C_METHOD osig -> c_method_to_string osig SIMPLE | OBJC_BLOCK name -> "block" (** Convert a proc name to a filename *) let to_filename (pn : proc_name) = let cutoff_length = 100 in (** if longer than cutoff, cut it and append CRC *) let name = to_unique_id pn in if String.length name <= cutoff_length then name else let pname_first_100 = String.sub name 0 cutoff_length in let crc_str = CRC.crc16 name in pname_first_100 ^ crc_str (** Pretty print a proc name *) let pp f pn = F.fprintf f "%s" (to_string pn) (** Compare function for Procname.t types *) (* These rules create an ordered set of procnames grouped with the following priority (lowest to highest): *) (* JAVA, C_FUNCTION, STATIC, OBJC *) let compare pn1 pn2 = match pn1, pn2 with | JAVA j1, JAVA j2 -> java_sig_compare j1 j2 | JAVA _, _ -> -1 | _, JAVA _ -> 1 | C_FUNCTION (c1, c2), C_FUNCTION (c3, c4) -> (* Compare C_FUNCTION types *) let n = string_compare c1 c3 in if n <> 0 then n else mangled_compare c2 c4 | C_FUNCTION _, _ -> -1 | _, C_FUNCTION _ -> 1 | STATIC (c1, c2), STATIC (c3, c4) -> (* Compare STATIC types *) let n = string_compare c1 c3 in if n <> 0 then n else mangled_compare c2 c4 | STATIC _, _ -> -1 | _, STATIC _ -> 1 | OBJC_BLOCK s1, OBJC_BLOCK s2 -> (* Compare OBJC_BLOCK types *) string_compare s1 s2 | OBJC_BLOCK _, _ -> -1 | _, OBJC_BLOCK _ -> 1 | C_METHOD osig1, C_METHOD osig2 -> c_meth_sig_compare osig1 osig2 let equal pn1 pn2 = compare pn1 pn2 = 0 (** hash function for procname *) let hash_pname = Hashtbl.hash module Hash = Hashtbl.Make(struct type t = proc_name let equal = equal let hash = hash_pname end) module Map = Map.Make (struct type t = proc_name let compare = compare end) module Set = Set.Make(struct type t = proc_name let compare = compare end) (** Pretty print a set of proc names *) let pp_set fmt set = Set.iter (fun pname -> F.fprintf fmt "%a " pp pname) set