From 3d181bd8313b22ba2ac2ac98ae6db8975bb892d7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ezgi=20=C3=87i=C3=A7ek?= Date: Tue, 26 Nov 2019 05:33:29 -0800 Subject: [PATCH] [infer] Polymorphic value type for `FuncArg` Reviewed By: jvillard Differential Revision: D18706143 fbshipit-source-id: 96c91db77 --- infer/src/IR/ProcnameDispatcher.ml | 356 +++++++++++------- infer/src/IR/ProcnameDispatcher.mli | 216 ++++++----- .../bufferoverrun/bufferOverrunAnalysis.ml | 3 +- .../src/bufferoverrun/bufferOverrunChecker.ml | 2 +- .../src/bufferoverrun/bufferOverrunModels.ml | 7 +- .../bufferoverrun/bufferOverrunTypModels.ml | 2 +- infer/src/checkers/cost.ml | 2 +- infer/src/checkers/costModels.ml | 4 +- infer/src/checkers/hoisting.ml | 2 +- infer/src/checkers/purityModels.ml | 2 +- infer/src/opensource/FbCostModels.ml | 2 +- infer/src/opensource/FbCostModels.mli | 2 +- infer/src/pulse/PulseModels.ml | 2 +- 13 files changed, 355 insertions(+), 247 deletions(-) diff --git a/infer/src/IR/ProcnameDispatcher.ml b/infer/src/IR/ProcnameDispatcher.ml index 102fcd964..dd93f0d81 100644 --- a/infer/src/IR/ProcnameDispatcher.ml +++ b/infer/src/IR/ProcnameDispatcher.ml @@ -65,7 +65,7 @@ let templated_name_of_java java = (* Intermediate matcher types *) -type ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher = +type ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, 'value) name_matcher = { on_objc_cpp: 'context -> 'f_in -> objc_cpp -> ('f_out * 'captured_types capt) option ; on_qual_name: 'context -> 'f_in -> qual_name -> ('f_out * 'captured_types capt) option ; get_markers: 'markers_in -> 'markers_out } @@ -89,7 +89,8 @@ type ( 'context , 'captured_types , 'markers_in , 'markers_out - , 'list_constraint ) + , 'list_constraint + , 'value ) templ_matcher = { on_objc_cpp: 'context @@ -109,7 +110,15 @@ type ('context, 'f_in, 'f_out, 'captured_types, 'emptyness) path_extra = {on_objc_cpp: 'context -> 'f_in -> objc_cpp -> ('f_out * 'captured_types capt) option} -> ('context, 'f_in, 'f_out, 'captured_types, non_empty) path_extra -type ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, 'emptyness) path_matcher = +type ( 'context + , 'f_in + , 'f_out + , 'captured_types + , 'markers_in + , 'markers_out + , 'emptyness + , 'value ) + path_matcher = { on_templated_name: 'context -> 'f_in -> templated_name -> ('f_out * 'captured_types capt) option ; path_extra: ('context, 'f_in, 'f_out, 'captured_types, 'emptyness) path_extra ; get_markers: 'markers_in -> 'markers_out } @@ -118,7 +127,7 @@ type typ_matcher = typ -> bool (* Combinators *) -let empty : ('context, 'f, 'f, unit, 'markers, 'markers, empty) path_matcher = +let empty : ('context, 'f, 'f, unit, 'markers, 'markers, empty, 'value) path_matcher = let get_markers m = m in let get_capture () = () in let on_templated_name _context f (qual_name, template_args) = @@ -134,9 +143,9 @@ let empty : ('context, 'f, 'f, unit, 'markers, 'markers, empty) path_matcher = let name_cons : - ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, _) path_matcher + ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, _, 'value) path_matcher -> string - -> ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher = + -> ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, 'value) name_matcher = fun m name -> let {on_templated_name; get_markers} = m in let match_fuzzy_name = @@ -159,9 +168,9 @@ let name_cons : let name_cons_f : - ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, _) path_matcher + ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, _, 'value) path_matcher -> ('context -> string -> bool) - -> ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher = + -> ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, 'value) name_matcher = fun m f_name -> let {on_templated_name; get_markers} = m in let on_qual_name context f qual_name = @@ -180,9 +189,24 @@ let name_cons_f : let all_names_cons : - ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, non_empty) path_matcher - -> ('context, 'f_in, 'f_out, 'captured_tpes, 'markers_in, 'markers_out, non_empty) path_matcher - = + ( 'context + , 'f_in + , 'f_out + , 'captured_types + , 'markers_in + , 'markers_out + , non_empty + , 'value ) + path_matcher + -> ( 'context + , 'f_in + , 'f_out + , 'captured_tpes + , 'markers_in + , 'markers_out + , non_empty + , 'value ) + path_matcher = fun m -> let {on_templated_name; get_markers; path_extra= PathNonEmpty {on_objc_cpp}} = m in let rec on_templated_name_rec context f templated_name = @@ -209,14 +233,15 @@ let all_names_cons : let templ_begin : - ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher + ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, 'value) name_matcher -> ( 'context , 'f_in , 'f_out , 'captured_types , 'markers_in , 'markers_out - , accept_more ) + , accept_more + , 'value ) templ_matcher = fun m -> let {on_objc_cpp; on_qual_name; get_markers} = m in @@ -245,7 +270,8 @@ let templ_cons : , 'captured_types_in , 'markers_interm , 'markers_out - , accept_more ) + , accept_more + , 'value ) templ_matcher -> ( 'f_interm , 'f_out @@ -255,8 +281,15 @@ let templ_cons : , 'markers_interm , 'lc ) template_arg - -> ('context, 'f_in, 'f_out, 'captured_types_out, 'markers_in, 'markers_out, 'lc) templ_matcher - = + -> ( 'context + , 'f_in + , 'f_out + , 'captured_types_out + , 'markers_in + , 'markers_out + , 'lc + , 'value ) + templ_matcher = fun m template_arg -> let {on_objc_cpp; on_templated_name; get_markers} = m in let {eat_template_arg; add_marker} = template_arg in @@ -271,9 +304,16 @@ let templ_cons : let templ_end : - ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, _) templ_matcher - -> ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, non_empty) path_matcher - = + ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, _, 'value) templ_matcher + -> ( 'context + , 'f_in + , 'f_out + , 'captured_types + , 'markers_in + , 'markers_out + , non_empty + , 'value ) + path_matcher = let match_empty_templ_args (f, captured_types, template_args) = match template_args with [] -> Some (f, captured_types) | _ -> None in @@ -289,11 +329,11 @@ let templ_end : module type Common = sig - type ('context, 'f) matcher + type ('context, 'f, 'value) matcher - type ('context, 'f) dispatcher + type ('context, 'f, 'value) dispatcher - val make_dispatcher : ('context, 'f) matcher list -> ('context, 'f) dispatcher + val make_dispatcher : ('context, 'f, 'value) matcher list -> ('context, 'f, 'value) dispatcher (* Template arguments *) @@ -335,11 +375,12 @@ module type Common = sig template_arg (** Captures all template args *) - val ( ~- ) : string -> ('context, 'f, 'f, unit, 'markers, 'markers) name_matcher + val ( ~- ) : string -> ('context, 'f, 'f, unit, 'markers, 'markers, 'value) name_matcher (** Starts a path with a name *) val ( ~+ ) : - ('context -> string -> bool) -> ('context, 'f, 'f, unit, 'markers, 'markers) name_matcher + ('context -> string -> bool) + -> ('context, 'f, 'f, unit, 'markers, 'markers, 'value) name_matcher (** Starts a path with a matching name that satisfies the given function *) val ( &+ ) : @@ -349,7 +390,8 @@ module type Common = sig , 'captured_types_in , 'markers_interm , 'markers_out - , accept_more ) + , accept_more + , 'value ) templ_matcher -> ( 'f_interm , 'f_out @@ -359,11 +401,26 @@ module type Common = sig , 'markers_interm , 'lc ) template_arg - -> ('context, 'f_in, 'f_out, 'captured_types_out, 'markers_in, 'markers_out, 'lc) templ_matcher + -> ( 'context + , 'f_in + , 'f_out + , 'captured_types_out + , 'markers_in + , 'markers_out + , 'lc + , 'value ) + templ_matcher (** Separate template arguments *) val ( < ) : - ('context, 'f_in, 'f_interm, 'captured_types_in, 'markers_interm, 'markers_out) name_matcher + ( 'context + , 'f_in + , 'f_interm + , 'captured_types_in + , 'markers_interm + , 'markers_out + , 'value ) + name_matcher -> ( 'f_interm , 'f_out , 'captured_types_in @@ -372,19 +429,27 @@ module type Common = sig , 'markers_interm , 'lc ) template_arg - -> ('context, 'f_in, 'f_out, 'captured_types_out, 'markers_in, 'markers_out, 'lc) templ_matcher + -> ( 'context + , 'f_in + , 'f_out + , 'captured_types_out + , 'markers_in + , 'markers_out + , 'lc + , 'value ) + templ_matcher (** Starts template arguments after a name *) val ( >:: ) : - ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, _) templ_matcher + ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, _, 'value) templ_matcher -> string - -> ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher + -> ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, 'value) name_matcher (** Ends template arguments and starts a name *) val ( >::+ ) : - ('a, 'b, 'c, 'd, 'e, 'f, 'g) templ_matcher + ('a, 'b, 'c, 'd, 'e, 'f, 'g, 'h) templ_matcher -> ('a -> string -> bool) - -> ('a, 'b, 'c, 'd, 'e, 'f) name_matcher + -> ('a, 'b, 'c, 'd, 'e, 'f, 'h) name_matcher val ( &+...>:: ) : ( 'context @@ -393,27 +458,28 @@ module type Common = sig , 'captured_types , 'markers_in , 'markers_out - , accept_more ) + , accept_more + , 'value ) templ_matcher -> string - -> ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher + -> ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, 'value) name_matcher (** Ends template arguments with eats-ALL and starts a name *) val ( &:: ) : - ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher + ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, 'value) name_matcher -> string - -> ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher + -> ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, 'value) name_matcher (** Separates names (accepts ALL template arguments on the left one) *) val ( &::+ ) : - ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher + ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, 'value) name_matcher -> ('context -> string -> bool) - -> ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher + -> ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, 'value) name_matcher val ( <>:: ) : - ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher + ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, 'value) name_matcher -> string - -> ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher + -> ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, 'value) name_matcher (** Separates names (accepts NO template arguments on the left one) *) end @@ -529,16 +595,12 @@ module Common = struct let ( <>:: ) name_matcher name = name_matcher :: name end -module type VALUE = sig - type t -end - -module MakeCall (Val : VALUE) = struct +module Call = struct include Common (** Little abstraction over arguments: currently actual args, we'll want formal args later *) module FuncArg = struct - type t = {exp: Exp.t; typ: Typ.t; value: Val.t} + type 'value t = {exp: Exp.t; typ: Typ.t; value: 'value} let typ {typ} = typ @@ -559,64 +621,75 @@ module MakeCall (Val : VALUE) = struct ; on_c: 'context -> 'f_in -> c -> ('f_out * 'captured_types) option ; on_java: 'context -> 'f_in -> java -> ('f_out * 'captured_types) option } - type ('context, 'f_in, 'f_out, 'captured_types) on_args = - 'context -> 'captured_types -> 'f_in * FuncArg.t list -> ('f_out * FuncArg.t list) option + type ('context, 'f_in, 'f_out, 'captured_types, 'value) on_args = + 'context + -> 'captured_types + -> 'f_in * 'value FuncArg.t list + -> ('f_out * 'value FuncArg.t list) option - type ('context, 'f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers) args_matcher = + type ('context, 'f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers, 'value) args_matcher = { on_proc: ('context, 'f_in, 'f_proc_out, 'captured_types) proc_matcher - ; on_args: ('context, 'f_proc_out, 'f_out, 'captured_types) on_args + ; on_args: ('context, 'f_proc_out, 'f_out, 'captured_types, 'value) on_args ; markers: 'markers } - type ('context, 'captured_types, 'markers) one_arg_matcher = - { match_arg: 'context -> 'captured_types -> FuncArg.t -> bool + type ('context, 'captured_types, 'markers, 'value) one_arg_matcher = + { match_arg: 'context -> 'captured_types -> 'value FuncArg.t -> bool ; marker_static_checker: 'markers -> bool } - type ('arg_in, 'arg_out, 'f_in, 'f_out) arg_capture = - {get_captured_value: FuncArg.t -> 'arg_in; do_capture: 'f_in -> 'arg_out -> 'f_out} + type ('arg_in, 'arg_out, 'f_in, 'f_out, 'value) arg_capture = + {get_captured_value: 'value FuncArg.t -> 'arg_in; do_capture: 'f_in -> 'arg_out -> 'f_out} - type ('context, 'arg_in, 'arg_out, 'f_in, 'f_out, 'captured_types, 'markers) one_arg = - { one_arg_matcher: ('context, 'captured_types, 'markers) one_arg_matcher - ; capture: ('arg_in, 'arg_out, 'f_in, 'f_out) arg_capture } + type ('context, 'arg_in, 'arg_out, 'f_in, 'f_out, 'captured_types, 'markers, 'value) one_arg = + { one_arg_matcher: ('context, 'captured_types, 'markers, 'value) one_arg_matcher + ; capture: ('arg_in, 'arg_out, 'f_in, 'f_out, 'value) arg_capture } - type ('arg_in, 'arg_out, 'f_in, 'f_out) arg_preparer = - { on_empty: ('f_in -> 'arg_out -> 'f_out) -> 'f_in -> ('f_out * FuncArg.t list) option + type ('arg_in, 'arg_out, 'f_in, 'f_out, 'value) arg_preparer = + { on_empty: ('f_in -> 'arg_out -> 'f_out) -> 'f_in -> ('f_out * 'value FuncArg.t list) option ; wrapper: 'arg_in -> 'arg_out } - type ('context, 'f_in, 'f_out, 'captured_types, 'markers) func_arg = - { eat_func_arg: ('context, 'f_in, 'f_out, 'captured_types) on_args + type ('context, 'f_in, 'f_out, 'captured_types, 'markers, 'value) func_arg = + { eat_func_arg: ('context, 'f_in, 'f_out, 'captured_types, 'value) on_args ; marker_static_checker: 'markers -> bool } - type ('context, 'f) matcher = - { on_objc_cpp: 'context -> objc_cpp -> FuncArg.t list -> 'f option - ; on_c: 'context -> c -> FuncArg.t list -> 'f option - ; on_java: 'context -> java -> FuncArg.t list -> 'f option } + type ('context, 'f, 'value) matcher = + { on_objc_cpp: 'context -> objc_cpp -> 'value FuncArg.t list -> 'f option + ; on_c: 'context -> c -> 'value FuncArg.t list -> 'f option + ; on_java: 'context -> java -> 'value FuncArg.t list -> 'f option } - type ('context, 'f) pre_result = + type ('context, 'f, 'value) pre_result = | DoesNotMatch | Matches of 'f - | RetryWith of ('context, 'f) matcher + | RetryWith of ('context, 'f, 'value) matcher let pre_bind_opt opt ~f = match opt with None -> DoesNotMatch | Some x -> f x let pre_map_opt opt ~f = match opt with None -> DoesNotMatch | Some x -> Matches (f x) - type ('context, 'f_in, 'f_out, 'captured_types) func_args_end = - on_args:('context, 'f_in, 'f_out, 'captured_types) on_args + type ('context, 'f_in, 'f_out, 'captured_types, 'value) func_args_end = + on_args:('context, 'f_in, 'f_out, 'captured_types, 'value) on_args -> 'context - -> FuncArg.t list + -> 'value FuncArg.t list -> 'f_in * 'captured_types - -> ('context, 'f_out) pre_result - - type ('context, 'f_in, 'f_out) all_args_matcher = - { on_objc_cpp: 'context -> 'f_in -> objc_cpp -> FuncArg.t list -> ('context, 'f_out) pre_result - ; on_c: 'context -> 'f_in -> c -> FuncArg.t list -> ('context, 'f_out) pre_result - ; on_java: 'context -> 'f_in -> java -> FuncArg.t list -> ('context, 'f_out) pre_result } - - type ('context, 'f) dispatcher = 'context -> Typ.Procname.t -> FuncArg.t list -> 'f option + -> ('context, 'f_out, 'value) pre_result + + type ('context, 'f_in, 'f_out, 'value) all_args_matcher = + { on_objc_cpp: + 'context + -> 'f_in + -> objc_cpp + -> 'value FuncArg.t list + -> ('context, 'f_out, 'value) pre_result + ; on_c: 'context -> 'f_in -> c -> 'value FuncArg.t list -> ('context, 'f_out, 'value) pre_result + ; on_java: + 'context -> 'f_in -> java -> 'value FuncArg.t list -> ('context, 'f_out, 'value) pre_result + } + + type ('context, 'f, 'value) dispatcher = + 'context -> Typ.Procname.t -> 'value FuncArg.t list -> 'f option let args_begin : - ('context, 'f_in, 'f_out, 'captured_types, unit, 'markers, non_empty) path_matcher - -> ('context, 'f_in, 'f_out, 'f_out, 'captured_types, 'markers) args_matcher = + ('context, 'f_in, 'f_out, 'captured_types, unit, 'markers, non_empty, 'value) path_matcher + -> ('context, 'f_in, 'f_out, 'f_out, 'captured_types, 'markers, 'value) args_matcher = let on_args _context _capt f_args = Some f_args in fun m -> let {on_templated_name; path_extra= PathNonEmpty {on_objc_cpp}; get_markers} = m in @@ -637,9 +710,9 @@ module MakeCall (Val : VALUE) = struct let args_cons : - ('context, 'f_in, 'f_proc_out, 'f_interm, 'captured_types, 'markers) args_matcher - -> ('context, 'f_interm, 'f_out, 'captured_types, 'markers) func_arg - -> ('context, 'f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers) args_matcher = + ('context, 'f_in, 'f_proc_out, 'f_interm, 'captured_types, 'markers, 'value) args_matcher + -> ('context, 'f_interm, 'f_out, 'captured_types, 'markers, 'value) func_arg + -> ('context, 'f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers, 'value) args_matcher = fun m func_arg -> let {on_proc; on_args; markers} = m in let {marker_static_checker; eat_func_arg} = func_arg in @@ -651,9 +724,9 @@ module MakeCall (Val : VALUE) = struct let args_end : - ('context, 'f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers) args_matcher - -> ('context, 'f_proc_out, 'f_out, 'captured_types) func_args_end - -> ('context, 'f_in, 'f_out) all_args_matcher = + ('context, 'f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers, 'value) args_matcher + -> ('context, 'f_proc_out, 'f_out, 'captured_types, 'value) func_args_end + -> ('context, 'f_in, 'f_out, 'value) all_args_matcher = fun m func_args_end -> let {on_proc= {on_c; on_java; on_objc_cpp}; on_args} = m in let on_c context f c args = @@ -669,9 +742,11 @@ module MakeCall (Val : VALUE) = struct let make_matcher : - ('context, 'f_in, 'f_out) all_args_matcher -> 'f_in -> ('context, 'f_out) matcher = + ('context, 'f_in, 'f_out, 'value) all_args_matcher + -> 'f_in + -> ('context, 'f_out, 'value) matcher = fun m f -> - let ({on_c; on_java; on_objc_cpp} : (_, _, _) all_args_matcher) = m in + let ({on_c; on_java; on_objc_cpp} : (_, _, _, _) all_args_matcher) = m in let on_objc_cpp context objc_cpp args = match on_objc_cpp context f objc_cpp args with | DoesNotMatch -> @@ -703,7 +778,7 @@ module MakeCall (Val : VALUE) = struct (** Simple implementation of a dispatcher, could be optimized later *) - let make_dispatcher : ('context, 'f) matcher list -> ('context, 'f) dispatcher = + let make_dispatcher : ('context, 'f, 'value) matcher list -> ('context, 'f, 'value) dispatcher = fun matchers -> let on_objc_cpp context objc_cpp args = List.find_map matchers ~f:(fun (matcher : _ matcher) -> @@ -728,7 +803,9 @@ module MakeCall (Val : VALUE) = struct let merge_dispatchers : - ('context, 'f) dispatcher -> ('context, 'f) dispatcher -> ('context, 'f) dispatcher = + ('context, 'f, 'value) dispatcher + -> ('context, 'f, 'value) dispatcher + -> ('context, 'f, 'value) dispatcher = fun dispatcher1 dispatcher2 context procname args -> match dispatcher1 context procname args with | Some _ as r -> @@ -742,7 +819,7 @@ module MakeCall (Val : VALUE) = struct let no_marker_checker _markers = true (** Matches any arg *) - let match_any_arg : (_, _, _) one_arg_matcher = + let match_any_arg : (_, _, _, _) one_arg_matcher = let match_arg _context _capt _arg = true in {match_arg; marker_static_checker= no_marker_checker} @@ -751,7 +828,7 @@ module MakeCall (Val : VALUE) = struct ('markers -> 'marker) -> ('captured_types -> 'marker mtyp) -> 'marker - -> ('context, 'captured_types, 'markers) one_arg_matcher = + -> ('context, 'captured_types, 'markers, 'value) one_arg_matcher = fun get_m get_c marker -> let marker_static_checker markers = Poly.equal marker (get_m markers) in let match_arg _context capt arg = Typ.equal (FuncArg.typ arg) (get_c capt) in @@ -759,31 +836,32 @@ module MakeCall (Val : VALUE) = struct (** Matches first captured type *) - let match_typ1 : 'marker -> ('context, 'marker mtyp * _, 'marker * _) one_arg_matcher = + let match_typ1 : 'marker -> ('context, 'marker mtyp * _, 'marker * _, _) one_arg_matcher = let pos1 (x, _) = x in fun marker -> mk_match_typ_nth pos1 pos1 marker (** Matches second captured type *) - let match_typ2 : 'marker -> ('context, _ * ('marker mtyp * _), _ * ('marker * _)) one_arg_matcher - = + let match_typ2 : + 'marker -> ('context, _ * ('marker mtyp * _), _ * ('marker * _), _) one_arg_matcher = let pos2 (_, (x, _)) = x in fun marker -> mk_match_typ_nth pos2 pos2 marker (** Matches third captured type *) let match_typ3 : - 'marker -> ('context, _ * (_ * ('marker mtyp * _)), _ * (_ * ('marker * _))) one_arg_matcher = + 'marker + -> ('context, _ * (_ * ('marker mtyp * _)), _ * (_ * ('marker * _)), 'value) one_arg_matcher = let pos3 (_, (_, (x, _))) = x in fun marker -> mk_match_typ_nth pos3 pos3 marker (** Matches the type matched by the given path_matcher *) let match_typ : - ('context, _, _, unit, unit, unit, non_empty) path_matcher -> ('context, _, _) one_arg_matcher - = + ('context, _, _, unit, unit, unit, non_empty, 'value) path_matcher + -> ('context, _, _, _) one_arg_matcher = fun m -> - let ({on_templated_name} : (_, _, _, unit, unit, unit, non_empty) path_matcher) = m in + let ({on_templated_name} : (_, _, _, unit, unit, unit, non_empty, 'value) path_matcher) = m in let rec match_typ context typ = match typ with | {Typ.desc= Tstruct name} -> @@ -807,35 +885,35 @@ module MakeCall (Val : VALUE) = struct (* Function argument capture *) (** Do not capture this argument *) - let no_capture : (_, _, 'f, 'f) arg_capture = + let no_capture : (_, _, 'f, 'f, _) arg_capture = let get_captured_value _arg = () in let do_capture f _v = f in {get_captured_value; do_capture} (** Capture the argument *) - let capture_arg : (FuncArg.t, 'wrapped_arg, 'wrapped_arg -> 'f, 'f) arg_capture = + let capture_arg : ('value FuncArg.t, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, 'value) arg_capture = let get_captured_value arg = arg in let do_capture f v = f v in {get_captured_value; do_capture} (** Capture the argument value *) - let capture_arg_val : (Val.t, 'wrapped_arg, 'wrapped_arg -> 'f, 'f) arg_capture = + let capture_arg_val : ('value, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, 'value) arg_capture = let get_captured_value arg = FuncArg.value arg in let do_capture f v = f v in {get_captured_value; do_capture} (** Capture the argument expression *) - let capture_arg_exp : (Exp.t, 'wrapped_arg, 'wrapped_arg -> 'f, 'f) arg_capture = + let capture_arg_exp : (Exp.t, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, _) arg_capture = let get_captured_value arg = FuncArg.exp arg in let do_capture f v = f v in {get_captured_value; do_capture} (** Capture the argument local var or fail *) - let capture_arg_var_exn : (Ident.t, 'wrapped_arg, 'wrapped_arg -> 'f, 'f) arg_capture = + let capture_arg_var_exn : (Ident.t, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, _) arg_capture = let get_captured_value arg = FuncArg.get_var_exn arg in let do_capture f v = f v in {get_captured_value; do_capture} @@ -854,9 +932,9 @@ module MakeCall (Val : VALUE) = struct let make_arg : - ('arg_in, 'arg_out, 'f_in, 'f_out) arg_preparer - -> ('context, 'arg_in, 'arg_out, 'f_in, 'f_out, _, _) one_arg - -> ('context, 'f_in, 'f_out, _, _) func_arg = + ('arg_in, 'arg_out, 'f_in, 'f_out, 'value) arg_preparer + -> ('context, 'arg_in, 'arg_out, 'f_in, 'f_out, _, _, 'value) one_arg + -> ('context, 'f_in, 'f_out, _, _, 'value) func_arg = fun arg_preparer one_arg -> let {on_empty; wrapper} = arg_preparer in let {one_arg_matcher; capture} = one_arg in @@ -874,23 +952,24 @@ module MakeCall (Val : VALUE) = struct {eat_func_arg; marker_static_checker} - let any_arg : ('context, unit, _, 'f, 'f, _, _) one_arg = + let any_arg : ('context, unit, _, 'f, 'f, _, _, _) one_arg = {one_arg_matcher= match_any_arg; capture= no_capture} - let capt_arg : ('context, FuncArg.t, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, _, _) one_arg = + let capt_arg : + ('context, 'value FuncArg.t, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, _, _, 'value) one_arg = {one_arg_matcher= match_any_arg; capture= capture_arg} - let capt_value : ('context, Val.t, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, _, _) one_arg = + let capt_value : ('context, 'value, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, _, _, 'value) one_arg = {one_arg_matcher= match_any_arg; capture= capture_arg_val} - let capt_exp : ('context, Exp.t, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, _, _) one_arg = + let capt_exp : ('context, Exp.t, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, _, _, _) one_arg = {one_arg_matcher= match_any_arg; capture= capture_arg_exp} - let capt_var_exn : ('context, Ident.t, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, _, _) one_arg = + let capt_var_exn : ('context, Ident.t, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, _, _, _) one_arg = {one_arg_matcher= match_any_arg; capture= capture_arg_var_exn} @@ -913,36 +992,36 @@ module MakeCall (Val : VALUE) = struct {one_arg_matcher= one_arg_matcher_of_prim_typ typ; capture= capture_arg_exp} - let typ1 : 'marker -> ('context, unit, _, 'f, 'f, _, _) one_arg = + let typ1 : 'marker -> ('context, unit, _, 'f, 'f, _, _, _) one_arg = fun m -> {one_arg_matcher= match_typ1 m; capture= no_capture} - let typ2 : 'marker -> ('context, unit, _, 'f, 'f, _, _) one_arg = + let typ2 : 'marker -> ('context, unit, _, 'f, 'f, _, _, _) one_arg = fun m -> {one_arg_matcher= match_typ2 m; capture= no_capture} - let typ3 : 'marker -> ('context, unit, _, 'f, 'f, _, _) one_arg = + let typ3 : 'marker -> ('context, unit, _, 'f, 'f, _, _, _) one_arg = fun m -> {one_arg_matcher= match_typ3 m; capture= no_capture} (* Function args end *) (** Matches if there is no function arguments left *) - let no_args_left : ('context, _, _, _) func_args_end = + let no_args_left : ('context, _, _, _, _) func_args_end = let match_empty_args = function Some (f, []) -> Matches f | _ -> DoesNotMatch in fun ~on_args context args (f, capt) -> on_args context capt (f, args) |> match_empty_args (** Matches any function arguments *) - let any_func_args : ('context, _, _, _) func_args_end = + let any_func_args : ('context, _, _, _, _) func_args_end = fun ~on_args context args (f, capt) -> on_args context capt (f, args) |> pre_map_opt ~f:fst (** If [func_args_end1] does not match, use [func_args_end2] *) let alternative_args_end : - ('context, 'f_in, 'f_out, 'captured_types) func_args_end - -> ('context, 'f_in, 'f_out, 'captured_types) func_args_end - -> ('context, 'f_in, 'f_out, 'captured_types) func_args_end = + ('context, 'f_in, 'f_out, 'captured_types, 'value) func_args_end + -> ('context, 'f_in, 'f_out, 'captured_types, 'value) func_args_end + -> ('context, 'f_in, 'f_out, 'captured_types, 'value) func_args_end = fun func_args_end1 func_args_end2 ~on_args context args f_capt -> match func_args_end1 ~on_args context args f_capt with | DoesNotMatch -> @@ -952,13 +1031,14 @@ module MakeCall (Val : VALUE) = struct (** Retries matching with another matcher *) - let args_end_retry : _ matcher -> ('context, _, _, _) func_args_end = + let args_end_retry : _ matcher -> ('context, _, _, _, _) func_args_end = fun m ~on_args:_ _context _args _f_capt -> RetryWith m (** Retries matching with another matcher if the function does not have the exact number/types of args *) - let exact_args_or_retry : ('context, 'f) matcher -> ('context, _, _, _) func_args_end = + let exact_args_or_retry : + ('context, 'f, 'value) matcher -> ('context, _, _, _, 'value) func_args_end = fun m -> alternative_args_end no_args_left (args_end_retry m) @@ -1023,24 +1103,24 @@ module type NameCommon = sig include Common val ( >--> ) : - ('context, 'f_in, 'f_out, 'captured_types, unit, 'markers, _) templ_matcher + ('context, 'f_in, 'f_out, 'captured_types, unit, 'markers, _, 'value) templ_matcher -> 'f_in - -> ('context, 'f_out) matcher + -> ('context, 'f_out, 'value) matcher val ( <>--> ) : - ('context, 'f_in, 'f_out, 'captured_types, unit, 'markers) name_matcher + ('context, 'f_in, 'f_out, 'captured_types, unit, 'markers, 'value) name_matcher -> 'f_in - -> ('context, 'f_out) matcher + -> ('context, 'f_out, 'value) matcher val ( &--> ) : - ('context, 'f_in, 'f_out, 'captured_types, unit, 'markers) name_matcher + ('context, 'f_in, 'f_out, 'captured_types, unit, 'markers, 'value) name_matcher -> 'f_in - -> ('context, 'f_out) matcher + -> ('context, 'f_out, 'value) matcher val ( &::.*--> ) : - ('context, 'f_in, 'f_out, 'captured_types, unit, 'markers) name_matcher + ('context, 'f_in, 'f_out, 'captured_types, unit, 'markers, 'value) name_matcher -> 'f_in - -> ('context, 'f_out) matcher + -> ('context, 'f_out, 'value) matcher (** After a name, accepts ALL template arguments, accepts ALL path tails (names, templates), accepts ALL function arguments, binds the function *) end @@ -1048,17 +1128,17 @@ end module NameCommon = struct include Common - type ('context, 'f) matcher = + type ('context, 'f, 'value) matcher = { on_templated_name: 'context -> templated_name -> 'f option ; on_objc_cpp: 'context -> objc_cpp -> 'f option } let make_matcher : - ('context, 'f_in, 'f_out, _, _, _, non_empty) path_matcher + ('context, 'f_in, 'f_out, _, _, _, non_empty, 'value) path_matcher -> 'f_in - -> ('context, 'f_out) matcher = + -> ('context, 'f_out, 'value) matcher = fun m f -> let ({on_templated_name; path_extra= PathNonEmpty {on_objc_cpp}} - : ('context, 'f_in, 'f_out, _, _, _, non_empty) path_matcher) = + : ('context, 'f_in, 'f_out, _, _, _, non_empty, 'value) path_matcher) = m in let on_templated_name context templated_name = @@ -1082,9 +1162,9 @@ end module ProcName = struct include NameCommon - type ('context, 'f) dispatcher = 'context -> Typ.Procname.t -> 'f option + type ('context, 'f, 'value) dispatcher = 'context -> Typ.Procname.t -> 'f option - let make_dispatcher : ('context, 'f) matcher list -> ('context, 'f) dispatcher = + let make_dispatcher : ('context, 'f, 'value) matcher list -> ('context, 'f, 'value) dispatcher = fun matchers -> let on_objc_cpp context objc_cpp = List.find_map matchers ~f:(fun (matcher : _ matcher) -> matcher.on_objc_cpp context objc_cpp) @@ -1117,9 +1197,9 @@ end module TypName = struct include NameCommon - type ('context, 'f) dispatcher = 'context -> Typ.name -> 'f option + type ('context, 'f, 'value) dispatcher = 'context -> Typ.name -> 'f option - let make_dispatcher : ('context, 'f) matcher list -> ('context, 'f) dispatcher = + let make_dispatcher : ('context, 'f, 'value) matcher list -> ('context, 'f, 'value) dispatcher = fun matchers context typname -> let templated_name = templated_name_of_class_name typname in List.find_map matchers ~f:(fun (matcher : _ matcher) -> diff --git a/infer/src/IR/ProcnameDispatcher.mli b/infer/src/IR/ProcnameDispatcher.mli index 70277bed5..bf3b5c64f 100644 --- a/infer/src/IR/ProcnameDispatcher.mli +++ b/infer/src/IR/ProcnameDispatcher.mli @@ -26,7 +26,7 @@ type 'marker mtyp = Typ.t (* Intermediate matcher types *) -type ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher +type ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, 'value) name_matcher type ( 'f_in , 'f_out @@ -43,7 +43,8 @@ type ( 'context , 'captured_types , 'markers_in , 'markers_out - , 'list_constraint ) + , 'list_constraint + , 'value ) templ_matcher (* A matcher is a rule associating a function [f] to a [C/C++ function/method]: @@ -62,11 +63,11 @@ type ( 'context *) module type Common = sig - type ('context, 'f) matcher + type ('context, 'f, 'value) matcher - type ('context, 'f) dispatcher + type ('context, 'f, 'value) dispatcher - val make_dispatcher : ('context, 'f) matcher list -> ('context, 'f) dispatcher + val make_dispatcher : ('context, 'f, 'value) matcher list -> ('context, 'f, 'value) dispatcher (** Combines matchers to create a dispatcher *) (* Template arguments *) @@ -109,11 +110,12 @@ module type Common = sig template_arg (** Captures all template args *) - val ( ~- ) : string -> ('context, 'f, 'f, unit, 'markers, 'markers) name_matcher + val ( ~- ) : string -> ('context, 'f, 'f, unit, 'markers, 'markers, 'value) name_matcher (** Starts a path with a name *) val ( ~+ ) : - ('context -> string -> bool) -> ('context, 'f, 'f, unit, 'markers, 'markers) name_matcher + ('context -> string -> bool) + -> ('context, 'f, 'f, unit, 'markers, 'markers, 'value) name_matcher (** Starts a path with a matching name that satisfies the given function *) val ( &+ ) : @@ -123,7 +125,8 @@ module type Common = sig , 'captured_types_in , 'markers_interm , 'markers_out - , accept_more ) + , accept_more + , 'value ) templ_matcher -> ( 'f_interm , 'f_out @@ -133,11 +136,26 @@ module type Common = sig , 'markers_interm , 'lc ) template_arg - -> ('context, 'f_in, 'f_out, 'captured_types_out, 'markers_in, 'markers_out, 'lc) templ_matcher + -> ( 'context + , 'f_in + , 'f_out + , 'captured_types_out + , 'markers_in + , 'markers_out + , 'lc + , 'value ) + templ_matcher (** Separate template arguments *) val ( < ) : - ('context, 'f_in, 'f_interm, 'captured_types_in, 'markers_interm, 'markers_out) name_matcher + ( 'context + , 'f_in + , 'f_interm + , 'captured_types_in + , 'markers_interm + , 'markers_out + , 'value ) + name_matcher -> ( 'f_interm , 'f_out , 'captured_types_in @@ -146,19 +164,27 @@ module type Common = sig , 'markers_interm , 'lc ) template_arg - -> ('context, 'f_in, 'f_out, 'captured_types_out, 'markers_in, 'markers_out, 'lc) templ_matcher + -> ( 'context + , 'f_in + , 'f_out + , 'captured_types_out + , 'markers_in + , 'markers_out + , 'lc + , 'value ) + templ_matcher (** Starts template arguments after a name *) val ( >:: ) : - ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, _) templ_matcher + ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, _, 'value) templ_matcher -> string - -> ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher + -> ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, 'value) name_matcher (** Ends template arguments and starts a name *) val ( >::+ ) : - ('a, 'b, 'c, 'd, 'e, 'f, 'g) templ_matcher + ('a, 'b, 'c, 'd, 'e, 'f, 'g, 'h) templ_matcher -> ('a -> string -> bool) - -> ('a, 'b, 'c, 'd, 'e, 'f) name_matcher + -> ('a, 'b, 'c, 'd, 'e, 'f, 'h) name_matcher val ( &+...>:: ) : ( 'context @@ -167,29 +193,30 @@ module type Common = sig , 'captured_types , 'markers_in , 'markers_out - , accept_more ) + , accept_more + , 'value ) templ_matcher -> string - -> ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher + -> ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, 'value) name_matcher (** Ends template arguments with eats-ALL and starts a name *) val ( &:: ) : - ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher + ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, 'value) name_matcher -> string - -> ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher + -> ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, 'value) name_matcher (** Separates names (accepts ALL template arguments on the left one) *) val ( &::+ ) : - ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher + ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, 'value) name_matcher -> ('context -> string -> bool) - -> ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher + -> ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, 'value) name_matcher (** Separates names that satisfies the given function (accepts ALL template arguments on the left one) *) val ( <>:: ) : - ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher + ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, 'value) name_matcher -> string - -> ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher + -> ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, 'value) name_matcher (** Separates names (accepts NO template arguments on the left one) *) end @@ -197,195 +224,196 @@ module type NameCommon = sig include Common val ( >--> ) : - ('context, 'f_in, 'f_out, 'captured_types, unit, 'markers, _) templ_matcher + ('context, 'f_in, 'f_out, 'captured_types, unit, 'markers, _, 'value) templ_matcher -> 'f_in - -> ('context, 'f_out) matcher + -> ('context, 'f_out, 'value) matcher val ( <>--> ) : - ('context, 'f_in, 'f_out, 'captured_types, unit, 'markers) name_matcher + ('context, 'f_in, 'f_out, 'captured_types, unit, 'markers, 'value) name_matcher -> 'f_in - -> ('context, 'f_out) matcher + -> ('context, 'f_out, 'value) matcher val ( &--> ) : - ('context, 'f_in, 'f_out, 'captured_types, unit, 'markers) name_matcher + ('context, 'f_in, 'f_out, 'captured_types, unit, 'markers, 'value) name_matcher -> 'f_in - -> ('context, 'f_out) matcher + -> ('context, 'f_out, 'value) matcher val ( &::.*--> ) : - ('context, 'f_in, 'f_out, 'captured_types, unit, 'markers) name_matcher + ('context, 'f_in, 'f_out, 'captured_types, unit, 'markers, 'value) name_matcher -> 'f_in - -> ('context, 'f_out) matcher + -> ('context, 'f_out, 'value) matcher (** After a name, accepts ALL template arguments, accepts ALL path tails (names, templates), accepts ALL function arguments, binds the function *) end module ProcName : - NameCommon with type ('context, 'f) dispatcher = 'context -> Typ.Procname.t -> 'f option + NameCommon with type ('context, 'f, 'value) dispatcher = 'context -> Typ.Procname.t -> 'f option -module TypName : NameCommon with type ('context, 'f) dispatcher = 'context -> Typ.name -> 'f option - -module type VALUE = sig - type t -end +module TypName : + NameCommon with type ('context, 'f, 'value) dispatcher = 'context -> Typ.name -> 'f option -module MakeCall (Val : VALUE) : sig +module Call : sig (** Little abstraction over arguments: currently actual args, we'll want formal args later *) module FuncArg : sig - type t = {exp: Exp.t; typ: Typ.t; value: Val.t} + type 'value t = {exp: Exp.t; typ: Typ.t; value: 'value} end include Common - with type ('context, 'f) dispatcher = - 'context -> Typ.Procname.t -> FuncArg.t list -> 'f option + with type ('context, 'f, 'value) dispatcher = + 'context -> Typ.Procname.t -> 'value FuncArg.t list -> 'f option val merge_dispatchers : - ('context, 'f) dispatcher -> ('context, 'f) dispatcher -> ('context, 'f) dispatcher + ('context, 'f, 'value) dispatcher + -> ('context, 'f, 'value) dispatcher + -> ('context, 'f, 'value) dispatcher (** Merges two dispatchers into a dispatcher *) - type ('context, 'f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers) args_matcher + type ('context, 'f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers, 'value) args_matcher - type ('context, 'arg_in, 'arg_out, 'f_in, 'f_out, 'captured_types, 'markers) one_arg + type ('context, 'arg_in, 'arg_out, 'f_in, 'f_out, 'captured_types, 'markers, 'value) one_arg (* Function args *) - val any_arg : ('context, unit, _, 'f, 'f, _, _) one_arg + val any_arg : ('context, unit, _, 'f, 'f, _, _, _) one_arg (** Eats one arg *) - val capt_arg : ('context, FuncArg.t, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, _, _) one_arg + val capt_arg : + ('context, 'value FuncArg.t, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, _, _, 'value) one_arg (** Captures one arg *) - val capt_value : ('context, Val.t, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, _, _) one_arg + val capt_value : ('context, 'value, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, _, _, 'value) one_arg (** Captures the value of one arg at current state *) - val capt_exp : ('context, Exp.t, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, _, _) one_arg + val capt_exp : ('context, Exp.t, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, _, _, _) one_arg (** Captures one arg expression *) val any_arg_of_typ : - ('context, unit, _, unit, unit, unit) name_matcher -> ('context, unit, _, 'f, 'f, _, _) one_arg + ('context, unit, _, unit, unit, unit, 'value) name_matcher + -> ('context, unit, _, 'f, 'f, _, _, 'value) one_arg (** Eats one arg of the given type *) val capt_arg_of_typ : - ('context, unit, _, unit, unit, unit) name_matcher - -> ('context, FuncArg.t, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, _, _) one_arg + ('context, unit, _, unit, unit, unit, 'value) name_matcher + -> ('context, 'value FuncArg.t, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, _, _, 'value) one_arg (** Captures one arg of the given type *) val capt_exp_of_typ : - ('context, unit, _, unit, unit, unit) name_matcher - -> ('context, Exp.t, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, _, _) one_arg + ('context, unit, _, unit, unit, unit, 'value) name_matcher + -> ('context, Exp.t, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, _, _, _) one_arg (** Captures one arg expression of the given type *) - val any_arg_of_prim_typ : Typ.t -> ('context, unit, _, 'f, 'f, _, _) one_arg + val any_arg_of_prim_typ : Typ.t -> ('context, unit, _, 'f, 'f, _, _, _) one_arg (** Eats one arg of the given primitive type *) val capt_exp_of_prim_typ : - Typ.t -> ('context, Exp.t, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, _, _) one_arg + Typ.t -> ('context, Exp.t, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, _, _, _) one_arg (** Captures one arg expression of the given primitive type *) - val capt_var_exn : ('context, Ident.t, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, _, _) one_arg + val capt_var_exn : ('context, Ident.t, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, _, _, _) one_arg (** Captures one arg Var. Fails with an internal error if the expression is not a Var *) - val typ1 : 'marker -> ('context, unit, _, 'f, 'f, 'marker mtyp * _, 'marker * _) one_arg + val typ1 : 'marker -> ('context, unit, _, 'f, 'f, 'marker mtyp * _, 'marker * _, _) one_arg (** Matches first captured type *) val typ2 : - 'marker -> ('context, unit, _, 'f, 'f, _ * ('marker mtyp * _), _ * ('marker * _)) one_arg + 'marker -> ('context, unit, _, 'f, 'f, _ * ('marker mtyp * _), _ * ('marker * _), _) one_arg (** Matches second captured type *) val typ3 : 'marker - -> ('context, unit, _, 'f, 'f, _ * (_ * ('marker mtyp * _)), _ * (_ * ('marker * _))) one_arg + -> ('context, unit, _, 'f, 'f, _ * (_ * ('marker mtyp * _)), _ * (_ * ('marker * _)), _) one_arg (** Matches third captured type *) val ( $+ ) : - ('context, 'f_in, 'f_proc_out, 'f_interm, 'captured_types, 'markers) args_matcher - -> ('context, 'arg, 'arg, 'f_interm, 'f_out, 'captured_types, 'markers) one_arg - -> ('context, 'f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers) args_matcher + ('context, 'f_in, 'f_proc_out, 'f_interm, 'captured_types, 'markers, 'value) args_matcher + -> ('context, 'arg, 'arg, 'f_interm, 'f_out, 'captured_types, 'markers, 'value) one_arg + -> ('context, 'f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers, 'value) args_matcher (** Separate function arguments *) val ( $+? ) : - ('context, 'f_in, 'f_proc_out, 'f_interm, 'captured_types, 'markers) args_matcher - -> ('context, 'arg, 'arg option, 'f_interm, 'f_out, 'captured_types, 'markers) one_arg - -> ('context, 'f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers) args_matcher + ('context, 'f_in, 'f_proc_out, 'f_interm, 'captured_types, 'markers, 'value) args_matcher + -> ('context, 'arg, 'arg option, 'f_interm, 'f_out, 'captured_types, 'markers, 'value) one_arg + -> ('context, 'f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers, 'value) args_matcher (** Add an optional argument *) val ( >$ ) : - ('context, 'f_in, 'f_proc_out, 'ct, unit, 'cm, _) templ_matcher - -> ('context, 'arg, 'arg, 'f_proc_out, 'f_out, 'ct, 'cm) one_arg - -> ('context, 'f_in, 'f_proc_out, 'f_out, 'ct, 'cm) args_matcher + ('context, 'f_in, 'f_proc_out, 'ct, unit, 'cm, _, 'value) templ_matcher + -> ('context, 'arg, 'arg, 'f_proc_out, 'f_out, 'ct, 'cm, 'value) one_arg + -> ('context, 'f_in, 'f_proc_out, 'f_out, 'ct, 'cm, 'value) args_matcher (** Ends template arguments and starts function arguments *) val ( $--> ) : - ('context, 'f_in, _, 'f_out, 'captured_types, 'markers) args_matcher + ('context, 'f_in, _, 'f_out, 'captured_types, 'markers, 'value) args_matcher -> 'f_in - -> ('context, 'f_out) matcher + -> ('context, 'f_out, 'value) matcher (** Ends function arguments, binds the function *) val ( $ ) : - ('context, 'f_in, 'f_proc_out, 'captured_types, unit, 'markers) name_matcher - -> ('context, 'arg, 'arg, 'f_proc_out, 'f_out, 'captured_types, 'markers) one_arg - -> ('context, 'f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers) args_matcher + ('context, 'f_in, 'f_proc_out, 'captured_types, unit, 'markers, 'value) name_matcher + -> ('context, 'arg, 'arg, 'f_proc_out, 'f_out, 'captured_types, 'markers, 'value) one_arg + -> ('context, 'f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers, 'value) args_matcher (** Ends a name with accept-ALL template arguments and starts function arguments *) val ( <>$ ) : - ('context, 'f_in, 'f_proc_out, 'captured_types, unit, 'markers) name_matcher - -> ('context, 'arg, 'arg, 'f_proc_out, 'f_out, 'captured_types, 'markers) one_arg - -> ('context, 'f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers) args_matcher + ('context, 'f_in, 'f_proc_out, 'captured_types, unit, 'markers, 'value) name_matcher + -> ('context, 'arg, 'arg, 'f_proc_out, 'f_out, 'captured_types, 'markers, 'value) one_arg + -> ('context, 'f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers, 'value) args_matcher (** Ends a name with accept-NO template arguments and starts function arguments *) val ( >--> ) : - ('context, 'f_in, 'f_out, 'captured_types, unit, 'markers, _) templ_matcher + ('context, 'f_in, 'f_out, 'captured_types, unit, 'markers, _, 'value) templ_matcher -> 'f_in - -> ('context, 'f_out) matcher + -> ('context, 'f_out, 'value) matcher (** Ends template arguments, accepts ALL function arguments, binds the function *) val ( $+...$--> ) : - ('context, 'f_in, _, 'f_out, 'captured_types, 'markers) args_matcher + ('context, 'f_in, _, 'f_out, 'captured_types, 'markers, 'value) args_matcher -> 'f_in - -> ('context, 'f_out) matcher + -> ('context, 'f_out, 'value) matcher (** Ends function arguments with eats-ALL and binds the function *) val ( >$$--> ) : - ('context, 'f_in, 'f_out, 'captured_types, unit, 'markers, _) templ_matcher + ('context, 'f_in, 'f_out, 'captured_types, unit, 'markers, _, 'value) templ_matcher -> 'f_in - -> ('context, 'f_out) matcher + -> ('context, 'f_out, 'value) matcher (** Ends template arguments, accepts NO function arguments, binds the function *) val ( $$--> ) : - ('context, 'f_in, 'f_out, 'captured_types, unit, 'markers) name_matcher + ('context, 'f_in, 'f_out, 'captured_types, unit, 'markers, 'value) name_matcher -> 'f_in - -> ('context, 'f_out) matcher + -> ('context, 'f_out, 'value) matcher (** After a name, accepts ALL template arguments, accepts NO function arguments, binds the function *) val ( <>$$--> ) : - ('context, 'f_in, 'f_out, 'captured_types, unit, 'markers) name_matcher + ('context, 'f_in, 'f_out, 'captured_types, unit, 'markers, 'value) name_matcher -> 'f_in - -> ('context, 'f_out) matcher + -> ('context, 'f_out, 'value) matcher (** After a name, accepts NO template arguments, accepts NO function arguments, binds the function *) val ( &--> ) : - ('context, 'f_in, 'f_out, 'captured_types, unit, 'markers) name_matcher + ('context, 'f_in, 'f_out, 'captured_types, unit, 'markers, 'value) name_matcher -> 'f_in - -> ('context, 'f_out) matcher + -> ('context, 'f_out, 'value) matcher (** After a name, accepts ALL template arguments, accepts ALL function arguments, binds the function *) val ( <>--> ) : - ('context, 'f_in, 'f_out, 'captured_types, unit, 'markers) name_matcher + ('context, 'f_in, 'f_out, 'captured_types, unit, 'markers, 'value) name_matcher -> 'f_in - -> ('context, 'f_out) matcher + -> ('context, 'f_out, 'value) matcher (** After a name, accepts NO template arguments, accepts ALL function arguments, binds the function *) val ( &::.*--> ) : - ('context, 'f_in, 'f_out, 'captured_types, unit, 'markers) name_matcher + ('context, 'f_in, 'f_out, 'captured_types, unit, 'markers, 'value) name_matcher -> 'f_in - -> ('context, 'f_out) matcher + -> ('context, 'f_out, 'value) matcher (** After a name, accepts ALL template arguments, accepts ALL path tails (names, templates), accepts ALL function arguments, binds the function *) val ( $!--> ) : - ('context, 'f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers) args_matcher + ('context, 'f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers, 'value) args_matcher -> 'f_in - -> ('context, 'f_out) matcher + -> ('context, 'f_out, 'value) matcher (** Ends function arguments, accepts NO more function arguments. If the args do not match, raise an internal error. *) diff --git a/infer/src/bufferoverrun/bufferOverrunAnalysis.ml b/infer/src/bufferoverrun/bufferOverrunAnalysis.ml index 1141cfd8f..0040c694f 100644 --- a/infer/src/bufferoverrun/bufferOverrunAnalysis.ml +++ b/infer/src/bufferoverrun/bufferOverrunAnalysis.ml @@ -363,7 +363,8 @@ module TransferFunctions = struct assign_java_enum_values id callee_pname mem else let fun_arg_list = - List.map params ~f:(fun (exp, typ) -> Models.ModeledCall.FuncArg.{exp; typ; value= ()}) + List.map params ~f:(fun (exp, typ) -> + ProcnameDispatcher.Call.FuncArg.{exp; typ; value= ()} ) in match Models.Call.dispatch tenv callee_pname fun_arg_list with | Some {Models.exec} -> diff --git a/infer/src/bufferoverrun/bufferOverrunChecker.ml b/infer/src/bufferoverrun/bufferOverrunChecker.ml index f3938172f..a7e73023c 100644 --- a/infer/src/bufferoverrun/bufferOverrunChecker.ml +++ b/infer/src/bufferoverrun/bufferOverrunChecker.ml @@ -295,7 +295,7 @@ let check_instr : check_expr_for_integer_overflow integer_type_widths exp location mem cond_set ) in let fun_arg_list = - List.map params ~f:(fun (exp, typ) -> Models.ModeledCall.FuncArg.{exp; typ; value= ()}) + List.map params ~f:(fun (exp, typ) -> ProcnameDispatcher.Call.FuncArg.{exp; typ; value= ()}) in match Models.Call.dispatch tenv callee_pname fun_arg_list with | Some {Models.check} -> diff --git a/infer/src/bufferoverrun/bufferOverrunModels.ml b/infer/src/bufferoverrun/bufferOverrunModels.ml index b9d04f81e..d6246d682 100644 --- a/infer/src/bufferoverrun/bufferOverrunModels.ml +++ b/infer/src/bufferoverrun/bufferOverrunModels.ml @@ -21,8 +21,7 @@ module Val = struct type t = unit end -module ModeledCall = ProcnameDispatcher.MakeCall (Val) -open ModeledCall.FuncArg +open ProcnameDispatcher.Call.FuncArg type exec_fun = model_env -> ret:Ident.t * Typ.t -> Dom.Mem.t -> Dom.Mem.t @@ -1176,8 +1175,8 @@ module Object = struct end module Call = struct - let dispatch : (Tenv.t, model) ModeledCall.dispatcher = - let open ModeledCall in + let dispatch : (Tenv.t, model, unit) ProcnameDispatcher.Call.dispatcher = + let open ProcnameDispatcher.Call in let mk_std_array () = -"std" &:: "array" < any_typ &+ capt_int in let std_array0 = mk_std_array () in let std_array1 = mk_std_array () in diff --git a/infer/src/bufferoverrun/bufferOverrunTypModels.ml b/infer/src/bufferoverrun/bufferOverrunTypModels.ml index 414b37690..940a3bc9e 100644 --- a/infer/src/bufferoverrun/bufferOverrunTypModels.ml +++ b/infer/src/bufferoverrun/bufferOverrunTypModels.ml @@ -30,7 +30,7 @@ module Java = struct let integer = JavaInteger end -let dispatch : (Tenv.t, typ_model) ProcnameDispatcher.TypName.dispatcher = +let dispatch : (Tenv.t, typ_model, unit) ProcnameDispatcher.TypName.dispatcher = let open ProcnameDispatcher.TypName in make_dispatcher [ -"std" &:: "array" < capt_typ `T &+ capt_int >--> std_array diff --git a/infer/src/checkers/cost.ml b/infer/src/checkers/cost.ml index 9accab4ec..8a8270ffc 100644 --- a/infer/src/checkers/cost.ml +++ b/infer/src/checkers/cost.ml @@ -565,7 +565,7 @@ module InstrBasicCost = struct let loc = InstrCFG.Node.loc instr_node in let fun_arg_list = List.map params ~f:(fun (exp, typ) -> - BufferOverrunModels.ModeledCall.FuncArg.{exp; typ; value= ()} ) + ProcnameDispatcher.Call.FuncArg.{exp; typ; value= ()} ) in match CostModels.Call.dispatch tenv callee_pname fun_arg_list with | Some model -> diff --git a/infer/src/checkers/costModels.ml b/infer/src/checkers/costModels.ml index c1b2760f8..ffb26b4c1 100644 --- a/infer/src/checkers/costModels.ml +++ b/infer/src/checkers/costModels.ml @@ -118,8 +118,8 @@ module ImmutableSet = struct end module Call = struct - let dispatch : (Tenv.t, CostUtils.model) BufferOverrunModels.ModeledCall.dispatcher = - let open BufferOverrunModels.ModeledCall in + let dispatch : (Tenv.t, CostUtils.model, unit) ProcnameDispatcher.Call.dispatcher = + let open ProcnameDispatcher.Call in let int_typ = Typ.mk (Typ.Tint Typ.IInt) in let dispatcher = make_dispatcher diff --git a/infer/src/checkers/hoisting.ml b/infer/src/checkers/hoisting.ml index d680c2f2d..6e0bd202a 100644 --- a/infer/src/checkers/hoisting.ml +++ b/infer/src/checkers/hoisting.ml @@ -118,7 +118,7 @@ let get_cost_if_expensive tenv integer_type_widths get_callee_cost_summary_and_f | None -> let fun_arg_list = List.map params ~f:(fun (exp, typ) -> - BufferOverrunModels.ModeledCall.FuncArg.{exp; typ; value= ()} ) + ProcnameDispatcher.Call.FuncArg.{exp; typ; value= ()} ) in CostModels.Call.dispatch tenv pname fun_arg_list |> Option.map ~f:(fun model -> diff --git a/infer/src/checkers/purityModels.ml b/infer/src/checkers/purityModels.ml index 671ab3c65..80f53f658 100644 --- a/infer/src/checkers/purityModels.ml +++ b/infer/src/checkers/purityModels.ml @@ -34,7 +34,7 @@ let startsWith prefix _ s = String.is_prefix ~prefix s let getStarValue tenv s = startsWith "get" tenv s && endsWith "Value" tenv s module ProcName = struct - let dispatch : (Tenv.t, PurityDomain.t) ProcnameDispatcher.ProcName.dispatcher = + let dispatch : (Tenv.t, PurityDomain.t, unit) ProcnameDispatcher.ProcName.dispatcher = let open ProcnameDispatcher.ProcName in make_dispatcher [ +pure_builtins <>--> PurityDomain.pure diff --git a/infer/src/opensource/FbCostModels.ml b/infer/src/opensource/FbCostModels.ml index 2f572a0bc..eb60fb8f0 100644 --- a/infer/src/opensource/FbCostModels.ml +++ b/infer/src/opensource/FbCostModels.ml @@ -8,5 +8,5 @@ open! IStd module Call = struct - let dispatch = BufferOverrunModels.ModeledCall.make_dispatcher [] + let dispatch = ProcnameDispatcher.Call.make_dispatcher [] end diff --git a/infer/src/opensource/FbCostModels.mli b/infer/src/opensource/FbCostModels.mli index 101451918..984656839 100644 --- a/infer/src/opensource/FbCostModels.mli +++ b/infer/src/opensource/FbCostModels.mli @@ -8,5 +8,5 @@ open! IStd module Call : sig - val dispatch : (Tenv.t, CostUtils.model) BufferOverrunModels.ModeledCall.dispatcher + val dispatch : (Tenv.t, CostUtils.model, unit) ProcnameDispatcher.Call.dispatcher end diff --git a/infer/src/pulse/PulseModels.ml b/infer/src/pulse/PulseModels.ml index fc50dd9b5..3480f10a0 100644 --- a/infer/src/pulse/PulseModels.ml +++ b/infer/src/pulse/PulseModels.ml @@ -245,7 +245,7 @@ module StdVector = struct end module ProcNameDispatcher = struct - let dispatch : (Tenv.t, model) ProcnameDispatcher.ProcName.dispatcher = + let dispatch : (Tenv.t, model, unit) ProcnameDispatcher.ProcName.dispatcher = let open ProcnameDispatcher.ProcName in make_dispatcher [ -"folly" &:: "DelayedDestruction" &:: "destroy" &--> Misc.skip