ppx_compare DB

Reviewed By: cristianoc

Differential Revision: D4232372

fbshipit-source-id: 5cc11c9

infer/src/IR/AttributesTable.re

@@ -77,7 +77,7 @@ let store_attributes (proc_attributes: ProcAttributes.t) => {
     | Some proc_attributes_on_disk =>
       let higher_rank_than_on_disk () =>
         proc_attributes.is_defined &&
-        DB.source_file_compare proc_attributes.loc.file proc_attributes_on_disk.loc.file > 0;
+        DB.compare_source_file proc_attributes.loc.file proc_attributes_on_disk.loc.file > 0;
       let becomes_defined = proc_attributes.is_defined && not proc_attributes_on_disk.is_defined;
       /* Only overwrite the attribute file if the procedure becomes defined
          or its associated file has higher rank (alphabetically) than on disk. */
@@ -217,7 +217,7 @@ let find_file_capturing_procedure pname =>
     let origin =
       /* Procedure coming from include files if it has different location
          than the file where it was captured. */
-      DB.source_file_compare source_file proc_attributes.ProcAttributes.loc.file != 0 ?
+      DB.compare_source_file source_file proc_attributes.ProcAttributes.loc.file != 0 ?
         `Include : `Source;
     let cfg_fname = DB.source_dir_get_internal_file source_dir ".cfg";
     let cfg_fname_exists = Sys.file_exists (DB.filename_to_string cfg_fname);

infer/src/IR/Location.re

@@ -25,7 +25,7 @@ let compare loc1 loc2 => {
   if (n != 0) {
     n
   } else {
-    DB.source_file_compare loc1.file loc2.file
+    DB.compare_source_file loc1.file loc2.file
   }
 };
 

infer/src/IR/Pvar.re

@@ -63,7 +63,7 @@ let rec pvar_kind_compare k1 k2 =>
   | (Abduced_ref_param _, _) => (-1)
   | (_, Abduced_ref_param _) => 1
   | (Global_var (f1, const1, pod1), Global_var (f2, const2, pod2)) =>
-    let n = DB.source_file_compare f1 f2;
+    let n = DB.compare_source_file f1 f2;
     if (n != 0) {
       n
     } else {

infer/src/backend/InferPrint.re

@@ -1287,7 +1287,7 @@ let module AnalysisResults = {
     apply_without_gc (IList.iter load_file) (spec_files_from_cmdline ());
     let summ_cmp (_, summ1) (_, summ2) => {
       let n =
-        DB.source_file_compare
+        DB.compare_source_file
           summ1.Specs.attributes.ProcAttributes.loc.Location.file
           summ2.Specs.attributes.ProcAttributes.loc.Location.file;
       if (n != 0) {

infer/src/backend/dotty.ml

@@ -1017,7 +1017,7 @@ let pp_cfgnode pdesc fmt (n: Procdesc.Node.t) =
 let print_icfg source fmt cfg =
   let print_node pdesc node =
     let loc = Procdesc.Node.get_loc node in
-    if (Config.dotty_cfg_libs || DB.source_file_equal loc.Location.file source) then
+    if (Config.dotty_cfg_libs || DB.equal_source_file loc.Location.file source) then
       F.fprintf fmt "%a\n" (pp_cfgnode pdesc) node in
   Cfg.iter_all_nodes print_node cfg
 

infer/src/backend/exe_env.ml

@@ -34,7 +34,7 @@ let tenv_filename file_base =
 module FilenameHash = Hashtbl.Make(
   struct
     type t = DB.filename
-    let equal file1 file2 = DB.filename_compare file1 file2 = 0
+    let equal file1 file2 = DB.compare_filename file1 file2 = 0
     let hash = Hashtbl.hash
   end)
 
@@ -99,7 +99,7 @@ let add_cg (exe_env: t) (source_dir : DB.source_dir) =
             | None ->
                 ()
             | Some (source_captured, origin) ->
-                let multiply_defined = DB.source_file_compare source source_captured <> 0 in
+                let multiply_defined = DB.compare_source_file source source_captured <> 0 in
                 if multiply_defined then Cg.remove_node_defined cg pname;
                 if Config.check_duplicate_symbols &&
                    multiply_defined &&

infer/src/backend/printer.ml

@@ -478,11 +478,11 @@ let write_html_proc source proof_cover table_nodes_at_linenum global_err_log pro
   let proc_loc = Procdesc.get_loc proc_desc in
   let process_proc =
     Procdesc.is_defined proc_desc &&
-    DB.source_file_equal proc_loc.Location.file source &&
+    DB.equal_source_file proc_loc.Location.file source &&
     match AttributesTable.find_file_capturing_procedure proc_name with
     | None -> true
     | Some (source_captured, _) ->
-        DB.source_file_equal source_captured (Procdesc.get_loc proc_desc).file in
+        DB.equal_source_file source_captured (Procdesc.get_loc proc_desc).file in
   if process_proc then
     begin
       IList.iter process_node (Procdesc.get_nodes proc_desc);

infer/src/base/DB.ml

@@ -26,24 +26,14 @@ type source_file =
   | Absolute of string
   | RelativeProjectRoot of string (* relative to project root *)
   | RelativeInferModel of string (* relative to infer models *)
+[@@deriving compare]
 
-let source_file_compare sf1 sf2 =
-  match sf1, sf2 with
-  | Absolute p1, Absolute p2 -> string_compare p1 p2
-  | Absolute _, _ -> -1
-  | _, Absolute _ -> 1
-  | RelativeProjectRoot p1, RelativeProjectRoot p2 -> string_compare p1 p2
-  | RelativeProjectRoot _, _ -> -1
-  | _, RelativeProjectRoot _ -> 1
-  | RelativeInferModel p1, RelativeInferModel p2 -> string_compare p1 p2
-
-let source_file_equal sf1 sf2 =
-  (source_file_compare sf1 sf2) = 0
+let equal_source_file sf1 sf2 =
+  compare_source_file sf1 sf2 = 0
 
 module OrderedSourceFile =
 struct
-  type t = source_file
-  let compare = source_file_compare
+  type t = source_file [@@deriving compare]
 end
 
 module SourceFileMap = Map.Make(OrderedSourceFile)
@@ -165,9 +155,7 @@ let source_file_of_header header_file =
 (** {2 Source Dirs} *)
 
 (** source directory: the directory inside the results dir corresponding to a source file *)
-type source_dir = string
-
-let source_dir_compare = string_compare
+type source_dir = string [@@deriving compare]
 
 (** expose the source dir as a string *)
 let source_dir_to_string source_dir = source_dir
@@ -204,7 +192,7 @@ let find_source_dirs () =
 
 (** {2 Filename} *)
 
-type filename = string
+type filename = string [@@deriving compare]
 
 let filename_concat = Filename.concat
 
@@ -212,8 +200,6 @@ let filename_to_string s = s
 
 let filename_from_string s = s
 
-let filename_compare = Pervasives.compare
-
 let filename_add_suffix fn s = fn ^ s
 
 let chop_extension = Filename.chop_extension
@@ -224,14 +210,12 @@ let file_remove = Sys.remove
 
 module FilenameSet = Set.Make(
   struct
-    type t = filename
-    let compare = filename_compare
+    type t = filename [@@deriving compare]
   end)
 
 module FilenameMap = Map.Make(
   struct
-    type t = filename
-    let compare = filename_compare
+    type t = filename [@@deriving compare]
   end)
 
 (** Return the time when a file was last modified. The file must exist. *)
@@ -342,7 +326,7 @@ module Results_dir = struct
     create_dir specs_dir;
     create_dir (path_to_filename Abs_root [Config.attributes_dir_name]);
     create_dir (path_to_filename Abs_root [Config.captured_dir_name]);
-    if not (source_file_equal source source_file_empty) then
+    if not (equal_source_file source source_file_empty) then
       create_dir (path_to_filename (Abs_source_dir source) [])
 
   let clean_specs_dir () =

infer/src/base/DB.mli

@@ -15,14 +15,13 @@ open! Utils
 (** {2 Filename} *)
 
 (** generic file name *)
-type filename
+type filename [@@deriving compare]
 
 module FilenameSet : Set.S with type elt = filename
 module FilenameMap : Map.S with type key = filename
 
 val filename_from_string : string -> filename
 val filename_to_string : filename -> string
-val filename_compare : filename -> filename -> int
 val chop_extension : filename -> filename
 val filename_concat : filename -> string -> filename
 val filename_add_suffix : filename -> string -> filename
@@ -39,7 +38,10 @@ val mark_file_updated : string -> unit
 (** Return whether filename was updated after analysis started. File doesn't have to exist *)
 val file_was_updated_after_start : filename -> bool
 
-type source_file
+type source_file [@@deriving compare]
+
+(** equality of source files *)
+val equal_source_file : source_file -> source_file -> bool
 
 (** {2 Results Directory} *)
 
@@ -86,15 +88,9 @@ module SourceFileMap : Map.S with type key = source_file
 (** Set of source files *)
 module SourceFileSet : Set.S with type elt = source_file
 
-(** comparison of source files *)
-val source_file_compare : source_file -> source_file -> int
-
 (** compute line count of a source file *)
 val source_file_line_count : source_file -> int
 
-(** equality of source files *)
-val source_file_equal : source_file -> source_file -> bool
-
 (** empty source file *)
 val source_file_empty : source_file
 
@@ -130,9 +126,7 @@ val source_file_of_header : source_file -> source_file option
 (** {2 Source Dirs} *)
 
 (** source directory: the directory inside the results dir corresponding to a source file *)
-type source_dir
-
-val source_dir_compare : source_dir -> source_dir -> int
+type source_dir [@@deriving compare]
 
 (** expose the source dir as a string *)
 val source_dir_to_string : source_dir -> string

infer/src/checkers/Siof.ml

@@ -109,7 +109,7 @@ let report_siof tenv trace pdesc gname loc =
 
   let pp_sink f sink =
     let pp_source f v = match Pvar.get_source_file v with
-      | Some source_file when not (DB.source_file_equal DB.source_file_empty source_file) ->
+      | Some source_file when not (DB.equal_source_file DB.source_file_empty source_file) ->
           F.fprintf f " from file %s" (DB.source_file_to_string source_file)
       | _ ->
           () in

infer/src/clang/ComponentKit.ml

@@ -25,7 +25,7 @@ let is_in_main_file translation_unit_context an =
   | None ->
       false
   | Some file ->
-      DB.source_file_equal
+      DB.equal_source_file
         (DB.source_file_from_abs_path file)
         translation_unit_context.CFrontend_config.source_file
 

infer/src/clang/cLocation.ml

@@ -31,8 +31,8 @@ let should_do_frontend_check trans_unit_ctx (loc_start, _) =
   match loc_start.Clang_ast_t.sl_file with
   | Some file ->
       let source_file = (DB.source_file_from_abs_path file) in
-      DB.source_file_equal source_file trans_unit_ctx.CFrontend_config.source_file ||
-      (source_file_in_project source_file &&  not Config.testing_mode)
+      DB.equal_source_file source_file trans_unit_ctx.CFrontend_config.source_file ||
+      (source_file_in_project source_file && not Config.testing_mode)
   | None -> false
 
 (** We translate by default the instructions in the current file.  In C++ development, we also
@@ -52,7 +52,7 @@ let should_translate trans_unit_ctx (loc_start, loc_end) decl_trans_context ~tra
   (* it's not necessary to compare inodes here because both files come from
      the same context - they are produced by the same invocation of ASTExporter
      which uses same logic to produce both files *)
-  let equal_current_source = DB.source_file_equal trans_unit_ctx.CFrontend_config.source_file
+  let equal_current_source = DB.equal_source_file trans_unit_ctx.CFrontend_config.source_file
   in
   let equal_header_of_current_source maybe_header =
     (* DB.source_file_of_header will cache calls to filesystem *)