[cost] extend BasicCost to BasicCostWithReason

Summary:
Extend BasicCost to BasicCostWithReason which contains a record of the form
```{cost: BasicCost.t; proc_name_list: Procname.t list}```

This is done so that we can keep track of top cost function.
So the idea is that 80% of functions with Top cost are caused by calling top-costed callees, i.e. callee's Top cost is simply propagated to its transitive callers, so the aim is to investigate such root callees along with the number of their transitive callers.

Therefore, we create an extension that match `cost` to the root cause function.

This diff only handles the extension. Details about how we update the root cause function is in the next diff.

Reviewed By: skcho

Differential Revision: D22158717

fbshipit-source-id: 6498d904f

infer/src/cost/cost.ml

@@ -9,6 +9,7 @@ open! IStd
 module F = Format
 module L = Logging
 module BasicCost = CostDomain.BasicCost
+module BasicCostWithReason = CostDomain.BasicCostWithReason
 
 (* CFG modules used in several other modules  *)
 module InstrCFG = ProcCfg.NormalOneInstrPerNode
@@ -29,10 +30,10 @@ let instantiate_cost integer_type_widths ~inferbo_caller_mem ~callee_pname ~call
     BufferOverrunSemantics.mk_eval_sym_cost integer_type_widths callee_formals params
       inferbo_caller_mem
   in
-  BasicCost.subst callee_pname loc callee_cost eval_sym
+  BasicCostWithReason.subst callee_pname loc callee_cost eval_sym
 
 
-module InstrBasicCost = struct
+module InstrBasicCostWithReason = struct
   (*
     Compute the cost for an instruction.
     For example for basic operation we set it to 1 and for function call we take it from the spec of the function.
@@ -95,8 +96,8 @@ module InstrBasicCost = struct
                           instantiate_cost integer_type_widths ~inferbo_caller_mem:inferbo_mem
                             ~callee_pname ~callee_formals ~params ~callee_cost ~loc )
                     in
-                    if BasicCost.is_top (CostDomain.get_operation_cost instantiated_cost) then
-                      CostDomain.unit_cost_atomic_operation
+                    if BasicCostWithReason.is_top (CostDomain.get_operation_cost instantiated_cost)
+                    then CostDomain.unit_cost_atomic_operation
                     else instantiated_cost
                 | `NotFound ->
                     ScubaLogging.log_message ~label:"unmodeled_function_cost_analysis"
@@ -146,14 +147,14 @@ module InstrBasicCost = struct
         (Sil.pp_instr ~print_types:false Pp.text)
         instr
     in
-    if BasicCost.is_top operation_cost then log_msg "top"
-    else if BasicCost.is_unreachable operation_cost then log_msg "unreachable" ;
+    if BasicCostWithReason.is_top operation_cost then log_msg "top"
+    else if BasicCostWithReason.is_unreachable operation_cost then log_msg "unreachable" ;
     cost
 end
 
 let compute_errlog_extras cost =
-  { Jsonbug_t.cost_polynomial= Some (Format.asprintf "%a" BasicCost.pp_hum cost)
-  ; cost_degree= BasicCost.degree cost |> Option.map ~f:Polynomials.Degree.encode_to_int
+  { Jsonbug_t.cost_polynomial= Some (Format.asprintf "%a" BasicCostWithReason.pp_hum cost)
+  ; cost_degree= BasicCostWithReason.degree cost |> Option.map ~f:Polynomials.Degree.encode_to_int
   ; nullsafe_extra= None }
 
 
@@ -164,7 +165,9 @@ module WorstCaseCost = struct
       we report Top cost only at the top level per function. *)
   let exec_node tenv extras instr_node =
     let {get_node_nb_exec} = extras in
-    let instr_cost_record = InstrBasicCost.get_instr_node_cost_record tenv extras instr_node in
+    let instr_cost_record =
+      InstrBasicCostWithReason.get_instr_node_cost_record tenv extras instr_node
+    in
     let node = InstrCFG.Node.underlying_node instr_node in
     let nb_exec = get_node_nb_exec node in
     if BasicCost.is_top nb_exec then
@@ -191,11 +194,11 @@ module Check = struct
     let report issue suffix =
       let message = F.asprintf "%s of the function %a %s" name Procname.pp pname suffix in
       Reporting.log_issue proc_desc err_log ~loc
-        ~ltr:(BasicCost.polynomial_traces cost)
+        ~ltr:(BasicCostWithReason.polynomial_traces cost)
         ~extras:(compute_errlog_extras cost) Cost issue message
     in
-    if BasicCost.is_top cost then report infinite_issue "cannot be computed"
-    else if BasicCost.is_unreachable cost then
+    if BasicCostWithReason.is_top cost then report infinite_issue "cannot be computed"
+    else if BasicCostWithReason.is_unreachable cost then
       report unreachable_issue
         "cannot be computed since the program's exit state is never reachable"
 

infer/src/cost/cost.mli

@@ -20,8 +20,8 @@ val instantiate_cost :
   -> callee_pname:Procname.t
   -> callee_formals:(Pvar.t * Typ.t) list
   -> params:(Exp.t * Typ.t) list
-  -> callee_cost:CostDomain.BasicCost.t
+  -> callee_cost:CostDomain.BasicCostWithReason.t
   -> loc:Location.t
-  -> CostDomain.BasicCost.t
+  -> CostDomain.BasicCostWithReason.t
 
 val is_report_suppressed : Procname.t -> bool

infer/src/cost/costDomain.ml

@@ -16,24 +16,58 @@ module BasicCost = struct
   let version = 7
 end
 
+module BasicCostWithReason = struct
+  type t = {cost: BasicCost.t; top_pname_opt: Procname.t option}
+
+  let is_top {cost} = BasicCost.is_top cost
+
+  let is_unreachable {cost} = BasicCost.is_unreachable cost
+
+  let zero = {cost= BasicCost.zero; top_pname_opt= None}
+
+  let one = {cost= BasicCost.one; top_pname_opt= None}
+
+  let subst callee_pname location record eval_sym =
+    {record with cost= BasicCost.subst callee_pname location record.cost eval_sym}
+
+
+  let plus record1 record2 =
+    { cost= BasicCost.plus record1.cost record2.cost
+    ; top_pname_opt= Option.first_some record1.top_pname_opt record2.top_pname_opt }
+
+
+  let degree {cost} = BasicCost.degree cost
+
+  let mult_unreachable cost record = {record with cost= BasicCost.mult_unreachable cost record.cost}
+
+  let polynomial_traces {cost} = BasicCost.polynomial_traces cost
+
+  let pp format {cost} = BasicCost.pp format cost
+
+  let pp_hum = pp
+end
+
 (** Module to simulate a record
     [{OperationCost:BasicCost.t; AllocationCost: BasicCost.t; IOCost:BasicCost.t}] with a map
     [{OperationCost, AllocationCost, IOCost} -> BasicCost.t] *)
 module VariantCostMap = struct
-  include PrettyPrintable.PPMonoMapOfPPMap (CostIssues.CostKindMap) (BasicCost)
+  include PrettyPrintable.PPMonoMapOfPPMap (CostIssues.CostKindMap) (BasicCostWithReason)
 
   let[@warning "-32"] add _ = Logging.die InternalError "Don't call me"
 
-  let get kind record = find_opt kind record |> Option.value ~default:BasicCost.zero
+  let get kind record = find_opt kind record |> Option.value ~default:BasicCostWithReason.zero
 
   let increase_by kind cost_to_add record =
     update kind
       (function
-        | None -> Some cost_to_add | Some existing -> Some (BasicCost.plus cost_to_add existing) )
+        | None ->
+            Some cost_to_add
+        | Some existing ->
+            Some (BasicCostWithReason.plus cost_to_add existing) )
       record
 
 
-  let increment kind record = increase_by kind BasicCost.one record
+  let increment kind record = increase_by kind BasicCostWithReason.one record
 end
 
 type t = VariantCostMap.t
@@ -51,11 +85,11 @@ let map ~f cost_record = VariantCostMap.map f cost_record
 let zero_record = VariantCostMap.empty
 
 (** If nb_exec is unreachable, we map to unreachable, not 0 *)
-let mult_by cost_record ~nb_exec = map cost_record ~f:(BasicCost.mult_unreachable nb_exec)
+let mult_by cost_record ~nb_exec = map cost_record ~f:(BasicCostWithReason.mult_unreachable nb_exec)
 
 let plus cost_record1 cost_record2 =
   VariantCostMap.union
-    (fun _kind cost1 cost2 -> Some (BasicCost.plus cost1 cost2))
+    (fun _kind cost1 cost2 -> Some (BasicCostWithReason.plus cost1 cost2))
     cost_record1 cost_record2
 
 
@@ -64,4 +98,6 @@ let unit_cost_atomic_operation = VariantCostMap.increment CostKind.OperationCost
 let unit_cost_allocation = VariantCostMap.increment CostKind.AllocationCost zero_record
 
 let of_operation_cost operation_cost =
-  VariantCostMap.increase_by CostKind.OperationCost operation_cost zero_record
+  VariantCostMap.increase_by CostKind.OperationCost
+    {cost= operation_cost; top_pname_opt= None}
+    zero_record

infer/src/cost/costDomain.mli

@@ -17,8 +17,35 @@ module BasicCost : sig
   (** version used to consistently compare at infer-reportdiff phase *)
 end
 
+module BasicCostWithReason : sig
+  (** This is for [Call] instruction. Most top cost function is caused by calling top-costed
+      function. The extension aims to find the root callee with top cost.
+
+      If the callee top cost and thus the caller has top cost, then
+
+      1. if for callee, [top_pname_opt] is [None], then callee is itself top cost, so for the
+      caller, we record [top_pname_opt = callee] ;
+
+      2. if for callee, [top_pname_opt] is [f], then we know that callee calls [f], which is top
+      cost, so for the caller, we record [top_pname_opt = f] *)
+
+  type t = {cost: BasicCost.t; top_pname_opt: Procname.t option}
+
+  val is_top : t -> bool
+
+  val is_unreachable : t -> bool
+
+  val subst : Procname.t -> Location.t -> t -> Bounds.Bound.eval_sym -> t
+
+  val degree : t -> Polynomials.Degree.t option
+
+  val polynomial_traces : t -> Errlog.loc_trace
+
+  val pp_hum : Format.formatter -> t -> unit
+end
+
 module VariantCostMap : sig
-  type t = BasicCost.t CostIssues.CostKindMap.t
+  type t = BasicCostWithReason.t CostIssues.CostKindMap.t
 
   val pp : F.formatter -> t -> unit
 end
@@ -29,11 +56,11 @@ type summary = {post: t; is_on_ui_thread: bool}
 
 val pp_summary : F.formatter -> summary -> unit
 
-val get_cost_kind : CostKind.t -> t -> BasicCost.t
+val get_cost_kind : CostKind.t -> t -> BasicCostWithReason.t
 
-val get_operation_cost : t -> BasicCost.t
+val get_operation_cost : t -> BasicCostWithReason.t
 
-val map : f:(BasicCost.t -> BasicCost.t) -> t -> t
+val map : f:(BasicCostWithReason.t -> BasicCostWithReason.t) -> t -> t
 
 val zero_record : t
 (** Map representing cost record \{OperationCost:0; AllocationCost:0; IOCost:0\} *)

infer/src/cost/hoisting.ml

@@ -111,10 +111,11 @@ let get_cost_if_expensive tenv integer_type_widths get_callee_cost_summary_and_f
     match get_callee_cost_summary_and_formals pname with
     | Some (CostDomain.{post= cost_record}, callee_formals) ->
         let callee_cost = CostDomain.get_operation_cost cost_record in
-        if CostDomain.BasicCost.is_symbolic callee_cost then
+        if CostDomain.BasicCost.is_symbolic callee_cost.cost then
           Some
             (Cost.instantiate_cost integer_type_widths ~inferbo_caller_mem:inferbo_mem
                ~callee_pname:pname ~callee_formals ~params ~callee_cost ~loc)
+              .cost
         else None
     | None ->
         let fun_arg_list =

infer/src/integration/JsonReports.ml

@@ -268,7 +268,7 @@ module JsonCostsPrinter = MakeJsonListPrinter (struct
           ; procedure_name= Procname.get_method proc_name
           ; procedure_id= procedure_id_of_procname proc_name
           ; is_on_ui_thread
-          ; exec_cost= cost_info (CostDomain.get_cost_kind CostKind.OperationCost post) }
+          ; exec_cost= cost_info (CostDomain.get_cost_kind CostKind.OperationCost post).cost }
         in
         Some (Jsonbug_j.string_of_cost_item cost_item)
     | _ ->