2016-02-18 07:11:59 -08:00
|
|
|
(**************************************************************************)
|
|
|
|
(* *)
|
|
|
|
(* OCaml *)
|
|
|
|
(* *)
|
|
|
|
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
|
|
|
|
(* *)
|
|
|
|
(* Copyright 1996 Institut National de Recherche en Informatique et *)
|
|
|
|
(* en Automatique. *)
|
|
|
|
(* *)
|
|
|
|
(* All rights reserved. This file is distributed under the terms of *)
|
|
|
|
(* the GNU Lesser General Public License version 2.1, with the *)
|
|
|
|
(* special exception on linking described in the file LICENSE. *)
|
|
|
|
(* *)
|
|
|
|
(**************************************************************************)
|
1995-08-09 08:06:35 -07:00
|
|
|
|
2018-09-12 00:51:47 -07:00
|
|
|
(** Miscellaneous useful types and functions
|
|
|
|
|
|
|
|
{b Warning:} this module is unstable and part of
|
2018-09-12 06:36:40 -07:00
|
|
|
{{!Compiler_libs}compiler-libs}.
|
2018-09-12 00:51:47 -07:00
|
|
|
|
|
|
|
*)
|
1995-05-04 03:15:53 -07:00
|
|
|
|
|
|
|
val fatal_error: string -> 'a
|
2015-12-18 07:50:24 -08:00
|
|
|
val fatal_errorf: ('a, Format.formatter, unit, 'b) format4 -> 'a
|
1995-05-04 03:15:53 -07:00
|
|
|
exception Fatal_error
|
|
|
|
|
2015-12-23 13:40:21 -08:00
|
|
|
val try_finally :
|
|
|
|
?always:(unit -> unit) ->
|
|
|
|
?exceptionally:(unit -> unit) ->
|
|
|
|
(unit -> 'a) -> 'a
|
|
|
|
(** [try_finally work ~always ~exceptionally] is designed to run code
|
|
|
|
in [work] that may fail with an exception, and has two kind of
|
|
|
|
cleanup routines: [always], that must be run after any execution
|
|
|
|
of the function (typically, freeing system resources), and
|
|
|
|
[exceptionally], that should be run only if [work] or [always]
|
|
|
|
failed with an exception (typically, undoing user-visible state
|
|
|
|
changes that would only make sense if the function completes
|
|
|
|
correctly). For example:
|
|
|
|
|
|
|
|
{[
|
|
|
|
let objfile = outputprefix ^ ".cmo" in
|
|
|
|
let oc = open_out_bin objfile in
|
|
|
|
Misc.try_finally
|
|
|
|
(fun () ->
|
|
|
|
bytecode
|
|
|
|
++ Timings.(accumulate_time (Generate sourcefile))
|
|
|
|
(Emitcode.to_file oc modulename objfile);
|
|
|
|
Warnings.check_fatal ())
|
|
|
|
~always:(fun () -> close_out oc)
|
|
|
|
~exceptionally:(fun _exn -> remove_file objfile);
|
|
|
|
]}
|
|
|
|
|
|
|
|
If [exceptionally] fail with an exception, it is propagated as
|
|
|
|
usual.
|
|
|
|
|
|
|
|
If [always] or [exceptionally] use exceptions internally for
|
|
|
|
control-flow but do not raise, then [try_finally] is careful to
|
|
|
|
preserve any exception backtrace coming from [work] or [always]
|
|
|
|
for easier debugging.
|
|
|
|
*)
|
|
|
|
|
2003-04-01 17:32:09 -08:00
|
|
|
|
1995-05-04 03:15:53 -07:00
|
|
|
val map_end: ('a -> 'b) -> 'a list -> 'b list -> 'b list
|
1996-01-04 04:51:11 -08:00
|
|
|
(* [map_end f l t] is [map f l @ t], just more efficient. *)
|
2002-02-08 08:55:44 -08:00
|
|
|
val map_left_right: ('a -> 'b) -> 'a list -> 'b list
|
|
|
|
(* Like [List.map], with guaranteed left-to-right evaluation order *)
|
1995-05-04 03:15:53 -07:00
|
|
|
val for_all2: ('a -> 'b -> bool) -> 'a list -> 'b list -> bool
|
2000-11-22 05:51:07 -08:00
|
|
|
(* Same as [List.for_all] but for a binary predicate.
|
|
|
|
In addition, this [for_all2] never fails: given two lists
|
|
|
|
with different lengths, it returns false. *)
|
1996-01-04 04:51:11 -08:00
|
|
|
val replicate_list: 'a -> int -> 'a list
|
|
|
|
(* [replicate_list elem n] is the list with [n] elements
|
|
|
|
all identical to [elem]. *)
|
1999-02-04 02:32:27 -08:00
|
|
|
val list_remove: 'a -> 'a list -> 'a list
|
|
|
|
(* [list_remove x l] returns a copy of [l] with the first
|
2000-02-28 07:47:13 -08:00
|
|
|
element equal to [x] removed. *)
|
|
|
|
val split_last: 'a list -> 'a list * 'a
|
|
|
|
(* Return the last element and the other elements of the given list. *)
|
1999-11-30 08:07:38 -08:00
|
|
|
val may: ('a -> unit) -> 'a option -> unit
|
|
|
|
val may_map: ('a -> 'b) -> 'a option -> 'b option
|
|
|
|
|
2016-02-24 08:04:37 -08:00
|
|
|
type ref_and_value = R : 'a ref * 'a -> ref_and_value
|
|
|
|
|
|
|
|
val protect_refs : ref_and_value list -> (unit -> 'a) -> 'a
|
|
|
|
(** [protect_refs l f] temporarily sets [r] to [v] for each [R (r, v)] in [l]
|
|
|
|
while executing [f]. The previous contents of the references is restored
|
|
|
|
even if [f] raises an exception. *)
|
|
|
|
|
2015-12-30 06:43:44 -08:00
|
|
|
module Stdlib : sig
|
|
|
|
module List : sig
|
|
|
|
type 'a t = 'a list
|
|
|
|
|
|
|
|
val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int
|
|
|
|
(** The lexicographic order supported by the provided order.
|
|
|
|
There is no constraint on the relative lengths of the lists. *)
|
|
|
|
|
|
|
|
val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
|
|
|
|
(** Returns [true] iff the given lists have the same length and content
|
|
|
|
with respect to the given equality function. *)
|
|
|
|
|
2018-10-07 02:47:38 -07:00
|
|
|
val find_map : ('a -> 'b option) -> 'a t -> 'b option
|
|
|
|
(** [find_map f l] returns the first evaluation of [f] that returns [Some],
|
|
|
|
or returns None if there is no such element. *)
|
|
|
|
|
2015-12-30 06:43:44 -08:00
|
|
|
val some_if_all_elements_are_some : 'a option t -> 'a t option
|
|
|
|
(** If all elements of the given list are [Some _] then [Some xs]
|
|
|
|
is returned with the [xs] being the contents of those [Some]s, with
|
2016-01-12 04:44:20 -08:00
|
|
|
order preserved. Otherwise return [None]. *)
|
2015-12-30 06:43:44 -08:00
|
|
|
|
|
|
|
val map2_prefix : ('a -> 'b -> 'c) -> 'a t -> 'b t -> ('c t * 'b t)
|
|
|
|
(** [let r1, r2 = map2_prefix f l1 l2]
|
|
|
|
If [l1] is of length n and [l2 = h2 @ t2] with h2 of length n,
|
|
|
|
r1 is [List.map2 f l1 h1] and r2 is t2. *)
|
|
|
|
|
2016-01-12 04:44:20 -08:00
|
|
|
val split_at : int -> 'a t -> 'a t * 'a t
|
2015-12-30 06:43:44 -08:00
|
|
|
(** [split_at n l] returns the pair [before, after] where [before] is
|
|
|
|
the [n] first elements of [l] and [after] the remaining ones.
|
|
|
|
If [l] has less than [n] elements, raises Invalid_argument. *)
|
2019-03-06 02:59:03 -08:00
|
|
|
|
|
|
|
val is_prefix
|
|
|
|
: equal:('a -> 'a -> bool)
|
|
|
|
-> 'a list
|
|
|
|
-> of_:'a list
|
|
|
|
-> bool
|
|
|
|
(** Returns [true] iff the given list, with respect to the given equality
|
|
|
|
function on list members, is a prefix of the list [of_]. *)
|
|
|
|
|
|
|
|
type 'a longest_common_prefix_result = private {
|
|
|
|
longest_common_prefix : 'a list;
|
|
|
|
first_without_longest_common_prefix : 'a list;
|
|
|
|
second_without_longest_common_prefix : 'a list;
|
|
|
|
}
|
|
|
|
|
|
|
|
val find_and_chop_longest_common_prefix
|
|
|
|
: equal:('a -> 'a -> bool)
|
|
|
|
-> first:'a list
|
|
|
|
-> second:'a list
|
|
|
|
-> 'a longest_common_prefix_result
|
|
|
|
(** Returns the longest list that, with respect to the provided equality
|
|
|
|
function, is a prefix of both of the given lists. The input lists,
|
|
|
|
each with such longest common prefix removed, are also returned. *)
|
2015-12-30 06:43:44 -08:00
|
|
|
end
|
|
|
|
|
|
|
|
module Option : sig
|
|
|
|
type 'a t = 'a option
|
|
|
|
|
2018-07-11 04:50:02 -07:00
|
|
|
val is_none : 'a t -> bool
|
|
|
|
val is_some : 'a t -> bool
|
|
|
|
|
2015-12-30 06:43:44 -08:00
|
|
|
val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
|
|
|
|
|
|
|
|
val iter : ('a -> unit) -> 'a t -> unit
|
|
|
|
val map : ('a -> 'b) -> 'a t -> 'b t
|
|
|
|
val fold : ('a -> 'b -> 'b) -> 'a t -> 'b -> 'b
|
|
|
|
val value_default : ('a -> 'b) -> default:'b -> 'a t -> 'b
|
|
|
|
end
|
2017-08-01 00:04:03 -07:00
|
|
|
|
|
|
|
module Array : sig
|
|
|
|
val exists2 : ('a -> 'b -> bool) -> 'a array -> 'b array -> bool
|
|
|
|
(* Same as [Array.exists], but for a two-argument predicate. Raise
|
|
|
|
Invalid_argument if the two arrays are determined to have
|
|
|
|
different lengths. *)
|
|
|
|
end
|
2018-07-23 05:19:41 -07:00
|
|
|
|
|
|
|
module String : sig
|
|
|
|
include module type of String
|
|
|
|
module Set : Set.S with type elt = string
|
|
|
|
module Map : Map.S with type key = string
|
2018-11-13 05:43:38 -08:00
|
|
|
module Tbl : Hashtbl.S with type key = string
|
2018-09-18 06:49:18 -07:00
|
|
|
|
|
|
|
val for_all : (char -> bool) -> t -> bool
|
2018-07-23 05:19:41 -07:00
|
|
|
end
|
2018-08-27 04:42:14 -07:00
|
|
|
|
|
|
|
external compare : 'a -> 'a -> int = "%compare"
|
2015-12-30 06:43:44 -08:00
|
|
|
end
|
1999-11-30 08:07:38 -08:00
|
|
|
|
1995-05-04 03:15:53 -07:00
|
|
|
val find_in_path: string list -> string -> string
|
|
|
|
(* Search a file in a list of directories. *)
|
2014-10-15 06:34:58 -07:00
|
|
|
val find_in_path_rel: string list -> string -> string
|
|
|
|
(* Search a relative file in a list of directories. *)
|
2002-06-07 00:35:38 -07:00
|
|
|
val find_in_path_uncap: string list -> string -> string
|
|
|
|
(* Same, but search also for uncapitalized name, i.e.
|
|
|
|
if name is Foo.ml, allow /path/Foo.ml and /path/foo.ml
|
|
|
|
to match. *)
|
1995-05-04 03:15:53 -07:00
|
|
|
val remove_file: string -> unit
|
1996-01-04 04:51:11 -08:00
|
|
|
(* Delete the given file if it exists. Never raise an error. *)
|
2000-12-27 21:02:43 -08:00
|
|
|
val expand_directory: string -> string -> string
|
|
|
|
(* [expand_directory alt file] eventually expands a [+] at the
|
|
|
|
beginning of file into [alt] (an alternate root directory) *)
|
1995-05-04 03:15:53 -07:00
|
|
|
|
2018-06-19 12:30:56 -07:00
|
|
|
val split_path_contents: ?sep:char -> string -> string list
|
|
|
|
(* [split_path_contents ?sep s] interprets [s] as the value of a "PATH"-like
|
|
|
|
variable and returns the corresponding list of directories. [s] is split
|
|
|
|
using the platform-specific delimiter, or [~sep] if it is passed.
|
|
|
|
|
|
|
|
Returns the empty list if [s] is empty. *)
|
2018-06-15 02:47:14 -07:00
|
|
|
|
1995-05-04 03:15:53 -07:00
|
|
|
val create_hashtable: int -> ('a * 'b) list -> ('a, 'b) Hashtbl.t
|
|
|
|
(* Create a hashtable of the given size and fills it with the
|
|
|
|
given bindings. *)
|
|
|
|
|
|
|
|
val copy_file: in_channel -> out_channel -> unit
|
|
|
|
(* [copy_file ic oc] reads the contents of file [ic] and copies
|
|
|
|
them to [oc]. It stops when encountering EOF on [ic]. *)
|
|
|
|
val copy_file_chunk: in_channel -> out_channel -> int -> unit
|
|
|
|
(* [copy_file_chunk ic oc n] reads [n] bytes from [ic] and copies
|
|
|
|
them to [oc]. It raises [End_of_file] when encountering
|
|
|
|
EOF on [ic]. *)
|
2012-05-30 07:52:37 -07:00
|
|
|
val string_of_file: in_channel -> string
|
|
|
|
(* [string_of_file ic] reads the contents of file [ic] and copies
|
|
|
|
them to a string. It stops when encountering EOF on [ic]. *)
|
2017-09-06 11:01:15 -07:00
|
|
|
val output_to_file_via_temporary:
|
|
|
|
?mode:open_flag list -> string -> (string -> out_channel -> 'a) -> 'a
|
|
|
|
(* Produce output in temporary file, then rename it
|
|
|
|
(as atomically as possible) to the desired output file name.
|
|
|
|
[output_to_file_via_temporary filename fn] opens a temporary file
|
|
|
|
which is passed to [fn] (name + output channel). When [fn] returns,
|
|
|
|
the channel is closed and the temporary file is renamed to
|
|
|
|
[filename]. *)
|
|
|
|
|
1995-06-05 06:44:14 -07:00
|
|
|
val log2: int -> int
|
2010-01-22 04:48:24 -08:00
|
|
|
(* [log2 n] returns [s] such that [n = 1 lsl s]
|
1995-06-05 06:44:14 -07:00
|
|
|
if [n] is a power of 2*)
|
|
|
|
val align: int -> int -> int
|
|
|
|
(* [align n a] rounds [n] upwards to a multiple of [a]
|
|
|
|
(a power of 2). *)
|
1995-10-26 09:25:24 -07:00
|
|
|
val no_overflow_add: int -> int -> bool
|
|
|
|
(* [no_overflow_add n1 n2] returns [true] if the computation of
|
|
|
|
[n1 + n2] does not overflow. *)
|
|
|
|
val no_overflow_sub: int -> int -> bool
|
2017-03-28 06:33:41 -07:00
|
|
|
(* [no_overflow_sub n1 n2] returns [true] if the computation of
|
1995-10-26 09:25:24 -07:00
|
|
|
[n1 - n2] does not overflow. *)
|
2015-02-07 03:32:12 -08:00
|
|
|
val no_overflow_mul: int -> int -> bool
|
|
|
|
(* [no_overflow_mul n1 n2] returns [true] if the computation of
|
|
|
|
[n1 * n2] does not overflow. *)
|
|
|
|
val no_overflow_lsl: int -> int -> bool
|
|
|
|
(* [no_overflow_lsl n k] returns [true] if the computation of
|
|
|
|
[n lsl k] does not overflow. *)
|
2002-01-28 09:25:26 -08:00
|
|
|
|
2015-04-18 20:07:32 -07:00
|
|
|
module Int_literal_converter : sig
|
|
|
|
val int : string -> int
|
|
|
|
val int32 : string -> int32
|
|
|
|
val int64 : string -> int64
|
|
|
|
val nativeint : string -> nativeint
|
|
|
|
end
|
|
|
|
|
2007-02-23 05:44:51 -08:00
|
|
|
val chop_extensions: string -> string
|
|
|
|
(* Return the given file name without its extensions. The extensions
|
|
|
|
is the longest suffix starting with a period and not including
|
|
|
|
a directory separator, [.xyz.uvw] for instance.
|
|
|
|
|
|
|
|
Return the given name if it does not contain an extension. *)
|
|
|
|
|
2002-02-08 08:55:44 -08:00
|
|
|
val search_substring: string -> string -> int -> int
|
|
|
|
(* [search_substring pat str start] returns the position of the first
|
|
|
|
occurrence of string [pat] in string [str]. Search starts
|
|
|
|
at offset [start] in [str]. Raise [Not_found] if [pat]
|
|
|
|
does not occur. *)
|
2002-05-07 06:16:28 -07:00
|
|
|
|
2015-02-08 03:18:29 -08:00
|
|
|
val replace_substring: before:string -> after:string -> string -> string
|
2017-03-28 06:33:41 -07:00
|
|
|
(* [replace_substring ~before ~after str] replaces all
|
|
|
|
occurrences of [before] with [after] in [str] and returns
|
2015-09-11 04:58:31 -07:00
|
|
|
the resulting string. *)
|
2015-02-08 03:18:29 -08:00
|
|
|
|
2002-05-07 06:16:28 -07:00
|
|
|
val rev_split_words: string -> string list
|
2015-12-30 06:43:44 -08:00
|
|
|
(* [rev_split_words s] splits [s] in blank-separated words, and returns
|
2002-05-07 06:16:28 -07:00
|
|
|
the list of words in reverse order. *)
|
2011-12-28 06:20:53 -08:00
|
|
|
|
|
|
|
val get_ref: 'a list ref -> 'a list
|
|
|
|
(* [get_ref lr] returns the content of the list reference [lr] and reset
|
|
|
|
its content to the empty list. *)
|
2012-05-30 07:52:37 -07:00
|
|
|
|
2018-10-19 13:20:30 -07:00
|
|
|
val set_or_ignore : ('a -> 'b option) -> 'b option ref -> 'a -> unit
|
|
|
|
(* [set_or_ignore f opt x] sets [opt] to [f x] if it returns [Some _],
|
|
|
|
or leaves it unmodified if it returns [None]. *)
|
2012-05-30 07:52:37 -07:00
|
|
|
|
|
|
|
val fst3: 'a * 'b * 'c -> 'a
|
|
|
|
val snd3: 'a * 'b * 'c -> 'b
|
|
|
|
val thd3: 'a * 'b * 'c -> 'c
|
|
|
|
|
|
|
|
val fst4: 'a * 'b * 'c * 'd -> 'a
|
|
|
|
val snd4: 'a * 'b * 'c * 'd -> 'b
|
|
|
|
val thd4: 'a * 'b * 'c * 'd -> 'c
|
2013-04-29 22:26:57 -07:00
|
|
|
val for4: 'a * 'b * 'c * 'd -> 'd
|
2012-10-16 06:54:24 -07:00
|
|
|
|
2013-04-17 02:07:00 -07:00
|
|
|
module LongString :
|
|
|
|
sig
|
2014-04-29 04:56:17 -07:00
|
|
|
type t = bytes array
|
2013-04-17 02:07:00 -07:00
|
|
|
val create : int -> t
|
|
|
|
val length : t -> int
|
|
|
|
val get : t -> int -> char
|
|
|
|
val set : t -> int -> char -> unit
|
|
|
|
val blit : t -> int -> t -> int -> int -> unit
|
2018-04-13 09:09:03 -07:00
|
|
|
val blit_string : string -> int -> t -> int -> int -> unit
|
2013-04-17 02:07:00 -07:00
|
|
|
val output : out_channel -> t -> int -> int -> unit
|
2018-04-13 08:11:23 -07:00
|
|
|
val input_bytes_into : t -> in_channel -> int -> unit
|
2013-04-17 02:07:00 -07:00
|
|
|
val input_bytes : in_channel -> int -> t
|
|
|
|
end
|
2012-10-16 06:54:24 -07:00
|
|
|
|
|
|
|
val edit_distance : string -> string -> int -> int option
|
|
|
|
(** [edit_distance a b cutoff] computes the edit distance between
|
|
|
|
strings [a] and [b]. To help efficiency, it uses a cutoff: if the
|
|
|
|
distance [d] is smaller than [cutoff], it returns [Some d], else
|
|
|
|
[None].
|
|
|
|
|
|
|
|
The distance algorithm currently used is Damerau-Levenshtein: it
|
|
|
|
computes the number of insertion, deletion, substitution of
|
|
|
|
letters, or swapping of adjacent letters to go from one word to the
|
|
|
|
other. The particular algorithm may change in the future.
|
|
|
|
*)
|
2013-06-05 10:54:20 -07:00
|
|
|
|
2014-12-13 06:46:16 -08:00
|
|
|
val spellcheck : string list -> string -> string list
|
|
|
|
(** [spellcheck env name] takes a list of names [env] that exist in
|
|
|
|
the current environment and an erroneous [name], and returns a
|
|
|
|
list of suggestions taken from [env], that are close enough to
|
|
|
|
[name] that it may be a typo for one of them. *)
|
|
|
|
|
|
|
|
val did_you_mean : Format.formatter -> (unit -> string list) -> unit
|
|
|
|
(** [did_you_mean ppf get_choices] hints that the user may have meant
|
|
|
|
one of the option returned by calling [get_choices]. It does nothing
|
|
|
|
if the returned list is empty.
|
|
|
|
|
|
|
|
The [unit -> ...] thunking is meant to delay any potentially-slow
|
|
|
|
computation (typically computing edit-distance with many things
|
|
|
|
from the current environment) to when the hint message is to be
|
|
|
|
printed. You should print an understandable error message before
|
|
|
|
calling [did_you_mean], so that users get a clear notification of
|
|
|
|
the failure even if producing the hint is slow.
|
|
|
|
*)
|
|
|
|
|
2013-06-05 10:54:20 -07:00
|
|
|
val cut_at : string -> char -> string * string
|
|
|
|
(** [String.cut_at s c] returns a pair containing the sub-string before
|
|
|
|
the first occurrence of [c] in [s], and the sub-string after the
|
|
|
|
first occurrence of [c] in [s].
|
|
|
|
[let (before, after) = String.cut_at s c in
|
|
|
|
before ^ String.make 1 c ^ after] is the identity if [s] contains [c].
|
|
|
|
|
|
|
|
Raise [Not_found] if the character does not appear in the string
|
|
|
|
@since 4.01
|
|
|
|
*)
|
2014-08-29 07:35:10 -07:00
|
|
|
|
2015-08-15 08:57:49 -07:00
|
|
|
(* Color handling *)
|
|
|
|
module Color : sig
|
|
|
|
type color =
|
|
|
|
| Black
|
|
|
|
| Red
|
|
|
|
| Green
|
|
|
|
| Yellow
|
|
|
|
| Blue
|
|
|
|
| Magenta
|
|
|
|
| Cyan
|
|
|
|
| White
|
|
|
|
;;
|
|
|
|
|
|
|
|
type style =
|
|
|
|
| FG of color (* foreground *)
|
|
|
|
| BG of color (* background *)
|
|
|
|
| Bold
|
|
|
|
| Reset
|
|
|
|
|
|
|
|
val ansi_of_style_l : style list -> string
|
|
|
|
(* ANSI escape sequence for the given style *)
|
|
|
|
|
|
|
|
type styles = {
|
|
|
|
error: style list;
|
|
|
|
warning: style list;
|
|
|
|
loc: style list;
|
|
|
|
}
|
|
|
|
|
|
|
|
val default_styles: styles
|
|
|
|
val get_styles: unit -> styles
|
|
|
|
val set_styles: styles -> unit
|
|
|
|
|
2016-01-12 05:35:17 -08:00
|
|
|
type setting = Auto | Always | Never
|
|
|
|
|
2019-02-27 05:28:06 -08:00
|
|
|
val default_setting : setting
|
|
|
|
|
Respect OCAML_COLOR environment variable for deciding whether to use colors
Since 4.03, OCaml supports coloring its messages to standard output and standard
error, depending on the "-color" argument ({always,never,auto}). This commit
adds support for the environment variable "OCAML_COLOR" (which value can as well
be {always,never,auto}).
The command line argument "-color" takes precedence, "OCAML_COLOR" is only
taken into consideration if no "-color" is provided.
The motivation for this is that the user should have control over coloring
OCaml's output messages. OCamlbuild, a widely used build tool executes OCaml
not under a tty (and OCaml does not colorize errors and warnings), which lead
various packages use `color(always)` in their `_tags` files, which breaks with
other (non-interactive) programs (i.e. editor helpers).
Further discussion was done at https://github.com/ocaml/ocamlbuild/issues/87 and
https://github.com/ocaml/ocaml/pull/1098.
2017-03-11 03:38:59 -08:00
|
|
|
val setup : setting option -> unit
|
2015-08-15 08:57:51 -07:00
|
|
|
(* [setup opt] will enable or disable color handling on standard formatters
|
|
|
|
according to the value of color setting [opt].
|
2015-08-15 08:57:49 -07:00
|
|
|
Only the first call to this function has an effect. *)
|
|
|
|
|
|
|
|
val set_color_tag_handling : Format.formatter -> unit
|
|
|
|
(* adds functions to support color tags to the given formatter. *)
|
|
|
|
end
|
2015-12-23 02:57:10 -08:00
|
|
|
|
2018-10-19 13:20:30 -07:00
|
|
|
(* See the -error-style option *)
|
|
|
|
module Error_style : sig
|
|
|
|
type setting =
|
|
|
|
| Contextual
|
|
|
|
| Short
|
2019-02-27 05:28:06 -08:00
|
|
|
|
|
|
|
val default_setting : setting
|
2018-10-19 13:20:30 -07:00
|
|
|
end
|
|
|
|
|
2015-12-23 02:57:10 -08:00
|
|
|
val normalise_eol : string -> string
|
2016-01-18 08:40:03 -08:00
|
|
|
(** [normalise_eol s] returns a fresh copy of [s] with any '\r' characters
|
|
|
|
removed. Intended for pre-processing text which will subsequently be printed
|
|
|
|
on a channel which performs EOL transformations (i.e. Windows) *)
|
2016-02-24 09:29:47 -08:00
|
|
|
|
|
|
|
val delete_eol_spaces : string -> string
|
2016-08-01 07:06:59 -07:00
|
|
|
(** [delete_eol_spaces s] returns a fresh copy of [s] with any end of
|
|
|
|
line spaces removed. Intended to normalize the output of the
|
|
|
|
toplevel for tests. *)
|
2016-06-29 08:13:54 -07:00
|
|
|
|
2018-10-07 02:47:38 -07:00
|
|
|
val pp_two_columns :
|
|
|
|
?sep:string -> ?max_lines:int ->
|
|
|
|
Format.formatter -> (string * string) list -> unit
|
|
|
|
(** [pp_two_columns ?sep ?max_lines ppf l] prints the lines in [l] as two
|
|
|
|
columns separated by [sep] ("|" by default). [max_lines] can be used to
|
|
|
|
indicate a maximum number of lines to print -- an ellipsis gets inserted at
|
|
|
|
the middle if the input has too many lines.
|
|
|
|
|
|
|
|
Example:
|
|
|
|
|
|
|
|
{v pp_two_columns ~max_lines:3 Format.std_formatter [
|
|
|
|
"abc", "hello";
|
|
|
|
"def", "zzz";
|
|
|
|
"a" , "bllbl";
|
|
|
|
"bb" , "dddddd";
|
|
|
|
] v}
|
|
|
|
|
|
|
|
prints
|
|
|
|
|
|
|
|
{v
|
|
|
|
abc | hello
|
|
|
|
...
|
|
|
|
bb | dddddd
|
|
|
|
v}
|
|
|
|
*)
|
2016-06-29 08:13:54 -07:00
|
|
|
|
ocamlc -config: new -config-var option to print specific configuration variables
The proposed behavior of `-config-var s` is as follows:
- if `s` is an existing configuration variable, print its value as
a string and exit with a success return value (0)
- if `s` is not an existing configuration variable, print nothing
and exit with a failure return value (non-0)
Note that we do not print a newline after the value of the
configuration variable. In particular, if the value is an empty
string, the output is undistinguishable from the output for
non-existing variables, the return value has to be considered instead.
The following alternative behaviors were considered:
- We could print a newline after the configuration value, which
would let users distinguish empty values from non-existing variables
by counting the lines of output, and would also be more pleasant for
users invoking the option from the command-line. However, the way
bash works on Windows means that $(ocamlc -config-var foo) would keep
a trailing \r in its output, and portable scripts would have to use
$(ocamlc -config-var foo | tr -d '\r') instead, which is a pain.
(This issue was pointed out by David Allsopp)
- We could print a message on the error output if the configuration
variable does not exist. This is clearer to a human user, but it is
annoying for scripts if they forget to silence the error output and
get their output mixed with our error messages. The main use of this
new feature is for scripting purposes.
2017-10-14 09:46:58 -07:00
|
|
|
(** configuration variables *)
|
|
|
|
val show_config_and_exit : unit -> unit
|
|
|
|
val show_config_variable_and_exit : string -> unit
|
2018-07-27 03:25:23 -07:00
|
|
|
|
|
|
|
val get_build_path_prefix_map: unit -> Build_path_prefix_map.map option
|
|
|
|
(** Returns the map encoded in the [BUILD_PATH_PREFIX_MAP] environment
|
|
|
|
variable. *)
|
|
|
|
|
|
|
|
val debug_prefix_map_flags: unit -> string list
|
|
|
|
(** Returns the list of [--debug-prefix-map] flags to be passed to the
|
|
|
|
assembler, built from the [BUILD_PATH_PREFIX_MAP] environment variable. *)
|
2016-05-03 09:51:07 -07:00
|
|
|
|
|
|
|
val print_if :
|
|
|
|
Format.formatter -> bool ref -> (Format.formatter -> 'a -> unit) -> 'a -> 'a
|
|
|
|
(** [print_if ppf flag fmt x] prints [x] with [fmt] on [ppf] if [b] is true. *)
|
2019-01-27 03:38:02 -08:00
|
|
|
|
2019-01-26 14:02:11 -08:00
|
|
|
|
2019-01-27 03:38:02 -08:00
|
|
|
type filepath = string
|
|
|
|
type modname = string
|
|
|
|
type crcs = (modname * Digest.t option) list
|
|
|
|
|
|
|
|
type alerts = string Stdlib.String.Map.t
|
2019-01-26 14:02:11 -08:00
|
|
|
|
|
|
|
|
|
|
|
module EnvLazy: sig
|
|
|
|
type ('a,'b) t
|
|
|
|
|
|
|
|
type log
|
|
|
|
|
|
|
|
val force : ('a -> 'b) -> ('a,'b) t -> 'b
|
|
|
|
val create : 'a -> ('a,'b) t
|
|
|
|
val get_arg : ('a,'b) t -> 'a option
|
|
|
|
val create_forced : 'b -> ('a, 'b) t
|
|
|
|
val create_failed : exn -> ('a, 'b) t
|
|
|
|
|
|
|
|
(* [force_logged log f t] is equivalent to [force f t] but if [f] returns
|
|
|
|
[None] then [t] is recorded in [log]. [backtrack log] will then reset all
|
|
|
|
the recorded [t]s back to their original state. *)
|
|
|
|
val log : unit -> log
|
|
|
|
val force_logged : log -> ('a -> 'b option) -> ('a,'b option) t -> 'b option
|
|
|
|
val backtrack : log -> unit
|
|
|
|
|
|
|
|
end
|