[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
master
Jules Villard 7 years ago committed by Facebook Github Bot
parent 774aebcdba
commit 84d3144c98

@ -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

@ -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

@ -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

@ -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

@ -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"

@ -8,7 +8,6 @@
*)
open! IStd
open! PVariant
module F = Format
module L = Logging

@ -9,7 +9,6 @@
*)
open! IStd
open! PVariant
module Hashtbl = Caml.Hashtbl
(** Support for Execution environments *)

@ -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

@ -8,7 +8,7 @@
*)
open! IStd
open! PVariant
open PolyVariantEqual
module L = Logging
module F = Format

@ -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

@ -9,7 +9,6 @@
*)
open! IStd
open! PVariant
module L = Logging
(** add instructions to perform abstraction *)

@ -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)

@ -9,7 +9,7 @@
*)
open! IStd
open! PVariant
open PolyVariantEqual
module Hashtbl = Caml.Hashtbl
(** Specifications and spec table *)

@ -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

@ -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 =

@ -9,7 +9,7 @@
*)
open! IStd
open! PVariant
open PolyVariantEqual
(** Database of analysis results *)

@ -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

@ -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

@ -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

@ -8,7 +8,7 @@
*)
open! IStd
open! PVariant
open PolyVariantEqual
module F = Format
module L = Logging

@ -8,7 +8,6 @@
*)
open! IStd
open! PVariant
module L = Logging
let database : Sqlite3.db option ref = ref None

@ -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

@ -8,7 +8,7 @@
*)
open! IStd
open! PVariant
open PolyVariantEqual
module L = Logging
let count_newlines (path: string) : int =

@ -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

@ -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) ;

@ -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}

@ -8,7 +8,7 @@
*)
open! IStd
open! PVariant
open PolyVariantEqual
module F = Format
module L = Logging

@ -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 ())

@ -8,7 +8,7 @@
*)
open! IStd
open! PVariant
open PolyVariantEqual
module MF = MarkupFormatter
let get_source_range an =

@ -8,7 +8,7 @@
*)
open! IStd
open! PVariant
open PolyVariantEqual
(** Functions for transformations of ast nodes *)

@ -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], _)

@ -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

@ -8,7 +8,7 @@
*)
open! IStd
open! PVariant
open PolyVariantEqual
(** Module for function to retrieve the location (file, line, etc) of instructions *)

@ -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 )
| _ ->

@ -8,7 +8,7 @@
*)
open! IStd
open! PVariant
open PolyVariantEqual
(** Translates instructions: (statements and expressions) from the ast into sil *)

@ -8,7 +8,6 @@
*)
open! IStd
open! PVariant
(** Process variable declarations by saving them as local or global variables. *)

@ -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
| _ ->

@ -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

@ -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 *)

@ -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 ;

@ -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 .

@ -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

@ -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. *)

@ -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

@ -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)

@ -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

@ -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

@ -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 *)

@ -4,7 +4,7 @@
{|
(library
((name InferStdlib)
(flags (%s))
(flags (%s -open Core))
(ocamlopt_flags (%s))
(libraries (%s))
))

@ -9,7 +9,7 @@
*)
open! IStd
open! PVariant
open PolyVariantEqual
open Javalib_pack
module L = Logging

@ -9,7 +9,7 @@
*)
open! IStd
open! PVariant
open PolyVariantEqual
open Javalib_pack
open Sawja_pack
module L = Logging

@ -9,7 +9,7 @@
*)
open! IStd
open! PVariant
open PolyVariantEqual
open Javalib_pack
module F = Format
module L = Logging

Loading…
Cancel
Save