[refactoring] add make_trace_element to Errlog

Summary:
It was defined in two places and I'm about to add a third, so let's share
instead.

Reviewed By: sblackshear

Differential Revision: D4153420

fbshipit-source-id: 3d2c519

infer/src/IR/Errlog.ml

@@ -20,6 +20,10 @@ type loc_trace_elem = {
   lt_node_tags : (string * string) list (** tags describing the node at the current location *)
 }
 
+let make_trace_element lt_level lt_loc lt_description lt_node_tags =
+  { lt_level; lt_loc; lt_description; lt_node_tags }
+
+
 (** Trace of locations *)
 type loc_trace = loc_trace_elem list
 

infer/src/IR/Errlog.mli

@@ -12,13 +12,16 @@ open! Utils
 (** Module for error logs. *)
 
 (** Element of a loc trace *)
-type loc_trace_elem = {
+type loc_trace_elem = private {
   lt_level : int; (** nesting level of procedure calls *)
   lt_loc : Location.t; (** source location at the current step in the trace *)
   lt_description : string; (** description of the current step in the trace *)
   lt_node_tags : (string * string) list (** tags describing the node at the current location *)
 }
 
+(** build a loc_trace_elem from its constituents (unambiguously identified by their types). *)
+val make_trace_element : int -> Location.t -> string -> (string * string) list -> loc_trace_elem
+
 (** Trace of locations *)
 type loc_trace = loc_trace_elem list
 

infer/src/backend/paths.ml

@@ -445,11 +445,6 @@ end = struct
 
   let create_loc_trace path pos_opt : Errlog.loc_trace =
     let trace = ref [] in
-    let mk_trace_elem level loc descr node_tags =
-      { Errlog.lt_level = level;
-        Errlog.lt_loc = loc;
-        Errlog.lt_description = descr;
-        Errlog.lt_node_tags = node_tags } in
     let g level path _ exn_opt =
       match curr_node path with
       | Some curr_node ->
@@ -465,7 +460,7 @@ end = struct
                   [(Io_infer.Xml.tag_kind,"procedure_start");
                    (Io_infer.Xml.tag_name, name);
                    (Io_infer.Xml.tag_name_id, name_id)] in
-                trace := mk_trace_elem level curr_loc descr node_tags :: !trace
+                trace := Errlog.make_trace_element level curr_loc descr node_tags :: !trace
             | Procdesc.Node.Prune_node (is_true_branch, if_kind, _) ->
                 let descr = match is_true_branch, if_kind with
                   | true, Sil.Ik_if -> "Taking true branch"
@@ -481,7 +476,7 @@ end = struct
                 let node_tags =
                   [(Io_infer.Xml.tag_kind,"condition");
                    (Io_infer.Xml.tag_branch, if is_true_branch then "true" else "false")] in
-                trace := mk_trace_elem level curr_loc descr node_tags :: !trace
+                trace := Errlog.make_trace_element level curr_loc descr node_tags :: !trace
             | Procdesc.Node.Exit_node pname ->
                 let descr = "return from a call to " ^ (Procname.to_string pname) in
                 let name = Procname.to_string pname in
@@ -490,7 +485,7 @@ end = struct
                   [(Io_infer.Xml.tag_kind,"procedure_end");
                    (Io_infer.Xml.tag_name, name);
                    (Io_infer.Xml.tag_name_id, name_id)] in
-                trace := mk_trace_elem level curr_loc descr node_tags :: !trace
+                trace := Errlog.make_trace_element level curr_loc descr node_tags :: !trace
             | _ ->
                 let descr, node_tags =
                   match exn_opt with
@@ -508,7 +503,7 @@ end = struct
                   | Some path_descr ->
                       if String.length descr > 0 then descr^" "^path_descr else path_descr
                   | None -> descr in
-                trace := mk_trace_elem level curr_loc descr node_tags :: !trace
+                trace := Errlog.make_trace_element level curr_loc descr node_tags :: !trace
           end
       | None ->
           () in

infer/src/checkers/annotationReachability.ml

@@ -179,13 +179,7 @@ let lookup_annotation_calls annot pname : CallSite.t list =
 let update_trace loc trace =
   if Location.equal loc Location.dummy then trace
   else
-    let trace_elem = {
-      Errlog.lt_level = 0;
-      lt_loc = loc;
-      lt_description = "";
-      lt_node_tags = [];
-    } in
-    trace_elem :: trace
+    Errlog.make_trace_element 0 loc "" [] :: trace
 
 let string_of_pname =
   Procname.to_simplified_string ~withclass:true

infer/src/checkers/checkers.ml

@@ -131,18 +131,12 @@ module ST = struct
       is_method_suppressed || is_field_suppressed || is_class_suppressed in
 
     let trace =
-      let make_trace_element loc description =
-        [{
-          Errlog.lt_level = 0;
-          Errlog.lt_loc = loc;
-          Errlog.lt_description = description;
-          Errlog.lt_node_tags = []
-        }] in
       let origin_elements =
         match origin_loc with
-        | Some oloc -> make_trace_element oloc "origin"
+        | Some oloc -> [Errlog.make_trace_element 0 oloc "origin" []]
         | None -> [] in
-      origin_elements @ (make_trace_element loc description) in
+      origin_elements @ [Errlog.make_trace_element 0 loc description []]
+    in
 
     if not suppressed then
       begin

infer/src/clang/cFrontend_errors.ml

@@ -111,11 +111,7 @@ let log_frontend_issue translation_unit_context method_decl_opt key issue_desc =
       issue_desc.CIssue.suggestion loc in
   let name = CIssue.to_string issue in
   let exn = Exceptions.Frontend_warning (name, err_desc, __POS__) in
-  let trace = [
-    { Errlog.lt_level = 0;
-      Errlog.lt_loc = issue_desc.CIssue.loc;
-      Errlog.lt_description = "";
-      Errlog.lt_node_tags = []}] in
+  let trace = [ Errlog.make_trace_element 0 issue_desc.CIssue.loc "" [] ] in
   let err_kind = CIssue.severity_of_issue issue in
   let method_name = Ast_utils.full_name_of_decl_opt method_decl_opt in
   let key = Hashtbl.hash (key ^ method_name) in