diff --git a/vendor/fmt/LICENSE.md b/vendor/fmt/LICENSE.md deleted file mode 100644 index 52fe16df4b8..00000000000 --- a/vendor/fmt/LICENSE.md +++ /dev/null @@ -1,13 +0,0 @@ -Copyright (c) 2016 The fmt programmers - -Permission to use, copy, modify, and/or distribute this software for any -purpose with or without fee is hereby granted, provided that the above -copyright notice and this permission notice appear in all copies. - -THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. diff --git a/vendor/fmt/src/dune b/vendor/fmt/src/dune deleted file mode 100644 index f9968bc5bd8..00000000000 --- a/vendor/fmt/src/dune +++ /dev/null @@ -1,3 +0,0 @@ -(library - (name fmt) - (wrapped false)) diff --git a/vendor/fmt/src/fmt.ml b/vendor/fmt/src/fmt.ml deleted file mode 100644 index ef913720750..00000000000 --- a/vendor/fmt/src/fmt.ml +++ /dev/null @@ -1,801 +0,0 @@ -(*--------------------------------------------------------------------------- - Copyright (c) 2014 The fmt programmers. All rights reserved. - Distributed under the ISC license, see terms at the end of the file. - ---------------------------------------------------------------------------*) - -let invalid_arg' = invalid_arg - -(* Errors *) - -let err_str_formatter = "Format.str_formatter can't be set." - -(* Standard outputs *) - -let stdout = Format.std_formatter -let stderr = Format.err_formatter - -(* Formatting *) - -let pf = Format.fprintf -let pr = Format.printf -let epr = Format.eprintf -let str = Format.asprintf -let kpf = Format.kfprintf -let kstr = Format.kasprintf -let failwith fmt = kstr failwith fmt -let failwith_notrace fmt = kstr (fun s -> raise_notrace (Failure s)) fmt -let invalid_arg fmt = kstr invalid_arg fmt -let error fmt = kstr (fun s -> Error s) fmt -let error_msg fmt = kstr (fun s -> Error (`Msg s)) fmt - -(* Formatters *) - -type 'a t = Format.formatter -> 'a -> unit - -let flush ppf _ = Format.pp_print_flush ppf () -let nop fmt ppf = () -let any fmt ppf _ = pf ppf fmt -let using f pp ppf v = pp ppf (f v) -let const pp_v v ppf _ = pp_v ppf v -let fmt fmt ppf = pf ppf fmt - -(* Separators *) - -let cut ppf _ = Format.pp_print_cut ppf () -let sp ppf _ = Format.pp_print_space ppf () -let sps n ppf _ = Format.pp_print_break ppf n 0 -let comma ppf _ = Format.pp_print_string ppf ","; sp ppf () -let semi ppf _ = Format.pp_print_string ppf ";"; sp ppf () - -(* Sequencing *) - -let iter ?sep:(pp_sep = cut) iter pp_elt ppf v = - let is_first = ref true in - let pp_elt v = - if !is_first then (is_first := false) else pp_sep ppf (); - pp_elt ppf v - in - iter pp_elt v - -let iter_bindings ?sep:(pp_sep = cut) iter pp_binding ppf v = - let is_first = ref true in - let pp_binding k v = - if !is_first then (is_first := false) else pp_sep ppf (); - pp_binding ppf (k, v) - in - iter pp_binding v - -let append pp_v0 pp_v1 ppf v = pp_v0 ppf v; pp_v1 ppf v -let ( ++ ) = append -let concat ?sep pps ppf v = iter ?sep List.iter (fun ppf pp -> pp ppf v) ppf pps - -(* Boxes *) - -let box ?(indent = 0) pp_v ppf v = - Format.(pp_open_box ppf indent; pp_v ppf v; pp_close_box ppf ()) - -let hbox pp_v ppf v = - Format.(pp_open_hbox ppf (); pp_v ppf v; pp_close_box ppf ()) - -let vbox ?(indent = 0) pp_v ppf v = - Format.(pp_open_vbox ppf indent; pp_v ppf v; pp_close_box ppf ()) - -let hvbox ?(indent = 0) pp_v ppf v = - Format.(pp_open_hvbox ppf indent; pp_v ppf v; pp_close_box ppf ()) - -let hovbox ?(indent = 0) pp_v ppf v = - Format.(pp_open_hovbox ppf indent; pp_v ppf v; pp_close_box ppf ()) - -(* Brackets *) - -let surround s1 s2 pp_v ppf v = - Format.(pp_print_string ppf s1; pp_v ppf v; pp_print_string ppf s2) - -let parens pp_v = box ~indent:1 (surround "(" ")" pp_v) -let brackets pp_v = box ~indent:1 (surround "[" "]" pp_v) -let oxford_brackets pp_v = box ~indent:2 (surround "[|" "|]" pp_v) -let braces pp_v = box ~indent:1 (surround "{" "}" pp_v) -let quote ?(mark = "\"") pp_v = - let pp_mark ppf _ = Format.pp_print_as ppf 1 mark in - box ~indent:1 (pp_mark ++ pp_v ++ pp_mark) - -(* Stdlib types formatters *) - -let bool = Format.pp_print_bool -let int = Format.pp_print_int -let nativeint ppf v = pf ppf "%nd" v -let int32 ppf v = pf ppf "%ld" v -let int64 ppf v = pf ppf "%Ld" v -let uint ppf v = pf ppf "%u" v -let uint32 ppf v = pf ppf "%lu" v -let uint64 ppf v = pf ppf "%Lu" v -let unativeint ppf v = pf ppf "%nu" v -let char = Format.pp_print_char -let string = Format.pp_print_string -let buffer ppf b = string ppf (Buffer.contents b) -let exn ppf e = string ppf (Printexc.to_string e) -let exn_backtrace ppf (e, bt) = - let pp_backtrace_str ppf s = - let stop = String.length s - 1 (* there's a newline at the end *) in - let rec loop left right = - if right = stop then string ppf (String.sub s left (right - left)) else - if s.[right] <> '\n' then loop left (right + 1) else - begin - string ppf (String.sub s left (right - left)); - cut ppf (); - loop (right + 1) (right + 1) - end - in - if s = "" then (string ppf "No backtrace available.") else - loop 0 0 - in - pf ppf "@[Exception: %a@,%a@]" - exn e pp_backtrace_str (Printexc.raw_backtrace_to_string bt) - -let float ppf v = pf ppf "%g" v -let round x = floor (x +. 0.5) -let round_dfrac d x = - if x -. (round x) = 0. then x else (* x is an integer. *) - let m = 10. ** (float_of_int d) in (* m moves 10^-d to 1. *) - (floor ((x *. m) +. 0.5)) /. m - -let round_dsig d x = - if x = 0. then 0. else - let m = 10. ** (floor (log10 (abs_float x))) in (* to normalize x. *) - (round_dfrac d (x /. m)) *. m - -let float_dfrac d ppf f = pf ppf "%g" (round_dfrac d f) -let float_dsig d ppf f = pf ppf "%g" (round_dsig d f) - -let pair ?sep:(pp_sep = cut) pp_fst pp_snd ppf (fst, snd) = - pp_fst ppf fst; pp_sep ppf (); pp_snd ppf snd - -let option ?none:(pp_none = nop) pp_v ppf = function -| None -> pp_none ppf () -| Some v -> pp_v ppf v - -let result ~ok ~error ppf = function -| Ok v -> ok ppf v -| Error e -> error ppf e - -let list ?sep pp_elt = iter ?sep List.iter pp_elt -let array ?sep pp_elt = iter ?sep Array.iter pp_elt -let seq ?sep pp_elt = iter ?sep Seq.iter pp_elt -let hashtbl ?sep pp_binding = iter_bindings ?sep Hashtbl.iter pp_binding -let queue ?sep pp_elt = iter Queue.iter pp_elt -let stack ?sep pp_elt = iter Stack.iter pp_elt - -(* Stdlib type dumpers *) - -module Dump = struct - - (* Stdlib types *) - - let sig_names = - Sys.[ sigabrt, "SIGABRT"; sigalrm, "SIGALRM"; sigfpe, "SIGFPE"; - sighup, "SIGHUP"; sigill, "SIGILL"; sigint, "SIGINT"; - sigkill, "SIGKILL"; sigpipe, "SIGPIPE"; sigquit, "SIGQUIT"; - sigsegv, "SIGSEGV"; sigterm, "SIGTERM"; sigusr1, "SIGUSR1"; - sigusr2, "SIGUSR2"; sigchld, "SIGCHLD"; sigcont, "SIGCONT"; - sigstop, "SIGSTOP"; sigtstp, "SIGTSTP"; sigttin, "SIGTTIN"; - sigttou, "SIGTTOU"; sigvtalrm, "SIGVTALRM"; sigprof, "SIGPROF"; - sigbus, "SIGBUS"; sigpoll, "SIGPOLL"; sigsys, "SIGSYS"; - sigtrap, "SIGTRAP"; sigurg, "SIGURG"; sigxcpu, "SIGXCPU"; - sigxfsz, "SIGXFSZ"; ] - - let signal ppf s = match List.assq_opt s sig_names with - | Some name -> string ppf name - | None -> pf ppf "SIG(%d)" s - - let uchar ppf u = pf ppf "U+%04X" (Uchar.to_int u) - let string ppf s = pf ppf "%S" s - let pair pp_fst pp_snd = - parens (using fst (box pp_fst) ++ comma ++ using snd (box pp_snd)) - - let option pp_v ppf = function - | None -> pf ppf "None" - | Some v -> pf ppf "@[<2>Some@ @[%a@]@]" pp_v v - - let result ~ok ~error ppf = function - | Ok v -> pf ppf "@[<2>Ok@ @[%a@]@]" ok v - | Error e -> pf ppf "@[<2>Error@ @[%a@]@]" error e - - (* Sequencing *) - - let iter iter_f pp_name pp_elt = - let pp_v = iter ~sep:sp iter_f (box pp_elt) in - parens (pp_name ++ sp ++ pp_v) - - let iter_bindings iter_f pp_name pp_k pp_v = - let pp_v = iter_bindings ~sep:sp iter_f (pair pp_k pp_v) in - parens (pp_name ++ sp ++ pp_v) - - (* Stdlib data structures *) - - let list pp_elt = brackets (list ~sep:semi (box pp_elt)) - let array pp_elt = oxford_brackets (array ~sep:semi (box pp_elt)) - let seq pp_elt = brackets (seq ~sep:semi (box pp_elt)) - - let hashtbl pp_k pp_v = - iter_bindings Hashtbl.iter (any "hashtbl") pp_k pp_v - - let stack pp_elt = iter Stack.iter (any "stack") pp_elt - let queue pp_elt = iter Queue.iter (any "queue") pp_elt - - (* Records *) - - let field ?(label = string) l prj pp_v ppf v = - pf ppf "@[<1>%a =@ %a@]" label l pp_v (prj v) - - let record pps = - box ~indent:2 (surround "{ " " }" @@ vbox (concat ~sep:(any ";@,") pps)) -end - -(* Magnitudes *) - -let ilog10 x = - let rec loop p x = if x = 0 then p else loop (p + 1) (x / 10) in - loop (-1) x - -let ipow10 n = - let rec loop acc n = if n = 0 then acc else loop (acc * 10) (n - 1) in - loop 1 n - -let si_symb_max = 16 -let si_symb = - [| "y"; "z"; "a"; "f"; "p"; "n"; "u"; "m"; ""; "k"; "M"; "G"; "T"; "P"; - "E"; "Z"; "Y"|] - -let rec pp_at_factor ~scale u symb factor ppf s = - let m = s / factor in - let n = s mod factor in - match m with - | m when m >= 100 -> (* No fractional digit *) - let m_up = if n > 0 then m + 1 else m in - if m_up >= 1000 then si_size ~scale u ppf (m_up * factor) else - pf ppf "%d%s%s" m_up symb u - | m when m >= 10 -> (* One fractional digit w.o. trailing 0 *) - let f_factor = factor / 10 in - let f_m = n / f_factor in - let f_n = n mod f_factor in - let f_m_up = if f_n > 0 then f_m + 1 else f_m in - begin match f_m_up with - | 0 -> pf ppf "%d%s%s" m symb u - | f when f >= 10 -> si_size ~scale u ppf (m * factor + f * f_factor) - | f -> pf ppf "%d.%d%s%s" m f symb u - end - | m -> (* Two or zero fractional digits w.o. trailing 0 *) - let f_factor = factor / 100 in - let f_m = n / f_factor in - let f_n = n mod f_factor in - let f_m_up = if f_n > 0 then f_m + 1 else f_m in - match f_m_up with - | 0 -> pf ppf "%d%s%s" m symb u - | f when f >= 100 -> si_size ~scale u ppf (m * factor + f * f_factor) - | f when f mod 10 = 0 -> pf ppf "%d.%d%s%s" m (f / 10) symb u - | f -> pf ppf "%d.%02d%s%s" m f symb u - -and si_size ~scale u ppf s = match scale < -8 || scale > 8 with -| true -> invalid_arg "~scale is %d, must be in [-8;8]" scale -| false -> - let pow_div_3 = if s = 0 then 0 else (ilog10 s / 3) in - let symb = (scale + 8) + pow_div_3 in - let symb, factor = match symb > si_symb_max with - | true -> si_symb_max, ipow10 ((8 - scale) * 3) - | false -> symb, ipow10 (pow_div_3 * 3) - in - if factor = 1 - then pf ppf "%d%s%s" s si_symb.(symb) u - else pp_at_factor ~scale u si_symb.(symb) factor ppf s - -let byte_size ppf s = si_size ~scale:0 "B" ppf s - -let bi_byte_size ppf s = - (* XXX we should get rid of this. *) - let _pp_byte_size k i ppf s = - let pp_frac = float_dfrac 1 in - let div_round_up m n = (m + n - 1) / n in - let float = float_of_int in - if s < k then pf ppf "%dB" s else - let m = k * k in - if s < m then begin - let kstr = if i = "" then "k" (* SI *) else "K" (* IEC *) in - let sk = s / k in - if sk < 10 - then pf ppf "%a%s%sB" pp_frac (float s /. float k) kstr i - else pf ppf "%d%s%sB" (div_round_up s k) kstr i - end else - let g = k * m in - if s < g then begin - let sm = s / m in - if sm < 10 - then pf ppf "%aM%sB" pp_frac (float s /. float m) i - else pf ppf "%dM%sB" (div_round_up s m) i - end else - let t = k * g in - if s < t then begin - let sg = s / g in - if sg < 10 - then pf ppf "%aG%sB" pp_frac (float s /. float g) i - else pf ppf "%dG%sB" (div_round_up s g) i - end else - let p = k * t in - if s < p then begin - let st = s / t in - if st < 10 - then pf ppf "%aT%sB" pp_frac (float s /. float t) i - else pf ppf "%dT%sB" (div_round_up s t) i - end else begin - let sp = s / p in - if sp < 10 - then pf ppf "%aP%sB" pp_frac (float s /. float p) i - else pf ppf "%dP%sB" (div_round_up s p) i - end - in - _pp_byte_size 1024 "i" ppf s - -(* XXX From 4.08 on use Int64.unsigned_* - - See Hacker's Delight for the implementation of these unsigned_* funs *) - -let unsigned_compare x0 x1 = Int64.(compare (sub x0 min_int) (sub x1 min_int)) -let unsigned_div n d = match d < Int64.zero with -| true -> if unsigned_compare n d < 0 then Int64.zero else Int64.one -| false -> - let q = Int64.(shift_left (div (shift_right_logical n 1) d) 1) in - let r = Int64.(sub n (mul q d)) in - if unsigned_compare r d >= 0 then Int64.succ q else q - -let unsigned_rem n d = Int64.(sub n (mul (unsigned_div n d) d)) - -let us_span = 1_000L -let ms_span = 1_000_000L -let sec_span = 1_000_000_000L -let min_span = 60_000_000_000L -let hour_span = 3600_000_000_000L -let day_span = 86_400_000_000_000L -let year_span = 31_557_600_000_000_000L - -let rec pp_si_span unit_str si_unit si_higher_unit ppf span = - let geq x y = unsigned_compare x y >= 0 in - let m = unsigned_div span si_unit in - let n = unsigned_rem span si_unit in - match m with - | m when geq m 100L -> (* No fractional digit *) - let m_up = if Int64.equal n 0L then m else Int64.succ m in - let span' = Int64.mul m_up si_unit in - if geq span' si_higher_unit then uint64_ns_span ppf span' else - pf ppf "%Ld%s" m_up unit_str - | m when geq m 10L -> (* One fractional digit w.o. trailing zero *) - let f_factor = unsigned_div si_unit 10L in - let f_m = unsigned_div n f_factor in - let f_n = unsigned_rem n f_factor in - let f_m_up = if Int64.equal f_n 0L then f_m else Int64.succ f_m in - begin match f_m_up with - | 0L -> pf ppf "%Ld%s" m unit_str - | f when geq f 10L -> - uint64_ns_span ppf Int64.(add (mul m si_unit) (mul f f_factor)) - | f -> pf ppf "%Ld.%Ld%s" m f unit_str - end - | m -> (* Two or zero fractional digits w.o. trailing zero *) - let f_factor = unsigned_div si_unit 100L in - let f_m = unsigned_div n f_factor in - let f_n = unsigned_rem n f_factor in - let f_m_up = if Int64.equal f_n 0L then f_m else Int64.succ f_m in - match f_m_up with - | 0L -> pf ppf "%Ld%s" m unit_str - | f when geq f 100L -> - uint64_ns_span ppf Int64.(add (mul m si_unit) (mul f f_factor)) - | f when Int64.equal (Int64.rem f 10L) 0L -> - pf ppf "%Ld.%Ld%s" m (Int64.div f 10L) unit_str - | f -> - pf ppf "%Ld.%02Ld%s" m f unit_str - -and pp_non_si unit_str unit unit_lo_str unit_lo unit_lo_size ppf span = - let geq x y = unsigned_compare x y >= 0 in - let m = unsigned_div span unit in - let n = unsigned_rem span unit in - if Int64.equal n 0L then pf ppf "%Ld%s" m unit_str else - let f_m = unsigned_div n unit_lo in - let f_n = unsigned_rem n unit_lo in - let f_m_up = if Int64.equal f_n 0L then f_m else Int64.succ f_m in - match f_m_up with - | f when geq f unit_lo_size -> - uint64_ns_span ppf Int64.(add (mul m unit) (mul f unit_lo)) - | f -> - pf ppf "%Ld%s%Ld%s" m unit_str f unit_lo_str - -and uint64_ns_span ppf span = - let geq x y = unsigned_compare x y >= 0 in - let lt x y = unsigned_compare x y = -1 in - match span with - | s when lt s us_span -> pf ppf "%Ldns" s - | s when lt s ms_span -> pp_si_span "us" us_span ms_span ppf s - | s when lt s sec_span -> pp_si_span "ms" ms_span sec_span ppf s - | s when lt s min_span -> pp_si_span "s" sec_span min_span ppf s - | s when lt s hour_span -> pp_non_si "min" min_span "s" sec_span 60L ppf s - | s when lt s day_span -> pp_non_si "h" hour_span "min" min_span 60L ppf s - | s when lt s year_span -> pp_non_si "d" day_span "h" hour_span 24L ppf s - | s -> - let m = unsigned_div s year_span in - let n = unsigned_rem s year_span in - if Int64.equal n 0L then pf ppf "%Lda" m else - let f_m = unsigned_div n day_span in - let f_n = unsigned_rem n day_span in - let f_m_up = if Int64.equal f_n 0L then f_m else Int64.succ f_m in - match f_m_up with - | f when geq f 366L -> pf ppf "%Lda" (Int64.succ m) - | f -> pf ppf "%Lda%Ldd" m f - -(* Binary formatting *) - -type 'a vec = int * (int -> 'a) - -let iter_vec f (n, get) = for i = 0 to n - 1 do f i (get i) done -let vec ?sep = iter_bindings ?sep iter_vec - -let on_string = using String.(fun s -> length s, get s) -let on_bytes = using Bytes.(fun b -> length b, get b) - -let sub_vecs w (n, get) = - (n - 1) / w + 1, - fun j -> - let off = w * j in - min w (n - off), fun i -> get (i + off) - -let prefix0x = [ - 0xf , fmt "%01x"; - 0xff , fmt "%02x"; - 0xfff , fmt "%03x"; - 0xffff , fmt "%04x"; - 0xfffff , fmt "%05x"; - 0xffffff , fmt "%06x"; - 0xfffffff , fmt "%07x"; ] - -let padded0x ~max = match List.find_opt (fun (x, _) -> max <= x) prefix0x with -| Some (_, pp) -> pp -| None -> fmt "%08x" - -let ascii ?(w = 0) ?(subst = const char '.') () ppf (n, _ as v) = - let pp_char ppf (_, c) = - if '\x20' <= c && c < '\x7f' then char ppf c else subst ppf () - in - vec pp_char ppf v; - if n < w then sps (w - n) ppf () - -let octets ?(w = 0) ?(sep = sp) () ppf (n, _ as v) = - let pp_sep ppf i = if i > 0 && i mod 2 = 0 then sep ppf () in - let pp_char ppf (i, c) = pp_sep ppf i; pf ppf "%02x" (Char.code c) in - vec ~sep:nop pp_char ppf v; - for i = n to w - 1 do pp_sep ppf i; sps 2 ppf () done - -let addresses ?addr ?(w = 16) pp_vec ppf (n, _ as v) = - let addr = match addr with - | Some pp -> pp - | _ -> padded0x ~max:(((n - 1) / w) * w) ++ const string ": " - in - let pp_sub ppf (i, sub) = addr ppf (i * w); box pp_vec ppf sub in - vbox (vec pp_sub) ppf (sub_vecs w v) - -let hex ?(w = 16) () = - addresses ~w ((octets ~w () |> box) ++ sps 2 ++ (ascii ~w () |> box)) - -(* Text and lines *) - -let is_nl c = c = '\n' -let is_nl_or_sp c = is_nl c || c = ' ' -let is_white = function ' ' | '\t' .. '\r' -> true | _ -> false -let not_white c = not (is_white c) -let not_white_or_nl c = is_nl c || not_white c - -let rec stop_at sat ~start ~max s = - if start > max then start else - if sat s.[start] then start else - stop_at sat ~start:(start + 1) ~max s - -let sub s start stop ~max = - if start = stop then "" else - if start = 0 && stop > max then s else - String.sub s start (stop - start) - -let words ppf s = - let max = String.length s - 1 in - let rec loop start s = match stop_at is_white ~start ~max s with - | stop when stop > max -> Format.pp_print_string ppf (sub s start stop ~max) - | stop -> - Format.pp_print_string ppf (sub s start stop ~max); - match stop_at not_white ~start:stop ~max s with - | stop when stop > max -> () - | stop -> Format.pp_print_space ppf (); loop stop s - in - let start = stop_at not_white ~start:0 ~max s in - if start > max then () else loop start s - -let paragraphs ppf s = - let max = String.length s - 1 in - let rec loop start s = match stop_at is_white ~start ~max s with - | stop when stop > max -> Format.pp_print_string ppf (sub s start stop ~max) - | stop -> - Format.pp_print_string ppf (sub s start stop ~max); - match stop_at not_white_or_nl ~start:stop ~max s with - | stop when stop > max -> () - | stop -> - if s.[stop] <> '\n' - then (Format.pp_print_space ppf (); loop stop s) else - match stop_at not_white_or_nl ~start:(stop + 1) ~max s with - | stop when stop > max -> () - | stop -> - if s.[stop] <> '\n' - then (Format.pp_print_space ppf (); loop stop s) else - match stop_at not_white ~start:(stop + 1) ~max s with - | stop when stop > max -> () - | stop -> - Format.pp_force_newline ppf (); - Format.pp_force_newline ppf (); - loop stop s - in - let start = stop_at not_white ~start:0 ~max s in - if start > max then () else loop start s - -let text ppf s = - let max = String.length s - 1 in - let rec loop start s = match stop_at is_nl_or_sp ~start ~max s with - | stop when stop > max -> Format.pp_print_string ppf (sub s start stop ~max) - | stop -> - Format.pp_print_string ppf (sub s start stop ~max); - begin match s.[stop] with - | ' ' -> Format.pp_print_space ppf () - | '\n' -> Format.pp_force_newline ppf () - | _ -> assert false - end; - loop (stop + 1) s - in - loop 0 s - -let lines ppf s = - let max = String.length s - 1 in - let rec loop start s = match stop_at is_nl ~start ~max s with - | stop when stop > max -> Format.pp_print_string ppf (sub s start stop ~max) - | stop -> - Format.pp_print_string ppf (sub s start stop ~max); - Format.pp_force_newline ppf (); - loop (stop + 1) s - in - loop 0 s - -let truncated ~max ppf s = match String.length s <= max with -| true -> Format.pp_print_string ppf s -| false -> - for i = 0 to max - 4 do Format.pp_print_char ppf s.[i] done; - Format.pp_print_string ppf "..." - -let text_loc ppf ((l0, c0), (l1, c1)) = - if (l0 : int) == (l1 : int) && (c0 : int) == (c1 : int) - then pf ppf "%d.%d" l0 c0 - else pf ppf "%d.%d-%d.%d" l0 c0 l1 c1 - -(* HCI fragments *) - -let one_of ?(empty = nop) pp_v ppf = function -| [] -> empty ppf () -| [v] -> pp_v ppf v -| [v0; v1] -> pf ppf "@[either %a or@ %a@]" pp_v v0 pp_v v1 -| _ :: _ as vs -> - let rec loop ppf = function - | [v] -> pf ppf "or@ %a" pp_v v - | v :: vs -> pf ppf "%a,@ " pp_v v; loop ppf vs - | [] -> assert false - in - pf ppf "@[one@ of@ %a@]" loop vs - -let did_you_mean - ?(pre = any "Unknown") ?(post = nop) ~kind pp_v ppf (v, hints) - = - match hints with - | [] -> pf ppf "@[%a %s %a%a.@]" pre () kind pp_v v post () - | hints -> - pf ppf "@[%a %s %a%a.@ Did you mean %a ?@]" - pre () kind pp_v v post () (one_of pp_v) hints - -(* Conditional UTF-8 and styled formatting. *) - -module Imap = Map.Make (Int) - -type 'a attr = int * ('a -> string) * (string -> 'a) -let id = ref 0 -let attr (type a) enc dec = incr id; (!id, enc, dec) - -type Format.stag += -| Fmt_store_get : 'a attr -> Format.stag -| Fmt_store_set : 'a attr * 'a -> Format.stag - -let store () = - let s = ref Imap.empty in - fun ~other -> function - | Fmt_store_get (id, _, _) -> Option.value ~default:"" (Imap.find_opt id !s) - | Fmt_store_set ((id, enc, _), v) -> s := Imap.add id (enc v) !s; "ok" - | stag -> other stag - -let setup_store ppf = - let funs = Format.pp_get_formatter_stag_functions ppf () in - let mark_open_stag = store () ~other:funs.mark_open_stag in - Format.pp_set_formatter_stag_functions ppf { funs with mark_open_stag } - -let store_op op ppf = - let funs = Format.pp_get_formatter_stag_functions ppf () in - funs.mark_open_stag op - -let get (_, _, dec as attr) ppf = match store_op (Fmt_store_get attr) ppf with -| "" -> None | s -> Some (dec s) - -let rec set attr v ppf = match store_op (Fmt_store_set (attr, v)) ppf with -| "ok" -> () | _ -> setup_store ppf; set attr v ppf - -let def x = function Some y -> y | _ -> x - -let utf_8_attr = - let enc = function true -> "t" | false -> "f" in - let dec = function "t" -> true | "f" -> false | _ -> assert false in - attr enc dec - -let utf_8 ppf = get utf_8_attr ppf |> def true -let set_utf_8 ppf x = set utf_8_attr x ppf - -type style_renderer = [ `Ansi_tty | `None ] -let style_renderer_attr = - let enc = function `Ansi_tty -> "A" | `None -> "N" in - let dec = function "A" -> `Ansi_tty | "N" -> `None | _ -> assert false in - attr enc dec - -let style_renderer ppf = get style_renderer_attr ppf |> def `None -let set_style_renderer ppf x = set style_renderer_attr x ppf - -let with_buffer ?like buf = - let ppf = Format.formatter_of_buffer buf in - (* N.B. this does slighty more it also makes buf use other installed - semantic tag actions. *) - match like with - | None -> ppf - | Some like -> - let funs = Format.pp_get_formatter_stag_functions like () in - Format.pp_set_formatter_stag_functions ppf funs; - ppf - -let str_like ppf fmt = - let buf = Buffer.create 64 in - let bppf = with_buffer ~like:ppf buf in - let flush ppf = - Format.pp_print_flush ppf (); - let s = Buffer.contents buf in - Buffer.reset buf; s - in - Format.kfprintf flush bppf fmt - -(* Conditional UTF-8 formatting *) - -let if_utf_8 pp_u pp = fun ppf v -> (if utf_8 ppf then pp_u else pp) ppf v - -(* Styled formatting *) - -type color = - [ `Black | `Blue | `Cyan | `Green | `Magenta | `Red | `White | `Yellow ] - -type style = - [ `None | `Bold | `Faint | `Italic | `Underline | `Reverse - | `Fg of [ color | `Hi of color ] - | `Bg of [ color | `Hi of color ] - | color (** deprecated *) ] - -let ansi_style_code = function -| `Bold -> "1" -| `Faint -> "2" -| `Italic -> "3" -| `Underline -> "4" -| `Reverse -> "7" -| `Fg `Black -> "30" -| `Fg `Red -> "31" -| `Fg `Green -> "32" -| `Fg `Yellow -> "33" -| `Fg `Blue -> "34" -| `Fg `Magenta -> "35" -| `Fg `Cyan -> "36" -| `Fg `White -> "37" -| `Bg `Black -> "40" -| `Bg `Red -> "41" -| `Bg `Green -> "42" -| `Bg `Yellow -> "43" -| `Bg `Blue -> "44" -| `Bg `Magenta -> "45" -| `Bg `Cyan -> "46" -| `Bg `White -> "47" -| `Fg (`Hi `Black) -> "90" -| `Fg (`Hi `Red) -> "91" -| `Fg (`Hi `Green) -> "92" -| `Fg (`Hi `Yellow) -> "93" -| `Fg (`Hi `Blue) -> "94" -| `Fg (`Hi `Magenta) -> "95" -| `Fg (`Hi `Cyan) -> "96" -| `Fg (`Hi `White) -> "97" -| `Bg (`Hi `Black) -> "100" -| `Bg (`Hi `Red) -> "101" -| `Bg (`Hi `Green) -> "102" -| `Bg (`Hi `Yellow) -> "103" -| `Bg (`Hi `Blue) -> "104" -| `Bg (`Hi `Magenta) -> "105" -| `Bg (`Hi `Cyan) -> "106" -| `Bg (`Hi `White) -> "107" -| `None -> "0" -(* deprecated *) -| `Black -> "30" -| `Red -> "31" -| `Green -> "32" -| `Yellow -> "33" -| `Blue -> "34" -| `Magenta -> "35" -| `Cyan -> "36" -| `White -> "37" - -let pp_sgr ppf style = - Format.pp_print_as ppf 0 "\027["; - Format.pp_print_as ppf 0 style; - Format.pp_print_as ppf 0 "m" - -let curr_style = attr Fun.id Fun.id - -let styled style pp_v ppf v = match style_renderer ppf with -| `None -> pp_v ppf v -| `Ansi_tty -> - let prev = match get curr_style ppf with - | None -> let zero = "0" in set curr_style zero ppf; zero - | Some s -> s - in - let here = ansi_style_code style in - let curr = match style with - | `None -> here - | _ -> String.concat ";" [prev; here] - in - let finally () = set curr_style prev ppf in - set curr_style curr ppf; - Fun.protect ~finally @@ fun () -> - pp_sgr ppf here; pp_v ppf v; pp_sgr ppf prev - -(* Records *) - -let id = Fun.id -let label = styled (`Fg `Yellow) string -let field ?(label = label) ?(sep = any ":@ ") l prj pp_v ppf v = - pf ppf "@[<1>%a%a%a@]" label l sep () pp_v (prj v) - -let record ?(sep = cut) pps = vbox (concat ~sep pps) - -(* Converting with string converters. *) - -let of_to_string f ppf v = string ppf (f v) -let to_to_string pp_v v = str "%a" pp_v v - -(* Deprecated *) - -let strf = str -let kstrf = kstr -let strf_like = str_like -let always = any -let unit = any -let prefix pp_p pp_v ppf v = pp_p ppf (); pp_v ppf v -let suffix pp_s pp_v ppf v = pp_v ppf v; pp_s ppf () -let styled_unit style fmt = styled style (any fmt) - -(*--------------------------------------------------------------------------- - Copyright (c) 2014 The fmt programmers - - Permission to use, copy, modify, and/or distribute this software for any - purpose with or without fee is hereby granted, provided that the above - copyright notice and this permission notice appear in all copies. - - THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES - WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF - MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR - ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES - WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN - ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF - OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. - ---------------------------------------------------------------------------*) diff --git a/vendor/fmt/src/fmt.mli b/vendor/fmt/src/fmt.mli deleted file mode 100644 index 301e524f5f2..00000000000 --- a/vendor/fmt/src/fmt.mli +++ /dev/null @@ -1,697 +0,0 @@ -(*--------------------------------------------------------------------------- - Copyright (c) 2014 The fmt programmers. All rights reserved. - Distributed under the ISC license, see terms at the end of the file. - ---------------------------------------------------------------------------*) - -(** {!Format} pretty-printer combinators. - - Consult {{!nameconv}naming conventions} for your pretty-printers. - - {b References} - {ul - {- The {!Format} module documentation.} - {- The required reading {!Format} module - {{:https://ocaml.org/learn/tutorials/format.html}tutorial}.}} *) - -(** {1:stdos Standard outputs} *) - -val stdout : Format.formatter -(** [stdout] is the standard output formatter. *) - -val stderr : Format.formatter -(** [stderr] is the standard error formatter. *) - -(** {1:formatting Formatting} *) - -val pf : Format.formatter -> ('a, Format.formatter, unit) Stdlib.format -> 'a -(** [pf] is {!Format.fprintf}. *) - -val pr : ('a, Format.formatter, unit) format -> 'a -(** [pr] is [pf stdout]. *) - -val epr : ('a, Format.formatter, unit) format -> 'a -(** [epr] is [pf stderr]. *) - -val str : ('a, Format.formatter, unit, string) format4 -> 'a -(** [str] is {!Format.asprintf}. - - {b Note.} When using [str] {!utf_8} and {!val-style_renderer} are - always respectively set to [true] and [`None]. See also - {!str_like}. *) - -val kpf : (Format.formatter -> 'a) -> Format.formatter -> - ('b, Format.formatter, unit, 'a) Stdlib.format4 -> 'b -(** [kpf] is {!Format.kfprintf}. *) - -val kstr : - (string -> 'a) -> ('b, Format.formatter, unit, 'a) format4 -> 'b -(** [kstr] is like {!str} but continuation based. *) - -val str_like : - Format.formatter -> ('a, Format.formatter, unit, string) format4 -> 'a -(** [str_like ppf] is like {!str} except its {!utf_8} and {!val-style_renderer} - settings are those of [ppf]. *) - -val with_buffer : ?like:Format.formatter -> Buffer.t -> Format.formatter -(** [with_buffer ~like b] is a formatter whose {!utf_8} and - {!val-style_renderer} settings are copied from those of [like] - (if provided). *) - -val failwith : ('a, Format.formatter, unit, 'b) format4 -> 'a -(** [failwith] is [kstr failwith], raises {!Stdlib.Failure} with - a pretty-printed string argument. *) - -val failwith_notrace : ('a, Format.formatter, unit, 'b) format4 -> 'a -(** [failwith_notrace] is like {!failwith} but raises with {!raise_notrace}. *) - -val invalid_arg : ('a, Format.formatter, unit, 'b) format4 -> 'a -(** [invalid_arg] is [kstr invalid_arg], raises - {!Stdlib.Invalid_argument} with a pretty-printed string argument. *) - -val error : ('b, Format.formatter , unit, ('a, string) result) format4 -> 'b -(** [error fmt ...] is [kstr (fun s -> Error s) fmt ...] *) - -val error_msg : - ('b, Format.formatter , unit, ('a, [> `Msg of string]) result) format4 -> 'b -(** [error_msg fmt ...] is [kstr (fun s -> Error (`Msg s)) fmt ...] *) - -(** {1 Formatters} *) - -type 'a t = Format.formatter -> 'a -> unit -(** The type for formatters of values of type ['a]. *) - -val flush : 'a t -(** [flush] has the effect of {!Format.pp_print_flush} *) - -val nop : 'a t -(** [nop] formats nothing. *) - -val any : (unit, Format.formatter, unit) Stdlib.format -> 'a t -(** [any fmt ppf v] formats any value with the constant format [fmt]. *) - -val using : ('a -> 'b) -> 'b t -> 'a t -(** [using f pp ppf v] ppf ppf [(f v)]. *) - -val const : 'a t -> 'a -> 'b t -(** [const pp_v v] always formats [v] using [pp_v]. *) - -val fmt : ('a, Format.formatter, unit) Stdlib.format -> Format.formatter -> 'a -(** [fmt fmt ppf] is [pf ppf fmt]. If [fmt] is used with a single - non-constant formatting directive, generates a value of type - {!t}. *) - -(** {1:seps Separators} *) - -val cut : 'a t -(** [cut] has the effect of {!Format.pp_print_cut}. *) - -val sp : 'a t -(** [sp] has the effect of {!Format.pp_print_space}. *) - -val sps : int -> 'a t -(** [sps n] has the effect of {!Format.pp_print_break}[ n 0]. *) - -val comma : 'a t -(** [comma] is {!Fmt.any}[ ",@ "]. *) - -val semi : 'a t -(** [semi] is {!Fmt.any}[ ";@ "]. *) - -(** {1:seq Sequencing} *) - -val append : 'a t -> 'a t -> 'a t -(** [append pp_v0 pp_v1 ppf v] is [pp_v0 ppf v; pp_v1 ppf v]. *) - -val ( ++ ) : 'a t -> 'a t -> 'a t -(** [( ++ )] is {!append}. *) - -val concat : ?sep:unit t -> 'a t list -> 'a t -(** [concat ~sep pps] formats a value using the formaters [pps] - and separting each format with [sep] (defaults to {!cut}). *) - -val iter : ?sep:unit t -> (('a -> unit) -> 'b -> unit) -> 'a t -> 'b t -(** [iter ~sep iter pp_elt] formats the iterations of [iter] over a - value using [pp_elt]. Iterations are separated by [sep] (defaults to - {!cut}). *) - -val iter_bindings : ?sep:unit t -> (('a -> 'b -> unit) -> 'c -> unit) -> - ('a * 'b) t -> 'c t -(** [iter_bindings ~sep iter pp_binding] formats the iterations of - [iter] over a value using [pp_binding]. Iterations are separated - by [sep] (defaults to {!cut}). *) - -(** {1:boxes Boxes} *) - -val box : ?indent:int -> 'a t -> 'a t -(** [box ~indent pp ppf] wraps [pp] in a pretty-printing box. The box tries to - print as much as possible on every line, while emphasizing the box structure - (see {!Format.pp_open_box}). Break hints that lead to a new line add - [indent] to the current indentation (defaults to [0]). *) - -val hbox : 'a t -> 'a t -(** [hbox] is like {!box} but is a horizontal box: the line is not split - in this box (but may be in sub-boxes). See {!Format.pp_open_hbox}. *) - -val vbox : ?indent:int -> 'a t -> 'a t -(** [vbox] is like {!box} but is a vertical box: every break hint leads - to a new line which adds [indent] to the current indentation - (defaults to [0]). See {!Format.pp_open_vbox}. *) - -val hvbox : ?indent:int -> 'a t -> 'a t -(** [hvbox] is like {!hbox} if it fits on a single line, or like {!vbox} - otherwise. See {!Format.pp_open_hvbox}. *) - -val hovbox : ?indent:int -> 'a t -> 'a t -(** [hovbox] is a condensed {!box}. See {!Format.pp_open_hovbox}. *) - -(** {1:bracks Brackets} *) - -val parens : 'a t -> 'a t -(** [parens pp_v ppf] is [pf "@[<1>(%a)@]" pp_v]. *) - -val brackets : 'a t -> 'a t -(** [brackets pp_v ppf] is [pf "@[<1>[%a]@]" pp_v]. *) - -val braces : 'a t -> 'a t -(** [braces pp_v ppf] is [pf "@[<1>{%a}@]" pp_v]. *) - -val quote : ?mark:string -> 'a t -> 'a t -(** [quote ~mark pp_v ppf] is [pf "@[<1>@<1>%s%a@<1>%s@]" mark pp_v mark], - [mark] defaults to ["\""], it is always counted as spanning as single - column (this allows for UTF-8 encoded marks). *) - -(** {1:records Records} *) - -val id : 'a -> 'a -(** [id] is {!Fun.id}. *) - -val field : - ?label:string t -> ?sep:unit t -> string -> ('b -> 'a) -> 'a t -> 'b t -(** [field ~label ~sep l prj pp_v] pretty prints a labelled field value as - [pf "@[<1>%a%a%a@]" label l sep () (using prj pp_v)]. [label] defaults - to [styled `Yellow string] and [sep] to [any ":@ "]. *) - -val record : ?sep:unit t -> 'a t list -> 'a t -(** [record ~sep fields] pretty-prints a value using the concatenation of - [fields], separated by [sep] (defaults to [cut]) and framed in a vertical - box. *) - -(** {1:stdlib Stdlib types} - - Formatters for structures give full control to the client over the - formatting process and do not wrap the formatted structures with - boxes. Use the {!Dump} module to quickly format values for - inspection. *) - -val bool : bool t -(** [bool] is {!Format.pp_print_bool}. *) - -val int : int t -(** [int ppf] is [pf ppf "%d"]. *) - -val nativeint : nativeint t -(** [nativeint ppf] is [pf ppf "%nd"]. *) - -val int32 : int32 t -(** [int32 ppf] is [pf ppf "%ld"]. *) - -val int64 : int64 t -(** [int64 ppf] is [pf ppf "%Ld"]. *) - -val uint : int t -(** [uint ppf] is [pf ppf "%u"]. *) - -val unativeint : nativeint t -(** [unativeint ppf] is [pf ppf "%nu"]. *) - -val uint32 : int32 t -(** [uint32 ppf] is [pf ppf "%lu"]. *) - -val uint64 : int64 t -(** [uint64 ppf] is [pf ppf "%Lu"]. *) - -val float : float t -(** [float ppf] is [pf ppf "%g".] *) - -val float_dfrac : int -> float t -(** [float_dfrac d] rounds the float to the [d]th {e decimal} - fractional digit and formats the result with ["%g"]. Ties are - rounded towards positive infinity. The result is only defined - for [0 <= d <= 16]. *) - -val float_dsig : int -> float t -(** [float_dsig d] rounds the normalized {e decimal} significand - of the float to the [d]th decimal fractional digit and formats - the result with ["%g"]. Ties are rounded towards positive - infinity. The result is NaN on infinities and only defined for - [0 <= d <= 16]. - - {b Warning.} The current implementation overflows on large [d] - and floats. *) - -val char : char t -(** [char] is {!Format.pp_print_char}. *) - -val string : string t -(** [string] is {!Format.pp_print_string}. *) - -val buffer : Buffer.t t -(** [buffer] formats a {!Buffer.t} value's current contents. *) - -val exn : exn t -(** [exn] formats an exception. *) - -val exn_backtrace : (exn * Printexc.raw_backtrace) t -(** [exn_backtrace] formats an exception backtrace. *) - -val pair : ?sep:unit t -> 'a t -> 'b t -> ('a * 'b) t -(** [pair ~sep pp_fst pp_snd] formats a pair. The first and second - projection are formatted using [pp_fst] and [pp_snd] and are - separated by [sep] (defaults to {!cut}). *) - -val option : ?none:unit t -> 'a t -> 'a option t -(** [option ~none pp_v] formats an optional value. The [Some] case - uses [pp_v] and [None] uses [none] (defaults to {!nop}). *) - -val result : ok:'a t -> error:'b t -> ('a, 'b) result t -(** [result ~ok ~error] formats a result value using [ok] for the [Ok] - case and [error] for the [Error] case. *) - -val list : ?sep:unit t -> 'a t -> 'a list t -(** [list sep pp_v] formats list elements. Each element of the list is - formatted in order with [pp_v]. Elements are separated by [sep] - (defaults to {!cut}). If the list is empty, this is {!nop}. *) - -val array : ?sep:unit t -> 'a t -> 'a array t -(** [array sep pp_v] formats array elements. Each element of the array - is formatted in order with [pp_v]. Elements are separated by [sep] - (defaults to {!cut}). If the array is empty, this is {!nop}. *) - -val seq : ?sep:unit t -> 'a t -> 'a Seq.t t -(** [seq sep pp_v] formats sequence elements. Each element of the sequence - is formatted in order with [pp_v]. Elements are separated by [sep] - (defaults to {!cut}). If the sequence is empty, this is {!nop}. *) - -val hashtbl : ?sep:unit t -> ('a * 'b) t -> ('a, 'b) Hashtbl.t t -(** [hashtbl ~sep pp_binding] formats the bindings of a hash - table. Each binding is formatted with [pp_binding] and bindings - are separated by [sep] (defaults to {!cut}). If the hash table has - multiple bindings for a given key, all bindings are formatted, - with the most recent binding first. If the hash table is empty, - this is {!nop}. *) - -val queue : ?sep:unit t -> 'a t -> 'a Queue.t t -(** [queue ~sep pp_v] formats queue elements. Each element of the - queue is formatted in least recently added order with - [pp_v]. Elements are separated by [sep] (defaults to {!cut}). If - the queue is empty, this is {!nop}. *) - -val stack : ?sep:unit t -> 'a t -> 'a Stack.t t -(** [stack ~sep pp_v] formats stack elements. Each element of the - stack is formatted from top to bottom order with [pp_v]. Elements - are separated by [sep] (defaults to {!cut}). If the stack is - empty, this is {!nop}. *) - -(** Formatters for inspecting OCaml values. - - Formatters of this module dump OCaml value with little control - over the representation but with good default box structures and, - whenever possible, using OCaml syntax. *) -module Dump : sig - - (** {1:stdlib Stdlib types} *) - - val signal : int t - (** [signal] formats an OCaml {{!Sys.sigabrt}signal number} as a C - POSIX - {{:http://pubs.opengroup.org/onlinepubs/9699919799/basedefs/signal.h.html} - constant} or ["SIG(%d)"] the signal number is unknown. *) - - val uchar : Uchar.t t - (** [uchar] formats an OCaml {!Uchar.t} value using only US-ASCII - encoded characters according to the Unicode - {{:http://www.unicode.org/versions/latest/appA.pdf}notational - convention} for code points. *) - - val string : string t - (** [string] is [pf ppf "%S"]. *) - - val pair : 'a t -> 'b t -> ('a * 'b) t - (** [pair pp_fst pp_snd] formats an OCaml pair using [pp_fst] and [pp_snd] - for the first and second projection. *) - - val option : 'a t -> 'a option t - (** [option pp_v] formats an OCaml option using [pp_v] for the [Some] - case. No parentheses are added. *) - - val result : ok:'a t -> error:'b t -> ('a, 'b) result t - (** [result ~ok ~error] formats an OCaml result using [ok] for the [Ok] - case value and [error] for the [Error] case value. No parentheses - are added. *) - - val list : 'a t -> 'a list t - (** [list pp_v] formats an OCaml list using [pp_v] for the list - elements. *) - - val array : 'a t -> 'a array t - (** [array pp_v] formats an OCaml array using [pp_v] for the array - elements. *) - - val seq : 'a t -> 'a Seq.t t - (** [seq pp_v] formats an OCaml sequence using [pp_v] for the sequence - elements. *) - - val hashtbl : 'a t -> 'b t -> ('a, 'b) Hashtbl.t t - (** [hashtbl pp_k pp_v] formats an unspecified representation of the - bindings of a hash table using [pp_k] for the keys and [pp_v] - for the values. If the hash table has multiple bindings for a - given key, all bindings are formatted, with the most recent - binding first. *) - - val queue : 'a t -> 'a Queue.t t - (** [queue pp_v] formats an unspecified representation of an OCaml - queue using [pp_v] to format its elements, in least recently added - order. *) - - val stack : 'a t -> 'a Stack.t t - (** [stack pp_v] formats an unspecified representation of an OCaml - stack using [pp_v] to format its elements in top to bottom order. *) - - (** {1:record Records} *) - - val field : ?label:string t -> string -> ('b -> 'a) -> 'a t -> 'b t - (** [field ~label l prj pp_v] pretty prints a named field using [label] - (defaults to [styled `Yellow string]) for the label, and [using prj pp_v] - for the field value. *) - - val record : 'a t list -> 'a t - (** [record fields] pretty-prints a value using the concatenation of - [fields], separated by [";@,"], framed in a vertical - box and surrounded by {!braces}. *) - - (** {1:seq Sequencing} - - These are akin to {!iter} and {!iter_bindings} but - delimit the sequences with {!parens}. *) - - val iter : (('a -> unit) -> 'b -> unit) -> 'b t -> 'a t -> 'b t - (** [iter iter pp_name pp_elt] formats an unspecified representation - of the iterations of [iter] over a value using [pp_elt]. The - iteration is named by [pp_name]. *) - - val iter_bindings : (('a -> 'b -> unit) -> 'c -> unit) -> 'c t -> 'a t - -> 'b t -> 'c t - (** [iter_bindings ~sep iter pp_name pp_k pp_v] formats an - unspecified representation of the iterations of [iter] over a - value using [pp_k] and [pp_v]. The iteration is named by - [pp_name]. *) -end - -(** {1:mgs Magnitudes} *) - -val si_size : scale:int -> string -> int t -(** [si_size ~scale unit] formats a non negative integer - representing unit [unit] at scale 10{^scale * 3}, depending on - its magnitude, using power of 3 - {{:https://www.bipm.org/en/publications/si-brochure/chapter3.html} - SI prefixes} (i.e. all of them except deca, hector, deci and - centi). Only US-ASCII characters are used, [µ] (10{^-6}) is - written using [u]. - - [scale] indicates the scale 10{^scale * 3} an integer - represents, for example [-1] for m[unit] (10{^-3}), [0] for - [unit] (10{^0}), [1] for [kunit] (10{^3}); it must be in the - range \[[-8];[8]\] or [Invalid_argument] is raised. - - Except at the maximal yotta scale always tries to show three - digits of data with trailing fractional zeros omited. Rounds - towards positive infinity (over approximates). *) - -val byte_size : int t -(** [byte_size] is [si_size ~scale:0 "B"]. *) - -val bi_byte_size : int t -(** [bi_byte_size] formats a byte size according to its magnitude - using {{:https://en.wikipedia.org/wiki/Binary_prefix}binary prefixes} - up to pebi bytes (2{^15}). *) - -val uint64_ns_span : int64 t -(** [uint64_ns_span] formats an {e unsigned} nanosecond time span - according to its magnitude using - {{:http://www.bipm.org/en/publications/si-brochure/chapter3.html}SI - prefixes} on seconds and - {{:http://www.bipm.org/en/publications/si-brochure/table6.html}accepted - non-SI units}. Years are counted in Julian years (365.25 SI-accepted days) - as {{:http://www.iau.org/publications/proceedings_rules/units/}defined} - by the International Astronomical Union (IAU). Only US-ASCII characters - are used ([us] is used for [µs]). *) - -(** {1:binary Binary data} *) - -type 'a vec = int * (int -> 'a) -(** The type for random addressable, sized sequences. Each [(n, f)] - represents the sequence [f 0, ..., f (n - 1)]. *) - -val on_bytes : char vec t -> bytes t -(** [on_bytes pp] is [pp] adapted to format (entire) [bytes]. *) - -val on_string : char vec t -> string t -(** [on_string pp] is [pp] adapted to format (entire) [string]s. *) - -val ascii : ?w:int -> ?subst:unit t -> unit -> char vec t -(** [ascii ~w ~subst ()] formats character sequences by printing - characters in the {e printable US-ASCII range} ([[0x20];[0x7E]]) - as is, and replacing the rest with [subst] (defaults to [fmt "."]). - [w] causes the output to be right padded to the size of formatting - at least [w] sequence elements (defaults to [0]). *) - -val octets : ?w:int -> ?sep:unit t -> unit -> char vec t -(** [octets ~w ~sep ()] formats character sequences as hexadecimal - digits. It prints groups of successive characters of unspecified - length together, separated by [sep] (defaults to {!sp}). [w] - causes the output to be right padded to the size of formatting at - least [w] sequence elements (defaults to [0]). *) - -val addresses : ?addr:int t -> ?w:int -> 'a vec t -> 'a vec t -(** [addresses pp] formats sequences by applying [pp] to consecutive - subsequences of length [w] (defaults to 16). [addr] formats - subsequence offsets (defaults to an unspecified hexadecimal - format). *) - -val hex : ?w:int -> unit -> char vec t -(** [hex ~w ()] formats character sequences as traditional hex dumps, - matching the output of {e xxd} and forcing line breaks after every - [w] characters (defaults to 16). *) - -(** {1:text Words, paragraphs, text and lines} - - {b Note.} These functions only work on US-ASCII strings and/or - with newlines (['\n']). If you are dealing with UTF-8 strings or - different kinds of line endings you should use the pretty-printers - from {!Uuseg_string}. - - {b White space.} White space is one of the following US-ASCII - characters: space [' '] ([0x20]), tab ['\t'] ([0x09]), newline - ['\n'] ([0x0A]), vertical tab ([0x0B]), form feed ([0x0C]), - carriage return ['\r'] ([0x0D]). *) - -val words : string t -(** [words] formats words by suppressing initial and trailing - white space and replacing consecutive white space with - a single {!Format.pp_print_space}. *) - -val paragraphs : string t -(** [paragraphs] formats paragraphs by suppressing initial and trailing - spaces and newlines, replacing blank lines (a line made only - of white space) by a two {!Format.pp_force_newline} and remaining - consecutive white space with a single {!Format.pp_print_space}. *) - -val text : string t -(** [text] formats text by respectively replacing spaces and newlines in - the string with {!Format.pp_print_space} and {!Format.pp_force_newline}. *) - -val lines : string t -(** [lines] formats lines by replacing newlines (['\n']) in the string - with calls to {!Format.pp_force_newline}. *) - -val truncated : max:int -> string t -(** [truncated ~max] formats a string using at most [max] - characters. If the string doesn't fit, it is truncated and ended - with three consecutive dots which do count towards [max]. *) - -val text_loc : ((int * int) * (int * int)) t -(** [text_loc] formats a line-column text range according to - {{:http://www.gnu.org/prep/standards/standards.html#Errors} - GNU conventions}. *) - -(** {1:hci HCI fragments} *) - -val one_of : ?empty:unit t -> 'a t -> 'a list t -(** [one_of ~empty pp_v ppf l] formats according to the length of [l] - {ul - {- [0], formats [empty] (defaults to {!nop}).} - {- [1], formats the element with [pp_v].} - {- [2], formats ["either %a or %a"] with the list elements} - {- [n], formats ["one of %a, ... or %a"] with the list elements}} *) - -val did_you_mean : - ?pre:unit t -> ?post:unit t -> kind:string -> 'a t -> ('a * 'a list) t -(** [did_you_mean ~pre kind ~post pp_v] formats a faulty value [v] of - kind [kind] and a list of [hints] that [v] could have been - mistaken for. - - [pre] defaults to [unit "Unknown"], [post] to {!nop} they surround - the faulty value before the "did you mean" part as follows ["%a %s - %a%a." pre () kind pp_v v post ()]. If [hints] is empty no "did - you mean" part is printed. *) - -(** {1:utf8_cond Conditional UTF-8 formatting} - - {b Note.} Since {!Format} is not UTF-8 aware using UTF-8 output - may derail the pretty printing process. Use the pretty-printers - from {!Uuseg_string} if you are serious about UTF-8 formatting. *) - -val if_utf_8 : 'a t -> 'a t -> 'a t -(** [if_utf_8 pp_u pp ppf v] is: - {ul - {- [pp_u ppf v] if [utf_8 ppf] is [true].} - {- [pp ppf v] otherwise.}} *) - -val utf_8 : Format.formatter -> bool -(** [utf_8 ppf] is [true] if UTF-8 output is enabled on [ppf]. If - {!set_utf_8} hasn't been called on [ppf] this is [true]. *) - -val set_utf_8 : Format.formatter -> bool -> unit -(** [set_utf_8 ppf b] enables or disables conditional UTF-8 formatting - on [ppf]. - - @raise Invalid_argument if [ppf] is {!Format.str_formatter}: it is - is always UTF-8 enabled. *) - -(** {1:styled Styled formatting} *) - -type color = - [ `Black | `Blue | `Cyan | `Green | `Magenta | `Red | `White | `Yellow ] -(** The type for colors. *) - -type style = - [ `None | `Bold | `Faint | `Italic | `Underline | `Reverse - | `Fg of [ color | `Hi of color ] - | `Bg of [ color | `Hi of color ] - | color (** deprecated *) ] -(** The type for styles: - {ul - {- [`None] resets the styling.} - {- [`Bold], [`Faint], [`Italic], [`Underline] and [`Reverse] are - display attributes.} - {- [`Fg _] is the foreground color or high-intensity color on [`Hi _].} - {- [`Bg _] is the foreground color or high-intensity color on [`Hi _].} - {- [#color] is the foreground colour, {b deprecated} use [`Fg - #color] instead.}} *) - -val styled : style -> 'a t -> 'a t -(** [styled s pp] formats like [pp] but styled with [s]. *) - -(** {2 Style rendering control} *) - -type style_renderer = [ `Ansi_tty | `None ] -(** The type for style renderers. - {ul - {- [`Ansi_tty], renders styles using - {{:http://www.ecma-international.org/publications/standards/Ecma-048.htm} - ANSI escape sequences}.} - {- [`None], styled rendering has no effect.}} *) - -val style_renderer : Format.formatter -> style_renderer -(** [style_renderer ppf] is the style renderer used by [ppf]. If - {!set_style_renderer} has never been called on [ppf] this is - [`None]. *) - -val set_style_renderer : Format.formatter -> style_renderer -> unit -(** [set_style_renderer ppf r] sets the style renderer of [ppf] to [r]. - - @raise Invalid_argument if [ppf] is {!Format.str_formatter}: its - renderer is always [`None]. *) - -(** {1:stringconverters Converting with string value converters} *) - -val of_to_string : ('a -> string) -> 'a t -(** [of_to_string f ppf v] is [string ppf (f v)]. *) - -val to_to_string : 'a t -> 'a -> string -(** [to_to_string pp_v v] is [strf "%a" pp_v v]. *) - -(** {1:deprecated Deprecated} *) - -val strf : ('a, Format.formatter, unit, string) format4 -> 'a -[@@ocaml.deprecated "use Fmt.str instead."] -(** @deprecated use {!str} instead. *) - -val kstrf : (string -> 'a) -> ('b, Format.formatter, unit, 'a) format4 -> 'b -[@@ocaml.deprecated "use Fmt.kstr instead."] -(** @deprecated use {!kstr} instead. *) - -val strf_like : - Format.formatter -> ('a, Format.formatter, unit, string) format4 -> 'a -[@@ocaml.deprecated "use Fmt.str_like instead."] -(** @deprecated use {!str_like} instead. *) - -val always : (unit, Format.formatter, unit) Stdlib.format -> 'a t -[@@ocaml.deprecated "use Fmt.any instead."] -(** @deprecated use {!any} instead. *) - -val unit : (unit, Format.formatter, unit) Stdlib.format -> unit t -[@@ocaml.deprecated "use Fmt.any instead."] -(** @deprecated use {!any}. *) - -val prefix : unit t -> 'a t -> 'a t -[@@ocaml.deprecated "use Fmt.(++) instead."] -(** @deprecated use {!( ++ )}. *) - -val suffix : unit t -> 'a t -> 'a t -[@@ocaml.deprecated "use Fmt.(++) instead."] -(** @deprecated use {!( ++ )}. *) - -val styled_unit : - style -> (unit, Format.formatter, unit) Stdlib.format -> unit t -[@@ocaml.deprecated "use Fmt.(styled s (any fmt)) instead."] -(** @deprecated use [styled s (any fmt)] instead *) - -(** {1:nameconv Naming conventions} - - Given a type [ty] use: - - {ul - {- [pp_ty] for a pretty printer that provides full control to the - client and does not wrap the formatted value in an enclosing - box. See {{!stdlib}these examples}.} - {- [pp_dump_ty] for a pretty printer that provides little control - over the pretty-printing process, wraps the rendering in an - enclosing box and tries as much as possible to respect the - OCaml syntax. These pretty-printers should make it easy to - inspect and understand values of the given type, they are - mainly used for quick printf debugging and/or toplevel interaction. - See {{!Fmt.Dump.stdlib}these examples}.}} - - If you are in a situation where making a difference between [dump_ty] - and [pp_ty] doesn't make sense then use [pp_ty]. - - For a type [ty] that is the main type of the module (the "[M.t]" - convention) drop the suffix, that is simply use [M.pp] and - [M.pp_dump]. *) - -(*--------------------------------------------------------------------------- - Copyright (c) 2014 The fmt programmers - - Permission to use, copy, modify, and/or distribute this software for any - purpose with or without fee is hereby granted, provided that the above - copyright notice and this permission notice appear in all copies. - - THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES - WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF - MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR - ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES - WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN - ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF - OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. - ---------------------------------------------------------------------------*) diff --git a/vendor/update-fmt.sh b/vendor/update-fmt.sh deleted file mode 100755 index e03839ef9ae..00000000000 --- a/vendor/update-fmt.sh +++ /dev/null @@ -1,28 +0,0 @@ -#!/usr/bin/env bash - -version=4175d4cc6bb2a99b93e993cdb47e43fc8d27acfa - -set -e -o pipefail - -TMP="$(mktemp -d)" -trap "rm -rf $TMP" EXIT - -PACKAGE=fmt - -rm -rf $PACKAGE -mkdir -p $PACKAGE/src - -( - cd $TMP - git clone https://github.com/ocaml-dune/$PACKAGE.git - cd $PACKAGE - git checkout $version -) - -SRC=$TMP/$PACKAGE - -cp -v $SRC/LICENSE.md $PACKAGE/ -cp -v -R $SRC/src/fmt.ml{i,} $PACKAGE/src/ - -git checkout $PACKAGE/src/dune -git add -A .