From 31075e42acda91e571751f90bc298b538e7b100f Mon Sep 17 00:00:00 2001 From: Nikos Gorogiannis Date: Thu, 21 Nov 2024 07:22:57 -0800 Subject: [PATCH] [core] migrate Map and Set containers to Stdlib Summary: Core 0.15 conflicts with OCaml 5.2. Core 0.16.1 does not, but makes breaking changes to several container types. This diff moves the majority of Core container usages over to Stdlib ones. Reviewed By: skcho Differential Revision: D66243343 Privacy Context Container: L1208441 fbshipit-source-id: 9bc18124125509fb9c8fba7ca38f5a5147befee4 --- infer/src/IR/BiabductionModels.ml | 8 +-- infer/src/IR/inferconfig.ml | 20 ++++---- infer/src/backend/printer.ml | 6 +-- infer/src/base/Config.ml | 2 +- infer/src/base/Config.mli | 2 +- infer/src/base/DBWriter.ml | 13 +++-- infer/src/base/Scuba.ml | 10 ++-- infer/src/base/SourceFile.ml | 12 ++--- infer/src/base/ToplLexer.mll | 4 +- infer/src/biabduction/BiabductionSummary.ml | 6 +-- .../bufferoverrun/bufferOverrunAnalysis.ml | 9 ++-- infer/src/checkers/LithoDomain.ml | 20 ++++++-- infer/src/checkers/LithoDomain.mli | 4 +- infer/src/checkers/RequiredProps.ml | 8 +-- infer/src/clang/ClangCommand.ml | 6 +-- infer/src/clang/ClangPointers.ml | 22 ++++---- infer/src/clang/ClangPointers.mli | 8 +-- infer/src/clang/cAst_utils.ml | 16 +++--- infer/src/clang/cScope.ml | 6 +-- infer/src/clang/cTrans.ml | 6 +-- infer/src/concurrency/RacerDModels.ml | 2 +- infer/src/concurrency/StarvationModels.ml | 6 ++- infer/src/cost/ConfigImpactAnalysis.ml | 4 +- infer/src/integration/Differential.ml | 25 ++++++++-- infer/src/integration/DifferentialFilters.ml | 6 ++- infer/src/integration/Gradle.ml | 10 ++-- infer/src/integration/JsonReports.ml | 2 +- infer/src/integration/StatsDiff.ml | 36 ++++++------- infer/src/integration/Suppressions.ml | 50 ++++++++++--------- infer/src/integration/Suppressions.mli | 2 +- .../src/integration/unit/SuppressionsTest.ml | 18 +++---- infer/src/istd/IList.ml | 9 +--- infer/src/istd/IString.ml | 16 ++++++ infer/src/istd/IString.mli | 12 +++++ infer/src/istd/Pp.ml | 6 +-- infer/src/java/jClasspath.ml | 24 ++++----- infer/src/java/jClasspath.mli | 2 +- infer/src/java/jFrontend.ml | 12 ++--- infer/src/java/jMain.ml | 6 +-- infer/src/java/jTrans.ml | 6 +-- infer/src/pulse/Pulse.ml | 8 +-- infer/src/pulse/PulseModelsHack.ml | 6 +-- infer/src/textual/TextualBasicVerification.ml | 6 +-- infer/src/textual/TextualTransform.ml | 8 +-- 44 files changed, 262 insertions(+), 208 deletions(-) create mode 100644 infer/src/istd/IString.ml create mode 100644 infer/src/istd/IString.mli diff --git a/infer/src/IR/BiabductionModels.ml b/infer/src/IR/BiabductionModels.ml index 1bdd87ea225..fcd5c5ba419 100644 --- a/infer/src/IR/BiabductionModels.ml +++ b/infer/src/IR/BiabductionModels.ml @@ -11,15 +11,15 @@ let scan_model_proc_names () = let db = Database.get_database AnalysisDatabase in Sqlite3.prepare db "SELECT proc_uid FROM model_specs" |> SqliteUtils.result_fold_single_column_rows db ~log:"scan model procnames" - ~init:String.Set.empty ~f:(fun acc proc_uid_sqlite -> + ~init:IString.Set.empty ~f:(fun acc proc_uid_sqlite -> let[@warning "-partial-match"] (Sqlite3.Data.TEXT proc_uid) = proc_uid_sqlite in - String.Set.add acc proc_uid ) + IString.Set.add proc_uid acc ) let models_index = - lazy (if Config.biabduction_models_mode then String.Set.empty else scan_model_proc_names ()) + lazy (if Config.biabduction_models_mode then IString.Set.empty else scan_model_proc_names ()) let mem proc_name = let proc_uid = Procname.to_unique_id proc_name in - String.Set.mem (Lazy.force models_index) proc_uid + IString.Set.mem proc_uid (Lazy.force models_index) diff --git a/infer/src/IR/inferconfig.ml b/infer/src/IR/inferconfig.ml index 41458e5c074..91d2e7758a0 100644 --- a/infer/src/IR/inferconfig.ml +++ b/infer/src/IR/inferconfig.ml @@ -119,22 +119,20 @@ module FileOrProcMatcher = struct List.fold ~f:(fun map pattern -> let previous = - try String.Map.find_exn map pattern.class_name - with Not_found_s _ | Stdlib.Not_found -> [] + IString.Map.find_opt pattern.class_name map |> Option.value ~default:[] in - String.Map.set ~key:pattern.class_name ~data:(pattern :: previous) map ) - ~init:String.Map.empty m_patterns + IString.Map.add pattern.class_name (pattern :: previous) map ) + ~init:IString.Map.empty m_patterns in let do_java pname_java = let class_name = Procname.Java.get_class_name pname_java and method_name = Procname.Java.get_method pname_java in - try - let class_patterns = String.Map.find_exn pattern_map class_name in - List.exists - ~f:(fun p -> - match p.method_name with None -> true | Some m -> String.equal m method_name ) - class_patterns - with Not_found_s _ | Stdlib.Not_found -> false + IString.Map.find_opt class_name pattern_map + |> Option.exists ~f:(fun class_patterns -> + List.exists + ~f:(fun p -> + match p.method_name with None -> true | Some m -> String.equal m method_name ) + class_patterns ) in fun _ proc_name -> match proc_name with Procname.Java pname_java -> do_java pname_java | _ -> false diff --git a/infer/src/backend/printer.ml b/infer/src/backend/printer.ml index 74e9c5c73f5..9cd8d29f7ec 100644 --- a/infer/src/backend/printer.ml +++ b/infer/src/backend/printer.ml @@ -184,9 +184,9 @@ end = struct in try let set = Hashtbl.find err_per_line err_data.loc.Location.line in - Hashtbl.replace err_per_line err_data.loc.Location.line (String.Set.add set err_str) + Hashtbl.replace err_per_line err_data.loc.Location.line (IString.Set.add err_str set) with Stdlib.Not_found -> - Hashtbl.add err_per_line err_data.loc.Location.line (String.Set.singleton err_str) + Hashtbl.add err_per_line err_data.loc.Location.line (IString.Set.singleton err_str) in Errlog.iter add_err err_log ; err_per_line @@ -250,7 +250,7 @@ end = struct () ) ; ( match Hashtbl.find table_err_per_line line_number with | errset -> - String.Set.iter errset ~f:(pp_err_message fmt) + IString.Set.iter (pp_err_message fmt) errset | exception Stdlib.Not_found -> () ) ; F.fprintf fmt "@\n" diff --git a/infer/src/base/Config.ml b/infer/src/base/Config.ml index 6716280629d..193e53c02a8 100644 --- a/infer/src/base/Config.ml +++ b/infer/src/base/Config.ml @@ -4720,7 +4720,7 @@ and racerd_always_report_java = !racerd_always_report_java and racerd_guardedby = !racerd_guardedby -and racerd_ignore_classes = RevList.to_list !racerd_ignore_classes |> String.Set.of_list +and racerd_ignore_classes = RevList.to_list !racerd_ignore_classes |> IString.Set.of_list and reactive_mode = !reactive diff --git a/infer/src/base/Config.mli b/infer/src/base/Config.mli index 54642086f2e..5070344a71f 100644 --- a/infer/src/base/Config.mli +++ b/infer/src/base/Config.mli @@ -765,7 +765,7 @@ val racerd_always_report_java : bool val racerd_guardedby : bool -val racerd_ignore_classes : String.Set.t +val racerd_ignore_classes : IString.Set.t val reactive_mode : bool diff --git a/infer/src/base/DBWriter.ml b/infer/src/base/DBWriter.ml index 47ddb856d04..b0ea71c25d9 100644 --- a/infer/src/base/DBWriter.ml +++ b/infer/src/base/DBWriter.ml @@ -429,21 +429,20 @@ module Implementation = struct in let update_statement = let stmts = - List.fold PayloadId.database_fields ~init:String.Map.empty ~f:(fun acc payload_id -> - String.Map.add_exn ~key:payload_id - ~data: - (Database.register_statement AnalysisDatabase - {| + List.fold PayloadId.database_fields ~init:IString.Map.empty ~f:(fun acc payload_id -> + IString.Map.add payload_id + (Database.register_statement AnalysisDatabase + {| UPDATE specs SET report_summary = :report_summary, summary_metadata = :summary_metadata, %s = :value WHERE proc_uid = :proc_uid |} - payload_id ) + payload_id ) acc ) in - fun payload_id -> String.Map.find_exn stmts (PayloadId.Variants.to_name payload_id) + fun payload_id -> IString.Map.find (PayloadId.Variants.to_name payload_id) stmts in fun analysis_req ~proc_uid ~proc_name ~merge_pulse_payload ~merge_report_summary ~merge_summary_metadata -> diff --git a/infer/src/base/Scuba.ml b/infer/src/base/Scuba.ml index e02a510ad3d..fc9a5df0d35 100644 --- a/infer/src/base/Scuba.ml +++ b/infer/src/base/Scuba.ml @@ -6,7 +6,7 @@ *) open! IStd -module SMap = Map.Make (String) +module SMap = IString.Map type table = InferEvents @@ -27,23 +27,23 @@ let new_sample ~time = let add_int ~name ~value sample = - let int_section = SMap.set sample.int_section ~key:name ~data:value in + let int_section = SMap.add name value sample.int_section in {sample with int_section} let add_normal ~name ~value sample = - let normal_section = SMap.set sample.normal_section ~key:name ~data:value in + let normal_section = SMap.add name value sample.normal_section in {sample with normal_section} let add_tagset ~name ~value sample = - let tagset_section = SMap.set sample.tagset_section ~key:name ~data:value in + let tagset_section = SMap.add name value sample.tagset_section in {sample with tagset_section} let sample_to_json sample = let map_to_assoc value_to_json key_value_map = - let pairs = SMap.to_alist key_value_map in + let pairs = SMap.bindings key_value_map in let assocs = List.map pairs ~f:(fun (name, data) -> (name, value_to_json data)) in `Assoc assocs in diff --git a/infer/src/base/SourceFile.ml b/infer/src/base/SourceFile.ml index 4cd5fffb2f2..b8c81055033 100644 --- a/infer/src/base/SourceFile.ml +++ b/infer/src/base/SourceFile.ml @@ -235,14 +235,14 @@ let is_under_project_root = function false -let exists_cache = String.Table.create ~size:256 () +let exists_cache = IString.Hash.create 256 let path_exists abs_path = - try String.Table.find_exn exists_cache abs_path - with Not_found_s _ | Stdlib.Not_found -> - let result = ISys.file_exists abs_path in - String.Table.set exists_cache ~key:abs_path ~data:result ; - result + IString.Hash.find_opt exists_cache abs_path + |> Option.value_or_thunk ~default:(fun () -> + let result = ISys.file_exists abs_path in + IString.Hash.replace exists_cache abs_path result ; + result ) let of_header ?(warn_on_error = true) header_file = diff --git a/infer/src/base/ToplLexer.mll b/infer/src/base/ToplLexer.mll index 1da0b331965..95d015df021 100644 --- a/infer/src/base/ToplLexer.mll +++ b/infer/src/base/ToplLexer.mll @@ -22,9 +22,9 @@ let quoted = Str.regexp "\\\\\\(.\\)" let unquote x = Str.global_replace quoted "\\1" x - (* We open Caml, because ocamllex generates code that uses Array.make, + (* We open Stdlib, because ocamllex generates code that uses Array.make, which is not available in Core. Ideally, this should go away. *) - open! Caml + open! Stdlib } let id_tail = ['a'-'z' 'A'-'Z' '0'-'9']* diff --git a/infer/src/biabduction/BiabductionSummary.ml b/infer/src/biabduction/BiabductionSummary.ml index 4c3836e7e92..9e8ac51fd66 100644 --- a/infer/src/biabduction/BiabductionSummary.ml +++ b/infer/src/biabduction/BiabductionSummary.ml @@ -157,9 +157,9 @@ module Visitedset = struct end) let pp fmt visitedset = - let collect_lines (_, ns) acc = List.fold ns ~f:Int.Set.add ~init:acc in - let lines = fold collect_lines visitedset Int.Set.empty in - Pp.seq F.pp_print_int fmt (Int.Set.elements lines) + let collect_lines (_, ns) acc = List.fold ns ~f:(fun acc i -> IInt.Set.add i acc) ~init:acc in + let lines = fold collect_lines visitedset IInt.Set.empty in + Pp.seq F.pp_print_int fmt (IInt.Set.elements lines) end (** A spec consists of: diff --git a/infer/src/bufferoverrun/bufferOverrunAnalysis.ml b/infer/src/bufferoverrun/bufferOverrunAnalysis.ml index 5e1946e16b5..29b96bbea42 100644 --- a/infer/src/bufferoverrun/bufferOverrunAnalysis.ml +++ b/infer/src/bufferoverrun/bufferOverrunAnalysis.ml @@ -237,11 +237,10 @@ module TransferFunctions = struct let join_java_static_final = - let known_java_static_fields = String.Set.of_list [".EMPTY"] in + let known_java_static_fields = IString.Set.of_list [".EMPTY"] in let is_known_java_static_field fn = let fieldname = Fieldname.to_string fn in - String.Set.exists known_java_static_fields ~f:(fun suffix -> - String.is_suffix fieldname ~suffix ) + IString.Set.exists (fun suffix -> String.is_suffix fieldname ~suffix) known_java_static_fields in let copy_reachable_locs_from loc ~from_mem ~to_mem = let copy loc acc = @@ -279,11 +278,11 @@ module TransferFunctions = struct let modeled_load_of_empty_collection_opt = - let known_empty_collections = String.Set.of_list ["EMPTY_LIST"; "EMPTY_SET"; "EMPTY_MAP"] in + let known_empty_collections = IString.Set.of_list ["EMPTY_LIST"; "EMPTY_SET"; "EMPTY_MAP"] in fun exp model_env ret mem -> match exp with | Exp.Lfield (_, fieldname, typ) - when String.Set.mem known_empty_collections (Fieldname.get_field_name fieldname) + when IString.Set.mem (Fieldname.get_field_name fieldname) known_empty_collections && String.equal "java.util.Collections" (Typ.to_string typ) -> Models.Collection.create_collection model_env ~ret mem ~length:Itv.zero |> Option.some | _ -> diff --git a/infer/src/checkers/LithoDomain.ml b/infer/src/checkers/LithoDomain.ml index 63c18f9a9c7..709378625bb 100644 --- a/infer/src/checkers/LithoDomain.ml +++ b/infer/src/checkers/LithoDomain.ml @@ -30,17 +30,29 @@ end module LocalAccessPathSet = PrettyPrintable.MakePPSet (LocalAccessPath) -let suffixes = String.Set.of_list ["Attr"; "Dip"; "Px"; "Res"; "Sp"] +let suffixes = IString.Set.of_list ["Attr"; "Dip"; "Px"; "Res"; "Sp"] module MethodCallPrefix = struct type t = {prefix: string; procname: Procname.t [@compare.ignore]; location: Location.t [@compare.ignore]} [@@deriving compare] + exception Found of string + let make_with_prefixes procname location = let method_name = Procname.get_method procname in let prefix_opt = - String.Set.find_map suffixes ~f:(fun suffix -> String.chop_suffix method_name ~suffix) + try + IString.Set.iter + (fun suffix -> + match String.chop_suffix method_name ~suffix with + | Some res -> + raise (Found res) + | None -> + () ) + suffixes ; + None + with Found res -> Some res in let default = [{prefix= method_name; procname; location}] in Option.value_map prefix_opt ~default ~f:(fun prefix -> @@ -185,9 +197,9 @@ module MethodCalls = struct let to_string_set method_calls = let accum_as_string method_call acc = - String.Set.add acc (MethodCallPrefix.procname_to_string method_call) + IString.Set.add (MethodCallPrefix.procname_to_string method_call) acc in - S.fold accum_as_string method_calls String.Set.empty + S.fold accum_as_string method_calls IString.Set.empty let get_call_chain method_calls = diff --git a/infer/src/checkers/LithoDomain.mli b/infer/src/checkers/LithoDomain.mli index c2607c2f02c..5e158270396 100644 --- a/infer/src/checkers/LithoDomain.mli +++ b/infer/src/checkers/LithoDomain.mli @@ -20,7 +20,7 @@ module LocalAccessPath : sig val make_from_access_expression : HilExp.AccessExpression.t -> Procname.t -> t end -val suffixes : String.Set.t +val suffixes : IString.Set.t (** Called procedure & location *) module MethodCallPrefix : sig @@ -76,6 +76,6 @@ val pp_summary : Format.formatter -> summary -> unit val get_summary : is_void_func:bool -> t -> summary val check_required_props : - check_on_string_set:(Typ.name -> Location.t -> MethodCallPrefix.t list -> String.Set.t -> unit) + check_on_string_set:(Typ.name -> Location.t -> MethodCallPrefix.t list -> IString.Set.t -> unit) -> summary -> summary diff --git a/infer/src/checkers/RequiredProps.ml b/infer/src/checkers/RequiredProps.ml index 0f6c7dff849..bf63c602062 100644 --- a/infer/src/checkers/RequiredProps.ml +++ b/infer/src/checkers/RequiredProps.ml @@ -90,13 +90,15 @@ let report_missing_required_prop proc_desc err_log prop parent_typename ~create_ let has_prop prop_set prop = let check prop = - String.Set.mem prop_set prop + IString.Set.mem prop prop_set || (* @Prop(resType = ...) myProp can also be set via myProp(), myPropAttr(), myPropDip(), myPropPx(), myPropRes() or myPropSp(). Our annotation parameter parsing is too primitive to identify resType, so just assume that all @Prop's can be set any of these 6 ways. *) - String.Set.exists prop_set ~f:(fun el -> + IString.Set.exists + (fun el -> String.chop_prefix el ~prefix:prop - |> Option.exists ~f:(fun suffix -> String.Set.mem LithoDomain.suffixes suffix) ) + |> Option.exists ~f:(fun suffix -> IString.Set.mem suffix LithoDomain.suffixes) ) + prop_set in match prop with | Prop prop -> diff --git a/infer/src/clang/ClangCommand.ml b/infer/src/clang/ClangCommand.ml index a1f5fecb269..28e168fc84a 100644 --- a/infer/src/clang/ClangCommand.ml +++ b/infer/src/clang/ClangCommand.ml @@ -88,9 +88,9 @@ let filter_and_replace_unsupported_args ?(replace_options_arg = fun _ s -> s) ?( arg file, we need to remove its argument now *) aux in_argfiles (false, res_rev, true) tl | at_argfile :: tl - when String.is_prefix at_argfile ~prefix:"@" && not (String.Set.mem in_argfiles at_argfile) + when String.is_prefix at_argfile ~prefix:"@" && not (IString.Set.mem at_argfile in_argfiles) -> ( - let in_argfiles' = String.Set.add in_argfiles at_argfile in + let in_argfiles' = IString.Set.add at_argfile in_argfiles in let argfile = String.slice at_argfile 1 (String.length at_argfile) in match In_channel.read_lines argfile with | lines -> @@ -129,7 +129,7 @@ let filter_and_replace_unsupported_args ?(replace_options_arg = fun _ s -> s) ?( let arg' = replace_options_arg res_rev arg in aux in_argfiles (false, arg' :: res_rev, changed || not (phys_equal arg arg')) tl in - match aux String.Set.empty (false, [], false) args with + match aux IString.Set.empty (false, [], false) args with | _, res_rev, _ -> (* return non-reversed list *) List.append pre_args (List.rev_append res_rev post_args) diff --git a/infer/src/clang/ClangPointers.ml b/infer/src/clang/ClangPointers.ml index d50e88149ce..c7aacbf0f8f 100644 --- a/infer/src/clang/ClangPointers.ml +++ b/infer/src/clang/ClangPointers.ml @@ -7,15 +7,15 @@ open! IStd module L = Logging -module Map = Map.Make (Int) +module Map = IInt.Map -let ivar_to_property_table = Int.Table.create ~size:256 () +let ivar_to_property_table = IInt.Hash.create 256 -let pointer_decl_table = Int.Table.create ~size:256 () +let pointer_decl_table = IInt.Hash.create 256 -let pointer_stmt_table = Int.Table.create ~size:256 () +let pointer_stmt_table = IInt.Hash.create 256 -let pointer_type_table = Int.Table.create ~size:256 () +let pointer_type_table = IInt.Hash.create 256 let empty_v = Clang_ast_visit.empty_visitor @@ -55,7 +55,7 @@ let get_val_from_node node = let add_node_to_cache node cache = let key = get_ptr_from_node node in let data = get_val_from_node node in - Int.Table.set cache ~key ~data + IInt.Hash.replace cache key data let process_decl _ decl = @@ -63,7 +63,7 @@ let process_decl _ decl = match decl with | Clang_ast_t.ObjCPropertyDecl (_, _, {opdi_ivar_decl= Some decl_ref}) -> let ivar_pointer = decl_ref.Clang_ast_t.dr_decl_pointer in - Int.Table.set ivar_to_property_table ~key:ivar_pointer ~data:decl + IInt.Hash.replace ivar_to_property_table ivar_pointer decl | _ -> () @@ -113,10 +113,10 @@ let complete_source_location _ source_loc = let reset_cache () = - Int.Table.clear pointer_decl_table ; - Int.Table.clear pointer_stmt_table ; - Int.Table.clear pointer_type_table ; - Int.Table.clear ivar_to_property_table ; + IInt.Hash.clear pointer_decl_table ; + IInt.Hash.clear pointer_stmt_table ; + IInt.Hash.clear pointer_type_table ; + IInt.Hash.clear ivar_to_property_table ; reset_sloc previous_sloc diff --git a/infer/src/clang/ClangPointers.mli b/infer/src/clang/ClangPointers.mli index eb06640f4ee..4f980eeab2a 100644 --- a/infer/src/clang/ClangPointers.mli +++ b/infer/src/clang/ClangPointers.mli @@ -7,15 +7,15 @@ open! IStd -module Map : module type of Map.Make (Int) +module Map : Stdlib.Map.S with type key = int -val pointer_decl_table : Clang_ast_t.decl Int.Table.t +val pointer_decl_table : Clang_ast_t.decl IInt.Hash.t (** maps decl pointer to its decl record *) -val pointer_stmt_table : Clang_ast_t.stmt Int.Table.t +val pointer_stmt_table : Clang_ast_t.stmt IInt.Hash.t (** maps stmt pointer to its stmt record *) -val pointer_type_table : Clang_ast_t.c_type Int.Table.t +val pointer_type_table : Clang_ast_t.c_type IInt.Hash.t (** map pointer to its type *) val populate_all_tables : Clang_ast_t.decl -> unit diff --git a/infer/src/clang/cAst_utils.ml b/infer/src/clang/cAst_utils.ml index b3315d10eec..774f4fafee5 100644 --- a/infer/src/clang/cAst_utils.ml +++ b/infer/src/clang/cAst_utils.ml @@ -146,10 +146,10 @@ let named_decl_info_equal ndi1 ndi2 = let get_decl decl_ptr = - let decl = Int.Table.find ClangPointers.pointer_decl_table decl_ptr in + let decl = IInt.Hash.find_opt ClangPointers.pointer_decl_table decl_ptr in match decl with | Some (VarDecl ({di_parent_pointer= Some parent_pointer}, ndi, _, _)) -> ( - match Int.Table.find ClangPointers.pointer_decl_table parent_pointer with + match IInt.Hash.find_opt ClangPointers.pointer_decl_table parent_pointer with | Some (CXXRecordDecl (_, _, _, decls, _, _, _, _)) -> ( let has_same_ndi = function | Clang_ast_t.VarDecl (_, ndi', _, _) -> @@ -169,7 +169,7 @@ let get_decl_opt decl_ptr_opt = let get_stmt stmt_ptr source_range = - let stmt = Int.Table.find ClangPointers.pointer_stmt_table stmt_ptr in + let stmt = IInt.Hash.find_opt ClangPointers.pointer_stmt_table stmt_ptr in if Option.is_none stmt then CFrontend_errors.incorrect_assumption __POS__ source_range "stmt with pointer %d not found@\n" stmt_ptr ; @@ -204,28 +204,28 @@ let update_sil_types_map type_ptr sil_type = let update_enum_map_exn enum_constant_pointer sil_exp = let predecessor_pointer_opt, _ = - ClangPointers.Map.find_exn !CFrontend_config.enum_map enum_constant_pointer + ClangPointers.Map.find enum_constant_pointer !CFrontend_config.enum_map in let enum_map_value = (predecessor_pointer_opt, Some sil_exp) in CFrontend_config.enum_map := - ClangPointers.Map.set !CFrontend_config.enum_map ~key:enum_constant_pointer ~data:enum_map_value + ClangPointers.Map.add enum_constant_pointer enum_map_value !CFrontend_config.enum_map let add_enum_constant enum_constant_pointer predecessor_pointer_opt = let enum_map_value = (predecessor_pointer_opt, None) in CFrontend_config.enum_map := - ClangPointers.Map.set !CFrontend_config.enum_map ~key:enum_constant_pointer ~data:enum_map_value + ClangPointers.Map.add enum_constant_pointer enum_map_value !CFrontend_config.enum_map let get_enum_constant_exp_exn enum_constant_pointer = - ClangPointers.Map.find_exn !CFrontend_config.enum_map enum_constant_pointer + ClangPointers.Map.find enum_constant_pointer !CFrontend_config.enum_map let get_type type_ptr = match type_ptr with (* There is chance for success only if type_ptr is in fact clang pointer *) | Clang_ast_types.TypePtr.Ptr raw_ptr -> - Int.Table.find ClangPointers.pointer_type_table raw_ptr + IInt.Hash.find_opt ClangPointers.pointer_type_table raw_ptr | _ -> (* TODO(T30739447): investigate why this happens *) (* otherwise, function fails *) diff --git a/infer/src/clang/cScope.ml b/infer/src/clang/cScope.ml index aac1fc94d6b..56a26d1bc47 100644 --- a/infer/src/clang/cScope.ml +++ b/infer/src/clang/cScope.ml @@ -269,9 +269,7 @@ module Variables = struct L.debug Capture Verbose "~[%d:%a]" stmt_info.Clang_ast_t.si_pointer (Pp.seq ~sep:"," CContext.pp_var_to_destroy) vars_to_destroy ; - let map = - ClangPointers.Map.set map ~key:stmt_info.Clang_ast_t.si_pointer ~data:vars_to_destroy - in + let map = ClangPointers.Map.add stmt_info.Clang_ast_t.si_pointer vars_to_destroy map in (scope, map) | DeclStmt (_, stmts, decl_list) -> let to_destroy = @@ -323,7 +321,7 @@ module Variables = struct L.debug Capture Verbose "~[%d:%a]" pointer (Pp.seq ~sep:"," CContext.pp_var_to_destroy) vars_to_destroy ; - ClangPointers.Map.set map ~key:pointer ~data:vars_to_destroy ) + ClangPointers.Map.add pointer vars_to_destroy map ) else ( L.debug Capture Verbose "~[%d:skip]" pointer ; map ) diff --git a/infer/src/clang/cTrans.ml b/infer/src/clang/cTrans.ml index 5a0783e845c..aa2c9abde62 100644 --- a/infer/src/clang/cTrans.ml +++ b/infer/src/clang/cTrans.ml @@ -2100,7 +2100,7 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s if not (CGeneral_utils.is_cpp_translation context.translation_unit_context) then None else match - CContext.StmtMap.find context.CContext.vars_to_destroy stmt_info.Clang_ast_t.si_pointer + CContext.StmtMap.find_opt stmt_info.Clang_ast_t.si_pointer context.CContext.vars_to_destroy with | None -> L.(debug Capture Verbose) "@\nNo variables going out of scope here.@\n" ; @@ -3084,9 +3084,7 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s and init_dynamic_array trans_state array_exp_typ array_stmt_info dynlength_stmt_pointer = - let dynlength_stmt = - Int.Table.find_exn ClangPointers.pointer_stmt_table dynlength_stmt_pointer - in + let dynlength_stmt = IInt.Hash.find ClangPointers.pointer_stmt_table dynlength_stmt_pointer in let dynlength_stmt_info, _ = Clang_ast_proj.get_stmt_tuple dynlength_stmt in let trans_state_pri = PriorityNode.try_claim_priority_node trans_state array_stmt_info in let dynlength_trans_result = instruction trans_state_pri dynlength_stmt in diff --git a/infer/src/concurrency/RacerDModels.ml b/infer/src/concurrency/RacerDModels.ml index f760305c9a7..1931cb2d633 100644 --- a/infer/src/concurrency/RacerDModels.ml +++ b/infer/src/concurrency/RacerDModels.ml @@ -657,7 +657,7 @@ let get_litho_explanation tenv pname = let class_is_ignored_by_racerd class_name = - Typ.Name.name class_name |> String.Set.mem Config.racerd_ignore_classes + IString.Set.mem (Typ.Name.name class_name) Config.racerd_ignore_classes let proc_is_ignored_by_racerd callee = diff --git a/infer/src/concurrency/StarvationModels.ml b/infer/src/concurrency/StarvationModels.ml index cf45040540b..0ea21f62966 100644 --- a/infer/src/concurrency/StarvationModels.ml +++ b/infer/src/concurrency/StarvationModels.ml @@ -38,7 +38,7 @@ let android_anr_time_limit = 5.0 (* get time unit in seconds *) let secs_of_timeunit = let time_units = - String.Map.of_alist_exn + Stdlib.List.to_seq [ ("NANOSECONDS", 0.000_000_001) ; ("MICROSECONDS", 0.000_001) ; ("MILLISECONDS", 0.001) @@ -46,6 +46,7 @@ let secs_of_timeunit = ; ("MINUTES", 60.0) ; ("HOURS", 3_600.0) ; ("DAYS", 86_400.0) ] + |> IString.Map.of_seq in let str_of_access_path = function | _, [AccessPath.FieldAccess field] @@ -61,7 +62,8 @@ let secs_of_timeunit = | _ -> None in - fun timeunit_exp -> str_of_exp timeunit_exp |> Option.bind ~f:(String.Map.find time_units) + fun timeunit_exp -> + str_of_exp timeunit_exp |> Option.bind ~f:(fun t -> IString.Map.find_opt t time_units) let float_of_const_int = function diff --git a/infer/src/cost/ConfigImpactAnalysis.ml b/infer/src/cost/ConfigImpactAnalysis.ml index 40bda563c7f..4fbd41e62cb 100644 --- a/infer/src/cost/ConfigImpactAnalysis.ml +++ b/infer/src/cost/ConfigImpactAnalysis.ml @@ -1049,7 +1049,7 @@ module TransferFunctions = struct let is_cheap_system_method = let cheap_system_methods = - String.Set.of_list + IString.Set.of_list [ "clearProperty" ; "console" ; "currentTimeMillis" @@ -1071,7 +1071,7 @@ module TransferFunctions = struct ; "setProperty" ; "setSecurityManager" ] in - fun _ method_name -> String.Set.mem cheap_system_methods method_name + fun _ method_name -> IString.Set.mem method_name cheap_system_methods let is_known_cheap_method = diff --git a/infer/src/integration/Differential.ml b/infer/src/integration/Differential.ml index 351fc5c810b..de9cc7c44d4 100644 --- a/infer/src/integration/Differential.ml +++ b/infer/src/integration/Differential.ml @@ -476,7 +476,7 @@ module ConfigImpactItem = struct in {config_impact_item; unchecked_callees} in - let fold_aux ~key:_ ~data ((acc_introduced, acc_fixed) as acc) = + let fold_aux _key data ((acc_introduced, acc_fixed) as acc) = match data with | `Both (current_reports, previous_reports) -> (* current/previous reports cannot be empty. *) @@ -507,14 +507,31 @@ module ConfigImpactItem = struct acc in let map_of_config_impact config_impact = - List.fold ~init:String.Map.empty config_impact + List.fold ~init:IString.Map.empty config_impact ~f:(fun acc ({Jsonconfigimpact_t.hash= key; unchecked_callees} as config_impact_item) -> let unchecked_callees = UncheckedCallees.decode unchecked_callees in - String.Map.add_multi acc ~key ~data:{config_impact_item; unchecked_callees} ) + IString.Map.update key + (fun v_opt -> + Some ({config_impact_item; unchecked_callees} :: Option.value v_opt ~default:[]) ) + acc ) in let current_map = map_of_config_impact current_config_impact in let previous_map = map_of_config_impact previous_config_impact in - Map.fold2 ~init:([], []) current_map previous_map ~f:fold_aux + let combined_map = + IString.Map.merge + (fun _key curr_opt prev_opt -> + match (curr_opt, prev_opt) with + | Some curr, None -> + Some (`Left curr) + | None, Some prev -> + Some (`Right prev) + | Some curr, Some prev -> + Some (`Both (curr, prev)) + | None, None -> + assert false ) + current_map previous_map + in + IString.Map.fold fold_aux combined_map ([], []) end module Report = struct diff --git a/infer/src/integration/DifferentialFilters.ml b/infer/src/integration/DifferentialFilters.ml index 01bc6c4bd6b..440497b5281 100644 --- a/infer/src/integration/DifferentialFilters.ml +++ b/infer/src/integration/DifferentialFilters.ml @@ -178,14 +178,16 @@ let interesting_paths_filter (interesting_paths : SourceFile.t list option) = if (not (SourceFile.is_invalid p)) && SourceFile.is_under_project_root p then Some (SourceFile.to_string p) else None ) - |> String.Set.of_list + |> IString.Set.of_list in fun ~do_log report -> let stat = {all= List.length report; filtered_out= 0; filtered_out_header= 0} in let filtered_report = List.filter ~f:(fun issue -> - let is_interesting_path = String.Set.mem interesting_paths_set issue.Jsonbug_t.file in + let is_interesting_path = + IString.Set.mem issue.Jsonbug_t.file interesting_paths_set + in if do_log then incr_stat is_interesting_path issue.Jsonbug_t.file stat ; is_interesting_path ) report diff --git a/infer/src/integration/Gradle.ml b/infer/src/integration/Gradle.ml index 81ce0505ab7..8b8877d70c3 100644 --- a/infer/src/integration/Gradle.ml +++ b/infer/src/integration/Gradle.ml @@ -45,11 +45,11 @@ let process_gradle_output_line = |> Option.value_map ~default:acc ~f:(fun pos -> let content = String.drop_prefix line (pos + String.length arg_start_pattern) in L.debug Capture Verbose "Processing: %s@." content ; - if String.Set.mem seen content then acc + if IString.Set.mem content seen then acc else let javac_data = parse_gradle_line ~kotlin:Config.kotlin_capture ~line:content in let out_dir = Unix.mkdtemp capture_output_template in - (String.Set.add seen content, (out_dir, javac_data) :: target_dirs) ) + (IString.Set.add content seen, (out_dir, javac_data) :: target_dirs) ) let run_gradle ~prog ~args = @@ -67,7 +67,7 @@ let run_gradle ~prog ~args = L.progress "[GRADLE] running gradle took %a@\n" Mtime.Span.pp (Mtime_clock.count time) ; match Utils.read_file gradle_output_file with | Ok lines -> - List.fold lines ~init:(String.Set.empty, []) ~f:process_gradle_output_line + List.fold lines ~init:(IString.Set.empty, []) ~f:process_gradle_output_line | Error _ -> L.die ExternalError "*** failed to read gradle output: %s@\n" gradle_output_file @@ -133,5 +133,5 @@ let capture ~prog ~args = let time = Mtime_clock.counter () in run_infer_capture rev_target_data ; write_rev_infer_deps rev_target_data ; - L.debug Capture Quiet "[GRADLE] infer processed %d lines in %a@\n" (String.Set.length processed) - Mtime.Span.pp (Mtime_clock.count time) + L.debug Capture Quiet "[GRADLE] infer processed %d lines in %a@\n" + (IString.Set.cardinal processed) Mtime.Span.pp (Mtime_clock.count time) diff --git a/infer/src/integration/JsonReports.ml b/infer/src/integration/JsonReports.ml index 8d94463822e..7a81982b7ee 100644 --- a/infer/src/integration/JsonReports.ml +++ b/infer/src/integration/JsonReports.ml @@ -239,7 +239,7 @@ module JsonIssuePrinter = MakeJsonListPrinter (struct match Utils.read_file filename with | Error _ -> L.user_error "Could not read file %s@\n" filename ; - String.Map.empty + IString.Map.empty | Ok lines -> Suppressions.parse_lines ~file:filename lines ) in diff --git a/infer/src/integration/StatsDiff.ml b/infer/src/integration/StatsDiff.ml index 102b4a92926..bf5d3f86598 100644 --- a/infer/src/integration/StatsDiff.ml +++ b/infer/src/integration/StatsDiff.ml @@ -29,24 +29,24 @@ module F = Format } v} *) -(* keep this sorted or else... (the [ok_exn] below will fail) *) +(* keep this sorted or else... *) let stable_stat_events = - [| "count.analysis_scheduler_gc_stats.compactions" - ; "count.backend_stats.pulse_aliasing_contradictions" - ; "count.backend_stats.pulse_captured_vars_length_contradictions" - ; "count.backend_stats.pulse_summaries_count_0_percent" - ; "count.backend_stats.pulse_summaries_count_1" - ; "count.backend_stats.pulse_summaries_unsat_for_caller" - ; "count.backend_stats.pulse_summaries_unsat_for_caller_percent" - ; "count.backend_stats.pulse_summaries_with_some_unreachable_nodes" - ; "count.backend_stats.pulse_summaries_with_some_unreachable_nodes_percent" - ; "count.backend_stats.pulse_summaries_with_some_unreachable_returns" - ; "count.backend_stats.pulse_summaries_with_some_unreachable_returns_percent" - ; "count.backend_stats.timeouts" - ; "count.num_analysis_workers" - ; "count.source_files_to_analyze" - ; "msg.analyzed_file" |] - |> String.Set.of_sorted_array |> Or_error.ok_exn + IString.Set.of_list + [ "count.analysis_scheduler_gc_stats.compactions" + ; "count.backend_stats.pulse_aliasing_contradictions" + ; "count.backend_stats.pulse_captured_vars_length_contradictions" + ; "count.backend_stats.pulse_summaries_count_0_percent" + ; "count.backend_stats.pulse_summaries_count_1" + ; "count.backend_stats.pulse_summaries_unsat_for_caller" + ; "count.backend_stats.pulse_summaries_unsat_for_caller_percent" + ; "count.backend_stats.pulse_summaries_with_some_unreachable_nodes" + ; "count.backend_stats.pulse_summaries_with_some_unreachable_nodes_percent" + ; "count.backend_stats.pulse_summaries_with_some_unreachable_returns" + ; "count.backend_stats.pulse_summaries_with_some_unreachable_returns_percent" + ; "count.backend_stats.timeouts" + ; "count.num_analysis_workers" + ; "count.source_files_to_analyze" + ; "msg.analyzed_file" ] let error ~expected json = @@ -269,7 +269,7 @@ let pp_diff fmt diff = let is_changed_entry_significant entry = - String.Set.mem stable_stat_events entry.event + IString.Set.mem entry.event stable_stat_events && Option.exists (delta_of_changed_entry entry) ~f:(fun (_, _, delta) -> Float.(abs delta > 0.5)) diff --git a/infer/src/integration/Suppressions.ml b/infer/src/integration/Suppressions.ml index 88486277f95..dd14ea29740 100644 --- a/infer/src/integration/Suppressions.ml +++ b/infer/src/integration/Suppressions.ml @@ -23,25 +23,26 @@ module Span = struct F.fprintf f "Blocks %a" (Pp.seq ~sep:", " pp_block) b end -type t = Span.t String.Map.t +type t = Span.t IString.Map.t let pp f suppressions = - if Map.is_empty suppressions then F.pp_print_string f "Empty" - else Map.iteri suppressions ~f:(fun ~key ~data -> F.fprintf f "%s: %a@\n" key Span.pp data) + if IString.Map.is_empty suppressions then F.pp_print_string f "Empty" + else IString.Map.iter (fun key data -> F.fprintf f "%s: %a@\n" key Span.pp data) suppressions -type fold_state = {current_line: int; block_start: int option; issue_types: String.Set.t; res: t} +type fold_state = {current_line: int; block_start: int option; issue_types: IString.Set.t; res: t} let pp_fold_state f {current_line; block_start; issue_types; res} = F.fprintf f "current_line: %d@\n" current_line ; F.fprintf f "block_start: %a@\n" (Pp.option F.pp_print_int) block_start ; - F.fprintf f "issue_types: [%a]@\n" (Pp.seq F.pp_print_string) (Set.to_list issue_types) ; + F.fprintf f "issue_types: [%a]@\n" (Pp.seq F.pp_print_string) (IString.Set.elements issue_types) ; F.fprintf f "res: %a@\n" pp res let update_suppressions_every issue_types suppressions = - Set.fold issue_types ~init:suppressions ~f:(fun m issue_type -> - Map.set m ~key:issue_type ~data:Span.Every ) + IString.Set.fold + (fun issue_type m -> IString.Map.add issue_type Span.Every m) + issue_types suppressions let update_suppressions block_start current_line issue_types suppressions = @@ -49,16 +50,19 @@ let update_suppressions block_start current_line issue_types suppressions = | None -> suppressions | Some start -> - Set.fold issue_types ~init:suppressions ~f:(fun m issue_type -> - match Map.find suppressions issue_type with + IString.Set.fold + (fun issue_type m -> + match IString.Map.find_opt issue_type suppressions with | None -> - Map.set m ~key:issue_type ~data:(Span.Blocks [{first= start; last= current_line}]) + IString.Map.add issue_type (Span.Blocks [{first= start; last= current_line}]) m | Some (Span.Blocks b) -> - Map.set m ~key:issue_type - ~data:(Span.Blocks (b @ [{Span.first= start; last= current_line}])) + IString.Map.add issue_type + (Span.Blocks (b @ [{Span.first= start; last= current_line}])) + m | Some Span.Every -> (* don't override Every with Blocks *) m ) + issue_types suppressions let substring_after_match rx s = @@ -69,14 +73,14 @@ let substring_after_match rx s = Some (String.concat ~sep:"," parts) -let regex_cache = ref String.Map.empty +let regex_cache = ref IString.Map.empty let get_regex s = - match Map.find !regex_cache s with + match IString.Map.find_opt s !regex_cache with | None -> ( try let r = Str.regexp s in - regex_cache := Map.set !regex_cache ~key:s ~data:r ; + regex_cache := IString.Map.add s r !regex_cache ; Some r with _ -> L.user_error "Invalid regex: %s@\n" s ; @@ -110,7 +114,7 @@ let extract_valid_issue_types s = let valid = valid_issue_type s in if not valid then L.user_error "%s not a valid issue_type / wildcard@\n" s ; valid ) - |> String.Set.of_list + |> IString.Set.of_list (* trailing space intentional *) @@ -122,14 +126,14 @@ let parse_lines ?file lines = let parse_result = List.fold lines ~init: - {current_line= 1; block_start= None; issue_types= String.Set.empty; res= String.Map.empty} + {current_line= 1; block_start= None; issue_types= IString.Set.empty; res= IString.Map.empty} ~f:(fun {current_line; block_start; issue_types; res} line -> let next_line = current_line + 1 in match (substring_after_match ignore_all_rx line, substring_after_match ignore_rx line) with | None, None -> { current_line= next_line ; block_start= None - ; issue_types= String.Set.empty + ; issue_types= IString.Set.empty ; res= update_suppressions block_start current_line issue_types res } | Some s, other -> if Option.is_some other then @@ -137,12 +141,12 @@ let parse_lines ?file lines = (Option.value ~default:"" file) next_line ; { current_line= next_line ; block_start= None - ; issue_types= String.Set.empty + ; issue_types= IString.Set.empty ; res= update_suppressions_every (extract_valid_issue_types s) res } | _, Some s -> { current_line= next_line ; block_start= (if Option.is_some block_start then block_start else Some current_line) - ; issue_types= Set.union issue_types (extract_valid_issue_types s) + ; issue_types= IString.Set.union issue_types (extract_valid_issue_types s) ; res } ) in L.debug Report Verbose "Parse state: %a@\n" pp_fold_state parse_result ; @@ -155,8 +159,8 @@ let parse_lines ?file lines = let first_key_match ~suppressions s = - Map.to_sequence suppressions - |> Sequence.find ~f:(fun (k, _) -> + IString.Map.to_seq suppressions + |> Seq.find (fun (k, _) -> match get_regex k with Some rx -> Str.string_match rx s 0 | _ -> false ) |> Option.map ~f:snd @@ -168,7 +172,7 @@ let is_suppressed ~suppressions ~issue_type ~line = 2. loop trough all keys (treated as regexes) and find first match *) match - match Map.find suppressions issue_type with + match IString.Map.find_opt issue_type suppressions with | None -> first_key_match ~suppressions issue_type | v -> diff --git a/infer/src/integration/Suppressions.mli b/infer/src/integration/Suppressions.mli index 93fdc3860de..5214a210d25 100644 --- a/infer/src/integration/Suppressions.mli +++ b/infer/src/integration/Suppressions.mli @@ -13,7 +13,7 @@ module Span : sig type t = Every | Blocks of block list [@@deriving compare, equal] end -type t = Span.t String.Map.t +type t = Span.t IString.Map.t val parse_lines : ?file:string -> string list -> t diff --git a/infer/src/integration/unit/SuppressionsTest.ml b/infer/src/integration/unit/SuppressionsTest.ml index 8da92bf8097..0afbade4a08 100644 --- a/infer/src/integration/unit/SuppressionsTest.ml +++ b/infer/src/integration/unit/SuppressionsTest.ml @@ -6,7 +6,7 @@ *) open! IStd -module Map = String.Map +module Map = IString.Map (** {2 parsing} *) @@ -41,8 +41,8 @@ let%test "parsing matching line multiple issue types" = (Suppressions.parse_lines ["1+1 // @infer-ignore BUFFER_OVERRUN_L1,PULSE_UNNECESSARY_COPY"]) Map.( empty - |> add_exn ~key:"BUFFER_OVERRUN_L1" ~data:(Suppressions.Span.Blocks [{first= 1; last= 2}]) - |> add_exn ~key:"PULSE_UNNECESSARY_COPY" ~data:(Suppressions.Span.Blocks [{first= 1; last= 2}]) ) + |> add "BUFFER_OVERRUN_L1" (Suppressions.Span.Blocks [{first= 1; last= 2}]) + |> add "PULSE_UNNECESSARY_COPY" (Suppressions.Span.Blocks [{first= 1; last= 2}]) ) let%test "parsing matching line multiple noise" = @@ -51,8 +51,8 @@ let%test "parsing matching line multiple noise" = ["1+1 // @infer-ignore BUFFER_OVERRUN_L1,,,, PULSE_UNNECESSARY_COPY,,,,,,,"] ) Map.( empty - |> add_exn ~key:"BUFFER_OVERRUN_L1" ~data:(Suppressions.Span.Blocks [{first= 1; last= 2}]) - |> add_exn ~key:"PULSE_UNNECESSARY_COPY" ~data:(Suppressions.Span.Blocks [{first= 1; last= 2}]) ) + |> add "BUFFER_OVERRUN_L1" (Suppressions.Span.Blocks [{first= 1; last= 2}]) + |> add "PULSE_UNNECESSARY_COPY" (Suppressions.Span.Blocks [{first= 1; last= 2}]) ) let%test "multi line block" = @@ -61,8 +61,8 @@ let%test "multi line block" = ["// @infer-ignore BUFFER_OVERRUN_L1"; "1+1 // @infer-ignore ,PULSE_UNNECESSARY_COPY"] ) Map.( empty - |> add_exn ~key:"BUFFER_OVERRUN_L1" ~data:(Suppressions.Span.Blocks [{first= 1; last= 3}]) - |> add_exn ~key:"PULSE_UNNECESSARY_COPY" ~data:(Suppressions.Span.Blocks [{first= 1; last= 3}]) ) + |> add "BUFFER_OVERRUN_L1" (Suppressions.Span.Blocks [{first= 1; last= 3}]) + |> add "PULSE_UNNECESSARY_COPY" (Suppressions.Span.Blocks [{first= 1; last= 3}]) ) let%test "multiple blocks" = @@ -71,8 +71,8 @@ let%test "multiple blocks" = ["// @infer-ignore BUFFER_OVERRUN_L1"; ""; "1+1 // @infer-ignore BUFFER_OVERRUN_L1"] ) Map.( empty - |> add_exn ~key:"BUFFER_OVERRUN_L1" - ~data:(Suppressions.Span.Blocks [{first= 1; last= 2}; {first= 3; last= 4}]) ) + |> add "BUFFER_OVERRUN_L1" + (Suppressions.Span.Blocks [{first= 1; last= 2}; {first= 3; last= 4}]) ) let%test "parsing matching line every" = diff --git a/infer/src/istd/IList.ml b/infer/src/istd/IList.ml index a6a5a68391b..6a0cb9e0e81 100644 --- a/infer/src/istd/IList.ml +++ b/infer/src/istd/IList.ml @@ -122,21 +122,16 @@ let split_last_rev l = match List.rev l with x :: xs -> Some (x, xs) | [] -> Non let append_no_duplicates (type a) ~(cmp : a -> a -> int) = (* roughly based on [Core.List.stable_dedup_staged] but also takes care of the append and takes into account the invariant that [list1] and [list2] do not contain duplicates individually *) - let module Set = Set.Make (struct + let module Set = Stdlib.Set.Make (struct type t = a let compare = cmp - - (* we never calls these *) - let t_of_sexp _ = assert false - - let sexp_of_t _ = assert false end) in Staged.stage (fun (list1 : a list) (list2 : a list) -> let set1 = Set.of_list list1 in let res_rev = List.fold_left list2 ~init:(List.rev list1) ~f:(fun res_rev x -> - if Set.mem set1 x then res_rev else x :: res_rev ) + if Set.mem x set1 then res_rev else x :: res_rev ) in List.rev res_rev ) diff --git a/infer/src/istd/IString.ml b/infer/src/istd/IString.ml new file mode 100644 index 00000000000..17b0fde6f4c --- /dev/null +++ b/infer/src/istd/IString.ml @@ -0,0 +1,16 @@ +(* + * Copyright (c) Facebook, Inc. and its affiliates. + * + * This source code is licensed under the MIT license found in the + * LICENSE file in the root directory of this source tree. + *) + +open! IStd + +module T = struct + type t = string [@@deriving compare, hash, equal] +end + +module Map = Stdlib.Map.Make (T) +module Set = Stdlib.Set.Make (T) +module Hash = Stdlib.Hashtbl.Make (T) diff --git a/infer/src/istd/IString.mli b/infer/src/istd/IString.mli new file mode 100644 index 00000000000..0aeacb41204 --- /dev/null +++ b/infer/src/istd/IString.mli @@ -0,0 +1,12 @@ +(* + * Copyright (c) Facebook, Inc. and its affiliates. + * + * This source code is licensed under the MIT license found in the + * LICENSE file in the root directory of this source tree. + *) + +module Map : Stdlib.Map.S with type key = string + +module Set : Stdlib.Set.S with type elt = string + +module Hash : Stdlib.Hashtbl.S with type key = string diff --git a/infer/src/istd/Pp.ml b/infer/src/istd/Pp.ml index c527b86cc93..1bb588c1eea 100644 --- a/infer/src/istd/Pp.ml +++ b/infer/src/istd/Pp.ml @@ -205,8 +205,8 @@ let cli_args_with_verbosity ~verbose fmt args = pp_argfile in_argfiles fmt argfile ) ) ; if !at_least_one then F.fprintf fmt "@]@\n" and pp_argfile in_argfiles fmt fname = - if not (String.Set.mem in_argfiles fname) then - let in_argfiles' = String.Set.add in_argfiles fname in + if not (IString.Set.mem fname in_argfiles) then + let in_argfiles' = IString.Set.add fname in_argfiles in match In_channel.read_lines fname with | args -> F.fprintf fmt "++Contents of %s:@\n%a@\n" @@ -220,7 +220,7 @@ let cli_args_with_verbosity ~verbose fmt args = Exn.pp exn in pp_args fmt args ; - if verbose then pp_argfile_args String.Set.empty fmt args + if verbose then pp_argfile_args IString.Set.empty fmt args let cli_args fmt args = cli_args_with_verbosity ~verbose:true fmt args diff --git a/infer/src/java/jClasspath.ml b/infer/src/java/jClasspath.ml index 32007066da7..48c9332e23b 100644 --- a/infer/src/java/jClasspath.ml +++ b/infer/src/java/jClasspath.ml @@ -29,7 +29,7 @@ type file_entry = Singleton of SourceFile.t | Duplicate of (string list * Source type t = { classpath_channel: Javalib.class_path - ; sources: file_entry String.Map.t + ; sources: file_entry IString.Map.t ; classes: JBasics.ClassSet.t } (* Open the source file and search for the package declaration. @@ -61,7 +61,7 @@ let add_source_file = let basename = Filename.basename path in let entry = let current_source_file = SourceFile.from_abs_path (convert_to_absolute path) in - match String.Map.find map basename with + match IString.Map.find_opt basename map with | None -> (* Most common case: there is no conflict with the base name of the source file *) Singleton current_source_file @@ -80,10 +80,10 @@ let add_source_file = let current_package = read_package_declaration current_source_file in Duplicate ((current_package, current_source_file) :: previous_source_files) in - String.Map.set ~key:basename ~data:entry map + IString.Map.add basename entry map -let add_root_path path roots = String.Set.add roots path +let add_root_path path roots = IString.Set.add path roots let read_modules_1 path = let temp_dir = Filename.temp_dir "java_modules_lib" "" in @@ -130,7 +130,7 @@ let load_from_verbose_output = match In_channel.input_line file_in with | None -> let paths = if Config.java_read_modules then read_modules paths else paths in - let classpath = classpath_of_paths (String.Set.elements roots @ paths) in + let classpath = classpath_of_paths (IString.Set.elements roots @ paths) in {classpath_channel= Javalib.class_path classpath; sources; classes} | Some line when Str.string_match class_filename_re line 0 -> ( let path = @@ -163,7 +163,7 @@ let load_from_verbose_output = in fun javac_verbose_out -> Utils.with_file_in javac_verbose_out - ~f:(loop [] String.Set.empty String.Map.empty JBasics.ClassSet.empty) + ~f:(loop [] IString.Set.empty IString.Map.empty JBasics.ClassSet.empty) let collect_classnames init jar_filename = @@ -195,7 +195,7 @@ let search_classes path = (add_root_path p paths, collect_classnames classes p) | _ -> accu ) - (String.Set.empty, JBasics.ClassSet.empty) + (IString.Set.empty, JBasics.ClassSet.empty) path @@ -207,7 +207,7 @@ let is_valid_source_file path = let search_sources sources = let initial_map = - List.fold sources ~init:String.Map.empty ~f:(fun map path -> + List.fold sources ~init:IString.Map.empty ~f:(fun map path -> if is_valid_source_file path then add_source_file path map else ( L.external_warning "'%s' does not appear to be a valid source file, skipping@\n" path ; @@ -227,7 +227,7 @@ let load_from_arguments classes_out_path sources = let split cp_option = Option.value_map ~f:split_classpath ~default:[] cp_option in let classpath = (* order follows https://docs.oracle.com/javase/7/docs/technotes/tools/windows/classpath.html *) - split Config.bootclasspath @ split Config.classpath @ String.Set.elements roots + split Config.bootclasspath @ split Config.classpath @ IString.Set.elements roots |> classpath_of_paths in {classpath_channel= Javalib.class_path classpath; sources= search_sources sources; classes} @@ -245,13 +245,13 @@ let with_classpath ~f source = | FromArguments {path; sources} -> load_from_arguments path sources in - if String.Map.is_empty classpath.sources then + if IString.Map.is_empty classpath.sources then L.user_warning "No Java source code loaded. Analyzing JAR/WAR files directly" ; - if String.Map.is_empty classpath.sources && JBasics.ClassSet.is_empty classpath.classes then + if IString.Map.is_empty classpath.sources && JBasics.ClassSet.is_empty classpath.classes then L.(die InternalError) "Failed to load any Java source or class files" ; L.(debug Capture Quiet) "Translating %d source files (%d classes)@." - (String.Map.length classpath.sources) + (IString.Map.cardinal classpath.sources) (JBasics.ClassSet.cardinal classpath.classes) ; f classpath ; Javalib.close_class_path classpath.classpath_channel diff --git a/infer/src/java/jClasspath.mli b/infer/src/java/jClasspath.mli index c347be86ffb..5c0c69d7845 100644 --- a/infer/src/java/jClasspath.mli +++ b/infer/src/java/jClasspath.mli @@ -14,7 +14,7 @@ type file_entry = Singleton of SourceFile.t | Duplicate of (string list * Source type t = { classpath_channel: Javalib.class_path - ; sources: file_entry String.Map.t + ; sources: file_entry IString.Map.t ; classes: JBasics.ClassSet.t } type source = diff --git a/infer/src/java/jFrontend.ml b/infer/src/java/jFrontend.ml index c20df83599f..4c99cb7e053 100644 --- a/infer/src/java/jFrontend.ml +++ b/infer/src/java/jFrontend.ml @@ -27,7 +27,7 @@ let add_edges (context : JContext.t) start_node exn_node exit_nodes method_body_ | JTrans.Skip when is_last pc && not (JContext.is_goto_jump context pc) -> exit_nodes | JTrans.Skip -> - direct_successors pc (Int.Set.add visited pc) + direct_successors pc (IInt.Set.add pc visited) | JTrans.Instr node -> [node] | JTrans.Prune (node_true, node_false) -> @@ -40,20 +40,20 @@ let add_edges (context : JContext.t) start_node exn_node exit_nodes method_body_ match JContext.get_goto_jump context pc with | JContext.Next -> let next_pc = pc + 1 in - if Int.Set.mem visited next_pc || is_a_throw pc then [] + if IInt.Set.mem next_pc visited || is_a_throw pc then [] else get_body_nodes_ next_pc visited - | JContext.Jump goto_pc when Int.Set.mem visited goto_pc -> + | JContext.Jump goto_pc when IInt.Set.mem goto_pc visited -> [] (* loop in goto *) | JContext.Jump goto_pc -> get_body_nodes_ goto_pc visited | JContext.Exit -> exit_nodes in - let get_body_nodes pc = get_body_nodes_ pc Int.Set.empty in + let get_body_nodes pc = get_body_nodes_ pc IInt.Set.empty in let get_succ_nodes node pc = match JContext.get_if_jump context node with | None -> - direct_successors pc Int.Set.empty + direct_successors pc IInt.Set.empty | Some jump_pc -> get_body_nodes jump_pc in @@ -81,7 +81,7 @@ let add_edges (context : JContext.t) start_node exn_node exit_nodes method_body_ in let first_nodes = (* deals with the case of an empty array *) - direct_successors (-1) Int.Set.empty + direct_successors (-1) IInt.Set.empty in (* the exceptions edges here are going directly to the exit node *) Procdesc.node_set_succs context.procdesc start_node ~normal:first_nodes ~exn:exit_nodes ; diff --git a/infer/src/java/jMain.ml b/infer/src/java/jMain.ml index 88532ca3d72..c454599b2a5 100644 --- a/infer/src/java/jMain.ml +++ b/infer/src/java/jMain.ml @@ -101,7 +101,7 @@ let do_all_files classpath program = let translate_source_file basename package_opt source_file = if not (skip source_file) then do_source_file program tenv basename package_opt source_file in - if String.Map.is_empty sources then ( + if IString.Map.is_empty sources then ( L.(debug Capture Medium) "no source files found, capturing class files directly@." ; JBasics.ClassSet.iter (fun cn -> @@ -113,8 +113,8 @@ let do_all_files classpath program = Option.iter ~f:(do_class tenv program cn) node ) classes ) else - String.Map.iteri - ~f:(fun ~key:basename ~data:file_entry -> + IString.Map.iter + (fun basename file_entry -> match file_entry with | JClasspath.Singleton source_file -> translate_source_file basename None source_file diff --git a/infer/src/java/jTrans.ml b/infer/src/java/jTrans.ml index bad3feb9a21..6bfab97cc5e 100644 --- a/infer/src/java/jTrans.ml +++ b/infer/src/java/jTrans.ml @@ -912,11 +912,11 @@ let get_array_length context pc expr_list content_type = let detect_loop entry_pc impl = let code = JBir.code impl in let pc_bound = Array.length code in - let empty = Int.Set.empty in + let empty = IInt.Set.empty in let rec loop visited pc = - if Int.Set.mem visited pc || pc >= pc_bound then (false, visited) + if IInt.Set.mem pc visited || pc >= pc_bound then (false, visited) else - let visited_updated = Int.Set.add visited pc in + let visited_updated = IInt.Set.add pc visited in match code.(pc) with | JBir.Goto goto_pc when Int.equal goto_pc entry_pc -> (true, empty) diff --git a/infer/src/pulse/Pulse.ml b/infer/src/pulse/Pulse.ml index a74c8483769..13006d293e2 100644 --- a/infer/src/pulse/Pulse.ml +++ b/infer/src/pulse/Pulse.ml @@ -1646,11 +1646,11 @@ let log_summary_count proc_name summary = let counts = let summary_kinds = List.map ~f:ExecutionDomain.to_name summary in let map = - let incr_or_one val_opt = match val_opt with Some v -> v + 1 | None -> 1 in - let update acc s = String.Map.update acc s ~f:incr_or_one in - List.fold summary_kinds ~init:String.Map.empty ~f:update + let incr_or_one val_opt = Some (match val_opt with Some v -> v + 1 | None -> 1) in + let update acc s = IString.Map.update s incr_or_one acc in + List.fold summary_kinds ~init:IString.Map.empty ~f:update in - let alist = List.map ~f:(fun (s, i) -> (s, `Int i)) (String.Map.to_alist map) in + let alist = List.map ~f:(fun (s, i) -> (s, `Int i)) (IString.Map.bindings map) in let alist = match PulseModelsErlang.Custom.exists_db_model proc_name with | true -> diff --git a/infer/src/pulse/PulseModelsHack.ml b/infer/src/pulse/PulseModelsHack.ml index 40cdccd34e1..2c367239e77 100644 --- a/infer/src/pulse/PulseModelsHack.ml +++ b/infer/src/pulse/PulseModelsHack.ml @@ -1465,7 +1465,7 @@ let check_against_type_struct v tdict : DSL.aval DSL.model_monad = let rootname = replace_backslash_with_colon rootname in L.d_printfln "got root_name = %s, type_prop_name = %s" rootname type_prop_name ; let concatenated_name = Printf.sprintf "%s$$%s" rootname type_prop_name in - if String.Set.mem visited_set concatenated_name then ( + if IString.Set.mem concatenated_name visited_set then ( L.d_printfln "Cyclic type constant detected!" ; ret None ) else @@ -1479,12 +1479,12 @@ let check_against_type_struct v tdict : DSL.aval DSL.model_monad = L.d_printfln "type structure for projection=%a" AbstractValue.pp (fst type_constant_ts) ; find_name type_constant_ts nullable - (String.Set.add visited_set concatenated_name) + (IString.Set.add concatenated_name visited_set) | _, _ -> ret None ) else ret None ) in - let* name_opt = find_name tdict false String.Set.empty in + let* name_opt = find_name tdict false IString.Set.empty in match name_opt with | Some (name, nullable) -> L.d_printfln "type structure test against type name %a" Typ.Name.pp name ; diff --git a/infer/src/textual/TextualBasicVerification.ml b/infer/src/textual/TextualBasicVerification.ml index c3e739452c3..a023d62db80 100644 --- a/infer/src/textual/TextualBasicVerification.ml +++ b/infer/src/textual/TextualBasicVerification.ml @@ -81,7 +81,7 @@ let count_generics_args args generics = let verify_decl ~env errors (decl : Module.decl) = let verify_label errors declared_labels pname label = - if String.Set.mem declared_labels label.NodeName.value then errors + if IString.Set.mem label.NodeName.value declared_labels then errors else UnknownLabel {label; pname} :: errors in let verify_field errors field = @@ -221,8 +221,8 @@ let verify_decl ~env errors (decl : Module.decl) = idents ) ) in let declared_labels = - List.fold procdesc.nodes ~init:String.Set.empty ~f:(fun set node -> - String.Set.add set node.Node.label.value ) + List.fold procdesc.nodes ~init:IString.Set.empty ~f:(fun set node -> + IString.Set.add node.Node.label.value set ) in let verify_label errors = verify_label errors declared_labels procdesc.procdecl.qualified_name diff --git a/infer/src/textual/TextualTransform.ml b/infer/src/textual/TextualTransform.ml index 2091f201334..2168fa41916 100644 --- a/infer/src/textual/TextualTransform.ml +++ b/infer/src/textual/TextualTransform.ml @@ -56,11 +56,11 @@ module FixClosureAppExpr = struct let open ProcDesc in let globals_and_locals = List.fold pdesc.locals ~init:globals ~f:(fun set (varname, _) -> - String.Set.add set varname.VarName.value ) + IString.Set.add varname.VarName.value set ) in let is_varname ({enclosing_class; name} : QualifiedProcName.t) = match enclosing_class with - | TopLevel when String.Set.mem globals_and_locals name.value -> + | TopLevel when IString.Set.mem name.value globals_and_locals -> let varname : VarName.t = {value= name.value; loc= name.loc} in Some (Exp.Load {exp= Lvar varname; typ= None}) | TopLevel when is_ident name.value -> @@ -142,10 +142,10 @@ module FixClosureAppExpr = struct let transform (module_ : Module.t) = let open Module in let globals = - List.fold module_.decls ~init:String.Set.empty ~f:(fun set decl -> + List.fold module_.decls ~init:IString.Set.empty ~f:(fun set decl -> match decl with | Global {name} -> - String.Set.add set name.VarName.value + IString.Set.add name.VarName.value set | Proc _ | Struct _ | Procdecl _ -> set ) in