@ -78,39 +78,42 @@ let method_is_expensive tenv pname =
 
			
		
	
		
		
			
				
					
					  | |  check_method  Annotations . ia_is_expensive  pname 
  | |  check_method  Annotations . ia_is_expensive  pname 
 
			
		
	
		
		
			
				
					
					
 
			
		
	
		
		
			
				
					
					
 
			
		
	
		
		
			
				
					
					let  lookup_ call_tree s pname  = let  lookup_ expensive_ calls pname  =  
			
				
				
			
		
	
		
		
	
		
		
			
				
					
					  match  Specs . get_summary  pname  with 
  match  Specs . get_summary  pname  with 
 
			
		
	
		
		
			
				
					
					  |  None  ->  [] 
  |  None  ->  [] 
 
			
		
	
		
		
			
				
					
					  |  Some  summary  -> 
  |  Some  summary  -> 
 
			
		
	
		
		
			
				
					
					      begin 
      begin 
 
			
		
	
		
		
			
				
					
					        match  summary . Specs . payload . Specs . calls  with 
        match  summary . Specs . payload . Specs . calls  with 
 
			
		
	
		
		
			
				
					
					        |  Some  tree ->  tree  
        |  Some  calls ->  calls  
 
			
				
				
			
		
	
		
		
	
		
		
			
				
					
					        |  None  ->  [] 
        |  None  ->  [] 
 
			
		
	
		
		
			
				
					
					      end 
      end 
 
			
		
	
		
		
			
				
					
					
 
			
		
	
		
		
			
				
					
					
 
			
		
	
		
		
			
				
					
					let  method_calls_expensive  tenv  pname  =  
			
		
	
		
		
			
				
					
					  method_is_expensive  tenv  pname 
 
			
		
	
		
		
			
				
					
					  | |  lookup_expensive_calls  pname  < >  [] 
 
			
		
	
		
		
			
				
					
					
 
			
		
	
		
		
			
				
					
					
 
			
		
	
		
		
			
				
					
					let  lookup_location  pname  = let  lookup_location  pname  =  
			
		
	
		
		
			
				
					
					  match  Specs . get_summary  pname  with 
  match  Specs . get_summary  pname  with 
 
			
		
	
		
		
			
				
					
					  |  None  ->  Location . dummy 
  |  None  ->  Location . dummy 
 
			
		
	
		
		
			
				
					
					  |  Some  summary  ->  summary . Specs . attributes . ProcAttributes . loc 
  |  Some  summary  ->  summary . Specs . attributes . ProcAttributes . loc 
 
			
		
	
		
		
			
				
					
					
 
			
		
	
		
		
			
				
					
					
 
			
		
	
		
		
			
				
					
					let  collect_expensive_call  tenv  caller_pdesc  checked_pnames  call_ trees  ( pname ,  _ )  = let  collect_expensive_call  tenv  caller_pdesc  checked_pnames  call_ lis t ( pname ,  _ )  =  
			
				
				
			
		
	
		
		
			
				
					
					  if  Procname . Set . mem  pname  ! checked_pnames  then  call_ trees 
  if  Procname . Set . mem  pname  ! checked_pnames  then  call_ lis t
 
			
				
				
			
		
	
		
		
	
		
		
	
		
		
			
				
					
					  else 
  else 
 
			
		
	
		
		
			
				
					
					    begin 
    begin 
 
			
		
	
		
		
			
				
					
					      Ondemand . do_analysis  caller_pdesc  pname ; 
      Ondemand . do_analysis  caller_pdesc  pname ; 
 
			
		
	
		
		
			
				
					
					      checked_pnames  :=  Procname . Set . add  pname  ! checked_pnames ; 
      checked_pnames  :=  Procname . Set . add  pname  ! checked_pnames ; 
 
			
		
	
		
		
			
				
					
					      let  call_loc  =  lookup_location  pname  in 
      let  call_loc  =  lookup_location  pname  in 
 
			
		
	
		
		
			
				
					
					      if  method_ i s_expensive tenv  pname  then 
      if  method_ call s_expensive tenv  pname  then 
 
			
				
				
			
		
	
		
		
			
				
					
					        ( CallTree . Direct  ( pname ,  call_loc ) ) ::  call_ trees 
        ( pname ,  call_loc )  ::  call_ lis t
 
			
				
				
			
		
	
		
		
	
		
		
	
		
		
			
				
					
					      else 
      else 
 
			
		
	
		
		
			
				
					
					        match  lookup_call_trees  pname  with 
        call_list 
 
			
				
				
			
		
	
		
		
			
				
					
					        |  []  ->  call_trees 
 
			
		
	
		
		
			
				
					
					        |  calls  ->  ( CallTree . Indirect  ( ( pname ,  call_loc ) ,  calls ) )  ::  call_trees 
 
			
		
	
		
		
	
		
		
			
				
					
					    end 
    end 
 
			
		
	
		
		
			
				
					
					
 
			
		
	
		
		
			
				
					
					let  update_summary  call _tree s pname  = let  update_summary  call s pname  =  
			
				
				
			
		
	
		
		
	
		
		
			
				
					
					  match  Specs . get_summary  pname  with 
  match  Specs . get_summary  pname  with 
 
			
		
	
		
		
			
				
					
					  |  None  ->  () 
  |  None  ->  () 
 
			
		
	
		
		
			
				
					
					  |  Some  summary  -> 
  |  Some  summary  -> 
 
			
		
	
	
		
		
			
				
					
						
						
						
							
								 
						
					 
					@ -118,12 +121,12 @@ let update_summary call_trees pname =
 
			
		
	
		
		
			
				
					
					        {  summary  with 
        {  summary  with 
 
			
		
	
		
		
			
				
					
					          Specs . payload  = 
          Specs . payload  = 
 
			
		
	
		
		
			
				
					
					            {  summary . Specs . payload  with 
            {  summary . Specs . payload  with 
 
			
		
	
		
		
			
				
					
					              Specs . calls  =  Some  call _tree s;  } 
              Specs . calls  =  Some  call s;  } 
 
			
				
				
			
		
	
		
		
	
		
		
			
				
					
					        }  in 
        }  in 
 
			
		
	
		
		
			
				
					
					      Specs . add_summary  pname  updated_summary 
      Specs . add_summary  pname  updated_summary 
 
			
		
	
		
		
			
				
					
					
 
			
		
	
		
		
			
				
					
					
 
			
		
	
		
		
			
				
					
					let  report_expensive_calls  pdesc  loc  call _tree s = let  report_expensive_calls  tenv  pname pdesc  loc  call s =  
			
				
				
			
		
	
		
		
	
		
		
			
				
					
					  let  string_of_pname  =  Procname . to_simplified_string  ~ withclass : true  in 
  let  string_of_pname  =  Procname . to_simplified_string  ~ withclass : true  in 
 
			
		
	
		
		
			
				
					
					  let  update_trace  trace  loc  = 
  let  update_trace  trace  loc  = 
 
			
		
	
		
		
			
				
					
					    if  Location . equal  loc  Location . dummy  then  trace 
    if  Location . equal  loc  Location . dummy  then  trace 
 
			
		
	
	
		
		
			
				
					
						
						
						
							
								 
						
					 
					@ -135,30 +138,36 @@ let report_expensive_calls pname pdesc loc call_trees =
 
			
		
	
		
		
			
				
					
					        lt_node_tags  =  [] ; 
        lt_node_tags  =  [] ; 
 
			
		
	
		
		
			
				
					
					      }  in 
      }  in 
 
			
		
	
		
		
			
				
					
					      trace_elem  ::  trace  in 
      trace_elem  ::  trace  in 
 
			
		
	
		
		
			
				
					
					  let  rec  report_call_tree  ( trace ,  stack_str )  call_tree  = 
  let  rec  report_expensive_call  visited_pnames  ( trace ,  stack_str )  ( callee_pname ,  callee_loc )  = 
 
			
				
				
			
		
	
		
		
			
				
					
					    match  call_tree  with 
    if  method_is_expensive  tenv  callee_pname  then 
 
			
				
				
			
		
	
		
		
			
				
					
					    |  CallTree . Direct  ( expensive_pname ,  callee_loc )  -> 
      let  final_trace  =  IList . rev  ( update_trace  trace  callee_loc )  in 
 
			
				
				
			
		
	
		
		
			
				
					
					        let  final_trace  =  IList . rev  ( update_trace  trace  callee_loc )  in 
      let  exp_pname_str  =  string_of_pname  callee_pname  in 
 
			
				
				
			
		
	
		
		
			
				
					
					        let  exp_pname_str  =  string_of_pname  expensive_pname  in 
      let  description  = 
 
			
				
				
			
		
	
		
		
			
				
					
					        let  description  = 
        Printf . sprintf 
 
			
				
				
			
		
	
		
		
			
				
					
					          Printf . sprintf 
          " Method `%s` annotated with `@%s` calls `%s%s` where `%s` is annotated with `@%s` " 
 
			
				
				
			
		
	
		
		
			
				
					
					            " Method `%s` annotated with `@%s` calls `%s%s` where `%s` is annotated with `@%s` " 
          ( Procname . to_simplified_string  pname ) 
 
			
				
				
			
		
	
		
		
			
				
					
					            ( Procname . to_simplified_string  pname ) 
          Annotations . performance_critical 
 
			
				
				
			
		
	
		
		
			
				
					
					            Annotations . performance_critical 
          stack_str 
 
			
				
				
			
		
	
		
		
			
				
					
					            stack_str 
          exp_pname_str 
 
			
				
				
			
		
	
		
		
			
				
					
					            exp_pname_str 
          exp_pname_str 
 
			
				
				
			
		
	
		
		
			
				
					
					            exp_pname_str 
          Annotations . expensive  in 
 
			
				
				
			
		
	
		
		
			
				
					
					            Annotations . expensive  in 
      let  exn  = 
 
			
				
				
			
		
	
		
		
			
				
					
					        let  exn  = 
        Exceptions . Checkers  ( calls_expensive_method ,  Localise . verbatim_desc  description )  in 
 
			
				
				
			
		
	
		
		
			
				
					
					          Exceptions . Checkers  ( calls_expensive_method ,  Localise . verbatim_desc  description )  in 
      Reporting . log_error  pname  ~ loc :  ( Some  loc )  ~ ltr :  ( Some  final_trace )  exn 
 
			
				
				
			
		
	
		
		
			
				
					
					        Reporting . log_error  pname  ~ loc :  ( Some  loc )  ~ ltr :  ( Some  final_trace )  exn 
    else 
 
			
				
				
			
		
	
		
		
			
				
					
					    |  CallTree . Indirect  ( ( callee_pname ,  callee_loc ) ,  sub_trees )  -> 
      let  next_calls  =  lookup_expensive_calls  callee_pname  in 
 
			
				
				
			
		
	
		
		
			
				
					
					        let  callee_pname_str  =  string_of_pname  callee_pname  in 
      let  callee_pname_str  =  string_of_pname  callee_pname  in 
 
			
				
				
			
		
	
		
		
			
				
					
					        let  new_stack_str  =  stack_str  ^  callee_pname_str  ^  "  ->  "  in 
      let  new_stack_str  =  stack_str  ^  callee_pname_str  ^  "  ->  "  in 
 
			
				
				
			
		
	
		
		
			
				
					
					        let  new_trace  =  update_trace  trace  callee_loc  in 
      let  new_trace  =  update_trace  trace  callee_loc  in 
 
			
				
				
			
		
	
		
		
			
				
					
					        IList . iter  ( report_call_tree  ( new_trace ,  new_stack_str ) )  sub_trees  in 
      let  unseen_pnames ,  updated_visited  = 
 
			
				
				
			
		
	
		
		
	
		
		
	
		
		
	
		
		
	
		
		
	
		
		
	
		
		
	
		
		
	
		
		
	
		
		
	
		
		
	
		
		
	
		
		
	
		
		
	
		
		
	
		
		
	
		
		
	
		
		
	
		
		
	
		
		
	
		
		
	
		
		
	
		
		
			
				
					
					        IList . fold_left 
 
			
		
	
		
		
			
				
					
					          ( fun  ( accu ,  set )  ( p ,  loc )  -> 
 
			
		
	
		
		
			
				
					
					             if  Procname . Set . mem  p  set  then  ( accu ,  set ) 
 
			
		
	
		
		
			
				
					
					             else  ( ( p ,  loc )  ::  accu ,  Procname . Set . add  p  set ) ) 
 
			
		
	
		
		
			
				
					
					          ( [] ,  visited_pnames )  next_calls  in 
 
			
		
	
		
		
			
				
					
					      IList . iter  ( report_expensive_call  updated_visited  ( new_trace ,  new_stack_str ) )  unseen_pnames  in 
 
			
		
	
		
		
			
				
					
					  let  start_trace  =  update_trace  []  ( Cfg . Procdesc . get_loc  pdesc )  in 
  let  start_trace  =  update_trace  []  ( Cfg . Procdesc . get_loc  pdesc )  in 
 
			
		
	
		
		
			
				
					
					  IList . iter  ( report_call_tree  ( start_trace ,  " " ) )  call_trees 
  IList . iter  ( report_ expensive_call Procname . Set . empty   ( start_trace ,  " " ) )  call s
 
			
				
				
			
		
	
		
		
	
		
		
			
				
					
					
 
			
		
	
		
		
			
				
					
					
 
			
		
	
		
		
			
				
					
					let  check_one_procedure  tenv  pname  pdesc  = let  check_one_procedure  tenv  pname  pdesc  =  
			
		
	
	
		
		
			
				
					
						
							
								 
						
						
							
								 
						
						
					 
					@ -186,18 +195,15 @@ let check_one_procedure tenv pname pdesc =
 
			
		
	
		
		
			
				
					
					    PatternMatch . proc_iter_overridden_methods 
    PatternMatch . proc_iter_overridden_methods 
 
			
		
	
		
		
			
				
					
					      check_expensive_subtyping_rules  tenv  pname ; 
      check_expensive_subtyping_rules  tenv  pname ; 
 
			
		
	
		
		
			
				
					
					
 
			
		
	
		
		
			
				
					
					  let  expensive_call _tree s = 
  let  expensive_call s = 
 
			
				
				
			
		
	
		
		
	
		
		
			
				
					
					    let  checked_pnames  =  ref  Procname . Set . empty  in 
    let  checked_pnames  =  ref  Procname . Set . empty  in 
 
			
		
	
		
		
			
				
					
					    Cfg . Procdesc . fold_calls 
    Cfg . Procdesc . fold_calls 
 
			
		
	
		
		
			
				
					
					      ( collect_expensive_call  tenv  pdesc  checked_pnames )  []  pdesc  in 
      ( collect_expensive_call  tenv  pdesc  checked_pnames )  []  pdesc  in 
 
			
		
	
		
		
			
				
					
					
 
			
		
	
		
		
			
				
					
					  update_summary  expensive_call _tree s pname ; 
  update_summary  expensive_call s pname ; 
 
			
				
				
			
		
	
		
		
	
		
		
			
				
					
					
 
			
		
	
		
		
			
				
					
					  match  expensive_call_trees  with 
  if  performance_critical  then 
 
			
				
				
			
		
	
		
		
			
				
					
					  |  []  ->  () 
    report_expensive_calls  tenv  pname  pdesc  loc  expensive_calls 
 
			
				
				
			
		
	
		
		
			
				
					
					  |  call_trees  when  performance_critical  -> 
 
			
		
	
		
		
			
				
					
					      report_expensive_calls  pname  pdesc  loc  call_trees 
 
			
		
	
		
		
			
				
					
					  |  _  ->  () 
 
			
		
	
		
		
	
		
		
	
		
		
			
				
					
					
 
			
		
	
		
		
			
				
					
					
 
			
		
	
		
		
			
				
					
					let  callback_performance_checker  {  Callbacks . proc_desc ;  proc_name ;  get_proc_desc ;  tenv  }  = let  callback_performance_checker  {  Callbacks . proc_desc ;  proc_name ;  get_proc_desc ;  tenv  }  =