From 73906d537d5c15a4d3922184405c20dcdcbdc517 Mon Sep 17 00:00:00 2001 From: Mehdi Bouaziz Date: Wed, 29 Nov 2017 06:05:25 -0800 Subject: [PATCH] [dispatcher] Typename dispatcher Summary: Extends `ProcnameDispatcher` to allow matching typenames only. There isn't much new here, mainly moving stuff so that we only have to open one module to use the operators. Reviewed By: skcho Differential Revision: D6408245 fbshipit-source-id: afc6533 --- infer/src/IR/ProcnameDispatcher.ml | 484 +++++++++++------- infer/src/IR/ProcnameDispatcher.mli | 363 +++++++------ .../src/bufferoverrun/bufferOverrunModels.ml | 2 +- 3 files changed, 509 insertions(+), 340 deletions(-) diff --git a/infer/src/IR/ProcnameDispatcher.ml b/infer/src/IR/ProcnameDispatcher.ml index 439e61b03..4a95bbde4 100644 --- a/infer/src/IR/ProcnameDispatcher.ml +++ b/infer/src/IR/ProcnameDispatcher.ml @@ -136,9 +136,13 @@ type ('f_in, 'f_out) all_args_matcher = { on_objc_cpp: 'f_in -> objc_cpp -> FuncArg.t list -> 'f_out pre_result ; on_c: 'f_in -> c -> FuncArg.t list -> 'f_out pre_result } +type 'f typ_matcher = Typ.name -> 'f option + (* they are actually just the same thing *) type 'f dispatcher = 'f matcher +type 'f typ_dispatcher = 'f typ_matcher + (* Combinators *) let empty : ('f, 'f, unit, 'markers, 'markers, empty) path_matcher = @@ -285,245 +289,377 @@ let args_end {on_c; on_objc_cpp} -let make_matcher : ('f_in, 'f_out) all_args_matcher -> 'f_in -> 'f_out matcher = - fun m f -> - let {on_c; on_objc_cpp} : (_, _) all_args_matcher = m in - fun procname args -> - match procname with - | ObjC_Cpp objc_cpp -> - on_objc_cpp f objc_cpp args |> pre_to_opt procname args - | C c -> - on_c f c args |> pre_to_opt procname args - | _ -> - None - - -(** Simple implementation of a dispatcher, could be optimized later *) -let make_dispatcher : 'f matcher list -> 'f dispatcher = - fun matchers procname args -> List.find_map matchers ~f:(fun matcher -> matcher procname args) - +module type Common = sig + (* Template arguments *) + + val any_typ : + ('f, 'f, 'captured_types, 'captured_types, 'markers, 'markers, accept_more) template_arg + (** Eats a type *) + + val capt_typ : + 'marker + -> ( 'marker mtyp -> 'f + , 'f + , 'captured_types + , 'marker mtyp * 'captured_types + , 'markers + , 'marker * 'markers + , accept_more ) + template_arg + (** Captures a type than can be back-referenced *) + + val capt_int : + ( Int64.t -> 'f + , 'f + , 'captured_types + , 'captured_types + , 'markers + , 'markers + , accept_more ) + template_arg + (** Captures an int *) + + val capt_all : + ( Typ.template_arg list -> 'f + , 'f + , 'captured_types + , 'captured_types + , 'markers + , 'markers + , end_of_list ) + template_arg + (** Captures all template args *) + + val ( ~- ) : string -> ('f, 'f, unit, 'markers, 'markers) name_matcher + (** Starts a path with a name *) + + val ( &+ ) : + ( 'f_in + , 'f_interm + , 'captured_types_in + , 'markers_interm + , 'markers_out + , accept_more ) + templ_matcher + -> ( 'f_interm + , 'f_out + , 'captured_types_in + , 'captured_types_out + , 'markers_in + , 'markers_interm + , 'lc ) + template_arg + -> ('f_in, 'f_out, 'captured_types_out, 'markers_in, 'markers_out, 'lc) templ_matcher + (** Separate template arguments *) + + val ( < ) : + ('f_in, 'f_interm, 'captured_types_in, 'markers_interm, 'markers_out) name_matcher + -> ( 'f_interm + , 'f_out + , 'captured_types_in + , 'captured_types_out + , 'markers_in + , 'markers_interm + , 'lc ) + template_arg + -> ('f_in, 'f_out, 'captured_types_out, 'markers_in, 'markers_out, 'lc) templ_matcher + (** Starts template arguments after a name *) + + val ( >:: ) : + ('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, _) templ_matcher -> string + -> ('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher + (** Ends template arguments and starts a name *) + + val ( &+...>:: ) : + ('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, accept_more) templ_matcher + -> string -> ('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher + (** Ends template arguments with eats-ALL and starts a name *) + + val ( &:: ) : + ('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher -> string + -> ('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher + (** Separates names (accepts ALL template arguments on the left one) *) + + val ( <>:: ) : + ('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher -> string + -> ('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher + (** Separates names (accepts NO template arguments on the left one) *) +end -(* Template arguments *) +module Common = struct + (* Template arguments *) -let add_no_marker capture_markers = capture_markers + let add_no_marker capture_markers = capture_markers -(** Eats all template args *) -let any_template_args - : ('f, 'f, 'captured_types, 'captured_types, 'markers, 'markers, end_of_list) template_arg = - let eat_template_arg (f, captured_types, _) = Some (f, captured_types, []) in - {eat_template_arg; add_marker= add_no_marker} + (** Eats all template args *) + let any_template_args + : ('f, 'f, 'captured_types, 'captured_types, 'markers, 'markers, end_of_list) template_arg = + let eat_template_arg (f, captured_types, _) = Some (f, captured_types, []) in + {eat_template_arg; add_marker= add_no_marker} -(** Eats a type *) -let any_typ - : ('f, 'f, 'captured_types, 'captured_types, 'markers, 'markers, accept_more) template_arg = - let eat_template_arg (f, captured_types, template_args) = - match template_args with (Typ.TType _) :: rest -> Some (f, captured_types, rest) | _ -> None - in - {eat_template_arg; add_marker= add_no_marker} - - -(** Captures a type than can be back-referenced *) -let capt_typ - : 'marker - -> ( 'marker mtyp -> 'f - , 'f - , 'captured_types - , 'marker mtyp * 'captured_types - , 'markers - , 'marker * 'markers - , accept_more ) - template_arg = - fun marker -> + (** Eats a type *) + let any_typ + : ('f, 'f, 'captured_types, 'captured_types, 'markers, 'markers, accept_more) template_arg = let eat_template_arg (f, captured_types, template_args) = match template_args with - | (Typ.TType ty) :: rest -> - let captured_types () = (ty, captured_types ()) in - Some (f ty, captured_types, rest) + | (Typ.TType _) :: rest -> + Some (f, captured_types, rest) | _ -> None in - let add_marker capture_markers = (marker, capture_markers) in - {eat_template_arg; add_marker} - - -(** Captures an int *) -let capt_int - : ( Int64.t -> 'f - , 'f - , 'captured_types - , 'captured_types - , 'markers - , 'markers - , accept_more ) - template_arg = - let eat_template_arg (f, captured_types, template_args) = - match template_args with (Typ.TInt i) :: rest -> Some (f i, captured_types, rest) | _ -> None - in - {eat_template_arg; add_marker= add_no_marker} - - -(** Captures all template args *) -let capt_all - : ( Typ.template_arg list -> 'f - , 'f - , 'captured_types - , 'captured_types - , 'markers - , 'markers - , end_of_list ) - template_arg = - let eat_template_arg (f, captured_types, template_args) = - Some (f template_args, captured_types, []) - in - {eat_template_arg; add_marker= add_no_marker} + {eat_template_arg; add_marker= add_no_marker} + + + (** Captures a type than can be back-referenced *) + let capt_typ + : 'marker + -> ( 'marker mtyp -> 'f + , 'f + , 'captured_types + , 'marker mtyp * 'captured_types + , 'markers + , 'marker * 'markers + , accept_more ) + template_arg = + fun marker -> + let eat_template_arg (f, captured_types, template_args) = + match template_args with + | (Typ.TType ty) :: rest -> + let captured_types () = (ty, captured_types ()) in + Some (f ty, captured_types, rest) + | _ -> + None + in + let add_marker capture_markers = (marker, capture_markers) in + {eat_template_arg; add_marker} + + + (** Captures an int *) + let capt_int + : ( Int64.t -> 'f + , 'f + , 'captured_types + , 'captured_types + , 'markers + , 'markers + , accept_more ) + template_arg = + let eat_template_arg (f, captured_types, template_args) = + match template_args with + | (Typ.TInt i) :: rest -> + Some (f i, captured_types, rest) + | _ -> + None + in + {eat_template_arg; add_marker= add_no_marker} + + + (** Captures all template args *) + let capt_all + : ( Typ.template_arg list -> 'f + , 'f + , 'captured_types + , 'captured_types + , 'markers + , 'markers + , end_of_list ) + template_arg = + let eat_template_arg (f, captured_types, template_args) = + Some (f template_args, captured_types, []) + in + {eat_template_arg; add_marker= add_no_marker} -(* Function args *) + let ( ! ) templ_matcher () = templ_end templ_matcher -let eat_one_func_arg ~match_if capt (f, args) = - match args with arg :: rest when match_if capt arg -> Some (f, rest) | _ -> None + let ( &::! ) path_matcher name = name_cons path_matcher name + let ( ~- ) name = empty &::! name -(** Eats one arg *) -let any_arg : ('f, 'f, _, _) func_arg = - let eat_func_arg capt = eat_one_func_arg ~match_if:(fun _ _ -> true) capt in - {eat_func_arg; marker_static_checker= no_checker} + let ( &+ ) templ_matcher template_arg = templ_cons templ_matcher template_arg + let ( < ) name_matcher template_arg = name_matcher 'marker) -> ('captured_types -> 'marker mtyp) -> 'marker - -> ('f, 'f, 'captured_types, 'markers) func_arg = - fun get_m get_c marker -> - let marker_static_checker markers = Polymorphic_compare.( = ) marker (get_m markers) in - let eat_func_arg = - eat_one_func_arg ~match_if:(fun capt func_arg -> - Typ.equal (FuncArg.typ func_arg) (get_c capt) ) - in - {eat_func_arg; marker_static_checker} + let ( >:: ) templ_matcher name = templ_matcher >! () &::! name + let ( &+...>:: ) templ_matcher name = templ_matcher &+ any_template_args >:: name -(** Matches first captured type *) -let typ1 : 'marker -> ('f, 'f, 'marker mtyp * _, 'marker * _) func_arg = - let pos1 (x, _) = x in - fun marker -> mk_typ_nth pos1 pos1 marker + let ( &:: ) path_matcher name = path_matcher < any_template_args >:: name + let ( <>:: ) name_matcher name = name_matcher :: name +end -(** Matches second captured type *) -let typ2 : 'marker -> ('f, 'f, _ * ('marker mtyp * _), _ * ('marker * _)) func_arg = - let pos2 (_, (x, _)) = x in - fun marker -> mk_typ_nth pos2 pos2 marker +module Procname = struct + include Common + let make_matcher : ('f_in, 'f_out) all_args_matcher -> 'f_in -> 'f_out matcher = + fun m f -> + let {on_c; on_objc_cpp} : (_, _) all_args_matcher = m in + fun procname args -> + match procname with + | ObjC_Cpp objc_cpp -> + on_objc_cpp f objc_cpp args |> pre_to_opt procname args + | C c -> + on_c f c args |> pre_to_opt procname args + | _ -> + None -(** Matches third captured type *) -let typ3 : 'marker -> ('f, 'f, _ * (_ * ('marker mtyp * _)), _ * (_ * ('marker * _))) func_arg = - let pos3 (_, (_, (x, _))) = x in - fun marker -> mk_typ_nth pos3 pos3 marker + (** Simple implementation of a dispatcher, could be optimized later *) + let make_dispatcher : 'f matcher list -> 'f dispatcher = + fun matchers procname args -> List.find_map matchers ~f:(fun matcher -> matcher procname args) -let capt_arg : (FuncArg.t -> 'f, 'f, _, _) func_arg = - let eat_func_arg _capt (f, args) = - match args with arg :: rest -> Some (f arg, rest) | _ -> None - in - {eat_func_arg; marker_static_checker= no_checker} + (* Function args *) -(* Function args end *) + let no_checker _ = true -(** Matches if there is no function arguments left *) -let no_args_left : (_, _, _) func_args_end = - let match_empty_args = function Some (f, []) -> Matches f | _ -> DoesNotMatch in - fun ~on_args args (f, capt) -> on_args capt (f, args) |> match_empty_args + let eat_one_func_arg ~match_if capt (f, args) = + match args with arg :: rest when match_if capt arg -> Some (f, rest) | _ -> None -(** Matches any function arguments *) -let any_func_args : (_, _, _) func_args_end = - fun ~on_args args (f, capt) -> on_args capt (f, args) |> pre_map_opt ~f:fst + (** Eats one arg *) + let any_arg : ('f, 'f, _, _) func_arg = + let eat_func_arg capt = eat_one_func_arg ~match_if:(fun _ _ -> true) capt in + {eat_func_arg; marker_static_checker= no_checker} -(** If [func_args_end1] does not match, use [func_args_end2] *) -let alternative_args_end - : ('f_in, 'f_out, 'captured_types) func_args_end - -> ('f_in, 'f_out, 'captured_types) func_args_end - -> ('f_in, 'f_out, 'captured_types) func_args_end = - fun func_args_end1 func_args_end2 ~on_args args f_capt -> - match func_args_end1 ~on_args args f_capt with - | DoesNotMatch -> - func_args_end2 ~on_args args f_capt - | otherwise -> - otherwise + let mk_typ_nth + : ('markers -> 'marker) -> ('captured_types -> 'marker mtyp) -> 'marker + -> ('f, 'f, 'captured_types, 'markers) func_arg = + fun get_m get_c marker -> + let marker_static_checker markers = Polymorphic_compare.( = ) marker (get_m markers) in + let eat_func_arg = + eat_one_func_arg ~match_if:(fun capt func_arg -> + Typ.equal (FuncArg.typ func_arg) (get_c capt) ) + in + {eat_func_arg; marker_static_checker} -(** Retries matching with another matcher *) -let args_end_retry : _ -> (_, _, _) func_args_end = fun f ~on_args:_ _args _f_capt -> RetryWith f + (** Matches first captured type *) + let typ1 : 'marker -> ('f, 'f, 'marker mtyp * _, 'marker * _) func_arg = + let pos1 (x, _) = x in + fun marker -> mk_typ_nth pos1 pos1 marker + + + (** Matches second captured type *) + let typ2 : 'marker -> ('f, 'f, _ * ('marker mtyp * _), _ * ('marker * _)) func_arg = + let pos2 (_, (x, _)) = x in + fun marker -> mk_typ_nth pos2 pos2 marker -(** Retries matching with another matcher if the function does not have the - exact number/types of args *) -let exact_args_or_retry : 'f -> (_, _, _) func_args_end = - fun f -> alternative_args_end no_args_left (args_end_retry f) + (** Matches third captured type *) + let typ3 : 'marker -> ('f, 'f, _ * (_ * ('marker mtyp * _)), _ * (_ * ('marker * _))) func_arg = + let pos3 (_, (_, (x, _))) = x in + fun marker -> mk_typ_nth pos3 pos3 marker -let wrong_args_internal_error procname _args = - Logging.(die InternalError) - "Unexpected number/types of arguments for %a" Typ.Procname.pp procname + + let capt_arg : (FuncArg.t -> 'f, 'f, _, _) func_arg = + let eat_func_arg _capt (f, args) = + match args with arg :: rest -> Some (f arg, rest) | _ -> None + in + {eat_func_arg; marker_static_checker= no_checker} -(* Notation shorthands *) + (* Function args end *) + (** Matches if there is no function arguments left *) + let no_args_left : (_, _, _) func_args_end = + let match_empty_args = function Some (f, []) -> Matches f | _ -> DoesNotMatch in + fun ~on_args args (f, capt) -> on_args capt (f, args) |> match_empty_args -let ( ! ) templ_matcher () = templ_end templ_matcher + (** Matches any function arguments *) + let any_func_args : (_, _, _) func_args_end = + fun ~on_args args (f, capt) -> on_args capt (f, args) |> pre_map_opt ~f:fst -let ( $! ) path_matcher () = args_begin path_matcher -let ( >$! ) templ_matcher () = templ_matcher >! () $! () + (** If [func_args_end1] does not match, use [func_args_end2] *) + let alternative_args_end + : ('f_in, 'f_out, 'captured_types) func_args_end + -> ('f_in, 'f_out, 'captured_types) func_args_end + -> ('f_in, 'f_out, 'captured_types) func_args_end = + fun func_args_end1 func_args_end2 ~on_args args f_capt -> + match func_args_end1 ~on_args args f_capt with + | DoesNotMatch -> + func_args_end2 ~on_args args f_capt + | otherwise -> + otherwise -let ( &::! ) path_matcher name = name_cons path_matcher name -let ( $*--> ) all_args_matcher f = make_matcher all_args_matcher f + (** Retries matching with another matcher *) + let args_end_retry : _ -> (_, _, _) func_args_end = fun f ~on_args:_ _args _f_capt -> RetryWith f -let ( ~- ) name = empty &::! name + (** Retries matching with another matcher if the function does not have the + exact number/types of args *) + let exact_args_or_retry : 'f -> (_, _, _) func_args_end = + fun f -> alternative_args_end no_args_left (args_end_retry f) -let ( &+ ) templ_matcher template_arg = templ_cons templ_matcher template_arg -let ( < ) name_matcher template_arg = name_matcher :: ) templ_matcher name = templ_matcher >! () &::! name -let ( $+ ) args_matcher func_arg = args_cons args_matcher func_arg + let ( $! ) path_matcher () = args_begin path_matcher -let ( >$ ) templ_matcher func_arg = templ_matcher >$! () $+ func_arg + let ( >$! ) templ_matcher () = templ_matcher >! () $! () -let ( $* ) args_matcher func_args_end = args_end args_matcher func_args_end + let ( $*--> ) all_args_matcher f = make_matcher all_args_matcher f -let ( $--> ) args_matcher f = args_matcher $* no_args_left $*--> f + let ( $+ ) args_matcher func_arg = args_cons args_matcher func_arg -let ( &+...>:: ) templ_matcher name = templ_matcher &+ any_template_args >:: name + let ( >$ ) templ_matcher func_arg = templ_matcher >$! () $+ func_arg -let ( &:: ) path_matcher name = path_matcher < any_template_args >:: name + let ( $* ) args_matcher func_args_end = args_end args_matcher func_args_end -let ( <>:: ) name_matcher name = name_matcher :: name + let ( $--> ) args_matcher f = args_matcher $* no_args_left $*--> f -let ( $ ) name_matcher func_arg = name_matcher < any_template_args >$ func_arg + let ( $ ) name_matcher func_arg = name_matcher < any_template_args >$ func_arg -let ( <>$ ) name_matcher func_arg = name_matcher $ func_arg + let ( <>$ ) name_matcher func_arg = name_matcher $ func_arg -let ( $+...$--> ) args_matcher f = args_matcher $* any_func_args $*--> f + let ( $+...$--> ) args_matcher f = args_matcher $* any_func_args $*--> f -let ( >--> ) templ_matcher f = templ_matcher >$! () $+...$--> f + let ( >--> ) templ_matcher f = templ_matcher >$! () $+...$--> f -let ( >$$--> ) templ_matcher f = templ_matcher >$! () $--> f + let ( >$$--> ) templ_matcher f = templ_matcher >$! () $--> f -let ( $$--> ) name_matcher f = name_matcher < any_template_args >$$--> f + let ( $$--> ) name_matcher f = name_matcher < any_template_args >$$--> f -let ( <>$$--> ) name_matcher f = name_matcher $$--> f + let ( <>$$--> ) name_matcher f = name_matcher $$--> f -let ( &--> ) name_matcher f = name_matcher < any_template_args >--> f + let ( &--> ) name_matcher f = name_matcher < any_template_args >--> f -let ( <>--> ) name_matcher f = name_matcher --> f + let ( <>--> ) name_matcher f = name_matcher --> f -let ( $!--> ) args_matcher f = - args_matcher $* exact_args_or_retry wrong_args_internal_error $*--> f + let ( $!--> ) args_matcher f = + args_matcher $* exact_args_or_retry wrong_args_internal_error $*--> f + +end +module TypName = struct + include Common + + let make_matcher + : ('f_in, 'f_out, _, _, _, non_empty) path_matcher -> 'f_in -> 'f_out typ_matcher = + fun m f -> + let {on_templated_name} = m in + function + | name -> name |> templated_name_of_class_name |> on_templated_name f |> Option.map ~f:fst + + + let make_dispatcher : 'f typ_matcher list -> 'f typ_dispatcher = + fun matchers typname -> List.find_map matchers ~f:(fun matcher -> matcher typname) + + + let ( &-->! ) path_matcher f = make_matcher path_matcher f + + let ( >--> ) templ_matcher f = templ_matcher >! () &-->! f + + let ( <>--> ) name_matcher f = name_matcher --> f + + let ( &--> ) name_matcher f = name_matcher < any_template_args >--> f +end diff --git a/infer/src/IR/ProcnameDispatcher.mli b/infer/src/IR/ProcnameDispatcher.mli index 6d582a0f7..0a8451762 100644 --- a/infer/src/IR/ProcnameDispatcher.mli +++ b/infer/src/IR/ProcnameDispatcher.mli @@ -54,65 +54,9 @@ type 'f matcher = Typ.Procname.t -> FuncArg.t list -> 'f option type 'f dispatcher = 'f matcher -val make_dispatcher : 'f matcher list -> 'f dispatcher -(** Combines matchers to create a dispatcher *) - -(* Template arguments *) - -val any_typ : - ('f, 'f, 'captured_types, 'captured_types, 'markers, 'markers, accept_more) template_arg -(** Eats a type *) - -val capt_typ : - 'marker - -> ( 'marker mtyp -> 'f - , 'f - , 'captured_types - , 'marker mtyp * 'captured_types - , 'markers - , 'marker * 'markers - , accept_more ) - template_arg -(** Captures a type than can be back-referenced *) - -val capt_int : - ( Int64.t -> 'f - , 'f - , 'captured_types - , 'captured_types - , 'markers - , 'markers - , accept_more ) - template_arg -(** Captures an int *) - -val capt_all : - ( Typ.template_arg list -> 'f - , 'f - , 'captured_types - , 'captured_types - , 'markers - , 'markers - , end_of_list ) - template_arg -(** Captures all template args *) - -(* Function args *) - -val any_arg : ('f, 'f, _, _) func_arg -(** Eats one arg *) - -val capt_arg : (FuncArg.t -> 'f, 'f, _, _) func_arg -(** Captures one arg *) - -val typ1 : 'marker -> ('f, 'f, 'marker mtyp * _, 'marker * _) func_arg -(** Matches first captured type *) - -val typ2 : 'marker -> ('f, 'f, _ * ('marker mtyp * _), _ * ('marker * _)) func_arg -(** Matches second captured type *) - -val typ3 : 'marker -> ('f, 'f, _ * (_ * ('marker mtyp * _)), _ * (_ * ('marker * _))) func_arg -(** Matches third captured type *) +type 'f typ_matcher = Typ.name -> 'f option + +type 'f typ_dispatcher = 'f typ_matcher (* A matcher is a rule associating a function [f] to a [C/C++ function/method]: - [C/C++ function/method] --> [f] @@ -129,112 +73,201 @@ val typ3 : 'marker -> ('f, 'f, _ * (_ * ('marker mtyp * _)), _ * (_ * ('marker * -"std" &:: "vector" < capt_typ T &+ capt_typ A >:: "vector" $ typ2 A $--> f *) -val ( ~- ) : string -> ('f, 'f, unit, 'markers, 'markers) name_matcher -(** Starts a path with a name *) +module type Common = sig + (* Template arguments *) + + val any_typ : + ('f, 'f, 'captured_types, 'captured_types, 'markers, 'markers, accept_more) template_arg + (** Eats a type *) + + val capt_typ : + 'marker + -> ( 'marker mtyp -> 'f + , 'f + , 'captured_types + , 'marker mtyp * 'captured_types + , 'markers + , 'marker * 'markers + , accept_more ) + template_arg + (** Captures a type than can be back-referenced *) + + val capt_int : + ( Int64.t -> 'f + , 'f + , 'captured_types + , 'captured_types + , 'markers + , 'markers + , accept_more ) + template_arg + (** Captures an int *) + + val capt_all : + ( Typ.template_arg list -> 'f + , 'f + , 'captured_types + , 'captured_types + , 'markers + , 'markers + , end_of_list ) + template_arg + (** Captures all template args *) + + val ( ~- ) : string -> ('f, 'f, unit, 'markers, 'markers) name_matcher + (** Starts a path with a name *) + + val ( &+ ) : + ( 'f_in + , 'f_interm + , 'captured_types_in + , 'markers_interm + , 'markers_out + , accept_more ) + templ_matcher + -> ( 'f_interm + , 'f_out + , 'captured_types_in + , 'captured_types_out + , 'markers_in + , 'markers_interm + , 'lc ) + template_arg + -> ('f_in, 'f_out, 'captured_types_out, 'markers_in, 'markers_out, 'lc) templ_matcher + (** Separate template arguments *) + + val ( < ) : + ('f_in, 'f_interm, 'captured_types_in, 'markers_interm, 'markers_out) name_matcher + -> ( 'f_interm + , 'f_out + , 'captured_types_in + , 'captured_types_out + , 'markers_in + , 'markers_interm + , 'lc ) + template_arg + -> ('f_in, 'f_out, 'captured_types_out, 'markers_in, 'markers_out, 'lc) templ_matcher + (** Starts template arguments after a name *) + + val ( >:: ) : + ('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, _) templ_matcher -> string + -> ('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher + (** Ends template arguments and starts a name *) + + val ( &+...>:: ) : + ('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, accept_more) templ_matcher + -> string -> ('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher + (** Ends template arguments with eats-ALL and starts a name *) + + val ( &:: ) : + ('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher -> string + -> ('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher + (** Separates names (accepts ALL template arguments on the left one) *) + + val ( <>:: ) : + ('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher -> string + -> ('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher + (** Separates names (accepts NO template arguments on the left one) *) +end -val ( &+ ) : - ('f_in, 'f_interm, 'captured_types_in, 'markers_interm, 'markers_out, accept_more) templ_matcher - -> ( 'f_interm - , 'f_out - , 'captured_types_in - , 'captured_types_out - , 'markers_in - , 'markers_interm - , 'lc ) - template_arg - -> ('f_in, 'f_out, 'captured_types_out, 'markers_in, 'markers_out, 'lc) templ_matcher -(** Separate template arguments *) - -val ( < ) : - ('f_in, 'f_interm, 'captured_types_in, 'markers_interm, 'markers_out) name_matcher - -> ( 'f_interm - , 'f_out - , 'captured_types_in - , 'captured_types_out - , 'markers_in - , 'markers_interm - , 'lc ) - template_arg - -> ('f_in, 'f_out, 'captured_types_out, 'markers_in, 'markers_out, 'lc) templ_matcher -(** Starts template arguments after a name *) - -val ( >:: ) : - ('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, _) templ_matcher -> string - -> ('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher -(** Ends template arguments and starts a name *) - -val ( $+ ) : - ('f_in, 'f_proc_out, 'f_interm, 'captured_types, 'markers) args_matcher - -> ('f_interm, 'f_out, 'captured_types, 'markers) func_arg - -> ('f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers) args_matcher -(** Separate function arguments *) - -val ( >$ ) : - ('f_in, 'f_proc_out, 'ct, unit, 'cm, _) templ_matcher -> ('f_proc_out, 'f_out, 'ct, 'cm) func_arg - -> ('f_in, 'f_proc_out, 'f_out, 'ct, 'cm) args_matcher -(** Ends template arguments and starts function arguments *) - -val ( $--> ) : - ('f_in, _, 'f_out, 'captured_types, 'markers) args_matcher -> 'f_in -> 'f_out matcher -(** Ends function arguments, binds the function *) - -val ( &+...>:: ) : - ('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, accept_more) templ_matcher -> string - -> ('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher -(** Ends template arguments with eats-ALL and starts a name *) - -val ( &:: ) : - ('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher -> string - -> ('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher -(** Separates names (accepts ALL template arguments on the left one) *) - -val ( <>:: ) : - ('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher -> string - -> ('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher -(** Separates names (accepts NO template arguments on the left one) *) - -val ( $ ) : - ('f_in, 'f_proc_out, 'captured_types, unit, 'markers) name_matcher - -> ('f_proc_out, 'f_out, 'captured_types, 'markers) func_arg - -> ('f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers) args_matcher -(** Ends a name with accept-ALL template arguments and starts function arguments *) - -val ( <>$ ) : - ('f_in, 'f_proc_out, 'captured_types, unit, 'markers) name_matcher - -> ('f_proc_out, 'f_out, 'captured_types, 'markers) func_arg - -> ('f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers) args_matcher -(** Ends a name with accept-NO template arguments and starts function arguments *) - -val ( >--> ) : - ('f_in, 'f_out, 'captured_types, unit, 'markers, _) templ_matcher -> 'f_in -> 'f_out matcher -(** Ends template arguments, accepts ALL function arguments, binds the function *) - -val ( $+...$--> ) : - ('f_in, _, 'f_out, 'captured_types, 'markers) args_matcher -> 'f_in -> 'f_out matcher -(** Ends function arguments with eats-ALL and binds the function *) - -val ( >$$--> ) : - ('f_in, 'f_out, 'captured_types, unit, 'markers, _) templ_matcher -> 'f_in -> 'f_out matcher -(** Ends template arguments, accepts NO function arguments, binds the function *) - -val ( $$--> ) : - ('f_in, 'f_out, 'captured_types, unit, 'markers) name_matcher -> 'f_in -> 'f_out matcher -(** After a name, accepts ALL template arguments, accepts NO function arguments, binds the function *) - -val ( <>$$--> ) : - ('f_in, 'f_out, 'captured_types, unit, 'markers) name_matcher -> 'f_in -> 'f_out matcher -(** After a name, accepts NO template arguments, accepts NO function arguments, binds the function *) - -val ( &--> ) : - ('f_in, 'f_out, 'captured_types, unit, 'markers) name_matcher -> 'f_in -> 'f_out matcher -(** After a name, accepts ALL template arguments, accepts ALL function arguments, binds the function *) - -val ( <>--> ) : - ('f_in, 'f_out, 'captured_types, unit, 'markers) name_matcher -> 'f_in -> 'f_out matcher -(** After a name, accepts NO template arguments, accepts ALL function arguments, binds the function *) - -val ( $!--> ) : - ('f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers) args_matcher -> 'f_in -> 'f_out matcher -(** Ends function arguments, accepts NO more function arguments. +module Procname : sig + include Common + + (* Function args *) + + val any_arg : ('f, 'f, _, _) func_arg + (** Eats one arg *) + + val capt_arg : (FuncArg.t -> 'f, 'f, _, _) func_arg + (** Captures one arg *) + + val typ1 : 'marker -> ('f, 'f, 'marker mtyp * _, 'marker * _) func_arg + (** Matches first captured type *) + + val typ2 : 'marker -> ('f, 'f, _ * ('marker mtyp * _), _ * ('marker * _)) func_arg + (** Matches second captured type *) + + val typ3 : 'marker -> ('f, 'f, _ * (_ * ('marker mtyp * _)), _ * (_ * ('marker * _))) func_arg + (** Matches third captured type *) + + val make_dispatcher : 'f matcher list -> 'f dispatcher + (** Combines matchers to create a dispatcher *) + + val ( $+ ) : + ('f_in, 'f_proc_out, 'f_interm, 'captured_types, 'markers) args_matcher + -> ('f_interm, 'f_out, 'captured_types, 'markers) func_arg + -> ('f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers) args_matcher + (** Separate function arguments *) + + val ( >$ ) : + ('f_in, 'f_proc_out, 'ct, unit, 'cm, _) templ_matcher + -> ('f_proc_out, 'f_out, 'ct, 'cm) func_arg + -> ('f_in, 'f_proc_out, 'f_out, 'ct, 'cm) args_matcher + (** Ends template arguments and starts function arguments *) + + val ( $--> ) : + ('f_in, _, 'f_out, 'captured_types, 'markers) args_matcher -> 'f_in -> 'f_out matcher + (** Ends function arguments, binds the function *) + + val ( $ ) : + ('f_in, 'f_proc_out, 'captured_types, unit, 'markers) name_matcher + -> ('f_proc_out, 'f_out, 'captured_types, 'markers) func_arg + -> ('f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers) args_matcher + (** Ends a name with accept-ALL template arguments and starts function arguments *) + + val ( <>$ ) : + ('f_in, 'f_proc_out, 'captured_types, unit, 'markers) name_matcher + -> ('f_proc_out, 'f_out, 'captured_types, 'markers) func_arg + -> ('f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers) args_matcher + (** Ends a name with accept-NO template arguments and starts function arguments *) + + val ( >--> ) : + ('f_in, 'f_out, 'captured_types, unit, 'markers, _) templ_matcher -> 'f_in -> 'f_out matcher + (** Ends template arguments, accepts ALL function arguments, binds the function *) + + val ( $+...$--> ) : + ('f_in, _, 'f_out, 'captured_types, 'markers) args_matcher -> 'f_in -> 'f_out matcher + (** Ends function arguments with eats-ALL and binds the function *) + + val ( >$$--> ) : + ('f_in, 'f_out, 'captured_types, unit, 'markers, _) templ_matcher -> 'f_in -> 'f_out matcher + (** Ends template arguments, accepts NO function arguments, binds the function *) + + val ( $$--> ) : + ('f_in, 'f_out, 'captured_types, unit, 'markers) name_matcher -> 'f_in -> 'f_out matcher + (** After a name, accepts ALL template arguments, accepts NO function arguments, binds the function *) + + val ( <>$$--> ) : + ('f_in, 'f_out, 'captured_types, unit, 'markers) name_matcher -> 'f_in -> 'f_out matcher + (** After a name, accepts NO template arguments, accepts NO function arguments, binds the function *) + + val ( &--> ) : + ('f_in, 'f_out, 'captured_types, unit, 'markers) name_matcher -> 'f_in -> 'f_out matcher + (** After a name, accepts ALL template arguments, accepts ALL function arguments, binds the function *) + + val ( <>--> ) : + ('f_in, 'f_out, 'captured_types, unit, 'markers) name_matcher -> 'f_in -> 'f_out matcher + (** After a name, accepts NO template arguments, accepts ALL function arguments, binds the function *) + + val ( $!--> ) : + ('f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers) args_matcher -> 'f_in -> 'f_out matcher + (** Ends function arguments, accepts NO more function arguments. If the args do not match, raise an internal error. *) +end + +module TypName : sig + include Common + + val make_dispatcher : 'f typ_matcher list -> 'f typ_dispatcher + + val ( >--> ) : + ('f_in, 'f_out, 'captured_types, unit, 'markers, _) templ_matcher -> 'f_in + -> 'f_out typ_matcher + + val ( <>--> ) : + ('f_in, 'f_out, 'captured_types, unit, 'markers) name_matcher -> 'f_in -> 'f_out typ_matcher + + val ( &--> ) : + ('f_in, 'f_out, 'captured_types, unit, 'markers) name_matcher -> 'f_in -> 'f_out typ_matcher +end diff --git a/infer/src/bufferoverrun/bufferOverrunModels.ml b/infer/src/bufferoverrun/bufferOverrunModels.ml index 0ea3b4c33..6c441335c 100644 --- a/infer/src/bufferoverrun/bufferOverrunModels.ml +++ b/infer/src/bufferoverrun/bufferOverrunModels.ml @@ -154,7 +154,7 @@ module Make (CFG : ProcCfg.S) = struct let dispatcher : model ProcnameDispatcher.dispatcher = - let open ProcnameDispatcher in + let open ProcnameDispatcher.Procname in make_dispatcher [ -"__inferbo_min" <>$ capt_arg $+ capt_arg $!--> inferbo_min ; -"__inferbo_set_size" <>$ capt_arg $+ capt_arg $!--> inferbo_set_size