From 84d3144c9800bef102ef24f45887964805fe9715 Mon Sep 17 00:00:00 2001 From: Jules Villard Date: Mon, 26 Mar 2018 07:57:32 -0700 Subject: [PATCH] [istd] break IStd.ml into sensible components Summary: Limit the scope of what gets included into IStd.ml to only values that we want to shadow. New values go into other files. Also, build istd/ with `Core` open. Reviewed By: mbouaziz Differential Revision: D7382111 fbshipit-source-id: 969f0e8 --- CONTRIBUTING.md | 8 ++-- infer/src/IR/Mleak_buckets.ml | 6 +-- infer/src/IR/Sil.ml | 2 +- infer/src/backend/DifferentialFilters.ml | 2 +- infer/src/backend/StatsAggregator.ml | 2 +- infer/src/backend/callbacks.ml | 1 - infer/src/backend/exe_env.ml | 1 - infer/src/backend/interproc.ml | 8 ++-- infer/src/backend/mergeCapture.ml | 2 +- infer/src/backend/ondemand.ml | 3 +- infer/src/backend/preanal.ml | 1 - infer/src/backend/prover.ml | 2 +- infer/src/backend/specs.ml | 2 +- infer/src/backend/symExec.ml | 8 ++-- infer/src/base/Config.ml | 14 +++--- infer/src/base/DB.ml | 2 +- infer/src/base/IList.ml | 16 +++++++ infer/src/base/IList.mli | 2 + infer/src/base/Logging.ml | 2 +- infer/src/base/Multilinks.ml | 2 +- infer/src/base/ResultsDatabase.ml | 1 - infer/src/base/ResultsDir.ml | 2 +- infer/src/base/SourceFile.ml | 2 +- infer/src/base/SymOp.ml | 4 +- infer/src/base/Utils.ml | 6 +-- infer/src/base/ZipLib.ml | 2 +- infer/src/checkers/SiofTrace.ml | 2 +- infer/src/clang/Capture.ml | 2 +- infer/src/clang/ComponentKit.ml | 2 +- infer/src/clang/cAst_utils.ml | 2 +- infer/src/clang/cFrontend_checkers_main.ml | 10 +++-- infer/src/clang/cFrontend_decl.ml | 2 +- infer/src/clang/cLocation.ml | 2 +- infer/src/clang/cPredicates.ml | 6 +-- infer/src/clang/cTrans.ml | 2 +- infer/src/clang/cVar_decl.ml | 1 - infer/src/clang/ctl_parser_types.ml | 2 +- .../integration/CaptureCompilationDatabase.ml | 2 +- infer/src/integration/Driver.ml | 2 +- infer/src/integration/Javac.ml | 2 +- infer/src/istd/.merlin | 1 + infer/src/istd/IExn.ml | 20 +++++++++ infer/src/istd/IExn.mli | 18 ++++++++ infer/src/istd/IStd.ml | 44 +------------------ infer/src/istd/IntSet.ml | 11 +++++ infer/src/istd/IntSet.mli | 10 +++++ infer/src/istd/PolyVariantEqual.ml | 12 +++++ infer/src/istd/PolyVariantEqual.mli | 15 +++++++ infer/src/istd/jbuild.in | 2 +- infer/src/java/jClasspath.ml | 2 +- infer/src/java/jFrontend.ml | 2 +- infer/src/java/jMain.ml | 2 +- 52 files changed, 170 insertions(+), 111 deletions(-) create mode 100644 infer/src/istd/IExn.ml create mode 100644 infer/src/istd/IExn.mli create mode 100644 infer/src/istd/IntSet.ml create mode 100644 infer/src/istd/IntSet.mli create mode 100644 infer/src/istd/PolyVariantEqual.ml create mode 100644 infer/src/istd/PolyVariantEqual.mli diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index bec43eca9..e486259e0 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -103,7 +103,7 @@ Error: This variant expression is expected to have type 'a list - Polymorphic equality is disabled; use type-specific equality instead, even for primitive types (e.g., `Int.equal`). However, if your module uses a lot of polymorphic variants with no arguments - you may safely `open! PVariant`. + you may safely `open PolyVariantEqual`. If you try and use polymorphic equality `=` in your code you will get a compilation error, such as: ``` @@ -117,8 +117,8 @@ Error: This expression has type int but an expression was expected of type - Check that your code compiles without warnings with `make -j test_build` (this also runs as part of `make test`). -- Apart from `IStd` and `PVariant`, refrain from globally `open`ing modules. Using local open - instead when it improves readability: `let open MyModule in ...`. +- Apart from `IStd` and `PolyVariantEqual`, refrain from globally `open`ing modules. Using + local open instead when it improves readability: `let open MyModule in ...`. - Avoid the use of module aliases, except for the following commonly-aliased modules. Use module aliases consistently (e.g., do not alias `L` to a module other than `Logging`). @@ -156,7 +156,7 @@ Follow `clang-format` (see ".clang-format" at the root of the repository). ## Testing your Changes -- Make sure infer builds: `make -j `. Refer to the [installation +- Make sure infer builds: `make -j test_build`. Refer to the [installation document](https://github.com/facebook/infer/blob/master/INSTALL.md) for details. - Run the tests: `make -j 4 test` (adjust 4 to the number of cores available of your machine). The diff --git a/infer/src/IR/Mleak_buckets.ml b/infer/src/IR/Mleak_buckets.ml index 1c804e0d2..a7cca0118 100644 --- a/infer/src/IR/Mleak_buckets.ml +++ b/infer/src/IR/Mleak_buckets.ml @@ -9,7 +9,7 @@ *) open! IStd -open! PVariant +open PolyVariantEqual (** This module handles buckets of memory leaks in Objective-C/C++ *) @@ -17,9 +17,9 @@ let bucket_to_message bucket = match bucket with `MLeak_cpp -> "[CPP]" | `MLeak_unknown -> "[UNKNOWN ORIGIN]" -let contains_cpp = List.mem ~equal:PVariant.( = ) Config.ml_buckets `MLeak_cpp +let contains_cpp = List.mem ~equal:( = ) Config.ml_buckets `MLeak_cpp -let contains_unknown_origin = List.mem ~equal:PVariant.( = ) Config.ml_buckets `MLeak_unknown +let contains_unknown_origin = List.mem ~equal:( = ) Config.ml_buckets `MLeak_unknown let should_raise_leak_unknown_origin = contains_unknown_origin diff --git a/infer/src/IR/Sil.ml b/infer/src/IR/Sil.ml index d2ed5b6e9..8793548cb 100644 --- a/infer/src/IR/Sil.ml +++ b/infer/src/IR/Sil.ml @@ -1164,7 +1164,7 @@ let is_sub_empty = function (** Join two substitutions into one. For all id in dom(sub1) cap dom(sub2), sub1(id) = sub2(id). *) let sub_join sub1 sub2 = - let sub = List_.merge_dedup ~compare:compare_ident_exp sub1 sub2 in + let sub = IList.merge_dedup ~compare:compare_ident_exp sub1 sub2 in assert (sub_no_duplicated_ids sub) ; sub diff --git a/infer/src/backend/DifferentialFilters.ml b/infer/src/backend/DifferentialFilters.ml index 7844d6da7..3b6c432e2 100644 --- a/infer/src/backend/DifferentialFilters.ml +++ b/infer/src/backend/DifferentialFilters.ml @@ -236,7 +236,7 @@ let do_filter (diff: Differential.t) (renamings: FileRenamings.t) ~(skip_duplica ~(interesting_paths: SourceFile.t list option) : Differential.t = let paths_filter = interesting_paths_filter interesting_paths in let apply_paths_filter_if_needed label issues = - if List.exists ~f:(PVariant.( = ) label) Config.differential_filter_set then + if List.exists ~f:(PolyVariantEqual.( = ) label) Config.differential_filter_set then paths_filter issues else issues in diff --git a/infer/src/backend/StatsAggregator.ml b/infer/src/backend/StatsAggregator.ml index 70fe1c605..46607b6a1 100644 --- a/infer/src/backend/StatsAggregator.ml +++ b/infer/src/backend/StatsAggregator.ml @@ -7,7 +7,7 @@ * of patent rights can be found in the PATENTS file in the same directory. *) open! IStd -open! PVariant +open PolyVariantEqual module L = Logging let aggregated_stats_filename = "aggregated_stats.json" diff --git a/infer/src/backend/callbacks.ml b/infer/src/backend/callbacks.ml index 004b82516..2c6730558 100644 --- a/infer/src/backend/callbacks.ml +++ b/infer/src/backend/callbacks.ml @@ -8,7 +8,6 @@ *) open! IStd -open! PVariant module F = Format module L = Logging diff --git a/infer/src/backend/exe_env.ml b/infer/src/backend/exe_env.ml index df897ba4e..7cea10f16 100644 --- a/infer/src/backend/exe_env.ml +++ b/infer/src/backend/exe_env.ml @@ -9,7 +9,6 @@ *) open! IStd -open! PVariant module Hashtbl = Caml.Hashtbl (** Support for Execution environments *) diff --git a/infer/src/backend/interproc.ml b/infer/src/backend/interproc.ml index c559bdc69..8d06c90b6 100644 --- a/infer/src/backend/interproc.ml +++ b/infer/src/backend/interproc.ml @@ -9,7 +9,6 @@ *) open! IStd -open! PVariant module Hashtbl = Caml.Hashtbl (** Interprocedural Analysis *) @@ -464,7 +463,8 @@ let forward_tabulate exe_env tenv proc_cfg wl = L.d_decrease_indent 1 ; L.d_ln () with exn -> - reraise_if exn ~f:(fun () -> not !Config.footprint || not (Exceptions.handle_exception exn)) ; + IExn.reraise_if exn ~f:(fun () -> + not !Config.footprint || not (Exceptions.handle_exception exn) ) ; handle_exn exn ; L.d_decrease_indent 1 ; L.d_ln () @@ -494,7 +494,7 @@ let forward_tabulate exe_env tenv proc_cfg wl = if !handle_exn_called then Printer.force_delayed_prints () ; do_after_node curr_node with exn -> - reraise_if exn ~f:(fun () -> not (Exceptions.handle_exception exn)) ; + IExn.reraise_if exn ~f:(fun () -> not (Exceptions.handle_exception exn)) ; handle_exn_node curr_node exn ; Printer.force_delayed_prints () ; do_after_node curr_node ; @@ -1202,6 +1202,6 @@ let analyze_procedure {Callbacks.summary; proc_desc; tenv; exe_env} : Specs.summ let proc_name = Procdesc.get_proc_name proc_desc in Specs.add_summary proc_name summary ; ( try ignore (analyze_procedure_aux exe_env tenv proc_desc) with exn -> - reraise_if exn ~f:(fun () -> not (Exceptions.handle_exception exn)) ; + IExn.reraise_if exn ~f:(fun () -> not (Exceptions.handle_exception exn)) ; Reporting.log_error_deprecated proc_name exn ) ; Specs.get_summary_unsafe __FILE__ proc_name diff --git a/infer/src/backend/mergeCapture.ml b/infer/src/backend/mergeCapture.ml index 7a9e668af..63586bcd7 100644 --- a/infer/src/backend/mergeCapture.ml +++ b/infer/src/backend/mergeCapture.ml @@ -8,7 +8,7 @@ *) open! IStd -open! PVariant +open PolyVariantEqual module L = Logging module F = Format diff --git a/infer/src/backend/ondemand.ml b/infer/src/backend/ondemand.ml index 31e354c8e..509104a24 100644 --- a/infer/src/backend/ondemand.ml +++ b/infer/src/backend/ondemand.ml @@ -8,7 +8,6 @@ *) open! IStd -open! PVariant (** Module for on-demand analysis. *) @@ -155,7 +154,7 @@ let run_proc_analysis analyze_proc ~caller_pdesc callee_pdesc = let final_summary = postprocess summary in restore_global_state old_state ; final_summary with exn -> - reraise_if exn ~f:(fun () -> restore_global_state old_state ; not Config.keep_going) ; + IExn.reraise_if exn ~f:(fun () -> restore_global_state old_state ; not Config.keep_going) ; L.internal_error "@\nERROR RUNNING BACKEND: %a %s@\n@\nBACK TRACE@\n%s@?" Typ.Procname.pp callee_pname (Exn.to_string exn) (Printexc.get_backtrace ()) ; match exn with diff --git a/infer/src/backend/preanal.ml b/infer/src/backend/preanal.ml index b699af07c..820ca0d18 100644 --- a/infer/src/backend/preanal.ml +++ b/infer/src/backend/preanal.ml @@ -9,7 +9,6 @@ *) open! IStd -open! PVariant module L = Logging (** add instructions to perform abstraction *) diff --git a/infer/src/backend/prover.ml b/infer/src/backend/prover.ml index 5a2ca6748..b6836c6f2 100644 --- a/infer/src/backend/prover.ml +++ b/infer/src/backend/prover.ml @@ -17,7 +17,7 @@ module F = Format let decrease_indent_when_exception thunk = try thunk () with exn when SymOp.exn_not_failure exn -> - reraise_after exn ~f:(fun () -> L.d_decrease_indent 1) + IExn.reraise_after exn ~f:(fun () -> L.d_decrease_indent 1) let compute_max_from_nonempty_int_list l = uw (List.max_elt ~cmp:IntLit.compare_value l) diff --git a/infer/src/backend/specs.ml b/infer/src/backend/specs.ml index dba6afdbf..1bd569203 100644 --- a/infer/src/backend/specs.ml +++ b/infer/src/backend/specs.ml @@ -9,7 +9,7 @@ *) open! IStd -open! PVariant +open PolyVariantEqual module Hashtbl = Caml.Hashtbl (** Specifications and spec table *) diff --git a/infer/src/backend/symExec.ml b/infer/src/backend/symExec.ml index ed7efc9ae..8b98fc85b 100644 --- a/infer/src/backend/symExec.ml +++ b/infer/src/backend/symExec.ml @@ -9,7 +9,6 @@ *) open! IStd -open! PVariant (** Symbolic Execution *) @@ -1386,7 +1385,7 @@ and instrs ?(mask_errors= false) exe_env tenv pdesc instrs ppl = Sil.d_instr instr ; L.d_ln () ; try sym_exec exe_env tenv pdesc instr p path with exn -> - reraise_if exn ~f:(fun () -> not mask_errors || not (SymOp.exn_not_failure exn)) ; + IExn.reraise_if exn ~f:(fun () -> not mask_errors || not (SymOp.exn_not_failure exn)) ; let error = Exceptions.recognize_exception exn in let loc = match error.ocaml_pos with @@ -1598,7 +1597,7 @@ and check_variadic_sentinel ?(fails_on_nil= false) n_formals (sentinel, null_pos let tmp_id_deref = Ident.create_fresh Ident.kprimed in let load_instr = Sil.Load (tmp_id_deref, lexp, typ, loc) in try instrs exe_env tenv pdesc [load_instr] result with e when SymOp.exn_not_failure e -> - reraise_if e ~f:(fun () -> fails_on_nil) ; + IExn.reraise_if e ~f:(fun () -> fails_on_nil) ; let deref_str = Localise.deref_str_nil_argument_in_variadic_method proc_name nargs i in let err_desc = Errdesc.explain_dereference proc_name tenv ~use_buckets:true ~is_premature_nil:true @@ -1825,7 +1824,8 @@ and sym_exec_wrapper exe_env handle_exn tenv proc_cfg instr ((prop: Prop.normal State.mark_instr_ok () ; Paths.PathSet.from_renamed_list results with exn -> - reraise_if exn ~f:(fun () -> not !Config.footprint || not (Exceptions.handle_exception exn)) ; + IExn.reraise_if exn ~f:(fun () -> + not !Config.footprint || not (Exceptions.handle_exception exn) ) ; handle_exn exn ; (* calls State.mark_instr_fail *) Paths.PathSet.empty diff --git a/infer/src/base/Config.ml b/infer/src/base/Config.ml index a5a9cc35c..e7b01e318 100644 --- a/infer/src/base/Config.ml +++ b/infer/src/base/Config.ml @@ -9,7 +9,7 @@ *) open! IStd -open! PVariant +open PolyVariantEqual (** Configuration values: either constant, determined at compile time, or set at startup time by system calls, environment variables, or command line options *) @@ -1167,7 +1167,7 @@ and differential_filter_files = and differential_filter_set = - CLOpt.mk_symbol_seq ~long:"differential-filter-set" ~eq:PVariant.( = ) + CLOpt.mk_symbol_seq ~long:"differential-filter-set" ~eq:PolyVariantEqual.( = ) "Specify which set of the differential results is filtered with the modified files provided \ through the $(b,--differential-modified-files) argument. By default it is applied to all \ sets ($(b,introduced), $(b,fixed), and $(b,preexisting))" @@ -1372,7 +1372,7 @@ and help = and help_format = CLOpt.mk_symbol ~long:"help-format" ~symbols:[("auto", `Auto); ("groff", `Groff); ("pager", `Pager); ("plain", `Plain)] - ~eq:PVariant.( = ) ~default:`Auto + ~eq:PolyVariantEqual.( = ) ~default:`Auto ~in_help:(List.map InferCommand.all_commands ~f:(fun command -> (command, manual_generic))) "Show this help in the specified format. $(b,auto) sets the format to $(b,plain) if the \ environment variable $(b,TERM) is \"dumb\" or undefined, and to $(b,pager) otherwise." @@ -1422,7 +1422,7 @@ and issues_fields = ; `Issue_field_line_offset ; `Issue_field_bug_type ; `Issue_field_kind - ; `Issue_field_bug_trace ] ~symbols:issues_fields_symbols ~eq:PVariant.( = ) + ; `Issue_field_bug_trace ] ~symbols:issues_fields_symbols ~eq:PolyVariantEqual.( = ) "Fields to emit with $(b,--issues-tests)" @@ -1556,7 +1556,7 @@ and ml_buckets = {|Specify the memory leak buckets to be checked in C++: - $(b,cpp) from C++ code |} - ~symbols:ml_bucket_symbols ~eq:PVariant.( = ) + ~symbols:ml_bucket_symbols ~eq:PolyVariantEqual.( = ) and modified_targets = @@ -1765,8 +1765,8 @@ and report_formatter = CLOpt.mk_symbol ~long:"report-formatter" ~in_help:InferCommand.([(Report, manual_generic)]) ~default:`Phabricator_formatter - ~symbols:[("none", `No_formatter); ("phabricator", `Phabricator_formatter)] ~eq:PVariant.( = ) - "Which formatter to use when emitting the report" + ~symbols:[("none", `No_formatter); ("phabricator", `Phabricator_formatter)] + ~eq:PolyVariantEqual.( = ) "Which formatter to use when emitting the report" and report_hook = diff --git a/infer/src/base/DB.ml b/infer/src/base/DB.ml index 7c85ee96d..fbf028fa9 100644 --- a/infer/src/base/DB.ml +++ b/infer/src/base/DB.ml @@ -9,7 +9,7 @@ *) open! IStd -open! PVariant +open PolyVariantEqual (** Database of analysis results *) diff --git a/infer/src/base/IList.ml b/infer/src/base/IList.ml index f338c54f4..dbc51f1b0 100644 --- a/infer/src/base/IList.ml +++ b/infer/src/base/IList.ml @@ -121,3 +121,19 @@ let append_no_duplicates (type a) ~(cmp: a -> a -> int) = if Set.mem set1 x then res_rev else x :: res_rev ) in List.rev res_rev ) + + +let merge_dedup l1 l2 ~compare = + let rec loop acc l1 l2 = + match (l1, l2) with + | [], l2 -> + List.rev_append acc l2 + | l1, [] -> + List.rev_append acc l1 + | h1 :: t1, h2 :: t2 -> + let cmp = compare h1 h2 in + if Int.equal cmp 0 then loop (h1 :: acc) t1 t2 + else if cmp < 0 then loop (h1 :: acc) t1 l2 + else loop (h2 :: acc) l1 t2 + in + loop [] l1 l2 diff --git a/infer/src/base/IList.mli b/infer/src/base/IList.mli index 8a3d609cb..d84ef6c3a 100644 --- a/infer/src/base/IList.mli +++ b/infer/src/base/IList.mli @@ -33,3 +33,5 @@ val append_no_duplicates : cmp:('a -> 'a -> int) -> ('a list -> 'a list -> 'a li (** [append_no_duplicates list1 list2], assuming that list1 and list2 have no duplicates on their own, it computes list1 @ (filtered list2), so it keeps the order of both lists and has no duplicates. *) + +val merge_dedup : 'a list -> 'a list -> compare:('a -> 'a -> int) -> 'a list diff --git a/infer/src/base/Logging.ml b/infer/src/base/Logging.ml index 97cae35be..1f70b48d5 100644 --- a/infer/src/base/Logging.ml +++ b/infer/src/base/Logging.ml @@ -308,7 +308,7 @@ let setup_log_file () = in (* assumes the results dir exists already *) let logfile_path = results_dir ^/ Config.log_file in - let preexisting_logfile = PVariant.( = ) (Sys.file_exists logfile_path) `Yes in + let preexisting_logfile = PolyVariantEqual.( = ) (Sys.file_exists logfile_path) `Yes in let chan = Pervasives.open_out_gen [Open_append; Open_creat] 0o666 logfile_path in let file_fmt = let f = F.formatter_of_out_channel chan in diff --git a/infer/src/base/Multilinks.ml b/infer/src/base/Multilinks.ml index 0dad2740f..54e35318a 100644 --- a/infer/src/base/Multilinks.ml +++ b/infer/src/base/Multilinks.ml @@ -8,7 +8,7 @@ *) open! IStd -open! PVariant +open PolyVariantEqual module F = Format module L = Logging diff --git a/infer/src/base/ResultsDatabase.ml b/infer/src/base/ResultsDatabase.ml index 2f3318ef7..9818ebc32 100644 --- a/infer/src/base/ResultsDatabase.ml +++ b/infer/src/base/ResultsDatabase.ml @@ -8,7 +8,6 @@ *) open! IStd -open! PVariant module L = Logging let database : Sqlite3.db option ref = ref None diff --git a/infer/src/base/ResultsDir.ml b/infer/src/base/ResultsDir.ml index 9160816ce..2042d95e4 100644 --- a/infer/src/base/ResultsDir.ml +++ b/infer/src/base/ResultsDir.ml @@ -7,7 +7,7 @@ * of patent rights can be found in the PATENTS file in the same directory. *) open! IStd -open! PVariant +open PolyVariantEqual module CLOpt = CommandLineOption module L = Logging diff --git a/infer/src/base/SourceFile.ml b/infer/src/base/SourceFile.ml index d6d9eeceb..17385e1da 100644 --- a/infer/src/base/SourceFile.ml +++ b/infer/src/base/SourceFile.ml @@ -8,7 +8,7 @@ *) open! IStd -open! PVariant +open PolyVariantEqual module L = Logging let count_newlines (path: string) : int = diff --git a/infer/src/base/SymOp.ml b/infer/src/base/SymOp.ml index 44dfdcb50..e6ed66b58 100644 --- a/infer/src/base/SymOp.ml +++ b/infer/src/base/SymOp.ml @@ -29,10 +29,10 @@ let try_finally ~f ~finally = | r -> finally () ; r | exception (Analysis_failure_exe _ as f_exn) -> - reraise_after f_exn ~f:(fun () -> + IExn.reraise_after f_exn ~f:(fun () -> try finally () with _ -> (* swallow in favor of the original exception *) () ) | exception f_exn -> - reraise_after f_exn ~f:(fun () -> + IExn.reraise_after f_exn ~f:(fun () -> try finally () with | finally_exn diff --git a/infer/src/base/Utils.ml b/infer/src/base/Utils.ml index 4f7defdb0..884009212 100644 --- a/infer/src/base/Utils.ml +++ b/infer/src/base/Utils.ml @@ -8,7 +8,7 @@ * of patent rights can be found in the PATENTS file in the same directory. *) open! IStd -open! PVariant +open PolyVariantEqual module F = Format module Hashtbl = Caml.Hashtbl module L = Die @@ -163,7 +163,7 @@ let read_json_file path = let do_finally_swallow_timeout ~f ~finally = let res = try f () with exc -> - reraise_after exc ~f:(fun () -> + IExn.reraise_after exc ~f:(fun () -> try finally () |> ignore with _ -> (* swallow in favor of the original exception *) () ) in let res' = finally () in @@ -254,7 +254,7 @@ let realpath ?(warn_on_error= true) path = Hashtbl.add realpath_cache path (Ok realpath) ; realpath | exception (Unix.Unix_error (code, _, arg) as exn) -> - reraise_after exn ~f:(fun () -> + IExn.reraise_after exn ~f:(fun () -> if warn_on_error then F.eprintf "WARNING: Failed to resolve file %s with \"%s\" @\n@." arg (Unix.Error.message code) ; diff --git a/infer/src/base/ZipLib.ml b/infer/src/base/ZipLib.ml index f5a5bee2d..a425f9fca 100644 --- a/infer/src/base/ZipLib.ml +++ b/infer/src/base/ZipLib.ml @@ -8,7 +8,7 @@ *) open! IStd -open! PVariant +open PolyVariantEqual module L = Logging type zip_library = {zip_filename: string; zip_channel: Zip.in_file Lazy.t; models: bool} diff --git a/infer/src/checkers/SiofTrace.ml b/infer/src/checkers/SiofTrace.ml index 16a4bc4d1..9dbf32c3c 100644 --- a/infer/src/checkers/SiofTrace.ml +++ b/infer/src/checkers/SiofTrace.ml @@ -8,7 +8,7 @@ *) open! IStd -open! PVariant +open PolyVariantEqual module F = Format module L = Logging diff --git a/infer/src/clang/Capture.ml b/infer/src/clang/Capture.ml index cb0ee0451..7f7e1be42 100644 --- a/infer/src/clang/Capture.ml +++ b/infer/src/clang/Capture.ml @@ -103,7 +103,7 @@ let run_clang_frontend ast_source = let run_and_validate_clang_frontend ast_source = try run_clang_frontend ast_source with exc -> - reraise_if exc ~f:(fun () -> not Config.keep_going) ; + IExn.reraise_if exc ~f:(fun () -> not Config.keep_going) ; L.internal_error "ERROR RUNNING CAPTURE: %a@\n%s@\n" Exn.pp exc (Printexc.get_backtrace ()) diff --git a/infer/src/clang/ComponentKit.ml b/infer/src/clang/ComponentKit.ml index ecd3d8415..ba516857d 100644 --- a/infer/src/clang/ComponentKit.ml +++ b/infer/src/clang/ComponentKit.ml @@ -8,7 +8,7 @@ *) open! IStd -open! PVariant +open PolyVariantEqual module MF = MarkupFormatter let get_source_range an = diff --git a/infer/src/clang/cAst_utils.ml b/infer/src/clang/cAst_utils.ml index c68de1c6f..9ff057bed 100644 --- a/infer/src/clang/cAst_utils.ml +++ b/infer/src/clang/cAst_utils.ml @@ -8,7 +8,7 @@ *) open! IStd -open! PVariant +open PolyVariantEqual (** Functions for transformations of ast nodes *) diff --git a/infer/src/clang/cFrontend_checkers_main.ml b/infer/src/clang/cFrontend_checkers_main.ml index a99c73bc6..4d5cfbc2d 100644 --- a/infer/src/clang/cFrontend_checkers_main.ml +++ b/infer/src/clang/cFrontend_checkers_main.ml @@ -103,7 +103,7 @@ let rec get_responds_to_selector stmt = when List.mem ~equal:String.equal responToSelectorMethods mdi.Clang_ast_t.omei_selector -> [method_name] | BinaryOperator (_, [stmt1; stmt2], _, bo_info) - when PVariant.( = ) bo_info.Clang_ast_t.boi_kind `LAnd -> + when PolyVariantEqual.( = ) bo_info.Clang_ast_t.boi_kind `LAnd -> List.append (get_responds_to_selector stmt1) (get_responds_to_selector stmt2) | ImplicitCastExpr (_, [stmt], _, _) | ParenExpr (_, [stmt], _) @@ -146,13 +146,15 @@ let rec get_current_os_version stmt = let open Clang_ast_t in match stmt with | BinaryOperator (_, [stmt1; stmt2], _, bo_info) - when PVariant.( = ) bo_info.Clang_ast_t.boi_kind `GE && is_core_foundation_version_number stmt1 -> + when PolyVariantEqual.( = ) bo_info.Clang_ast_t.boi_kind `GE + && is_core_foundation_version_number stmt1 -> Option.to_list (current_os_version_constant stmt2) | BinaryOperator (_, [stmt1; stmt2], _, bo_info) - when PVariant.( = ) bo_info.Clang_ast_t.boi_kind `LE && is_core_foundation_version_number stmt2 -> + when PolyVariantEqual.( = ) bo_info.Clang_ast_t.boi_kind `LE + && is_core_foundation_version_number stmt2 -> Option.to_list (current_os_version_constant stmt1) | BinaryOperator (_, [stmt1; stmt2], _, bo_info) - when PVariant.( = ) bo_info.Clang_ast_t.boi_kind `LAnd -> + when PolyVariantEqual.( = ) bo_info.Clang_ast_t.boi_kind `LAnd -> List.append (get_current_os_version stmt1) (get_current_os_version stmt2) | ImplicitCastExpr (_, [stmt], _, _) | ParenExpr (_, [stmt], _) diff --git a/infer/src/clang/cFrontend_decl.ml b/infer/src/clang/cFrontend_decl.ml index 67a9df64f..de25f604f 100644 --- a/infer/src/clang/cFrontend_decl.ml +++ b/infer/src/clang/cFrontend_decl.ml @@ -41,7 +41,7 @@ let protect ~f ~recover ~pp_context (trans_unit_ctx: CFrontend_config.translatio log_and_recover ~print:true "Unexpected SelfClassException %a@\n" Typ.Name.pp e.class_name | exn -> let trace = Backtrace.get () in - reraise_if exn ~f:(fun () -> + IExn.reraise_if exn ~f:(fun () -> L.internal_error "%a: %a@\n%!" pp_context () Exn.pp exn ; not Config.keep_going ) ; log_and_recover ~print:true "Frontend error: %a@\nBacktrace:@\n%s" Exn.pp exn diff --git a/infer/src/clang/cLocation.ml b/infer/src/clang/cLocation.ml index 6b0d9e844..770f6a1d3 100644 --- a/infer/src/clang/cLocation.ml +++ b/infer/src/clang/cLocation.ml @@ -8,7 +8,7 @@ *) open! IStd -open! PVariant +open PolyVariantEqual (** Module for function to retrieve the location (file, line, etc) of instructions *) diff --git a/infer/src/clang/cPredicates.ml b/infer/src/clang/cPredicates.ml index cb0fd3303..db3157eec 100644 --- a/infer/src/clang/cPredicates.ml +++ b/infer/src/clang/cPredicates.ml @@ -247,7 +247,7 @@ let decl_ref_name ?kind name st = let has_right_name = ALVar.compare_str_with_alexp ndi.ni_name name in match kind with | Some decl_kind -> - has_right_name && PVariant.( = ) dr.Clang_ast_t.dr_kind decl_kind + has_right_name && PolyVariantEqual.( = ) dr.Clang_ast_t.dr_kind decl_kind | None -> has_right_name ) | _ -> @@ -288,7 +288,7 @@ let is_enum_constant_of_enum an name = | Some (_, stripped_qual_name) -> ( match QualifiedCppName.extract_last stripped_qual_name with | Some (enum_name, _) -> - PVariant.( = ) dr.Clang_ast_t.dr_kind `EnumConstant + PolyVariantEqual.( = ) dr.Clang_ast_t.dr_kind `EnumConstant && ALVar.compare_str_with_alexp enum_name name | _ -> false ) @@ -356,7 +356,7 @@ let is_ivar_atomic an = match CAst_utils.get_decl ivar_pointer with | Some d -> let attributes = get_ivar_attributes d in - List.exists ~f:(PVariant.( = ) `Atomic) attributes + List.exists ~f:(PolyVariantEqual.( = ) `Atomic) attributes | _ -> false ) | _ -> diff --git a/infer/src/clang/cTrans.ml b/infer/src/clang/cTrans.ml index fb05f852c..ae1d46882 100644 --- a/infer/src/clang/cTrans.ml +++ b/infer/src/clang/cTrans.ml @@ -8,7 +8,7 @@ *) open! IStd -open! PVariant +open PolyVariantEqual (** Translates instructions: (statements and expressions) from the ast into sil *) diff --git a/infer/src/clang/cVar_decl.ml b/infer/src/clang/cVar_decl.ml index 4feec0479..732d4a33c 100644 --- a/infer/src/clang/cVar_decl.ml +++ b/infer/src/clang/cVar_decl.ml @@ -8,7 +8,6 @@ *) open! IStd -open! PVariant (** Process variable declarations by saving them as local or global variables. *) diff --git a/infer/src/clang/ctl_parser_types.ml b/infer/src/clang/ctl_parser_types.ml index 823eb25da..26e20f974 100644 --- a/infer/src/clang/ctl_parser_types.ml +++ b/infer/src/clang/ctl_parser_types.ml @@ -409,7 +409,7 @@ let builtin_type_kind_assoc = let builtin_equal (bi: Clang_ast_t.builtin_type_kind) (abi: builtin_kind) = - match List.Assoc.find ~equal:PVariant.( = ) builtin_type_kind_assoc bi with + match List.Assoc.find ~equal:PolyVariantEqual.( = ) builtin_type_kind_assoc bi with | Some assoc_abi when equal_builtin_kind assoc_abi abi -> true | _ -> diff --git a/infer/src/integration/CaptureCompilationDatabase.ml b/infer/src/integration/CaptureCompilationDatabase.ml index 769663b2b..3e8db22ab 100644 --- a/infer/src/integration/CaptureCompilationDatabase.ml +++ b/infer/src/integration/CaptureCompilationDatabase.ml @@ -30,7 +30,7 @@ let create_cmd (compilation_data: CompilationDatabase.compilation_data) = Because infer processes run in parallel but do not share any memory, we use the filesystem to signal failures across processes. *) let sentinel_exists sentinel_opt = - let file_exists sentinel = PVariant.( = ) (Sys.file_exists sentinel) `Yes in + let file_exists sentinel = PolyVariantEqual.( = ) (Sys.file_exists sentinel) `Yes in Option.value_map ~default:false sentinel_opt ~f:file_exists diff --git a/infer/src/integration/Driver.ml b/infer/src/integration/Driver.ml index 40650e473..d257063a3 100644 --- a/infer/src/integration/Driver.ml +++ b/infer/src/integration/Driver.ml @@ -7,7 +7,7 @@ * of patent rights can be found in the PATENTS file in the same directory. *) open! IStd -open! PVariant +open PolyVariantEqual (** entry points for top-level functionalities such as capture, analysis, and reporting *) diff --git a/infer/src/integration/Javac.ml b/infer/src/integration/Javac.ml index e3b46241f..81ef05384 100644 --- a/infer/src/integration/Javac.ml +++ b/infer/src/integration/Javac.ml @@ -70,7 +70,7 @@ let compile compiler build_prog build_args = (Unix.Exit_or_signal.to_string_hum (Error err)) shell_cmd log verbose_errlog ) | exception exn -> - reraise_if exn ~f:(fun () -> + IExn.reraise_if exn ~f:(fun () -> match error_k with | Some k -> L.(debug Capture Quiet) "*** Failed: %a!@\n" Exn.pp exn ; diff --git a/infer/src/istd/.merlin b/infer/src/istd/.merlin index 61702e145..e47615a55 100644 --- a/infer/src/istd/.merlin +++ b/infer/src/istd/.merlin @@ -16,4 +16,5 @@ PKG yojson PKG zip FLG -principal -safe-string -short-paths -strict-formats -strict-sequence FLG -w +a-4-9-40-41-42-44-45-48-60 +FLG -open Core S . diff --git a/infer/src/istd/IExn.ml b/infer/src/istd/IExn.ml new file mode 100644 index 000000000..41c12e178 --- /dev/null +++ b/infer/src/istd/IExn.ml @@ -0,0 +1,20 @@ +(* + * Copyright (c) 2018 - present Facebook, Inc. + * All rights reserved. + * + * This source code is licensed under the BSD style license found in the + * LICENSE file in the root directory of this source tree. An additional grant + * of patent rights can be found in the PATENTS file in the same directory. + *) + +open! Core + +let reraise_after ~f exn = + let backtrace = Caml.Printexc.get_raw_backtrace () in + let () = f () in + Caml.Printexc.raise_with_backtrace exn backtrace + + +let reraise_if ~f exn = + let backtrace = Caml.Printexc.get_raw_backtrace () in + if f () then Caml.Printexc.raise_with_backtrace exn backtrace diff --git a/infer/src/istd/IExn.mli b/infer/src/istd/IExn.mli new file mode 100644 index 000000000..269ed296d --- /dev/null +++ b/infer/src/istd/IExn.mli @@ -0,0 +1,18 @@ +(* + * Copyright (c) 2018 - present Facebook, Inc. + * All rights reserved. + * + * This source code is licensed under the BSD style license found in the + * LICENSE file in the root directory of this source tree. An additional grant + * of patent rights can be found in the PATENTS file in the same directory. + *) + +open! Core + +val reraise_after : f:(unit -> unit) -> exn -> 'a +(** Reraise the exception after doing f. Always reraise immediately after catching the exception, + otherwise the backtrace can be wrong. *) + +val reraise_if : f:(unit -> bool) -> exn -> unit +(** Reraise the exception if f returns true. Always reraise immediately after catching the + exception, otherwise the backtrace can be wrong. *) diff --git a/infer/src/istd/IStd.ml b/infer/src/istd/IStd.ml index 86dd22458..a0586e7aa 100644 --- a/infer/src/istd/IStd.ml +++ b/infer/src/istd/IStd.ml @@ -1,5 +1,5 @@ (* - * Copyright (c) 2016 - present Facebook, Inc. + * Copyright (c) 2018 - present Facebook, Inc. * All rights reserved. * * This source code is licensed under the BSD style license found in the @@ -9,27 +9,6 @@ include Core -module List_ = struct - let merge_dedup l1 l2 ~compare = - let rec loop acc l1 l2 = - match (l1, l2) with - | [], l2 -> - List.rev_append acc l2 - | l1, [] -> - List.rev_append acc l1 - | h1 :: t1, h2 :: t2 -> - let cmp = compare h1 h2 in - if cmp = 0 then loop (h1 :: acc) t1 t2 - else if cmp < 0 then loop (h1 :: acc) t1 l2 - else loop (h2 :: acc) l1 t2 - in - loop [] l1 l2 -end - -(* Use Caml.Set since they are serialized using Marshal, and Core.Std.Set includes the comparison - function in its representation, which Marshal cannot (de)serialize. *) -module IntSet = Caml.Set.Make (Int) - [@@@warning "-32"] (* Compare police: generic compare mostly disabled. *) @@ -47,31 +26,10 @@ let invalid_arg _ : [`use_Logging_die_instead] = assert false let invalid_argf _ : [`use_Logging_die_instead] = assert false -(** With Logging.exit you have more control of the code that invokes exit, for example when forking - and running certain functions that may in turn invoke exit, and you want to handle the execution - flow differently - like invoking certain callbacks before exiting, or not exiting at all. *) let exit = `In_general_prefer_using_Logging_exit_over_Pervasives_exit [@@@warning "+32"] -module PVariant = struct - (* Equality for polymorphic variants *) - let ( = ) (v1: [> ]) (v2: [> ]) = Polymorphic_compare.( = ) v1 v2 -end - -(** Reraise the exception after doing f. Always reraise immediately after catching the exception, otherwise the backtrace can be wrong *) -let reraise_after ~f exn = - let backtrace = Caml.Printexc.get_raw_backtrace () in - let () = f () in - Caml.Printexc.raise_with_backtrace exn backtrace - - -(** Reraise the exception if f returns true. Always reraise immediately after catching the exception, otherwise the backtrace can be wrong *) -let reraise_if ~f exn = - let backtrace = Caml.Printexc.get_raw_backtrace () in - if f () then Caml.Printexc.raise_with_backtrace exn backtrace - - module ANSITerminal : module type of ANSITerminal = struct include ANSITerminal diff --git a/infer/src/istd/IntSet.ml b/infer/src/istd/IntSet.ml new file mode 100644 index 000000000..61e337fbe --- /dev/null +++ b/infer/src/istd/IntSet.ml @@ -0,0 +1,11 @@ +(* + * Copyright (c) 2018 - present Facebook, Inc. + * All rights reserved. + * + * This source code is licensed under the BSD style license found in the + * LICENSE file in the root directory of this source tree. An additional grant + * of patent rights can be found in the PATENTS file in the same directory. + *) + +open! Core +include Caml.Set.Make (Int) diff --git a/infer/src/istd/IntSet.mli b/infer/src/istd/IntSet.mli new file mode 100644 index 000000000..54fa4419e --- /dev/null +++ b/infer/src/istd/IntSet.mli @@ -0,0 +1,10 @@ +(* + * Copyright (c) 2018 - present Facebook, Inc. + * All rights reserved. + * + * This source code is licensed under the BSD style license found in the + * LICENSE file in the root directory of this source tree. An additional grant + * of patent rights can be found in the PATENTS file in the same directory. + *) + +include Caml.Set.S with type elt = int diff --git a/infer/src/istd/PolyVariantEqual.ml b/infer/src/istd/PolyVariantEqual.ml new file mode 100644 index 000000000..0c6bca72d --- /dev/null +++ b/infer/src/istd/PolyVariantEqual.ml @@ -0,0 +1,12 @@ +(* + * Copyright (c) 2018 - present Facebook, Inc. + * All rights reserved. + * + * This source code is licensed under the BSD style license found in the + * LICENSE file in the root directory of this source tree. An additional grant + * of patent rights can be found in the PATENTS file in the same directory. + *) + +open! Core + +let ( = ) (v1: [> ]) (v2: [> ]) = Polymorphic_compare.( = ) v1 v2 diff --git a/infer/src/istd/PolyVariantEqual.mli b/infer/src/istd/PolyVariantEqual.mli new file mode 100644 index 000000000..3eb433bb1 --- /dev/null +++ b/infer/src/istd/PolyVariantEqual.mli @@ -0,0 +1,15 @@ +(* + * Copyright (c) 2018 - present Facebook, Inc. + * All rights reserved. + * + * This source code is licensed under the BSD style license found in the + * LICENSE file in the root directory of this source tree. An additional grant + * of patent rights can be found in the PATENTS file in the same directory. + *) + +open! Core + +(** Open to bring equality [(=)] for polymorphic variants into scope *) + +val ( = ) : ([> ] as 'a) -> 'a -> bool +(** Equality for polymorphic variants *) diff --git a/infer/src/istd/jbuild.in b/infer/src/istd/jbuild.in index bae8749fd..a1639a522 100644 --- a/infer/src/istd/jbuild.in +++ b/infer/src/istd/jbuild.in @@ -4,7 +4,7 @@ {| (library ((name InferStdlib) - (flags (%s)) + (flags (%s -open Core)) (ocamlopt_flags (%s)) (libraries (%s)) )) diff --git a/infer/src/java/jClasspath.ml b/infer/src/java/jClasspath.ml index 927b62a88..c9d4f774a 100644 --- a/infer/src/java/jClasspath.ml +++ b/infer/src/java/jClasspath.ml @@ -9,7 +9,7 @@ *) open! IStd -open! PVariant +open PolyVariantEqual open Javalib_pack module L = Logging diff --git a/infer/src/java/jFrontend.ml b/infer/src/java/jFrontend.ml index 10108347e..bbf7a1f2f 100644 --- a/infer/src/java/jFrontend.ml +++ b/infer/src/java/jFrontend.ml @@ -9,7 +9,7 @@ *) open! IStd -open! PVariant +open PolyVariantEqual open Javalib_pack open Sawja_pack module L = Logging diff --git a/infer/src/java/jMain.ml b/infer/src/java/jMain.ml index b248152f1..b6f5a50ca 100644 --- a/infer/src/java/jMain.ml +++ b/infer/src/java/jMain.ml @@ -9,7 +9,7 @@ *) open! IStd -open! PVariant +open PolyVariantEqual open Javalib_pack module F = Format module L = Logging