swrup/mte
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Browse source
This commit is contained in:
swrup 2025-11-11 02:07:51 +01:00
parent aa2ff7b2f0
commit 2f3113f55d
11742 changed files with 1223940 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

13
unikernel/duniverse/dune_/vendor/uutf/LICENSE.md vendored Normal file
View file

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

2
unikernel/duniverse/dune_/vendor/uutf/dune vendored Normal file
View file

@ -0,0 +1,2 @@
(library
(name dune_uutf))

822
unikernel/duniverse/dune_/vendor/uutf/uutf.ml vendored Normal file
View file

@ -0,0 +1,822 @@
(*---------------------------------------------------------------------------
Copyright (c) 2012 The uutf programmers. All rights reserved.
Distributed under the ISC license, see terms at the end of the file.
---------------------------------------------------------------------------*)
let io_buffer_size = 65536 (* IO_BUFFER_SIZE 4.0.0 *)
let pp = Format.fprintf
let invalid_encode () = invalid_arg "expected `Await encode"
let invalid_bounds j l =
invalid_arg (Printf.sprintf "invalid bounds (index %d, length %d)" j l)
(* Unsafe string byte manipulations. If you don't believe the author's
invariants, replacing with safe versions makes everything safe in
the module. He won't be upset. *)
let unsafe_chr = Char.unsafe_chr
let unsafe_blit = Bytes.unsafe_blit
let unsafe_array_get = Array.unsafe_get
let unsafe_byte s j = Char.code (Bytes.unsafe_get s j)
let unsafe_set_byte s j byte = Bytes.unsafe_set s j (Char.unsafe_chr byte)
(* Unicode characters *)
let u_bom = Uchar.unsafe_of_int 0xFEFF (* BOM. *)
let u_rep = Uchar.unsafe_of_int 0xFFFD (* replacement character. *)
(* Unicode encoding schemes *)
type encoding = [ `UTF_8 | `UTF_16 | `UTF_16BE | `UTF_16LE ]
type decoder_encoding = [ encoding | `US_ASCII | `ISO_8859_1 ]
let encoding_of_string s = match String.uppercase_ascii s with (* IANA names. *)
| "UTF-8" -> Some `UTF_8
| "UTF-16" -> Some `UTF_16
| "UTF-16LE" -> Some `UTF_16LE
| "UTF-16BE" -> Some `UTF_16BE
| "ANSI_X3.4-1968" | "ISO-IR-6" | "ANSI_X3.4-1986" | "ISO_646.IRV:1991"
| "ASCII" | "ISO646-US" | "US-ASCII" | "US" | "IBM367" | "CP367" | "CSASCII" ->
Some `US_ASCII
| "ISO_8859-1:1987" | "ISO-IR-100" | "ISO_8859-1" | "ISO-8859-1"
| "LATIN1" | "L1" | "IBM819" | "CP819" | "CSISOLATIN1" ->
Some `ISO_8859_1
| _ -> None
let encoding_to_string = function
| `UTF_8 -> "UTF-8" | `UTF_16 -> "UTF-16" | `UTF_16BE -> "UTF-16BE"
| `UTF_16LE -> "UTF-16LE" | `US_ASCII -> "US-ASCII"
| `ISO_8859_1 -> "ISO-8859-1"
(* Base character decoders. They assume enough data. *)
let malformed s j l = `Malformed (Bytes.sub_string s j l)
let malformed_pair be hi s j l = (* missing or half low surrogate at eoi. *)
let bs1 = Bytes.(sub s j l) in
let bs0 = Bytes.create 2 in
let j0, j1 = if be then (0, 1) else (1, 0) in
unsafe_set_byte bs0 j0 (hi lsr 8);
unsafe_set_byte bs0 j1 (hi land 0xFF);
`Malformed Bytes.(unsafe_to_string (cat bs0 bs1))
let r_us_ascii s j =
(* assert (0 <= j && j < String.length s); *)
let b0 = unsafe_byte s j in
if b0 <= 127 then `Uchar (Uchar.unsafe_of_int b0) else malformed s j 1
let r_iso_8859_1 s j =
(* assert (0 <= j && j < String.length s); *)
`Uchar (Uchar.unsafe_of_int @@ unsafe_byte s j)
let utf_8_len = [| (* uchar byte length according to first UTF-8 byte. *)
1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1;
1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1;
1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1;
1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1;
1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1;
1; 1; 1; 1; 1; 1; 1; 1; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0;
0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0;
0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0;
0; 0; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2;
2; 2; 2; 2; 2; 2; 2; 2; 3; 3; 3; 3; 3; 3; 3; 3; 3; 3; 3; 3; 3; 3; 3; 3;
4; 4; 4; 4; 4; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0 |]
let r_utf_8 s j l =
(* assert (0 <= j && 0 <= l && j + l <= String.length s); *)
let uchar c = `Uchar (Uchar.unsafe_of_int c) in
match l with
| 1 -> uchar (unsafe_byte s j)
| 2 ->
let b0 = unsafe_byte s j in let b1 = unsafe_byte s (j + 1) in
if b1 lsr 6 != 0b10 then malformed s j l else
uchar (((b0 land 0x1F) lsl 6) lor (b1 land 0x3F))
| 3 ->
let b0 = unsafe_byte s j in let b1 = unsafe_byte s (j + 1) in
let b2 = unsafe_byte s (j + 2) in
let c = ((b0 land 0x0F) lsl 12) lor
((b1 land 0x3F) lsl 6) lor
(b2 land 0x3F)
in
if b2 lsr 6 != 0b10 then malformed s j l else
begin match b0 with
| 0xE0 -> if b1 < 0xA0 || 0xBF < b1 then malformed s j l else uchar c
| 0xED -> if b1 < 0x80 || 0x9F < b1 then malformed s j l else uchar c
| _ -> if b1 lsr 6 != 0b10 then malformed s j l else uchar c
end
| 4 ->
let b0 = unsafe_byte s j in let b1 = unsafe_byte s (j + 1) in
let b2 = unsafe_byte s (j + 2) in let b3 = unsafe_byte s (j + 3) in
let c = (((b0 land 0x07) lsl 18) lor
((b1 land 0x3F) lsl 12) lor
((b2 land 0x3F) lsl 6) lor
(b3 land 0x3F))
in
if b3 lsr 6 != 0b10 || b2 lsr 6 != 0b10 then malformed s j l else
begin match b0 with
| 0xF0 -> if b1 < 0x90 || 0xBF < b1 then malformed s j l else uchar c
| 0xF4 -> if b1 < 0x80 || 0x8F < b1 then malformed s j l else uchar c
| _ -> if b1 lsr 6 != 0b10 then malformed s j l else uchar c
end
| _ -> assert false
let r_utf_16 s j0 j1 = (* May return a high surrogate. *)
(* assert (0 <= j0 && 0 <= j1 && max j0 j1 < String.length s); *)
let b0 = unsafe_byte s j0 in let b1 = unsafe_byte s j1 in
let u = (b0 lsl 8) lor b1 in
if u < 0xD800 || u > 0xDFFF then `Uchar (Uchar.unsafe_of_int u) else
if u > 0xDBFF then malformed s (min j0 j1) 2 else `Hi u
let r_utf_16_lo hi s j0 j1 = (* Combines [hi] with a low surrogate. *)
(* assert (0 <= j0 && 0 <= j1 && max j0 j1 < String.length s); *)
let b0 = unsafe_byte s j0 in
let b1 = unsafe_byte s j1 in
let lo = (b0 lsl 8) lor b1 in
if lo < 0xDC00 || lo > 0xDFFF
then malformed_pair (j0 < j1 (* true => be *)) hi s (min j0 j1) 2
else `Uchar (Uchar.unsafe_of_int ((((hi land 0x3FF) lsl 10) lor
(lo land 0x3FF)) + 0x10000))
let r_encoding s j l = (* guess encoding with max. 3 bytes. *)
(* assert (0 <= j && 0 <= l && j + l <= String.length s) *)
let some i = if i < l then Some (unsafe_byte s (j + i)) else None in
match (some 0), (some 1), (some 2) with
| Some 0xEF, Some 0xBB, Some 0xBF -> `UTF_8 `BOM
| Some 0xFE, Some 0xFF, _ -> `UTF_16BE `BOM
| Some 0xFF, Some 0xFE, _ -> `UTF_16LE `BOM
| Some 0x00, Some p, _ when p > 0 -> `UTF_16BE (`ASCII p)
| Some p, Some 0x00, _ when p > 0 -> `UTF_16LE (`ASCII p)
| Some u, _, _ when utf_8_len.(u) <> 0 -> `UTF_8 `Decode
| Some _, Some _, _ -> `UTF_16BE `Decode
| Some _, None , None -> `UTF_8 `Decode
| None , None , None -> `UTF_8 `End
| None , Some _, _ -> assert false
| Some _, None , Some _ -> assert false
| None , None , Some _ -> assert false
(* Decode *)
type src = [ `Channel of in_channel | `String of string | `Manual ]
type nln = [ `ASCII of Uchar.t | `NLF of Uchar.t | `Readline of Uchar.t ]
type decode = [ `Await | `End | `Malformed of string | `Uchar of Uchar.t]
let pp_decode ppf = function
| `Uchar u -> pp ppf "@[`Uchar U+%04X@]" (Uchar.to_int u)
| `End -> pp ppf "`End"
| `Await -> pp ppf "`Await"
| `Malformed bs ->
let l = String.length bs in
pp ppf "@[`Malformed (";
if l > 0 then pp ppf "%02X" (Char.code (bs.[0]));
for i = 1 to l - 1 do pp ppf " %02X" (Char.code (bs.[i])) done;
pp ppf ")@]"
type decoder =
{ src : src; (* input source. *)
mutable encoding : decoder_encoding; (* decoded encoding. *)
nln : nln option; (* newline normalization (if any). *)
nl : Uchar.t; (* newline normalization character. *)
mutable i : Bytes.t; (* current input chunk. *)
mutable i_pos : int; (* input current position. *)
mutable i_max : int; (* input maximal position. *)
t : Bytes.t; (* four bytes temporary buffer for overlapping reads. *)
mutable t_len : int; (* current byte length of [t]. *)
mutable t_need : int; (* number of bytes needed in [t]. *)
mutable removed_bom : bool; (* [true] if an initial BOM was removed. *)
mutable last_cr : bool; (* [true] if last char was CR. *)
mutable line : int; (* line number. *)
mutable col : int; (* column number. *)
mutable byte_count : int; (* byte count. *)
mutable count : int; (* char count. *)
mutable pp : (* decoder post-processor for BOM, position and nln. *)
decoder -> [ `Malformed of string | `Uchar of Uchar.t ] -> decode;
mutable k : decoder -> decode } (* decoder continuation. *)
(* On decodes that overlap two (or more) [d.i] buffers, we use [t_fill] to copy
the input data to [d.t] and decode from there. If the [d.i] buffers are not
too small this is faster than continuation based byte per byte writes.
End of input (eoi) is signalled by [d.i_pos = 0] and [d.i_max = min_int]
which implies that [i_rem d < 0] is [true]. *)
let i_rem d = d.i_max - d.i_pos + 1 (* remaining bytes to read in [d.i]. *)
let eoi d =
d.i <- Bytes.empty; d.i_pos <- 0; d.i_max <- min_int (* set eoi in [d]. *)
let src d s j l = (* set [d.i] with [s]. *)
if (j < 0 || l < 0 || j + l > Bytes.length s) then invalid_bounds j l else
if (l = 0) then eoi d else
(d.i <- s; d.i_pos <- j; d.i_max <- j + l - 1)
let refill k d = match d.src with (* get new input in [d.i] and [k]ontinue. *)
| `Manual -> d.k <- k; `Await
| `String _ -> eoi d; k d
| `Channel ic ->
let rc = input ic d.i 0 (Bytes.length d.i) in
(src d d.i 0 rc; k d)
let t_need d need = d.t_len <- 0; d.t_need <- need
let rec t_fill k d = (* get [d.t_need] bytes (or less if eoi) in [i.t]. *)
let blit d l =
unsafe_blit d.i d.i_pos d.t d.t_len (* write pos. *) l;
d.i_pos <- d.i_pos + l; d.t_len <- d.t_len + l;
in
let rem = i_rem d in
if rem < 0 (* eoi *) then k d else
let need = d.t_need - d.t_len in
if rem < need then (blit d rem; refill (t_fill k) d) else (blit d need; k d)
let ret k v byte_count d = (* return post-processed [v]. *)
d.k <- k; d.byte_count <- d.byte_count + byte_count; d.pp d v
(* Decoders. *)
let rec decode_us_ascii d =
let rem = i_rem d in
if rem <= 0 then (if rem < 0 then `End else refill decode_us_ascii d) else
let j = d.i_pos in
d.i_pos <- d.i_pos + 1; ret decode_us_ascii (r_us_ascii d.i j) 1 d
let rec decode_iso_8859_1 d =
let rem = i_rem d in
if rem <= 0 then (if rem < 0 then `End else refill decode_iso_8859_1 d) else
let j = d.i_pos in
d.i_pos <- d.i_pos + 1; ret decode_iso_8859_1 (r_iso_8859_1 d.i j) 1 d
(* UTF-8 decoder *)
let rec t_decode_utf_8 d = (* decode from [d.t]. *)
if d.t_len < d.t_need
then ret decode_utf_8 (malformed d.t 0 d.t_len) d.t_len d
else ret decode_utf_8 (r_utf_8 d.t 0 d.t_len) d.t_len d
and decode_utf_8 d =
let rem = i_rem d in
if rem <= 0 then (if rem < 0 then `End else refill decode_utf_8 d) else
let need = unsafe_array_get utf_8_len (unsafe_byte d.i d.i_pos) in
if rem < need then (t_need d need; t_fill t_decode_utf_8 d) else
let j = d.i_pos in
if need = 0
then (d.i_pos <- d.i_pos + 1; ret decode_utf_8 (malformed d.i j 1) 1 d)
else (d.i_pos <- d.i_pos + need; ret decode_utf_8 (r_utf_8 d.i j need) need d)
(* UTF-16BE decoder *)
let rec t_decode_utf_16be_lo hi d = (* decode from [d.t]. *)
let bcount = d.t_len + 2 (* hi count *) in
if d.t_len < d.t_need
then ret decode_utf_16be (malformed_pair true hi d.t 0 d.t_len) bcount d
else ret decode_utf_16be (r_utf_16_lo hi d.t 0 1) bcount d
and t_decode_utf_16be d = (* decode from [d.t]. *)
if d.t_len < d.t_need
then ret decode_utf_16be (malformed d.t 0 d.t_len) d.t_len d
else decode_utf_16be_lo (r_utf_16 d.t 0 1) d
and decode_utf_16be_lo v d = match v with
| `Uchar _ | `Malformed _ as v -> ret decode_utf_16be v 2 d
| `Hi hi ->
let rem = i_rem d in
if rem < 2 then (t_need d 2; t_fill (t_decode_utf_16be_lo hi) d) else
let j = d.i_pos in
d.i_pos <- d.i_pos + 2;
ret decode_utf_16be (r_utf_16_lo hi d.i j (j + 1)) 4 d
and decode_utf_16be d =
let rem = i_rem d in
if rem <= 0 then (if rem < 0 then `End else refill decode_utf_16be d) else
if rem < 2 then (t_need d 2; t_fill t_decode_utf_16be d) else
let j = d.i_pos in
d.i_pos <- d.i_pos + 2; decode_utf_16be_lo (r_utf_16 d.i j (j + 1)) d
(* UTF-16LE decoder, same as UTF-16BE with byte swapped. *)
let rec t_decode_utf_16le_lo hi d = (* decode from [d.t]. *)
let bcount = d.t_len + 2 (* hi count *) in
if d.t_len < d.t_need
then ret decode_utf_16le (malformed_pair false hi d.t 0 d.t_len) bcount d
else ret decode_utf_16le (r_utf_16_lo hi d.t 1 0) bcount d
and t_decode_utf_16le d = (* decode from [d.t]. *)
if d.t_len < d.t_need
then ret decode_utf_16le (malformed d.t 0 d.t_len) d.t_len d
else decode_utf_16le_lo (r_utf_16 d.t 1 0) d
and decode_utf_16le_lo v d = match v with
| `Uchar _ | `Malformed _ as v -> ret decode_utf_16le v 2 d
| `Hi hi ->
let rem = i_rem d in
if rem < 2 then (t_need d 2; t_fill (t_decode_utf_16le_lo hi) d) else
let j = d.i_pos in
d.i_pos <- d.i_pos + 2;
ret decode_utf_16le (r_utf_16_lo hi d.i (j + 1) j) 4 d
and decode_utf_16le d =
let rem = i_rem d in
if rem <= 0 then (if rem < 0 then `End else refill decode_utf_16le d) else
if rem < 2 then (t_need d 2; t_fill t_decode_utf_16le d) else
let j = d.i_pos in
d.i_pos <- d.i_pos + 2; decode_utf_16le_lo (r_utf_16 d.i (j + 1) j) d
(* Encoding guessing. The guess is simple but starting the decoder
after is tedious, uutf's decoders are not designed to put bytes
back in the stream. *)
let guessed_utf_8 d = (* start decoder after `UTF_8 guess. *)
let b3 d = (* handles the third read byte. *)
let b3 = unsafe_byte d.t 2 in
match utf_8_len.(b3) with
| 0 -> ret decode_utf_8 (malformed d.t 2 1) 1 d
| n ->
d.t_need <- n; d.t_len <- 1; unsafe_set_byte d.t 0 b3;
t_fill t_decode_utf_8 d
in
let b2 d = (* handle second read byte. *)
let b2 = unsafe_byte d.t 1 in
let b3 = if d.t_len > 2 then b3 else decode_utf_8 (* decodes `End *) in
match utf_8_len.(b2) with
| 0 -> ret b3 (malformed d.t 1 1) 1 d
| 1 -> ret b3 (r_utf_8 d.t 1 1) 1 d
| n -> (* copy d.t.(1-2) to d.t.(0-1) and decode *)
d.t_need <- n;
unsafe_set_byte d.t 0 b2;
if (d.t_len < 3) then d.t_len <- 1 else
(d.t_len <- 2; unsafe_set_byte d.t 1 (unsafe_byte d.t 2); );
t_fill t_decode_utf_8 d
in
let b1 = unsafe_byte d.t 0 in (* handle first read byte. *)
let b2 = if d.t_len > 1 then b2 else decode_utf_8 (* decodes `End *) in
match utf_8_len.(b1) with
| 0 -> ret b2 (malformed d.t 0 1) 1 d
| 1 -> ret b2 (r_utf_8 d.t 0 1) 1 d
| 2 ->
if d.t_len < 2 then ret decode_utf_8 (malformed d.t 0 1) 1 d else
if d.t_len < 3 then ret decode_utf_8 (r_utf_8 d.t 0 2) 2 d else
ret b3 (r_utf_8 d.t 0 2) 2 d
| 3 ->
if d.t_len < 3
then ret decode_utf_8 (malformed d.t 0 d.t_len) d.t_len d
else ret decode_utf_8 (r_utf_8 d.t 0 3) 3 d
| 4 ->
if d.t_len < 3
then ret decode_utf_8 (malformed d.t 0 d.t_len) d.t_len d
else (d.t_need <- 4; t_fill t_decode_utf_8 d)
| n -> assert false
let guessed_utf_16 d be v = (* start decoder after `UTF_16{BE,LE} guess. *)
let decode_utf_16, t_decode_utf_16, t_decode_utf_16_lo, j0, j1 =
if be then decode_utf_16be, t_decode_utf_16be, t_decode_utf_16be_lo, 0, 1
else decode_utf_16le, t_decode_utf_16le, t_decode_utf_16le_lo, 1, 0
in
let b3 k d =
if d.t_len < 3 then decode_utf_16 d (* decodes `End *) else
begin (* copy d.t.(2) to d.t.(0) and decode. *)
d.t_need <- 2; d.t_len <- 1;
unsafe_set_byte d.t 0 (unsafe_byte d.t 2);
t_fill k d
end
in
match v with
| `BOM -> ret (b3 t_decode_utf_16) (`Uchar u_bom) 2 d
| `ASCII u -> ret (b3 t_decode_utf_16) (`Uchar (Uchar.unsafe_of_int u)) 2 d
| `Decode ->
match r_utf_16 d.t j0 j1 with
| `Malformed _ | `Uchar _ as v -> ret (b3 t_decode_utf_16) v 2 d
| `Hi hi ->
if d.t_len < 3
then ret decode_utf_16 (malformed_pair be hi Bytes.empty 0 0) d.t_len d
else (b3 (t_decode_utf_16_lo hi)) d
let guess_encoding d = (* guess encoding and start decoder. *)
let setup d = match r_encoding d.t 0 d.t_len with
| `UTF_8 r ->
d.encoding <- `UTF_8; d.k <- decode_utf_8;
begin match r with
| `BOM -> ret decode_utf_8 (`Uchar u_bom) 3 d
| `Decode -> guessed_utf_8 d
| `End -> `End
end
| `UTF_16BE r ->
d.encoding <- `UTF_16BE; d.k <- decode_utf_16be; guessed_utf_16 d true r
| `UTF_16LE r ->
d.encoding <- `UTF_16LE; d.k <- decode_utf_16le; guessed_utf_16 d false r
in
(t_need d 3; t_fill setup d)
(* Character post-processors. Used for BOM handling, newline
normalization and position tracking. The [pp_remove_bom] is only
used for the first character to remove a possible initial BOM and
handle UTF-16 endianness recognition. *)
let nline d = d.col <- 0; d.line <- d.line + 1 (* inlined. *)
let ncol d = d.col <- d.col + 1 (* inlined. *)
let ncount d = d.count <- d.count + 1 (* inlined. *)
let cr d b = d.last_cr <- b (* inlined. *)
let pp_remove_bom utf16 pp d = function(* removes init. BOM, handles UTF-16. *)
| `Malformed _ as v -> d.removed_bom <- false; d.pp <- pp; d.pp d v
| `Uchar u as v ->
match Uchar.to_int u with
| 0xFEFF (* BOM *) ->
if utf16 then (d.encoding <- `UTF_16BE; d.k <- decode_utf_16be);
d.removed_bom <- true; d.pp <- pp; d.k d
| 0xFFFE (* BOM reversed from decode_utf_16be *) when utf16 ->
d.encoding <- `UTF_16LE; d.k <- decode_utf_16le;
d.removed_bom <- true; d.pp <- pp; d.k d
| _ ->
d.removed_bom <- false; d.pp <- pp; d.pp d v
let pp_nln_none d = function
| `Malformed _ as v -> cr d false; ncount d; ncol d; v
| `Uchar u as v ->
match Uchar.to_int u with
| 0x000A (* LF *) ->
let last_cr = d.last_cr in
cr d false; ncount d; if last_cr then v else (nline d; v)
| 0x000D (* CR *) -> cr d true; ncount d; nline d; v
| (0x0085 | 0x000C | 0x2028 | 0x2029) (* NEL | FF | LS | PS *) ->
cr d false; ncount d; nline d; v
| _ ->
cr d false; ncount d; ncol d; v
let pp_nln_readline d = function
| `Malformed _ as v -> cr d false; ncount d; ncol d; v
| `Uchar u as v ->
match Uchar.to_int u with
| 0x000A (* LF *) ->
let last_cr = d.last_cr in
cr d false; if last_cr then d.k d else (ncount d; nline d; `Uchar d.nl)
| 0x000D (* CR *) -> cr d true; ncount d; nline d; `Uchar d.nl
| (0x0085 | 0x000C | 0x2028 | 0x2029) (* NEL | FF | LS | PS *) ->
cr d false; ncount d; nline d; `Uchar d.nl
| _ ->
cr d false; ncount d; ncol d; v
let pp_nln_nlf d = function
| `Malformed _ as v -> cr d false; ncount d; ncol d; v
| `Uchar u as v ->
match Uchar.to_int u with
| 0x000A (* LF *) ->
let last_cr = d.last_cr in
cr d false; if last_cr then d.k d else (ncount d; nline d; `Uchar d.nl)
| 0x000D (* CR *) -> cr d true; ncount d; nline d; `Uchar d.nl
| 0x0085 (* NEL *) -> cr d false; ncount d; nline d; `Uchar d.nl
| (0x000C | 0x2028 | 0x2029) (* FF | LS | PS *) ->
cr d false; ncount d; nline d; v
| _ ->
cr d false; ncount d; ncol d; v
let pp_nln_ascii d = function
| `Malformed _ as v -> cr d false; ncount d; ncol d; v
| `Uchar u as v ->
match Uchar.to_int u with
| 0x000A (* LF *) ->
let last_cr = d.last_cr in
cr d false; if last_cr then d.k d else (ncount d; nline d; `Uchar d.nl)
| 0x000D (* CR *) -> cr d true; ncount d; nline d; `Uchar d.nl
| (0x0085 | 0x000C | 0x2028 | 0x2029) (* NEL | FF | LS | PS *) ->
cr d false; ncount d; nline d; v
| _ ->
cr d false; ncount d; ncol d; v
let decode_fun = function
| `UTF_8 -> decode_utf_8
| `UTF_16 -> decode_utf_16be (* see [pp_remove_bom]. *)
| `UTF_16BE -> decode_utf_16be
| `UTF_16LE -> decode_utf_16le
| `US_ASCII -> decode_us_ascii
| `ISO_8859_1 -> decode_iso_8859_1
let decoder ?nln ?encoding src =
let pp, nl = match nln with
| None -> pp_nln_none, Uchar.unsafe_of_int 0x000A (* not used. *)
| Some (`ASCII nl) -> pp_nln_ascii, nl
| Some (`NLF nl) -> pp_nln_nlf, nl
| Some (`Readline nl) -> pp_nln_readline, nl
in
let encoding, k = match encoding with
| None -> `UTF_8, guess_encoding
| Some e -> (e :> decoder_encoding), decode_fun e
in
let i, i_pos, i_max = match src with
| `Manual -> Bytes.empty, 1, 0 (* implies src_rem d = 0. *)
| `Channel _ -> Bytes.create io_buffer_size, 1, 0 (* idem. *)
| `String s -> Bytes.unsafe_of_string s, 0, String.length s - 1
in
{ src = (src :> src); encoding; nln = (nln :> nln option); nl;
i; i_pos; i_max; t = Bytes.create 4; t_len = 0; t_need = 0;
removed_bom = false; last_cr = false; line = 1; col = 0;
byte_count = 0; count = 0;
pp = pp_remove_bom (encoding = `UTF_16) pp; k }
let decode d = d.k d
let decoder_line d = d.line
let decoder_col d = d.col
let decoder_byte_count d = d.byte_count
let decoder_count d = d.count
let decoder_removed_bom d = d.removed_bom
let decoder_src d = d.src
let decoder_nln d = d.nln
let decoder_encoding d = d.encoding
let set_decoder_encoding d e =
d.encoding <- (e :> decoder_encoding); d.k <- decode_fun e
(* Encode *)
type dst = [ `Channel of out_channel | `Buffer of Buffer.t | `Manual ]
type encode = [ `Await | `End | `Uchar of Uchar.t ]
type encoder =
{ dst : dst; (* output destination. *)
encoding : encoding; (* encoded encoding. *)
mutable o : Bytes.t; (* current output chunk. *)
mutable o_pos : int; (* next output position to write. *)
mutable o_max : int; (* maximal output position to write. *)
t : Bytes.t; (* four bytes buffer for overlapping writes. *)
mutable t_pos : int; (* next position to read in [t]. *)
mutable t_max : int; (* maximal position to read in [t]. *)
mutable k : (* encoder continuation. *)
encoder -> encode -> [ `Ok | `Partial ] }
(* On encodes that overlap two (or more) [e.o] buffers, we encode the
character to the temporary buffer [o.t] and continue with
[tmp_flush] to write this data on the different [e.o] buffers. If
the [e.o] buffers are not too small this is faster than
continuation based byte per byte writes. *)
let o_rem e = e.o_max - e.o_pos + 1 (* remaining bytes to write in [e.o]. *)
let dst e s j l = (* set [e.o] with [s]. *)
if (j < 0 || l < 0 || j + l > Bytes.length s) then invalid_bounds j l;
e.o <- s; e.o_pos <- j; e.o_max <- j + l - 1
let partial k e = function `Await -> k e | `Uchar _ | `End -> invalid_encode ()
let flush k e = match e.dst with(* get free storage in [d.o] and [k]ontinue. *)
| `Manual -> e.k <- partial k; `Partial
| `Channel oc -> output oc e.o 0 e.o_pos; e.o_pos <- 0; k e
| `Buffer b ->
let o = Bytes.unsafe_to_string e.o in
Buffer.add_substring b o 0 e.o_pos; e.o_pos <- 0; k e
let t_range e max = e.t_pos <- 0; e.t_max <- max
let rec t_flush k e = (* flush [d.t] up to [d.t_max] in [d.i]. *)
let blit e l =
unsafe_blit e.t e.t_pos e.o e.o_pos l;
e.o_pos <- e.o_pos + l; e.t_pos <- e.t_pos + l
in
let rem = o_rem e in
let len = e.t_max - e.t_pos + 1 in
if rem < len then (blit e rem; flush (t_flush k) e) else (blit e len; k e)
(* Encoders. *)
let rec encode_utf_8 e v =
let k e = e.k <- encode_utf_8; `Ok in
match v with
| `Await -> k e
| `End -> flush k e
| `Uchar u as v ->
let u = Uchar.to_int u in
let rem = o_rem e in
if u <= 0x007F then
if rem < 1 then flush (fun e -> encode_utf_8 e v) e else
(unsafe_set_byte e.o e.o_pos u; e.o_pos <- e.o_pos + 1; k e)
else if u <= 0x07FF then
begin
let s, j, k =
if rem < 2 then (t_range e 1; e.t, 0, t_flush k) else
let j = e.o_pos in (e.o_pos <- e.o_pos + 2; e.o, j, k)
in
unsafe_set_byte s j (0xC0 lor (u lsr 6));
unsafe_set_byte s (j + 1) (0x80 lor (u land 0x3F));
k e
end
else if u <= 0xFFFF then
begin
let s, j, k =
if rem < 3 then (t_range e 2; e.t, 0, t_flush k) else
let j = e.o_pos in (e.o_pos <- e.o_pos + 3; e.o, j, k)
in
unsafe_set_byte s j (0xE0 lor (u lsr 12));
unsafe_set_byte s (j + 1) (0x80 lor ((u lsr 6) land 0x3F));
unsafe_set_byte s (j + 2) (0x80 lor (u land 0x3F));
k e
end
else
begin
let s, j, k =
if rem < 4 then (t_range e 3; e.t, 0, t_flush k) else
let j = e.o_pos in (e.o_pos <- e.o_pos + 4; e.o, j, k)
in
unsafe_set_byte s j (0xF0 lor (u lsr 18));
unsafe_set_byte s (j + 1) (0x80 lor ((u lsr 12) land 0x3F));
unsafe_set_byte s (j + 2) (0x80 lor ((u lsr 6) land 0x3F));
unsafe_set_byte s (j + 3) (0x80 lor (u land 0x3F));
k e
end
let rec encode_utf_16be e v =
let k e = e.k <- encode_utf_16be; `Ok in
match v with
| `Await -> k e
| `End -> flush k e
| `Uchar u ->
let u = Uchar.to_int u in
let rem = o_rem e in
if u < 0x10000 then
begin
let s, j, k =
if rem < 2 then (t_range e 1; e.t, 0, t_flush k) else
let j = e.o_pos in (e.o_pos <- e.o_pos + 2; e.o, j, k)
in
unsafe_set_byte s j (u lsr 8);
unsafe_set_byte s (j + 1) (u land 0xFF);
k e
end else begin
let s, j, k =
if rem < 4 then (t_range e 3; e.t, 0, t_flush k) else
let j = e.o_pos in (e.o_pos <- e.o_pos + 4; e.o, j, k)
in
let u' = u - 0x10000 in
let hi = (0xD800 lor (u' lsr 10)) in
let lo = (0xDC00 lor (u' land 0x3FF)) in
unsafe_set_byte s j (hi lsr 8);
unsafe_set_byte s (j + 1) (hi land 0xFF);
unsafe_set_byte s (j + 2) (lo lsr 8);
unsafe_set_byte s (j + 3) (lo land 0xFF);
k e
end
let rec encode_utf_16le e v = (* encode_uft_16be with bytes swapped. *)
let k e = e.k <- encode_utf_16le; `Ok in
match v with
| `Await -> k e
| `End -> flush k e
| `Uchar u ->
let u = Uchar.to_int u in
let rem = o_rem e in
if u < 0x10000 then
begin
let s, j, k =
if rem < 2 then (t_range e 1; e.t, 0, t_flush k) else
let j = e.o_pos in (e.o_pos <- e.o_pos + 2; e.o, j, k)
in
unsafe_set_byte s j (u land 0xFF);
unsafe_set_byte s (j + 1) (u lsr 8);
k e
end
else
begin
let s, j, k =
if rem < 4 then (t_range e 3; e.t, 0, t_flush k) else
let j = e.o_pos in (e.o_pos <- e.o_pos + 4; e.o, j, k)
in
let u' = u - 0x10000 in
let hi = (0xD800 lor (u' lsr 10)) in
let lo = (0xDC00 lor (u' land 0x3FF)) in
unsafe_set_byte s j (hi land 0xFF);
unsafe_set_byte s (j + 1) (hi lsr 8);
unsafe_set_byte s (j + 2) (lo land 0xFF);
unsafe_set_byte s (j + 3) (lo lsr 8);
k e
end
let encode_fun = function
| `UTF_8 -> encode_utf_8
| `UTF_16 -> encode_utf_16be
| `UTF_16BE -> encode_utf_16be
| `UTF_16LE -> encode_utf_16le
let encoder encoding dst =
let o, o_pos, o_max = match dst with
| `Manual -> Bytes.empty, 1, 0 (* implies o_rem e = 0. *)
| `Buffer _
| `Channel _ -> Bytes.create io_buffer_size, 0, io_buffer_size - 1
in
{ dst = (dst :> dst); encoding = (encoding :> encoding); o; o_pos; o_max;
t = Bytes.create 4; t_pos = 1; t_max = 0; k = encode_fun encoding}
let encode e v = e.k e (v :> encode)
let encoder_encoding e = e.encoding
let encoder_dst e = e.dst
(* Manual sources and destinations. *)
module Manual = struct
let src = src
let dst = dst
let dst_rem = o_rem
end
(* Strings folders and Buffer encoders *)
module String = struct
let encoding_guess s =
let s = Bytes.unsafe_of_string s in
match r_encoding s 0 (max (Bytes.length s) 3) with
| `UTF_8 d -> `UTF_8, (d = `BOM)
| `UTF_16BE d -> `UTF_16BE, (d = `BOM)
| `UTF_16LE d -> `UTF_16LE, (d = `BOM)
type 'a folder =
'a -> int -> [ `Uchar of Uchar.t | `Malformed of string ] -> 'a
let fold_utf_8 ?(pos = 0) ?len f acc s =
let rec loop acc f s i last =
if i > last then acc else
let need = unsafe_array_get utf_8_len (unsafe_byte s i) in
if need = 0 then loop (f acc i (malformed s i 1)) f s (i + 1) last else
let rem = last - i + 1 in
if rem < need then f acc i (malformed s i rem) else
loop (f acc i (r_utf_8 s i need)) f s (i + need) last
in
let len = match len with None -> String.length s - pos | Some l -> l in
let last = pos + len - 1 in
loop acc f (Bytes.unsafe_of_string s) pos last
let fold_utf_16be ?(pos = 0) ?len f acc s =
let rec loop acc f s i last =
if i > last then acc else
let rem = last - i + 1 in
if rem < 2 then f acc i (malformed s i 1) else
match r_utf_16 s i (i + 1) with
| `Uchar _ | `Malformed _ as v -> loop (f acc i v) f s (i + 2) last
| `Hi hi ->
if rem < 4 then f acc i (malformed s i rem) else
loop (f acc i (r_utf_16_lo hi s (i + 2) (i + 3))) f s (i + 4) last
in
let len = match len with None -> String.length s - pos | Some l -> l in
let last = pos + len - 1 in
loop acc f (Bytes.unsafe_of_string s) pos last
let fold_utf_16le ?(pos = 0) ?len f acc s =
(* [fold_utf_16be], bytes swapped. *)
let rec loop acc f s i last =
if i > last then acc else
let rem = last - i + 1 in
if rem < 2 then f acc i (malformed s i 1) else
match r_utf_16 s (i + 1) i with
| `Uchar _ | `Malformed _ as v -> loop (f acc i v) f s (i + 2) last
| `Hi hi ->
if rem < 4 then f acc i (malformed s i rem) else
loop (f acc i (r_utf_16_lo hi s (i + 3) (i + 2))) f s (i + 4) last
in
let len = match len with None -> String.length s - pos | Some l -> l in
let last = pos + len - 1 in
loop acc f (Bytes.unsafe_of_string s) pos last
end
module Buffer = struct
let add_utf_8 b u =
let u = Uchar.to_int u in
let w byte = Buffer.add_char b (unsafe_chr byte) in (* inlined. *)
if u <= 0x007F then
(w u)
else if u <= 0x07FF then
(w (0xC0 lor (u lsr 6));
w (0x80 lor (u land 0x3F)))
else if u <= 0xFFFF then
(w (0xE0 lor (u lsr 12));
w (0x80 lor ((u lsr 6) land 0x3F));
w (0x80 lor (u land 0x3F)))
else
(w (0xF0 lor (u lsr 18));
w (0x80 lor ((u lsr 12) land 0x3F));
w (0x80 lor ((u lsr 6) land 0x3F));
w (0x80 lor (u land 0x3F)))
let add_utf_16be b u =
let u = Uchar.to_int u in
let w byte = Buffer.add_char b (unsafe_chr byte) in (* inlined. *)
if u < 0x10000 then (w (u lsr 8); w (u land 0xFF)) else
let u' = u - 0x10000 in
let hi = (0xD800 lor (u' lsr 10)) in
let lo = (0xDC00 lor (u' land 0x3FF)) in
w (hi lsr 8); w (hi land 0xFF);
w (lo lsr 8); w (lo land 0xFF)
let add_utf_16le b u = (* swapped add_utf_16be. *)
let u = Uchar.to_int u in
let w byte = Buffer.add_char b (unsafe_chr byte) in (* inlined. *)
if u < 0x10000 then (w (u land 0xFF); w (u lsr 8)) else
let u' = u - 0x10000 in
let hi = (0xD800 lor (u' lsr 10)) in
let lo = (0xDC00 lor (u' land 0x3FF)) in
w (hi land 0xFF); w (hi lsr 8);
w (lo land 0xFF); w (lo lsr 8)
end
(*---------------------------------------------------------------------------
Copyright (c) 2012 The uutf 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.
---------------------------------------------------------------------------*)

510
unikernel/duniverse/dune_/vendor/uutf/uutf.mli vendored Normal file
View file

@ -0,0 +1,510 @@
(*---------------------------------------------------------------------------
Copyright (c) 2012 The uutf programmers. All rights reserved.
Distributed under the ISC license, see terms at the end of the file.
---------------------------------------------------------------------------*)
(** Non-blocking streaming Unicode codec.
[Uutf] is a non-blocking streaming codec to {{:#decode}decode} and
{{:#encode}encode} the {{:http://www.ietf.org/rfc/rfc3629.txt}
UTF-8}, {{:http://www.ietf.org/rfc/rfc2781.txt} UTF-16}, UTF-16LE
and UTF-16BE encoding schemes. It can efficiently work character by
character without blocking on IO. Decoders perform
character position tracking and support {{!nln}newline normalization}.
Functions are also provided to {{!String} fold over} the characters
of UTF encoded OCaml string values and to {{!Buffer}directly encode}
characters in OCaml {!Stdlib.Buffer.t} values. {b Note} that since OCaml
4.14, that functionality can be found in {!Stdlib.String} and
{!Stdlib.Buffer} and you are encouraged to migrate to it.
See {{:#examples}examples} of use.
{b References}
{ul
{- The Unicode Consortium.
{e {{:http://www.unicode.org/versions/latest}The Unicode Standard}}.
(latest version)}}
*)
(** {1:ucharcsts Special Unicode characters} *)
val u_bom : Uchar.t
(** [u_bom] is the {{:http://unicode.org/glossary/#byte_order_mark}byte
order mark} (BOM) character ([U+FEFF]). From OCaml 4.06 on, use
{!Uchar.bom}. *)
val u_rep : Uchar.t
(** [u_rep] is the
{{:http://unicode.org/glossary/#replacement_character}replacement}
character ([U+FFFD]). From OCaml 4.06 on, use
{!Uchar.rep}. *)
(** {1:schemes Unicode encoding schemes} *)
type encoding = [ `UTF_16 | `UTF_16BE | `UTF_16LE | `UTF_8 ]
(** The type for Unicode
{{:http://unicode.org/glossary/#character_encoding_scheme}encoding
schemes}. *)
type decoder_encoding = [ encoding | `US_ASCII | `ISO_8859_1 ]
(** The type for encoding schemes {e decoded} by [Uutf]. Unicode encoding
schemes plus {{:http://tools.ietf.org/html/rfc20}US-ASCII} and
{{:http://www.ecma-international.org/publications/standards/Ecma-094.htm}
ISO/IEC 8859-1} (latin-1). *)
val encoding_of_string : string -> decoder_encoding option
(** [encoding_of_string s] converts a (case insensitive)
{{:http://www.iana.org/assignments/character-sets}IANA character set name}
to an encoding. *)
val encoding_to_string : [< decoder_encoding] -> string
(** [encoding_to_string e] is a
{{:http://www.iana.org/assignments/character-sets}IANA character set name}
for [e]. *)
(** {1:decode Decode} *)
type src = [ `Channel of in_channel | `String of string | `Manual ]
(** The type for input sources. With a [`Manual] source the client
must provide input with {!Manual.src}. *)
type nln = [ `ASCII of Uchar.t | `NLF of Uchar.t | `Readline of Uchar.t ]
(** The type for newline normalizations. The variant argument is the
normalization character.
{ul
{- [`ASCII], normalizes CR ([U+000D]), LF ([U+000A]) and CRLF
(<[U+000D], [U+000A]>).}
{- [`NLF], normalizes the Unicode newline function (NLF). This is
NEL ([U+0085]) and the normalizations of [`ASCII].}
{- [`Readline], normalizes for a Unicode readline function. This is FF
([U+000C]), LS ([U+2028]), PS ([U+2029]), and the normalizations
of [`NLF].}}
Used with an appropriate normalization character the [`NLF] and
[`Readline] normalizations allow to implement all the different
recommendations of Unicode's newline guidelines (section 5.8 in
Unicode 9.0.0). *)
type decoder
(** The type for decoders. *)
val decoder : ?nln:[< nln] -> ?encoding:[< decoder_encoding] -> [< src] ->
decoder
(** [decoder nln encoding src] is a decoder that inputs from [src].
{b Byte order mark.}
{{:http://unicode.org/glossary/#byte_order_mark}Byte order mark}
(BOM) constraints are application dependent and prone to
misunderstandings (see the
{{:http://www.unicode.org/faq/utf_bom.html#BOM}FAQ}). Hence,
[Uutf] decoders have a simple rule: an {e initial BOM is always
removed from the input and not counted in character position
tracking}. The function {!decoder_removed_bom} does however return
[true] if a BOM was removed so that all the information can be
recovered if needed.
For UTF-16BE and UTF-16LE the above rule is a violation of
conformance D96 and D97 of the standard. [Uutf] favors the idea
that if there's a BOM, decoding with [`UTF_16] or the [`UTF_16XX]
corresponding to the BOM should decode the same character sequence
(this is not the case if you stick to the standard). The client
can however regain conformance by consulting the result of
{!decoder_removed_bom} and take appropriate action.
{b Encoding.} [encoding] specifies the decoded encoding
scheme. If [`UTF_16] is used the endianness is determined
according to the standard: from a
{{:http://unicode.org/glossary/#byte_order_mark}BOM}
if there is one, [`UTF_16BE] otherwise.
If [encoding] is unspecified it is guessed. The result of a guess
can only be [`UTF_8], [`UTF_16BE] or [`UTF_16LE]. The heuristic
looks at the first three bytes of input (or less if impossible)
and takes the {e first} matching byte pattern in the table below.
{v
xx = any byte
.. = any byte or no byte (input too small)
pp = positive byte
uu = valid UTF-8 first byte
Bytes | Guess | Rationale
---------+-----------+-----------------------------------------------
EF BB BF | `UTF_8 | UTF-8 BOM
FE FF .. | `UTF_16BE | UTF-16BE BOM
FF FE .. | `UTF_16LE | UTF-16LE BOM
00 pp .. | `UTF_16BE | ASCII UTF-16BE and U+0000 is often forbidden
pp 00 .. | `UTF_16LE | ASCII UTF-16LE and U+0000 is often forbidden
uu .. .. | `UTF_8 | ASCII UTF-8 or valid UTF-8 first byte.
xx xx .. | `UTF_16BE | Not UTF-8 => UTF-16, no BOM => UTF-16BE
.. .. .. | `UTF_8 | Single malformed UTF-8 byte or no input.
v}
This heuristic is compatible both with BOM based
recognitition and
{{:http://tools.ietf.org/html/rfc4627#section-3}JSON-like encoding
recognition} that relies on ASCII being present at the beginning
of the stream. Also, {!decoder_removed_bom} will tell the client
if the guess was BOM based.
{b Newline normalization.} If [nln] is specified, the given
newline normalization is performed, see {!nln}. Otherwise
all newlines are returned as found in the input.
{b Character position.} The line number, column number, byte count
and character count of the last decoded character (including
[`Malformed] ones) are respectively returned by {!decoder_line},
{!decoder_col}, {!decoder_byte_count} and {!decoder_count}. Before
the first call to {!val-decode} the line number is [1] and the column
is [0]. Each {!val-decode} returning [`Uchar] or [`Malformed]
increments the column until a newline. On a newline, the line
number is incremented and the column set to zero. For example the
line is [2] and column [0] after the first newline was
decoded. This can be understood as if {!val-decode} was moving an
insertion point to the right in the data. A {e newline} is
anything normalized by [`Readline], see {!nln}.
[Uutf] assumes that each Unicode scalar value has a column width
of 1. The same assumption may not be made by the display program
(e.g. for [emacs]' compilation mode you need to set
[compilation-error-screen-columns] to [nil]). The problem is in
general difficult to solve without interaction or convention with the
display program's rendering engine. Depending on the context better column
increments can be implemented by using {!Uucp.Break.tty_width_hint} or
{{:http://unicode.org/reports/tr29/#Grapheme_Cluster_Boundaries}
grapheme cluster boundaries} (see {!Uuseg}). *)
val decode : decoder ->
[ `Await | `Uchar of Uchar.t | `End | `Malformed of string]
(** [decode d] is:
{ul
{- [`Await] if [d] has a [`Manual] input source and awaits
for more input. The client must use {!Manual.src} to provide it.}
{- [`Uchar u] if a Unicode scalar value [u] was decoded.}
{- [`End] if the end of input was reached.}
{- [`Malformed bytes] if the [bytes] sequence is malformed according to
the decoded encoding scheme. If you are interested in a best-effort
decoding you can still continue to decode after an error until the
decoder synchronizes again on valid bytes. It may however be a good
idea to signal the malformed characters by adding an {!u_rep}
character to the parsed data, see the {{:#examples}examples}.}}
{b Note.} Repeated invocation always eventually returns [`End], even
in case of errors. *)
val decoder_encoding : decoder -> decoder_encoding
(** [decoder_encoding d] is [d]'s the decoded encoding scheme of [d].
{b Warning.} If the decoder guesses the encoding or uses [`UTF_16],
rely on this value only after the first [`Uchar] was decoded. *)
(**/**)
(* This function is dangerous, it may destroy the current continuation.
But it's needed for things like XML parsers. *)
val set_decoder_encoding : decoder -> [< decoder_encoding] -> unit
(** [set_decoder_encoding d enc] changes the decoded encoding
to [enc] after decoding started.
{b Warning.} Call only after {!val-decode} was called on [d] and that the
last call to it returned something different from [`Await] or data may
be lost. After encoding guess wait for at least three [`Uchar]s. *)
(**/**)
val decoder_line : decoder -> int
(** [decoder_line d] is the line number of the last
decoded (or malformed) character. See {!val-decoder} for details. *)
val decoder_col : decoder -> int
(** [decoder_col d] is the column number of the last decoded
(or malformed) character. See {!val-decoder} for details. *)
val decoder_byte_count : decoder -> int
(** [decoder_byte_count d] is the number of bytes already decoded on
[d] (including malformed ones). This is the last {!val-decode}'s
end byte offset counting from the beginning of the stream. *)
val decoder_count : decoder -> int
(** [decoder_count d] is the number of characters already decoded on [d]
(including malformed ones). See {!val-decoder} for details. *)
val decoder_removed_bom : decoder -> bool
(** [decoder_removed_bom d] is [true] iff an {e initial}
{{:http://unicode.org/glossary/#byte_order_mark}BOM} was
removed from the input stream. See {!val-decoder} for details. *)
val decoder_src : decoder -> src
(** [decoder_src d] is [d]'s input source. *)
val decoder_nln : decoder -> nln option
(** [decoder_nln d] returns [d]'s newline normalization (if any). *)
val pp_decode : Format.formatter ->
[< `Await | `Uchar of Uchar.t | `End | `Malformed of string] -> unit
(** [pp_decode ppf v] prints an unspecified representation of [v] on
[ppf]. *)
(** {1:encode Encode} *)
type dst = [ `Channel of out_channel | `Buffer of Buffer.t | `Manual ]
(** The type for output destinations. With a [`Manual] destination the client
must provide output storage with {!Manual.dst}. *)
type encoder
(** The type for Unicode encoders. *)
val encoder : [< encoding] -> [< dst] -> encoder
(** [encoder encoding dst] is an encoder for [encoding] that outputs
to [dst].
{b Note.} No initial
{{:http://unicode.org/glossary/#byte_order_mark}BOM}
is encoded. If needed, this duty is left to the client. *)
val encode :
encoder -> [<`Await | `End | `Uchar of Uchar.t ] -> [`Ok | `Partial ]
(** [encode e v] is :
{ul
{- [`Partial] iff [e] has a [`Manual] destination and needs more output
storage. The client must use {!Manual.dst} to provide a new buffer
and then call {!val-encode} with [`Await] until [`Ok] is returned.}
{- [`Ok] when the encoder is ready to encode a new [`Uchar] or [`End]}}
For [`Manual] destination, encoding [`End] always returns
[`Partial], the client should continue as usual with [`Await]
until [`Ok] is returned at which point {!Manual.dst_rem} [e] is
guaranteed to be the size of the last provided buffer (i.e. nothing
was written).
{b Raises.} [Invalid_argument] if an [`Uchar] or [`End] is encoded
after a [`Partial] encode. *)
val encoder_encoding : encoder -> encoding
(** [encoder_encoding e] is [e]'s encoding. *)
val encoder_dst : encoder -> dst
(** [encoder_dst e] is [e]'s output destination. *)
(** {1:manual Manual sources and destinations.} *)
(** Manual sources and destinations.
{b Warning.} Use only with [`Manual] decoder and encoders. *)
module Manual : sig
val src : decoder -> Bytes.t -> int -> int -> unit
(** [src d s j l] provides [d] with [l] bytes to read, starting at
[j] in [s]. This byte range is read by calls to {!val-decode} with [d]
until [`Await] is returned. To signal the end of input call the function
with [l = 0]. *)
val dst : encoder -> Bytes.t -> int -> int -> unit
(** [dst e s j l] provides [e] with [l] bytes to write, starting
at [j] in [s]. This byte range is written by calls to
{!val-encode} with [e] until [`Partial] is returned. Use {!dst_rem} to
know the remaining number of non-written free bytes in [s]. *)
val dst_rem : encoder -> int
(** [dst_rem e] is the remaining number of non-written, free bytes
in the last buffer provided with {!Manual.dst}. *)
end
(** {1:strbuf String folders and Buffer encoders} *)
(** Fold over the characters of UTF encoded OCaml [string] values.
{b Note.} Since OCaml 4.14, UTF decoders are available in
{!Stdlib.String}. You are encouraged to migrate to them. *)
module String : sig
(** {1 Encoding guess} *)
val encoding_guess : string -> [ `UTF_8 | `UTF_16BE | `UTF_16LE ] * bool
(** [encoding_guess s] is the encoding guessed for [s] coupled with
[true] iff there's an initial
{{:http://unicode.org/glossary/#byte_order_mark}BOM}. *)
(** {1 String folders}
{b Note.} Initial {{:http://unicode.org/glossary/#byte_order_mark}BOM}s
are also folded over. *)
type 'a folder = 'a -> int -> [ `Uchar of Uchar.t | `Malformed of string ] ->
'a
(** The type for character folders. The integer is the index in the
string where the [`Uchar] or [`Malformed] starts. *)
val fold_utf_8 : ?pos:int -> ?len:int -> 'a folder -> 'a -> string -> 'a
(** [fold_utf_8 f a s ?pos ?len ()] is
[f (] ... [(f (f a pos u]{_0}[) j]{_1}[ u]{_1}[)] ... [)] ... [)
j]{_n}[ u]{_n}
where [u]{_i}, [j]{_i} are characters and their start position
in the UTF-8 encoded substring [s] starting at [pos] and [len]
long. The default value for [pos] is [0] and [len] is
[String.length s - pos]. *)
val fold_utf_16be : ?pos:int -> ?len:int -> 'a folder -> 'a -> string -> 'a
(** [fold_utf_16be f a s ?pos ?len ()] is
[f (] ... [(f (f a pos u]{_0}[) j]{_1}[ u]{_1}[)] ... [)] ... [)
j]{_n}[ u]{_n}
where [u]{_i}, [j]{_i} are characters and their start position
in the UTF-8 encoded substring [s] starting at [pos] and [len]
long. The default value for [pos] is [0] and [len] is
[String.length s - pos]. *)
val fold_utf_16le : ?pos:int -> ?len:int -> 'a folder -> 'a -> string -> 'a
(** [fold_utf_16le f a s ?pos ?len ()] is
[f (] ... [(f (f a pos u]{_0}[) j]{_1}[ u]{_1}[)] ... [)] ... [)
j]{_n}[ u]{_n}
where [u]{_i}, [j]{_i} are characters and their start position
in the UTF-8 encoded substring [s] starting at [pos] and [len]
long. The default value for [pos] is [0] and [len] is
[String.length s - pos]. *)
end
(** UTF encode characters in OCaml {!Buffer.t} values.
{b Note.} Since OCaml 4.06, these encoders are available in
{!Stdlib.Buffer}. You are encouraged to migrate to them. *)
module Buffer : sig
(** {1 Buffer encoders} *)
val add_utf_8 : Buffer.t -> Uchar.t -> unit
(** [add_utf_8 b u] adds the UTF-8 encoding of [u] to [b]. *)
val add_utf_16be : Buffer.t -> Uchar.t -> unit
(** [add_utf_16be b u] adds the UTF-16BE encoding of [u] to [b]. *)
val add_utf_16le : Buffer.t -> Uchar.t -> unit
(** [add_utf_16le b u] adds the UTF-16LE encoding of [u] to [b]. *)
end
(** {1:examples Examples}
{2:readlines Read lines}
The value of [lines src] is the list of lines in [src] as UTF-8
encoded OCaml strings. Line breaks are determined according to the
recommendation R4 for a [readline] function in section 5.8 of
Unicode 9.0.0. If a decoding error occurs we silently replace the
malformed sequence by the replacement character {!u_rep} and continue.
{[let lines ?encoding (src : [`Channel of in_channel | `String of string]) =
let rec loop d buf acc = match Uutf.decode d with
| `Uchar u ->
begin match Uchar.to_int u with
| 0x000A ->
let line = Buffer.contents buf in
Buffer.clear buf; loop d buf (line :: acc)
| _ ->
Uutf.Buffer.add_utf_8 buf u; loop d buf acc
end
| `End -> List.rev (Buffer.contents buf :: acc)
| `Malformed _ -> Uutf.Buffer.add_utf_8 buf Uutf.u_rep; loop d buf acc
| `Await -> assert false
in
let nln = `Readline (Uchar.of_int 0x000A) in
loop (Uutf.decoder ~nln ?encoding src) (Buffer.create 512) []
]}
Using the [`Manual] interface, [lines_fd] does the same but on a Unix file
descriptor.
{[let lines_fd ?encoding (fd : Unix.file_descr) =
let rec loop fd s d buf acc = match Uutf.decode d with
| `Uchar u ->
begin match Uchar.to_int u with
| 0x000A ->
let line = Buffer.contents buf in
Buffer.clear buf; loop fd s d buf (line :: acc)
| _ ->
Uutf.Buffer.add_utf_8 buf u; loop fd s d buf acc
end
| `End -> List.rev (Buffer.contents buf :: acc)
| `Malformed _ -> Uutf.Buffer.add_utf_8 buf Uutf.u_rep; loop fd s d buf acc
| `Await ->
let rec unix_read fd s j l = try Unix.read fd s j l with
| Unix.Unix_error (Unix.EINTR, _, _) -> unix_read fd s j l
in
let rc = unix_read fd s 0 (Bytes.length s) in
Uutf.Manual.src d s 0 rc; loop fd s d buf acc
in
let s = Bytes.create 65536 (* UNIX_BUFFER_SIZE in 4.0.0 *) in
let nln = `Readline (Uchar.of_int 0x000A) in
loop fd s (Uutf.decoder ~nln ?encoding `Manual) (Buffer.create 512) []
]}
{2:recode Recode}
The result of [recode src out_encoding dst] has the characters of
[src] written on [dst] with encoding [out_encoding]. If a
decoding error occurs we silently replace the malformed sequence
by the replacement character {!u_rep} and continue. Note that we
don't add an initial
{{:http://unicode.org/glossary/#byte_order_mark}BOM} to [dst],
recoding will thus loose the initial BOM [src] may have. Whether
this is a problem or not depends on the context.
{[let recode ?nln ?encoding out_encoding
(src : [`Channel of in_channel | `String of string])
(dst : [`Channel of out_channel | `Buffer of Buffer.t])
=
let rec loop d e = match Uutf.decode d with
| `Uchar _ as u -> ignore (Uutf.encode e u); loop d e
| `End -> ignore (Uutf.encode e `End)
| `Malformed _ -> ignore (Uutf.encode e (`Uchar Uutf.u_rep)); loop d e
| `Await -> assert false
in
let d = Uutf.decoder ?nln ?encoding src in
let e = Uutf.encoder out_encoding dst in
loop d e]}
Using the [`Manual] interface, [recode_fd] does the same but between
Unix file descriptors.
{[let recode_fd ?nln ?encoding out_encoding
(fdi : Unix.file_descr)
(fdo : Unix.file_descr)
=
let rec encode fd s e v = match Uutf.encode e v with `Ok -> ()
| `Partial ->
let rec unix_write fd s j l =
let rec write fd s j l = try Unix.single_write fd s j l with
| Unix.Unix_error (Unix.EINTR, _, _) -> write fd s j l
in
let wc = write fd s j l in
if wc < l then unix_write fd s (j + wc) (l - wc) else ()
in
unix_write fd s 0 (Bytes.length s - Uutf.Manual.dst_rem e);
Uutf.Manual.dst e s 0 (Bytes.length s);
encode fd s e `Await
in
let rec loop fdi fdo ds es d e = match Uutf.decode d with
| `Uchar _ as u -> encode fdo es e u; loop fdi fdo ds es d e
| `End -> encode fdo es e `End
| `Malformed _ -> encode fdo es e (`Uchar Uutf.u_rep); loop fdi fdo ds es d e
| `Await ->
let rec unix_read fd s j l = try Unix.read fd s j l with
| Unix.Unix_error (Unix.EINTR, _, _) -> unix_read fd s j l
in
let rc = unix_read fdi ds 0 (Bytes.length ds) in
Uutf.Manual.src d ds 0 rc; loop fdi fdo ds es d e
in
let ds = Bytes.create 65536 (* UNIX_BUFFER_SIZE in 4.0.0 *) in
let es = Bytes.create 65536 (* UNIX_BUFFER_SIZE in 4.0.0 *) in
let d = Uutf.decoder ?nln ?encoding `Manual in
let e = Uutf.encoder out_encoding `Manual in
Uutf.Manual.dst e es 0 (Bytes.length es);
loop fdi fdo ds es d e]}
*)
(*---------------------------------------------------------------------------
Copyright (c) 2012 The uutf 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.
---------------------------------------------------------------------------*)