Renamings: list -> map

Reviewed By: martinoluca

Differential Revision: D9633513

fbshipit-source-id: b0467f71d

infer/src/backend/DifferentialFilters.ml

@@ -9,15 +9,18 @@ open! IStd
 module L = Logging
 
 module FileRenamings = struct
-  type renaming = {current: string; previous: string} [@@deriving compare]
+  type renaming = {current: string; previous: string}
 
-  type t = renaming list [@@deriving compare]
+  module CurrentToPreviousMap = Caml.Map.Make (String)
 
-  let equal = [%compare.equal: t]
+  type t = string CurrentToPreviousMap.t [@@deriving compare]
 
-  let empty = []
+  let empty = CurrentToPreviousMap.empty
+
+  let of_renamings ~fold container =
+    fold container ~init:empty ~f:(fun acc {current; previous} ->
+        CurrentToPreviousMap.add current previous acc )
 
-  let from_renamings rl : t = rl
 
   (* A json renaming assoc list looks like:
      [{"current": "aaa.java", "previous": "BBB.java"}, ...] *)
@@ -51,31 +54,32 @@ module FileRenamings = struct
     in
     match j with
     | `List json_renamings ->
-        List.map ~f:renaming_of_assoc json_renamings
+        of_renamings json_renamings ~fold:(IContainer.map ~f:renaming_of_assoc List.fold)
     | _ ->
         L.(die UserError) "Expected JSON list but got '%s'" input
 
 
   let from_json_file file : t = from_json (In_channel.read_all file)
 
-  let find_previous (t : t) current =
-    let r = List.find ~f:(fun r -> String.equal current r.current) t in
-    Option.map ~f:(fun r -> r.previous) r
+  let find_previous (t : t) current = CurrentToPreviousMap.find_opt current t
 
+  module VISIBLE_FOR_TESTING_DO_NOT_USE_DIRECTLY = struct
+    type nonrec renaming = renaming = {current: string; previous: string}
 
-  let pp fmt t =
-    let pp_tuple fmt {current; previous} =
-      Format.fprintf fmt "{\"current\": \"%s\", \"previous\": \"%s\"}" current previous
-    in
-    Format.fprintf fmt "[%a]" (Pp.comma_seq pp_tuple) t
+    let of_list = of_renamings ~fold:List.fold
 
+    let equal = [%compare.equal: t]
+
+    let pp fmt t =
+      let pp_tuple fmt (current, previous) =
+        Format.fprintf fmt "{\"current\": \"%s\", \"previous\": \"%s\"}" current previous
+      in
+      Format.fprintf fmt "[%a]" (Pp.comma_seq pp_tuple) (CurrentToPreviousMap.bindings t)
 
-  module VISIBLE_FOR_TESTING_DO_NOT_USE_DIRECTLY = struct
-    let from_renamings = from_renamings
 
-    let equal = equal
+    let find_previous = find_previous
 
-    let pp = pp
+    let from_json = from_json
   end
 end
 

infer/src/backend/DifferentialFilters.mli

@@ -8,24 +8,24 @@
 open! IStd
 
 module FileRenamings : sig
-  type renaming = {current: string; previous: string}
-
   type t
 
   val empty : t
 
-  val from_json : string -> t
-
   val from_json_file : string -> t
 
-  val find_previous : t -> string -> string option
-
   module VISIBLE_FOR_TESTING_DO_NOT_USE_DIRECTLY : sig
-    val from_renamings : renaming list -> t
+    type renaming = {current: string; previous: string}
+
+    val of_list : renaming list -> t
 
     val equal : t -> t -> bool
 
     val pp : Format.formatter -> t -> unit
+
+    val find_previous : t -> string -> string option
+
+    val from_json : string -> t
   end
 end
 

infer/src/istd/IContainer.ml

@@ -64,3 +64,6 @@ let pp_collection ~fold ~pp_item fmt c =
 
 let filter ~fold ~filter t ~init ~f =
   fold t ~init ~f:(fun acc item -> if filter item then f acc item else acc)
+
+
+let map ~f:g fold t ~init ~f = fold t ~init ~f:(fun acc item -> f acc (g item))

infer/src/istd/IContainer.mli

@@ -42,3 +42,5 @@ val pp_collection :
 
 val filter :
   fold:('t, 'a, 'accum) Container.fold -> filter:('a -> bool) -> ('t, 'a, 'accum) Container.fold
+
+val map : f:('a -> 'b) -> ('t, 'a, 'accum) Container.fold -> ('t, 'b, 'accum) Container.fold

infer/src/unit/DifferentialFiltersTests.ml

@@ -13,7 +13,9 @@ type 'a outcome = Return of 'a | Raise of exn
 
 let test_file_renamings_from_json =
   let create_test test_input expected_output _ =
-    let test_output input = DifferentialFilters.FileRenamings.from_json input in
+    let test_output input =
+      DifferentialFilters.FileRenamings.VISIBLE_FOR_TESTING_DO_NOT_USE_DIRECTLY.from_json input
+    in
     let pp_diff fmt (expected, actual) =
       let pp = DifferentialFilters.FileRenamings.VISIBLE_FOR_TESTING_DO_NOT_USE_DIRECTLY.pp in
       Format.fprintf fmt "Expected %a but got %a" pp expected pp actual
@@ -31,15 +33,15 @@ let test_file_renamings_from_json =
       ^ "{\"current\": \"ccc.java\", \"previous\": \"DDD.java\"},"
       ^ "{\"current\": \"eee.java\", \"previous\": \"FFF.java\"}" ^ "]"
     , Return
-        (DifferentialFilters.FileRenamings.VISIBLE_FOR_TESTING_DO_NOT_USE_DIRECTLY.from_renamings
-           [ {DifferentialFilters.FileRenamings.current= "aaa.java"; previous= "BBB.java"}
-           ; {DifferentialFilters.FileRenamings.current= "ccc.java"; previous= "DDD.java"}
-           ; {DifferentialFilters.FileRenamings.current= "eee.java"; previous= "FFF.java"} ]) )
+        DifferentialFilters.FileRenamings.VISIBLE_FOR_TESTING_DO_NOT_USE_DIRECTLY.(
+          of_list
+            [ {current= "aaa.java"; previous= "BBB.java"}
+            ; {current= "ccc.java"; previous= "DDD.java"}
+            ; {current= "eee.java"; previous= "FFF.java"} ]) )
   ; ( "test_file_renamings_from_json_with_good_empty_input"
     , "[]"
-    , Return
-        (DifferentialFilters.FileRenamings.VISIBLE_FOR_TESTING_DO_NOT_USE_DIRECTLY.from_renamings
-           []) )
+    , Return (DifferentialFilters.FileRenamings.VISIBLE_FOR_TESTING_DO_NOT_USE_DIRECTLY.of_list [])
+    )
   ; ( "test_file_renamings_from_json_with_well_formed_but_unexpected_input"
     , "{}"
     , Raise (Logging.InferUserError "Expected JSON list but got '{}'") )
@@ -60,13 +62,16 @@ let test_file_renamings_from_json =
 
 let test_file_renamings_find_previous =
   let renamings =
-    DifferentialFilters.FileRenamings.VISIBLE_FOR_TESTING_DO_NOT_USE_DIRECTLY.from_renamings
-      [ {DifferentialFilters.FileRenamings.current= "aaa.java"; previous= "BBB.java"}
-      ; {DifferentialFilters.FileRenamings.current= "ccc.java"; previous= "DDD.java"}
-      ; {DifferentialFilters.FileRenamings.current= "eee.java"; previous= "FFF.java"} ]
+    DifferentialFilters.FileRenamings.VISIBLE_FOR_TESTING_DO_NOT_USE_DIRECTLY.(
+      of_list
+        [ {current= "aaa.java"; previous= "BBB.java"}
+        ; {current= "ccc.java"; previous= "DDD.java"}
+        ; {current= "eee.java"; previous= "FFF.java"} ])
   in
   let cmp s1 s2 = [%compare.equal: string option] s1 s2 in
-  let find_previous = DifferentialFilters.FileRenamings.find_previous in
+  let find_previous =
+    DifferentialFilters.FileRenamings.VISIBLE_FOR_TESTING_DO_NOT_USE_DIRECTLY.find_previous
+  in
   let pp_diff fmt (expected, actual) =
     let pp_str_opt fmt str_opt =
       let out = match str_opt with Some str -> "Some " ^ str | None -> "None" in
@@ -162,9 +167,10 @@ let test_skip_duplicated_types_on_filenames =
     ; create_fake_jsonbug ~bug_type:"bug_type_1" ~file:"file_2.java" ~hash:"2" () ]
   in
   let renamings =
-    DifferentialFilters.FileRenamings.VISIBLE_FOR_TESTING_DO_NOT_USE_DIRECTLY.from_renamings
-      [ {DifferentialFilters.FileRenamings.current= "file_2'.java"; previous= "file_2.java"}
-      ; {DifferentialFilters.FileRenamings.current= "file_1'.java"; previous= "file_1.java"} ]
+    DifferentialFilters.FileRenamings.VISIBLE_FOR_TESTING_DO_NOT_USE_DIRECTLY.(
+      of_list
+        [ {current= "file_2'.java"; previous= "file_2.java"}
+        ; {current= "file_1'.java"; previous= "file_1.java"} ])
   in
   let diff = Differential.of_reports ~current_report ~previous_report in
   let diff' =