@ -19,8 +19,8 @@ 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 packag e *)
type java _signature = {
(* java procedure nam e *)
type java = {
class_name : java_type ;
return_type : java_type option ; (* option because constructors have no return type *)
method_name : string ;
@ -42,22 +42,26 @@ let objc_method_kind_of_bool is_instance =
else Class_objc_method
(* C++/ObjC method signature *)
type c_method_signature = {
type obj c_cpp_ method = {
class_name : string ;
method_name : string ;
mangled : string option ;
}
type block = string
type c_function = string * ( string option )
type t =
| Java_method of java_signature
| Java of java
(* a pair ( plain, mangled optional ) for standard C function *)
| C _function of string * ( string option )
| C of c_function
(* structure with class name and method name for methods in Objective C and C++ *)
| ObjC_Cpp _method of c_method_signature
| ObjC_Cpp of obj c_cpp_ method
| ObjC_block of string
| Block of block
(* Defines the level of verbosity of some to_string functions *)
type detail_level =
@ -66,7 +70,7 @@ type detail_level =
| Simple
let empty = ObjC_b lock " "
let empty = B lock " "
let is_verbose v =
@ -132,13 +136,13 @@ let java_return_type_compare jr1 jr2 =
| Some _ , None -> 1
| Some jt1 , Some jt2 -> java_type_compare jt1 jt2
(* * Compare java signatur es. *)
let java_ sig_ compare ( j s 1: java _signature ) ( j s 2 : java _signature ) =
string_compare j s 1. method_name j s 2. method_name
| > next java_type_list_compare j s 1. parameters j s 2. parameters
| > next java_type_compare j s 1. class_name j s 2. class_name
| > next java_return_type_compare j s 1. return_type j s 2. return_type
| > next method_kind_compare j s 1. kind j s 2. kind
(* * Compare java procedure nam es. *)
let java_ compare ( j 1: java ) ( j 2 : java ) =
string_compare j 1. method_name j 2. method_name
| > next java_type_list_compare j 1. parameters j 2. parameters
| > next java_type_compare j 1. class_name j 2. class_name
| > next java_return_type_compare j 1. return_type j 2. return_type
| > next method_kind_compare j 1. kind j 2. kind
let c_function_mangled_compare mangled1 mangled2 =
match mangled1 , mangled2 with
@ -159,23 +163,22 @@ let c_meth_sig_compare osig1 osig2 =
let split_classname package_classname =
string_split_character package_classname '.'
let from_string_c_fun ( s : string ) = C _function ( s , None )
let from_string_c_fun ( s : string ) = C ( s , None )
let mangled_c_fun ( plain : string ) ( mangled : string ) = C _function ( plain , Some mangled )
let mangled_c_fun ( plain : string ) ( mangled : string ) = C ( plain , Some 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_method {
class_name = class_name ;
return_type = ret_type ;
method_name = method_name ;
parameters = params ;
kind = _ kind
let java class_name return_type method_name parameters kind =
{
class_name ;
return_type ;
method_name ;
parameters ;
kind ;
}
(* * Create an objc procedure name from a class_name and method_name. *)
let mangled_c_method class_name method_name mangled =
ObjC_Cpp _method {
ObjC_Cpp {
class_name = class_name ;
method_name = method_name ;
mangled = mangled ;
@ -183,99 +186,115 @@ let mangled_c_method class_name method_name mangled =
(* * Create an objc procedure name from a class_name and method_name. *)
let mangled_objc_block name =
ObjC_b lock name
B lock name
let is_java = function
| Java _method _ -> true
| Java _ -> true
| _ -> false
let is_c_method = function
| ObjC_Cpp _method _ -> true
| ObjC_Cpp _ -> true
| _ -> false
(* * Replace package and classname of a java procname. *)
let java_replace_class p package_classname =
match p with
| Java_method j -> Java_method { j with class_name = ( split_classname package_classname ) }
| _ -> assert false
| Java j ->
Java { j with class_name = ( split_classname package_classname ) }
| _ ->
Utils . assert_false _ _ POS__
(* * Replace the class name of an objc procedure name. *)
let c_method_replace_class t class_name =
match t with
| ObjC_Cpp_method osig -> ObjC_Cpp_method { osig with class_name = class_name }
| _ -> assert false
| ObjC_Cpp osig ->
ObjC_Cpp { osig with class_name = class_name }
| _ ->
Utils . assert_false _ _ POS__
(* * Get the class name of a Objective-C/C++ procedure name. *)
let c_get_class t =
match t with
| ObjC_Cpp_method osig -> osig . class_name
| _ -> assert false
| ObjC_Cpp osig ->
osig . class_name
| _ ->
Utils . assert_false _ _ POS__
(* * Return the package.classname of a java procname. *)
let java_get_class = function
| Java_method j -> java_type_to_string j . class_name
| _ -> assert false
let java_get_class ( j : java ) =
java_type_to_string j . class_name
(* * Return the class name of a java procedure name. *)
let java_get_simple_class = function
| Java_method j -> snd j . class_name
| _ -> assert false
let java_get_simple_class ( j : java ) =
snd j . class_name
(* * Return the package of a java procname. *)
let java_get_package = function
| Java_method j -> fst j . class_name
| _ -> assert false
let java_get_package ( j : java ) =
fst j . class_name
(* * Return the method of a java procname. *)
let java_get_method = function
| Java_method j -> j . method_name
| _ -> assert false
let java_get_method ( j : java ) =
j . method_name
(* * Replace the method of a java procname. *)
let java_replace_method j mname = match j with
| Java_method j -> Java_method { j with method_name = mname }
| _ -> assert false
| Java j ->
Java { j with method_name = mname }
| _ ->
Utils . assert_false _ _ POS__
(* * Replace the return type of a java procname. *)
let java_replace_return_type p ret_type = match p with
| Java_method j -> Java_method { j with return_type = Some ret_type }
| _ -> assert false
| Java j ->
Java { j with return_type = Some ret_type }
| _ ->
Utils . assert_false _ _ POS__
(* * Replace the parameters of a java procname. *)
let java_replace_parameters p parameters = match p with
| Java_method j -> Java_method { j with parameters }
| _ -> assert false
| Java j ->
Java { j with parameters }
| _ ->
Utils . assert_false _ _ POS__
(* * Return the method of a objc/c++ procname. *)
let c_get_method = function
| ObjC_Cpp_method name -> name . method_name
| C_function ( name , _ ) -> name
| ObjC_block name -> name
| _ -> assert false
| ObjC_Cpp name ->
name . method_name
| C ( name , _ ) ->
name
| Block name ->
name
| _ ->
Utils . assert_false _ _ POS__
(* * Return the return type of a java procname. *)
let java_get_return_type = function
| Java_method j -> java_return_type_to_string j Verbose
| _ -> assert false
let java_get_return_type ( j : java ) =
java_return_type_to_string j Verbose
(* * Return the parameters of a java procname. *)
let java_get_parameters = function
| Java_method j -> j . parameters
| _ -> assert false
| Java j ->
j . parameters
| _ ->
Utils . assert_false _ _ POS__
(* * Return the parameters of a java procname as strings. *)
let java_get_parameters_as_strings = function
| Java _method j ->
| Java j ->
IList . map ( fun param -> java_type_to_string param ) j . parameters
| _ -> assert false
| _ ->
Utils . assert_false _ _ POS__
(* * Return true if the java procedure is static *)
let java_is_static = function
| Java_method j -> j . kind = Static
| _ -> assert false
| Java j ->
j . kind = Static
| _ ->
Utils . assert_false _ _ POS__
(* * Prints a string of a java procname with the given level of verbosity *)
let java_to_string ? ( withclass = false ) ( j : java _signature ) verbosity =
let java_to_string ? ( withclass = false ) ( j : java ) verbosity =
match verbosity with
| Verbose | Non_verbose ->
(* if verbose, then package.class.method ( params ) : rtype,
@ -303,7 +322,7 @@ let java_to_string ?(withclass = false) (j : java_signature) verbosity =
| _ -> " ... " in
let method_name =
if j . method_name = " <init> " then
java_get_simple_class ( Java_method j )
java_get_simple_class j
else
cls_prefix ^ j . method_name in
method_name ^ " ( " ^ params ^ " ) "
@ -319,25 +338,25 @@ let is_anonymous_inner_class_name class_name =
(* * Check if the procedure belongs to an anonymous inner class. *)
let java_is_anonymous_inner_class = function
| Java _method j -> is_anonymous_inner_class_name ( snd j . class_name )
| Java j -> is_anonymous_inner_class_name ( snd j . class_name )
| _ -> 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 _method js ->
| Java js ->
( match IList . rev js . parameters with
| ( _ , s ) :: par' ->
if is_anonymous_inner_class_name s
then Some ( Java _method { js with parameters = IList . rev par' } )
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 _method js ->
| Java js ->
let _ , name = js . class_name in
is_anonymous_inner_class_name name
| _ -> false
@ -345,7 +364,7 @@ let java_is_anonymous_inner_class_constructor = function
(* * 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 _method js ->
| Java js ->
( match string_split_character js . method_name '$' with
| Some " access " , s ->
let is_int =
@ -357,7 +376,7 @@ let java_is_access_method = function
(* * 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 _method js ->
| Java js ->
begin
match ( IList . rev js . parameters ) with
| ( _ , " java.lang.Object[] " ) :: _ -> true
@ -367,31 +386,31 @@ let java_is_vararg = function
(* * [is_constructor pname] returns true if [pname] is a constructor *)
let is_constructor = function
| Java _method js -> js . method_name = " <init> "
| ObjC_Cpp _method name ->
| Java js -> js . method_name = " <init> "
| ObjC_Cpp name ->
( name . method_name = " new " ) | |
string_is_prefix " init " name . method_name
| _ -> false
(* * [is_objc_dealloc pname] returns true if [pname] is the dealloc method in Objective-C *)
let is_objc_dealloc = function
| ObjC_Cpp _method name -> name . method_name = " dealloc "
| ObjC_Cpp name -> name . method_name = " dealloc "
| _ -> false
let java_is_close = function
| Java _method js -> js . method_name = " close "
| Java js -> js . method_name = " close "
| _ -> false
(* * [is_class_initializer pname] returns true if [pname] is a class initializer *)
let is_class_initializer = function
| Java _method js -> js . method_name = " <clinit> "
| Java js -> js . method_name = " <clinit> "
| _ -> false
(* * [is_infer_undefined pn] returns true if [pn] is a special Infer undefined proc *)
let is_infer_undefined pn = match pn with
| Java _method _ ->
| Java j ->
let regexp = Str . regexp " com.facebook.infer.models.InferUndefined " in
Str . string_match regexp ( java_get_class pn ) 0
Str . string_match regexp ( java_get_class j ) 0
| _ ->
(* TODO: add cases for obj-c, c, c++ *)
false
@ -419,28 +438,31 @@ let c_method_to_string osig detail_level =
(* * Very verbose representation of an existing Procname.t *)
let to_unique_id pn =
match pn with
| Java _method j -> java_to_string j Verbose
| C _function ( c1 , c2 ) -> to_readable_string ( c1 , c2 ) true
| ObjC_Cpp _method osig -> c_method_to_string osig Verbose
| ObjC_b lock name -> name
| Java j -> java_to_string j Verbose
| C ( c1 , c2 ) -> to_readable_string ( c1 , c2 ) true
| ObjC_Cpp osig -> c_method_to_string osig Verbose
| B lock name -> name
(* * Convert a proc name to a string for the user to see *)
let to_string p =
match p with
| Java _method j -> ( java_to_string j Non_verbose )
| C _function ( c1 , c2 ) ->
| Java j -> ( java_to_string j Non_verbose )
| C ( c1 , c2 ) ->
to_readable_string ( c1 , c2 ) false
| ObjC_Cpp _method osig -> c_method_to_string osig Non_verbose
| ObjC_b lock name -> name
| ObjC_Cpp osig -> c_method_to_string osig Non_verbose
| B lock 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_method j -> ( java_to_string ~ withclass j Simple )
| C_function ( c1 , c2 ) ->
| Java j ->
( java_to_string ~ withclass j Simple )
| C ( c1 , c2 ) ->
to_readable_string ( c1 , c2 ) false ^ " () "
| ObjC_Cpp_method osig -> c_method_to_string osig Simple
| ObjC_block _ -> " block "
| ObjC_Cpp osig ->
c_method_to_string osig Simple
| Block _ ->
" block "
(* * Convert a proc name to a filename *)
let to_filename ( pn : proc_name ) =
@ -450,22 +472,31 @@ let to_filename (pn : 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 ) : *)
(* * Compare function for Procname.t types.
These rules create an ordered set of procnames grouped with the following
priority ( lowest to highest ) : * )
let compare pn1 pn2 = match pn1 , pn2 with
| Java_method j1 , Java_method j2 -> java_sig_compare j1 j2
| Java_method _ , _ -> - 1
| _ , Java_method _ -> 1
| C_function ( c1 , c2 ) , C_function ( c3 , c4 ) -> (* Compare C_function types *)
| Java j1 , Java j2 ->
java_compare j1 j2
| Java _ , _ ->
- 1
| _ , Java _ ->
1
| C ( c1 , c2 ) , C ( c3 , c4 ) -> (* Compare C_function types *)
string_compare c1 c3
| > next mangled_compare c2 c4
| C_function _ , _ -> - 1
| _ , C_function _ -> 1
| ObjC_block s1 , ObjC_block s2 -> (* Compare ObjC_block types *)
| C _ , _ ->
- 1
| _ , C _ ->
1
| Block s1 , Block s2 -> (* Compare ObjC_block types *)
string_compare s1 s2
| ObjC_block _ , _ -> - 1
| _ , ObjC_block _ -> 1
| ObjC_Cpp_method osig1 , ObjC_Cpp_method osig2 -> c_meth_sig_compare osig1 osig2
| Block _ , _ ->
- 1
| _ , Block _ ->
1
| ObjC_Cpp osig1 , ObjC_Cpp osig2 ->
c_meth_sig_compare osig1 osig2
let equal pn1 pn2 =
compare pn1 pn2 = 0