@ -341,33 +341,56 @@ module Dom = struct
fields field_checks } )
fields field_checks } )
let is_known_expensive_method =
type known_expensiveness = KnownCheap | KnownExpensive
let dispatch : ( Tenv . t , unit , unit ) ProcnameDispatcher . Call . dispatcher =
let get_expensiveness_model =
let dispatch : ( Tenv . t , known_expensiveness , unit ) ProcnameDispatcher . Call . dispatcher =
let open ProcnameDispatcher . Call in
let open ProcnameDispatcher . Call in
make_dispatcher
make_dispatcher
[ + PatternMatch . Java . implements_google " common.base.Preconditions "
[ + BuiltinDecl . ( match_builtin _ _ cast ) < > - -> KnownCheap
& :: " checkArgument " $ any_arg $+ any_arg $+ .. . $- -> ()
; + PatternMatch . Java . implements_google " common.base.Preconditions "
& :: " checkArgument " $ any_arg $+ any_arg $+ .. . $- -> KnownExpensive
; + PatternMatch . Java . implements_google " common.base.Preconditions "
; + PatternMatch . Java . implements_google " common.base.Preconditions "
& :: " checkElementIndex " $ any_arg $+ any_arg $+ any_arg $+ .. . $- -> ()
& :: " checkElementIndex " $ any_arg $+ any_arg $+ any_arg $+ .. . $- -> KnownExpensive
; + PatternMatch . Java . implements_google " common.base.Preconditions "
; + PatternMatch . Java . implements_google " common.base.Preconditions "
& :: " checkNotNull " $ any_arg $+ any_arg $+ .. . $- -> ()
& :: " checkNotNull " $ any_arg $+ any_arg $+ .. . $- -> KnownExpensive
; + PatternMatch . Java . implements_google " common.base.Preconditions "
; + PatternMatch . Java . implements_google " common.base.Preconditions "
& :: " checkPositionIndex " $ any_arg $+ any_arg $+ any_arg $+ .. . $- -> ()
& :: " checkPositionIndex " $ any_arg $+ any_arg $+ any_arg $+ .. . $- -> KnownExpensive
; + PatternMatch . Java . implements_google " common.base.Preconditions "
; + PatternMatch . Java . implements_google " common.base.Preconditions "
& :: " checkState " $ any_arg $+ any_arg $+ .. . $- -> ()
& :: " checkState " $ any_arg $+ any_arg $+ .. . $- -> KnownExpensive
; + PatternMatch . Java . implements_lang " String " & :: " concat " & - -> ()
; + PatternMatch . Java . implements_lang " String " & :: " concat " & - -> KnownExpensive
; + PatternMatch . Java . implements_lang " StringBuilder " & :: " append " & - -> () ]
; + PatternMatch . Java . implements_lang " StringBuilder " & :: " append " & - -> KnownExpensive ]
in
in
fun tenv pname args ->
fun tenv pname args ->
let args =
let args =
List . map args ~ f : ( fun ( exp , typ ) ->
List . map args ~ f : ( fun ( exp , typ ) ->
ProcnameDispatcher . Call . FuncArg . { exp ; typ ; arg_payload = () } )
ProcnameDispatcher . Call . FuncArg . { exp ; typ ; arg_payload = () } )
in
in
dispatch tenv pname args | > Option . is_some
dispatch tenv pname args
let call tenv analyze_dependency ~ is_cheap_call callee args location
let call tenv analyze_dependency ~ is_cheap_call callee args location
( { config_checks ; field_checks ; unchecked_callees ; unchecked_callees_cond } as astate ) =
( { config_checks ; field_checks ; unchecked_callees ; unchecked_callees_cond } as astate ) =
let join_unchecked_callees new_unchecked_callees new_unchecked_callees_cond =
if FieldChecks . is_top field_checks then
{ astate with
unchecked_callees = UncheckedCallees . join unchecked_callees new_unchecked_callees
; unchecked_callees_cond =
UncheckedCalleesCond . join unchecked_callees_cond new_unchecked_callees_cond }
else
let fields_to_add = FieldChecks . get_fields field_checks in
let unchecked_callees_cond =
UncheckedCalleesCond . weak_update fields_to_add new_unchecked_callees
unchecked_callees_cond
in
let unchecked_callees_cond =
UncheckedCalleesCond . fold
( fun fields callees acc ->
UncheckedCalleesCond . weak_update ( Fields . union fields fields_to_add ) callees acc )
new_unchecked_callees_cond unchecked_callees_cond
in
{ astate with unchecked_callees_cond }
in
if ConfigChecks . is_top config_checks then
if ConfigChecks . is_top config_checks then
let ( callee_summary : Summary . t option ) =
let ( callee_summary : Summary . t option ) =
match analyze_dependency callee with
match analyze_dependency callee with
@ -376,53 +399,40 @@ module Dom = struct
| Some ( _ , ( _ , analysis_data , _ ) ) ->
| Some ( _ , ( _ , analysis_data , _ ) ) ->
analysis_data
analysis_data
in
in
let is_expensive = is_known_expensive_method tenv callee args in
let expensiveness_model = get_expensiveness_model tenv callee args in
let has_expensive_callee =
let has_expensive_callee =
Option . exists callee_summary ~ f : Summary . has_known_expensive_callee
Option . exists callee_summary ~ f : Summary . has_known_expensive_callee
in
in
if is_cheap_call && ( not is_expensive ) && not has_expensive_callee then
match expensiveness_model with
(* If callee is cheap by heuristics, ignore it. *)
| None when is_cheap_call && not has_expensive_callee ->
astate
(* If callee is cheap by heuristics, ignore it. *)
else
astate
let new_unchecked_callees , new_unchecked_callees_cond =
| Some KnownCheap ->
if is_expensive then
(* If callee is known cheap by model, ignore it. *)
( UncheckedCallees . singleton
astate
( UncheckedCallee . make ~ is_known_expensive : true callee location )
| Some KnownExpensive ->
, UncheckedCalleesCond . empty )
(* If callee is known expensive by model, add callee's name. *)
else
join_unchecked_callees
match callee_summary with
( UncheckedCallees . singleton
| Some
( UncheckedCallee . make ~ is_known_expensive : true callee location ) )
{ Summary . unchecked_callees = callee_summary
UncheckedCalleesCond . empty
; unchecked_callees_cond = callee_summary_cond
| None -> (
; has_call_stmt }
match callee_summary with
when has_call_stmt ->
| Some
(* If callee's summary is not leaf, use it. *)
{ Summary . unchecked_callees = callee_summary
( UncheckedCallees . replace_location_by_call location callee_summary
; unchecked_callees_cond = callee_summary_cond
, UncheckedCalleesCond . replace_location_by_call location callee_summary_cond )
; has_call_stmt }
| _ ->
when has_call_stmt ->
(* Otherwise, add callee's name. *)
(* If callee's summary is not leaf, use it. *)
( UncheckedCallees . singleton
join_unchecked_callees
( UncheckedCallee . make ~ is_known_expensive : false callee location )
( UncheckedCallees . replace_location_by_call location callee_summary )
, UncheckedCalleesCond . empty )
( UncheckedCalleesCond . replace_location_by_call location callee_summary_cond )
in
| _ ->
if FieldChecks . is_top field_checks then
(* Otherwise, add callee's name. *)
{ astate with
join_unchecked_callees
unchecked_callees = UncheckedCallees . join unchecked_callees new_unchecked_callees
( UncheckedCallees . singleton
; unchecked_callees_cond =
( UncheckedCallee . make ~ is_known_expensive : false callee location ) )
UncheckedCalleesCond . join unchecked_callees_cond new_unchecked_callees_cond }
UncheckedCalleesCond . empty )
else
let fields_to_add = FieldChecks . get_fields field_checks in
let unchecked_callees_cond =
UncheckedCalleesCond . weak_update fields_to_add new_unchecked_callees
unchecked_callees_cond
in
let unchecked_callees_cond =
UncheckedCalleesCond . fold
( fun fields callees acc ->
UncheckedCalleesCond . weak_update ( Fields . union fields fields_to_add ) callees acc )
new_unchecked_callees_cond unchecked_callees_cond
in
{ astate with unchecked_callees_cond }
else astate
else astate
end
end