[reporting] Added logging of procedures analysis stats to backend

Summary:
- During backend execution, infer will log detailed stats about procedure analysis
- Logging is integrated with EventLogger
- `events_to_log` field added to Stats.t record in InferPrint
- New format in InferPrint - Logs
- `format_list` type changed to have a Utils.Outfile option to support Logs format

Reviewed By: dulmarod

Differential Revision: D6834538

fbshipit-source-id: 8c847f5

infer/src/IR/Procdesc.ml

@@ -274,6 +274,8 @@ let get_access pdesc = pdesc.attributes.access
 
 let get_nodes pdesc = pdesc.nodes
 
+let get_nodes_num pdesc = pdesc.nodes_num
+
 let get_proc_name pdesc = pdesc.attributes.proc_name
 
 (** Return the return type of the procedure *)

infer/src/IR/Procdesc.mli

@@ -167,6 +167,8 @@ val get_locals : t -> ProcAttributes.var_data list
 
 val get_nodes : t -> Node.t list
 
+val get_nodes_num : t -> int
+
 val get_proc_name : t -> Typ.Procname.t
 
 val get_ret_type : t -> Typ.t

infer/src/backend/InferPrint.ml

@@ -446,7 +446,8 @@ module Stats = struct
     ; mutable ntimeouts: int
     ; mutable nverified: int
     ; mutable nwarnings: int
-    ; mutable saved_errors: string list }
+    ; mutable saved_errors: string list
+    ; mutable events_to_log: EventLogger.event list }
 
   let create () =
     { files= Hashtbl.create 3
@@ -461,7 +462,8 @@ module Stats = struct
     ; ntimeouts= 0
     ; nverified= 0
     ; nwarnings= 0
-    ; saved_errors= [] }
+    ; saved_errors= []
+    ; events_to_log= [] }
 
 
   let process_loc loc stats =
@@ -549,6 +551,22 @@ module Stats = struct
     process_loc (Specs.get_loc summary) stats
 
 
+  let process_summary_for_logging _ (summary: Specs.summary) _ stats =
+    let num_preposts =
+      match summary.payload.preposts with Some preposts -> List.length preposts | None -> 0
+    in
+    stats.events_to_log
+    <- EventLogger.AnalysisStats
+         { num_preposts
+         ; analysis_nodes_visited= IntSet.cardinal summary.stats.nodes_visited_re
+         ; analysis_total_nodes= Specs.get_proc_desc summary |> Procdesc.get_nodes_num
+         ; symops= summary.stats.symops
+         ; method_location= Specs.get_loc summary
+         ; analysis_status= summary.stats.stats_failure
+         ; method_name= Specs.get_proc_name summary |> Typ.Procname.to_string }
+       :: stats.events_to_log
+
+
   let num_files stats = Hashtbl.length stats.files
 
   let pp fmt stats =
@@ -654,53 +672,99 @@ let error_filter filters proc_name file error_desc error_name =
 
 type report_kind = Issues | Procs | Stats | Calls | Summary [@@deriving compare]
 
-type bug_format_kind = Json | Csv | Tests | Text [@@deriving compare]
+let _string_of_report_kind = function
+  | Issues ->
+      "Issues"
+  | Procs ->
+      "Procs"
+  | Stats ->
+      "Stats"
+  | Calls ->
+      "Calls"
+  | Summary ->
+      "Summary"
+
+
+type bug_format_kind = Json | Csv | Logs | Tests | Text [@@deriving compare]
 
-let pp_issue_in_format (format_kind, (outf: Utils.outfile)) error_filter
+let _string_of_bug_format_kind = function
+  | Json ->
+      "Json"
+  | Csv ->
+      "Csv"
+  | Logs ->
+      "Logs"
+  | Tests ->
+      "Tests"
+  | Text ->
+      "Text"
+
+
+let get_outfile outfile =
+  match outfile with
+  | Some outfile ->
+      outfile
+  | None ->
+      L.(die InternalError) "An outfile is require for this format."
+
+
+let pp_issue_in_format (format_kind, (outfile_opt: Utils.outfile option)) error_filter
     {Issue.proc_name; proc_location; err_key; err_data} =
   match format_kind with
   | Csv ->
       L.(die InternalError) "Printing issues in a CSV format is not implemented"
   | Json ->
+      let outf = get_outfile outfile_opt in
       IssuesJson.pp_issue outf.fmt error_filter proc_name (Some proc_location) err_key err_data
   | Tests ->
       L.(die InternalError) "Printing issues as tests is not implemented"
+  | Logs ->
+      L.(die InternalError) "Printing issues as logs is not implemented"
   | Text ->
+      let outf = get_outfile outfile_opt in
       IssuesTxt.pp_issue outf.fmt error_filter (Some proc_location) err_key err_data
 
 
-let pp_issues_in_format (format_kind, (outf: Utils.outfile)) =
+let pp_issues_in_format (format_kind, (outfile_opt: Utils.outfile option)) =
   match format_kind with
   | Json ->
+      let outf = get_outfile outfile_opt in
       IssuesJson.pp_issues_of_error_log outf.fmt
   | Csv ->
       L.(die InternalError) "Printing issues in a CSV format is not implemented"
   | Tests ->
       L.(die InternalError) "Printing issues as tests is not implemented"
+  | Logs ->
+      L.(die InternalError) "Printing issues as logs is not implemented"
   | Text ->
+      let outf = get_outfile outfile_opt in
       IssuesTxt.pp_issues_of_error_log outf.fmt
 
 
-let pp_procs_in_format (format_kind, (outf: Utils.outfile)) =
+let pp_procs_in_format (format_kind, (outfile_opt: Utils.outfile option)) =
   match format_kind with
   | Csv ->
+      let outf = get_outfile outfile_opt in
       ProcsCsv.pp_summary outf.fmt
-  | Json | Tests | Text ->
+  | Json | Tests | Text | Logs ->
-      L.(die InternalError) "Printing procs in json/tests/text is not implemented"
+      L.(die InternalError) "Printing procs in json/tests/text/logs is not implemented"
 
 
-let pp_calls_in_format (format_kind, (outf: Utils.outfile)) =
+let pp_calls_in_format (format_kind, (outfile_opt: Utils.outfile option)) =
   match format_kind with
   | Csv ->
+      let outf = get_outfile outfile_opt in
       CallsCsv.pp_calls outf.fmt
-  | Json | Tests | Text ->
+  | Json | Tests | Text | Logs ->
-      L.(die InternalError) "Printing calls in json/tests/text is not implemented"
+      L.(die InternalError) "Printing calls in json/tests/text/logs is not implemented"
 
 
 let pp_stats_in_format (format_kind, _) =
   match format_kind with
   | Csv ->
       Stats.process_summary
+  | Logs ->
+      Stats.process_summary_for_logging
   | Json | Tests | Text ->
       L.(die InternalError) "Printing stats in json/tests/text is not implemented"
 
@@ -773,16 +837,20 @@ let pp_json_report_by_report_kind formats_by_report_kind fname =
   match Utils.read_file fname with
   | Ok report_lines ->
       let pp_json_issues format_list report =
-        let pp_json_issue (format_kind, (outf: Utils.outfile)) =
+        let pp_json_issue (format_kind, (outfile_opt: Utils.outfile option)) =
           match format_kind with
           | Tests ->
+              let outf = get_outfile outfile_opt in
               pp_custom_of_report outf.fmt report Config.issues_fields
           | Text ->
+              let outf = get_outfile outfile_opt in
               pp_text_of_report outf.fmt report
           | Json ->
               L.(die InternalError) "Printing issues from json does not support json output"
           | Csv ->
               L.(die InternalError) "Printing issues from json does not support csv output"
+          | Logs ->
+              L.(die InternalError) "Printing issues from json does not support logs output"
         in
         List.iter ~f:pp_json_issue format_list
       in
@@ -931,10 +999,12 @@ let register_perf_stats_report () =
 
 let mk_format format_kind fname =
   Option.value_map
-    ~f:(fun out_file -> [(format_kind, out_file)])
+    ~f:(fun out_file -> [(format_kind, Some out_file)])
     ~default:[] (Utils.create_outfile fname)
 
 
+(** Although the out_file is an Option type, the None option is strictly meant for the
+  logs format_kind, and all other formats should contain an outfile value. *)
 let init_issues_format_list report_json =
   let json_format = Option.value_map ~f:(mk_format Json) ~default:[] report_json in
   let tests_format = Option.value_map ~f:(mk_format Tests) ~default:[] Config.issues_tests in
@@ -944,29 +1014,36 @@ let init_issues_format_list report_json =
 
 let init_procs_format_list () = Option.value_map ~f:(mk_format Csv) ~default:[] Config.procs_csv
 
-let init_calls_format_list () =
+let init_calls_format_list () = Option.value_map ~f:(mk_format Csv) ~default:[] Config.calls_csv
-  let csv_format = Option.value_map ~f:(mk_format Csv) ~default:[] Config.calls_csv in
-  csv_format
-
 
 let init_stats_format_list () =
   let csv_format = Option.value_map ~f:(mk_format Csv) ~default:[] Config.stats_report in
-  csv_format
+  let logs_format = [(Logs, None)] in
+  csv_format @ logs_format
 
 
 let init_files format_list_by_kind =
   let init_files_of_report_kind (report_kind, format_list) =
-    let init_files_of_format (format_kind, (outfile: Utils.outfile)) =
+    let init_files_of_format (format_kind, (outfile_opt: Utils.outfile option)) =
       match (format_kind, report_kind) with
       | Csv, Issues ->
           L.(die InternalError) "Printing issues in a CSV format is not implemented"
+      | Logs, (Issues | Procs | Calls | Summary) ->
+          L.(die InternalError) "Logging these reports is not implemented"
       | Csv, Procs ->
+          let outfile = get_outfile outfile_opt in
           ProcsCsv.pp_header outfile.fmt ()
       | Csv, Stats ->
+          let outfile = get_outfile outfile_opt in
           Report.pp_header outfile.fmt ()
       | Json, Issues ->
+          let outfile = get_outfile outfile_opt in
           IssuesJson.pp_json_open outfile.fmt ()
-      | (Csv | Json | Tests | Text), _ ->
+      | Csv, (Calls | Summary)
+      | Json, (Procs | Stats | Calls | Summary)
+      | Logs, Stats
+      | Tests, _
+      | Text, _ ->
           ()
     in
     List.iter ~f:init_files_of_format format_list
@@ -974,17 +1051,25 @@ let init_files format_list_by_kind =
   List.iter ~f:init_files_of_report_kind format_list_by_kind
 
 
-let finalize_and_close_files format_list_by_kind stats =
+let finalize_and_close_files format_list_by_kind (stats: Stats.t) =
   let close_files_of_report_kind (report_kind, format_list) =
-    let close_files_of_format (format_kind, (outfile: Utils.outfile)) =
+    let close_files_of_format (format_kind, (outfile_opt: Utils.outfile option)) =
       ( match (format_kind, report_kind) with
       | Csv, Stats ->
+          let outfile = get_outfile outfile_opt in
           F.fprintf outfile.fmt "%a@?" Report.pp_stats stats
       | Json, Issues ->
+          let outfile = get_outfile outfile_opt in
           IssuesJson.pp_json_close outfile.fmt ()
-      | (Csv | Tests | Text | Json), _ ->
+      | Logs, Stats ->
+          EventLogger.log_multiple stats.events_to_log
+      | Csv, (Issues | Procs | Calls | Summary)
+      | Logs, (Issues | Procs | Calls | Summary)
+      | Json, (Procs | Stats | Calls | Summary)
+      | Tests, _
+      | Text, _ ->
           () ) ;
-      Utils.close_outf outfile
+      match outfile_opt with Some outfile -> Utils.close_outf outfile | None -> ()
     in
     List.iter ~f:close_files_of_format format_list ;
     ()

infer/src/base/EventLogger.ml

@@ -124,10 +124,40 @@ let create_procedures_translated_row base record =
   |> add_string ~key:"source_file" ~data:(SourceFile.to_rel_path record.source_file)
 
 
+type analysis_stats =
+  { num_preposts: int
+  ; analysis_nodes_visited: int
+  ; analysis_total_nodes: int
+  ; symops: int
+  ; method_location: Location.t
+  ; analysis_status: SymOp.failure_kind option
+  ; method_name: string }
+
+let create_analysis_stats_row base record =
+  let open JsonBuilder in
+  base |> add_int ~key:"num_preposts" ~data:record.num_preposts
+  |> add_int ~key:"analysis_nodes_visited" ~data:record.analysis_nodes_visited
+  |> add_int ~key:"analysis_total_nodes" ~data:record.analysis_total_nodes
+  |> add_int ~key:"symops" ~data:record.symops
+  |> add_string ~key:"source_file" ~data:(SourceFile.to_rel_path record.method_location.file)
+  |> add_string ~key:"method_location"
+       ~data:
+         (String.concat
+            [ string_of_int record.method_location.line
+            ; ":"
+            ; string_of_int record.method_location.col ])
+  |> add_string ~key:"analysis_status"
+       ~data:
+         (Option.value_map record.analysis_status ~default:"OK" ~f:(fun stats_failure ->
+              SymOp.failure_kind_to_string stats_failure ))
+  |> add_string ~key:"method_name" ~data:record.method_name
+
+
 type event =
   | UncaughtException of exn * int
   | FrontendException of frontend_exception
   | ProceduresTranslatedSummary of procedures_translated
+  | AnalysisStats of analysis_stats
 
 let string_of_event event =
   match event with
@@ -137,6 +167,8 @@ let string_of_event event =
       "FrontendException"
   | ProceduresTranslatedSummary _ ->
       "ProceduresTranslatedSummary"
+  | AnalysisStats _ ->
+      "AnalysisStats"
 
 
 let sequence_ctr = ref 0
@@ -173,7 +205,9 @@ let create_row event =
   | FrontendException record ->
       create_frontend_exception_row base record
   | ProceduresTranslatedSummary record ->
-      create_procedures_translated_row base record )
+      create_procedures_translated_row base record
+  | AnalysisStats record ->
+      create_analysis_stats_row base record )
   |> JsonBuilder.to_json
 
 
@@ -181,4 +215,12 @@ let prepare = IO.prepare
 
 let log event = IO.write "%s\n" (create_row event)
 
+let log_multiple events =
+  let rows = List.map ~f:create_row events in
+  let combinedJson =
+    List.fold_right rows ~init:"" ~f:(fun row combined -> combined ^ row ^ "\n")
+  in
+  IO.write "%s" combinedJson
+
+
 let dump = IO.dump

infer/src/base/EventLogger.mli

@@ -22,10 +22,20 @@ type procedures_translated =
   ; lang: string
   ; source_file: SourceFile.t }
 
+type analysis_stats =
+  { num_preposts: int
+  ; analysis_nodes_visited: int
+  ; analysis_total_nodes: int
+  ; symops: int
+  ; method_location: Location.t
+  ; analysis_status: SymOp.failure_kind option
+  ; method_name: string }
+
 type event =
   | UncaughtException of exn * int  (** exception, exitcode *)
   | FrontendException of frontend_exception  (** record of caught exception *)
   | ProceduresTranslatedSummary of procedures_translated  (** record of procedures translated *)
+  | AnalysisStats of analysis_stats  (** record of stats from the backend *)
 
 val get_log_identifier : unit -> string
 
@@ -33,4 +43,6 @@ val prepare : unit -> unit
 
 val log : event -> unit
 
+val log_multiple : event list -> unit
+
 val dump : unit -> unit

infer/src/base/SymOp.ml

@@ -47,11 +47,13 @@ let pp_failure_kind fmt = function
   | FKsymops_timeout symops ->
       F.fprintf fmt "SYMOPS TIMEOUT (%d)" symops
   | FKrecursion_timeout level ->
-      F.fprintf fmt "RECURSION TIMEOUT(%d)" level
+      F.fprintf fmt "RECURSION TIMEOUT (%d)" level
   | FKcrash msg ->
       F.fprintf fmt "CRASH (%s)" msg
 
 
+let failure_kind_to_string failure_kind = Format.asprintf "%a" pp_failure_kind failure_kind
+
 (** Count the number of symbolic operations *)
 
 (** Timeout in seconds for each function *)

infer/src/base/SymOp.mli

@@ -73,3 +73,5 @@ val try_finally : f:(unit -> 'a) -> finally:(unit -> unit) -> 'a
     return reasonably quickly. *)
 
 val pp_failure_kind : Format.formatter -> failure_kind -> unit
+
+val failure_kind_to_string : failure_kind -> string