1(**************************************************************************) 2(* *) 3(* OCaml *) 4(* *) 5(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) 6(* *) 7(* Copyright 1996 Institut National de Recherche en Informatique et *) 8(* en Automatique. *) 9(* *) 10(* All rights reserved. This file is distributed under the terms of *) 11(* the GNU Lesser General Public License version 2.1, with the *) 12(* special exception on linking described in the file LICENSE. *) 13(* *) 14(**************************************************************************) 15 16(* Miscellaneous useful types and functions *) 17 18val fatal_error: string -> 'a 19val fatal_errorf: ('a, Format.formatter, unit, 'b) format4 -> 'a 20exception Fatal_error 21 22val try_finally : (unit -> 'a) -> (unit -> unit) -> 'a;; 23 24val map_end: ('a -> 'b) -> 'a list -> 'b list -> 'b list 25 (* [map_end f l t] is [map f l @ t], just more efficient. *) 26val map_left_right: ('a -> 'b) -> 'a list -> 'b list 27 (* Like [List.map], with guaranteed left-to-right evaluation order *) 28val for_all2: ('a -> 'b -> bool) -> 'a list -> 'b list -> bool 29 (* Same as [List.for_all] but for a binary predicate. 30 In addition, this [for_all2] never fails: given two lists 31 with different lengths, it returns false. *) 32val replicate_list: 'a -> int -> 'a list 33 (* [replicate_list elem n] is the list with [n] elements 34 all identical to [elem]. *) 35val list_remove: 'a -> 'a list -> 'a list 36 (* [list_remove x l] returns a copy of [l] with the first 37 element equal to [x] removed. *) 38val split_last: 'a list -> 'a list * 'a 39 (* Return the last element and the other elements of the given list. *) 40val may: ('a -> unit) -> 'a option -> unit 41val may_map: ('a -> 'b) -> 'a option -> 'b option 42 43type ref_and_value = R : 'a ref * 'a -> ref_and_value 44 45val protect_refs : ref_and_value list -> (unit -> 'a) -> 'a 46(** [protect_refs l f] temporarily sets [r] to [v] for each [R (r, v)] in [l] 47 while executing [f]. The previous contents of the references is restored 48 even if [f] raises an exception. *) 49 50module Stdlib : sig 51 module List : sig 52 type 'a t = 'a list 53 54 val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int 55 (** The lexicographic order supported by the provided order. 56 There is no constraint on the relative lengths of the lists. *) 57 58 val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool 59 (** Returns [true] iff the given lists have the same length and content 60 with respect to the given equality function. *) 61 62 val filter_map : ('a -> 'b option) -> 'a t -> 'b t 63 (** [filter_map f l] applies [f] to every element of [l], filters 64 out the [None] elements and returns the list of the arguments of 65 the [Some] elements. *) 66 67 val some_if_all_elements_are_some : 'a option t -> 'a t option 68 (** If all elements of the given list are [Some _] then [Some xs] 69 is returned with the [xs] being the contents of those [Some]s, with 70 order preserved. Otherwise return [None]. *) 71 72 val map2_prefix : ('a -> 'b -> 'c) -> 'a t -> 'b t -> ('c t * 'b t) 73 (** [let r1, r2 = map2_prefix f l1 l2] 74 If [l1] is of length n and [l2 = h2 @ t2] with h2 of length n, 75 r1 is [List.map2 f l1 h1] and r2 is t2. *) 76 77 val split_at : int -> 'a t -> 'a t * 'a t 78 (** [split_at n l] returns the pair [before, after] where [before] is 79 the [n] first elements of [l] and [after] the remaining ones. 80 If [l] has less than [n] elements, raises Invalid_argument. *) 81 end 82 83 module Option : sig 84 type 'a t = 'a option 85 86 val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool 87 88 val iter : ('a -> unit) -> 'a t -> unit 89 val map : ('a -> 'b) -> 'a t -> 'b t 90 val fold : ('a -> 'b -> 'b) -> 'a t -> 'b -> 'b 91 val value_default : ('a -> 'b) -> default:'b -> 'a t -> 'b 92 end 93end 94 95val find_in_path: string list -> string -> string 96 (* Search a file in a list of directories. *) 97val find_in_path_rel: string list -> string -> string 98 (* Search a relative file in a list of directories. *) 99val find_in_path_uncap: string list -> string -> string 100 (* Same, but search also for uncapitalized name, i.e. 101 if name is Foo.ml, allow /path/Foo.ml and /path/foo.ml 102 to match. *) 103val remove_file: string -> unit 104 (* Delete the given file if it exists. Never raise an error. *) 105val expand_directory: string -> string -> string 106 (* [expand_directory alt file] eventually expands a [+] at the 107 beginning of file into [alt] (an alternate root directory) *) 108 109val create_hashtable: int -> ('a * 'b) list -> ('a, 'b) Hashtbl.t 110 (* Create a hashtable of the given size and fills it with the 111 given bindings. *) 112 113val copy_file: in_channel -> out_channel -> unit 114 (* [copy_file ic oc] reads the contents of file [ic] and copies 115 them to [oc]. It stops when encountering EOF on [ic]. *) 116val copy_file_chunk: in_channel -> out_channel -> int -> unit 117 (* [copy_file_chunk ic oc n] reads [n] bytes from [ic] and copies 118 them to [oc]. It raises [End_of_file] when encountering 119 EOF on [ic]. *) 120val string_of_file: in_channel -> string 121 (* [string_of_file ic] reads the contents of file [ic] and copies 122 them to a string. It stops when encountering EOF on [ic]. *) 123val log2: int -> int 124 (* [log2 n] returns [s] such that [n = 1 lsl s] 125 if [n] is a power of 2*) 126val align: int -> int -> int 127 (* [align n a] rounds [n] upwards to a multiple of [a] 128 (a power of 2). *) 129val no_overflow_add: int -> int -> bool 130 (* [no_overflow_add n1 n2] returns [true] if the computation of 131 [n1 + n2] does not overflow. *) 132val no_overflow_sub: int -> int -> bool 133 (* [no_overflow_sub n1 n2] returns [true] if the computation of 134 [n1 - n2] does not overflow. *) 135val no_overflow_mul: int -> int -> bool 136 (* [no_overflow_mul n1 n2] returns [true] if the computation of 137 [n1 * n2] does not overflow. *) 138val no_overflow_lsl: int -> int -> bool 139 (* [no_overflow_lsl n k] returns [true] if the computation of 140 [n lsl k] does not overflow. *) 141 142module Int_literal_converter : sig 143 val int : string -> int 144 val int32 : string -> int32 145 val int64 : string -> int64 146 val nativeint : string -> nativeint 147end 148 149val chop_extensions: string -> string 150 (* Return the given file name without its extensions. The extensions 151 is the longest suffix starting with a period and not including 152 a directory separator, [.xyz.uvw] for instance. 153 154 Return the given name if it does not contain an extension. *) 155 156val search_substring: string -> string -> int -> int 157 (* [search_substring pat str start] returns the position of the first 158 occurrence of string [pat] in string [str]. Search starts 159 at offset [start] in [str]. Raise [Not_found] if [pat] 160 does not occur. *) 161 162val replace_substring: before:string -> after:string -> string -> string 163 (* [replace_substring ~before ~after str] replaces all 164 occurrences of [before] with [after] in [str] and returns 165 the resulting string. *) 166 167val rev_split_words: string -> string list 168 (* [rev_split_words s] splits [s] in blank-separated words, and returns 169 the list of words in reverse order. *) 170 171val get_ref: 'a list ref -> 'a list 172 (* [get_ref lr] returns the content of the list reference [lr] and reset 173 its content to the empty list. *) 174 175 176val fst3: 'a * 'b * 'c -> 'a 177val snd3: 'a * 'b * 'c -> 'b 178val thd3: 'a * 'b * 'c -> 'c 179 180val fst4: 'a * 'b * 'c * 'd -> 'a 181val snd4: 'a * 'b * 'c * 'd -> 'b 182val thd4: 'a * 'b * 'c * 'd -> 'c 183val for4: 'a * 'b * 'c * 'd -> 'd 184 185module LongString : 186 sig 187 type t = bytes array 188 val create : int -> t 189 val length : t -> int 190 val get : t -> int -> char 191 val set : t -> int -> char -> unit 192 val blit : t -> int -> t -> int -> int -> unit 193 val output : out_channel -> t -> int -> int -> unit 194 val unsafe_blit_to_bytes : t -> int -> bytes -> int -> int -> unit 195 val input_bytes : in_channel -> int -> t 196 end 197 198val edit_distance : string -> string -> int -> int option 199(** [edit_distance a b cutoff] computes the edit distance between 200 strings [a] and [b]. To help efficiency, it uses a cutoff: if the 201 distance [d] is smaller than [cutoff], it returns [Some d], else 202 [None]. 203 204 The distance algorithm currently used is Damerau-Levenshtein: it 205 computes the number of insertion, deletion, substitution of 206 letters, or swapping of adjacent letters to go from one word to the 207 other. The particular algorithm may change in the future. 208*) 209 210val spellcheck : string list -> string -> string list 211(** [spellcheck env name] takes a list of names [env] that exist in 212 the current environment and an erroneous [name], and returns a 213 list of suggestions taken from [env], that are close enough to 214 [name] that it may be a typo for one of them. *) 215 216val did_you_mean : Format.formatter -> (unit -> string list) -> unit 217(** [did_you_mean ppf get_choices] hints that the user may have meant 218 one of the option returned by calling [get_choices]. It does nothing 219 if the returned list is empty. 220 221 The [unit -> ...] thunking is meant to delay any potentially-slow 222 computation (typically computing edit-distance with many things 223 from the current environment) to when the hint message is to be 224 printed. You should print an understandable error message before 225 calling [did_you_mean], so that users get a clear notification of 226 the failure even if producing the hint is slow. 227*) 228 229val cut_at : string -> char -> string * string 230(** [String.cut_at s c] returns a pair containing the sub-string before 231 the first occurrence of [c] in [s], and the sub-string after the 232 first occurrence of [c] in [s]. 233 [let (before, after) = String.cut_at s c in 234 before ^ String.make 1 c ^ after] is the identity if [s] contains [c]. 235 236 Raise [Not_found] if the character does not appear in the string 237 @since 4.01 238*) 239 240 241module StringSet: Set.S with type elt = string 242module StringMap: Map.S with type key = string 243(* TODO: replace all custom instantiations of StringSet/StringMap in various 244 compiler modules with this one. *) 245 246(* Color handling *) 247module Color : sig 248 type color = 249 | Black 250 | Red 251 | Green 252 | Yellow 253 | Blue 254 | Magenta 255 | Cyan 256 | White 257 ;; 258 259 type style = 260 | FG of color (* foreground *) 261 | BG of color (* background *) 262 | Bold 263 | Reset 264 265 val ansi_of_style_l : style list -> string 266 (* ANSI escape sequence for the given style *) 267 268 type styles = { 269 error: style list; 270 warning: style list; 271 loc: style list; 272 } 273 274 val default_styles: styles 275 val get_styles: unit -> styles 276 val set_styles: styles -> unit 277 278 type setting = Auto | Always | Never 279 280 val setup : setting option -> unit 281 (* [setup opt] will enable or disable color handling on standard formatters 282 according to the value of color setting [opt]. 283 Only the first call to this function has an effect. *) 284 285 val set_color_tag_handling : Format.formatter -> unit 286 (* adds functions to support color tags to the given formatter. *) 287end 288 289val normalise_eol : string -> string 290(** [normalise_eol s] returns a fresh copy of [s] with any '\r' characters 291 removed. Intended for pre-processing text which will subsequently be printed 292 on a channel which performs EOL transformations (i.e. Windows) *) 293 294val delete_eol_spaces : string -> string 295(** [delete_eol_spaces s] returns a fresh copy of [s] with any end of 296 line spaces removed. Intended to normalize the output of the 297 toplevel for tests. *) 298 299 300 301(** {2 Hook machinery} *) 302 303(* Hooks machinery: 304 [add_hook name f] will register a function that will be called on the 305 argument of a later call to [apply_hooks]. Hooks are applied in the 306 lexicographical order of their names. 307*) 308 309type hook_info = { 310 sourcefile : string; 311} 312 313exception HookExnWrapper of 314 { 315 error: exn; 316 hook_name: string; 317 hook_info: hook_info; 318 } 319 (** An exception raised by a hook will be wrapped into a 320 [HookExnWrapper] constructor by the hook machinery. *) 321 322 323val raise_direct_hook_exn: exn -> 'a 324 (** A hook can use [raise_unwrapped_hook_exn] to raise an exception that will 325 not be wrapped into a {!HookExnWrapper}. *) 326 327module type HookSig = sig 328 type t 329 val add_hook : string -> (hook_info -> t -> t) -> unit 330 val apply_hooks : hook_info -> t -> t 331end 332 333module MakeHooks : functor (M : sig type t end) -> HookSig with type t = M.t 334