This commit is contained in:
parent
aa2ff7b2f0
commit
2f3113f55d
11742 changed files with 1223940 additions and 0 deletions
8
unikernel/duniverse/fmt/.gitignore
vendored
Normal file
8
unikernel/duniverse/fmt/.gitignore
vendored
Normal file
|
|
@ -0,0 +1,8 @@
|
|||
BRZO
|
||||
_b0
|
||||
_build
|
||||
tmp
|
||||
*~
|
||||
\.\#*
|
||||
\#*#
|
||||
*.install
|
||||
4
unikernel/duniverse/fmt/.merlin
Normal file
4
unikernel/duniverse/fmt/.merlin
Normal file
|
|
@ -0,0 +1,4 @@
|
|||
PKG b0.kit cmdliner
|
||||
S src
|
||||
S test
|
||||
B _b0/b/**
|
||||
1
unikernel/duniverse/fmt/.ocp-indent
Normal file
1
unikernel/duniverse/fmt/.ocp-indent
Normal file
|
|
@ -0,0 +1 @@
|
|||
strict_with=always,match_clause=4,strict_else=never
|
||||
72
unikernel/duniverse/fmt/B0.ml
Normal file
72
unikernel/duniverse/fmt/B0.ml
Normal file
|
|
@ -0,0 +1,72 @@
|
|||
open B0_kit.V000
|
||||
open Result.Syntax
|
||||
|
||||
(* OCaml library names *)
|
||||
|
||||
let b0_std = B0_ocaml.libname "b0.std"
|
||||
let compiler_libs_toplevel = B0_ocaml.libname "compiler-libs.toplevel"
|
||||
let cmdliner = B0_ocaml.libname "cmdliner"
|
||||
let unix = B0_ocaml.libname "unix"
|
||||
|
||||
let fmt = B0_ocaml.libname "fmt"
|
||||
let fmt_cli = B0_ocaml.libname "fmt.cli"
|
||||
let fmt_tty = B0_ocaml.libname "fmt.tty"
|
||||
let fmt_top = B0_ocaml.libname "fmt.top"
|
||||
|
||||
(* Libraries *)
|
||||
|
||||
let fmt_lib =
|
||||
B0_ocaml.lib fmt ~srcs:[`Dir ~/"src"]
|
||||
|
||||
let fmt_cli =
|
||||
let srcs = [`Dir ~/"src/cli"] in
|
||||
B0_ocaml.lib fmt_cli ~srcs ~requires:[cmdliner; fmt] ~exports:[fmt]
|
||||
|
||||
let fmt_tty =
|
||||
let srcs = [`Dir ~/"src/tty"] in
|
||||
B0_ocaml.lib fmt_tty ~srcs ~requires:[unix; fmt] ~exports:[fmt]
|
||||
|
||||
let fmt_top =
|
||||
let srcs = [`Dir ~/"src/top"; `X ~/"src/top/fmt_tty_top_init.ml"] in
|
||||
B0_ocaml.lib fmt_top ~srcs ~requires:[compiler_libs_toplevel]
|
||||
|
||||
(* Tests *)
|
||||
|
||||
let test ?(requires = []) = B0_ocaml.test ~requires:(fmt :: requires)
|
||||
|
||||
let test_fmt = test ~/"test/test_fmt.ml" ~requires:[b0_std]
|
||||
let styled_perf_bug =
|
||||
test ~/"test/styled_perf_bug.ml" ~requires:[unix] ~run:false
|
||||
|
||||
(* Packs *)
|
||||
|
||||
let default =
|
||||
let meta =
|
||||
B0_meta.empty
|
||||
|> ~~ B0_meta.authors ["The fmt programmers"]
|
||||
|> ~~ B0_meta.maintainers
|
||||
["Daniel Bünzli <daniel.buenzl i@erratique.ch>"]
|
||||
|> ~~ B0_meta.homepage "https://erratique.ch/software/fmt"
|
||||
|> ~~ B0_meta.online_doc "https://erratique.ch/software/fmt/doc/"
|
||||
|> ~~ B0_meta.licenses ["ISC"]
|
||||
|> ~~ B0_meta.repo "git+https://erratique.ch/repos/fmt.git"
|
||||
|> ~~ B0_meta.issues "https://github.com/dbuenzli/fmt/issues"
|
||||
|> ~~ B0_meta.description_tags
|
||||
["string"; "format"; "pretty-print"; "org:erratique"]
|
||||
|> B0_meta.tag B0_opam.tag
|
||||
|> ~~ B0_opam.depopts ["base-unix", ""; "cmdliner", ""]
|
||||
|> ~~ B0_opam.conflicts
|
||||
[ "cmdliner", {|< "1.3.0"|}]
|
||||
|> ~~ B0_opam.depends
|
||||
[ "ocaml", {|>= "4.08.0"|};
|
||||
"ocamlfind", {|build|};
|
||||
"ocamlbuild", {|build|};
|
||||
"topkg", {|build & >= "1.1.0"|};
|
||||
]
|
||||
|> ~~ B0_opam.build
|
||||
{|[["ocaml" "pkg/pkg.ml" "build" "--dev-pkg" "%{dev}%"
|
||||
"--with-base-unix" "%{base-unix:installed}%"
|
||||
"--with-cmdliner" "%{cmdliner:installed}%"]]|}
|
||||
in
|
||||
B0_pack.make "default" ~doc:"fmt package" ~meta ~locked:true @@
|
||||
B0_unit.list ()
|
||||
146
unikernel/duniverse/fmt/CHANGES.md
Normal file
146
unikernel/duniverse/fmt/CHANGES.md
Normal file
|
|
@ -0,0 +1,146 @@
|
|||
v0.11.0 2025-07-25 Zagreb
|
||||
-------------------------
|
||||
|
||||
* Add `Fmt.{cardinal,ordinal}` to format english
|
||||
plurals. Thanks to Brian Ward for suggesting (#64).
|
||||
* Export `fmt` from `fmt.tty` and `fmt.cli` libraries.
|
||||
|
||||
v0.10.0 2025-03-10 La Forclaz (VS)
|
||||
----------------------------------
|
||||
|
||||
* Handle `cmdliner` deprecations.
|
||||
* Install each library in its own directory.
|
||||
* Add `Fmt.if'`, thanks to Rizo for the suggestion and patch.
|
||||
|
||||
v0.9.0 2021-10-22 Zagreb
|
||||
------------------------
|
||||
|
||||
* Add alert messages to deprecation annotations (#47).
|
||||
* The solution using ephemerons introduced in v0.8.7 for attaching
|
||||
custom data to formatters has unreliable performance characteristics
|
||||
in some usage scenarios. Namely use of `Fmt.styled` with
|
||||
`Fmt.[k]str` heavy code as those rely on `Format.{k,a}sprintf` which
|
||||
allocate one formatter per call.
|
||||
|
||||
Hence we subvert again the `Format` tag system to do dirty
|
||||
things. However since as of 4.08 tags became an extensible sum type
|
||||
we can keep our dirty things entirely internal.
|
||||
|
||||
Thanks to Thomas Leonard for reporting and David Kaloper Meršinjak
|
||||
for further investigations (#52).
|
||||
|
||||
v0.8.10 2021-10-04 Zagreb
|
||||
-------------------------
|
||||
|
||||
* Require OCaml >= 4.08. This drops the dependency on the
|
||||
`stdlib-shims` and `seq` packages.
|
||||
* Add the `[@@ocaml.deprecated]` annotation to deprecated
|
||||
functions. Thanks to Antonin Décimo for the patch.
|
||||
|
||||
v0.8.9 2020-09-23 Zagreb
|
||||
------------------------
|
||||
|
||||
* Fix `Dump.{iter_bindings,hashtbl}` which since 0.8.7 no longer
|
||||
prints seperators. Thanks to Edwin Török for the patch.
|
||||
* Open the result of `Fmt.error_msg` to make it easier
|
||||
to compose with other errors. Thanks to Thomas Leonard
|
||||
for the patch.
|
||||
|
||||
v0.8.8 2019-08-01 Zagreb
|
||||
------------------------
|
||||
|
||||
Fix build on 32-bit platforms.
|
||||
|
||||
v0.8.7 2019-07-21 Zagreb
|
||||
------------------------
|
||||
|
||||
* Require OCaml 4.05.
|
||||
* Add `Fmt.hex` and friends. Support for hex dumping.
|
||||
Thanks to David Kaloper Meršinjak for the design and implementation..
|
||||
* Add `Fmt.si_size` to format integer magnitudes using SI prefixes.
|
||||
* Add `Fmt.uint64_ns_span` to format time spans.
|
||||
* Add `Fmt.truncated` to truncate your long strings.
|
||||
* Add `Fmt.flush`, has the effect of `Format.pp_print_flush`.
|
||||
* Add `Fmt.[Dump.]{field,record}` for records (#9).
|
||||
* Add `Fmt.concat` to apply a list of formatters to a value.
|
||||
* Add `Fmt.{semi,sps}`, separators.
|
||||
* Add `Fmt.{error,error_msg}` to format `result` values.
|
||||
* Add `Fmt.failwith_notrace`.
|
||||
* Add `Fmt.( ++ )`, alias for `Fmt.append`.
|
||||
* Add `Fmt.Dump.string`.
|
||||
* Add more ANSI tty formatting styles and make them composable.
|
||||
* Change `Fmt.{const,comma,cut,sp}`, generalize signature.
|
||||
* Change `Fmt.append`, incompatible signature. Use `Fmt.(pair ~sep:nop)` if
|
||||
you were using it (backward compatible with earlier versions of `Fmt`).
|
||||
* Deprecate `Fmt.{strf,kstrf,strf_like}` in favor of `Fmt.{str,kstr,str_like}`.
|
||||
* Deprecate `Fmt.{always,unit}` in favor of `Fmt.any`.
|
||||
* Deprecate `Fmt.{prefix,suffix}` (specializes Fmt.( ++ )).
|
||||
* Deprecate `Fmt.styled_unit`.
|
||||
* No longer subvert the `Format` tag system to do dirty things.
|
||||
Thanks to David Kaloper Meršinjak for the work.
|
||||
|
||||
v0.8.6 2019-04-01 La Forclaz (VS)
|
||||
---------------------------------
|
||||
|
||||
* Add `Fmt.{seq,Dump.seq}` to format `'a Seq.t` values. Thanks to
|
||||
Hezekiah M. Carty for the patch.
|
||||
* Handle `Pervasives`'s deprecation via dependency on `stdlib-shims`.
|
||||
* `Fmt.Dump.signal` format signals added in 4.03.
|
||||
* Fix toplevel initialization for omod (#33).
|
||||
* Require at least OCaml 4.03 (drops dependency on `result` and `uchar`
|
||||
compatibility packages).
|
||||
|
||||
v0.8.5 2017-12-27 La Forclaz (VS)
|
||||
---------------------------------
|
||||
|
||||
* Fix `Fmt.{kstrf,strf_like}` when they are partially applied
|
||||
and repeatedly called. Thanks to Thomas Gazagnaire for the report.
|
||||
* Add `Fmt.comma`.
|
||||
* Relax the `Fmt.(invalid_arg, failwith)` type signature. Thanks to
|
||||
Hezekiah M. Carty for the patch.
|
||||
|
||||
v0.8.4 2017-07-08 Zagreb
|
||||
------------------------
|
||||
|
||||
* Add `Fmt.{invalid_arg,failwith}`. Thanks to Hezekiah M. Carty for the patch.
|
||||
|
||||
v0.8.3 2017-04-13 La Forclaz (VS)
|
||||
---------------------------------
|
||||
|
||||
* Fix `Fmt.exn_backtrace`. Thanks to Thomas Leonard for the report.
|
||||
|
||||
v0.8.2 2017-03-20 La Forclaz (VS)
|
||||
---------------------------------
|
||||
|
||||
* Fix `META` file.
|
||||
|
||||
v0.8.1 2017-03-15 La Forclaz (VS)
|
||||
---------------------------------
|
||||
|
||||
* `Fmt_tty.setup`, treat empty `TERM` env var as dumb.
|
||||
* Add `Fmt.Dump.uchar` formatter for inspecting `Uchar.t` values.
|
||||
|
||||
v0.8.0 2016-05-23 La Forclaz (VS)
|
||||
---------------------------------
|
||||
|
||||
* Build depend on topkg.
|
||||
* Relicense from BSD3 to ISC.
|
||||
* Tweak `Fmt.Dump.option` to indent like in sources.
|
||||
* Add `Fmt.Dump.signal` formatter for `Sys` signal numbers.
|
||||
* Add `Fmt[.Dump].result`, formatter for `result` values.
|
||||
* Add `Fmt.{words,paragraphs}` formatters on US-ASCII strings.
|
||||
* Add `Fmt.exn[_backtrace]`. Thanks to Edwin Török for suggesting.
|
||||
* Add `Fmt.quote`.
|
||||
* Rename `Fmt.text_range` to `Fmt.text_loc` and simplify output
|
||||
when range is a position.
|
||||
|
||||
v0.7.1 2015-12-03 Cambridge (UK)
|
||||
--------------------------------
|
||||
|
||||
* Add optional cmdliner support. See the `Fmt_cli` module provided
|
||||
by the package `fmt.cli`.
|
||||
|
||||
v0.7.0 2015-09-17 Cambridge (UK)
|
||||
--------------------------------
|
||||
|
||||
First Release.
|
||||
6
unikernel/duniverse/fmt/DEVEL.md
Normal file
6
unikernel/duniverse/fmt/DEVEL.md
Normal file
|
|
@ -0,0 +1,6 @@
|
|||
This project uses (perhaps the development version of) [`b0`] for
|
||||
development. Consult [b0 occasionally] for quick hints on how to
|
||||
perform common development tasks.
|
||||
|
||||
[`b0`]: https://erratique.ch/software/b0
|
||||
[b0 occasionally]: https://erratique.ch/software/b0/doc/occasionally.html
|
||||
13
unikernel/duniverse/fmt/LICENSE.md
Normal file
13
unikernel/duniverse/fmt/LICENSE.md
Normal file
|
|
@ -0,0 +1,13 @@
|
|||
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.
|
||||
35
unikernel/duniverse/fmt/README.md
Normal file
35
unikernel/duniverse/fmt/README.md
Normal file
|
|
@ -0,0 +1,35 @@
|
|||
Fmt — OCaml Format pretty-printer combinators
|
||||
=============================================
|
||||
|
||||
Fmt exposes combinators to devise `Format` pretty-printing functions.
|
||||
|
||||
Fmt depends only on the OCaml standard library. The optional `Fmt_tty`
|
||||
library that allows to setup formatters for terminal color output
|
||||
depends on the Unix library. The optional `Fmt_cli` library that
|
||||
provides command line support for Fmt depends on [`cmdliner`].
|
||||
|
||||
Fmt is distributed under the ISC license.
|
||||
|
||||
Home page: <http://erratique.ch/software/fmt>
|
||||
|
||||
[`cmdliner`]: http://erratique.ch/software/cmdliner
|
||||
|
||||
## Installation
|
||||
|
||||
Fmt can be installed with `opam`:
|
||||
|
||||
opam install fmt
|
||||
opam install base-unix cmdliner fmt # Install all optional libraries
|
||||
|
||||
If you don't use `opam` consult the [`opam`](opam) file for build
|
||||
instructions.
|
||||
|
||||
## Documentation
|
||||
|
||||
The documentation can be consulted [online] or via `odig doc fmt`.
|
||||
|
||||
Questions are welcome but better asked on the [OCaml forum] than on the
|
||||
issue tracker.
|
||||
|
||||
[online]: http://erratique.ch/software/fmt/doc/
|
||||
[OCaml forum]: https://discuss.ocaml.org/
|
||||
6
unikernel/duniverse/fmt/_tags
Normal file
6
unikernel/duniverse/fmt/_tags
Normal file
|
|
@ -0,0 +1,6 @@
|
|||
true : bin_annot, safe_string
|
||||
<_b0> : -traverse
|
||||
<src> : include
|
||||
<src/tty/fmt_tty*> : package(unix)
|
||||
<src/cli/fmt_cli*> : package(cmdliner)
|
||||
<src/top/fmt_top*> : package(compiler-libs.toplevel)
|
||||
15
unikernel/duniverse/fmt/doc/index.mld
Normal file
15
unikernel/duniverse/fmt/doc/index.mld
Normal file
|
|
@ -0,0 +1,15 @@
|
|||
{0 Fmt {%html: <span class="version">v0.11.0+dune</span>%}}
|
||||
|
||||
Fmt exposes combinators to devise {!Format} pretty-printing functions.
|
||||
|
||||
{1:library_fmt Library [fmt]}
|
||||
|
||||
{!modules: Fmt}
|
||||
|
||||
{1:library_tty Library [fmt.tty]}
|
||||
|
||||
{!modules: Fmt_tty}
|
||||
|
||||
{1:library_tty Library [fmt.cli]}
|
||||
|
||||
{!modules: Fmt_cli}
|
||||
3
unikernel/duniverse/fmt/dune-project
Normal file
3
unikernel/duniverse/fmt/dune-project
Normal file
|
|
@ -0,0 +1,3 @@
|
|||
(lang dune 1.0)
|
||||
(name fmt)
|
||||
(version v0.11.0+dune)
|
||||
34
unikernel/duniverse/fmt/fmt.opam
Normal file
34
unikernel/duniverse/fmt/fmt.opam
Normal file
|
|
@ -0,0 +1,34 @@
|
|||
version: "0.11.0+dune"
|
||||
opam-version: "2.0"
|
||||
name: "fmt"
|
||||
synopsis: "OCaml Format pretty-printer combinators"
|
||||
description: """\
|
||||
Fmt exposes combinators to devise `Format` pretty-printing functions.
|
||||
|
||||
Fmt depends only on the OCaml standard library. The optional `Fmt_tty`
|
||||
library that allows to setup formatters for terminal color output
|
||||
depends on the Unix library. The optional `Fmt_cli` library that
|
||||
provides command line support for Fmt depends on [`cmdliner`].
|
||||
|
||||
Fmt is distributed under the ISC license.
|
||||
|
||||
Home page: <http://erratique.ch/software/fmt>
|
||||
|
||||
[`cmdliner`]: http://erratique.ch/software/cmdliner"""
|
||||
maintainer: "Daniel Bünzli <daniel.buenzl i@erratique.ch>"
|
||||
authors: "The fmt programmers"
|
||||
license: "ISC"
|
||||
tags: ["string" "format" "pretty-print" "org:erratique"]
|
||||
homepage: "https://github.com/dune-universe/fmt"
|
||||
dev-repo: "git+https://github.com/dune-universe/fmt.git"
|
||||
bug-reports: "https://github.com/dbuenzli/fmt/issues"
|
||||
depends: [
|
||||
"ocaml" {>= "4.08.0"}
|
||||
"dune"
|
||||
]
|
||||
depopts: ["base-unix" "cmdliner"]
|
||||
conflicts: [
|
||||
"cmdliner" {< "1.3.0"}
|
||||
]
|
||||
build: [ "dune" "build" "-p" name "-j" jobs "@install" ]
|
||||
x-maintenance-intent: ["(latest)"]
|
||||
46
unikernel/duniverse/fmt/pkg/META
Normal file
46
unikernel/duniverse/fmt/pkg/META
Normal file
|
|
@ -0,0 +1,46 @@
|
|||
description = "OCaml Format pretty-printer combinators"
|
||||
version = "0.11.0+dune"
|
||||
requires = ""
|
||||
archive(byte) = "fmt.cma"
|
||||
archive(native) = "fmt.cmxa"
|
||||
plugin(byte) = "fmt.cma"
|
||||
plugin(native) = "fmt.cmxs"
|
||||
exists_if = "fmt.cma fmt.cmxa"
|
||||
|
||||
package "cli" (
|
||||
directory = "cli"
|
||||
description = "The fmt.cli library"
|
||||
version = "0.11.0+dune"
|
||||
requires = "cmdliner fmt"
|
||||
exports = "fmt"
|
||||
archive(byte) = "fmt_cli.cma"
|
||||
archive(native) = "fmt_cli.cmxa"
|
||||
plugin(byte) = "fmt_cli.cma"
|
||||
plugin(native) = "fmt_cli.cmxs"
|
||||
exists_if = "fmt_cli.cma fmt_cli.cmxa"
|
||||
)
|
||||
|
||||
package "top" (
|
||||
directory = "top"
|
||||
description = "The fmt.top library"
|
||||
version = "0.11.0+dune"
|
||||
requires = "fmt fmt.tty"
|
||||
archive(byte) = "fmt_top.cma"
|
||||
archive(native) = "fmt_top.cmxa"
|
||||
plugin(byte) = "fmt_top.cma"
|
||||
plugin(native) = "fmt_top.cmxs"
|
||||
exists_if = "fmt_top.cma fmt_top.cmxa"
|
||||
)
|
||||
|
||||
package "tty" (
|
||||
directory = "tty"
|
||||
description = "The fmt.tty library"
|
||||
version = "0.11.0+dune"
|
||||
requires = "unix fmt"
|
||||
exports = "fmt"
|
||||
archive(byte) = "fmt_tty.cma"
|
||||
archive(native) = "fmt_tty.cmxa"
|
||||
plugin(byte) = "fmt_tty.cma"
|
||||
plugin(native) = "fmt_tty.cmxs"
|
||||
exists_if = "fmt_tty.cma fmt_tty.cmxa"
|
||||
)
|
||||
18
unikernel/duniverse/fmt/pkg/pkg.ml
Executable file
18
unikernel/duniverse/fmt/pkg/pkg.ml
Executable file
|
|
@ -0,0 +1,18 @@
|
|||
#!/usr/bin/env ocaml
|
||||
#use "topfind"
|
||||
#require "topkg"
|
||||
open Topkg
|
||||
|
||||
let unix = Conf.with_pkg "base-unix"
|
||||
let cmdliner = Conf.with_pkg "cmdliner"
|
||||
|
||||
let () =
|
||||
Pkg.describe "fmt" @@ fun c ->
|
||||
let unix = Conf.value c unix in
|
||||
let cmdliner = Conf.value c cmdliner in
|
||||
Ok [ Pkg.mllib "src/fmt.mllib";
|
||||
Pkg.mllib ~cond:unix ~dst_dir:"tty" "src/tty/fmt_tty.mllib";
|
||||
Pkg.mllib ~cond:cmdliner ~dst_dir:"cli" "src/cli/fmt_cli.mllib";
|
||||
Pkg.mllib ~api:[] ~dst_dir:"top" "src/top/fmt_top.mllib";
|
||||
Pkg.lib ~dst:"top/fmt_tty_top_init.ml" "src/top/fmt_tty_top_init.ml";
|
||||
Pkg.doc "doc/index.mld" ~dst:"odoc-pages/index.mld" ]
|
||||
8
unikernel/duniverse/fmt/src/cli/dune
Normal file
8
unikernel/duniverse/fmt/src/cli/dune
Normal file
|
|
@ -0,0 +1,8 @@
|
|||
(library
|
||||
(name fmt_cli)
|
||||
(public_name fmt.cli)
|
||||
(optional)
|
||||
(libraries fmt cmdliner)
|
||||
(modules fmt_cli)
|
||||
(flags :standard -w -3-6-27)
|
||||
(wrapped false))
|
||||
15
unikernel/duniverse/fmt/src/cli/fmt_cli.ml
Normal file
15
unikernel/duniverse/fmt/src/cli/fmt_cli.ml
Normal file
|
|
@ -0,0 +1,15 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2015 The fmt programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
let strf = Format.asprintf
|
||||
|
||||
open Cmdliner
|
||||
|
||||
let style_renderer ?env ?docs () =
|
||||
let enum = ["auto", None; "always", Some `Ansi_tty; "never", Some `None] in
|
||||
let color = Arg.enum enum in
|
||||
let enum_alts = Arg.doc_alts_enum enum in
|
||||
let doc = strf "Colorize the output. $(docv) must be %s." enum_alts in
|
||||
Arg.(value & opt color None & info ["color"] ?env ~doc ~docv:"WHEN" ?docs)
|
||||
28
unikernel/duniverse/fmt/src/cli/fmt_cli.mli
Normal file
28
unikernel/duniverse/fmt/src/cli/fmt_cli.mli
Normal file
|
|
@ -0,0 +1,28 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2015 The fmt programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
(** {!Cmdliner} support for [Fmt]. *)
|
||||
|
||||
(** {1 Option for setting the style renderer} *)
|
||||
|
||||
val style_renderer : ?env:Cmdliner.Cmd.Env.info -> ?docs:string -> unit ->
|
||||
Fmt.style_renderer option Cmdliner.Term.t
|
||||
(** [style_renderer ?env ?docs ()] is a {!Cmdliner} option [--color] that can
|
||||
be directly used with the optional arguments of
|
||||
{{!Fmt_tty.tty_setup}TTY setup} or to control
|
||||
{{!Fmt.set_style_renderer}style rendering}. The option is
|
||||
documented under [docs] (defaults to the default in
|
||||
{!Cmdliner.Arg.info}).
|
||||
|
||||
The option is a tri-state enumerated value that when used with
|
||||
{{!Fmt_tty.tty_setup}TTY setup} takes over the automatic setup:
|
||||
{ul
|
||||
{- [--color=never], the value is [Some `None], forces no styling.}
|
||||
{- [--color=always], the value is [Some `Ansi_tty], forces ANSI styling.}
|
||||
{- [--color=auto] or absent, the value is [None], automatic setup
|
||||
takes place.}}
|
||||
|
||||
If [env] is provided, the option default value ([None]) can be
|
||||
overridden by the corresponding environment variable. *)
|
||||
1
unikernel/duniverse/fmt/src/cli/fmt_cli.mllib
Normal file
1
unikernel/duniverse/fmt/src/cli/fmt_cli.mllib
Normal file
|
|
@ -0,0 +1 @@
|
|||
Fmt_cli
|
||||
6
unikernel/duniverse/fmt/src/dune
Normal file
6
unikernel/duniverse/fmt/src/dune
Normal file
|
|
@ -0,0 +1,6 @@
|
|||
(library
|
||||
(name fmt)
|
||||
(public_name fmt)
|
||||
(modules fmt)
|
||||
(flags :standard -w -3-6-27-32-34-50)
|
||||
(wrapped false))
|
||||
812
unikernel/duniverse/fmt/src/fmt.ml
Normal file
812
unikernel/duniverse/fmt/src/fmt.ml
Normal file
|
|
@ -0,0 +1,812 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2014 The fmt programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
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 if' bool pp = if bool then pp else nop
|
||||
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 "@[<v>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
|
||||
|
||||
let cardinal ?zero ~one ?other () =
|
||||
let other = match other with
|
||||
| Some other -> other
|
||||
| None -> fun ppf i -> one ppf i; char ppf 's'
|
||||
in
|
||||
let zero = Option.value ~default:other zero in
|
||||
fun ppf i -> match Int.abs i with
|
||||
| 0 -> zero ppf 0 | 1 -> one ppf 1 | n -> other ppf i
|
||||
|
||||
let ordinal =
|
||||
let one ppf i = int ppf i; string ppf "st" in
|
||||
let two ppf i = int ppf i; string ppf "nd" in
|
||||
let three ppf i = int ppf i; string ppf "rd" in
|
||||
let other ppf i = int ppf i; string ppf "th" in
|
||||
fun ?zero ?(one = one) ?(two = two) ?(three = three) ?(other = other) () ->
|
||||
let zero = Option.value ~default:other zero in
|
||||
fun ppf i ->
|
||||
if i = 0 then zero ppf i else
|
||||
let n = Int.abs i in
|
||||
let mod10 = n mod 10 in
|
||||
let mod100 = n mod 100 in
|
||||
if mod10 = 1 && mod100 <> 11 then one ppf i else
|
||||
if mod10 = 2 && mod100 <> 12 then two ppf i else
|
||||
if mod10 = 3 && mod100 <> 13 then three ppf i else
|
||||
other ppf i
|
||||
|
||||
(* 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)
|
||||
708
unikernel/duniverse/fmt/src/fmt.mli
Normal file
708
unikernel/duniverse/fmt/src/fmt.mli
Normal file
|
|
@ -0,0 +1,708 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2014 The fmt programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
(** {!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 if' : bool -> 'a t -> 'a t
|
||||
(** [if' bool pp] is [pp] if [bool] is [true] and {!nop} otherwise. *)
|
||||
|
||||
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. *)
|
||||
|
||||
val cardinal : ?zero:int t -> one:int t -> ?other:int t -> unit -> int t
|
||||
(** [cardinal ?zero ~one ?other ()] formats an integer by selecting a
|
||||
formatter according to the cardinal english plural form of its absolute
|
||||
value [n]:
|
||||
{ul
|
||||
{- [zero], if [n = 0]. Defaults to [other] (as per
|
||||
{{:https://www.unicode.org/cldr/charts/47/supplemental/language_plural_rules.html#en}english rules}).}
|
||||
{- [one], if [n = 1].}
|
||||
{- [other], otherwise. Defaults to [one] followed by a ['s'] character.}} *)
|
||||
|
||||
val ordinal :
|
||||
?zero:int t -> ?one:int t -> ?two:int t -> ?three:int t -> ?other:int t ->
|
||||
unit -> int t
|
||||
(** [ordinal ?zero ?one ?two ?three ?other ()] formats an integer by selecting a
|
||||
formatter according to the ordinal english plural form of its absolute
|
||||
value [n]:
|
||||
{ul
|
||||
{- [zero], if [n = 0]. Defaults to [other] (as per
|
||||
{{:https://www.unicode.org/cldr/charts/47/supplemental/language_plural_rules.html#en}english rules}).}
|
||||
{- [one], if [n mod 10 = 1 && n mod 100 <> 11]. Defaults to ["%dst"].}
|
||||
{- [two], if [n mod 10 = 2 && n mod 100 <> 12]. Defaults to ["%dnd"].}
|
||||
{- [three], if [n mod 10 = 3 && n mod 100 <> 13]. Defaults to ["%drd"].}
|
||||
{- [other] otherwise. Defaults to ["%dth"].}} *)
|
||||
|
||||
(** {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 background color or high-intensity color on [`Hi _].}
|
||||
{- [#color] is the foreground color, {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]. *)
|
||||
1
unikernel/duniverse/fmt/src/fmt.mllib
Normal file
1
unikernel/duniverse/fmt/src/fmt.mllib
Normal file
|
|
@ -0,0 +1 @@
|
|||
Fmt
|
||||
6
unikernel/duniverse/fmt/src/top/dune
Normal file
6
unikernel/duniverse/fmt/src/top/dune
Normal file
|
|
@ -0,0 +1,6 @@
|
|||
(library
|
||||
(name fmt_top)
|
||||
(public_name fmt.top)
|
||||
(libraries compiler-libs.toplevel fmt)
|
||||
(modules fmt_top)
|
||||
(wrapped false))
|
||||
6
unikernel/duniverse/fmt/src/top/fmt_top.ml
Normal file
6
unikernel/duniverse/fmt/src/top/fmt_top.ml
Normal file
|
|
@ -0,0 +1,6 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2015 The fmt programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
let () = ignore (Toploop.use_file Format.err_formatter "fmt_tty_top_init.ml")
|
||||
1
unikernel/duniverse/fmt/src/top/fmt_top.mllib
Normal file
1
unikernel/duniverse/fmt/src/top/fmt_top.mllib
Normal file
|
|
@ -0,0 +1 @@
|
|||
Fmt_top
|
||||
6
unikernel/duniverse/fmt/src/top/fmt_tty_top_init.ml
Normal file
6
unikernel/duniverse/fmt/src/top/fmt_tty_top_init.ml
Normal file
|
|
@ -0,0 +1,6 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2015 The fmt programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
let () = Fmt_tty.setup_std_outputs ()
|
||||
8
unikernel/duniverse/fmt/src/tty/dune
Normal file
8
unikernel/duniverse/fmt/src/tty/dune
Normal file
|
|
@ -0,0 +1,8 @@
|
|||
(library
|
||||
(name fmt_tty)
|
||||
(public_name fmt.tty)
|
||||
(optional)
|
||||
(libraries unix fmt)
|
||||
(modules fmt_tty)
|
||||
(flags :standard -w -3-6-27)
|
||||
(wrapped false))
|
||||
61
unikernel/duniverse/fmt/src/tty/fmt_tty.ml
Normal file
61
unikernel/duniverse/fmt/src/tty/fmt_tty.ml
Normal file
|
|
@ -0,0 +1,61 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2015 The fmt programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
let is_infix ~affix s =
|
||||
(* Damned, already missing astring, from which this is c&p *)
|
||||
let len_a = String.length affix in
|
||||
let len_s = String.length s in
|
||||
if len_a > len_s then false else
|
||||
let max_idx_a = len_a - 1 in
|
||||
let max_idx_s = len_s - len_a in
|
||||
let rec loop i k =
|
||||
if i > max_idx_s then false else
|
||||
if k > max_idx_a then true else
|
||||
if k > 0 then
|
||||
if String.get affix k = String.get s (i + k) then loop i (k + 1) else
|
||||
loop (i + 1) 0
|
||||
else if String.get affix 0 = String.get s i then loop i 1 else
|
||||
loop (i + 1) 0
|
||||
in
|
||||
loop 0 0
|
||||
|
||||
let setup ?style_renderer ?utf_8 oc =
|
||||
let ppf =
|
||||
if oc == Stdlib.stdout then Fmt.stdout else
|
||||
if oc == Stdlib.stderr then Fmt.stderr else
|
||||
Format.formatter_of_out_channel oc
|
||||
in
|
||||
let style_renderer = match style_renderer with
|
||||
| Some r -> r
|
||||
| None ->
|
||||
let dumb =
|
||||
try match Sys.getenv "TERM" with
|
||||
| "dumb" | "" -> true
|
||||
| _ -> false
|
||||
with
|
||||
Not_found -> true
|
||||
in
|
||||
let isatty = try Unix.(isatty (descr_of_out_channel oc)) with
|
||||
| Unix.Unix_error _ -> false
|
||||
in
|
||||
if not dumb && isatty then `Ansi_tty else `None
|
||||
in
|
||||
let utf_8 = match utf_8 with
|
||||
| Some b -> b
|
||||
| None ->
|
||||
let has_utf_8 var =
|
||||
try is_infix ~affix:"UTF-8" (String.uppercase_ascii (Sys.getenv var))
|
||||
with Not_found -> false
|
||||
in
|
||||
has_utf_8 "LANG" || has_utf_8 "LC_ALL" || has_utf_8 "LC_CTYPE"
|
||||
in
|
||||
Fmt.set_style_renderer ppf style_renderer;
|
||||
Fmt.set_utf_8 ppf utf_8;
|
||||
ppf
|
||||
|
||||
let setup_std_outputs ?style_renderer ?utf_8 () =
|
||||
ignore (setup ?style_renderer ?utf_8 stdout);
|
||||
ignore (setup ?style_renderer ?utf_8 stderr);
|
||||
()
|
||||
33
unikernel/duniverse/fmt/src/tty/fmt_tty.mli
Normal file
33
unikernel/duniverse/fmt/src/tty/fmt_tty.mli
Normal file
|
|
@ -0,0 +1,33 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2015 The fmt programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
(** [Fmt] TTY setup.
|
||||
|
||||
[Fmt_tty] provides simple automatic setup on channel formatters for:
|
||||
{ul
|
||||
{- {!Fmt.set_style_renderer}. [`Ansi_tty] is used if the channel
|
||||
{{!Unix.isatty}is a tty} and the environment variable
|
||||
[TERM] is defined and its value is not ["dumb"]. [`None] is
|
||||
used otherwise.}
|
||||
{- {!Fmt.set_utf_8}. [true] is used if one of the following
|
||||
environment variables has ["UTF-8"] as a case insensitive
|
||||
substring: [LANG], [LC_ALL], [LC_CTYPE].}} *)
|
||||
|
||||
(** {1:tty_setup TTY setup} *)
|
||||
|
||||
val setup : ?style_renderer:Fmt.style_renderer -> ?utf_8:bool ->
|
||||
out_channel -> Format.formatter
|
||||
(** [setup ?style_renderer ?utf_8 outc] is a formatter for [outc] with
|
||||
{!Fmt.set_style_renderer} and {!Fmt.set_utf_8} correctly setup. If
|
||||
[style_renderer] or [utf_8] are specified they override the automatic
|
||||
setup.
|
||||
|
||||
If [outc] is {!stdout}, {!Fmt.stdout} is returned. If [outc] is
|
||||
{!stderr}, {!Fmt.stderr} is returned. *)
|
||||
|
||||
val setup_std_outputs : ?style_renderer:Fmt.style_renderer -> ?utf_8:bool ->
|
||||
unit -> unit
|
||||
(** [setup_std_outputs ?style_renderer ?utf_8 ()] applies {!setup}
|
||||
on {!stdout} and {!stderr}. *)
|
||||
1
unikernel/duniverse/fmt/src/tty/fmt_tty.mllib
Normal file
1
unikernel/duniverse/fmt/src/tty/fmt_tty.mllib
Normal file
|
|
@ -0,0 +1 @@
|
|||
Fmt_tty
|
||||
11
unikernel/duniverse/fmt/test/styled_perf_bug.ml
Normal file
11
unikernel/duniverse/fmt/test/styled_perf_bug.ml
Normal file
|
|
@ -0,0 +1,11 @@
|
|||
let n = 10000
|
||||
|
||||
let () =
|
||||
while true do
|
||||
let t0 = Unix.gettimeofday () in
|
||||
for _i = 1 to n do
|
||||
ignore @@ Fmt.str "Hello %a" Fmt.string "world"
|
||||
done;
|
||||
let t1 = Unix.gettimeofday () in
|
||||
Printf.printf "Formatted %.0f messages/second\n%!" (float n /. (t1 -. t0))
|
||||
done
|
||||
329
unikernel/duniverse/fmt/test/test_fmt.ml
Normal file
329
unikernel/duniverse/fmt/test/test_fmt.ml
Normal file
|
|
@ -0,0 +1,329 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2015 The fmt programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
open B0_testing
|
||||
|
||||
let str pp v = Format.asprintf "%a" pp v
|
||||
let snap s = Snap.string s
|
||||
|
||||
let test_dump_uchar =
|
||||
Test.test "Fmt.Dump.uchar" @@ fun () ->
|
||||
let str = str Fmt.Dump.uchar in
|
||||
snap (str Uchar.min) @@ __POS_OF__"U+0000";
|
||||
snap (str Uchar.(succ min)) @@ __POS_OF__"U+0001";
|
||||
snap (str Uchar.(of_int 0xFFFF)) @@ __POS_OF__"U+FFFF";
|
||||
snap (str Uchar.(succ (of_int 0xFFFF))) @@ __POS_OF__ "U+10000";
|
||||
snap (str Uchar.(pred max)) @@ __POS_OF__ "U+10FFFE";
|
||||
snap (str Uchar.max) @@ __POS_OF__ "U+10FFFF";
|
||||
()
|
||||
|
||||
let test_utf_8 =
|
||||
Test.test "Fmt.utf_8" @@ fun () ->
|
||||
let ppf = Format.formatter_of_buffer (Buffer.create 23) in
|
||||
Test.bool (Fmt.utf_8 ppf) true;
|
||||
Fmt.set_utf_8 ppf false;
|
||||
Test.bool (Fmt.utf_8 ppf) false;
|
||||
Fmt.set_utf_8 ppf true;
|
||||
Test.bool (Fmt.utf_8 ppf) true;
|
||||
()
|
||||
|
||||
let test_style_renderer =
|
||||
Test.test "Fmt.style_renderer" @@ fun () ->
|
||||
let ppf = Format.formatter_of_buffer (Buffer.create 23) in
|
||||
assert (Fmt.style_renderer ppf = `None);
|
||||
Fmt.set_style_renderer ppf `Ansi_tty;
|
||||
assert (Fmt.style_renderer ppf = `Ansi_tty);
|
||||
Fmt.set_style_renderer ppf `None;
|
||||
assert (Fmt.style_renderer ppf = `None);
|
||||
()
|
||||
|
||||
let test_exn_typechecks =
|
||||
Test.test "Fmt.{failwith,invalid_arg} types" @@ fun () ->
|
||||
let (_ : bool) = true || Fmt.failwith "%s" "" in
|
||||
let (_ : bool) = true || Fmt.invalid_arg "%s" "" in
|
||||
()
|
||||
|
||||
let test_kstr_str_like_partial_app =
|
||||
Test.test "Fmt.{kstr,str_like} partial application" @@ fun () ->
|
||||
let assertf f = assert (f "X" = f "X") in
|
||||
let test_kstrf fmt = Fmt.kstr (fun x -> x) fmt in
|
||||
let test_strf_like fmt = Fmt.str_like Fmt.stderr fmt in
|
||||
assertf (test_strf_like "%s");
|
||||
assertf (test_kstrf "%s");
|
||||
()
|
||||
|
||||
let test_cardinal =
|
||||
Test.test "Fmt.cardinal" @@ fun () ->
|
||||
let item = Fmt.cardinal ~one:(fun ppf n -> Fmt.pf ppf "%d item" n) () in
|
||||
let item n = Fmt.str "%a" item n in
|
||||
let children =
|
||||
let zero = Fmt.any "are no children" in
|
||||
let one = Fmt.any "is a child" in
|
||||
let other = Fmt.any "are children" in
|
||||
Fmt.cardinal ~zero ~one ~other ()
|
||||
in
|
||||
let children n = Fmt.str "There %a." children n in
|
||||
Snap.string (item 0) @@ __POS_OF__ "0 items";
|
||||
Snap.string (item 1) @@ __POS_OF__ "1 item";
|
||||
Snap.string (item 3) @@ __POS_OF__ "3 items";
|
||||
Snap.string (children 0) @@ __POS_OF__ "There are no children.";
|
||||
Snap.string (children 1) @@ __POS_OF__ "There is a child.";
|
||||
Snap.string (children 67) @@ __POS_OF__ "There are children.";
|
||||
()
|
||||
|
||||
let test_ordinal =
|
||||
Test.test "Fmt.ordinal" @@ fun () ->
|
||||
let ord = Fmt.ordinal () in
|
||||
let ord n = Fmt.str "%a" ord n in
|
||||
Snap.string (ord 0) @@ __POS_OF__ "0th";
|
||||
Snap.string (ord 1) @@ __POS_OF__ "1st";
|
||||
Snap.string (ord 2) @@ __POS_OF__ "2nd";
|
||||
Snap.string (ord 3) @@ __POS_OF__ "3rd";
|
||||
Snap.string (ord 4) @@ __POS_OF__ "4th";
|
||||
Snap.string (ord 11) @@ __POS_OF__ "11th";
|
||||
Snap.string (ord 12) @@ __POS_OF__ "12th";
|
||||
Snap.string (ord 21) @@ __POS_OF__ "21st";
|
||||
Snap.string (ord 22) @@ __POS_OF__ "22nd";
|
||||
Snap.string (ord 66) @@ __POS_OF__ "66th";
|
||||
Snap.string (ord 101) @@ __POS_OF__ "101st";
|
||||
Snap.string (ord 111) @@ __POS_OF__ "111th";
|
||||
()
|
||||
|
||||
let test_byte_size =
|
||||
Test.test "Fmt.byte_size" @@ fun () ->
|
||||
let size = str Fmt.byte_size in
|
||||
snap (size 0) @@ __POS_OF__ "0B";
|
||||
snap (size 999) @@ __POS_OF__ "999B";
|
||||
snap (size 1000) @@ __POS_OF__ "1kB";
|
||||
snap (size 1001) @@ __POS_OF__ "1.01kB";
|
||||
snap (size 1010) @@ __POS_OF__ "1.01kB";
|
||||
snap (size 1011) @@ __POS_OF__ "1.02kB";
|
||||
snap (size 1020) @@ __POS_OF__ "1.02kB";
|
||||
snap (size 1100) @@ __POS_OF__ "1.1kB";
|
||||
snap (size 1101) @@ __POS_OF__ "1.11kB";
|
||||
snap (size 1109) @@ __POS_OF__ "1.11kB";
|
||||
snap (size 1111) @@ __POS_OF__ "1.12kB";
|
||||
snap (size 1119) @@ __POS_OF__ "1.12kB";
|
||||
snap (size 1120) @@ __POS_OF__ "1.12kB";
|
||||
snap (size 1121) @@ __POS_OF__ "1.13kB";
|
||||
snap (size 9990) @@ __POS_OF__ "9.99kB";
|
||||
snap (size 9991) @@ __POS_OF__ "10kB";
|
||||
snap (size 9999) @@ __POS_OF__ "10kB";
|
||||
snap (size 10_000) @@ __POS_OF__ "10kB";
|
||||
snap (size 10_001) @@ __POS_OF__ "10.1kB";
|
||||
snap (size 10_002) @@ __POS_OF__ "10.1kB";
|
||||
snap (size 10_099) @@ __POS_OF__ "10.1kB";
|
||||
snap (size 10_100) @@ __POS_OF__ "10.1kB";
|
||||
snap (size 10_100) @@ __POS_OF__ "10.1kB";
|
||||
snap (size 10_101) @@ __POS_OF__ "10.2kB";
|
||||
snap (size 10_199) @@ __POS_OF__ "10.2kB";
|
||||
snap (size 10_199) @@ __POS_OF__ "10.2kB";
|
||||
snap (size 10_200) @@ __POS_OF__ "10.2kB";
|
||||
snap (size 10_201) @@ __POS_OF__ "10.3kB";
|
||||
snap (size 99_901) @@ __POS_OF__ "100kB";
|
||||
snap (size 99_999) @@ __POS_OF__ "100kB";
|
||||
snap (size 100_000) @@ __POS_OF__ "100kB";
|
||||
snap (size 100_001) @@ __POS_OF__ "101kB";
|
||||
snap (size 100_999) @@ __POS_OF__ "101kB";
|
||||
snap (size 101_000) @@ __POS_OF__ "101kB";
|
||||
snap (size 101_001) @@ __POS_OF__ "102kB";
|
||||
snap (size 999_000) @@ __POS_OF__ "999kB";
|
||||
snap (size 999_001) @@ __POS_OF__ "1MB";
|
||||
snap (size 999_999) @@ __POS_OF__ "1MB";
|
||||
snap (size 1_000_000) @@ __POS_OF__ "1MB";
|
||||
snap (size 1_000_001) @@ __POS_OF__ "1.01MB";
|
||||
snap (size 1_009_999) @@ __POS_OF__ "1.01MB";
|
||||
snap (size 1_010_000) @@ __POS_OF__ "1.01MB";
|
||||
snap (size 1_010_001) @@ __POS_OF__ "1.02MB";
|
||||
snap (size 1_019_999) @@ __POS_OF__ "1.02MB";
|
||||
snap (size 1_020_000) @@ __POS_OF__ "1.02MB";
|
||||
snap (size 1_020_001) @@ __POS_OF__ "1.03MB";
|
||||
snap (size 1_990_000) @@ __POS_OF__ "1.99MB";
|
||||
snap (size 1_990_001) @@ __POS_OF__ "2MB";
|
||||
snap (size 1_999_999) @@ __POS_OF__ "2MB";
|
||||
snap (size 2_000_000) @@ __POS_OF__ "2MB";
|
||||
snap (size 9_990_000) @@ __POS_OF__ "9.99MB";
|
||||
snap (size 9_990_001) @@ __POS_OF__ "10MB";
|
||||
snap (size 9_990_999) @@ __POS_OF__ "10MB";
|
||||
snap (size 10_000_000) @@ __POS_OF__ "10MB";
|
||||
snap (size 10_000_001) @@ __POS_OF__ "10.1MB";
|
||||
snap (size 10_099_999) @@ __POS_OF__ "10.1MB";
|
||||
snap (size 10_100_000) @@ __POS_OF__ "10.1MB";
|
||||
snap (size 10_900_001) @@ __POS_OF__ "11MB";
|
||||
snap (size 10_999_999) @@ __POS_OF__ "11MB";
|
||||
snap (size 11_000_000) @@ __POS_OF__ "11MB";
|
||||
snap (size 11_000_001) @@ __POS_OF__ "11.1MB";
|
||||
snap (size 99_900_000) @@ __POS_OF__ "99.9MB";
|
||||
snap (size 99_900_001) @@ __POS_OF__ "100MB";
|
||||
snap (size 99_999_999) @@ __POS_OF__ "100MB";
|
||||
snap (size 100_000_000) @@ __POS_OF__ "100MB";
|
||||
snap (size 100_000_001) @@ __POS_OF__ "101MB";
|
||||
snap (size 100_999_999) @@ __POS_OF__ "101MB";
|
||||
snap (size 101_000_000) @@ __POS_OF__ "101MB";
|
||||
snap (size 101_000_000) @@ __POS_OF__ "101MB";
|
||||
snap (size 999_000_000) @@ __POS_OF__ "999MB";
|
||||
snap (size 999_000_001) @@ __POS_OF__ "1GB";
|
||||
snap (size 999_999_999) @@ __POS_OF__ "1GB";
|
||||
snap (size 1_000_000_000) @@ __POS_OF__ "1GB";
|
||||
snap (size 1_000_000_001) @@ __POS_OF__ "1.01GB";
|
||||
snap (size 1_000_000_001) @@ __POS_OF__ "1.01GB";
|
||||
()
|
||||
|
||||
let test_uint64_ns_span =
|
||||
Test.test "Fmt.uint64_ns_span" @@ fun () ->
|
||||
let span s = Fmt.str "%a" Fmt.uint64_ns_span (Int64.of_string s) in
|
||||
snap (span "0u0") @@ __POS_OF__ "0ns";
|
||||
snap (span "0u999") @@ __POS_OF__ "999ns";
|
||||
snap (span "0u1_000") @@ __POS_OF__ "1us";
|
||||
snap (span "0u1_001") @@ __POS_OF__ "1.01us";
|
||||
snap (span "0u1_009") @@ __POS_OF__ "1.01us";
|
||||
snap (span "0u1_010") @@ __POS_OF__ "1.01us";
|
||||
snap (span "0u1_011") @@ __POS_OF__ "1.02us";
|
||||
snap (span "0u1_090") @@ __POS_OF__ "1.09us";
|
||||
snap (span "0u1_091") @@ __POS_OF__ "1.1us";
|
||||
snap (span "0u1_100") @@ __POS_OF__ "1.1us";
|
||||
snap (span "0u1_101") @@ __POS_OF__ "1.11us";
|
||||
snap (span "0u1_109") @@ __POS_OF__ "1.11us";
|
||||
snap (span "0u1_110") @@ __POS_OF__ "1.11us";
|
||||
snap (span "0u1_111") @@ __POS_OF__ "1.12us";
|
||||
snap (span "0u1_990") @@ __POS_OF__ "1.99us";
|
||||
snap (span "0u1_991") @@ __POS_OF__ "2us";
|
||||
snap (span "0u1_999") @@ __POS_OF__ "2us";
|
||||
snap (span "0u2_000") @@ __POS_OF__ "2us";
|
||||
snap (span "0u2_001") @@ __POS_OF__ "2.01us";
|
||||
snap (span "0u9_990") @@ __POS_OF__ "9.99us";
|
||||
snap (span "0u9_991") @@ __POS_OF__ "10us";
|
||||
snap (span "0u9_999") @@ __POS_OF__ "10us";
|
||||
snap (span "0u10_000") @@ __POS_OF__ "10us";
|
||||
snap (span "0u10_001") @@ __POS_OF__ "10.1us";
|
||||
snap (span "0u10_099") @@ __POS_OF__ "10.1us";
|
||||
snap (span "0u10_100") @@ __POS_OF__ "10.1us";
|
||||
snap (span "0u10_101") @@ __POS_OF__ "10.2us";
|
||||
snap (span "0u10_900") @@ __POS_OF__ "10.9us";
|
||||
snap (span "0u10_901") @@ __POS_OF__ "11us";
|
||||
snap (span "0u10_999") @@ __POS_OF__ "11us";
|
||||
snap (span "0u11_000") @@ __POS_OF__ "11us";
|
||||
snap (span "0u11_001") @@ __POS_OF__ "11.1us";
|
||||
snap (span "0u11_099") @@ __POS_OF__ "11.1us";
|
||||
snap (span "0u11_100") @@ __POS_OF__ "11.1us";
|
||||
snap (span "0u11_101") @@ __POS_OF__ "11.2us";
|
||||
snap (span "0u99_900") @@ __POS_OF__ "99.9us";
|
||||
snap (span "0u99_901") @@ __POS_OF__ "100us";
|
||||
snap (span "0u99_999") @@ __POS_OF__ "100us";
|
||||
snap (span "0u100_000") @@ __POS_OF__ "100us";
|
||||
snap (span "0u100_001") @@ __POS_OF__ "101us";
|
||||
snap (span "0u100_999") @@ __POS_OF__ "101us";
|
||||
snap (span "0u101_000") @@ __POS_OF__ "101us";
|
||||
snap (span "0u101_001") @@ __POS_OF__ "102us";
|
||||
snap (span "0u101_999") @@ __POS_OF__ "102us";
|
||||
snap (span "0u102_000") @@ __POS_OF__ "102us";
|
||||
snap (span "0u999_000") @@ __POS_OF__ "999us";
|
||||
snap (span "0u999_001") @@ __POS_OF__ "1ms";
|
||||
snap (span "0u999_001") @@ __POS_OF__ "1ms";
|
||||
snap (span "0u999_999") @@ __POS_OF__ "1ms";
|
||||
snap (span "0u1_000_000") @@ __POS_OF__ "1ms";
|
||||
snap (span "0u1_000_001") @@ __POS_OF__ "1.01ms";
|
||||
snap (span "0u1_009_999") @@ __POS_OF__ "1.01ms";
|
||||
snap (span "0u1_010_000") @@ __POS_OF__ "1.01ms";
|
||||
snap (span "0u1_010_001") @@ __POS_OF__ "1.02ms";
|
||||
snap (span "0u9_990_000") @@ __POS_OF__ "9.99ms";
|
||||
snap (span "0u9_990_001") @@ __POS_OF__ "10ms";
|
||||
snap (span "0u9_999_999") @@ __POS_OF__ "10ms";
|
||||
snap (span "0u10_000_000") @@ __POS_OF__ "10ms";
|
||||
snap (span "0u10_000_001") @@ __POS_OF__ "10.1ms";
|
||||
snap (span "0u10_000_001") @@ __POS_OF__ "10.1ms";
|
||||
snap (span "0u10_099_999") @@ __POS_OF__ "10.1ms";
|
||||
snap (span "0u10_100_000") @@ __POS_OF__ "10.1ms";
|
||||
snap (span "0u10_100_001") @@ __POS_OF__ "10.2ms";
|
||||
snap (span "0u99_900_000") @@ __POS_OF__ "99.9ms";
|
||||
snap (span "0u99_900_001") @@ __POS_OF__ "100ms";
|
||||
snap (span "0u99_999_999") @@ __POS_OF__ "100ms";
|
||||
snap (span "0u100_000_000") @@ __POS_OF__ "100ms";
|
||||
snap (span "0u100_000_001") @@ __POS_OF__ "101ms";
|
||||
snap (span "0u100_999_999") @@ __POS_OF__ "101ms";
|
||||
snap (span "0u101_000_000") @@ __POS_OF__ "101ms";
|
||||
snap (span "0u101_000_001") @@ __POS_OF__ "102ms";
|
||||
snap (span "0u999_000_000") @@ __POS_OF__ "999ms";
|
||||
snap (span "0u999_000_001") @@ __POS_OF__ "1s";
|
||||
snap (span "0u999_999_999") @@ __POS_OF__ "1s";
|
||||
snap (span "0u1_000_000_000") @@ __POS_OF__ "1s";
|
||||
snap (span "0u1_000_000_001") @@ __POS_OF__ "1.01s";
|
||||
snap (span "0u1_009_999_999") @@ __POS_OF__ "1.01s";
|
||||
snap (span "0u1_010_000_000") @@ __POS_OF__ "1.01s";
|
||||
snap (span "0u1_010_000_001") @@ __POS_OF__ "1.02s";
|
||||
snap (span "0u1_990_000_000") @@ __POS_OF__ "1.99s";
|
||||
snap (span "0u1_990_000_001") @@ __POS_OF__ "2s";
|
||||
snap (span "0u1_999_999_999") @@ __POS_OF__ "2s";
|
||||
snap (span "0u2_000_000_000") @@ __POS_OF__ "2s";
|
||||
snap (span "0u2_000_000_001") @@ __POS_OF__ "2.01s";
|
||||
snap (span "0u9_990_000_000") @@ __POS_OF__ "9.99s";
|
||||
snap (span "0u9_999_999_999") @@ __POS_OF__ "10s";
|
||||
snap (span "0u10_000_000_000") @@ __POS_OF__ "10s";
|
||||
snap (span "0u10_000_000_001") @@ __POS_OF__ "10.1s";
|
||||
snap (span "0u10_099_999_999") @@ __POS_OF__ "10.1s";
|
||||
snap (span "0u10_100_000_000") @@ __POS_OF__ "10.1s";
|
||||
snap (span "0u10_100_000_001") @@ __POS_OF__ "10.2s";
|
||||
snap (span "0u59_900_000_000") @@ __POS_OF__ "59.9s";
|
||||
snap (span "0u59_900_000_001") @@ __POS_OF__ "1min";
|
||||
snap (span "0u59_999_999_999") @@ __POS_OF__ "1min";
|
||||
snap (span "0u60_000_000_000") @@ __POS_OF__ "1min";
|
||||
snap (span "0u60_000_000_001") @@ __POS_OF__ "1min1s";
|
||||
snap (span "0u60_999_999_999") @@ __POS_OF__ "1min1s";
|
||||
snap (span "0u61_000_000_000") @@ __POS_OF__ "1min1s";
|
||||
snap (span "0u61_000_000_001") @@ __POS_OF__ "1min2s";
|
||||
snap (span "0u119_000_000_000") @@ __POS_OF__ "1min59s";
|
||||
snap (span "0u119_000_000_001") @@ __POS_OF__ "2min";
|
||||
snap (span "0u119_999_999_999") @@ __POS_OF__ "2min";
|
||||
snap (span "0u120_000_000_000") @@ __POS_OF__ "2min";
|
||||
snap (span "0u120_000_000_001") @@ __POS_OF__ "2min1s";
|
||||
snap (span "0u3599_000_000_000") @@ __POS_OF__ "59min59s";
|
||||
snap (span "0u3599_000_000_001") @@ __POS_OF__ "1h";
|
||||
snap (span "0u3599_999_999_999") @@ __POS_OF__ "1h";
|
||||
snap (span "0u3600_000_000_000") @@ __POS_OF__ "1h";
|
||||
snap (span "0u3600_000_000_001") @@ __POS_OF__ "1h1min";
|
||||
snap (span "0u3659_000_000_000") @@ __POS_OF__ "1h1min";
|
||||
snap (span "0u3659_000_000_001") @@ __POS_OF__ "1h1min";
|
||||
snap (span "0u3659_999_999_999") @@ __POS_OF__ "1h1min";
|
||||
snap (span "0u3660_000_000_000") @@ __POS_OF__ "1h1min";
|
||||
snap (span "0u3660_000_000_001") @@ __POS_OF__ "1h2min";
|
||||
snap (span "0u3660_000_000_001") @@ __POS_OF__ "1h2min";
|
||||
snap (span "0u3660_000_000_001") @@ __POS_OF__ "1h2min";
|
||||
snap (span "0u3720_000_000_000") @@ __POS_OF__ "1h2min";
|
||||
snap (span "0u3720_000_000_001") @@ __POS_OF__ "1h3min";
|
||||
snap (span "0u7140_000_000_000") @@ __POS_OF__ "1h59min";
|
||||
snap (span "0u7140_000_000_001") @@ __POS_OF__ "2h";
|
||||
snap (span "0u7199_999_999_999") @@ __POS_OF__ "2h";
|
||||
snap (span "0u7200_000_000_000") @@ __POS_OF__ "2h";
|
||||
snap (span "0u7200_000_000_001") @@ __POS_OF__ "2h1min";
|
||||
snap (span "0u86340_000_000_000") @@ __POS_OF__ "23h59min";
|
||||
snap (span "0u86340_000_000_001") @@ __POS_OF__ "1d";
|
||||
snap (span "0u86400_000_000_000") @@ __POS_OF__ "1d";
|
||||
snap (span "0u86400_000_000_001") @@ __POS_OF__ "1d1h";
|
||||
snap (span "0u89999_999_999_999") @@ __POS_OF__ "1d1h";
|
||||
snap (span "0u90000_000_000_000") @@ __POS_OF__ "1d1h";
|
||||
snap (span "0u90000_000_000_001") @@ __POS_OF__ "1d2h";
|
||||
snap (span "0u169200_000_000_000") @@ __POS_OF__ "1d23h";
|
||||
snap (span "0u169200_000_000_001") @@ __POS_OF__ "2d";
|
||||
snap (span "0u169200_000_000_001") @@ __POS_OF__ "2d";
|
||||
snap (span "0u172799_999_999_999") @@ __POS_OF__ "2d";
|
||||
snap (span "0u172800_000_000_000") @@ __POS_OF__ "2d";
|
||||
snap (span "0u172800_000_000_001") @@ __POS_OF__ "2d1h";
|
||||
snap (span "0u31536000_000_000_000") @@ __POS_OF__ "365d";
|
||||
snap (span "0u31554000_000_000_000") @@ __POS_OF__ "365d5h";
|
||||
snap (
|
||||
(* Technically this should round to a year but it does get rendered.
|
||||
I don't think it matters, it's not inacurate per se. *)
|
||||
span "0u31554000_000_000_001") @@ __POS_OF__ "365d6h";
|
||||
snap (span "0u31557600_000_000_000") @@ __POS_OF__ "1a";
|
||||
snap (span "0u31557600_000_000_001") @@ __POS_OF__ "1a1d";
|
||||
snap (span "0u63028800_000_000_000") @@ __POS_OF__ "1a365d";
|
||||
snap (span "0u63093600_000_000_000") @@ __POS_OF__ "1a365d";
|
||||
snap (span "0u63093600_000_000_001") @@ __POS_OF__ "2a";
|
||||
snap (span "0u63115200_000_000_000") @@ __POS_OF__ "2a";
|
||||
snap (span "0u63115200_000_000_001") @@ __POS_OF__ "2a1d";
|
||||
()
|
||||
|
||||
let main () = Test.main @@ fun () -> Test.autorun ()
|
||||
let () = if !Sys.interactive then () else exit (main ())
|
||||
Loading…
Add table
Add a link
Reference in a new issue