diff --git a/infer/src/IR/Cfg.ml b/infer/src/IR/Cfg.ml index 7db0de395..7225a491d 100644 --- a/infer/src/IR/Cfg.ml +++ b/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 "@[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 "@]" diff --git a/infer/src/IR/Cfg.mli b/infer/src/IR/Cfg.mli index f6bd342ec..4340c364e 100644 --- a/infer/src/IR/Cfg.mli +++ b/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 diff --git a/infer/src/IR/Errlog.ml b/infer/src/IR/Errlog.ml index 839c18f68..d450752dd 100644 --- a/infer/src/IR/Errlog.ml +++ b/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 diff --git a/infer/src/IR/Errlog.mli b/infer/src/IR/Errlog.mli index 07cb5c5e4..b5a4f3ef0 100644 --- a/infer/src/IR/Errlog.mli +++ b/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 diff --git a/infer/src/IR/ProcAttributes.ml b/infer/src/IR/ProcAttributes.ml index 23731b264..2f0c37dee 100644 --- a/infer/src/IR/ProcAttributes.ml +++ b/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@]]@," diff --git a/infer/src/IR/ProcAttributes.mli b/infer/src/IR/ProcAttributes.mli index a83f2dc2d..a9928da60 100644 --- a/infer/src/IR/ProcAttributes.mli +++ b/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. *) diff --git a/infer/src/IR/Procdesc.ml b/infer/src/IR/Procdesc.ml index e10edde9d..bdf96d82e 100644 --- a/infer/src/IR/Procdesc.ml +++ b/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 diff --git a/infer/src/IR/Procdesc.mli b/infer/src/IR/Procdesc.mli index bfc959210..7223aa9da 100644 --- a/infer/src/IR/Procdesc.mli +++ b/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 *)