diff --git a/infer/src/IR/QualifiedCppName.ml b/infer/src/IR/QualifiedCppName.ml index 6f3ac4588..6b7be8e7f 100644 --- a/infer/src/IR/QualifiedCppName.ml +++ b/infer/src/IR/QualifiedCppName.ml @@ -108,7 +108,7 @@ module Match = struct let of_fuzzy_qual_names ?prefix fuzzy_qual_names = - List.rev_map fuzzy_qual_names ~f:qualifiers_of_fuzzy_qual_name + RevList.rev_map fuzzy_qual_names ~f:qualifiers_of_fuzzy_qual_name |> qualifiers_list_matcher ?prefix diff --git a/infer/src/IR/QualifiedCppName.mli b/infer/src/IR/QualifiedCppName.mli index eccbe187e..346dd7ded 100644 --- a/infer/src/IR/QualifiedCppName.mli +++ b/infer/src/IR/QualifiedCppName.mli @@ -87,7 +87,7 @@ val pp : Format.formatter -> t -> unit module Match : sig type quals_matcher - val of_fuzzy_qual_names : ?prefix:bool -> string list -> quals_matcher + val of_fuzzy_qual_names : ?prefix:bool -> string RevList.t -> quals_matcher val match_qualifiers : quals_matcher -> t -> bool end diff --git a/infer/src/IR/inferconfig.ml b/infer/src/IR/inferconfig.ml index 33070dc10..4d377dd64 100644 --- a/infer/src/IR/inferconfig.ml +++ b/infer/src/IR/inferconfig.ml @@ -30,14 +30,14 @@ let do_not_filter : filters = type filter_config = - { whitelist: string list - ; blacklist: string list - ; blacklist_files_containing: string list - ; suppress_errors: string list } + { whitelist: string RevList.t + ; blacklist: string RevList.t + ; blacklist_files_containing: string RevList.t + ; suppress_errors: string RevList.t } let is_matching patterns source_file = let path = SourceFile.to_rel_path source_file in - List.exists + RevList.exists ~f:(fun pattern -> try Int.equal (Str.search_forward pattern path 0) 0 with Caml.Not_found -> false ) patterns @@ -77,19 +77,20 @@ module FileContainsStringMatcher = struct Utils.with_file_in path ~f:(fun file_in -> not (loop regexp_not file_in)) ) - let create_matcher (s_patterns : contains_pattern list) = - if List.is_empty s_patterns then default_matcher + let create_matcher (s_patterns : contains_pattern RevList.t) = + if RevList.is_empty s_patterns then default_matcher else let source_map = ref SourceFile.Map.empty in let not_contains_patterns = - List.exists ~f:(fun {not_contains} -> Option.is_some not_contains) s_patterns + RevList.exists ~f:(fun {not_contains} -> Option.is_some not_contains) s_patterns in let disjunctive_regexp = - Str.regexp (String.concat ~sep:"\\|" (List.map ~f:(fun {contains} -> contains) s_patterns)) + Str.regexp + (String.concat ~sep:"\\|" (RevList.rev_map ~f:(fun {contains} -> contains) s_patterns)) in let cond check_regexp = if not_contains_patterns then - List.exists + RevList.exists ~f:(fun {contains; not_contains} -> check_regexp (Str.regexp contains) (Option.map not_contains ~f:Str.regexp) ) s_patterns @@ -124,10 +125,10 @@ module FileOrProcMatcher = struct let default_matcher : matcher = fun _ _ -> false let create_method_matcher m_patterns = - if List.is_empty m_patterns then default_matcher + if RevList.is_empty m_patterns then default_matcher else let pattern_map = - List.fold + RevList.fold ~f:(fun map pattern -> let previous = try String.Map.find_exn map pattern.class_name @@ -155,11 +156,11 @@ module FileOrProcMatcher = struct let s_patterns, m_patterns = let collect (s_patterns, m_patterns) = function | Source_pattern (_, s) -> - (s :: s_patterns, m_patterns) + (RevList.cons s s_patterns, m_patterns) | Method_pattern (_, mp) -> - (s_patterns, mp :: m_patterns) + (s_patterns, RevList.cons mp m_patterns) in - List.fold ~f:collect ~init:([], []) patterns + List.fold ~f:collect ~init:(RevList.empty, RevList.empty) patterns in let s_matcher = let matcher = FileContainsStringMatcher.create_matcher s_patterns in @@ -330,15 +331,15 @@ let load_filters () = let filters_from_inferconfig inferconfig : filters = let path_filter = let whitelist_filter : path_filter = - if List.is_empty inferconfig.whitelist then default_path_filter - else is_matching (List.map ~f:Str.regexp inferconfig.whitelist) + if RevList.is_empty inferconfig.whitelist then default_path_filter + else is_matching (RevList.map ~f:Str.regexp inferconfig.whitelist) in let blacklist_filter : path_filter = - is_matching (List.map ~f:Str.regexp inferconfig.blacklist) + is_matching (RevList.map ~f:Str.regexp inferconfig.blacklist) in let blacklist_files_containing_filter : path_filter = FileContainsStringMatcher.create_matcher - (List.map + (RevList.map ~f:(fun s -> {contains= s; not_contains= None}) inferconfig.blacklist_files_containing) in @@ -351,7 +352,7 @@ let filters_from_inferconfig inferconfig : filters = let error_filter = function | error_name -> let error_str = error_name.IssueType.unique_id in - not (List.exists ~f:(String.equal error_str) inferconfig.suppress_errors) + not (RevList.exists ~f:(String.equal error_str) inferconfig.suppress_errors) in {path_filter; error_filter; proc_filter= default_proc_filter} diff --git a/infer/src/absint/ConcurrencyModels.ml b/infer/src/absint/ConcurrencyModels.ml index 1bd92c358..2c26352ba 100644 --- a/infer/src/absint/ConcurrencyModels.ml +++ b/infer/src/absint/ConcurrencyModels.ml @@ -123,12 +123,12 @@ end = struct List.concat_map lock_models ~f:(fun mdl -> List.map (f mdl) ~f:(fun mtd -> mdl.classname ^ "::" ^ mtd) ) in - mk_matcher lock_methods + mk_matcher (RevList.of_list lock_methods) in ( mk_model_matcher ~f:(fun mdl -> mdl.lock) , mk_model_matcher ~f:(fun mdl -> mdl.unlock) , mk_model_matcher ~f:(fun mdl -> mdl.trylock) - , mk_matcher ["std::lock"] ) + , mk_matcher (RevList.of_list ["std::lock"]) ) (** C++ guard classes used for scope-based lock management. NB we pretend all classes below @@ -192,11 +192,11 @@ end = struct let is_guard_constructor, is_guard_destructor, is_guard_unlock, is_guard_lock, is_guard_trylock = let make ~f = let constructors = List.map guards ~f in - mk_matcher constructors + mk_matcher (RevList.of_list constructors) in let make_trylock ~f = let methods = List.concat_map guards ~f in - mk_matcher methods + mk_matcher (RevList.of_list methods) in ( make ~f:get_guard_constructor , make ~f:get_guard_destructor diff --git a/infer/src/al/AL.ml b/infer/src/al/AL.ml index 1d7923c8e..41fc20d25 100644 --- a/infer/src/al/AL.ml +++ b/infer/src/al/AL.ml @@ -331,13 +331,14 @@ let context_with_ck_set context decl_list = let find_linters_files () = - List.concat_map + RevList.rev_concat_map ~f:(fun folder -> Utils.find_files ~path:folder ~extension:".al") Config.linters_def_folder let linters_files = - List.dedup_and_sort ~compare:String.compare (find_linters_files () @ Config.linters_def_file) + RevList.dedup_and_sort ~compare:String.compare + (RevList.rev_append (find_linters_files ()) Config.linters_def_file) let is_decl_allowed lcxt decl = diff --git a/infer/src/al/CTLParserHelper.ml b/infer/src/al/CTLParserHelper.ml index e57ce55b2..16bb63c7d 100644 --- a/infer/src/al/CTLParserHelper.ml +++ b/infer/src/al/CTLParserHelper.ml @@ -29,7 +29,7 @@ let validate_al_files () = None with CTLExceptions.ALFileException exc_info -> Some (CTLExceptions.json_of_exc_info exc_info) in - match List.filter_map ~f:validate_al_file Config.linters_def_file with + match RevList.rev_filter_map ~f:validate_al_file Config.linters_def_file with | [] -> Ok () | _ as errors -> diff --git a/infer/src/backend/printer.ml b/infer/src/backend/printer.ml index 64b79de92..91e23433e 100644 --- a/infer/src/backend/printer.ml +++ b/infer/src/backend/printer.ml @@ -231,14 +231,13 @@ end = struct let is_whitelisted = - match Config.write_html_whitelist_regex with - | [] -> - fun _ -> true - | _ as reg_list -> - let regex = Str.regexp (String.concat ~sep:"\\|" reg_list) in - fun file -> - let fname = SourceFile.to_rel_path file in - Str.string_match regex fname 0 + if RevList.is_empty Config.write_html_whitelist_regex then fun _ -> true + else + let reg_list = RevList.to_list Config.write_html_whitelist_regex in + let regex = Str.regexp (String.concat ~sep:"\\|" reg_list) in + fun file -> + let fname = SourceFile.to_rel_path file in + Str.string_match regex fname 0 (* diff --git a/infer/src/base/CommandLineOption.ml b/infer/src/base/CommandLineOption.ml index 4dabbaba3..a460d8dca 100644 --- a/infer/src/base/CommandLineOption.ml +++ b/infer/src/base/CommandLineOption.ml @@ -321,7 +321,7 @@ let subcommands = ref [] let subcommand_actions = ref [] -let rev_anon_args = ref [] +let rev_anon_args = ref RevList.empty (* keep track of the current active command to drive the remainder of the program *) let curr_command = ref None @@ -539,14 +539,15 @@ let mk_string_list ?(default = []) ?(default_to_string = String.concat ~sep:",") ?(deprecated = []) ~long ?short ?parse_mode ?in_help ?(meta = "string") doc = let flag = mk_flag ~deprecated ?short ~long in let mk () = - mk ~deprecated ~long ?short ~default ?parse_mode ?in_help ~meta:("+" ^ meta) doc - ~default_to_string - ~mk_setter:(fun var str -> var := f str :: !var) + mk ~deprecated ~long ?short ~default:(RevList.of_list default) ?parse_mode ?in_help + ~meta:("+" ^ meta) doc + ~default_to_string:(fun rev -> RevList.to_list rev |> default_to_string) + ~mk_setter:(fun var str -> var := RevList.cons (f str) !var) ~decode_json:(list_json_decoder (string_json_decoder ~flag)) ~mk_spec:(fun set -> String set) in let reset_doc = reset_doc_list ~long in - mk_with_reset [] ~reset_doc ~long ?parse_mode mk + mk_with_reset RevList.empty ~reset_doc ~long ?parse_mode mk let map_to_str map = @@ -634,13 +635,14 @@ let mk_path_list ?(default = []) ?(default_to_string = String.concat ~sep:", ") let flag = mk_flag ~deprecated ?short ~long in let mk () = mk_path_helper - ~setter:(fun var x -> var := x :: !var) + ~setter:(fun var x -> var := RevList.cons x !var) ~decode_json:(list_json_decoder (path_json_decoder ~flag)) - ~default_to_string ~default ~deprecated ~long ~short ~parse_mode ~in_help ~meta:("+" ^ meta) - doc + ~default_to_string:(fun rev -> RevList.to_list rev |> default_to_string) + ~default:(RevList.of_list default) ~deprecated ~long ~short ~parse_mode ~in_help + ~meta:("+" ^ meta) doc in let reset_doc = reset_doc_list ~long in - mk_with_reset [] ~reset_doc ~long ?parse_mode mk + mk_with_reset RevList.empty ~reset_doc ~long ?parse_mode mk let mk_symbols_meta symbols = @@ -807,11 +809,12 @@ let string_of_command command = let mk_rest_actions ?(parse_mode = InferCommand) ?(in_help = []) doc ~usage decode_action = - let rest = ref [] in + let rest = ref RevList.empty in let spec = String (fun arg -> - rest := List.rev (Array.to_list (Array.slice !args_to_parse (!arg_being_parsed + 1) 0)) ; + rest := + RevList.of_list (Array.to_list (Array.slice !args_to_parse (!arg_being_parsed + 1) 0)) ; select_parse_mode ~usage (decode_action arg) |> ignore ) in add parse_mode in_help @@ -882,7 +885,7 @@ let anon_fun arg = else match !anon_arg_action.on_unknown with | `Add -> - rev_anon_args := arg :: !rev_anon_args + rev_anon_args := RevList.cons arg !rev_anon_args | `Skip -> () | `Reject -> diff --git a/infer/src/base/CommandLineOption.mli b/infer/src/base/CommandLineOption.mli index beceed690..68abe2a4d 100644 --- a/infer/src/base/CommandLineOption.mli +++ b/infer/src/base/CommandLineOption.mli @@ -93,7 +93,7 @@ val mk_string_list : ?default:string list -> ?default_to_string:(string list -> string) -> ?f:(string -> string) - -> string list ref t + -> string RevList.t ref t (** [mk_string_list] defines a [string list ref], initialized to [\[\]] unless overridden by [~default]. Each argument of an occurrence of the option will be prepended to the list, so the final value will be in the reverse order they appeared on the command line. @@ -116,7 +116,7 @@ val mk_path_opt : (** analogous of [mk_string_opt] with the extra feature of [mk_path] *) val mk_path_list : - ?default:string list -> ?default_to_string:(string list -> string) -> string list ref t + ?default:string list -> ?default_to_string:(string list -> string) -> string RevList.t ref t (** analogous of [mk_string_list] with the extra feature of [mk_path] *) val mk_symbol : @@ -136,7 +136,7 @@ val mk_symbol_seq : val mk_json : Yojson.Basic.t ref t -val mk_anon : unit -> string list ref +val mk_anon : unit -> string RevList.t ref [@@warning "-32"] (** [mk_anon ()] defines a [string list ref] of the anonymous command line arguments, in the reverse order they appeared on the command line. *) @@ -147,7 +147,7 @@ val mk_rest_actions : -> string -> usage:string -> (string -> parse_mode) - -> string list ref + -> string RevList.t ref (** [mk_rest_actions doc ~usage command_to_parse_mode] defines a [string list ref] of the command line arguments following ["--"], in the reverse order they appeared on the command line. [usage] is the usage message in case of parse errors or if --help is passed. For example, calling diff --git a/infer/src/base/Config.ml b/infer/src/base/Config.ml index b03a298e5..332a869e0 100644 --- a/infer/src/base/Config.ml +++ b/infer/src/base/Config.ml @@ -1200,7 +1200,7 @@ and differential_filter_set = and () = let mk b ?deprecated ~long ?default doc = - let (_ : string list ref) = + let (_ : string RevList.t ref) = CLOpt.mk_string_list ?deprecated ~long ~f:(fun issue_id -> let issue = @@ -1534,7 +1534,7 @@ and linters_def_folder = ~meta:"dir" "Specify the folder containing linters files with extension .al" in let () = - CLOpt.mk_set linters_def_folder [] ~long:"reset-linters-def-folder" + CLOpt.mk_set linters_def_folder RevList.empty ~long:"reset-linters-def-folder" "Reset the list of folders containing linters definitions to be empty (see \ $(b,linters-def-folder))." in @@ -2677,11 +2677,12 @@ let post_parsing_initialization command_opt = if is_none !symops_per_iteration then symops_per_iteration := symops_timeout ; if is_none !seconds_per_iteration then seconds_per_iteration := seconds_timeout ; clang_compilation_dbs := - List.rev_map ~f:(fun x -> `Raw x) !compilation_database - |> List.rev_map_append ~f:(fun x -> `Escaped x) !compilation_database_escaped ; + RevList.rev_map ~f:(fun x -> `Raw x) !compilation_database + |> RevList.rev_map_append ~f:(fun x -> `Escaped x) !compilation_database_escaped ; (* set analyzer mode to linters in linters developer mode *) if !linters_developer_mode then enable_checker Linters ; - if !default_linters then linters_def_file := linters_def_default_file :: !linters_def_file ; + if !default_linters then + linters_def_file := RevList.cons linters_def_default_file !linters_def_file ; ( match !analyzer with | Linters -> disable_all_checkers () ; @@ -2710,7 +2711,7 @@ let process_linters_doc_url args = but got %s" arg in - let linter_doc_url_assocs = List.rev_map ~f:linters_doc_url args in + let linter_doc_url_assocs = RevList.rev_map ~f:linters_doc_url args in fun ~linter_id -> List.Assoc.find ~equal:String.equal linter_doc_url_assocs linter_id @@ -2785,7 +2786,7 @@ and capture = !capture and capture_blacklist = !capture_blacklist and censor_report = - List.map !censor_report ~f:(fun str -> + RevList.map !censor_report ~f:(fun str -> match String.split str ~on:':' with | [issue_type_re; filename_re; reason_str] when not String.(is_empty issue_type_re || is_empty filename_re || is_empty reason_str) -> @@ -2934,7 +2935,7 @@ and genrule_mode = !genrule_mode and get_linter_doc_url = process_linters_doc_url !linters_doc_url and help_checker = - List.map !help_checker ~f:(fun checker_string -> + RevList.map !help_checker ~f:(fun checker_string -> match Checker.from_id checker_string with | Some checker -> checker @@ -2946,7 +2947,7 @@ and help_checker = and help_issue_type = - List.map !help_issue_type ~f:(fun id -> + RevList.map !help_issue_type ~f:(fun id -> match IssueType.find_from_string ~id with | Some issue_type -> issue_type @@ -3139,7 +3140,7 @@ and pulse_model_skip_pattern = Option.map ~f:Str.regexp !pulse_model_skip_patter and pulse_model_transfer_ownership_namespace, pulse_model_transfer_ownership = let models = let re = Str.regexp "::" in - List.map ~f:(fun model -> (model, Str.split re model)) !pulse_model_transfer_ownership + RevList.map ~f:(fun model -> (model, Str.split re model)) !pulse_model_transfer_ownership in let aux el = match el with @@ -3154,7 +3155,7 @@ and pulse_model_transfer_ownership_namespace, pulse_model_transfer_ownership = option (List.length splits - 1) in - List.partition_map ~f:aux models + RevList.rev_partition_map ~f:aux models and pulse_recency_limit = !pulse_recency_limit @@ -3431,12 +3432,8 @@ let dynamic_dispatch = is_checker_enabled Biabduction (** Check if a Java package is external to the repository *) let java_package_is_external package = - match external_java_packages with - | [] -> - false - | _ -> - List.exists external_java_packages ~f:(fun (prefix : string) -> - String.is_prefix package ~prefix ) + RevList.exists external_java_packages ~f:(fun (prefix : string) -> + String.is_prefix package ~prefix ) let is_in_custom_symbols list_name symbol = diff --git a/infer/src/base/Config.mli b/infer/src/base/Config.mli index dc49af3eb..f007cfe8f 100644 --- a/infer/src/base/Config.mli +++ b/infer/src/base/Config.mli @@ -39,7 +39,7 @@ val anonymous_block_num_sep : string val anonymous_block_prefix : string -val append_buck_flavors : string list +val append_buck_flavors : string RevList.t val assign : string @@ -132,7 +132,7 @@ val kotlin_source_extension : string val sourcepath : string option -val sources : string list +val sources : string RevList.t val trace_absarray : bool @@ -174,11 +174,11 @@ val bootclasspath : string option val buck : bool -val buck_blacklist : string list +val buck_blacklist : string RevList.t -val buck_build_args : string list +val buck_build_args : string RevList.t -val buck_build_args_no_inline_rev : string list +val buck_build_args_no_inline_rev : string RevList.t val buck_cache_mode : bool @@ -188,7 +188,7 @@ val buck_mode : BuckMode.t option val buck_out_gen : string -val buck_targets_blacklist : string list +val buck_targets_blacklist : string RevList.t val call_graph_schedule : bool @@ -196,7 +196,7 @@ val capture : bool val capture_blacklist : string option -val censor_report : ((bool * Str.regexp) * (bool * Str.regexp) * string) list +val censor_report : ((bool * Str.regexp) * (bool * Str.regexp) * string) RevList.t val changed_files_index : string option @@ -206,11 +206,11 @@ val clang_ast_file : [`Biniou of string | `Yojson of string] option val clang_compound_literal_init_limit : int -val clang_extra_flags : string list +val clang_extra_flags : string RevList.t -val clang_blacklisted_flags : string list +val clang_blacklisted_flags : string RevList.t -val clang_blacklisted_flags_with_arg : string list +val clang_blacklisted_flags_with_arg : string RevList.t val clang_ignore_regex : string option @@ -310,9 +310,9 @@ val genrule_mode : bool val get_linter_doc_url : linter_id:string -> string option -val help_checker : Checker.t list +val help_checker : Checker.t RevList.t -val help_issue_type : IssueType.t list +val help_issue_type : IssueType.t RevList.t val hoisting_report_only_expensive : bool @@ -362,9 +362,9 @@ val keep_going : bool val linter : string option -val linters_def_file : string list +val linters_def_file : string RevList.t -val linters_def_folder : string list +val linters_def_folder : string RevList.t val linters_developer_mode : bool @@ -378,7 +378,7 @@ val list_issue_types : bool val liveness_dangerous_classes : Yojson.Basic.t -val liveness_ignored_constant : string list +val liveness_ignored_constant : string RevList.t val max_nesting : int option @@ -471,13 +471,13 @@ val pulse_isl : bool [@@warning "-32"] val pulse_max_disjuncts : int -val pulse_model_abort : string list +val pulse_model_abort : string RevList.t val pulse_model_alloc_pattern : Str.regexp option val pulse_model_release_pattern : Str.regexp option -val pulse_model_return_nonnull : string list +val pulse_model_return_nonnull : string RevList.t val pulse_model_skip_pattern : Str.regexp option @@ -509,7 +509,7 @@ val reactive_mode : bool val reanalyze : bool -val report_blacklist_files_containing : string list +val report_blacklist_files_containing : string RevList.t val report_console_limit : int option @@ -517,17 +517,17 @@ val report_current : string option val report_formatter : [`No_formatter | `Phabricator_formatter] -val report_path_regex_blacklist : string list +val report_path_regex_blacklist : string RevList.t -val report_path_regex_whitelist : string list +val report_path_regex_whitelist : string RevList.t val report_previous : string option -val report_suppress_errors : string list +val report_suppress_errors : string RevList.t val reports_include_ml_loc : bool -val rest : string list +val rest : string RevList.t val results_dir : string @@ -547,15 +547,15 @@ val show_buckets : bool val siof_check_iostreams : bool -val siof_safe_methods : string list +val siof_safe_methods : string RevList.t -val skip_analysis_in_path : string list +val skip_analysis_in_path : string RevList.t val skip_analysis_in_path_skips_compilation : bool val skip_duplicated_types : bool -val skip_translation_headers : string list +val skip_translation_headers : string RevList.t val source_files : bool @@ -607,7 +607,7 @@ val topl_max_conjuncts : int val topl_max_disjuncts : int -val topl_properties : string list +val topl_properties : string RevList.t val trace_error : bool @@ -641,7 +641,7 @@ val write_dotty : bool val write_html : bool -val write_html_whitelist_regex : string list +val write_html_whitelist_regex : string RevList.t val write_website : string option diff --git a/infer/src/biabduction/errdesc.ml b/infer/src/biabduction/errdesc.ml index 05bdc9987..cf96bf721 100644 --- a/infer/src/biabduction/errdesc.ml +++ b/infer/src/biabduction/errdesc.ml @@ -14,7 +14,7 @@ module L = Logging module F = Format module DExp = DecompiledExp -let vector_matcher = QualifiedCppName.Match.of_fuzzy_qual_names ["std::vector"] +let vector_matcher = QualifiedCppName.Match.of_fuzzy_qual_names (RevList.of_list ["std::vector"]) let is_one_of_classes = QualifiedCppName.Match.match_qualifiers diff --git a/infer/src/checkers/Siof.ml b/infer/src/checkers/Siof.ml index f84680578..e07eaa363 100644 --- a/infer/src/checkers/Siof.ml +++ b/infer/src/checkers/Siof.ml @@ -50,7 +50,8 @@ let models = List.map ~f:parse_siof_model [("std::ios_base::Init::Init", standar let is_modelled = let models_matcher = - List.map models ~f:(fun {qual_name} -> qual_name) |> QualifiedCppName.Match.of_fuzzy_qual_names + List.map models ~f:(fun {qual_name} -> qual_name) + |> RevList.of_list |> QualifiedCppName.Match.of_fuzzy_qual_names in fun pname -> Procname.get_qualifiers pname |> QualifiedCppName.Match.match_qualifiers models_matcher @@ -75,7 +76,8 @@ module TransferFunctions (CFG : ProcCfg.S) = struct let filter_global_accesses initialized = let initialized_matcher = - Domain.VarNames.elements initialized |> QualifiedCppName.Match.of_fuzzy_qual_names + Domain.VarNames.elements initialized + |> RevList.of_list |> QualifiedCppName.Match.of_fuzzy_qual_names in Staged.stage (fun (* gvar \notin initialized, up to some fuzzing *) gvar -> @@ -153,7 +155,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct let init = List.find_map_exn models ~f:(fun {qual_name; initialized_globals} -> if - QualifiedCppName.Match.of_fuzzy_qual_names [qual_name] + QualifiedCppName.Match.of_fuzzy_qual_names (RevList.of_list [qual_name]) |> Fn.flip QualifiedCppName.Match.match_qualifiers (Procname.get_qualifiers callee_pname) then Some initialized_globals diff --git a/infer/src/checkers/liveness.ml b/infer/src/checkers/liveness.ml index 103528439..48d732907 100644 --- a/infer/src/checkers/liveness.ml +++ b/infer/src/checkers/liveness.ml @@ -54,13 +54,15 @@ end module CheckerMode : LivenessConfig = struct let blacklisted_destructor_matcher = QualifiedCppName.Match.of_fuzzy_qual_names - (string_list_of_json ~option_name:"liveness-dangerous-classes" ~init:[] - Config.liveness_dangerous_classes) + (RevList.of_list + (string_list_of_json ~option_name:"liveness-dangerous-classes" ~init:[] + Config.liveness_dangerous_classes)) (** hardcoded list of wrappers, mostly because they are impossible to specify as config options *) let standard_wrappers_matcher = - QualifiedCppName.Match.of_fuzzy_qual_names ["std::unique_ptr"; "std::shared_ptr"] + QualifiedCppName.Match.of_fuzzy_qual_names + (RevList.of_list ["std::unique_ptr"; "std::shared_ptr"]) let is_blacklisted_class_name class_name = @@ -176,7 +178,7 @@ let matcher_scope_guard = let default_scope_guards = ["CKComponentKey"; "CKComponentScope"] in string_list_of_json ~option_name:"cxx-scope_guards" ~init:default_scope_guards Config.cxx_scope_guards - |> QualifiedCppName.Match.of_fuzzy_qual_names + |> RevList.of_list |> QualifiedCppName.Match.of_fuzzy_qual_names module CapturedByRefTransferFunctions (CFG : ProcCfg.S) = struct @@ -216,7 +218,7 @@ module IntLitSet = Caml.Set.Make (IntLit) let ignored_constants = let int_lit_constants = - List.map + RevList.map ~f:(fun el -> try IntLit.of_string el with Invalid_argument _ -> @@ -224,7 +226,7 @@ let ignored_constants = "Ill-formed option '%s' for --liveness-ignored-constant: an integer was expected" el ) Config.liveness_ignored_constant in - IntLitSet.of_list int_lit_constants + IntLitSet.of_seq (RevList.to_rev_seq int_lit_constants) let checker {IntraproceduralAnalysis.proc_desc; err_log} = diff --git a/infer/src/clang/CType_decl.ml b/infer/src/clang/CType_decl.ml index 8661d17ec..1e55bb4d3 100644 --- a/infer/src/clang/CType_decl.ml +++ b/infer/src/clang/CType_decl.ml @@ -331,7 +331,7 @@ let get_superclass_decls decl = let translate_as_type_ptr_matcher = - QualifiedCppName.Match.of_fuzzy_qual_names ["infer_traits::TranslateAsType"] + QualifiedCppName.Match.of_fuzzy_qual_names (RevList.of_list ["infer_traits::TranslateAsType"]) let get_translate_as_friend_decl decl_list = diff --git a/infer/src/clang/ClangCommand.ml b/infer/src/clang/ClangCommand.ml index b2314a01d..29280cbd0 100644 --- a/infer/src/clang/ClangCommand.ml +++ b/infer/src/clang/ClangCommand.ml @@ -114,15 +114,16 @@ let filter_and_replace_unsupported_args ?(replace_options_arg = fun _ s -> s) ?( (Exn.to_string e) ; aux in_argfiles' (false, at_argfile :: res_rev, changed) tl ) | flag :: tl - when List.mem ~equal:String.equal Config.clang_blacklisted_flags flag + when RevList.mem ~equal:String.equal Config.clang_blacklisted_flags flag || String.lsplit2 ~on:'=' flag |> function | Some (flag, _arg) -> - List.mem ~equal:String.equal Config.clang_blacklisted_flags_with_arg flag + RevList.mem ~equal:String.equal Config.clang_blacklisted_flags_with_arg flag | None -> false -> aux in_argfiles (false, res_rev, true) tl - | flag :: tl when List.mem ~equal:String.equal Config.clang_blacklisted_flags_with_arg flag -> + | flag :: tl when RevList.mem ~equal:String.equal Config.clang_blacklisted_flags_with_arg flag + -> (* remove the flag and its arg separately in case we are at the end of an argfile *) aux in_argfiles (true, res_rev, true) tl | arg :: tl -> @@ -204,7 +205,7 @@ let mk ~is_driver quoting_style ~prog ~args = (* Some arguments break the compiler so they need to be removed even before the normalization step *) let sanitized_args = filter_and_replace_unsupported_args args in let sanitized_args = - if is_driver then sanitized_args @ List.rev Config.clang_extra_flags else sanitized_args + if is_driver then sanitized_args @ RevList.to_list Config.clang_extra_flags else sanitized_args in {exec= prog; orig_argv= sanitized_args; argv= sanitized_args; quoting_style; is_driver} diff --git a/infer/src/clang/cFrontend_config.ml b/infer/src/clang/cFrontend_config.ml index 591aa5f38..e46eae041 100644 --- a/infer/src/clang/cFrontend_config.ml +++ b/infer/src/clang/cFrontend_config.ml @@ -106,7 +106,7 @@ let return_param = "__return_param" let self = "self" -let std_addressof = QualifiedCppName.Match.of_fuzzy_qual_names ["std::addressof"] +let std_addressof = QualifiedCppName.Match.of_fuzzy_qual_names (RevList.of_list ["std::addressof"]) let string_with_utf8_m = "stringWithUTF8String:" diff --git a/infer/src/clang/cFrontend_decl.ml b/infer/src/clang/cFrontend_decl.ml index 3d5bfa8f7..afbc62f26 100644 --- a/infer/src/clang/cFrontend_decl.ml +++ b/infer/src/clang/cFrontend_decl.ml @@ -300,9 +300,11 @@ module CFrontend_decl_funct (T : CModule_type.CTranslation) : CModule_type.CFron method should be translated based on method and class whitelists *) let is_whitelisted_cpp_method = let method_matcher = - QualifiedCppName.Match.of_fuzzy_qual_names Config.whitelisted_cpp_methods + QualifiedCppName.Match.of_fuzzy_qual_names (RevList.of_list Config.whitelisted_cpp_methods) + in + let class_matcher = + QualifiedCppName.Match.of_fuzzy_qual_names (RevList.of_list Config.whitelisted_cpp_classes) in - let class_matcher = QualifiedCppName.Match.of_fuzzy_qual_names Config.whitelisted_cpp_classes in fun qual_name -> (* either the method is explictely whitelisted, or the whole class is whitelisted *) QualifiedCppName.Match.match_qualifiers method_matcher qual_name diff --git a/infer/src/clang/cLocation.ml b/infer/src/clang/cLocation.ml index a7815852c..fe56e82a8 100644 --- a/infer/src/clang/cLocation.ml +++ b/infer/src/clang/cLocation.ml @@ -24,7 +24,7 @@ let source_file_in_project source_file = let file_in_project = SourceFile.is_under_project_root source_file in let rel_source_file = SourceFile.to_string source_file in let file_should_be_skipped = - List.exists + RevList.exists ~f:(fun path -> String.is_prefix ~prefix:path rel_source_file) Config.skip_translation_headers in @@ -83,7 +83,7 @@ let should_translate_lib translation_unit source_range decl_trans_context ~trans let is_file_blacklisted file = let paths = Config.skip_analysis_in_path in let is_file_blacklisted = - List.exists ~f:(fun path -> Str.string_match (Str.regexp ("^.*/" ^ path)) file 0) paths + RevList.exists ~f:(fun path -> Str.string_match (Str.regexp ("^.*/" ^ path)) file 0) paths in is_file_blacklisted diff --git a/infer/src/clang/unit/QualifiedCppNameTests.ml b/infer/src/clang/unit/QualifiedCppNameTests.ml index 1c547f98f..60a179427 100644 --- a/infer/src/clang/unit/QualifiedCppNameTests.ml +++ b/infer/src/clang/unit/QualifiedCppNameTests.ml @@ -45,7 +45,7 @@ let test_fuzzy_match = ; ("test_std_fuzzy_no_match1", ["std::foo"], ["std"; "__1"; "__2"; "foo"], false) ; ("test_std_fuzzy_no_match2", ["std::foo"], ["std"; "__1"; "foo"; "bad"], false) ] |> List.map ~f:(fun (name, fuzzy_qual_names, qualifiers, expected_output) -> - name >:: create_test fuzzy_qual_names qualifiers expected_output ) + name >:: create_test (RevList.of_list fuzzy_qual_names) qualifiers expected_output ) let tests = "qualified_cpp_name_fuzzy_match" >::: test_fuzzy_match diff --git a/infer/src/concurrency/RacerDModels.ml b/infer/src/concurrency/RacerDModels.ml index 2b29b0ce0..4a29e8da7 100644 --- a/infer/src/concurrency/RacerDModels.ml +++ b/infer/src/concurrency/RacerDModels.ml @@ -119,7 +119,7 @@ let is_cpp_container_read = QualifiedCppName.extract_last pname_qualifiers |> Option.exists ~f:(fun (last, _) -> String.equal last "operator[]") in - let matcher = QualifiedCppName.Match.of_fuzzy_qual_names ["std::map::find"] in + let matcher = QualifiedCppName.Match.of_fuzzy_qual_names (RevList.of_list ["std::map::find"]) in fun pname -> let pname_qualifiers = Procname.get_qualifiers pname in QualifiedCppName.Match.match_qualifiers matcher pname_qualifiers @@ -128,7 +128,8 @@ let is_cpp_container_read = let is_cpp_container_write = let matcher = - QualifiedCppName.Match.of_fuzzy_qual_names ["std::map::operator[]"; "std::map::erase"] + QualifiedCppName.Match.of_fuzzy_qual_names + (RevList.of_list ["std::map::operator[]"; "std::map::erase"]) in fun pname -> QualifiedCppName.Match.match_qualifiers matcher (Procname.get_qualifiers pname) @@ -162,17 +163,18 @@ let should_skip = let matcher = lazy (QualifiedCppName.Match.of_fuzzy_qual_names ~prefix:true - [ "folly::AtomicStruct" - ; "folly::fbstring_core" - ; "folly::Future" - ; "folly::futures" - ; "folly::LockedPtr" - ; "folly::Optional" - ; "folly::Promise" - ; "folly::ThreadLocal" - ; "folly::detail::SingletonHolder" - ; "std::atomic" - ; "std::vector" ]) + (RevList.of_list + [ "folly::AtomicStruct" + ; "folly::fbstring_core" + ; "folly::Future" + ; "folly::futures" + ; "folly::LockedPtr" + ; "folly::Optional" + ; "folly::Promise" + ; "folly::ThreadLocal" + ; "folly::detail::SingletonHolder" + ; "std::atomic" + ; "std::vector" ])) in function | Procname.ObjC_Cpp cpp_pname as pname -> diff --git a/infer/src/infer.ml b/infer/src/infer.ml index 2dc128202..a25674ac9 100644 --- a/infer/src/infer.ml +++ b/infer/src/infer.ml @@ -168,14 +168,15 @@ let () = if Config.( list_checkers || list_issue_types || Option.is_some write_website - || (not (List.is_empty help_checker)) - || not (List.is_empty help_issue_type)) + || (not (RevList.is_empty help_checker)) + || not (RevList.is_empty help_issue_type)) then ( if Config.list_checkers then Help.list_checkers () ; if Config.list_issue_types then Help.list_issue_types () ; - if not (List.is_empty Config.help_checker) then Help.show_checkers Config.help_checker ; - if not (List.is_empty Config.help_issue_type) then - Help.show_issue_types Config.help_issue_type ; + if not (RevList.is_empty Config.help_checker) then + Help.show_checkers (RevList.to_list Config.help_checker) ; + if not (RevList.is_empty Config.help_issue_type) then + Help.show_issue_types (RevList.to_list Config.help_issue_type) ; Option.iter Config.write_website ~f:(fun website_root -> Help.write_website ~website_root) ; () ) else diff --git a/infer/src/integration/Buck.ml b/infer/src/integration/Buck.ml index ae5c0ee52..d2fd82a5a 100644 --- a/infer/src/integration/Buck.ml +++ b/infer/src/integration/Buck.ml @@ -97,7 +97,7 @@ module Target = struct let add_flavor (mode : BuckMode.t) (command : InferCommand.t) ~extra_flavors target = - let target = List.fold_left ~f:add_flavor_internal ~init:target extra_flavors in + let target = RevList.fold ~f:add_flavor_internal ~init:target extra_flavors in match (mode, command) with | ClangCompilationDB _, _ -> add_flavor_internal target "compilation-database" @@ -137,10 +137,10 @@ let config = | None -> [] ) @ - if List.is_empty Config.buck_blacklist then [] + if RevList.is_empty Config.buck_blacklist then [] else [ Printf.sprintf "*//infer.blacklist_regex=(%s)" - (String.concat ~sep:")|(" Config.buck_blacklist) ] + (String.concat ~sep:")|(" (RevList.to_list Config.buck_blacklist)) ] in fun buck_mode -> let args = @@ -296,7 +296,7 @@ module Query = struct store_args_in_file ~identifier:"buck_query_args" (buck_config @ buck_output_options @ [query]) in let cmd = - "buck" :: "query" :: List.rev_append Config.buck_build_args_no_inline_rev bounded_args + "buck" :: "query" :: RevList.rev_append2 Config.buck_build_args_no_inline_rev bounded_args in wrap_buck_call ~label:"query" cmd |> parse_query_output ?buck_mode end @@ -368,10 +368,10 @@ let config = | None -> [] ) @ - if List.is_empty Config.buck_blacklist then [] + if RevList.is_empty Config.buck_blacklist then [] else [ Printf.sprintf "*//infer.blacklist_regex=(%s)" - (String.concat ~sep:")|(" Config.buck_blacklist) ] + (String.concat ~sep:")|(" (RevList.to_list Config.buck_blacklist)) ] in fun buck_mode -> let args = @@ -455,10 +455,13 @@ let parse_command_and_targets (buck_mode : BuckMode.t) original_buck_args = let expanded_buck_args = inline_argument_files original_buck_args in let command, args = split_buck_command expanded_buck_args in let buck_targets_blacklist_regexp = - if List.is_empty Config.buck_targets_blacklist then None + if RevList.is_empty Config.buck_targets_blacklist then None else Some - (Str.regexp ("\\(" ^ String.concat ~sep:"\\)\\|\\(" Config.buck_targets_blacklist ^ "\\)")) + (Str.regexp + ( "\\(" + ^ String.concat ~sep:"\\)\\|\\(" (RevList.to_list Config.buck_targets_blacklist) + ^ "\\)" )) in let rec parse_cmd_args parsed_args = function | [] -> diff --git a/infer/src/integration/Buck.mli b/infer/src/integration/Buck.mli index 174f8ab73..4dada1c02 100644 --- a/infer/src/integration/Buck.mli +++ b/infer/src/integration/Buck.mli @@ -14,7 +14,7 @@ module Target : sig val to_string : t -> string - val add_flavor : BuckMode.t -> InferCommand.t -> extra_flavors:string list -> t -> t + val add_flavor : BuckMode.t -> InferCommand.t -> extra_flavors:string RevList.t -> t -> t end val wrap_buck_call : diff --git a/infer/src/integration/BuckFlavors.ml b/infer/src/integration/BuckFlavors.ml index 4e50c4bc6..4a742a932 100644 --- a/infer/src/integration/BuckFlavors.ml +++ b/infer/src/integration/BuckFlavors.ml @@ -26,7 +26,8 @@ let add_flavors_to_buck_arguments buck_mode ~extra_flavors original_buck_args = let capture_buck_args () = ("--show-output" :: (if Config.keep_going then ["--keep-going"] else [])) @ (match Config.load_average with Some l -> ["-L"; Float.to_string l] | None -> []) - @ Buck.config ClangFlavors @ List.rev Config.buck_build_args + @ Buck.config ClangFlavors + @ RevList.to_list Config.buck_build_args let run_buck_build prog buck_build_args = @@ -108,14 +109,14 @@ let capture build_cmd = in Unix.putenv ~key:CLOpt.args_env_var ~data:infer_args_with_buck ; let {command; rev_not_targets; targets} = - add_flavors_to_buck_arguments ClangFlavors ~extra_flavors:[] buck_args + add_flavors_to_buck_arguments ClangFlavors ~extra_flavors:RevList.empty buck_args in if List.is_empty targets then () else let all_args = List.rev_append rev_not_targets targets in let updated_buck_cmd = command - :: List.rev_append Config.buck_build_args_no_inline_rev + :: RevList.rev_append2 Config.buck_build_args_no_inline_rev (Buck.store_args_in_file ~identifier:"clang_flavor_build" all_args) in L.debug Capture Quiet "Processed buck command '%a'@\n" (Pp.seq F.pp_print_string) diff --git a/infer/src/integration/BuckFlavors.mli b/infer/src/integration/BuckFlavors.mli index 461fdb11d..3ec38fae9 100644 --- a/infer/src/integration/BuckFlavors.mli +++ b/infer/src/integration/BuckFlavors.mli @@ -10,7 +10,7 @@ open! IStd type flavored_arguments = {command: string; rev_not_targets: string list; targets: string list} val add_flavors_to_buck_arguments : - BuckMode.t -> extra_flavors:string list -> string list -> flavored_arguments + BuckMode.t -> extra_flavors:string RevList.t -> string list -> flavored_arguments (** Add infer flavors to the targets in the given buck arguments, depending on the infer analyzer. For instance, in clang capture mode, the buck command: build //foo/bar:baz#some,flavor becomes: build //foo/bar:baz#infer-capture-all,some,flavor *) diff --git a/infer/src/integration/BuckGenrule.ml b/infer/src/integration/BuckGenrule.ml index b781a3ff9..f7a597a34 100644 --- a/infer/src/integration/BuckGenrule.ml +++ b/infer/src/integration/BuckGenrule.ml @@ -170,7 +170,7 @@ let capture buck_mode build_cmd = let updated_buck_cmd = (* make buck tell us where in buck-out are the capture directories for merging *) (prog :: command :: "--build-report" :: build_report_file :: Buck.config buck_mode) - @ List.rev_append Config.buck_build_args_no_inline_rev + @ RevList.rev_append2 Config.buck_build_args_no_inline_rev (Buck.store_args_in_file ~identifier:"genrule_build" all_args) in L.(debug Capture Quiet) diff --git a/infer/src/integration/BuckJavaFlavor.ml b/infer/src/integration/BuckJavaFlavor.ml index 656ed2abe..bb61fd5b2 100644 --- a/infer/src/integration/BuckJavaFlavor.ml +++ b/infer/src/integration/BuckJavaFlavor.ml @@ -14,7 +14,7 @@ let capture build_cmd = L.progress "Querying buck for java flavor capture targets...@." ; let time0 = Mtime_clock.counter () in let BuckFlavors.{command; rev_not_targets; targets} = - BuckFlavors.add_flavors_to_buck_arguments JavaFlavor ~extra_flavors:[] buck_cmd + BuckFlavors.add_flavors_to_buck_arguments JavaFlavor ~extra_flavors:RevList.empty buck_cmd in L.progress "Found %d java flavor capture targets in %a.@." (List.length targets) Mtime.Span.pp (Mtime_clock.count time0) ; @@ -25,7 +25,7 @@ let capture build_cmd = let updated_buck_cmd = (* make buck tell us where in buck-out are the capture directories for merging *) (prog :: command :: "--build-report" :: build_report_file :: Buck.config JavaFlavor) - @ List.rev_append Config.buck_build_args_no_inline_rev + @ RevList.rev_append2 Config.buck_build_args_no_inline_rev (Buck.store_args_in_file ~identifier:"java_flavor_build" all_args) in L.(debug Capture Quiet) diff --git a/infer/src/integration/CaptureCompilationDatabase.ml b/infer/src/integration/CaptureCompilationDatabase.ml index d5bd99396..40586a155 100644 --- a/infer/src/integration/CaptureCompilationDatabase.ml +++ b/infer/src/integration/CaptureCompilationDatabase.ml @@ -21,7 +21,8 @@ let create_cmd (source_file, (compilation_data : CompilationDatabase.compilation ( source_file , { CompilationDatabase.directory= compilation_data.directory ; executable= swap_executable compilation_data.executable - ; escaped_arguments= ["@" ^ arg_file; "-fsyntax-only"] @ List.rev Config.clang_extra_flags } ) + ; escaped_arguments= + ["@" ^ arg_file; "-fsyntax-only"] @ RevList.to_list Config.clang_extra_flags } ) let invoke_cmd (source_file, (cmd : CompilationDatabase.compilation_data)) = @@ -83,7 +84,8 @@ let get_compilation_database_files_buck db_deps ~prog ~args = | {command= "build" as command; rev_not_targets; targets} -> let targets_args = Buck.store_args_in_file ~identifier:"compdb_build_args" targets in let build_args = - (command :: List.rev_append rev_not_targets (List.rev Config.buck_build_args_no_inline_rev)) + command + :: List.rev_append rev_not_targets (RevList.to_list Config.buck_build_args_no_inline_rev) @ (* Infer doesn't support C++ modules nor precompiled headers yet (T35656509) *) "--config" :: "*//cxx.pch_enabled=false" :: "--config" :: "*//cxx.modules_default=false" :: "--config" :: "*//cxx.modules=False" :: targets_args @@ -95,7 +97,7 @@ let get_compilation_database_files_buck db_deps ~prog ~args = prog :: "targets" :: List.rev_append (Buck.filter_compatible `Targets rev_not_targets) - (List.rev Config.buck_build_args_no_inline_rev) + (RevList.to_list Config.buck_build_args_no_inline_rev) @ ("--show-output" :: targets_args) in let on_target_lines = function diff --git a/infer/src/integration/Driver.ml b/infer/src/integration/Driver.ml index 3f6a8c7dc..6253ddb31 100644 --- a/infer/src/integration/Driver.ml +++ b/infer/src/integration/Driver.ml @@ -372,7 +372,8 @@ let mode_of_build_command build_cmd (buck_mode : BuckMode.t option) = | BBuck, Some CombinedGenrule -> BuckCombinedGenrule {build_cmd} | BBuck, Some (ClangCompilationDB deps) -> - BuckCompilationDB {deps; prog; args= List.append args (List.rev Config.buck_build_args)} + BuckCompilationDB + {deps; prog; args= List.append args (RevList.to_list Config.buck_build_args)} | BBuck, Some ClangFlavors when Config.is_checker_enabled Linters -> L.user_warning "WARNING: the linters require --buck-compilation-database to be set.@ Alternatively, \ @@ -426,7 +427,7 @@ let mode_from_command_line = assert_supported_mode `Java "Buck genrule" ; BuckGenrule {prog= path} | None -> - mode_of_build_command (List.rev Config.rest) Config.buck_mode ) + mode_of_build_command (RevList.to_list Config.rest) Config.buck_mode ) let run_prologue mode = diff --git a/infer/src/integration/JsonReports.ml b/infer/src/integration/JsonReports.ml index 87eab71b9..a7c3269df 100644 --- a/infer/src/integration/JsonReports.ml +++ b/infer/src/integration/JsonReports.ml @@ -100,7 +100,7 @@ let censored_reason (issue_type : IssueType.t) source_file = in Option.some_if (not accepted) reason in - List.find_map Config.censor_report ~f:rejected_by + RevList.find_map Config.censor_report ~f:rejected_by let potential_exception_message = "potential exception at line" diff --git a/infer/src/istd/RevList.ml b/infer/src/istd/RevList.ml new file mode 100644 index 000000000..3c4cf5a13 --- /dev/null +++ b/infer/src/istd/RevList.ml @@ -0,0 +1,40 @@ +(* + * 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 +include List + +let empty = [] + +let to_list = rev + +let of_list = rev + +let rev_partition_map t ~f = + let rec loop t fst snd = + match t with + | [] -> + (fst, snd) + | x :: t -> ( + match (f x : _ Either.t) with + | First y -> + loop t (y :: fst) snd + | Second y -> + loop t fst (y :: snd) ) + in + loop t [] [] + + +let rev_concat_map rev ~f = + let rec aux acc = function [] -> acc | hd :: tl -> aux (rev_append (f hd) acc) tl in + aux [] rev + + +let rev_append2 = rev_append + +let rec to_rev_seq rev = + match rev with [] -> fun () -> Seq.Nil | hd :: tl -> fun () -> Seq.Cons (hd, to_rev_seq tl) diff --git a/infer/src/istd/RevList.mli b/infer/src/istd/RevList.mli new file mode 100644 index 000000000..c296342c2 --- /dev/null +++ b/infer/src/istd/RevList.mli @@ -0,0 +1,48 @@ +(* + * 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 + +type 'a t + +val empty : 'a t + +val is_empty : 'a t -> bool + +val cons : 'a -> 'a t -> 'a t + +val to_list : 'a t -> 'a list + +val of_list : 'a list -> 'a t + +val fold : 'a t -> init:'b -> f:('b -> 'a -> 'b) -> 'b + +val mem : 'a t -> 'a -> equal:('a -> 'a -> bool) -> bool + +val exists : 'a t -> f:('a -> bool) -> bool + +val map : 'a t -> f:('a -> 'b) -> 'b t + +val rev_map : 'a t -> f:('a -> 'b) -> 'b list + +val rev_map_append : 'a t -> 'b list -> f:('a -> 'b) -> 'b list + +val rev_partition_map : 'a t -> f:('a -> ('b, 'c) Either.t) -> 'b list * 'c list + +val find_map : 'a t -> f:('a -> 'b option) -> 'b option + +val rev_filter_map : 'a t -> f:('a -> 'b option) -> 'b list + +val rev_concat_map : 'a t -> f:('a -> 'b list) -> 'b list + +val rev_append : 'a list -> 'a t -> 'a t + +val rev_append2 : 'a t -> 'a list -> 'a list + +val dedup_and_sort : compare:('a -> 'a -> int) -> 'a t -> 'a list + +val to_rev_seq : 'a t -> 'a Seq.t diff --git a/infer/src/java/jClasspath.ml b/infer/src/java/jClasspath.ml index 6aee8c551..6efc1c2e7 100644 --- a/infer/src/java/jClasspath.ml +++ b/infer/src/java/jClasspath.ml @@ -173,7 +173,7 @@ let search_classes path = let search_sources () = let initial_map = - List.fold ~f:(fun map path -> add_source_file path map) ~init:String.Map.empty Config.sources + RevList.fold ~f:(fun map path -> add_source_file path map) ~init:String.Map.empty Config.sources in match Config.sourcepath with | None -> diff --git a/infer/src/java/jMain.ml b/infer/src/java/jMain.ml index 1ef2fc958..6d93dbd41 100644 --- a/infer/src/java/jMain.ml +++ b/infer/src/java/jMain.ml @@ -82,7 +82,7 @@ let do_all_files sources program = let tenv = load_tenv () in let skip source_file = let is_path_matching path = - List.exists + RevList.exists ~f:(fun pattern -> Str.string_match (Str.regexp pattern) path 0) Config.skip_analysis_in_path in diff --git a/infer/src/pulse/PulseModels.ml b/infer/src/pulse/PulseModels.ml index ebceb47e5..6c902c53b 100644 --- a/infer/src/pulse/PulseModels.ml +++ b/infer/src/pulse/PulseModels.ml @@ -982,7 +982,7 @@ module ProcNameDispatcher = struct in let get_cpp_matchers config ~model = let cpp_separator_regex = Str.regexp_string "::" in - List.filter_map + RevList.rev_filter_map ~f:(fun m -> match Str.split cpp_separator_regex m with | [] -> diff --git a/infer/src/quandary/ClangTaintAnalysis.ml b/infer/src/quandary/ClangTaintAnalysis.ml index 3475564e5..8588e32d9 100644 --- a/infer/src/quandary/ClangTaintAnalysis.ml +++ b/infer/src/quandary/ClangTaintAnalysis.ml @@ -77,7 +77,7 @@ include TaintAnalysis.Make (struct when folly::Subprocess calls exec), in addition some folly functions are heavily optimized in a way that obscures what they're actually doing (e.g., they use assembly code). it's better to write models for these functions or treat them as unknown *) - let models_matcher = QualifiedCppName.Match.of_fuzzy_qual_names ["folly"] + let models_matcher = QualifiedCppName.Match.of_fuzzy_qual_names (RevList.of_list ["folly"]) let get_model pname ret_typ actuals tenv summary = (* hack for default C++ constructors, which get translated as an empty body (and will thus diff --git a/infer/src/quandary/ClangTrace.ml b/infer/src/quandary/ClangTrace.ml index 599a0e00e..5c12d288d 100644 --- a/infer/src/quandary/ClangTrace.ml +++ b/infer/src/quandary/ClangTrace.ml @@ -10,7 +10,7 @@ module F = Format module L = Logging let parse_clang_procedure procedure kinds index = - try Some (QualifiedCppName.Match.of_fuzzy_qual_names [procedure], kinds, index) + try Some (QualifiedCppName.Match.of_fuzzy_qual_names (RevList.of_list [procedure]), kinds, index) with QualifiedCppName.ParseError _ -> (* Java and Clang sources/sinks live in the same inferconfig entry. If we try to parse a Java procedure that happens to be an invalid Clang qualified name (e.g., MyClass.), @@ -423,7 +423,8 @@ module CppSanitizer = struct let external_sanitizers = List.map ~f:(fun {QuandaryConfig.Sanitizer.procedure; kind} -> - (QualifiedCppName.Match.of_fuzzy_qual_names [procedure], of_string kind) ) + (QualifiedCppName.Match.of_fuzzy_qual_names (RevList.of_list [procedure]), of_string kind) + ) (QuandaryConfig.Sanitizer.of_json Config.quandary_sanitizers) diff --git a/infer/src/topl/Topl.ml b/infer/src/topl/Topl.ml index 3565ea287..bb0806a38 100644 --- a/infer/src/topl/Topl.ml +++ b/infer/src/topl/Topl.ml @@ -23,7 +23,7 @@ let parse topl_file = with Sys_error msg -> L.die UserError "@[topl:%s: %s@]@\n@?" topl_file msg -let properties = lazy (List.concat_map ~f:parse Config.topl_properties) +let properties = lazy (RevList.rev_concat_map ~f:parse Config.topl_properties) let automaton = lazy (ToplAutomaton.make (Lazy.force properties))