Remove Errlog.equal

Reviewed By: jeremydubreil

Differential Revision: D9327478

fbshipit-source-id: 465e09a6b

infer/src/IR/Cfg.ml

@@ -15,10 +15,12 @@ type t = Procdesc.t Typ.Procname.Hash.t
 
 let create () = Typ.Procname.Hash.create 16
 
-let get_all_proc_descs cfg =
-  let procs = ref [] in
-  let f _ pdesc = procs := pdesc :: !procs in
-  Typ.Procname.Hash.iter f cfg ; !procs
+let iter_over_sorted_procs cfg ~f =
+  let compare_proc_desc_by_proc_name pdesc1 pdesc2 =
+    Typ.Procname.compare (Procdesc.get_proc_name pdesc1) (Procdesc.get_proc_name pdesc2)
+  in
+  Typ.Procname.Hash.fold (fun _ pdesc acc -> pdesc :: acc) cfg []
+  |> List.sort ~compare:compare_proc_desc_by_proc_name |> List.iter ~f
 
 
 let get_all_proc_names cfg =
@@ -35,20 +37,15 @@ let create_proc_desc cfg (proc_attributes: ProcAttributes.t) =
 
 
 (** Iterate over all the nodes in the cfg *)
-let iter_all_nodes ?(sorted= false) cfg ~f =
+let iter_all_nodes ~sorted cfg ~f =
   let do_proc_desc _ (pdesc: Procdesc.t) =
     List.iter ~f:(fun node -> f pdesc node) (Procdesc.get_nodes pdesc)
   in
   if not sorted then Typ.Procname.Hash.iter do_proc_desc cfg
   else
-    Typ.Procname.Hash.fold
-      (fun pname pdesc result ->
-        Procdesc.get_nodes pdesc
-        |> List.fold ~init:result ~f:(fun inner_result node -> (pname, pdesc, node) :: inner_result)
-        )
-      cfg []
-    |> List.sort ~compare:[%compare : Typ.Procname.t * Procdesc.t * Procdesc.Node.t]
-    |> List.iter ~f:(fun (_, d, n) -> f d n)
+    iter_over_sorted_procs cfg ~f:(fun pdesc ->
+        Procdesc.get_nodes pdesc |> List.sort ~compare:Procdesc.Node.compare
+        |> List.iter ~f:(fun node -> f pdesc node) )
 
 
 let load_statement =
@@ -157,8 +154,7 @@ let inline_java_synthetic_methods cfg =
 
 let pp_proc_signatures fmt cfg =
   F.fprintf fmt "@[<v>METHOD SIGNATURES@;" ;
-  let sorted_procs = List.sort ~compare:Procdesc.compare (get_all_proc_descs cfg) in
-  List.iter ~f:(Procdesc.pp_signature fmt) sorted_procs ;
+  iter_over_sorted_procs ~f:(Procdesc.pp_signature fmt) cfg ;
   F.fprintf fmt "@]"
 
 

infer/src/IR/Cfg.mli

@@ -27,7 +27,7 @@ val create : unit -> t
 val create_proc_desc : t -> ProcAttributes.t -> Procdesc.t
 (** Create a new procdesc and add it to the cfg *)
 
-val iter_all_nodes : ?sorted:bool -> t -> f:(Procdesc.t -> Procdesc.Node.t -> unit) -> unit
+val iter_all_nodes : sorted:bool -> t -> f:(Procdesc.t -> Procdesc.Node.t -> unit) -> unit
 (** Iterate over all the nodes in the cfg *)
 
 val save_attributes : SourceFile.t -> t -> unit

infer/src/IR/Errlog.ml

@@ -96,7 +96,7 @@ end)
 (** Hash table to implement error logs *)
 module ErrLogHash = struct
   module Key = struct
-    type t = err_key [@@deriving compare]
+    type t = err_key
 
     (* NOTE: changing the hash function can change the order in which issues are reported. *)
     let hash key =
@@ -119,12 +119,7 @@ end
     error description, severity, to set of err_data. *)
 type t = ErrDataSet.t ErrLogHash.t
 
-let compare x y =
-  let bindings x = ErrLogHash.fold (fun k d l -> (k, d) :: l) x [] in
-  [%compare : (ErrLogHash.Key.t * ErrDataSet.t) list] (bindings x) (bindings y)
-
-
-let equal x y = [%compare.equal : t] x y
+let is_empty err_log = Int.equal 0 (ErrLogHash.length err_log)
 
 (** Empty error log *)
 let empty () = ErrLogHash.create 13

infer/src/IR/Errlog.mli

@@ -58,13 +58,13 @@ type err_data = private
   ; extras: Jsonbug_t.extra option }
 
 (** Type of the error log *)
-type t [@@deriving compare]
-
-val equal : t -> t -> bool
+type t
 
 val empty : unit -> t
 (** Empty error log *)
 
+val is_empty : t -> bool
+
 (** type of the function to be passed to iter *)
 type iter_fun = err_key -> err_data -> unit
 

infer/src/IR/ProcAttributes.ml

@@ -14,11 +14,6 @@ module F = Format
 (** flags for a procedure *)
 type proc_flags = (string, string) Hashtbl.t
 
-let compare_proc_flags x y =
-  let bindings x = Hashtbl.fold (fun k d l -> (k, d) :: l) x [] in
-  [%compare : (string * string) list] (bindings x) (bindings y)
-
-
 let proc_flags_empty () : proc_flags = Hashtbl.create 1
 
 type clang_method_kind =
@@ -112,7 +107,6 @@ type t =
   ; proc_name: Typ.Procname.t  (** name of the procedure *)
   ; ret_type: Typ.t  (** return type *)
   ; has_added_return_param: bool  (** whether or not a return param was added *) }
-[@@deriving compare]
 
 let default translation_unit proc_name =
   { access= PredSymb.Default
@@ -189,7 +183,7 @@ let pp f
   if not ([%compare.equal : (Mangled.t * Typ.t) list] default.captured captured) then
     F.fprintf f "; captured= [@[%a@]]@," pp_parameters captured ;
   pp_bool_default ~default:default.did_preanalysis "did_preanalysis" did_preanalysis f () ;
-  if not (Errlog.equal default.err_log err_log) then
+  if not (Errlog.is_empty err_log) then
     F.fprintf f "; err_log= [@[%a%a@]]@," Errlog.pp_errors err_log Errlog.pp_warnings err_log ;
   if not ([%compare.equal : string list] default.exceptions exceptions) then
     F.fprintf f "; exceptions= [@[%a@]]@,"

infer/src/IR/ProcAttributes.mli

@@ -10,7 +10,7 @@ open! IStd
 (** Attributes of a procedure. *)
 
 (** flags for a procedure *)
-type proc_flags = (string, string) Caml.Hashtbl.t [@@deriving compare]
+type proc_flags = (string, string) Caml.Hashtbl.t
 
 type clang_method_kind =
   | CPP_INSTANCE
@@ -26,19 +26,17 @@ val equal_clang_method_kind : clang_method_kind -> clang_method_kind -> bool
 val string_of_clang_method_kind : clang_method_kind -> string
 
 type objc_accessor_type = Objc_getter of Typ.Struct.field | Objc_setter of Typ.Struct.field
-[@@deriving compare]
 
 val kind_of_objc_accessor_type : objc_accessor_type -> string
 
-type var_attribute =
-  | Modify_in_block
-  (* __block attribute of Objective-C variables, means that it will be modified inside a block *)
-[@@deriving compare]
+type var_attribute = Modify_in_block
+
+(* __block attribute of Objective-C variables, means that it will be modified inside a block *)
 
 val var_attribute_equal : var_attribute -> var_attribute -> bool
 (** Equality for var_attribute *)
 
-type var_data = {name: Mangled.t; typ: Typ.t; attributes: var_attribute list} [@@deriving compare]
+type var_data = {name: Mangled.t; typ: Typ.t; attributes: var_attribute list}
 
 type t =
   { access: PredSymb.access  (** visibility access *)
@@ -69,7 +67,6 @@ type t =
   ; proc_name: Typ.Procname.t  (** name of the procedure *)
   ; ret_type: Typ.t  (** return type *)
   ; has_added_return_param: bool  (** whether or not a return param was added *) }
-[@@deriving compare]
 
 val default : SourceFile.t -> Typ.Procname.t -> t
 (** Create a proc_attributes with default values. *)

infer/src/IR/Procdesc.ml

@@ -355,7 +355,6 @@ type t =
   ; mutable start_node: Node.t  (** start node of this procedure *)
   ; mutable exit_node: Node.t  (** exit node of this procedure *)
   ; mutable loop_heads: NodeSet.t option  (** loop head nodes of this procedure *) }
-[@@deriving compare]
 
 let from_proc_attributes attributes =
   let pname_opt = Some attributes.ProcAttributes.proc_name in

infer/src/IR/Procdesc.mli

@@ -163,7 +163,7 @@ module NodeSet : Caml.Set.S with type elt = Node.t
 (** procedure descriptions *)
 
 (** proc description *)
-type t [@@deriving compare]
+type t
 
 val append_locals : t -> ProcAttributes.var_data list -> unit
 (** append a list of new local variables to the existing list of local variables *)