unikernel/duniverse/astring/.gitignore

@@ -0,0 +1,10 @@
+_b0
+_build
+tmp
+CLOCK.org
+*~
+\.\#*
+\#*#
+*.native
+*.byte
+*.install

unikernel/duniverse/astring/.merlin

@@ -0,0 +1,3 @@
+S src
+S test
+B _build/**

unikernel/duniverse/astring/.ocp-indent

@@ -0,0 +1 @@
+strict_with=always,match_clause=4,strict_else=never

unikernel/duniverse/astring/CHANGES.md

@@ -0,0 +1,37 @@
+v0.8.5 2020-08-08 Zagreb
+------------------------
+
+- Support OCaml 4.12 injectiviy annotation of Map.S (#18).
+  Thanks to Jeremy Yallop for the patch. 
+  
+v0.8.4 2020-06-18 Zagreb
+------------------------
+
+- Handle `Pervasives`'s deprecation.
+- Require OCaml 4.05
+- Add conversions to/from Stdlib sets and maps. Thanks 
+  to Hezekiah M. Carty for the patch.
+
+v0.8.3 2016-09-12 Zagreb
+------------------------
+
+- Fix potential segfault on 32-bit platforms due to overflow in
+  `String[.Sub].concat`. Spotted by Jeremy Yallop in the standard
+  library. The same bug was present in Astring.
+
+v0.8.2 2016-08-26 Zagreb
+------------------------
+
+- Fix `String.Set.pp` not using the `sep` argument.
+- Build depend on topkg.
+- Relicense from BSD3 to ISC.
+
+v0.8.1 2015-02-22 La Forclaz (VS)
+---------------------------------
+
+- Fix a bug in `String.Sub.span`.
+
+v0.8.0 2015-12-14 Cambridge (UK)
+--------------------------------
+
+First release.

unikernel/duniverse/astring/LICENSE.md

@@ -0,0 +1,13 @@
+Copyright (c) 2016 The astring 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.

unikernel/duniverse/astring/README.md

@@ -0,0 +1,41 @@
+Astring — Alternative String module for OCaml
+-------------------------------------------------------------------------------
+%%VERSION%%
+
+Astring exposes an alternative `String` module for OCaml. This module
+tries to balance minimality and expressiveness for basic, index-free,
+string processing and provides types and functions for substrings,
+string sets and string maps.
+
+Remaining compatible with the OCaml `String` module is a non-goal. The
+`String` module exposed by Astring has exception safe functions,
+removes deprecated and rarely used functions, alters some signatures
+and names, adds a few missing functions and fully exploits OCaml's
+newfound string immutability.
+
+Astring depends only on the OCaml standard library. It is distributed
+under the ISC license.
+
+Home page: http://erratique.ch/software/astring  
+
+## Installation
+
+Astring can be installed with `opam`:
+
+    opam install astring
+
+If you don't use `opam` consult the [`opam`](opam) file for build
+instructions.
+
+## Documentation
+
+The documentation and API reference is automatically generated by
+`ocamldoc` from the interfaces. It can be consulted [online][doc]
+or via `odig doc astring`.
+
+[doc]: http://erratique.ch/software/astring/doc/
+
+## Sample programs
+
+If you installed Astring with `opam` sample programs are located in
+the directory `opam config var astring:doc`.

unikernel/duniverse/astring/_tags

@@ -0,0 +1,5 @@
+true : bin_annot, safe_string
+<_b0> : -traverse
+<src> : include
+<src/astring_top*> : package(compiler-libs.toplevel)
+<test> : include

unikernel/duniverse/astring/astring.opam

@@ -0,0 +1,33 @@
+opam-version: "2.0"
+maintainer: "Daniel Bünzli <daniel.buenzl i@erratique.ch>"
+authors: ["The astring programmers"]
+homepage: "https://erratique.ch/software/astring"
+doc: "https://erratique.ch/software/astring/doc"
+dev-repo: "git+https://github.com/dune-universe/astring.git"
+bug-reports: "https://github.com/dbuenzli/astring/issues"
+tags: [ "string" "org:erratique" ]
+license: "ISC"
+depends: [
+  "dune"
+  "ocaml" {>= "4.05.0"}
+  "base-bytes"
+]
+build: [[ "dune" "build" "-p" name ]]
+synopsis: "Alternative String module for OCaml"
+description: """
+Astring exposes an alternative `String` module for OCaml. This module
+tries to balance minimality and expressiveness for basic, index-free,
+string processing and provides types and functions for substrings,
+string sets and string maps.
+
+Remaining compatible with the OCaml `String` module is a non-goal. The
+`String` module exposed by Astring has exception safe functions,
+removes deprecated and rarely used functions, alters some signatures
+and names, adds a few missing functions and fully exploits OCaml's
+newfound string immutability.
+
+Astring depends only on the OCaml standard library. It is distributed
+under the ISC license."""
+url {
+  src: "git://github.com/dune-universe/astring.git#duniverse-v0.8.5"
+}

unikernel/duniverse/astring/doc/.merlin

@@ -0,0 +1,3 @@
+# Generated by brzo
+S ./**
+B /Users/dbuenzli/sync/repos/astring/doc/_b0/brzo/ocaml-doc/**

unikernel/duniverse/astring/doc/index.mld

@@ -0,0 +1,12 @@
+{0 Astring {%html: <span class="version">%%VERSION%%</span>%}}
+
+Astring exposes an alternative [String] module for OCaml. This module
+tries to balance minimality and expressiveness for basic, index-free,
+string processing and provides types and functions for substrings,
+string sets and string maps.
+
+{1:api API}
+
+{!modules:
+Astring
+}

unikernel/duniverse/astring/dune-project

@@ -0,0 +1,2 @@
+(lang dune 1.0)
+(name astring)

unikernel/duniverse/astring/pkg/META

@@ -0,0 +1,17 @@
+description = "Alternative String module for OCaml"
+version = "%%VERSION_NUM%%"
+requires = ""
+archive(byte) = "astring.cma"
+archive(native) = "astring.cmxa"
+plugin(byte) = "astring.cma"
+plugin(native) = "astring.cmxs"
+
+package "top" (
+  description = "Astring toplevel support"
+  version = "%%VERSION_NUM%%"
+  requires = "astring"
+  archive(byte) = "astring_top.cma"
+  archive(native) = "astring_top.cmxa"
+  plugin(byte) = "astring_top.cma"
+  plugin(native) = "astring_top.cmxs"
+)

unikernel/duniverse/astring/pkg/pkg.ml

@@ -0,0 +1,13 @@
+#!/usr/bin/env ocaml
+#use "topfind"
+#require "topkg"
+open Topkg
+
+let () =
+  Pkg.describe "astring" @@ fun c ->
+  Ok [ Pkg.mllib ~api:["Astring"] "src/astring.mllib";
+       Pkg.mllib ~api:[] "src/astring_top.mllib";
+       Pkg.lib "src/astring_top_init.ml";
+       Pkg.doc "test/examples.ml";
+       Pkg.test "test/test";
+       Pkg.test "test/examples"; ]

unikernel/duniverse/astring/src/astring.ml

@@ -0,0 +1,26 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The astring programmers. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+
+let strf = Format.asprintf
+let ( ^ ) = Astring_string.append
+
+module Char = Astring_char
+module String = Astring_string
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The astring 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.
+  ---------------------------------------------------------------------------*)

unikernel/duniverse/astring/src/astring.mllib

@@ -0,0 +1,7 @@
+Astring_unsafe
+Astring_base
+Astring_escape
+Astring_char
+Astring_sub
+Astring_string
+Astring

unikernel/duniverse/astring/src/astring_base.ml

@@ -0,0 +1,98 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The astring programmers. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+
+(* Commonalities for strings and substrings *)
+
+open Astring_unsafe
+
+let strf = Format.asprintf
+
+(* Errors *)
+
+let err_empty_string = "the string is empty"
+let err_empty_sep = "~sep is an empty string"
+let err_neg_max max = strf "negative ~max (%d)" max
+let err_neg_min max = strf "negative ~min (%d)" max
+let err_neg_len len = strf "negative length (%d)" len
+let err_max_string_len = "Sys.max_string_length exceeded"
+
+(* Base *)
+
+let empty = ""
+
+(* Predicates *)
+
+let for_all sat s ~first ~last =
+  let rec loop i =
+    if i > last then true else
+    if sat (string_unsafe_get s i) then loop (i + 1) else false
+  in
+  loop first
+
+let exists sat s ~first ~last =
+  let rec loop i =
+    if i > last then false else
+    if sat (string_unsafe_get s i) then true else loop (i + 1)
+  in
+  loop first
+
+(* Traversing *)
+
+let fold_left f acc s ~first ~last =
+  let rec loop acc i =
+    if i > last then acc else
+    loop (f acc (string_unsafe_get s i)) (i + 1)
+  in
+  loop acc first
+
+let fold_right f s acc ~first ~last =
+  let rec loop i acc =
+    if i < first then acc else
+    loop (i - 1) (f (string_unsafe_get s i) acc)
+  in
+  loop last acc
+
+(* OCaml conversions *)
+
+let of_char c =
+  let b = Bytes.create 1 in
+  bytes_unsafe_set b 0 c;
+  bytes_unsafe_to_string b
+
+let to_char s = match string_length s with
+| 0 -> None
+| 1 -> Some (string_unsafe_get s 0)
+| _ -> None
+
+let of_bool = string_of_bool
+let to_bool s =
+  try Some (bool_of_string s) with Invalid_argument (* good joke *) _ -> None
+
+let of_int = string_of_int
+let to_int s = try Some (int_of_string s) with Failure _ -> None
+let of_nativeint = Nativeint.to_string
+let to_nativeint s = try Some (Nativeint.of_string s) with Failure _ -> None
+let of_int32 = Int32.to_string
+let to_int32 s = try Some (Int32.of_string s) with Failure _ -> None
+let of_int64 = Int64.to_string
+let to_int64 s = try Some (Int64.of_string s) with Failure _ -> None
+let of_float = string_of_float
+let to_float s = try Some (float_of_string s) with Failure _ -> None
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The astring 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.
+  ---------------------------------------------------------------------------*)

unikernel/duniverse/astring/src/astring_char.ml

@@ -0,0 +1,99 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The astring programmers. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+
+let err_byte b = Printf.sprintf "%d is not a byte" b
+
+(* Bytes *)
+
+type t = char
+
+let unsafe_of_byte = Astring_unsafe.char_unsafe_of_byte
+
+let of_byte b =
+  if b < 0 || b > 255 then invalid_arg (err_byte b) else unsafe_of_byte b
+
+let of_int b =
+  if b < 0 || b > 255 then None else (Some (unsafe_of_byte b))
+
+let to_int = Astring_unsafe.char_to_byte
+
+let hash c = Hashtbl.hash c
+
+(* Predicates *)
+
+let equal : t -> t -> bool = fun c0 c1 -> c0 = c1
+let compare : t -> t -> int = fun c0 c1 -> compare c0 c1
+
+(* Bytes as US-ASCII characters *)
+
+module Ascii = struct
+  let max_ascii = '\x7F'
+
+  let is_valid : t -> bool = fun c -> c <= max_ascii
+
+  let is_digit = function '0' .. '9' -> true | _ -> false
+
+  let is_hex_digit = function
+  | '0' .. '9' | 'A' .. 'F' | 'a' .. 'f' -> true
+  | _ -> false
+
+  let is_upper = function 'A' .. 'Z' -> true | _ -> false
+
+  let is_lower = function 'a' .. 'z' -> true | _ -> false
+
+  let is_letter = function 'A' .. 'Z' | 'a' .. 'z' -> true | _ -> false
+
+  let is_alphanum = function
+  | '0' .. '9' | 'A' .. 'Z' | 'a' .. 'z' -> true
+  | _ -> false
+
+  let is_white = function ' ' | '\t' .. '\r'  -> true | _ -> false
+
+  let is_blank = function ' ' | '\t' -> true | _ -> false
+
+  let is_graphic = function '!' .. '~' -> true | _ -> false
+
+  let is_print = function ' ' .. '~' -> true | _ -> false
+
+  let is_control = function '\x00' .. '\x1F' | '\x7F' -> true | _ -> false
+
+  let uppercase = function
+  | 'a' .. 'z' as c -> unsafe_of_byte @@ to_int c - 0x20
+  | c -> c
+
+  let lowercase = function
+  | 'A' .. 'Z' as c -> unsafe_of_byte @@ to_int c + 0x20
+  | c -> c
+
+  (* Escaping *)
+
+  let escape = Astring_escape.char_escape
+  let escape_char = Astring_escape.char_escape_char
+end
+
+(* Pretty printing *)
+
+let pp = Format.pp_print_char
+let dump ppf c =
+  Format.pp_print_char ppf '\'';
+  Format.pp_print_string ppf (Ascii.escape_char c);
+  Format.pp_print_char ppf '\'';
+  ()
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The astring 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.
+  ---------------------------------------------------------------------------*)

unikernel/duniverse/astring/src/astring_escape.ml

@@ -0,0 +1,192 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The astring programmers. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+
+open Astring_unsafe
+
+let hex_digit =
+  [|'0';'1';'2';'3';'4';'5';'6';'7';'8';'9';'A';'B';'C';'D';'E';'F'|]
+
+let hex_escape b k c =
+  let byte = char_to_byte c in
+  let hi = byte / 16 in
+  let lo = byte mod 16 in
+  bytes_unsafe_set b (k    ) '\\';
+  bytes_unsafe_set b (k + 1) 'x';
+  bytes_unsafe_set b (k + 2) (array_unsafe_get hex_digit hi);
+  bytes_unsafe_set b (k + 3) (array_unsafe_get hex_digit lo);
+  ()
+
+let letter_escape b k letter =
+  bytes_unsafe_set b (k    ) '\\';
+  bytes_unsafe_set b (k + 1) letter;
+  ()
+
+(* Character escapes *)
+
+let char_escape = function
+| '\\' -> "\\\\"
+| '\x20' .. '\x7E' as c ->
+    let b = Bytes.create 1 in
+    bytes_unsafe_set b 0 c;
+    bytes_unsafe_to_string b
+| c (* hex escape *) ->
+    let b = Bytes.create 4 in
+    hex_escape b 0 c;
+    bytes_unsafe_to_string b
+
+let char_escape_char = function
+| '\\' -> "\\\\"
+| '\'' -> "\\'"
+| '\b' -> "\\b"
+| '\t' -> "\\t"
+| '\n' -> "\\n"
+| '\r' -> "\\r"
+| '\x20' .. '\x7E' as c ->
+    let b = Bytes.create 1 in
+    bytes_unsafe_set b 0 c;
+    bytes_unsafe_to_string b
+| c (* hex escape *) ->
+    let b = Bytes.create 4 in
+    hex_escape b 0 c;
+    bytes_unsafe_to_string b
+
+(* String escapes *)
+
+let escape s =
+  let max_idx = string_length s - 1 in
+  let rec escaped_len i l =
+    if i > max_idx then l else
+    match string_unsafe_get s i with
+    | '\\'               -> escaped_len (i + 1) (l + 2)
+    | '\x20' .. '\x7E'   -> escaped_len (i + 1) (l + 1)
+    | _ (* hex escape *) -> escaped_len (i + 1) (l + 4)
+  in
+  let escaped_len = escaped_len 0 0 in
+  if escaped_len = string_length s then s else
+  let b = Bytes.create escaped_len in
+  let rec loop i k =
+    if i > max_idx then bytes_unsafe_to_string b else
+    match string_unsafe_get s i with
+    | '\\' ->
+        letter_escape b k '\\'; loop (i + 1) (k + 2)
+    | '\x20' .. '\x7E' as c ->
+        bytes_unsafe_set b k c; loop (i + 1) (k + 1)
+    | c ->
+        hex_escape b k c; loop (i + 1) (k + 4)
+  in
+  loop 0 0
+
+let escape_string s =
+  let max_idx = string_length s - 1 in
+  let rec escaped_len i l =
+    if i > max_idx then l else
+    match string_unsafe_get s i with
+    | '\b' | '\t' | '\n' | '\r' | '\"' | '\\' ->
+        escaped_len (i + 1) (l + 2)
+    | '\x20' .. '\x7E'   ->
+        escaped_len (i + 1) (l + 1)
+    | _ (* hex escape *) ->
+        escaped_len (i + 1) (l + 4)
+  in
+  let escaped_len = escaped_len 0 0 in
+  if escaped_len = string_length s then s else
+  let b = Bytes.create escaped_len in
+  let rec loop i k =
+    if i > max_idx then bytes_unsafe_to_string b else
+    match string_unsafe_get s i with
+    | '\b' -> letter_escape b k 'b'; loop (i + 1) (k + 2)
+    | '\t' -> letter_escape b k 't'; loop (i + 1) (k + 2)
+    | '\n' -> letter_escape b k 'n'; loop (i + 1) (k + 2)
+    | '\r' -> letter_escape b k 'r'; loop (i + 1) (k + 2)
+    | '\"' -> letter_escape b k '"'; loop (i + 1) (k + 2)
+    | '\\' -> letter_escape b k '\\'; loop (i + 1) (k + 2)
+    | '\x20' .. '\x7E' as c ->
+        bytes_unsafe_set b k c; loop (i + 1) (k + 1)
+    | c ->
+        hex_escape b k c; loop (i + 1) (k + 4)
+  in
+  loop 0 0
+
+(* Unescaping *)
+
+let is_hex_digit = function
+| '0' .. '9' | 'A' .. 'F' | 'a' .. 'f' -> true
+| _ -> false
+
+let hex_value = function
+| '0' .. '9' as c -> char_to_byte c - 0x30
+| 'A' .. 'F' as c -> 10 + (char_to_byte c - 0x41)
+| 'a' .. 'f' as c -> 10 + (char_to_byte c - 0x61)
+| _ -> assert false
+
+let unescaped_len ~ocaml s =    (* derives length and checks syntax validity *)
+  let max_idx = string_length s - 1 in
+  let rec loop i l =
+    if i > max_idx then Some l else
+    if string_unsafe_get s i <> '\\' then loop (i + 1) (l + 1) else
+    let i = i + 1 in
+    if i > max_idx then None (* truncated escape *) else
+    match string_unsafe_get s i with
+    | '\\' -> loop (i + 1) (l + 1)
+    | 'x' ->
+        let i = i + 2 in
+        if i > max_idx then None (* truncated escape *) else
+        if not (is_hex_digit (string_unsafe_get s (i - 1)) &&
+                is_hex_digit (string_unsafe_get s (i    )))
+        then None (* invalid escape *)
+        else loop (i + 1) (l + 1)
+    | ('b' | 't' | 'n' | 'r' | '"' | '\'') when ocaml -> loop (i + 1) (l + 1)
+    | c -> None (* invalid escape *)
+  in
+  loop 0 0
+
+let _unescape ~ocaml s = match unescaped_len ~ocaml s with
+| None -> None
+| Some l when l = string_length s -> Some s
+| Some l ->
+    let b = Bytes.create l in
+    let max_idx = string_length s - 1 in
+    let rec loop i k =
+      if i > max_idx then Some (bytes_unsafe_to_string b) else
+      let c = string_unsafe_get s i in
+      if c <> '\\' then (bytes_unsafe_set b k c; loop (i + 1) (k + 1)) else
+      let i = i + 1 (* validity checked by unescaped_len *) in
+      match string_unsafe_get s i with
+      | '\\' -> bytes_unsafe_set b k '\\'; loop (i + 1) (k + 1)
+      | 'x' ->
+          let i = i + 2 (* validity checked by unescaped_len *) in
+          let hi = hex_value @@ string_unsafe_get s (i - 1) in
+          let lo = hex_value @@ string_unsafe_get s (i    ) in
+          let c = char_unsafe_of_byte @@ (hi lsl 4) + lo in
+          bytes_unsafe_set b k c; loop (i + 1) (k + 1)
+      (* The following cases are never reached for ~ocaml:false *)
+      | 'b' -> bytes_unsafe_set b k '\b'; loop (i + 1) (k + 1)
+      | 't' -> bytes_unsafe_set b k '\t'; loop (i + 1) (k + 1)
+      | 'n' -> bytes_unsafe_set b k '\n'; loop (i + 1) (k + 1)
+      | 'r' -> bytes_unsafe_set b k '\r'; loop (i + 1) (k + 1)
+      | '"' -> bytes_unsafe_set b k '\"'; loop (i + 1) (k + 1)
+      | '\'' -> bytes_unsafe_set b k '\''; loop (i + 1) (k + 1)
+      | c -> assert false (* because of unescaped_len  *)
+    in
+    loop 0 0
+
+let unescape s = _unescape ~ocaml:false s
+let unescape_string s = _unescape ~ocaml:true s
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The astring 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.
+  ---------------------------------------------------------------------------*)

unikernel/duniverse/astring/src/astring_string.ml

@@ -0,0 +1,785 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The astring programmers. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+
+open Astring_unsafe
+
+let strf = Format.asprintf
+
+(* String *)
+
+type t = string
+
+let empty = Astring_base.empty
+let v ~len f =
+  let b = Bytes.create len in
+  for i = 0 to len - 1 do bytes_unsafe_set b i (f i) done;
+  bytes_unsafe_to_string b
+
+let length = string_length
+let get = string_safe_get
+let get_byte s i = char_to_byte (get s i)
+let unsafe_get = string_unsafe_get
+let unsafe_get_byte s i = char_to_byte (unsafe_get s i)
+
+let head ?(rev = false) s =
+  let len = length s in
+  if len = 0 then None else
+  Some (string_unsafe_get s (if rev then len - 1 else 0))
+
+let get_head ?(rev = false) s =
+  let len = length s in
+  if len = 0 then invalid_arg Astring_base.err_empty_string else
+  string_unsafe_get s (if rev then len - 1 else 0)
+
+let hash c = Hashtbl.hash c
+
+(* Appending strings *)
+
+let append s0 s1 =
+  let l0 = length s0 in
+  if l0 = 0 then s1 else
+  let l1 = length s1 in
+  if l1 = 0 then s0 else
+  let b = Bytes.create (l0 + l1) in
+  bytes_unsafe_blit_string s0 0 b 0 l0;
+  bytes_unsafe_blit_string s1 0 b l0 l1;
+  bytes_unsafe_to_string b
+
+let concat ?(sep = empty) = function
+| [] -> empty
+| [s] -> s
+| s :: ss ->
+    let s_len = length s in
+    let sep_len = length sep in
+    let rec cat_len sep_count l ss =
+      if l < 0 then l else
+      match ss with
+      | s :: ss -> cat_len (sep_count + 1) (l + length s) ss
+      | [] ->
+          if sep_len = 0 then l else
+          let max_sep_count = Sys.max_string_length / sep_len in
+          if sep_count < 0 || sep_count > max_sep_count then -1 else
+          sep_count * sep_len + l
+    in
+    let cat_len = cat_len 0 s_len ss in
+    if cat_len < 0 then invalid_arg Astring_base.err_max_string_len else
+    let b = Bytes.create cat_len in
+    bytes_unsafe_blit_string s 0 b 0 s_len;
+    let rec loop i = function
+    | [] -> bytes_unsafe_to_string b
+    | str :: ss ->
+        let sep_first = i in
+        let str_first = i + sep_len in
+        let str_len = length str in
+        bytes_unsafe_blit_string sep 0 b sep_first sep_len;
+        bytes_unsafe_blit_string str 0 b str_first str_len;
+        loop (str_first + str_len) ss
+    in
+    loop s_len ss
+
+(* Predicates *)
+
+let is_empty s = length s = 0
+
+let is_prefix ~affix s =
+  let len_a = length affix in
+  let len_s = length s in
+  if len_a > len_s then false else
+  let max_idx_a = len_a - 1 in
+  let rec loop i =
+    if i > max_idx_a then true else
+    if unsafe_get affix i <> unsafe_get s i then false else loop (i + 1)
+  in
+  loop 0
+
+let is_infix ~affix s =
+  let len_a = length affix in
+  let len_s = 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 unsafe_get affix k = unsafe_get s (i + k)
+      then loop i (k + 1) else loop (i + 1) 0
+    else
+      if unsafe_get affix 0 = unsafe_get s i
+      then loop i 1 else loop (i + 1) 0
+  in
+  loop 0 0
+
+let is_suffix ~affix s =
+  let max_idx_a = length affix - 1 in
+  let max_idx_s = length s - 1 in
+  if max_idx_a > max_idx_s then false else
+  let rec loop i =
+    if i > max_idx_a then true else
+    if unsafe_get affix (max_idx_a - i) <> unsafe_get s (max_idx_s - i)
+    then false
+    else loop (i + 1)
+  in
+  loop 0
+
+let for_all sat s = Astring_base.for_all sat s ~first:0 ~last:(length s - 1)
+let exists sat s = Astring_base.exists sat s ~first:0 ~last:(length s - 1)
+let equal = string_equal
+let compare = string_compare
+
+(* Extracting substrings *)
+
+let with_range ?(first = 0) ?(len = max_int) s =
+  if len < 0 then invalid_arg (Astring_base.err_neg_len len) else
+  if len = 0 then empty else
+  let s_len = length s in
+  let max_idx = s_len - 1 in
+  let last = match len with
+  | len when len = max_int -> max_idx
+  | len ->
+      let last = first + len - 1 in
+      if last > max_idx then max_idx else last
+  in
+  let first = if first < 0 then 0 else first in
+  if first > max_idx || last < 0 || first > last then empty else
+  if first = 0 && last = max_idx then s else
+  unsafe_string_sub s first (last + 1 - first)
+
+let with_index_range ?(first = 0) ?last s =
+  let s_len = length s in
+  let max_idx = s_len - 1 in
+  let last = match last with
+  | None -> max_idx
+  | Some last -> if last > max_idx then max_idx else last
+  in
+  let first = if first < 0 then 0 else first in
+  if first > max_idx || last < 0 || first > last then empty else
+  if first = 0 && last = max_idx then s else
+  unsafe_string_sub s first (last + 1 - first)
+
+let trim ?(drop = Astring_char.Ascii.is_white) s =
+  let len = length s in
+  if len = 0 then s else
+  let max_idx = len - 1 in
+  let rec left_pos i =
+    if i > max_idx then len else
+    if drop (unsafe_get s i) then left_pos (i + 1) else i
+  in
+  let rec right_pos i =
+    if i < 0 then 0 else
+    if drop (unsafe_get s i) then right_pos (i - 1) else (i + 1)
+  in
+  let left = left_pos 0 in
+  if left = len then empty else
+  let right = right_pos max_idx in
+  if left = 0 && right = len then s else
+  unsafe_string_sub s left (right - left)
+
+let fspan ?(min = 0) ?(max = max_int) ?(sat = fun _ -> true) s =
+  if min < 0 then invalid_arg (Astring_base.err_neg_min min) else
+  if max < 0 then invalid_arg (Astring_base.err_neg_max max) else
+  if min > max || max = 0 then (empty, s) else
+  let len = length s in
+  let max_idx = len - 1 in
+  let max_idx = let k = max - 1 in (if k > max_idx then max_idx else k) in
+  let need_idx = min in
+  let rec loop i =
+    if i <= max_idx && sat (unsafe_get s i) then loop (i + 1) else
+    if i < need_idx || i = 0 then (empty, s) else
+    if i = len then (s, empty) else
+    unsafe_string_sub s 0 i, unsafe_string_sub s i (len - i)
+  in
+  loop 0
+
+let rspan ?(min = 0) ?(max = max_int) ?(sat = fun _ -> true) s =
+  if min < 0 then invalid_arg (Astring_base.err_neg_min min) else
+  if max < 0 then invalid_arg (Astring_base.err_neg_max max) else
+  if min > max || max = 0 then (s, empty) else
+  let len = length s in
+  let max_idx = len - 1 in
+  let min_idx = let k = len - max in (if k < 0 then 0 else k) in
+  let need_idx = max_idx - min in
+  let rec loop i =
+    if i >= min_idx && sat (unsafe_get s i) then loop (i - 1) else
+    if i > need_idx || i = max_idx then (s, empty) else
+    if i = -1 then (empty, s) else
+    let cut = i + 1 in
+    unsafe_string_sub s 0 cut, unsafe_string_sub s cut (len - cut)
+  in
+  loop max_idx
+
+let span ?(rev = false) ?min ?max ?sat s = match rev with
+| true  -> rspan ?min ?max ?sat s
+| false -> fspan ?min ?max ?sat s
+
+(* N.B. c&p of fspan *)
+let ftake ?(min = 0) ?(max = max_int) ?(sat = fun _ -> true) s =
+  if min < 0 then invalid_arg (Astring_base.err_neg_min min) else
+  if max < 0 then invalid_arg (Astring_base.err_neg_max max) else
+  if min > max || max = 0 then empty else
+  let len = length s in
+  let max_idx = len - 1 in
+  let max_idx = let k = max - 1 in (if k > max_idx then max_idx else k) in
+  let need_idx = min in
+  let rec loop i =
+    if i <= max_idx && sat (unsafe_get s i) then loop (i + 1) else
+    if i < need_idx || i = 0 then empty else
+    if i = len then s else
+    unsafe_string_sub s 0 i
+  in
+  loop 0
+
+(* N.B. c&p of rspan *)
+let rtake ?(min = 0) ?(max = max_int) ?(sat = fun _ -> true) s =
+  if min < 0 then invalid_arg (Astring_base.err_neg_min min) else
+  if max < 0 then invalid_arg (Astring_base.err_neg_max max) else
+  if min > max || max = 0 then empty else
+  let len = length s in
+  let max_idx = len - 1 in
+  let min_idx = let k = len - max in (if k < 0 then 0 else k) in
+  let need_idx = max_idx - min in
+  let rec loop i =
+    if i >= min_idx && sat (unsafe_get s i) then loop (i - 1) else
+    if i > need_idx || i = max_idx then empty else
+    if i = -1 then s else
+    let cut = i + 1 in
+    unsafe_string_sub s cut (len - cut)
+  in
+  loop max_idx
+
+let take ?(rev = false) ?min ?max ?sat s = match rev with
+| true  -> rtake ?min ?max ?sat s
+| false -> ftake ?min ?max ?sat s
+
+(* N.B. c&p of fspan *)
+let fdrop ?(min = 0) ?(max = max_int) ?(sat = fun _ -> true) s =
+  if min < 0 then invalid_arg (Astring_base.err_neg_min min) else
+  if max < 0 then invalid_arg (Astring_base.err_neg_max max) else
+  if min > max || max = 0 then s else
+  let len = length s in
+  let max_idx = len - 1 in
+  let max_idx = let k = max - 1 in (if k > max_idx then max_idx else k) in
+  let need_idx = min in
+  let rec loop i =
+    if i <= max_idx && sat (unsafe_get s i) then loop (i + 1) else
+    if i < need_idx || i = 0 then s else
+    if i = len then empty else
+    unsafe_string_sub s i (len - i)
+  in
+  loop 0
+
+(* N.B. c&p of rspan *)
+let rdrop ?(min = 0) ?(max = max_int) ?(sat = fun _ -> true) s =
+  if min < 0 then invalid_arg (Astring_base.err_neg_min min) else
+  if max < 0 then invalid_arg (Astring_base.err_neg_max max) else
+  if min > max || max = 0 then s else
+  let len = length s in
+  let max_idx = len - 1 in
+  let min_idx = let k = len - max in (if k < 0 then 0 else k) in
+  let need_idx = max_idx - min in
+  let rec loop i =
+    if i >= min_idx && sat (unsafe_get s i) then loop (i - 1) else
+    if i > need_idx || i = max_idx then s else
+    if i = -1 then empty else
+    let cut = i + 1 in
+    unsafe_string_sub s 0 cut
+  in
+  loop max_idx
+
+let drop ?(rev = false) ?min ?max ?sat s = match rev with
+| true  -> rdrop ?min ?max ?sat s
+| false -> fdrop ?min ?max ?sat s
+
+let fcut ~sep s =
+  let sep_len = length sep in
+  if sep_len = 0 then invalid_arg Astring_base.err_empty_sep else
+  let s_len = length s in
+  let max_sep_idx = sep_len - 1 in
+  let max_s_idx = s_len - sep_len in
+  let rec check_sep i k =
+    if k > max_sep_idx then
+      let r_start = i + sep_len in
+      Some (unsafe_string_sub s 0 i,
+            unsafe_string_sub s r_start (s_len - r_start))
+    else
+      if unsafe_get s (i + k) = unsafe_get sep k
+      then check_sep i (k + 1)
+      else scan (i + 1)
+  and scan i =
+    if i > max_s_idx then None else
+    if unsafe_get s i = unsafe_get sep 0 then check_sep i 1 else scan (i + 1)
+  in
+  scan 0
+
+let rcut ~sep s =
+  let sep_len = length sep in
+  if sep_len = 0 then invalid_arg Astring_base.err_empty_sep else
+  let s_len = length s in
+  let max_sep_idx = sep_len - 1 in
+  let max_s_idx = s_len - 1 in
+  let rec check_sep i k =
+    if k > max_sep_idx then
+      let r_start = i + sep_len in
+      Some (unsafe_string_sub s 0 i,
+            unsafe_string_sub s r_start (s_len - r_start))
+    else
+      if unsafe_get s (i + k) = unsafe_get sep k
+      then check_sep i (k + 1)
+      else rscan (i - 1)
+  and rscan i =
+    if i < 0 then None else
+    if unsafe_get s i = unsafe_get sep 0 then check_sep i 1 else rscan (i - 1)
+  in
+  rscan (max_s_idx - max_sep_idx)
+
+let cut ?(rev = false) ~sep s = if rev then rcut ~sep s else fcut ~sep s
+
+let add_sub ~no_empty s ~start ~stop acc =
+  if start = stop then (if no_empty then acc else empty :: acc) else
+  unsafe_string_sub s start (stop - start) :: acc
+
+let fcuts ~no_empty ~sep s =
+  let sep_len = length sep in
+  if sep_len = 0 then invalid_arg Astring_base.err_empty_sep else
+  let s_len = length s in
+  let max_sep_idx = sep_len - 1 in
+  let max_s_idx = s_len - sep_len in
+  let rec check_sep start i k acc =
+    if k > max_sep_idx then
+      let new_start = i + sep_len in
+      scan new_start new_start (add_sub ~no_empty s ~start ~stop:i acc)
+    else
+      if unsafe_get s (i + k) = unsafe_get sep k
+      then check_sep start i (k + 1) acc
+      else scan start (i + 1) acc
+  and scan start i acc =
+    if i > max_s_idx then
+      if start = 0 then (if no_empty && s_len = 0 then [] else [s]) else
+      List.rev (add_sub ~no_empty s ~start ~stop:s_len acc)
+    else
+      if unsafe_get s i = unsafe_get sep 0
+      then check_sep start i 1 acc
+      else scan start (i + 1) acc
+  in
+  scan 0 0 []
+
+let rcuts ~no_empty ~sep s =
+  let sep_len = length sep in
+  if sep_len = 0 then invalid_arg Astring_base.err_empty_sep else
+  let s_len = length s in
+  let max_sep_idx = sep_len - 1 in
+  let max_s_idx = s_len - 1 in
+  let rec check_sep stop i k acc =
+    if k > max_sep_idx then
+      let start = i + sep_len in
+      rscan i (i - sep_len) (add_sub ~no_empty s ~start ~stop acc)
+    else if unsafe_get s (i + k) = unsafe_get sep k
+    then check_sep stop i (k + 1) acc
+    else rscan stop (i - 1) acc
+  and rscan stop i acc =
+    if i < 0 then
+      if stop = s_len then (if no_empty && s_len = 0 then [] else [s]) else
+      add_sub ~no_empty s ~start:0 ~stop:stop acc
+    else if unsafe_get s i = unsafe_get sep 0
+    then check_sep stop i 1 acc
+    else rscan stop (i - 1) acc
+  in
+  rscan s_len (max_s_idx - max_sep_idx) []
+
+let cuts ?(rev = false) ?(empty = true) ~sep s = match rev with
+| true  -> rcuts ~no_empty:(not empty) ~sep s
+| false -> fcuts ~no_empty:(not empty) ~sep s
+
+let fields ?(empty = true) ?(is_sep = Astring_char.Ascii.is_white) s =
+  let no_empty = not empty in
+  let max_pos = length s in
+  let rec loop i end_pos acc =
+    if i < 0 then begin
+      if end_pos = max_pos
+      then (if no_empty && max_pos = 0 then [] else [s])
+      else add_sub ~no_empty s ~start:0 ~stop:end_pos acc
+    end else begin
+      if not (is_sep (unsafe_get s i)) then loop (i - 1) end_pos acc else
+      loop (i - 1) i (add_sub ~no_empty s ~start:(i + 1) ~stop:end_pos acc)
+    end
+  in
+  loop (max_pos - 1) max_pos []
+
+(* Substrings *)
+
+type sub = Astring_sub.t
+
+module Sub = Astring_sub
+
+let sub = Sub.v
+let sub_with_range = Sub.of_string_with_range
+let sub_with_index_range = Sub.of_string_with_index_range
+
+(* Traversing *)
+
+let ffind ?start sat s =
+  let max_idx = length s - 1 in
+  let rec loop i =
+    if i > max_idx then None else
+    if sat (unsafe_get s i) then Some i else loop (i + 1)
+  in
+  match start with
+  | None -> loop 0
+  | Some i when i < 0 -> loop 0
+  | Some i -> loop i
+
+let rfind ?start sat s =
+  let max_idx = length s - 1 in
+  let rec loop i =
+    if i < 0 then None else
+    if sat (unsafe_get s i) then Some i else loop (i - 1)
+  in
+  match start with
+  | None -> loop max_idx
+  | Some i when i > max_idx -> loop max_idx
+  | Some i -> loop i
+
+let find ?(rev = false) ?start sat s = match rev with
+| false -> ffind ?start sat s
+| true  -> rfind ?start sat s
+
+let ffind_sub ?start ~sub s =
+  let len_sub = length sub in
+  let len_s = length s in
+  let max_idx_sub = len_sub - 1 in
+  let max_idx_s = if len_sub <> 0 then len_s - len_sub else len_s - 1 in
+  let rec loop i k =
+    if i > max_idx_s then None else
+    if k > max_idx_sub then Some i else
+    if k > 0 then
+      if unsafe_get sub k = unsafe_get s (i + k)
+      then loop i (k + 1) else loop (i + 1) 0
+    else
+      if unsafe_get sub 0 = unsafe_get s i
+      then loop i 1 else loop (i + 1) 0
+  in
+  match start with
+  | None -> loop 0 0
+  | Some i when i < 0 -> loop 0 0
+  | Some i -> loop i 0
+
+let rfind_sub ?start ~sub s =
+  let len_sub = length sub in
+  let len_s = length s in
+  let max_idx_sub = len_sub - 1 in
+  let max_idx_s = if len_sub <> 0 then len_s - len_sub else len_s - 1 in
+  let rec loop i k =
+    if i < 0 then None else
+    if k > max_idx_sub then Some i else
+    if k > 0 then
+      if unsafe_get sub k = unsafe_get s (i + k)
+      then loop i (k + 1) else loop (i - 1) 0
+    else
+      if unsafe_get sub 0 = unsafe_get s i
+      then loop i 1 else loop (i - 1) 0
+  in
+  match start with
+  | None -> loop max_idx_s 0
+  | Some i when i > max_idx_s -> loop max_idx_s 0
+  | Some i -> loop i 0
+
+let find_sub ?(rev = false) ?start ~sub s = match rev with
+| false -> ffind_sub ?start ~sub s
+| true  -> rfind_sub ?start ~sub s
+
+let filter sat s =
+  let max_idx = length s - 1 in
+  let rec with_buf b k i = (* k is the write index in b *)
+    if i > max_idx then Bytes.sub_string b 0 k else
+    let c = unsafe_get s i in
+    if sat c then (bytes_unsafe_set b k c; with_buf b (k + 1) (i + 1)) else
+    with_buf b k (i + 1)
+  in
+  let rec try_no_alloc i =
+    if i > max_idx then s else
+    if (sat (unsafe_get s i)) then try_no_alloc (i + 1) else
+    if i = max_idx then unsafe_string_sub s 0 i else
+    let b = Bytes.of_string s in (* copy and overwrite starting from i *)
+    with_buf b i (i + 1)
+  in
+  try_no_alloc 0
+
+let filter_map f s =
+  let max_idx = length s - 1 in
+  let rec with_buf b k i = (* k is the write index in b *)
+    if i > max_idx then
+      (if k > max_idx then bytes_unsafe_to_string b else Bytes.sub_string b 0 k)
+    else
+    match f (unsafe_get s i) with
+    | None -> with_buf b k (i + 1)
+    | Some c -> bytes_unsafe_set b k c; with_buf b (k + 1) (i + 1)
+  in
+  let rec try_no_alloc i =
+    if i > max_idx then s else
+    let c = unsafe_get s i in
+    match f c with
+    | None ->
+        if i = max_idx then unsafe_string_sub s 0 i else
+        let b = Bytes.of_string s in
+        with_buf b i (i + 1)
+    | Some cm when cm <> c ->
+        let b = Bytes.of_string s in
+        bytes_unsafe_set b i cm;
+        with_buf b (i + 1) (i + 1)
+    | Some _ ->
+        try_no_alloc (i + 1)
+  in
+  try_no_alloc 0
+
+let map f s =
+  let max_idx = length s - 1 in
+  let rec with_buf b i =
+    if i > max_idx then bytes_unsafe_to_string b else
+    (bytes_unsafe_set b i (f (unsafe_get s i)); with_buf b (i + 1))
+  in
+  let rec try_no_alloc i =
+    if i > max_idx then s else
+    let c = unsafe_get s i in
+    match f c with
+    | cm when cm <> c ->
+        let b = Bytes.of_string s in
+        bytes_unsafe_set b i cm;
+        with_buf b (i + 1)
+    | _ ->
+        try_no_alloc (i + 1)
+  in
+  try_no_alloc 0
+
+let mapi f s =
+  let max_idx = length s - 1 in
+  let rec with_buf b i =
+    if i > max_idx then bytes_unsafe_to_string b else
+    (bytes_unsafe_set b i (f i (unsafe_get s i)); with_buf b (i + 1))
+  in
+  let rec try_no_alloc i =
+    if i > max_idx then s else
+    let c = unsafe_get s i in
+    match f i c with
+    | cm when cm <> c ->
+        let b = Bytes.of_string s in
+        bytes_unsafe_set b i cm;
+        with_buf b (i + 1)
+    | _ ->
+        try_no_alloc (i + 1)
+  in
+  try_no_alloc 0
+
+let fold_left f acc s =
+  Astring_base.fold_left f acc s ~first:0 ~last:(length s - 1)
+
+let fold_right f s acc =
+  Astring_base.fold_right f s acc ~first:0 ~last:(length s - 1)
+
+let iter f s = for i = 0 to length s - 1 do f (unsafe_get s i) done
+let iteri f s = for i = 0 to length s - 1 do f i (unsafe_get s i) done
+
+(* Strings as US-ASCII code point sequences *)
+
+module Ascii = struct
+
+  let is_valid s =
+    let max_idx = length s - 1 in
+    let rec loop i =
+      if i > max_idx then true else
+      if unsafe_get s i > Astring_char.Ascii.max_ascii then false else
+      loop (i + 1)
+    in
+    loop 0
+
+  (* Casing transforms *)
+
+  let caseify is_not_case to_case s =
+    let max_idx = length s - 1 in
+    let caseify b i =
+      for k = i to max_idx do
+        bytes_unsafe_set b k (to_case (unsafe_get s k))
+      done;
+      bytes_unsafe_to_string b
+    in
+    let rec try_no_alloc i =
+      if i > max_idx then s else
+      if is_not_case (unsafe_get s i) then caseify (Bytes.of_string s) i else
+      try_no_alloc (i + 1)
+    in
+    try_no_alloc 0
+
+  let uppercase s =
+    caseify Astring_char.Ascii.is_lower Astring_char.Ascii.uppercase s
+
+  let lowercase s =
+    caseify Astring_char.Ascii.is_upper Astring_char.Ascii.lowercase s
+
+  let caseify_first is_not_case to_case s =
+    if length s = 0 then s else
+    let c = unsafe_get s 0 in
+    if not (is_not_case c) then s else
+    let b = Bytes.of_string s in
+    bytes_unsafe_set b 0 (to_case c);
+    bytes_unsafe_to_string b
+
+  let capitalize s =
+    caseify_first Astring_char.Ascii.is_lower Astring_char.Ascii.uppercase s
+
+  let uncapitalize s =
+    caseify_first Astring_char.Ascii.is_upper Astring_char.Ascii.lowercase s
+
+  (* Escape *)
+
+  let escape = Astring_escape.escape
+  let unescape = Astring_escape.unescape
+  let escape_string = Astring_escape.escape_string
+  let unescape_string = Astring_escape.unescape_string
+end
+
+(* Pretty printing *)
+
+let pp = Format.pp_print_string
+let dump ppf s =
+  Format.pp_print_char ppf '"';
+  Format.pp_print_string ppf (Ascii.escape_string s);
+  Format.pp_print_char ppf '"';
+  ()
+
+(* String sets and maps *)
+
+module Set = struct
+  include Set.Make (String)
+
+  let pp ?sep:(pp_sep = Format.pp_print_cut) pp_elt ppf ss =
+    let pp_elt elt is_first =
+      if is_first then () else pp_sep ppf ();
+      pp_elt ppf elt; false
+    in
+    ignore (fold pp_elt ss true)
+
+  let dump_str = dump
+  let dump ppf ss =
+    let pp_elt elt is_first =
+      if is_first then () else Format.fprintf ppf "@ ";
+      Format.fprintf ppf "%a" dump_str elt;
+      false
+    in
+    Format.fprintf ppf "@[<1>{";
+    ignore (fold pp_elt ss true);
+    Format.fprintf ppf "}@]";
+    ()
+
+  let err_empty () = invalid_arg "empty set"
+  let err_absent s ss =
+    invalid_arg (strf "%a not in set %a" dump_str s dump ss)
+
+  let get_min_elt ss = try min_elt ss with Not_found -> err_empty ()
+  let min_elt ss = try Some (min_elt ss) with Not_found -> None
+
+  let get_max_elt ss = try max_elt ss with Not_found -> err_empty ()
+  let max_elt ss = try Some (max_elt ss) with Not_found -> None
+
+  let get_any_elt ss = try choose ss with Not_found -> err_empty ()
+  let choose ss = try Some (choose ss) with Not_found -> None
+
+  let get s ss = try find s ss with Not_found -> err_absent s ss
+  let find s ss = try Some (find s ss) with Not_found -> None
+
+  let of_list = List.fold_left (fun acc s -> add s acc) empty
+
+  let of_stdlib_set s = s
+  let to_stdlib_set s = s
+end
+
+module Map = struct
+  include Map.Make (String)
+
+  let err_empty () = invalid_arg "empty map"
+  let err_absent s = invalid_arg (strf "%a is not bound in map" dump s)
+
+  let get_min_binding m = try min_binding m with Not_found -> err_empty ()
+  let min_binding m = try Some (min_binding m) with Not_found -> None
+
+  let get_max_binding m = try max_binding m with Not_found -> err_empty ()
+  let max_binding m = try Some (max_binding m) with Not_found -> None
+
+  let get_any_binding m = try choose m with Not_found -> err_empty ()
+  let choose m = try Some (choose m) with Not_found -> None
+
+  let get k s = try find k s with Not_found -> err_absent k
+  let find k m = try Some (find k m) with Not_found -> None
+
+  let dom m = fold (fun k _ acc -> Set.add k acc) m Set.empty
+
+  let of_list bs = List.fold_left (fun m (k,v) -> add k v m) empty bs
+
+  let of_stdlib_map m = m
+  let to_stdlib_map m = m
+
+  let pp ?sep:(pp_sep = Format.pp_print_cut) pp_binding ppf (m : 'a t) =
+    let pp_binding k v is_first =
+      if is_first then () else pp_sep ppf ();
+      pp_binding ppf (k, v); false
+    in
+    ignore (fold pp_binding m true)
+
+  let dump_str = dump
+  let dump pp_v ppf m =
+    let pp_binding k v is_first =
+      if is_first then () else Format.fprintf ppf "@ ";
+      Format.fprintf ppf "@[<1>(@[%a@],@ @[%a@])@]" dump k pp_v v;
+      false
+    in
+    Format.fprintf ppf "@[<1>{";
+    ignore (fold pp_binding m true);
+    Format.fprintf ppf "}@]";
+    ()
+
+  let dump_string_map ppf m = dump dump_str ppf m
+end
+
+type set = Set.t
+type 'a map = 'a Map.t
+
+(* Uniqueness *)
+
+let uniquify ss =
+  let add (seen, ss as acc) v =
+    if Set.mem v seen then acc else (Set.add v seen, v :: ss)
+  in
+  List.rev (snd (List.fold_left add (Set.empty, []) ss))
+
+(* OCaml base type conversions *)
+
+let of_char = Astring_base.of_char
+let to_char = Astring_base.to_char
+let of_bool = Astring_base.of_bool
+let to_bool = Astring_base.to_bool
+let of_int = Astring_base.of_int
+let to_int = Astring_base.to_int
+let of_nativeint = Astring_base.of_nativeint
+let to_nativeint = Astring_base.to_nativeint
+let of_int32 = Astring_base.of_int32
+let to_int32 = Astring_base.to_int32
+let of_int64 = Astring_base.of_int64
+let to_int64 = Astring_base.to_int64
+let of_float = Astring_base.of_float
+let to_float = Astring_base.to_float
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The astring 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.
+  ---------------------------------------------------------------------------*)

unikernel/duniverse/astring/src/astring_sub.ml

@@ -0,0 +1,712 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The astring programmers. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+
+open Astring_unsafe
+
+let sunsafe_get = string_unsafe_get
+
+(* Errors *)
+
+let strf = Format.asprintf
+let err_base = "not on the same base string"
+let err_empty_sub pos = strf "empty substring [%d;%d]" pos pos
+let err_pos_range start stop len =
+  strf "invalid start:%d stop:%d for position range [0;%d]" start stop len
+
+(* From strings *)
+
+let v ?(start = 0) ?stop s =
+  let s_len = string_length s in
+  let stop = match stop with None -> s_len | Some stop -> stop in
+  if start < 0 || stop > s_len || stop < start
+  then invalid_arg (err_pos_range start stop s_len)
+  else (s, start, stop)
+
+let of_string_with_range ?(first = 0) ?(len = max_int) s =
+  if len < 0 then invalid_arg (Astring_base.err_neg_len len) else
+  let s_len = string_length s in
+  let max_idx = s_len - 1 in
+  let empty = function
+  | first when first < 0 -> (s, 0, 0)
+  | first when first > max_idx -> (s, s_len, s_len)
+  | first -> (s, first, first)
+  in
+  if len = 0 then empty first else
+  let last (* index *) = match len with
+  | len when len = max_int -> max_idx
+  | len ->
+      let last = first + len - 1 in
+      if last > max_idx then max_idx else last
+  in
+  let first = if first < 0 then 0 else first in
+  if first > max_idx || last < 0 || first > last then empty first else
+  (s, first, last + 1 (* position *))
+
+let of_string_with_index_range ?(first = 0) ? last s =
+  let s_len = string_length s in
+  let max_idx = s_len - 1 in
+  let empty = function
+  | first when first < 0 -> (s, 0, 0)
+  | first when first > max_idx -> (s, s_len, s_len)
+  | first -> (s, first, first)
+  in
+  let last (* index *) = match last with
+  | None -> max_idx
+  | Some last -> if last > max_idx then max_idx else last
+  in
+  let first = if first < 0 then 0 else first in
+  if first > max_idx || last < 0 || first > last then empty first else
+  (s, first, last + 1 (* position *))
+
+(* Substrings *)
+
+type t = string * int * int
+
+let empty = (Astring_base.empty, 0, 0)
+let start_pos (_, start, _) = start
+let stop_pos (_, _, stop) = stop
+let base_string (s, _, _) = s
+let length (_, start, stop) = stop - start
+let get (s, start, _) i = string_safe_get s (start + i)
+let get_byte s i = char_to_byte (get s i)
+let unsafe_get (s, start, _) i = string_unsafe_get s (start + i)
+let unsafe_get_byte s i = char_to_byte (unsafe_get s i)
+
+let head ?(rev = false) (s, start, stop) =
+  if start = stop then None else
+  Some (string_unsafe_get s (if rev then stop - 1 else start))
+
+let get_head ?(rev = false) (s, start, stop) =
+  if start = stop then invalid_arg (err_empty_sub start) else
+  string_unsafe_get s (if rev then stop - 1 else start)
+
+let of_string s = v s
+let to_string (s, start, stop) =
+  if start = stop then Astring_base.empty else
+  if start = 0 && stop = string_length s then s else
+  unsafe_string_sub s start (stop - start)
+
+let rebase (_, start, stop as sub) = (to_string sub, 0, stop - start)
+let hash s = Hashtbl.hash s
+
+(* Stretching substrings *)
+
+let start (s, start, _) = (s, start, start)
+let stop (s, _, stop) = (s, stop, stop)
+let base (s, _, _) = (s, 0, string_length s)
+
+let tail ?(rev = false) (s, start, stop as sub) =
+  if start = stop then sub else
+  if rev then (s, start, stop - 1) else (s, start + 1, stop)
+
+let fextend ?max ~sat (s, start, stop) =
+  let max_idx = string_length s - 1 in
+  let max_idx = match max with
+  | None -> max_idx
+  | Some max when max < 0 -> invalid_arg (Astring_base.err_neg_max max)
+  | Some max -> let i = stop + max - 1 in if i > max_idx then max_idx else i
+  in
+  let rec loop i =
+    if i > max_idx then (s, start, i) else
+    if sat (string_unsafe_get s i) then loop (i + 1) else
+    (s, start, i)
+  in
+  loop stop
+
+let rextend ?max ~sat (s, start, stop) =
+  let min_idx = match max with
+  | None -> 0
+  | Some max when max < 0 -> invalid_arg (Astring_base.err_neg_max max)
+  | Some max -> let i = start - max in if i < 0 then 0 else i
+  in
+  let rec loop i =
+    if i < min_idx then (s, min_idx, stop) else
+    if sat (string_unsafe_get s i) then loop (i - 1) else
+    (s, i + 1, stop)
+  in
+  loop (start - 1)
+
+let extend ?(rev = false) ?max ?(sat = (fun _ -> true)) sub = match rev with
+| true  -> rextend ?max ~sat sub
+| false -> fextend ?max ~sat sub
+
+let freduce ?max ~sat (s, start, stop as sub) =
+  if start = stop then sub else
+  let min_idx = match max with
+  | None -> start
+  | Some max when max < 0 -> invalid_arg (Astring_base.err_neg_max max)
+  | Some max -> let i = stop - max in if i < start then start else i
+  in
+  let rec loop i =
+    if i < min_idx then (s, start, min_idx) else
+    if sat (string_unsafe_get s i) then loop (i - 1) else
+    (s, start, i + 1)
+  in
+  loop (stop - 1)
+
+let rreduce ?max ~sat (s, start, stop as sub) =
+  if start = stop then sub else
+  let max_idx = stop - 1 in
+  let max_idx = match max with
+  | None -> max_idx
+  | Some max when max < 0 -> invalid_arg (Astring_base.err_neg_max max)
+  | Some max -> let i = start + max - 1 in if i > max_idx then max_idx else i
+  in
+  let rec loop i =
+    if i > max_idx then (s, i, stop) else
+    if sat (string_unsafe_get s i) then loop (i + 1) else
+    (s, i, stop)
+  in
+  loop start
+
+let reduce ?(rev = false) ?max ?(sat = (fun _ -> true)) sub = match rev with
+| true  -> rreduce ?max ~sat sub
+| false -> freduce ?max ~sat sub
+
+let extent (s0, start0, stop0) (s1, start1, stop1) =
+  if s0 != s1 then invalid_arg err_base else
+  let start = if start0 < start1 then start0 else start1 in
+  let stop = if stop0 < stop1 then stop1 else stop0 in
+  (s0, start, stop)
+
+let overlap (s0, start0, stop0) (s1, start1, stop1) =
+  if s0 != s1 then invalid_arg err_base else
+  if not (start0 <= stop1 && start1 <= stop0) then None else
+  let start = if start0 < start1 then start1 else start0 in
+  let stop = if stop0 < stop1 then stop0 else stop1 in
+  Some (s0, start, stop)
+
+(* Appending substrings *)
+
+let append (s0, start0, _ as sub0) (s1, start1, _ as sub1) =
+  let l0 = length sub0 in
+  if l0 = 0 then rebase sub1 else
+  let l1 = length sub1 in
+  if l1 = 0 then rebase sub0 else
+  let len = l0 + l1 in
+  let b = Bytes.create len in
+  bytes_unsafe_blit_string s0 start0 b 0 l0;
+  bytes_unsafe_blit_string s1 start1 b l0 l1;
+  (bytes_unsafe_to_string b, 0, len)
+
+let concat ?sep:(sep, sep_start, _ as sep_sub = empty) = function
+| [] -> empty
+| [s] -> rebase s
+| (s, start, _ as sub) :: ss ->
+    let sub_len = length sub in
+    let sep_len = length sep_sub in
+    let rec cat_len sep_count l ss =
+      if l < 0 then l else
+      match ss with
+      | s :: ss -> cat_len (sep_count + 1) (l + length s) ss
+      | [] ->
+          if sep_len = 0 then l else
+          let max_sep_count = Sys.max_string_length / sep_len in
+          if sep_count < 0 || sep_count > max_sep_count then -1 else
+          sep_count * sep_len + l
+    in
+    let cat_len = cat_len 0 sub_len ss in
+    if cat_len < 0 then invalid_arg Astring_base.err_max_string_len else
+    let b = Bytes.create cat_len in
+    bytes_unsafe_blit_string s start b 0 sub_len;
+    let rec loop i = function
+    | [] -> bytes_unsafe_to_string b
+    | (str, str_start, _ as str_sub) :: ss ->
+        let sep_pos = i in
+        let str_pos = i + sep_len in
+        let str_len = length str_sub in
+        bytes_unsafe_blit_string sep sep_start b sep_pos sep_len;
+        bytes_unsafe_blit_string str str_start b str_pos str_len;
+        loop (str_pos + str_len) ss
+    in
+    (loop sub_len ss, 0, cat_len)
+
+(* Predicates *)
+
+let is_empty (_, start, stop) = stop - start = 0
+
+let is_prefix ~affix:(affix, astart, _ as affix_sub) (s, sstart, _ as s_sub) =
+  let len_a = length affix_sub in
+  let len_s = length s_sub in
+  if len_a > len_s then false else
+  let max_zidx (* zero based idx *) = len_a - 1 in
+  let rec loop i =
+    if i > max_zidx then true else
+    if sunsafe_get affix (astart + i) <> sunsafe_get s (sstart + i)
+    then false
+    else loop (i + 1)
+  in
+  loop 0
+
+let is_infix ~affix:(affix, astart, _ as affix_sub) (s, sstart, _ as s_sub) =
+  let len_a = length affix_sub in
+  let len_s = length s_sub in
+  if len_a > len_s then false else
+  let max_zidx_a (* zero based idx *) = len_a - 1 in
+  let max_zidx_s (* zero based idx *) = len_s - len_a  in
+  let rec loop i k =
+    if i > max_zidx_s then false else
+    if k > max_zidx_a then true else
+    if k > 0 then
+      if sunsafe_get affix (astart + k) = sunsafe_get s (sstart + i + k)
+      then loop i (k + 1)
+      else loop (i + 1) 0
+    else if sunsafe_get affix astart = sunsafe_get s (sstart + i)
+    then loop i 1
+    else loop (i + 1) 0
+  in
+  loop 0 0
+
+let is_suffix ~affix:(affix, _, astop as affix_sub) (s, _, sstop as s_sub) =
+  let len_a = length affix_sub in
+  let len_s = length s_sub in
+  if len_a > len_s then false else
+  let max_zidx (* zero based idx *) = len_a - 1 in
+  let max_idx_a = astop - 1 in
+  let max_idx_s = sstop - 1 in
+  let rec loop i =
+    if i > max_zidx then true else
+    if sunsafe_get affix (max_idx_a - i) <> sunsafe_get s (max_idx_s - i)
+    then false
+    else loop (i + 1)
+  in
+  loop 0
+
+let for_all sat (s, start, stop) =
+  Astring_base.for_all sat s ~first:start ~last:(stop - 1)
+
+let exists sat (s, start, stop) =
+  Astring_base.exists sat s ~first:start ~last:(stop - 1)
+
+let same_base (s0, _, _) (s1, _, _) = s0 == s1
+
+let equal_bytes (s0, start0, stop0) (s1, start1, stop1) =
+  if s0 == s1 && start0 = start1 && stop0 = stop1 then true else
+  let len0 = stop0 - start0 in
+  let len1 = stop1 - start1 in
+  if len0 <> len1 then false else
+  let max_zidx = len0 - 1 in
+  let rec loop i =
+    if i > max_zidx then true else
+    if sunsafe_get s0 (start0 + i) <> sunsafe_get s1 (start1 + i)
+    then false
+    else loop (i + 1)
+  in
+  loop 0
+
+let compare_bytes (s0, start0, stop0) (s1, start1, stop1) =
+  if s0 == s1 && start0 = start1 && stop0 = stop1 then 0 else
+  let len0 = stop0 - start0 in
+  let len1 = stop1 - start1 in
+  let min_len = if len0 < len1 then len0 else len1 in
+  let max_i = min_len - 1 in
+  let rec loop i =
+    if i > max_i then compare len0 len1 else
+    let c0 = sunsafe_get s0 (start0 + i) in
+    let c1 = sunsafe_get s1 (start1 + i) in
+    let cmp = compare c0 c1 in
+    if cmp <> 0 then cmp else
+    loop (i + 1)
+  in
+  loop 0
+
+let eq_pos : int -> int -> bool = fun p0 p1 -> p0 = p1
+let equal (s0, start0, stop0) (s1, start1, stop1) =
+  if s0 != s1 then invalid_arg err_base else
+  eq_pos start0 start1 && eq_pos stop0 stop1
+
+let compare_pos : int -> int -> int = compare
+let compare (s0, start0, stop0) (s1, start1, stop1) =
+  if s0 != s1 then invalid_arg err_base else
+  let c = compare_pos start0 start1 in
+  if c <> 0 then c else
+  compare_pos stop0 stop1
+
+(* Extracting substrings *)
+
+let with_range ?(first = 0) ?(len = max_int) (s, start, stop) =
+  if len < 0 then invalid_arg (Astring_base.err_neg_len len) else
+  let s_len = stop - start in
+  let max_idx = s_len - 1 in
+  let empty = function
+  | first when first < 0 -> (s, start, start)
+  | first when first > max_idx -> (s, stop, stop)
+  | first -> (s, start + first, start + first)
+  in
+  if len = 0 then empty first else
+  let last (* index *) = match len with
+  | len when len = max_int -> max_idx
+  | len ->
+      let last = first + len - 1 in
+      if last > max_idx then max_idx else last
+  in
+  let first = if first < 0 then 0 else first in
+  if first > max_idx || last < 0 || first > last then empty first else
+  (s, start + first, start + last + 1 (* position *))
+
+let with_index_range ?(first = 0) ? last (s, start, stop) =
+  let s_len = stop - start in
+  let max_idx = s_len - 1 in
+  let empty = function
+  | first when first < 0 -> (s, start, start)
+  | first when first > max_idx -> (s, stop, stop)
+  | first -> (s, start + first, start + first)
+  in
+  let last (* index *) = match last with
+  | None -> max_idx
+  | Some last -> if last > max_idx then max_idx else last
+  in
+  let first = if first < 0 then 0 else first in
+  if first > max_idx || last < 0 || first > last then empty first else
+  (s, start + first, start + last + 1 (* position *))
+
+let trim ?(drop = Astring_char.Ascii.is_white) (s, start, stop as sub) =
+  let len = stop - start in
+  if len = 0 then sub else
+  let max_pos = stop in
+  let max_idx = stop - 1 in
+  let rec left_pos i =
+    if i > max_idx then max_pos else
+    if drop (sunsafe_get s i) then left_pos (i + 1) else i
+  in
+  let rec right_pos i =
+    if i < start then start else
+    if drop (sunsafe_get s i) then right_pos (i - 1) else (i + 1)
+  in
+  let left = left_pos start in
+  if left = max_pos then (s, (start + stop) / 2, (start + stop) / 2)  else
+  let right = right_pos max_idx in
+  if left = start && right = max_pos then sub else
+  (s, left, right)
+
+let fspan ~min ~max ~sat (s, start, stop as sub) =
+  if min < 0 then invalid_arg (Astring_base.err_neg_min min) else
+  if max < 0 then invalid_arg (Astring_base.err_neg_max max) else
+  if min > max || max = 0 then ((s, start, start), sub) else
+  let max_idx = stop - 1 in
+  let max_idx =
+    let k = start + max - 1 in (if k > max_idx || k < 0 then max_idx else k)
+  in
+  let need_idx = start + min in
+  let rec loop i =
+    if i <= max_idx && sat (sunsafe_get s i) then loop (i + 1) else
+    if i < need_idx || i = 0 then ((s, start, start), sub) else
+    if i = stop then (sub, (s, stop, stop)) else
+    (s, start, i), (s, i, stop)
+  in
+  loop start
+
+let rspan ~min ~max ~sat (s, start, stop as sub) =
+  if min < 0 then invalid_arg (Astring_base.err_neg_min min) else
+  if max < 0 then invalid_arg (Astring_base.err_neg_max max) else
+  if min > max || max = 0 then (sub, (s, stop, stop)) else
+  let max_idx = stop - 1 in
+  let min_idx = let k = stop - max in if k < start then start else k in
+  let need_idx = stop - min - 1 in
+  let rec loop i =
+    if i >= min_idx && sat (sunsafe_get s i) then loop (i - 1) else
+    if i > need_idx || i = max_idx then (sub, (s, stop, stop)) else
+    if i = start - 1 then ((s, start, start), sub) else
+    (s, start, i + 1), (s, i + 1, stop)
+  in
+  loop max_idx
+
+let span ?(rev = false) ?(min = 0) ?(max = max_int) ?(sat = fun _ -> true) sub =
+  match rev with
+  | true  -> rspan ~min ~max ~sat sub
+  | false -> fspan ~min ~max ~sat sub
+
+let take ?(rev = false) ?min ?max ?sat s =
+  (if rev then snd else fst) @@ span ~rev ?min ?max ?sat s
+
+let drop ?(rev = false) ?min ?max ?sat s =
+  (if rev then fst else snd) @@ span ~rev ?min ?max ?sat s
+
+let fcut ~sep:(sep, sep_start, sep_stop) (s, start, stop) =
+  let sep_len = sep_stop - sep_start in
+  if sep_len = 0 then invalid_arg Astring_base.err_empty_sep else
+  let max_sep_zidx = sep_len - 1 in
+  let max_s_idx = stop - sep_len in
+  let rec check_sep i k =
+    if k > max_sep_zidx then Some ((s, start, i), (s, i + sep_len, stop))
+    else if sunsafe_get s (i + k) = sunsafe_get sep (sep_start + k)
+    then check_sep i (k + 1)
+    else scan (i + 1)
+  and scan i =
+    if i > max_s_idx then None else
+    if sunsafe_get s i = sunsafe_get sep sep_start
+    then check_sep i 1
+    else scan (i + 1)
+  in
+  scan start
+
+let rcut ~sep:(sep, sep_start, sep_stop) (s, start, stop) =
+  let sep_len = sep_stop - sep_start in
+  if sep_len = 0 then invalid_arg Astring_base.err_empty_sep else
+  let max_sep_zidx = sep_len - 1 in
+  let max_s_idx = stop - 1 in
+  let rec check_sep i k =
+    if k > max_sep_zidx then Some ((s, start, i), (s, i + sep_len, stop))
+    else if sunsafe_get s (i + k) = sunsafe_get sep (sep_start + k)
+    then check_sep i (k + 1)
+    else rscan (i - 1)
+  and rscan i =
+    if i < start then None else
+    if sunsafe_get s i = sunsafe_get sep sep_start
+    then check_sep i 1
+    else rscan (i - 1)
+  in
+  rscan (max_s_idx - max_sep_zidx)
+
+let cut ?(rev = false) ~sep s = match rev with
+| true  -> rcut ~sep s
+| false -> fcut ~sep s
+
+let add_sub ~no_empty s ~start ~stop acc =
+  if start = stop then (if no_empty then acc else (s, start, start) :: acc) else
+  (s, start, stop) :: acc
+
+let fcuts ~no_empty ~sep:(sep, sep_start, sep_stop) (s, start, stop as sub) =
+  let sep_len = sep_stop - sep_start in
+  if sep_len = 0 then invalid_arg Astring_base.err_empty_sep else
+  let s_len = stop - start in
+  let max_sep_zidx = sep_len - 1 in
+  let max_s_idx = stop - sep_len in
+  let rec check_sep sstart i k acc =
+    if k > max_sep_zidx then
+      let new_start = i + sep_len in
+      scan new_start new_start (add_sub ~no_empty s ~start:sstart ~stop:i acc)
+    else
+      if sunsafe_get s (i + k) = sunsafe_get sep (sep_start + k)
+      then check_sep sstart i (k + 1) acc
+      else scan sstart (i + 1) acc
+  and scan sstart i acc =
+    if i > max_s_idx then
+      if sstart = start then (if no_empty && s_len = 0 then [] else [sub]) else
+      List.rev (add_sub ~no_empty s ~start:sstart ~stop acc)
+    else
+      if sunsafe_get s i = sunsafe_get sep sep_start
+      then check_sep sstart i 1 acc
+      else scan sstart (i + 1) acc
+  in
+  scan start start []
+
+let rcuts ~no_empty ~sep:(sep, sep_start, sep_stop) (s, start, stop as sub) =
+  let sep_len = sep_stop - sep_start in
+  if sep_len = 0 then invalid_arg Astring_base.err_empty_sep else
+  let s_len = stop - start in
+  let max_sep_zidx = sep_len - 1 in
+  let max_s_idx = stop - 1 in
+  let rec check_sep sstop i k acc =
+    if k > max_sep_zidx then
+      let start = i + sep_len in
+      rscan i (i - sep_len) (add_sub ~no_empty s ~start ~stop:sstop acc)
+    else
+      if sunsafe_get s (i + k) = sunsafe_get sep (sep_start + k)
+      then check_sep sstop i (k + 1) acc
+      else rscan sstop (i - 1) acc
+  and rscan sstop i acc =
+    if i < start then
+      if sstop = stop then (if no_empty && s_len = 0 then [] else [sub]) else
+      add_sub ~no_empty s ~start ~stop:sstop acc
+    else
+      if sunsafe_get s i = sunsafe_get sep sep_start
+      then check_sep sstop i 1 acc
+      else rscan sstop (i - 1) acc
+  in
+  rscan stop (max_s_idx - max_sep_zidx) []
+
+let cuts ?(rev = false) ?(empty = true) ~sep s = match rev with
+| true  -> rcuts ~no_empty:(not empty) ~sep s
+| false -> fcuts ~no_empty:(not empty) ~sep s
+
+let fields
+    ?(empty = false) ?(is_sep = Astring_char.Ascii.is_white)
+    (s, start, stop as sub)
+  =
+  let no_empty = not empty in
+  let max_pos = stop in
+  let rec loop i end_pos acc =
+    if i < start then begin
+      if end_pos = max_pos
+      then (if no_empty && max_pos = start then [] else [sub])
+      else add_sub ~no_empty s ~start ~stop:end_pos acc
+    end else begin
+      if not (is_sep (sunsafe_get s i)) then loop (i - 1) end_pos acc else
+      loop (i - 1) i (add_sub ~no_empty s ~start:(i + 1) ~stop:end_pos acc)
+    end
+  in
+  loop (max_pos - 1) max_pos []
+
+(* Traversing *)
+
+let ffind sat (s, start, stop) =
+  let max_idx = stop - 1 in
+  let rec loop i =
+    if i > max_idx then None else
+    if sat (sunsafe_get s i) then Some (s, i, i + 1) else loop (i + 1)
+  in
+  loop start
+
+let rfind sat (s, start, stop) =
+  let rec loop i =
+    if i < start then None else
+    if sat (sunsafe_get s i) then Some (s, i, i + 1) else loop (i - 1)
+  in
+  loop (stop - 1)
+
+let find ?(rev = false) sat sub = match rev with
+| true  -> rfind sat sub
+| false -> ffind sat sub
+
+let ffind_sub ~sub:(sub, sub_start, sub_stop) (s, start, stop) =
+  let len_sub = sub_stop - sub_start in
+  let len_s = stop - start in
+  if len_sub > len_s then None else
+  let max_zidx_sub = len_sub - 1 in
+  let max_idx_s = start + len_s - len_sub in
+  let rec loop i k =
+    if i > max_idx_s then None else
+    if k > max_zidx_sub then Some (s, i, i + len_sub) else
+    if k > 0 then
+      if sunsafe_get sub (sub_start + k) = sunsafe_get s (i + k)
+      then loop i (k + 1)
+      else loop (i + 1) 0
+    else if sunsafe_get sub sub_start = sunsafe_get s i then loop i 1 else
+    loop (i + 1) 0
+  in
+  loop start 0
+
+let rfind_sub ~sub:(sub, sub_start, sub_stop) (s, start, stop) =
+  let len_sub = sub_stop - sub_start in
+  let len_s = stop - start in
+  if len_sub > len_s then None else
+  let max_zidx_sub = len_sub - 1 in
+  let rec loop i k =
+    if i < start then None else
+    if k > max_zidx_sub then Some (s, i, i + len_sub) else
+    if k > 0 then
+      if sunsafe_get sub (sub_start + k) = sunsafe_get s (i + k)
+      then loop i (k + 1)
+      else loop (i - 1) 0
+    else if sunsafe_get sub sub_start = sunsafe_get s i then loop i 1 else
+    loop (i - 1) 0
+  in
+  loop (stop - len_sub) 0
+
+let find_sub ?(rev = false) ~sub start = match rev with
+| true  -> rfind_sub ~sub start
+| false -> ffind_sub ~sub start
+
+let filter sat (s, start, stop) =
+  let len = stop - start in
+  if len = 0 then empty else
+  let b = Bytes.create len in
+  let max_idx = stop - 1 in
+  let rec loop b k i = (* k is the write index in b *)
+    if i > max_idx then
+      ((if k = len then bytes_unsafe_to_string b else Bytes.sub_string b 0 k),
+       0, k)
+    else
+    let c = sunsafe_get s i in
+    if sat c then (bytes_unsafe_set b k c; loop b (k + 1) (i + 1)) else
+    loop b k (i + 1)
+  in
+  loop b 0 start
+
+let filter_map f (s, start, stop) =
+  let len = stop - start in
+  if len = 0 then empty else
+  let b = Bytes.create len in
+  let max_idx = stop - 1 in
+  let rec loop b k i = (* k is the write index in b *)
+    if i > max_idx then
+      ((if k = len then bytes_unsafe_to_string b else Bytes.sub_string b 0 k),
+       0, k)
+    else
+    match f (sunsafe_get s i) with
+    | None -> loop b k (i + 1)
+    | Some c -> bytes_unsafe_set b k c; loop b (k + 1) (i + 1)
+  in
+  loop b 0 start
+
+let map f (s, start, stop) =
+  let len = stop - start in
+  if len = 0 then empty else
+  let b = Bytes.create len in
+  for i = 0 to len - 1 do
+    bytes_unsafe_set b i (f (sunsafe_get s (start + i)))
+  done;
+  (bytes_unsafe_to_string b, 0, len)
+
+let mapi f (s, start, stop) =
+  let len = stop - start in
+  if len = 0 then empty else
+  let b = Bytes.create len in
+  for i = 0 to len - 1 do
+    bytes_unsafe_set b i (f i (sunsafe_get s (start + i)))
+  done;
+  (bytes_unsafe_to_string b, 0, len)
+
+let fold_left f acc (s, start, stop) =
+  Astring_base.fold_left f acc s ~first:start ~last:(stop - 1)
+
+let fold_right f (s, start, stop) acc =
+  Astring_base.fold_right f s acc ~first:start ~last:(stop - 1)
+
+let iter f (s, start, stop) =
+  for i = start to stop - 1 do f (sunsafe_get s i) done
+
+let iteri f (s, start, stop)  =
+  for i = start to stop - 1 do f (i - start) (sunsafe_get s i) done
+
+(* Pretty printing *)
+
+let pp ppf s =
+  Format.pp_print_string ppf (to_string s)
+
+let dump ppf s =
+  Format.pp_print_char ppf '"';
+  Format.pp_print_string ppf (Astring_escape.escape_string (to_string s));
+  Format.pp_print_char ppf '"';
+  ()
+
+let dump_raw ppf (s, start, stop) =
+  Format.fprintf ppf "@[<1>(@[<1>(base@ \"%s\")@]@ @[<1>(start@ %d)@]@ \
+                         @[(stop@ %d)@])@]"
+    (Astring_escape.escape_string s) start stop
+
+(* OCaml base type conversions *)
+
+let of_char c = v (Astring_base.of_char c)
+let to_char s = Astring_base.to_char (to_string s)
+let of_bool b = v (Astring_base.of_bool b)
+let to_bool s = Astring_base.to_bool (to_string s)
+let of_int i = v (Astring_base.of_int i)
+let to_int s = Astring_base.to_int (to_string s)
+let of_nativeint i = v (Astring_base.of_nativeint i)
+let to_nativeint s = Astring_base.to_nativeint (to_string s)
+let of_int32 i = v (Astring_base.of_int32 i)
+let to_int32 s = Astring_base.to_int32 (to_string s)
+let of_int64 i = v (Astring_base.of_int64 i)
+let to_int64 s = Astring_base.to_int64 (to_string s)
+let of_float f = v (Astring_base.of_float f)
+let to_float s = Astring_base.to_float (to_string s)
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The astring 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.
+  ---------------------------------------------------------------------------*)

unikernel/duniverse/astring/src/astring_top.ml

@@ -0,0 +1,22 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The astring programmers. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+
+let () = ignore (Toploop.use_file Format.err_formatter "astring_top_init.ml")
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The astring 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.
+  ---------------------------------------------------------------------------*)

unikernel/duniverse/astring/src/astring_top.mllib

@@ -0,0 +1 @@
+Astring_top

unikernel/duniverse/astring/src/astring_top_init.ml

@@ -0,0 +1,28 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The astring programmers. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+
+open Astring;;
+
+#install_printer Char.dump;;
+#install_printer String.dump;;
+#install_printer String.Sub.dump;;
+#install_printer String.Set.dump;;
+#install_printer String.Map.dump_string_map;;
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The astring 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.
+  ---------------------------------------------------------------------------*)

unikernel/duniverse/astring/src/astring_unsafe.ml

@@ -0,0 +1,45 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The astring programmers. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+
+(* Unsafe string and byte manipulations. If you don't believe the
+   author's invariants, replacing with safe versions makes everything
+   safe in the library. He won't be upset. *)
+
+let array_unsafe_get = Array.unsafe_get
+
+external char_unsafe_of_byte : int -> char = "%identity"
+external char_to_byte : char -> int = "%identity"
+
+let bytes_unsafe_set = Bytes.unsafe_set
+let bytes_unsafe_to_string = Bytes.unsafe_to_string
+let bytes_unsafe_blit_string s sfirst d dfirst len =
+  Bytes.(unsafe_blit (unsafe_of_string s) sfirst d dfirst len)
+
+external string_length : string -> int = "%string_length"
+external string_equal : string -> string -> bool = "caml_string_equal"
+external string_compare : string -> string -> int = "caml_string_compare"
+external string_safe_get : string -> int -> char = "%string_safe_get"
+external string_unsafe_get : string -> int -> char = "%string_unsafe_get"
+
+let unsafe_string_sub s first len =
+  let b = Bytes.create len in
+  bytes_unsafe_blit_string s first b 0 len;
+  Bytes.unsafe_to_string b
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The astring 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.
+  ---------------------------------------------------------------------------*)

unikernel/duniverse/astring/src/dune

@@ -0,0 +1,14 @@
+(library
+ (name astring)
+ (public_name astring)
+ (modules astring_unsafe astring_base astring_escape astring_char astring_sub
+   astring_string astring)
+ (flags :standard -w -27)
+ (wrapped false))
+
+(library
+ (name astring_top)
+ (public_name astring.top)
+ (libraries compiler-libs.toplevel)
+ (modules astring_top)
+ (wrapped false))

unikernel/duniverse/astring/test/examples.ml

@@ -0,0 +1,87 @@
+(* This code is in the public domain *)
+
+open Astring
+
+(* Version number (v|V).major.minor[.patch][(+|-)info] *)
+
+let parse_version : string -> (int * int * int * string option) option =
+fun s -> try
+  let parse_opt_v s = match String.Sub.head s with
+  | Some ('v'|'V') -> String.Sub.tail s
+  | Some _ -> s
+  | None -> raise Exit
+  in
+  let parse_dot s = match String.Sub.head s with
+  | Some '.' -> String.Sub.tail s
+  | Some _ | None -> raise Exit
+  in
+  let parse_int s =
+    match String.Sub.span ~min:1 ~sat:Char.Ascii.is_digit s with
+    | (i, _) when String.Sub.is_empty i -> raise Exit
+    | (i, s) ->
+        match String.Sub.to_int i with
+        | None -> raise Exit | Some i -> i, s
+  in
+  let maj, s = parse_int (parse_opt_v (String.sub s)) in
+  let min, s = parse_int (parse_dot s) in
+  let patch, s = match String.Sub.head s with
+  | Some '.' -> parse_int (parse_dot s)
+  | _ -> 0, s
+  in
+  let info = match String.Sub.head s with
+  | Some ('+' | '-') -> Some (String.Sub.(to_string (tail s)))
+  | Some _ -> raise Exit
+  | None -> None
+  in
+  Some (maj, min, patch, info)
+with Exit -> None
+
+(* Key value bindings *)
+
+let parse_env : string -> string String.map option =
+fun s -> try
+  let skip_white s = String.Sub.drop ~sat:Char.Ascii.is_white s in
+  let parse_key s =
+    let id_char c = Char.Ascii.is_letter c || c = '_' in
+    match String.Sub.span ~min:1 ~sat:id_char s with
+    | (key, _) when String.Sub.is_empty key -> raise Exit
+    | (key, rem) -> (String.Sub.to_string key), rem
+  in
+  let parse_eq s = match String.Sub.head s with
+  | Some '=' -> String.Sub.tail s
+  | Some _ | None -> raise Exit
+  in
+  let parse_value s = match String.Sub.head s with
+  | Some '"' -> (* quoted *)
+      let is_data = function '\\' | '"' -> false | _ -> true in
+      let rec loop acc s =
+        let data, rem = String.Sub.span ~sat:is_data s in
+        match String.Sub.head rem with
+        | Some '"' ->
+            let acc = List.rev (data :: acc) in
+            String.Sub.(to_string @@ concat acc), (String.Sub.tail rem)
+        | Some '\\' ->
+            let rem = String.Sub.tail rem in
+            begin match String.Sub.head rem with
+            | Some ('"' | '\\' as c) ->
+                let acc = String.(sub (of_char c)) :: data :: acc in
+                loop acc (String.Sub.tail rem)
+            | Some _ | None -> raise Exit
+            end
+        | None | Some _ -> raise Exit
+      in
+      loop [] (String.Sub.tail s)
+  | Some _ ->
+      let is_data c = not (Char.Ascii.is_white c) in
+      let data, rem = String.Sub.span ~sat:is_data s in
+      String.Sub.to_string data, rem
+  | None -> "", s
+  in
+  let rec parse_bindings acc s =
+    if String.Sub.is_empty s then acc else
+    let key, s = parse_key s in
+    let value, s = s |> skip_white |> parse_eq |> skip_white |> parse_value in
+    parse_bindings (String.Map.add key value acc) (skip_white s)
+  in
+  Some (String.sub s |> skip_white |> parse_bindings String.Map.empty)
+with Exit -> None

unikernel/duniverse/astring/test/test.ml

@@ -0,0 +1,29 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The astring programmers. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+
+let tests () = Testing.run
+    [ Test_char.suite;
+      Test_string.suite;
+      Test_sub.suite; ]
+
+let run () = tests (); Testing.log_results ()
+
+let () = if run () then exit 0 else exit 1
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The astring 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.
+  ---------------------------------------------------------------------------*)

unikernel/duniverse/astring/test/test_char.ml

@@ -0,0 +1,130 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The astring programmers. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+
+open Testing
+open Astring
+
+let eq = eq ~pp:Char.dump
+let eq_opt = eq_option ~pp:Char.dump ~eq:Char.equal
+let invalid = app_invalid ~pp:Char.dump
+
+let misc = test "Char.{of_byte,of_int,to_int}" @@ fun () ->
+  invalid Char.of_byte (-1);
+  invalid Char.of_byte (256);
+  eq_opt (Char.of_int (-1)) None;
+  eq_opt (Char.of_int 256) None;
+  for i = 0 to 0xFF do
+    let of_int = Char.of_int $ pp_int @-> ret_get_option Char.dump in
+    eq_int (Char.to_int (of_int i)) i
+  done;
+  ()
+
+let predicates = test "Char.{equal,compare}" @@ fun () ->
+  eq_bool (Char.equal ' ' ' ') true;
+  eq_bool (Char.equal ' ' 'a') false;
+  eq_int (Char.compare ' ' 'a') (-1);
+  eq_int (Char.compare ' ' ' ') (0);
+  eq_int (Char.compare 'a' ' ') (1);
+  eq_int (Char.compare '\x00' ' ') (-1);
+  ()
+
+let ascii_predicates = test "Char.Ascii.is_*" @@ fun () ->
+  let pp_int ppf i = Format.fprintf ppf "%X" i in
+  let test_pred p pi i =
+    let pred p i = p (Char.of_byte i) in
+    (pred p $ pp_int @-> ret_eq ~eq:(=) pp_bool (pi i)) i
+  in
+  let test p pi = for i = 0 to 255 do ignore (test_pred p pi i) done in
+  test Char.Ascii.is_valid (fun i -> i <= 0x7F);
+  test Char.Ascii.is_digit (fun i -> 0x30 <= i && i <= 0x39);
+  test Char.Ascii.is_hex_digit (fun i -> (0x30 <= i && i <= 0x39) ||
+                                         (0x41 <= i && i <= 0x46) ||
+                                         (0x61 <= i && i <= 0x66));
+  test Char.Ascii.is_upper (fun i -> 0x41 <= i && i <= 0x5A);
+  test Char.Ascii.is_lower (fun i -> 0x61 <= i && i <= 0x7A);
+  test Char.Ascii.is_letter (fun i -> (0x41 <= i && i <= 0x5A) ||
+                                      (0x61 <= i && i <= 0x7A));
+  test Char.Ascii.is_alphanum (fun i -> (0x30 <= i && i <= 0x39) ||
+                                        (0x41 <= i && i <= 0x5A) ||
+                                        (0x61 <= i && i <= 0x7A));
+  test Char.Ascii.is_white (fun i -> (0x09 <= i && i <= 0x0D) || i = 0x20);
+  test Char.Ascii.is_blank (fun i -> (i = 0x20 || i = 0x09));
+  test Char.Ascii.is_graphic (fun i -> (0x21 <= i && i <= 0x7E));
+  test Char.Ascii.is_print (fun i -> (0x21 <= i && i <= 0x7E) || i = 0x20);
+  test Char.Ascii.is_control (fun i -> (0x00 <= i && i <= 0x1F) || i = 0x7F);
+  ()
+
+let ascii_transforms = test "Char.Ascii.{uppercase,lowercase}" @@ fun () ->
+  for i = 0 to 255 do
+    if (0x61 <= i && i <= 0x7A)
+    then eq_char Char.(Ascii.uppercase @@ of_byte i) (Char.of_byte (i - 32))
+    else eq_char Char.(Ascii.uppercase @@ of_byte i) (Char.of_byte i)
+  done;
+  for i = 0 to 255 do
+    if (0x41 <= i && i <= 0x5A)
+    then eq_char Char.(Ascii.lowercase @@ of_byte i) (Char.of_byte (i + 32))
+    else eq_char Char.(Ascii.lowercase @@ of_byte i) (Char.of_byte i)
+  done;
+  ()
+
+let ascii_escape = test "Char.Ascii.{escape,escape_char}" @@ fun () ->
+  for i = 0 to 255 do
+    let c = Char.of_byte i in
+    let esc = Char.Ascii.escape c in
+    begin match String.Ascii.unescape esc with
+    | None -> fail "could not unescape";
+    | Some unesc ->
+        eq_int (String.length unesc) 1;
+        eq_char unesc.[0] (Char.of_byte i);
+    end;
+    if (0x00 <= i && i <= 0x1F) || (0x7F <= i && i <= 0xFF)
+    then eq_str esc (Printf.sprintf "\\x%02X" i)
+    else if (i = 0x5C)
+    then eq_str esc "\\\\"
+    else eq_str esc (Printf.sprintf "%c" c)
+  done;
+  for i = 0 to 255 do
+    let c = Char.of_byte i in
+    let esc = Char.Ascii.escape_char c in
+    begin match String.Ascii.unescape_string esc with
+    | None -> fail "could not unescape";
+    | Some unesc ->
+        eq_int (String.length unesc) 1;
+        eq_char unesc.[0] (Char.of_byte i);
+    end;
+    if (i = 0x08) then eq_str esc "\\b" else
+    if (i = 0x09) then eq_str esc "\\t" else
+    if (i = 0x0A) then eq_str esc "\\n" else
+    if (i = 0x0D) then eq_str esc "\\r" else
+    if (i = 0x27) then eq_str esc "\\'" else
+    if (i = 0x5C) then eq_str esc "\\\\" else
+    if (0x00 <= i && i <= 0x1F) || (0x7F <= i && i <= 0xFF)
+    then eq_str esc (Printf.sprintf "\\x%02X" i)
+    else eq_str esc (Printf.sprintf "%c" c)
+  done;
+  ()
+
+let suite = suite "Char functions"
+    [ misc;
+      predicates;
+      ascii_predicates;
+      ascii_transforms;
+      ascii_escape; ]
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The astring 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.
+  ---------------------------------------------------------------------------*)

unikernel/duniverse/astring/test/testing.ml

@@ -0,0 +1,257 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The astring programmers. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+
+(* Value equality and pretty printing *)
+
+type 'a eq = 'a -> 'a -> bool
+type 'a pp = Format.formatter -> 'a -> unit
+
+(* Pretty printers *)
+
+let pp = Format.fprintf
+let pp_exn ppf v = pp ppf "%s" (Printexc.to_string v)
+let pp_bool ppf v = pp ppf "%b" v
+let pp_char ppf v = pp ppf "%C" v
+let pp_str ppf v = pp ppf "%S" v
+let pp_int = Format.pp_print_int
+let pp_float ppf v = pp ppf "%.10f" (* bof... *) v
+let pp_int32 ppf v = pp ppf "%ld" v
+let pp_int64 ppf v = pp ppf "%Ld" v
+let pp_text = Format.pp_print_text
+let pp_list pp_v ppf l =
+  let pp_sep ppf () = pp ppf ";@," in
+  pp ppf "@[<1>[%a]@]" (Format.pp_print_list ~pp_sep pp_v) l
+
+let pp_option pp_v ppf = function
+| None -> Format.fprintf ppf "None"
+| Some v -> Format.fprintf ppf "Some %a" pp_v v
+
+let pp_slot_loc ppf l =
+  pp ppf "%s:%d.%d-%d:"
+    l.Printexc.filename l.Printexc.line_number
+    l.Printexc.start_char l.Printexc.end_char
+
+let pp_bt ppf bt = match Printexc.backtrace_slots bt with
+| None -> pp ppf "@,@[%a@]" pp_text "No backtrace. Did you compile with -g ?"
+| Some slots ->
+    let rec loop = function
+    | [] -> assert false
+    | s :: ss ->
+        begin match Printexc.Slot.location s with
+        | None -> ()
+        | Some l when l.Printexc.filename = "test/testing.ml" ||
+                      l.Printexc.filename = "test/test.ml" -> ()
+        | Some l -> pp ppf "@,%a" pp_slot_loc l
+        end;
+        if ss <> [] then (loop ss) else ()
+    in
+    loop (Array.to_list slots)
+
+(* Assertion counters *)
+
+let fail_count = ref 0
+let pass_count = ref 0
+
+(* Logging *)
+
+let log_part fmt = Format.printf fmt
+let log ?header fmt = match header with
+| Some h -> Format.printf ("[%s] " ^^ fmt ^^ "@.") h
+| None -> Format.printf (fmt ^^ "@.")
+
+let log_results () =
+  let total = !pass_count + !fail_count in
+  match !fail_count with
+  | 0 -> log ~header:"OK" "All %d assertions succeeded !@." total; true
+  | 1 -> log ~header:"FAIL" "1 failure out of %d assertions" total; false
+  | n -> log ~header:"FAIL" "%d failures out of %d assertions"
+           !fail_count total; false
+
+let log_fail msg bt =
+  log ~header:"FAIL" "@[<v>@[%a@]%a@]" pp_text msg pp_bt bt
+
+let log_unexpected_exn ~header exn bt =
+  log ~header:"SUITE" "@[<v>@[ABORTED: unexpected exception:@]@,%a%a@]"
+    pp_exn exn pp_bt bt
+
+(* Testing scopes *)
+
+exception Fail
+exception Fail_handled
+
+let block f = try f () with
+| Fail | Fail_handled -> ()
+| exn ->
+    let bt = Printexc.get_raw_backtrace () in
+    incr fail_count;
+    log_unexpected_exn ~header:"BLOCK" exn bt
+
+type test = string * (unit -> unit)
+
+let test n f = n, f
+let run_test (n, f) =
+  log "* %s" n;
+  try f () with
+  | Fail | Fail_handled ->
+      log ~header:"TEST" "ABORTED: a test failure blew the test scope"
+  | exn ->
+      let bt = Printexc.get_raw_backtrace () in
+      incr fail_count;
+      log_unexpected_exn ~header:"TEST" exn bt
+
+type suite = string * test list
+let suite n ts = n, ts
+let run_suite (n, ts) = try log "%s" n; List.iter run_test ts with
+| exn ->
+    let bt = Printexc.get_raw_backtrace () in
+    incr fail_count;
+    log_unexpected_exn ~header:"SUITE" exn bt
+
+let run suites = List.iter run_suite suites
+
+(* Passing and failing tests *)
+
+let pass () = incr pass_count
+let fail fmt =
+  let bt = Printexc.get_callstack 10 in
+  let fail _ = log_fail (Format.flush_str_formatter ()) bt in
+  (incr fail_count; Format.kfprintf fail Format.str_formatter fmt)
+
+(* Checking values *)
+
+let pp_neq pp_v ppf (v, v') = pp ppf "@[%a@]@ <>@ @[%a@]@]" pp_v v pp_v v'
+
+let fail_eq pp v v' = fail "%a" (pp_neq pp) (v, v')
+
+let eq ~eq ~pp v v' = if eq v v' then pass () else fail_eq pp v v'
+let eq_char = eq ~eq:(=) ~pp:pp_char
+let eq_str = eq ~eq:(=) ~pp:pp_str
+let eq_bool = eq ~eq:(=) ~pp:Format.pp_print_bool
+let eq_int = eq ~eq:(=) ~pp:Format.pp_print_int
+let eq_int32 = eq ~eq:(=) ~pp:pp_int32
+let eq_int64 = eq ~eq:(=) ~pp:pp_int64
+let eq_float = eq ~eq:(=) ~pp:pp_float
+let eq_nan f =
+  if f <> f then pass () else fail "@[%a@]@ is@ not a NaN" pp_float f
+
+let eq_option ~eq:eq_v ~pp =
+  let eq_opt v v' = match v, v' with
+  | Some v, Some v' -> eq_v v v'
+  | None, None -> true
+  | _ -> false
+  in
+  let pp = pp_option pp in
+  fun v v' -> eq ~eq:eq_opt ~pp v v'
+
+let eq_some = function
+| Some _ -> pass ()
+| None -> fail "None <> Some _"
+
+let eq_none ~pp = function
+| None -> pass ()
+| Some v -> fail "@[%a <>@ None@]" pp v
+
+let eq_list ~eq:eq_v ~pp:pp_v =
+  let eql l l' = try List.for_all2 eq_v l l' with Invalid_argument _ -> false in
+  fun l l' -> eq ~eq:eql ~pp:(pp_list pp_v) l l'
+
+(* Tracing and checking function applications. *)
+
+type app = (* Gathers information about the application *)
+  { fail_count : int; (* fail_count checkpoint when the app starts *)
+    pp_args : Format.formatter -> unit -> unit; }
+
+let ctx () = { fail_count = -1; pp_args = fun ppf () -> (); }
+
+let log_app_raised app exn =
+  log "@[<2>@[%a@]==> raised %a" app.pp_args () pp_exn exn
+
+let pp_app app pp_v ppf v =
+  pp ppf "@[<2>@[%a@]==>@ @[%a@]@]" app.pp_args () pp_v v
+
+let log_app app pp_v v = log "%a" (pp_app app pp_v) v
+
+let ( $ ) f k = k (ctx ()) f
+
+let ( @-> ) (pp_v : 'a pp) k app f v =
+  let pp_args ppf () = app.pp_args ppf (); pp ppf "%a@ " pp_v v in
+  let fc = if app.fail_count = -1 then !fail_count else app.fail_count in
+  let app = { fail_count = fc; pp_args } in
+  try k app (f v) with
+  | Fail ->
+      log_app app pp_v v;
+      raise Fail_handled
+  | Fail_handled as e -> raise e
+  | exn ->
+      log_app_raised app exn;
+      fail "unexpected exception %a raised" pp_exn exn;
+      raise Fail_handled
+
+let ret pp app v =
+  if !fail_count <> app.fail_count then log_app app pp v;
+  v
+
+let ret_eq ~eq pp r app v =
+  if eq r v then (pass (); ret pp app v) else
+  (fail "@[<v>%a@,%a@]" (pp_neq pp) (r, v) (pp_app app pp) v;
+   raise Fail_handled)
+
+let ret_none pp app v = match v with
+| None -> pass (); ret (pp_option pp) app v
+| Some _ -> ret_eq ~eq:(=) (pp_option pp) None app v
+
+let ret_some pp app v = match v with
+| Some _ as v -> pass (); ret (pp_option pp) app v
+| None as v ->
+    fail "@[<v>Some _ <> None@,%a@]" (pp_app app (pp_option pp)) v;
+    raise Fail_handled
+
+let ret_get_option pp app v = match ret_some pp app v with
+| Some v -> v
+| None -> assert false
+
+(* I think we could handle the following functions on app traced ones
+   by enriching the app type and have alternate functions to $ for
+   handling these cases. Note that the only place were we can check
+   for these things are in the @-> combinator *)
+
+let app_invalid ~pp f v =
+  try
+    let r = f v in
+    fail "%a <> exception Invalid_arg _" pp r
+  with
+  | Invalid_argument _ -> pass ()
+  | exn -> fail "exception %a <> exception Invalid_arg _" pp_exn exn
+
+let app_exn ~pp e f v =
+  try
+    let r = f v in
+    fail "%a <> exception %a" pp r pp_exn e
+  with
+  | exn when exn = e -> pass ()
+  | exn -> fail "exception %a <> exception %a_" pp_exn exn pp_exn e
+
+let app_raises ~pp f v =
+  try
+    let r = f v in
+    fail "%a <> exception _ " pp r
+  with
+  | exn -> pass ()
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The astring 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.
+  ---------------------------------------------------------------------------*)

unikernel/duniverse/astring/test/testing.mli

@@ -0,0 +1,92 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The astring programmers. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+
+(* {1 Value equality and pretty printing} *)
+
+type 'a eq = 'a -> 'a -> bool
+type 'a pp = Format.formatter -> 'a -> unit
+
+(* {1 Pretty printers} *)
+
+val pp_int : int pp
+val pp_bool : bool pp
+val pp_float : float pp
+val pp_char : char pp
+val pp_str : string pp
+val pp_list : 'a pp -> 'a list pp
+val pp_option : 'a pp -> 'a option pp
+
+(* {1 Logging} *)
+
+val log_part : ('a, Format.formatter, unit) format -> 'a
+val log : ?header:string -> ('a, Format.formatter, unit) format -> 'a
+val log_results : unit -> bool
+
+(* {1 Testing scopes} *)
+
+type test
+type suite
+
+val block : (unit -> unit) -> unit
+val test : string -> (unit -> unit) -> test
+val suite : string -> test list -> suite
+
+val run : suite list -> unit
+
+(* {1 Passing and failing tests} *)
+
+val pass : unit -> unit
+val fail : ('a, Format.formatter, unit, unit) format4 -> 'a
+
+(* {1 Checking values} *)
+
+val eq : eq:'a eq -> pp:'a pp -> 'a -> 'a -> unit
+val eq_char : char -> char -> unit
+val eq_str : string -> string -> unit
+val eq_bool : bool -> bool -> unit
+val eq_int : int -> int -> unit
+val eq_int32 : int32 -> int32 -> unit
+val eq_int64 : int64 -> int64 -> unit
+val eq_float : float -> float -> unit
+val eq_nan : float -> unit
+
+val eq_option : eq:'a eq -> pp:'a pp -> 'a option -> 'a option -> unit
+val eq_some : 'a option -> unit
+val eq_none : pp:'a pp -> 'a option -> unit
+
+val eq_list : eq:'a eq -> pp:'a pp -> 'a list -> 'a list -> unit
+
+(* {1 Tracing and checking function applications} *)
+
+type app (* holds information about the application *)
+
+val ( $ ) : 'a -> (app -> 'a -> 'b) -> 'b
+val ( @-> ) : 'a pp -> (app -> 'b -> 'c) -> app -> ('a -> 'b) -> 'a -> 'c
+
+val ret : 'a pp -> app -> 'a -> 'a
+val ret_eq : eq:'a eq -> 'a pp -> 'a -> app -> 'a -> 'a
+val ret_some : 'a pp -> app -> 'a option -> 'a option
+val ret_none : 'a pp -> app -> 'a option -> 'a option
+val ret_get_option : 'a pp -> app -> 'a option -> 'a
+
+val app_invalid : pp:'b pp -> ('a -> 'b) -> 'a -> unit
+val app_exn : pp:'b pp -> exn -> ('a -> 'b) -> 'a -> unit
+val app_raises : pp:'b pp -> ('a -> 'b) -> 'a -> unit
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2015 The astring 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.
+  ---------------------------------------------------------------------------*)

unikernel/duniverse/astring/test/total.ml

@@ -0,0 +1,20 @@
+
+open Astring
+
+(* Total *)
+let find_all p s =
+  let rec loop acc i = match String.find ~start:i p s with
+  | None -> List.rev acc
+  | Some i -> loop (i :: acc) (i + 1)
+  in
+  loop [] 0
+
+(* Not total *)
+let find_all p s =
+  let rec loop acc i =
+    if i > String.length s then List.rev acc else
+    match String.find ~start:i p s with
+    | None -> List.rev acc
+    | Some i -> loop (i :: acc) (i + 1)
+  in
+  loop [] 0