pghs975uc
/
infer_clone
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

ProcnameDispatcher: allow matching to depend on a context

Browse Source 
Reviewed By: jvillard

Differential Revision: D9178956

fbshipit-source-id: 78fdb11fc
master
Mehdi Bouaziz 7 years ago committed by Facebook Github Bot
parent d5a5e7da10
commit 96323b68e6
4 changed files with 368 additions and 268 deletions
Show Stats Download Patch File Download Diff File

469
infer/src/IR/ProcnameDispatcher.ml
Unescape View File

@ -65,9 +65,9 @@ let templated_name_of_java java =
(* Intermediate matcher types *) (* Intermediate matcher types *)
type ('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher = type ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher =
{ on_objc_cpp: 'f_in -> objc_cpp -> ('f_out * 'captured_types capt) option { on_objc_cpp: 'context -> 'f_in -> objc_cpp -> ('f_out * 'captured_types capt) option
; on_qual_name: 'f_in -> qual_name -> ('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 } ; get_markers: 'markers_in -> 'markers_out }
type ( 'f_in type ( 'f_in
@ -82,29 +82,33 @@ type ( 'f_in
-> ('f_out * 'captured_types_out capt * Typ.template_arg list) option -> ('f_out * 'captured_types_out capt * Typ.template_arg list) option
; add_marker: 'markers_in -> 'markers_out } ; add_marker: 'markers_in -> 'markers_out }
type ('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, 'list_constraint) templ_matcher = type ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, 'list_constraint) templ_matcher
{ on_objc_cpp: 'f_in -> objc_cpp -> ('f_out * 'captured_types capt * Typ.template_arg list) option =
{ on_objc_cpp:
'context -> 'f_in -> objc_cpp
-> ('f_out * 'captured_types capt * Typ.template_arg list) option
; on_templated_name: ; on_templated_name:
'f_in -> templated_name -> ('f_out * 'captured_types capt * Typ.template_arg list) option 'context -> 'f_in -> templated_name
-> ('f_out * 'captured_types capt * Typ.template_arg list) option
; get_markers: 'markers_in -> 'markers_out } ; get_markers: 'markers_in -> 'markers_out }
type ('f_in, 'f_out, 'captured_types, 'emptyness) path_extra = type ('context, 'f_in, 'f_out, 'captured_types, 'emptyness) path_extra =
| PathEmpty : ('f, 'f, unit, empty) path_extra | PathEmpty : ('context, 'f, 'f, unit, empty) path_extra
| PathNonEmpty: | PathNonEmpty:
{ on_objc_cpp: 'f_in -> objc_cpp -> ('f_out * 'captured_types capt) option } { on_objc_cpp: 'context -> 'f_in -> objc_cpp -> ('f_out * 'captured_types capt) option }
-> ('f_in, 'f_out, 'captured_types, non_empty) path_extra -> ('context, 'f_in, 'f_out, 'captured_types, non_empty) path_extra
type ('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) path_matcher =
{ on_templated_name: 'f_in -> templated_name -> ('f_out * 'captured_types capt) option { on_templated_name: 'context -> 'f_in -> templated_name -> ('f_out * 'captured_types capt) option
; path_extra: ('f_in, 'f_out, 'captured_types, 'emptyness) path_extra ; path_extra: ('context, 'f_in, 'f_out, 'captured_types, 'emptyness) path_extra
; get_markers: 'markers_in -> 'markers_out } ; get_markers: 'markers_in -> 'markers_out }
(* Combinators *) (* Combinators *)
let empty : ('f, 'f, unit, 'markers, 'markers, empty) path_matcher = let empty : ('context, 'f, 'f, unit, 'markers, 'markers, empty) path_matcher =
let get_markers m = m in let get_markers m = m in
let get_capture () = () in let get_capture () = () in
let on_templated_name f (qual_name, template_args) = let on_templated_name _context f (qual_name, template_args) =
match (QualifiedCppName.extract_last qual_name, template_args) with match (QualifiedCppName.extract_last qual_name, template_args) with
| None, [] -> | None, [] ->
Some (f, get_capture) Some (f, get_capture)
@ -117,35 +121,43 @@ let empty : ('f, 'f, unit, 'markers, 'markers, empty) path_matcher =
let name_cons let name_cons
: ('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, _) path_matcher -> string : ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, _) path_matcher
-> ('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher = -> string
-> ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher =
fun m name -> fun m name ->
let {on_templated_name; get_markers} = m in let {on_templated_name; get_markers} = m in
let fuzzy_name_regexp = let fuzzy_name_regexp =
name |> Str.quote |> Printf.sprintf "^%s\\(<[a-z0-9]+>\\)?$" |> Str.regexp name |> Str.quote |> Printf.sprintf "^%s\\(<[a-z0-9]+>\\)?$" |> Str.regexp
in in
let on_qual_name f qual_name = let on_qual_name context f qual_name =
match QualifiedCppName.extract_last qual_name with match QualifiedCppName.extract_last qual_name with
| Some (last, rest) when Str.string_match fuzzy_name_regexp last 0 -> | Some (last, rest) when Str.string_match fuzzy_name_regexp last 0 ->
on_templated_name f (rest, []) on_templated_name context f (rest, [])
| _ -> | _ ->
None None
in in
let on_objc_cpp f (objc_cpp: Typ.Procname.ObjC_Cpp.t) = let on_objc_cpp context f (objc_cpp: Typ.Procname.ObjC_Cpp.t) =
if String.equal name objc_cpp.method_name then if String.equal name objc_cpp.method_name then
on_templated_name f (templated_name_of_class_name objc_cpp.class_name) on_templated_name context f (templated_name_of_class_name objc_cpp.class_name)
else None else None
in in
{on_objc_cpp; on_qual_name; get_markers} {on_objc_cpp; on_qual_name; get_markers}
let all_names_cons let all_names_cons
: ('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, non_empty) path_matcher
-> ('f_in, 'f_out, 'captured_tpes, 'markers_in, 'markers_out, non_empty) path_matcher = -> ( 'context
, 'f_in
, 'f_out
, 'captured_tpes
, 'markers_in
, 'markers_out
, non_empty )
path_matcher =
fun m -> fun m ->
let {on_templated_name; get_markers; path_extra= PathNonEmpty {on_objc_cpp}} = m in let {on_templated_name; get_markers; path_extra= PathNonEmpty {on_objc_cpp}} = m in
let rec on_templated_name_rec f templated_name = let rec on_templated_name_rec context f templated_name =
match on_templated_name f templated_name with match on_templated_name context f templated_name with
| Some _ as some -> | Some _ as some ->
some some
| None -> | None ->
@ -154,33 +166,40 @@ let all_names_cons
| None -> | None ->
None None
| Some (_last, rest) -> | Some (_last, rest) ->
on_templated_name_rec f (rest, []) on_templated_name_rec context f (rest, [])
in in
let on_templated_name = on_templated_name_rec in let on_templated_name = on_templated_name_rec in
let on_objc_cpp f (objc_cpp: Typ.Procname.ObjC_Cpp.t) = let on_objc_cpp context f (objc_cpp: Typ.Procname.ObjC_Cpp.t) =
match on_objc_cpp f objc_cpp with match on_objc_cpp context f objc_cpp with
| Some _ as some -> | Some _ as some ->
some some
| None -> | None ->
on_templated_name f (templated_name_of_class_name objc_cpp.class_name) on_templated_name context f (templated_name_of_class_name objc_cpp.class_name)
in in
{on_templated_name; get_markers; path_extra= PathNonEmpty {on_objc_cpp}} {on_templated_name; get_markers; path_extra= PathNonEmpty {on_objc_cpp}}
let templ_begin let templ_begin
: ('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher : ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher
-> ('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, accept_more) templ_matcher = -> ( 'context
, 'f_in
, 'f_out
, 'captured_types
, 'markers_in
, 'markers_out
, accept_more )
templ_matcher =
fun m -> fun m ->
let {on_objc_cpp; on_qual_name; get_markers} = m in let {on_objc_cpp; on_qual_name; get_markers} = m in
let on_templated_name f (qual_name, template_args) = let on_templated_name context f (qual_name, template_args) =
match on_qual_name f qual_name with match on_qual_name context f qual_name with
| None -> | None ->
None None
| Some (f, captured_types) -> | Some (f, captured_types) ->
Some (f, captured_types, template_args) Some (f, captured_types, template_args)
in in
let on_objc_cpp f (objc_cpp: Typ.Procname.ObjC_Cpp.t) = let on_objc_cpp context f (objc_cpp: Typ.Procname.ObjC_Cpp.t) =
match on_objc_cpp f objc_cpp with match on_objc_cpp context f objc_cpp with
| None -> | None ->
None None
| Some (f, captured_types) -> | Some (f, captured_types) ->
@ -191,7 +210,8 @@ let templ_begin
let templ_cons let templ_cons
: ( 'f_in : ( 'context
, 'f_in
, 'f_interm , 'f_interm
, 'captured_types_in , 'captured_types_in
, 'markers_interm , 'markers_interm
@ -206,39 +226,57 @@ let templ_cons
, 'markers_interm , 'markers_interm
, 'lc ) , 'lc )
template_arg template_arg
-> ('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 )
templ_matcher =
fun m template_arg -> fun m template_arg ->
let {on_objc_cpp; on_templated_name; get_markers} = m in let {on_objc_cpp; on_templated_name; get_markers} = m in
let {eat_template_arg; add_marker} = template_arg in let {eat_template_arg; add_marker} = template_arg in
let get_markers m = get_markers (add_marker m) in let get_markers m = get_markers (add_marker m) in
let on_templated_name f templated_name = let on_templated_name context f templated_name =
on_templated_name f templated_name |> Option.bind ~f:eat_template_arg on_templated_name context f templated_name |> Option.bind ~f:eat_template_arg
in
let on_objc_cpp context f objc_cpp =
on_objc_cpp context f objc_cpp |> Option.bind ~f:eat_template_arg
in in
let on_objc_cpp f objc_cpp = on_objc_cpp f objc_cpp |> Option.bind ~f:eat_template_arg in
{on_objc_cpp; on_templated_name; get_markers} {on_objc_cpp; on_templated_name; get_markers}
let templ_end let templ_end
: ('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, _) templ_matcher : ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, _) templ_matcher
-> ('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
, non_empty )
path_matcher =
let match_empty_templ_args (f, captured_types, template_args) = let match_empty_templ_args (f, captured_types, template_args) =
match template_args with [] -> Some (f, captured_types) | _ -> None match template_args with [] -> Some (f, captured_types) | _ -> None
in in
fun m -> fun m ->
let {on_objc_cpp; on_templated_name; get_markers} = m in let {on_objc_cpp; on_templated_name; get_markers} = m in
let on_templated_name f templated_name = let on_templated_name context f templated_name =
on_templated_name f templated_name |> Option.bind ~f:match_empty_templ_args on_templated_name context f templated_name |> Option.bind ~f:match_empty_templ_args
in
let on_objc_cpp context f objc_cpp =
on_objc_cpp context f objc_cpp |> Option.bind ~f:match_empty_templ_args
in in
let on_objc_cpp f objc_cpp = on_objc_cpp f objc_cpp |> Option.bind ~f:match_empty_templ_args in
{on_templated_name; path_extra= PathNonEmpty {on_objc_cpp}; get_markers} {on_templated_name; path_extra= PathNonEmpty {on_objc_cpp}; get_markers}
module type Common = sig module type Common = sig
type 'f matcher type ('context, 'f) matcher
type 'f dispatcher type ('context, 'f) dispatcher
val make_dispatcher : 'f matcher list -> 'f dispatcher val make_dispatcher : ('context, 'f) matcher list -> ('context, 'f) dispatcher
(* Template arguments *) (* Template arguments *)
@ -280,11 +318,12 @@ module type Common = sig
template_arg template_arg
(** Captures all template args *) (** Captures all template args *)
val ( ~- ) : string -> ('f, 'f, unit, 'markers, 'markers) name_matcher val ( ~- ) : string -> ('context, 'f, 'f, unit, 'markers, 'markers) name_matcher
(** Starts a path with a name *) (** Starts a path with a name *)
val ( &+ ) : val ( &+ ) :
( 'f_in ( 'context
, 'f_in
, 'f_interm , 'f_interm
, 'captured_types_in , 'captured_types_in
, 'markers_interm , 'markers_interm
@ -299,11 +338,11 @@ module type Common = sig
, 'markers_interm , 'markers_interm
, 'lc ) , 'lc )
template_arg template_arg
-> ('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) templ_matcher
(** Separate template arguments *) (** Separate template arguments *)
val ( < ) : val ( < ) :
('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) name_matcher
-> ( 'f_interm -> ( 'f_interm
, 'f_out , 'f_out
, 'captured_types_in , 'captured_types_in
@ -312,27 +351,34 @@ module type Common = sig
, 'markers_interm , 'markers_interm
, 'lc ) , 'lc )
template_arg template_arg
-> ('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) templ_matcher
(** Starts template arguments after a name *) (** Starts template arguments after a name *)
val ( >:: ) : val ( >:: ) :
('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, _) templ_matcher -> string ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, _) templ_matcher
-> ('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher -> string -> ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher
(** Ends template arguments and starts a name *) (** Ends template arguments and starts a name *)
val ( &+...>:: ) : val ( &+...>:: ) :
('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, accept_more) templ_matcher ( 'context
-> string -> ('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher , 'f_in
, 'f_out
, 'captured_types
, 'markers_in
, 'markers_out
, accept_more )
templ_matcher -> string
-> ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher
(** Ends template arguments with eats-ALL and starts a name *) (** Ends template arguments with eats-ALL and starts a name *)
val ( &:: ) : val ( &:: ) :
('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher -> string ('context, '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 -> ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher
(** Separates names (accepts ALL template arguments on the left one) *) (** Separates names (accepts ALL template arguments on the left one) *)
val ( <>:: ) : val ( <>:: ) :
('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher -> string ('context, '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 -> ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher
(** Separates names (accepts NO template arguments on the left one) *) (** Separates names (accepts NO template arguments on the left one) *)
end end
@ -460,157 +506,172 @@ module Call = struct
"Expected Lvar, got %a:%a" Exp.pp e (Typ.pp Pp.text) (typ arg) "Expected Lvar, got %a:%a" Exp.pp e (Typ.pp Pp.text) (typ arg)
end end
type ('f_in, 'f_out, 'captured_types) proc_matcher = type ('context, 'f_in, 'f_out, 'captured_types) proc_matcher =
{ on_objc_cpp: 'f_in -> objc_cpp -> ('f_out * 'captured_types) option { on_objc_cpp: 'context -> 'f_in -> objc_cpp -> ('f_out * 'captured_types) option
; on_c: 'f_in -> c -> ('f_out * 'captured_types) option ; on_c: 'context -> 'f_in -> c -> ('f_out * 'captured_types) option
; on_java: 'f_in -> java -> ('f_out * 'captured_types) option } ; on_java: 'context -> 'f_in -> java -> ('f_out * 'captured_types) option }
type ('f_in, 'f_out, 'captured_types) on_args = type ('context, 'f_in, 'f_out, 'captured_types) on_args =
'captured_types -> 'f_in * FuncArg.t list -> ('f_out * FuncArg.t list) option 'context -> 'captured_types -> 'f_in * FuncArg.t list -> ('f_out * FuncArg.t list) option
type ('f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers) args_matcher = type ('context, 'f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers) args_matcher =
{ on_proc: ('f_in, 'f_proc_out, 'captured_types) proc_matcher { on_proc: ('context, 'f_in, 'f_proc_out, 'captured_types) proc_matcher
; on_args: ('f_proc_out, 'f_out, 'captured_types) on_args ; on_args: ('context, 'f_proc_out, 'f_out, 'captured_types) on_args
; markers: 'markers } ; markers: 'markers }
type ('captured_types, 'markers) one_arg_matcher = type ('context, 'captured_types, 'markers) one_arg_matcher =
{match_arg: 'captured_types -> FuncArg.t -> bool; marker_static_checker: 'markers -> bool} { match_arg: 'context -> 'captured_types -> FuncArg.t -> bool
; marker_static_checker: 'markers -> bool }
type ('arg_in, 'arg_out, 'f_in, 'f_out) arg_capture = 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} {get_captured_value: FuncArg.t -> 'arg_in; do_capture: 'f_in -> 'arg_out -> 'f_out}
type ('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) one_arg =
{ one_arg_matcher: ('captured_types, 'markers) one_arg_matcher { one_arg_matcher: ('context, 'captured_types, 'markers) one_arg_matcher
; capture: ('arg_in, 'arg_out, 'f_in, 'f_out) arg_capture } ; capture: ('arg_in, 'arg_out, 'f_in, 'f_out) arg_capture }
type ('arg_in, 'arg_out, 'f_in, 'f_out) arg_preparer = 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 { on_empty: ('f_in -> 'arg_out -> 'f_out) -> 'f_in -> ('f_out * FuncArg.t list) option
; wrapper: 'arg_in -> 'arg_out } ; wrapper: 'arg_in -> 'arg_out }
type ('f_in, 'f_out, 'captured_types, 'markers) func_arg = type ('context, 'f_in, 'f_out, 'captured_types, 'markers) func_arg =
{ eat_func_arg: ('f_in, 'f_out, 'captured_types) on_args { eat_func_arg: ('context, 'f_in, 'f_out, 'captured_types) on_args
; marker_static_checker: 'markers -> bool } ; marker_static_checker: 'markers -> bool }
type 'f matcher = type ('context, 'f) matcher =
{ on_objc_cpp: objc_cpp -> FuncArg.t list -> 'f option { on_objc_cpp: 'context -> objc_cpp -> FuncArg.t list -> 'f option
; on_c: c -> FuncArg.t list -> 'f option ; on_c: 'context -> c -> FuncArg.t list -> 'f option
; on_java: java -> FuncArg.t list -> 'f option } ; on_java: 'context -> java -> FuncArg.t list -> 'f option }
type 'f pre_result = DoesNotMatch | Matches of 'f | RetryWith of 'f matcher type ('context, 'f) pre_result =
| DoesNotMatch
| Matches of 'f
| RetryWith of ('context, 'f) matcher
let pre_bind_opt opt ~f = match opt with None -> DoesNotMatch | Some x -> f x 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) let pre_map_opt opt ~f = match opt with None -> DoesNotMatch | Some x -> Matches (f x)
type ('f_in, 'f_out, 'captured_types) func_args_end = type ('context, 'f_in, 'f_out, 'captured_types) func_args_end =
on_args:('f_in, 'f_out, 'captured_types) on_args -> FuncArg.t list -> 'f_in * 'captured_types on_args:('context, 'f_in, 'f_out, 'captured_types) on_args -> 'context -> FuncArg.t list
-> 'f_out pre_result -> 'f_in * 'captured_types -> ('context, 'f_out) pre_result
type ('f_in, 'f_out) all_args_matcher = type ('context, 'f_in, 'f_out) all_args_matcher =
{ on_objc_cpp: 'f_in -> objc_cpp -> FuncArg.t list -> 'f_out pre_result { on_objc_cpp: 'context -> 'f_in -> objc_cpp -> FuncArg.t list -> ('context, 'f_out) pre_result
; on_c: 'f_in -> c -> FuncArg.t list -> 'f_out pre_result ; on_c: 'context -> 'f_in -> c -> FuncArg.t list -> ('context, 'f_out) pre_result
; on_java: 'f_in -> java -> FuncArg.t list -> 'f_out pre_result } ; on_java: 'context -> 'f_in -> java -> FuncArg.t list -> ('context, 'f_out) pre_result }
type 'f dispatcher = Typ.Procname.t -> FuncArg.t list -> 'f option type ('context, 'f) dispatcher = 'context -> Typ.Procname.t -> FuncArg.t list -> 'f option
let args_begin let args_begin
: ('f_in, 'f_out, 'captured_types, unit, 'markers, non_empty) path_matcher : ('context, 'f_in, 'f_out, 'captured_types, unit, 'markers, non_empty) path_matcher
-> ('f_in, 'f_out, 'f_out, 'captured_types, 'markers) args_matcher = -> ('context, 'f_in, 'f_out, 'f_out, 'captured_types, 'markers) args_matcher =
let on_args _capt f_args = Some f_args in let on_args _context _capt f_args = Some f_args in
fun m -> fun m ->
let {on_templated_name; path_extra= PathNonEmpty {on_objc_cpp}; get_markers} = m in let {on_templated_name; path_extra= PathNonEmpty {on_objc_cpp}; get_markers} = m in
let markers = get_markers () in let markers = get_markers () in
let get_captures (f, captured_types) = (f, captured_types ()) in let get_captures (f, captured_types) = (f, captured_types ()) in
let on_c f (c: c) = let on_c context f (c: c) =
let template_args = template_args_of_template_spec_info c.template_args in let template_args = template_args_of_template_spec_info c.template_args in
on_templated_name f (c.name, template_args) |> Option.map ~f:get_captures on_templated_name context f (c.name, template_args) |> Option.map ~f:get_captures
in
let on_java context f (java: java) =
on_templated_name context f (templated_name_of_java java) |> Option.map ~f:get_captures
in in
let on_java f (java: java) = let on_objc_cpp context f objc_cpp =
on_templated_name f (templated_name_of_java java) |> Option.map ~f:get_captures on_objc_cpp context f objc_cpp |> Option.map ~f:get_captures
in in
let on_objc_cpp f objc_cpp = on_objc_cpp f objc_cpp |> Option.map ~f:get_captures in let on_proc : (_, _, _, _) proc_matcher = {on_objc_cpp; on_c; on_java} in
let on_proc : (_, _, _) proc_matcher = {on_objc_cpp; on_c; on_java} in
{on_proc; on_args; markers} {on_proc; on_args; markers}
let args_cons let args_cons
: ('f_in, 'f_proc_out, 'f_interm, 'captured_types, 'markers) args_matcher : ('context, 'f_in, 'f_proc_out, 'f_interm, 'captured_types, 'markers) args_matcher
-> ('f_interm, 'f_out, 'captured_types, 'markers) func_arg -> ('context, 'f_interm, 'f_out, 'captured_types, 'markers) func_arg
-> ('f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers) args_matcher = -> ('context, 'f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers) args_matcher =
fun m func_arg -> fun m func_arg ->
let {on_proc; on_args; markers} = m in let {on_proc; on_args; markers} = m in
let {marker_static_checker; eat_func_arg} = func_arg in let {marker_static_checker; eat_func_arg} = func_arg in
assert (marker_static_checker markers) ; assert (marker_static_checker markers) ;
let on_args capt f_args = on_args capt f_args |> Option.bind ~f:(eat_func_arg capt) in let on_args context capt f_args =
on_args context capt f_args |> Option.bind ~f:(eat_func_arg context capt)
in
{on_proc; on_args; markers} {on_proc; on_args; markers}
let args_end let args_end
: ('f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers) args_matcher : ('context, 'f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers) args_matcher
-> ('f_proc_out, 'f_out, 'captured_types) func_args_end -> ('f_in, 'f_out) all_args_matcher = -> ('context, 'f_proc_out, 'f_out, 'captured_types) func_args_end
-> ('context, 'f_in, 'f_out) all_args_matcher =
fun m func_args_end -> fun m func_args_end ->
let {on_proc= {on_c; on_java; on_objc_cpp}; on_args} = m in let {on_proc= {on_c; on_java; on_objc_cpp}; on_args} = m in
let on_c f c args = on_c f c |> pre_bind_opt ~f:(func_args_end ~on_args args) in let on_c context f c args =
let on_java f java args = on_java f java |> pre_bind_opt ~f:(func_args_end ~on_args args) in on_c context f c |> pre_bind_opt ~f:(func_args_end ~on_args context args)
let on_objc_cpp f objc_cpp args = in
on_objc_cpp f objc_cpp |> pre_bind_opt ~f:(func_args_end ~on_args args) let on_java context f java args =
on_java context f java |> pre_bind_opt ~f:(func_args_end ~on_args context args)
in
let on_objc_cpp context f objc_cpp args =
on_objc_cpp context f objc_cpp |> pre_bind_opt ~f:(func_args_end ~on_args context args)
in in
{on_c; on_java; on_objc_cpp} {on_c; on_java; on_objc_cpp}
let make_matcher : ('f_in, 'f_out) all_args_matcher -> 'f_in -> 'f_out matcher = let make_matcher
: ('context, 'f_in, 'f_out) all_args_matcher -> 'f_in -> ('context, 'f_out) matcher =
fun m f -> 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 objc_cpp args = let on_objc_cpp context objc_cpp args =
match on_objc_cpp f objc_cpp args with match on_objc_cpp context f objc_cpp args with
| DoesNotMatch -> | DoesNotMatch ->
None None
| Matches res -> | Matches res ->
Some res Some res
| RetryWith {on_objc_cpp} -> | RetryWith {on_objc_cpp} ->
on_objc_cpp objc_cpp args on_objc_cpp context objc_cpp args
in in
let on_c c args = let on_c context c args =
match on_c f c args with match on_c context f c args with
| DoesNotMatch -> | DoesNotMatch ->
None None
| Matches res -> | Matches res ->
Some res Some res
| RetryWith {on_c} -> | RetryWith {on_c} ->
on_c c args on_c context c args
in in
let on_java java args = let on_java context java args =
match on_java f java args with match on_java context f java args with
| DoesNotMatch -> | DoesNotMatch ->
None None
| Matches res -> | Matches res ->
Some res Some res
| RetryWith {on_java} -> | RetryWith {on_java} ->
on_java java args on_java context java args
in in
{on_objc_cpp; on_c; on_java} {on_objc_cpp; on_c; on_java}
(** Simple implementation of a dispatcher, could be optimized later *) (** Simple implementation of a dispatcher, could be optimized later *)
let make_dispatcher : 'f matcher list -> 'f dispatcher = let make_dispatcher : ('context, 'f) matcher list -> ('context, 'f) dispatcher =
fun matchers -> fun matchers ->
let on_objc_cpp objc_cpp args = let on_objc_cpp context objc_cpp args =
List.find_map matchers ~f:(fun (matcher: _ matcher) -> matcher.on_objc_cpp objc_cpp args) List.find_map matchers ~f:(fun (matcher: _ matcher) ->
matcher.on_objc_cpp context objc_cpp args )
in in
let on_c c args = let on_c context c args =
List.find_map matchers ~f:(fun (matcher: _ matcher) -> matcher.on_c c args) List.find_map matchers ~f:(fun (matcher: _ matcher) -> matcher.on_c context c args)
in in
let on_java java args = let on_java context java args =
List.find_map matchers ~f:(fun (matcher: _ matcher) -> matcher.on_java java args) List.find_map matchers ~f:(fun (matcher: _ matcher) -> matcher.on_java context java args)
in in
fun procname args -> fun context procname args ->
match procname with match procname with
| ObjC_Cpp objc_cpp -> | ObjC_Cpp objc_cpp ->
on_objc_cpp objc_cpp args on_objc_cpp context objc_cpp args
| C c -> | C c ->
on_c c args on_c context c args
| Java java -> | Java java ->
on_java java args on_java context java args
| _ -> | _ ->
None None
@ -620,53 +681,56 @@ module Call = struct
let no_marker_checker _markers = true let no_marker_checker _markers = true
(** Matches any arg *) (** Matches any arg *)
let match_any_arg : (_, _) one_arg_matcher = let match_any_arg : (_, _, _) one_arg_matcher =
let match_arg _capt _arg = true in let match_arg _context _capt _arg = true in
{match_arg; marker_static_checker= no_marker_checker} {match_arg; marker_static_checker= no_marker_checker}
let mk_match_typ_nth let mk_match_typ_nth
: ('markers -> 'marker) -> ('captured_types -> 'marker mtyp) -> 'marker : ('markers -> 'marker) -> ('captured_types -> 'marker mtyp) -> 'marker
-> ('captured_types, 'markers) one_arg_matcher = -> ('context, 'captured_types, 'markers) one_arg_matcher =
fun get_m get_c marker -> fun get_m get_c marker ->
let marker_static_checker markers = Polymorphic_compare.( = ) marker (get_m markers) in let marker_static_checker markers = Polymorphic_compare.( = ) marker (get_m markers) in
let match_arg capt arg = Typ.equal (FuncArg.typ arg) (get_c capt) in let match_arg _context capt arg = Typ.equal (FuncArg.typ arg) (get_c capt) in
{match_arg; marker_static_checker} {match_arg; marker_static_checker}
(** Matches first captured type *) (** Matches first captured type *)
let match_typ1 : 'marker -> ('marker mtyp * _, 'marker * _) one_arg_matcher = let match_typ1 : 'marker -> ('context, 'marker mtyp * _, 'marker * _) one_arg_matcher =
let pos1 (x, _) = x in let pos1 (x, _) = x in
fun marker -> mk_match_typ_nth pos1 pos1 marker fun marker -> mk_match_typ_nth pos1 pos1 marker
(** Matches second captured type *) (** Matches second captured type *)
let match_typ2 : 'marker -> (_ * ('marker mtyp * _), _ * ('marker * _)) one_arg_matcher = let match_typ2 : 'marker -> ('context, _ * ('marker mtyp * _), _ * ('marker * _)) one_arg_matcher =
let pos2 (_, (x, _)) = x in let pos2 (_, (x, _)) = x in
fun marker -> mk_match_typ_nth pos2 pos2 marker fun marker -> mk_match_typ_nth pos2 pos2 marker
(** Matches third captured type *) (** Matches third captured type *)
let match_typ3 let match_typ3
: 'marker -> (_ * (_ * ('marker mtyp * _)), _ * (_ * ('marker * _))) one_arg_matcher = : 'marker
-> ('context, _ * (_ * ('marker mtyp * _)), _ * (_ * ('marker * _))) one_arg_matcher =
let pos3 (_, (_, (x, _))) = x in let pos3 (_, (_, (x, _))) = x in
fun marker -> mk_match_typ_nth pos3 pos3 marker fun marker -> mk_match_typ_nth pos3 pos3 marker
(** Matches the type matched by the given path_matcher *) (** Matches the type matched by the given path_matcher *)
let match_typ : (_, _, unit, unit, unit, non_empty) path_matcher -> (_, _) one_arg_matcher = let match_typ
: ('context, _, _, unit, unit, unit, non_empty) path_matcher
-> ('context, _, _) one_arg_matcher =
fun m -> fun m ->
let {on_templated_name} : (_, _, unit, unit, unit, non_empty) path_matcher = m in let {on_templated_name} : (_, _, _, unit, unit, unit, non_empty) path_matcher = m in
let rec match_typ typ = let rec match_typ context typ =
match typ with match typ with
| {Typ.desc= Tstruct name} -> | {Typ.desc= Tstruct name} ->
name |> templated_name_of_class_name |> on_templated_name () |> Option.is_some name |> templated_name_of_class_name |> on_templated_name context () |> Option.is_some
| {Typ.desc= Tptr (typ, _ptr_kind)} -> | {Typ.desc= Tptr (typ, _ptr_kind)} ->
match_typ typ match_typ context typ
| _ -> | _ ->
false false
in in
let match_arg _capt arg = match_typ (FuncArg.typ arg) in let match_arg context _capt arg = match_typ context (FuncArg.typ arg) in
{match_arg; marker_static_checker= no_marker_checker} {match_arg; marker_static_checker= no_marker_checker}
@ -713,17 +777,18 @@ module Call = struct
let make_arg let make_arg
: ('arg_in, 'arg_out, 'f_in, 'f_out) arg_preparer : ('arg_in, 'arg_out, 'f_in, 'f_out) arg_preparer
-> ('arg_in, 'arg_out, 'f_in, 'f_out, _, _) one_arg -> ('f_in, 'f_out, _, _) func_arg = -> ('context, 'arg_in, 'arg_out, 'f_in, 'f_out, _, _) one_arg
-> ('context, 'f_in, 'f_out, _, _) func_arg =
fun arg_preparer one_arg -> fun arg_preparer one_arg ->
let {on_empty; wrapper} = arg_preparer in let {on_empty; wrapper} = arg_preparer in
let {one_arg_matcher; capture} = one_arg in let {one_arg_matcher; capture} = one_arg in
let {match_arg; marker_static_checker} = one_arg_matcher in let {match_arg; marker_static_checker} = one_arg_matcher in
let {get_captured_value; do_capture} = capture in let {get_captured_value; do_capture} = capture in
let eat_func_arg capt (f, args) = let eat_func_arg context capt (f, args) =
match args with match args with
| [] -> | [] ->
on_empty do_capture f on_empty do_capture f
| arg :: rest when match_arg capt arg -> | arg :: rest when match_arg context capt arg ->
Some (arg |> get_captured_value |> wrapper |> do_capture f, rest) Some (arg |> get_captured_value |> wrapper |> do_capture f, rest)
| _ -> | _ ->
None None
@ -731,19 +796,19 @@ module Call = struct
{eat_func_arg; marker_static_checker} {eat_func_arg; marker_static_checker}
let any_arg : (unit, _, 'f, 'f, _, _) one_arg = let any_arg : ('context, unit, _, 'f, 'f, _, _) one_arg =
{one_arg_matcher= match_any_arg; capture= no_capture} {one_arg_matcher= match_any_arg; capture= no_capture}
let capt_arg : (FuncArg.t, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, _, _) one_arg = let capt_arg : ('context, FuncArg.t, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, _, _) one_arg =
{one_arg_matcher= match_any_arg; capture= capture_arg} {one_arg_matcher= match_any_arg; capture= capture_arg}
let capt_exp : (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} {one_arg_matcher= match_any_arg; capture= capture_arg_exp}
let capt_var_exn : (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} {one_arg_matcher= match_any_arg; capture= capture_arg_var_exn}
@ -751,51 +816,51 @@ module Call = struct
let capt_exp_of_typ m = {one_arg_matcher= match_typ (m <...>! ()); capture= capture_arg_exp} let capt_exp_of_typ m = {one_arg_matcher= match_typ (m <...>! ()); capture= capture_arg_exp}
let typ1 : 'marker -> (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} fun m -> {one_arg_matcher= match_typ1 m; capture= no_capture}
let typ2 : 'marker -> (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} fun m -> {one_arg_matcher= match_typ2 m; capture= no_capture}
let typ3 : 'marker -> (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} fun m -> {one_arg_matcher= match_typ3 m; capture= no_capture}
(* Function args end *) (* Function args end *)
(** Matches if there is no function arguments left *) (** Matches if there is no function arguments left *)
let no_args_left : (_, _, _) func_args_end = let no_args_left : ('context, _, _, _) func_args_end =
let match_empty_args = function Some (f, []) -> Matches f | _ -> DoesNotMatch in 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 fun ~on_args context args (f, capt) -> on_args context capt (f, args) |> match_empty_args
(** Matches any function arguments *) (** Matches any function arguments *)
let any_func_args : (_, _, _) func_args_end = let any_func_args : ('context, _, _, _) func_args_end =
fun ~on_args args (f, capt) -> on_args capt (f, args) |> pre_map_opt ~f:fst 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] *) (** If [func_args_end1] does not match, use [func_args_end2] *)
let alternative_args_end let alternative_args_end
: ('f_in, 'f_out, 'captured_types) func_args_end : ('context, 'f_in, 'f_out, 'captured_types) func_args_end
-> ('f_in, 'f_out, 'captured_types) func_args_end -> ('context, 'f_in, 'f_out, 'captured_types) func_args_end
-> ('f_in, 'f_out, 'captured_types) func_args_end = -> ('context, 'f_in, 'f_out, 'captured_types) func_args_end =
fun func_args_end1 func_args_end2 ~on_args args f_capt -> fun func_args_end1 func_args_end2 ~on_args context args f_capt ->
match func_args_end1 ~on_args args f_capt with match func_args_end1 ~on_args context args f_capt with
| DoesNotMatch -> | DoesNotMatch ->
func_args_end2 ~on_args args f_capt func_args_end2 ~on_args context args f_capt
| otherwise -> | otherwise ->
otherwise otherwise
(** Retries matching with another matcher *) (** Retries matching with another matcher *)
let args_end_retry : _ matcher -> (_, _, _) func_args_end = let args_end_retry : _ matcher -> ('context, _, _, _) func_args_end =
fun m ~on_args:_ _args _f_capt -> RetryWith m fun m ~on_args:_ _context _args _f_capt -> RetryWith m
(** Retries matching with another matcher if the function does not have the (** Retries matching with another matcher if the function does not have the
exact number/types of args *) exact number/types of args *)
let exact_args_or_retry : 'f matcher -> (_, _, _) func_args_end = let exact_args_or_retry : ('context, 'f) matcher -> ('context, _, _, _) func_args_end =
fun m -> alternative_args_end no_args_left (args_end_retry m) fun m -> alternative_args_end no_args_left (args_end_retry m)
@ -804,9 +869,9 @@ module Call = struct
Logging.(die InternalError) Logging.(die InternalError)
"Unexpected number/types of arguments for %a" Typ.Procname.pp procname "Unexpected number/types of arguments for %a" Typ.Procname.pp procname
in in
let on_c c _args = on_procname (C c) in let on_c _context c _args = on_procname (C c) in
let on_java java _args = on_procname (Java java) in let on_java _context java _args = on_procname (Java java) in
let on_objc_cpp objc_cpp _args = on_procname (ObjC_Cpp objc_cpp) in let on_objc_cpp _context objc_cpp _args = on_procname (ObjC_Cpp objc_cpp) in
{on_c; on_java; on_objc_cpp} {on_c; on_java; on_objc_cpp}
@ -860,16 +925,20 @@ module type NameCommon = sig
include Common include Common
val ( >--> ) : val ( >--> ) :
('f_in, 'f_out, 'captured_types, unit, 'markers, _) templ_matcher -> 'f_in -> 'f_out matcher ('context, 'f_in, 'f_out, 'captured_types, unit, 'markers, _) templ_matcher -> 'f_in
-> ('context, 'f_out) matcher
val ( <>--> ) : val ( <>--> ) :
('f_in, 'f_out, 'captured_types, unit, 'markers) name_matcher -> 'f_in -> 'f_out matcher ('context, 'f_in, 'f_out, 'captured_types, unit, 'markers) name_matcher -> 'f_in
-> ('context, 'f_out) matcher
val ( &--> ) : val ( &--> ) :
('f_in, 'f_out, 'captured_types, unit, 'markers) name_matcher -> 'f_in -> 'f_out matcher ('context, 'f_in, 'f_out, 'captured_types, unit, 'markers) name_matcher -> 'f_in
-> ('context, 'f_out) matcher
val ( &::.*--> ) : val ( &::.*--> ) :
('f_in, 'f_out, 'captured_types, unit, 'markers) name_matcher -> 'f_in -> 'f_out matcher ('context, 'f_in, 'f_out, 'captured_types, unit, 'markers) name_matcher -> 'f_in
-> ('context, 'f_out) matcher
(** After a name, accepts ALL template arguments, accepts ALL path tails (names, templates), (** After a name, accepts ALL template arguments, accepts ALL path tails (names, templates),
accepts ALL function arguments, binds the function *) accepts ALL function arguments, binds the function *)
end end
@ -877,19 +946,22 @@ end
module NameCommon = struct module NameCommon = struct
include Common include Common
type 'f matcher = type ('context, 'f) matcher =
{on_templated_name: templated_name -> 'f option; on_objc_cpp: objc_cpp -> 'f option} { on_templated_name: 'context -> templated_name -> 'f option
; on_objc_cpp: 'context -> objc_cpp -> 'f option }
let make_matcher : ('f_in, 'f_out, _, _, _, non_empty) path_matcher -> 'f_in -> 'f_out matcher = let make_matcher
: ('context, 'f_in, 'f_out, _, _, _, non_empty) path_matcher -> 'f_in
-> ('context, 'f_out) matcher =
fun m f -> fun m f ->
let {on_templated_name; path_extra= PathNonEmpty {on_objc_cpp}} let {on_templated_name; path_extra= PathNonEmpty {on_objc_cpp}}
: ('f_in, 'f_out, _, _, _, non_empty) path_matcher = : ('context, 'f_in, 'f_out, _, _, _, non_empty) path_matcher =
m m
in in
let on_templated_name templated_name = let on_templated_name context templated_name =
templated_name |> on_templated_name f |> Option.map ~f:fst templated_name |> on_templated_name context f |> Option.map ~f:fst
in in
let on_objc_cpp objc_cpp = objc_cpp |> on_objc_cpp f |> Option.map ~f:fst in let on_objc_cpp context objc_cpp = objc_cpp |> on_objc_cpp context f |> Option.map ~f:fst in
{on_templated_name; on_objc_cpp} {on_templated_name; on_objc_cpp}
@ -907,34 +979,34 @@ end
module ProcName = struct module ProcName = struct
include NameCommon include NameCommon
type 'f dispatcher = Typ.Procname.t -> 'f option type ('context, 'f) dispatcher = 'context -> Typ.Procname.t -> 'f option
let make_dispatcher : 'f matcher list -> 'f dispatcher = let make_dispatcher : ('context, 'f) matcher list -> ('context, 'f) dispatcher =
fun matchers -> fun matchers ->
let on_objc_cpp objc_cpp = let on_objc_cpp context objc_cpp =
List.find_map matchers ~f:(fun (matcher: _ matcher) -> matcher.on_objc_cpp objc_cpp) List.find_map matchers ~f:(fun (matcher: _ matcher) -> matcher.on_objc_cpp context objc_cpp)
in in
let on_templated_name templated_name = let on_templated_name context templated_name =
List.find_map matchers ~f:(fun (matcher: _ matcher) -> List.find_map matchers ~f:(fun (matcher: _ matcher) ->
matcher.on_templated_name templated_name ) matcher.on_templated_name context templated_name )
in in
let on_java (java: Typ.Procname.Java.t) = let on_java context (java: Typ.Procname.Java.t) =
let templated_name = templated_name_of_java java in let templated_name = templated_name_of_java java in
on_templated_name templated_name on_templated_name context templated_name
in in
let on_c (c: c) = let on_c context (c: c) =
let template_args = template_args_of_template_spec_info c.template_args in let template_args = template_args_of_template_spec_info c.template_args in
let templated_name = (c.name, template_args) in let templated_name = (c.name, template_args) in
on_templated_name templated_name on_templated_name context templated_name
in in
fun procname -> fun context procname ->
match procname with match procname with
| ObjC_Cpp objc_cpp -> | ObjC_Cpp objc_cpp ->
on_objc_cpp objc_cpp on_objc_cpp context objc_cpp
| C c -> | C c ->
on_c c on_c context c
| Java java -> | Java java ->
on_java java on_java context java
| _ -> | _ ->
None None
end end
@ -942,10 +1014,11 @@ end
module TypName = struct module TypName = struct
include NameCommon include NameCommon
type 'f dispatcher = Typ.name -> 'f option type ('context, 'f) dispatcher = 'context -> Typ.name -> 'f option
let make_dispatcher : 'f matcher list -> 'f dispatcher = let make_dispatcher : ('context, 'f) matcher list -> ('context, 'f) dispatcher =
fun matchers typname -> fun matchers context typname ->
let templated_name = templated_name_of_class_name typname in let templated_name = templated_name_of_class_name typname in
List.find_map matchers ~f:(fun (matcher: _ matcher) -> matcher.on_templated_name templated_name) List.find_map matchers ~f:(fun (matcher: _ matcher) ->
matcher.on_templated_name context templated_name )
end end

153
infer/src/IR/ProcnameDispatcher.mli
Unescape View File

@ -25,7 +25,7 @@ type 'marker mtyp = Typ.t
(* Intermediate matcher types *) (* Intermediate matcher types *)
type ('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher type ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher
type ( 'f_in type ( 'f_in
, 'f_out , 'f_out
@ -35,7 +35,7 @@ type ( 'f_in
, 'markers_out , 'markers_out
, 'list_constraint ) template_arg , 'list_constraint ) template_arg
type ('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, 'list_constraint) templ_matcher type ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, 'list_constraint) templ_matcher
(* A matcher is a rule associating a function [f] to a [C/C++ function/method]: (* A matcher is a rule associating a function [f] to a [C/C++ function/method]:
- [C/C++ function/method] --> [f] - [C/C++ function/method] --> [f]
@ -53,11 +53,11 @@ type ('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, 'list_constrain
*) *)
module type Common = sig module type Common = sig
type 'f matcher type ('context, 'f) matcher
type 'f dispatcher type ('context, 'f) dispatcher
val make_dispatcher : 'f matcher list -> 'f dispatcher val make_dispatcher : ('context, 'f) matcher list -> ('context, 'f) dispatcher
(** Combines matchers to create a dispatcher *) (** Combines matchers to create a dispatcher *)
(* Template arguments *) (* Template arguments *)
@ -100,11 +100,12 @@ module type Common = sig
template_arg template_arg
(** Captures all template args *) (** Captures all template args *)
val ( ~- ) : string -> ('f, 'f, unit, 'markers, 'markers) name_matcher val ( ~- ) : string -> ('context, 'f, 'f, unit, 'markers, 'markers) name_matcher
(** Starts a path with a name *) (** Starts a path with a name *)
val ( &+ ) : val ( &+ ) :
( 'f_in ( 'context
, 'f_in
, 'f_interm , 'f_interm
, 'captured_types_in , 'captured_types_in
, 'markers_interm , 'markers_interm
@ -119,11 +120,11 @@ module type Common = sig
, 'markers_interm , 'markers_interm
, 'lc ) , 'lc )
template_arg template_arg
-> ('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) templ_matcher
(** Separate template arguments *) (** Separate template arguments *)
val ( < ) : val ( < ) :
('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) name_matcher
-> ( 'f_interm -> ( 'f_interm
, 'f_out , 'f_out
, 'captured_types_in , 'captured_types_in
@ -132,27 +133,34 @@ module type Common = sig
, 'markers_interm , 'markers_interm
, 'lc ) , 'lc )
template_arg template_arg
-> ('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) templ_matcher
(** Starts template arguments after a name *) (** Starts template arguments after a name *)
val ( >:: ) : val ( >:: ) :
('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, _) templ_matcher -> string ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, _) templ_matcher
-> ('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher -> string -> ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher
(** Ends template arguments and starts a name *) (** Ends template arguments and starts a name *)
val ( &+...>:: ) : val ( &+...>:: ) :
('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, accept_more) templ_matcher ( 'context
-> string -> ('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher , 'f_in
, 'f_out
, 'captured_types
, 'markers_in
, 'markers_out
, accept_more )
templ_matcher -> string
-> ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher
(** Ends template arguments with eats-ALL and starts a name *) (** Ends template arguments with eats-ALL and starts a name *)
val ( &:: ) : val ( &:: ) :
('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher -> string ('context, '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 -> ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher
(** Separates names (accepts ALL template arguments on the left one) *) (** Separates names (accepts ALL template arguments on the left one) *)
val ( <>:: ) : val ( <>:: ) :
('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher -> string ('context, '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 -> ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher
(** Separates names (accepts NO template arguments on the left one) *) (** Separates names (accepts NO template arguments on the left one) *)
end end
@ -160,16 +168,20 @@ module type NameCommon = sig
include Common include Common
val ( >--> ) : val ( >--> ) :
('f_in, 'f_out, 'captured_types, unit, 'markers, _) templ_matcher -> 'f_in -> 'f_out matcher ('context, 'f_in, 'f_out, 'captured_types, unit, 'markers, _) templ_matcher -> 'f_in
-> ('context, 'f_out) matcher
val ( <>--> ) : val ( <>--> ) :
('f_in, 'f_out, 'captured_types, unit, 'markers) name_matcher -> 'f_in -> 'f_out matcher ('context, 'f_in, 'f_out, 'captured_types, unit, 'markers) name_matcher -> 'f_in
-> ('context, 'f_out) matcher
val ( &--> ) : val ( &--> ) :
('f_in, 'f_out, 'captured_types, unit, 'markers) name_matcher -> 'f_in -> 'f_out matcher ('context, 'f_in, 'f_out, 'captured_types, unit, 'markers) name_matcher -> 'f_in
-> ('context, 'f_out) matcher
val ( &::.*--> ) : val ( &::.*--> ) :
('f_in, 'f_out, 'captured_types, unit, 'markers) name_matcher -> 'f_in -> 'f_out matcher ('context, 'f_in, 'f_out, 'captured_types, unit, 'markers) name_matcher -> 'f_in
-> ('context, 'f_out) matcher
(** After a name, accepts ALL template arguments, accepts ALL path tails (names, templates), (** After a name, accepts ALL template arguments, accepts ALL path tails (names, templates),
accepts ALL function arguments, binds the function *) accepts ALL function arguments, binds the function *)
end end
@ -179,10 +191,11 @@ end
include sig include sig
[@@@warning "-60"] [@@@warning "-60"]
module ProcName : NameCommon with type 'f dispatcher = Typ.Procname.t -> 'f option module ProcName :
NameCommon with type ('context, 'f) dispatcher = 'context -> Typ.Procname.t -> 'f option
end end
module TypName : NameCommon with type 'f dispatcher = Typ.name -> 'f option module TypName : NameCommon with type ('context, 'f) dispatcher = 'context -> Typ.name -> 'f option
module Call : sig module Call : sig
(** Little abstraction over arguments: currently actual args, we'll want formal args later *) (** Little abstraction over arguments: currently actual args, we'll want formal args later *)
@ -190,115 +203,129 @@ module Call : sig
type t = Exp.t * Typ.t type t = Exp.t * Typ.t
end end
include Common with type 'f dispatcher = Typ.Procname.t -> FuncArg.t list -> 'f option include Common
with type ('context, 'f) dispatcher =
'context -> Typ.Procname.t -> FuncArg.t list -> 'f option
type ('f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers) args_matcher type ('context, 'f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers) args_matcher
type ('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) one_arg
(* Function args *) (* Function args *)
val any_arg : (unit, _, 'f, 'f, _, _) one_arg val any_arg : ('context, unit, _, 'f, 'f, _, _) one_arg
(** Eats one arg *) (** Eats one arg *)
val capt_arg : (FuncArg.t, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, _, _) one_arg val capt_arg : ('context, FuncArg.t, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, _, _) one_arg
(** Captures one arg *) (** Captures one arg *)
val capt_exp : (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 *) (** Captures one arg expression *)
val capt_arg_of_typ : val capt_arg_of_typ :
(unit, _, unit, unit, unit) name_matcher ('context, unit, _, unit, unit, unit) name_matcher
-> (FuncArg.t, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, _, _) one_arg -> ('context, FuncArg.t, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, _, _) one_arg
(** Captures one arg of the given type *) (** Captures one arg of the given type *)
val capt_exp_of_typ : val capt_exp_of_typ :
(unit, _, unit, unit, unit) name_matcher ('context, unit, _, unit, unit, unit) name_matcher
-> (Exp.t, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, _, _) one_arg -> ('context, Exp.t, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, _, _) one_arg
(** Captures one arg expression of the given type *) (** Captures one arg expression of the given type *)
val capt_var_exn : (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 *) (** Captures one arg Var. Fails with an internal error if the expression is not a Var *)
val typ1 : 'marker -> (unit, _, 'f, 'f, 'marker mtyp * _, 'marker * _) one_arg val typ1 : 'marker -> ('context, unit, _, 'f, 'f, 'marker mtyp * _, 'marker * _) one_arg
(** Matches first captured type *) (** Matches first captured type *)
val typ2 : 'marker -> (unit, _, 'f, 'f, _ * ('marker mtyp * _), _ * ('marker * _)) one_arg val typ2 :
'marker -> ('context, unit, _, 'f, 'f, _ * ('marker mtyp * _), _ * ('marker * _)) one_arg
(** Matches second captured type *) (** Matches second captured type *)
val typ3 : val typ3 :
'marker -> (unit, _, 'f, 'f, _ * (_ * ('marker mtyp * _)), _ * (_ * ('marker * _))) one_arg 'marker
-> ('context, unit, _, 'f, 'f, _ * (_ * ('marker mtyp * _)), _ * (_ * ('marker * _))) one_arg
(** Matches third captured type *) (** Matches third captured type *)
val ( $+ ) : val ( $+ ) :
('f_in, 'f_proc_out, 'f_interm, 'captured_types, 'markers) args_matcher ('context, 'f_in, 'f_proc_out, 'f_interm, 'captured_types, 'markers) args_matcher
-> ('arg, 'arg, 'f_interm, 'f_out, 'captured_types, 'markers) one_arg -> ('context, 'arg, 'arg, 'f_interm, 'f_out, 'captured_types, 'markers) one_arg
-> ('f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers) args_matcher -> ('context, 'f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers) args_matcher
(** Separate function arguments *) (** Separate function arguments *)
val ( $+? ) : val ( $+? ) :
('f_in, 'f_proc_out, 'f_interm, 'captured_types, 'markers) args_matcher ('context, 'f_in, 'f_proc_out, 'f_interm, 'captured_types, 'markers) args_matcher
-> ('arg, 'arg option, 'f_interm, 'f_out, 'captured_types, 'markers) one_arg -> ('context, 'arg, 'arg option, 'f_interm, 'f_out, 'captured_types, 'markers) one_arg
-> ('f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers) args_matcher -> ('context, 'f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers) args_matcher
(** Add an optional argument *) (** Add an optional argument *)
val ( >$ ) : val ( >$ ) :
('f_in, 'f_proc_out, 'ct, unit, 'cm, _) templ_matcher ('context, 'f_in, 'f_proc_out, 'ct, unit, 'cm, _) templ_matcher
-> ('arg, 'arg, 'f_proc_out, 'f_out, 'ct, 'cm) one_arg -> ('context, 'arg, 'arg, 'f_proc_out, 'f_out, 'ct, 'cm) one_arg
-> ('f_in, 'f_proc_out, 'f_out, 'ct, 'cm) args_matcher -> ('context, 'f_in, 'f_proc_out, 'f_out, 'ct, 'cm) args_matcher
(** Ends template arguments and starts function arguments *) (** Ends template arguments and starts function arguments *)
val ( $--> ) : val ( $--> ) :
('f_in, _, 'f_out, 'captured_types, 'markers) args_matcher -> 'f_in -> 'f_out matcher ('context, 'f_in, _, 'f_out, 'captured_types, 'markers) args_matcher -> 'f_in
-> ('context, 'f_out) matcher
(** Ends function arguments, binds the function *) (** Ends function arguments, binds the function *)
val ( $ ) : val ( $ ) :
('f_in, 'f_proc_out, 'captured_types, unit, 'markers) name_matcher ('context, 'f_in, 'f_proc_out, 'captured_types, unit, 'markers) name_matcher
-> ('arg, 'arg, 'f_proc_out, 'f_out, 'captured_types, 'markers) one_arg -> ('context, 'arg, 'arg, 'f_proc_out, 'f_out, 'captured_types, 'markers) one_arg
-> ('f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers) args_matcher -> ('context, 'f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers) args_matcher
(** Ends a name with accept-ALL template arguments and starts function arguments *) (** Ends a name with accept-ALL template arguments and starts function arguments *)
val ( <>$ ) : val ( <>$ ) :
('f_in, 'f_proc_out, 'captured_types, unit, 'markers) name_matcher ('context, 'f_in, 'f_proc_out, 'captured_types, unit, 'markers) name_matcher
-> ('arg, 'arg, 'f_proc_out, 'f_out, 'captured_types, 'markers) one_arg -> ('context, 'arg, 'arg, 'f_proc_out, 'f_out, 'captured_types, 'markers) one_arg
-> ('f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers) args_matcher -> ('context, 'f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers) args_matcher
(** Ends a name with accept-NO template arguments and starts function arguments *) (** Ends a name with accept-NO template arguments and starts function arguments *)
val ( >--> ) : val ( >--> ) :
('f_in, 'f_out, 'captured_types, unit, 'markers, _) templ_matcher -> 'f_in -> 'f_out matcher ('context, 'f_in, 'f_out, 'captured_types, unit, 'markers, _) templ_matcher -> 'f_in
-> ('context, 'f_out) matcher
(** Ends template arguments, accepts ALL function arguments, binds the function *) (** Ends template arguments, accepts ALL function arguments, binds the function *)
val ( $+...$--> ) : val ( $+...$--> ) :
('f_in, _, 'f_out, 'captured_types, 'markers) args_matcher -> 'f_in -> 'f_out matcher ('context, 'f_in, _, 'f_out, 'captured_types, 'markers) args_matcher -> 'f_in
-> ('context, 'f_out) matcher
(** Ends function arguments with eats-ALL and binds the function *) (** Ends function arguments with eats-ALL and binds the function *)
val ( >$$--> ) : val ( >$$--> ) :
('f_in, 'f_out, 'captured_types, unit, 'markers, _) templ_matcher -> 'f_in -> 'f_out matcher ('context, 'f_in, 'f_out, 'captured_types, unit, 'markers, _) templ_matcher -> 'f_in
-> ('context, 'f_out) matcher
(** Ends template arguments, accepts NO function arguments, binds the function *) (** Ends template arguments, accepts NO function arguments, binds the function *)
val ( $$--> ) : val ( $$--> ) :
('f_in, 'f_out, 'captured_types, unit, 'markers) name_matcher -> 'f_in -> 'f_out matcher ('context, 'f_in, 'f_out, 'captured_types, unit, 'markers) name_matcher -> 'f_in
-> ('context, 'f_out) matcher
(** After a name, accepts ALL template arguments, accepts NO function arguments, binds the function *) (** After a name, accepts ALL template arguments, accepts NO function arguments, binds the function *)
val ( <>$$--> ) : val ( <>$$--> ) :
('f_in, 'f_out, 'captured_types, unit, 'markers) name_matcher -> 'f_in -> 'f_out matcher ('context, 'f_in, 'f_out, 'captured_types, unit, 'markers) name_matcher -> 'f_in
-> ('context, 'f_out) matcher
(** After a name, accepts NO template arguments, accepts NO function arguments, binds the function *) (** After a name, accepts NO template arguments, accepts NO function arguments, binds the function *)
val ( &--> ) : val ( &--> ) :
('f_in, 'f_out, 'captured_types, unit, 'markers) name_matcher -> 'f_in -> 'f_out matcher ('context, 'f_in, 'f_out, 'captured_types, unit, 'markers) name_matcher -> 'f_in
-> ('context, 'f_out) matcher
(** After a name, accepts ALL template arguments, accepts ALL function arguments, binds the function *) (** After a name, accepts ALL template arguments, accepts ALL function arguments, binds the function *)
val ( <>--> ) : val ( <>--> ) :
('f_in, 'f_out, 'captured_types, unit, 'markers) name_matcher -> 'f_in -> 'f_out matcher ('context, 'f_in, 'f_out, 'captured_types, unit, 'markers) name_matcher -> 'f_in
-> ('context, 'f_out) matcher
(** After a name, accepts NO template arguments, accepts ALL function arguments, binds the function *) (** After a name, accepts NO template arguments, accepts ALL function arguments, binds the function *)
val ( &::.*--> ) : val ( &::.*--> ) :
('f_in, 'f_out, 'captured_types, unit, 'markers) name_matcher -> 'f_in -> 'f_out matcher ('context, 'f_in, 'f_out, 'captured_types, unit, 'markers) name_matcher -> 'f_in
-> ('context, 'f_out) matcher
(** After a name, accepts ALL template arguments, accepts ALL path tails (names, templates), (** After a name, accepts ALL template arguments, accepts ALL path tails (names, templates),
accepts ALL function arguments, binds the function *) accepts ALL function arguments, binds the function *)
val ( $!--> ) : val ( $!--> ) :
('f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers) args_matcher -> 'f_in -> 'f_out matcher ('context, 'f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers) args_matcher -> 'f_in
-> ('context, 'f_out) matcher
(** Ends function arguments, accepts NO more function arguments. (** Ends function arguments, accepts NO more function arguments.
If the args do not match, raise an internal error. If the args do not match, raise an internal error.
*) *)

8
infer/src/bufferoverrun/bufferOverrunChecker.ml
Unescape View File

@ -81,7 +81,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
pname symbol_table path tenv ~node_hash location ~depth loc elt ~offset ?size pname symbol_table path tenv ~node_hash location ~depth loc elt ~offset ?size
~inst_num ~new_sym_num ~new_alloc_num mem ~inst_num ~new_sym_num ~new_alloc_num mem
| Typ.Tstruct typename -> ( | Typ.Tstruct typename -> (
match Models.TypName.dispatch typename with match Models.TypName.dispatch () typename with
| Some {Models.declare_symbolic} -> | Some {Models.declare_symbolic} ->
let model_env = Models.mk_model_env pname node_hash location tenv symbol_table in let model_env = Models.mk_model_env pname node_hash location tenv symbol_table in
declare_symbolic ~decl_sym_val:(decl_sym_val ~may_last_field) path model_env ~depth declare_symbolic ~decl_sym_val:(decl_sym_val ~may_last_field) path model_env ~depth
@ -268,7 +268,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
| Prune (exp, _, _, _) -> | Prune (exp, _, _, _) ->
Sem.Prune.prune exp mem Sem.Prune.prune exp mem
| Call (ret, Const (Cfun callee_pname), params, location, _) -> ( | Call (ret, Const (Cfun callee_pname), params, location, _) -> (
match Models.Call.dispatch callee_pname params with match Models.Call.dispatch () callee_pname params with
| Some {Models.exec} -> | Some {Models.exec} ->
let node_hash = CFG.Node.hash node in let node_hash = CFG.Node.hash node in
let model_env = let model_env =
@ -298,7 +298,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
BoUtils.Exec.decl_local_array ~decl_local pname ~node_hash location loc typ ~length BoUtils.Exec.decl_local_array ~decl_local pname ~node_hash location loc typ ~length
?stride ~inst_num ~dimension mem ?stride ~inst_num ~dimension mem
| Typ.Tstruct typname -> ( | Typ.Tstruct typname -> (
match Models.TypName.dispatch typname with match Models.TypName.dispatch () typname with
| Some {Models.declare_local} -> | Some {Models.declare_local} ->
let model_env = Models.mk_model_env pname node_hash location tenv symbol_table in let model_env = Models.mk_model_env pname node_hash location tenv symbol_table in
declare_local ~decl_local model_env loc ~inst_num ~dimension mem declare_local ~decl_local model_env loc ~inst_num ~dimension mem
@ -470,7 +470,7 @@ module Report = struct
| Sil.Load (_, exp, _, location) | Sil.Store (exp, _, _, location) -> | Sil.Load (_, exp, _, location) | Sil.Store (exp, _, _, location) ->
check_expr pname exp location mem cond_set check_expr pname exp location mem cond_set
| Sil.Call (_, Const (Cfun callee_pname), params, location, _) -> ( | Sil.Call (_, Const (Cfun callee_pname), params, location, _) -> (
match Models.Call.dispatch callee_pname params with match Models.Call.dispatch () callee_pname params with
| Some {Models.check} -> | Some {Models.check} ->
let node_hash = CFG.Node.hash node in let node_hash = CFG.Node.hash node in
check (Models.mk_model_env pname node_hash location tenv symbol_table) mem cond_set check (Models.mk_model_env pname node_hash location tenv symbol_table) mem cond_set

6
infer/src/bufferoverrun/bufferOverrunModels.ml
Unescape View File

@ -305,7 +305,7 @@ module StdArray = struct
{declare_local; declare_symbolic} {declare_local; declare_symbolic}
end end
(* Java's ArrayLists are represented by their size. We don't care about the elements. (* Java's ArrayLists are represented by their size. We don't care about the elements.
- when they are constructed, we set the size to 0 - when they are constructed, we set the size to 0
- each time we add an element, we increase the length of the array - each time we add an element, we increase the length of the array
- each time we delete an element, we decrease the length of the array *) - each time we delete an element, we decrease the length of the array *)
@ -404,7 +404,7 @@ module ArrayList = struct
end end
module Call = struct module Call = struct
let dispatch : model ProcnameDispatcher.Call.dispatcher = let dispatch : (unit, model) ProcnameDispatcher.Call.dispatcher =
let open ProcnameDispatcher.Call in let open ProcnameDispatcher.Call in
let mk_std_array () = -"std" &:: "array" < any_typ &+ capt_int in let mk_std_array () = -"std" &:: "array" < any_typ &+ capt_int in
let std_array0 = mk_std_array () in let std_array0 = mk_std_array () in
@ -449,7 +449,7 @@ module Call = struct
end end
module TypName = struct module TypName = struct
let dispatch : typ_model ProcnameDispatcher.TypName.dispatcher = let dispatch : (unit, typ_model) ProcnameDispatcher.TypName.dispatcher =
let open ProcnameDispatcher.TypName in let open ProcnameDispatcher.TypName in
make_dispatcher make_dispatcher
[ -"std" &:: "array" < capt_typ `T &+ capt_int >--> StdArray.typ [ -"std" &:: "array" < capt_typ `T &+ capt_int >--> StdArray.typ

Write Preview
Loading…
Cancel
Save