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

File diff suppressed because it is too large Load diff

View file

@ -0,0 +1,295 @@
(** [Bin] is a small library for encoding and decoding information from a buffer
(like a [bytes] or a [bigstring]). Unlike a {i parser combinator}, [Bin]
cannot decode a stream.
[Bin] can be used to project values coming from a pre-allocated buffer such
as a "framebuffer" (video, ethernet, etc.) or to inject values into it.
[Bin] can be seen as a library for describing (fairly basic) "C-like" types
of values that can be injected/projected into/from a particular memory area:
{[
#define PROPTAG_GET_COMMAND_LINE 0x00050001
#define VALUE_LENGTH_RESPONSE (1 << 31)
struct __attribute__((packed)) cmdline {
uint32_t id;
uint32_t value_len;
uint32_t param_len;
uint8 str[2048];
};
struct __attribute__((packed)) property_tag {
uint32_t id;
uint32_t value_len;
uint32_t param_len;
};
extern char _tags;
char *get_cmdline() {
struct cmdline p;
p.id = PROPTAG_GET_COMMAND_LINE;
p.value_len = len - sizeof(struct property_tag);
p.param_len = 2048 & ~VALUE_LENGTH_RESPONSE;
memcpy(&_tags, &p, sizeof(struct cmdline)); // inject
...
}
]}
[Bin] therefore allows you to describe a representation of a serialized
value in bytes and to associate with it a function that allows you to obtain
an OCaml value such as a record or a variant.
{[
open Bin
type cmdline = {
id: int32
; value_len: int32
; param_len: int32
; cmdline: string
}
let cmdline =
record (fun id value_len param_len -> { id; value_len; param_len })
|+ field neint32 (Fun.const 0x00050001l)
|+ field neint32 (fun t -> t.value_len)
|+ field neint32 (fun t -> t.param_len)
|+ field cstring (fun t -> t.cmdline)
|> sealr
let encode_into tags ?(off = 0) value =
let off = ref off in
Bin.encode_bstr cmdline value tags off (* inject *)
]}
Of course, it's not as fast as what we can do in C, but [Bin] has the
advantage of offering a small DSL that allows us to describe these types and
go directly to OCaml values, which is generally more pleasant to manipulate
with OCaml than to make C stubs. *)
type 'a t
(** {1:primitives Primitives.} *)
val char : char t
(** [char] is a representation of the character type. *)
val uint8 : int t
(** [uint8] is a representation of unsigned 8-bit integers. *)
val int8 : int t
(** [int8] is a representation of 8-bit integers. *)
val beuint16 : int t
(** [beint16] is a representation of big-endian unsigned 16-bit integers. *)
val leuint16 : int t
(** [leint16] is a representation of little-endian unsigned 16-bit integers. *)
val neuint16 : int t
(** [neint16] is a representation of native-endian unsigned 16-bit integers. *)
val beint16 : int t
(** [beint16] is a representation of big-endian 16-bit integers. *)
val leint16 : int t
(** [leint16] is a representation of little-endian 16-bit integers. *)
val neint16 : int t
(** [neint16] is a representation of native-endian 16-bit integers. *)
val beint32 : int32 t
(** [beint32] is a representation of big-endian 32-bit integers. *)
val leint32 : int32 t
(** [leint32] is a representation of little-endian 32-bit integers. *)
val neint32 : int32 t
(** [neint32] is a representation of native-endian 32-bit integers. *)
val beint64 : int64 t
(** [beint64] is a representation of big-endian 64-bit integers. *)
val leint64 : int64 t
(** [leint64] is a representation of little-endian 64-bit integers. *)
val neint64 : int64 t
(** [neint64] is a representation of native-endian 64-bit integers. *)
val varint : int t
val bytes : int -> string t
(** [bytes n] is a representation of a bytes sequence of [n] byte(s). *)
val bstr : int -> Bstr.t t
(** [bstr n] is a representation of a bigstring of [n] byte(s). *)
val cstring : string t
val until : char -> string t
val const : 'a -> 'a t
(** [const v] is [v] without a serialization mechanism. *)
val seq : len:int -> 'a t -> 'a array t
(** [seq ~len v] is a representation of fixed-length arrays of values of type
[v]. *)
val map : 'b t -> ('b -> 'a) -> ('a -> 'b) -> 'a t
(** This combinator allows defining a representative of one type in terms of
another by supplying coercions between them. *)
(* {2:records Records.}
{[
type header =
{ version : int32
; number : int32 }
let _PACK = 0x5041434bl
let header =
record (fun pack version number ->
if pack <> _PACK
then invalid_arg "Invalid PACK file";
{ version; number })
|+ field beint32 (fun _ -> _PACK)
|+ field beint32 (fun t -> t.version)
|+ field beint32 (fun t -> t.number)
|> sealr
]} *)
type ('a, 'b, 'c) open_record
(** The type for representing open records of type ['a] with a constructor of
['b]. ['c] represents the remaining fields to be described using the
{!val:(|+)} operator. An open record initially stisfies ['c = 'b] and can be
{{!val:sealr} sealed} once ['c = 'a]. *)
val record : 'b -> ('a, 'b, 'b) open_record
(** [record f] is an incomplete representation of the record of type ['a] with
constructor [f]. To complete the representation, add fields with {!val:(|+)}
and then seal the record with {!val:sealr}. *)
type ('a, 'b) field
(** The type for fields holding values of type ['b] and belonging to a record of
type ['a]. *)
val field : 'a t -> ('b -> 'a) -> ('b, 'a) field
(** [field n t g] is the representation of the field called [n] of type [t] with
getter [g]. For instance:
{[
type t = { foo: string }
let foo = field cstring (fun t -> t.foo)
]} *)
val ( |+ ) :
('a, 'b, 'c -> 'd) open_record -> ('a, 'c) field -> ('a, 'b, 'd) open_record
(** [r |+ f] is the open record [r] augmented with the field [f]. *)
val sealr : ('a, 'b, 'a) open_record -> 'a t
(** [sealr r] seals the open record [r]. *)
(** {2:variants Variants.}
{[
type t = Foo | Bar of string
let t =
variant (fun foo bar -> function Foo -> foo | Bar s -> bar s)
|~ case0 Foo
|~ case1 cstring (fun x -> Bar x)
|> sealv
]} *)
type ('a, 'b, 'c) open_variant
(** The type for representing open variants of type ['a] with pattern-matching
of type ['b]. ['c] represents the remaining constructors to be described
using the {!val:(|~)} operator. An open variant initially satisfies
['c = 'b] and can be {{!val:sealv} sealed} once ['c = 'a]. *)
val variant : 'b -> ('a, 'b, 'b) open_variant
(** [variant n p] is an incomplete representation of the variant type called [n]
of type ['a] using [p] to deconstruct values. To complete the
representation, add cases with {!val:(|~)} and then seal the variant with
{!val:sealv}. *)
type ('a, 'b) case
(** The type for representing variant cases of type ['a] with patterns of type
['b]. *)
type 'a case_p
(** The type for representing patterns for a variant of type ['a]. *)
val case0 : 'a -> ('a, 'a case_p) case
(** [case0 v] is a representation of a variant constructor [v] with no
arguments. For instance:
{[
type t = Foo
let foo = case0 Foo
]} *)
val case1 : 'b t -> ('b -> 'a) -> ('a, 'b -> 'a case_p) case
(** [case1 n t c] is a representation of a variant constructor [c] with an
argument of type [t]. For instances:
{[
type t = Foo of string
let foo = case1 cstring (fun s -> Foo s)
]} *)
val ( |~ ) :
('a, 'b, 'c -> 'd) open_variant -> ('a, 'c) case -> ('a, 'b, 'd) open_variant
(** [v |~ c] is the open variant [v] augmented with the case [c]. *)
val sealv : ('a, 'b, 'a -> 'a case_p) open_variant -> 'a t
(** [sealv v] seals the open variant [v]. *)
(** {2:decoder Decoder.} *)
val decode_bstr : 'a t -> Bstr.t -> int ref -> 'a
(** [decode_bstr repr] is the binary decoder for values of type [repr]. *)
val decode : 'a t -> string -> int ref -> 'a
(** {2:encoder Encoder.} *)
val encode_bstr : 'a t -> 'a -> Bstr.t -> int ref -> unit
val to_string : 'a t -> 'a -> string
module Size : sig
type -'a size_of
(** The type for size function related to binary encoder/decoder. *)
val size_of : 'a t -> 'a size_of
type 'a t = private
| Static of int
| Dynamic of 'a
| Unknown
(** A value representing information known about the length in bytes of
encodings produced by a particular binary codec:
- [Static n]: all encodings produced by this codec have length [n];
- [Dynamic fn]: the length of binary encodings is dependent on the
specific value, but may be efficiently computed at run-time via
the function [fn];
- [Unknown]: this codec may produce encodings that cannot be
efficiently pre-computed. *)
val of_encoding : 'a size_of -> (Bstr.t -> int -> int) t
val of_value : 'a size_of -> ('a -> int) t
end
val size_of_value : 'a t -> 'a -> int option
(** [size_of_value encoding value] attempts to calculate the number of bytes
needed to encode the given [value] according to the given encoding. *)
val size_of_bstr : ?off:int -> 'a t -> Bstr.t -> int option
(** [size_of_encoding ?off encoding bstr] attempts to calculate the number of
bytes required to decode a value according to the given [encoding] and
according to what can be decoded in the given byte sequence [bstr] (at the
given offset [off], defaults to [0]). *)

View file

@ -0,0 +1,325 @@
/*
* Copyright (c) 2024 Romain Calascibetta <romain.calascibetta@gmail.com>
*
* Permission to use, copy, modify, and 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.
*/
#include <caml/alloc.h>
#include <caml/bigarray.h>
#include <caml/custom.h>
#include <caml/fail.h>
#include <caml/m.h>
#include <caml/memory.h>
#include <caml/mlvalues.h>
#include <string.h>
#ifndef CAML_BA_SUBARRAY
#define CAML_BA_SUBARRAY 0x800
#endif
CAMLextern void caml_enter_blocking_section(void);
CAMLextern void caml_leave_blocking_section(void);
CAMLprim value bstr_bytecode_ptr(value va) {
CAMLparam1(va);
CAMLlocal1(res);
struct caml_ba_array *a = Caml_ba_array_val(va);
void *src_a = a->data;
res = caml_copy_nativeint((intnat)src_a);
CAMLreturn(res);
}
intnat bstr_native_ptr(value va) {
struct caml_ba_array *a = Caml_ba_array_val(va);
return ((intnat)a->data);
}
#define bstr_uint8_off(ba, off) ((uint8_t *)Caml_ba_data_val(ba) + off)
#define bytes_uint8_off(buf, off) ((uint8_t *)Bytes_val(buf) + off)
#define LEAVE_RUNTIME_OP_CUTOFF 4096
#define is_mmaped(ba) ((ba)->flags & CAML_BA_MAPPED_FILE)
void bstr_native_memcpy_mmaped(value src, intnat src_off, value dst,
intnat dst_off, intnat len) {
int leave_runtime = (len > LEAVE_RUNTIME_OP_CUTOFF * sizeof(long));
if (leave_runtime)
caml_enter_blocking_section();
memcpy(bstr_uint8_off(dst, dst_off), bstr_uint8_off(src, src_off), len);
if (leave_runtime)
caml_leave_blocking_section();
}
void bstr_native_memcpy(value src, intnat src_off, value dst, intnat dst_off,
intnat len) {
memcpy(bstr_uint8_off(dst, dst_off), bstr_uint8_off(src, src_off), len);
}
CAMLprim value bstr_bytecode_memcpy(value src, value src_off, value dst,
value dst_off, value len) {
CAMLparam5(src, src_off, dst, dst_off, len);
if (is_mmaped(Caml_ba_array_val(src)) || is_mmaped(Caml_ba_array_val(dst)))
bstr_native_memcpy_mmaped(src, Unsigned_long_val(src_off), dst,
Unsigned_long_val(dst_off),
Unsigned_long_val(len));
else
bstr_native_memcpy(src, Unsigned_long_val(src_off), dst,
Unsigned_long_val(dst_off), Unsigned_long_val(len));
CAMLreturn(Val_unit);
}
CAMLprim value bstr_native_memmove_mmaped(value src, intnat src_off, value dst,
intnat dst_off, intnat len) {
CAMLparam2(src, dst);
int leave_runtime = (len > LEAVE_RUNTIME_OP_CUTOFF * sizeof(long)) ||
is_mmaped(Caml_ba_array_val(src)) ||
is_mmaped(Caml_ba_array_val(dst));
if (leave_runtime)
caml_enter_blocking_section();
memmove(bstr_uint8_off(dst, dst_off), bstr_uint8_off(src, src_off), len);
if (leave_runtime)
caml_leave_blocking_section();
CAMLreturn(Val_unit);
}
CAMLprim value bstr_native_memmove(value src, intnat src_off, value dst,
intnat dst_off, intnat len) {
CAMLparam2(src, dst);
int leave_runtime = (len > LEAVE_RUNTIME_OP_CUTOFF * sizeof(long));
if (leave_runtime)
caml_enter_blocking_section();
memmove(bstr_uint8_off(dst, dst_off), bstr_uint8_off(src, src_off), len);
if (leave_runtime)
caml_leave_blocking_section();
CAMLreturn(Val_unit);
}
CAMLprim value bstr_bytecode_memmove(value src, value src_off, value dst,
value dst_off, value len) {
CAMLparam5(src, src_off, dst, dst_off, len);
if (is_mmaped(Caml_ba_array_val(src)) || is_mmaped(Caml_ba_array_val(dst)))
bstr_native_memmove_mmaped(src, Unsigned_long_val(src_off), dst,
Unsigned_long_val(dst_off),
Unsigned_long_val(len));
else
bstr_native_memmove(src, Unsigned_long_val(src_off), dst,
Unsigned_long_val(dst_off), Unsigned_long_val(len));
CAMLreturn(Val_unit);
}
intnat bstr_native_memcmp(value s1, intnat s1_off, value s2, intnat s2_off,
intnat len) {
intnat res;
res = memcmp(bstr_uint8_off(s1, s1_off), bstr_uint8_off(s2, s2_off), len);
return (res);
}
CAMLprim value bstr_bytecode_memcmp(value s1, value s1_off, value s2,
value s2_off, value len) {
CAMLparam5(s1, s1_off, s2, s2_off, len);
intnat res;
res = bstr_native_memcmp(s1, Unsigned_long_val(s1_off), s2,
Unsigned_long_val(s2_off), Unsigned_long_val(len));
CAMLreturn(Val_long(res));
}
#define __MEM1(name) \
intnat bstr_native_##name(value src, intnat src_off, intnat src_len, \
intnat va) { \
uint8_t *res = name(bstr_uint8_off(src, src_off), va, src_len); \
if (res == NULL) \
return (-1); \
\
return ((intnat)(res - bstr_uint8_off(src, src_off))); \
} \
\
CAMLprim value bstr_bytecode_##name(value src, value src_off, value src_len, \
value va) { \
CAMLparam4(src, src_off, src_len, va); \
intnat res; \
res = \
bstr_native_##name(src, Unsigned_long_val(src_off), \
Unsigned_long_val(src_len), Unsigned_long_val(va)); \
CAMLreturn(Val_long(res)); \
}
__MEM1(memset)
__MEM1(memchr)
void bstr_native_unsafe_blit_from_bytes(value src, intnat src_off, value dst,
intnat dst_off, intnat len) {
memcpy(bstr_uint8_off(dst, dst_off), bytes_uint8_off(src, src_off), len);
}
CAMLprim value bstr_bytecode_unsafe_blit_from_bytes(value src, intnat src_off,
value dst, intnat dst_off,
intnat len) {
CAMLparam5(src, src_off, dst, dst_off, len);
memcpy(bstr_uint8_off(dst, Unsigned_long_val(dst_off)),
bytes_uint8_off(src, Unsigned_long_val(src_off)),
Unsigned_long_val(len));
CAMLreturn(Val_unit);
}
void bstr_native_unsafe_blit_to_bytes(value src, intnat src_off, value dst,
intnat dst_off, intnat len) {
memcpy(bytes_uint8_off(dst, dst_off), bstr_uint8_off(src, src_off), len);
}
CAMLprim value bstr_bytecode_unsafe_blit_to_bytes(value src, intnat src_off,
value dst, intnat dst_off,
intnat len) {
CAMLparam5(src, src_off, dst, dst_off, len);
memcpy(bytes_uint8_off(dst, Unsigned_long_val(dst_off)),
bstr_uint8_off(src, Unsigned_long_val(src_off)),
Unsigned_long_val(len));
CAMLreturn(Val_unit);
}
#include <stdatomic.h>
#define atomic_store_release(p, v) \
atomic_store_explicit((p), (v), memory_order_release)
CAMLextern struct custom_operations caml_ba_ops;
static void caml_ba_update_proxy(struct caml_ba_array *b1,
struct caml_ba_array *b2) {
struct caml_ba_proxy *proxy;
/* Nothing to do for un-managed arrays */
if ((b1->flags & CAML_BA_MANAGED_MASK) == CAML_BA_EXTERNAL)
return;
if (b1->proxy != NULL) {
/* If b1 is already a proxy for a larger array, increment refcount of
proxy */
b2->proxy = b1->proxy;
#if OCAML_VERSION_MAJOR >= 5
(void)atomic_fetch_add(&b1->proxy->refcount, 1);
#else
b1->proxy->refcount += 1;
#endif
} else {
/* Otherwise, create proxy and attach it to both b1 and b2 */
proxy = malloc(sizeof(struct caml_ba_proxy));
if (proxy == NULL)
caml_raise_out_of_memory();
#if OCAML_VERSION_MAJOR >= 5
atomic_store_release(&proxy->refcount, 2);
#else
proxy->refcount = 2;
#endif
/* initial refcount: 2 = original array + sub array */
proxy->data = b1->data;
proxy->size = b1->flags & CAML_BA_MAPPED_FILE ? caml_ba_byte_size(b1) : 0;
b1->proxy = proxy;
b2->proxy = proxy;
}
}
CAMLprim value bstr_native_unsafe_sub(value vbstr, intnat off, intnat len) {
CAMLparam1(vbstr);
CAMLlocal1(res);
char *sub = Caml_ba_array_val(vbstr)->data + off;
res =
caml_alloc_custom_mem(&caml_ba_ops, SIZEOF_BA_ARRAY + sizeof(intnat), 0);
struct caml_ba_array *new;
new = Caml_ba_array_val(res);
new->data = sub;
new->num_dims = 1;
new->flags = Caml_ba_array_val(vbstr)->flags | CAML_BA_SUBARRAY;
new->proxy = NULL;
new->dim[0] = len;
Custom_ops_val(res) = Custom_ops_val(vbstr);
caml_ba_update_proxy(Caml_ba_array_val(vbstr), Caml_ba_array_val(res));
CAMLreturn(res);
}
CAMLprim value bstr_bytecode_unsafe_sub(value vbstr, value voff, value vlen) {
CAMLparam3(vbstr, voff, vlen);
CAMLlocal1(res);
intnat off = Unsigned_long_val(voff);
intnat len = Unsigned_long_val(vlen);
char *sub = Caml_ba_array_val(vbstr)->data + off;
res =
caml_alloc_custom_mem(&caml_ba_ops, SIZEOF_BA_ARRAY + sizeof(intnat), 0);
struct caml_ba_array *new;
new = Caml_ba_array_val(res);
new->data = sub;
new->num_dims = 1;
new->flags = Caml_ba_array_val(vbstr)->flags | CAML_BA_SUBARRAY;
new->proxy = NULL;
new->dim[0] = len;
Custom_ops_val(res) = Custom_ops_val(vbstr);
caml_ba_update_proxy(Caml_ba_array_val(vbstr), Caml_ba_array_val(res));
CAMLreturn(res);
}
/* This function is **only** useful when accessing to a bigstring for an
* architecture requiring alignment **and** for an OCaml executable in
* bytecode. It concerns only 32-bits architectures.
*/
uint64_t bstr_native_get64u(value va, intnat off) {
#ifdef ARCH_ALIGN_INT64
char b0, b1, b2, b3, b4, b5, b6, b7;
#endif
struct caml_ba_array *a = Caml_ba_array_val(va);
void *addr = &((unsigned char *)a->data)[off];
uint64_t res;
#ifdef ARCH_ALIGN_INT64
if (!((size_t)addr) & 0x7)
res = *((uint64_t *)addr);
else {
b0 = ((unsigned char *)a->data)[off];
b1 = ((unsigned char *)a->data)[off + 1];
b2 = ((unsigned char *)a->data)[off + 2];
b3 = ((unsigned char *)a->data)[off + 3];
b4 = ((unsigned char *)a->data)[off + 4];
b5 = ((unsigned char *)a->data)[off + 5];
b6 = ((unsigned char *)a->data)[off + 6];
b7 = ((unsigned char *)a->data)[off + 7];
#ifdef ARCH_BIG_ENDIAN
res = (uint64_t)b0 << 56 | (uint64_t)b1 << 48 | (uint64_t)b2 << 40 |
(uint64_t)b3 << 32 | (uint64_t)b4 << 24 | (uint64_t)b5 << 16 |
(uint64_t)b6 << 8 | (uint64_t)b7;
#else
res = (uint64_t)b7 << 56 | (uint64_t)b6 << 48 | (uint64_t)b5 << 40 |
(uint64_t)b4 << 32 | (uint64_t)b3 << 24 | (uint64_t)b2 << 16 |
(uint64_t)b1 << 8 | (uint64_t)b0;
#endif
}
#else
res = *((uint64_t *)addr);
#endif
return (res);
}
CAMLprim value bstr_bytecode_get64u(value va, value off) {
CAMLparam2(va, off);
CAMLlocal1(res);
uint64_t val = bstr_native_get64u(va, Unsigned_long_val(off));
res = caml_copy_int64(val);
CAMLreturn(res);
}

View file

@ -0,0 +1,787 @@
(*
* Copyright (c) 2024 Romain Calascibetta <romain.calascibetta@gmail.com>
*
* Permission to use, copy, modify, and 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.
*)
type t = (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t
external length : t -> int = "%caml_ba_dim_1"
external ptr : t -> (nativeint[@unboxed])
= "bstr_bytecode_ptr" "bstr_native_ptr"
[@@noalloc]
let overlap a b =
let src_a = ptr a in
let src_b = ptr b in
let len_a = Nativeint.of_int (length a) in
let len_b = Nativeint.of_int (length b) in
let len =
let ( + ) = Nativeint.add in
let ( - ) = Nativeint.sub in
Nativeint.max 0n (Nativeint.min (src_a + len_a) (src_b + len_b))
- Nativeint.max src_a src_b
in
let len = Nativeint.to_int len in
if src_a >= src_b && src_a < Nativeint.add src_b len_b then
let offset = Nativeint.(to_int (sub src_a src_b)) in
Some (len, 0, offset)
else if src_b >= src_a && src_b < Nativeint.add src_a len_a then
let offset = Nativeint.(to_int (sub src_b src_a)) in
Some (len, offset, 0)
else None
external ( < ) : 'a -> 'a -> bool = "%lessthan"
let ( < ) (x : int) y = x < y [@@inline]
external ( <= ) : 'a -> 'a -> bool = "%lessequal"
let ( <= ) (x : int) y = x <= y [@@inline]
external ( > ) : 'a -> 'a -> bool = "%greaterthan"
let ( > ) (x : int) y = x > y [@@inline]
external ( >= ) : 'a -> 'a -> bool = "%greaterequal"
let ( >= ) (x : int) y = x >= y [@@inline]
module Bytes = struct
include Bytes
external _unsafe_get_uint8 : bytes -> int -> int = "%bytes_unsafe_get"
external _unsafe_set_uint8 : bytes -> int -> int -> unit = "%bytes_unsafe_set"
external _unsafe_get_int32_ne : bytes -> int -> int32 = "%caml_bytes_get32u"
external _unsafe_set_int32_ne : bytes -> int -> int32 -> unit
= "%caml_bytes_set32u"
end
external swap16 : int -> int = "%bswap16"
external swap32 : int32 -> int32 = "%bswap_int32"
external swap64 : int64 -> int64 = "%bswap_int64"
external get_uint8 : t -> int -> int = "%caml_ba_ref_1"
external unsafe_get_uint8 : t -> int -> int = "%caml_ba_unsafe_ref_1"
external set_uint8 : t -> int -> int -> unit = "%caml_ba_set_1"
external get_uint16_ne : t -> int -> int = "%caml_bigstring_get16"
external set_int16_ne : t -> int -> int -> unit = "%caml_bigstring_set16"
external get_int32_ne : t -> int -> int32 = "%caml_bigstring_get32"
external set_int32_ne : t -> int -> int32 -> unit = "%caml_bigstring_set32"
external set_int64_ne : t -> int -> int64 -> unit = "%caml_bigstring_set64"
external unsafe_get_uint16_ne : t -> int -> int = "%caml_bigstring_get16u"
external unsafe_set_uint16_ne : t -> int -> int -> unit
= "%caml_bigstring_set16u"
external unsafe_get_int64_ne : t -> (int[@untagged]) -> (int64[@unboxed])
= "bstr_bytecode_get64u" "bstr_native_get64u"
[@@noalloc]
external _unsafe_set_int64_ne : t -> int -> int64 -> unit
= "%caml_bigstring_set64u"
external unsafe_memcmp :
t
-> (int[@untagged])
-> t
-> (int[@untagged])
-> (int[@untagged])
-> (int[@untagged]) = "bstr_bytecode_memcmp" "bstr_native_memcmp"
[@@noalloc]
external unsafe_memcpy :
t -> (int[@untagged]) -> t -> (int[@untagged]) -> (int[@untagged]) -> unit
= "bstr_bytecode_memcpy" "bstr_native_memcpy"
[@@noalloc]
external unsafe_memcpy_mmaped :
t -> (int[@untagged]) -> t -> (int[@untagged]) -> (int[@untagged]) -> unit
= "bstr_bytecode_memcpy" "bstr_native_memcpy_mmaped"
[@@noalloc]
external unsafe_memmove :
t -> (int[@untagged]) -> t -> (int[@untagged]) -> (int[@untagged]) -> unit
= "bstr_bytecode_memmove" "bstr_native_memmove"
[@@noalloc]
external unsafe_memmove_mmaped :
t -> (int[@untagged]) -> t -> (int[@untagged]) -> (int[@untagged]) -> unit
= "bstr_bytecode_memmove" "bstr_native_memmove_mmaped"
[@@noalloc]
external unsafe_memchr :
t
-> (int[@untagged])
-> (int[@untagged])
-> (int[@untagged])
-> (int[@untagged]) = "bstr_bytecode_memchr" "bstr_native_memchr"
[@@noalloc]
external unsafe_memset :
t
-> (int[@untagged])
-> (int[@untagged])
-> (int[@untagged])
-> (int[@untagged]) = "bstr_bytecode_memset" "bstr_native_memset"
[@@noalloc]
let memcmp src ~src_off dst ~dst_off ~len =
if
len < 0
|| src_off < 0
|| src_off > Bigarray.Array1.dim src - len
|| dst_off < 0
|| dst_off > Bigarray.Array1.dim dst - len
then invalid_arg "Bstr.memcmp";
unsafe_memcmp src src_off dst dst_off len
let memcpy src ~src_off dst ~dst_off ~len =
if
len < 0
|| src_off < 0
|| src_off > Bigarray.Array1.dim src - len
|| dst_off < 0
|| dst_off > Bigarray.Array1.dim dst - len
then invalid_arg "Bstr.memcpy";
unsafe_memcpy src src_off dst dst_off len
let memcpy_mmaped src ~src_off dst ~dst_off ~len =
if
len < 0
|| src_off < 0
|| src_off > Bigarray.Array1.dim src - len
|| dst_off < 0
|| dst_off > Bigarray.Array1.dim dst - len
then invalid_arg "Bstr.memcpy";
unsafe_memcpy_mmaped src src_off dst dst_off len
let memmove src ~src_off dst ~dst_off ~len =
if
len < 0
|| src_off < 0
|| src_off > Bigarray.Array1.dim src - len
|| dst_off < 0
|| dst_off > Bigarray.Array1.dim dst - len
then invalid_arg "Bstr.memmove";
unsafe_memmove src src_off dst dst_off len
let memmove_mmaped src ~src_off dst ~dst_off ~len =
if
len < 0
|| src_off < 0
|| src_off > Bigarray.Array1.dim src - len
|| dst_off < 0
|| dst_off > Bigarray.Array1.dim dst - len
then invalid_arg "Bstr.memmove";
unsafe_memmove_mmaped src src_off dst dst_off len
let memchr src ~off ~len value =
if len < 0 || off < 0 || off > Bigarray.Array1.dim src - len then
invalid_arg "Bstr.memchr";
unsafe_memchr src off len (Char.code value)
let memset src ~off ~len value =
if len < 0 || off < 0 || off > Bigarray.Array1.dim src - len then
invalid_arg "Bstr.memset";
ignore (unsafe_memset src off len (Char.code value))
let empty = Bigarray.Array1.create Bigarray.char Bigarray.c_layout 0
let create len = Bigarray.Array1.create Bigarray.char Bigarray.c_layout len
external get : t -> int -> char = "%caml_ba_ref_1"
external unsafe_get : t -> int -> char = "%caml_ba_unsafe_ref_1"
external set : t -> int -> char -> unit = "%caml_ba_set_1"
external unsafe_set : t -> int -> char -> unit = "%caml_ba_unsafe_set_1"
let fill bstr ?(off = 0) ?len chr =
let len = match len with Some len -> len | None -> length bstr - off in
memset bstr ~off ~len chr
let make len chr =
let bstr = create len in
ignore (unsafe_memset bstr 0 len (Char.code chr));
(* [Obj.magic] instead of [Char.code]? *)
bstr
let init len fn =
let bstr = create len in
for i = 0 to len - 1 do
unsafe_set bstr i (fn i)
done;
bstr
let copy src =
let len = length src in
let bstr = create len in
unsafe_memcpy src 0 bstr 0 len;
bstr
let chop ?(rev = false) bstr =
if length bstr == 0 then None
else if not rev then Some (unsafe_get bstr 0)
else Some (unsafe_get bstr (length bstr - 1))
let get_int64_ne bstr idx =
if idx < 0 || idx > length bstr - 8 then invalid_arg "Bstr.get_int64_ne";
unsafe_get_int64_ne bstr idx
let get_int8 bstr i =
(get_uint8 bstr i lsl (Sys.int_size - 8)) asr (Sys.int_size - 8)
let get_uint16_le bstr i =
if Sys.big_endian then swap16 (get_uint16_ne bstr i) else get_uint16_ne bstr i
let get_uint16_be bstr i =
if not Sys.big_endian then swap16 (get_uint16_ne bstr i)
else get_uint16_ne bstr i
let[@coverage off] _unsafe_get_uint16_le bstr i =
(* TODO(dinosaure): for unicode. *)
if Sys.big_endian then swap16 (unsafe_get_uint16_ne bstr i)
else unsafe_get_uint16_ne bstr i
let[@coverage off] _unsafe_get_uint16_be bstr i =
(* TODO(dinosaure): for unicode. *)
if not Sys.big_endian then swap16 (unsafe_get_uint16_ne bstr i)
else unsafe_get_uint16_ne bstr i
let get_int16_ne bstr i =
(get_uint16_ne bstr i lsl (Sys.int_size - 16)) asr (Sys.int_size - 16)
let get_int16_le bstr i =
(get_uint16_le bstr i lsl (Sys.int_size - 16)) asr (Sys.int_size - 16)
let get_int16_be bstr i =
(get_uint16_be bstr i lsl (Sys.int_size - 16)) asr (Sys.int_size - 16)
let get_int32_le bstr i =
if Sys.big_endian then swap32 (get_int32_ne bstr i) else get_int32_ne bstr i
let get_int32_be bstr i =
if not Sys.big_endian then swap32 (get_int32_ne bstr i)
else get_int32_ne bstr i
let get_int64_le bstr i =
if Sys.big_endian then swap64 (get_int64_ne bstr i) else get_int64_ne bstr i
let get_int64_be bstr i =
if not Sys.big_endian then swap64 (get_int64_ne bstr i)
else get_int64_ne bstr i
let[@coverage off] _unsafe_set_uint16_le bstr i x =
(* TODO(dinosaure): for unicode. *)
if Sys.big_endian then unsafe_set_uint16_ne bstr i (swap16 x)
else unsafe_set_uint16_ne bstr i x
let[@coverage off] _unsafe_set_uint16_be bstr i x =
(* TODO(dinosaure): for unicode. *)
if Sys.big_endian then unsafe_set_uint16_ne bstr i x
else unsafe_set_uint16_ne bstr i (swap16 x)
let set_int16_le bstr i x =
if Sys.big_endian then set_int16_ne bstr i (swap16 x)
else set_int16_ne bstr i x
let set_int16_be bstr i x =
if not Sys.big_endian then set_int16_ne bstr i (swap16 x)
else set_int16_ne bstr i x
let set_int32_le bstr i x =
if Sys.big_endian then set_int32_ne bstr i (swap32 x)
else set_int32_ne bstr i x
let set_int32_be bstr i x =
if not Sys.big_endian then set_int32_ne bstr i (swap32 x)
else set_int32_ne bstr i x
let set_int64_le bstr i x =
if Sys.big_endian then set_int64_ne bstr i (swap64 x)
else set_int64_ne bstr i x
let set_int64_be bstr i x =
if not Sys.big_endian then set_int64_ne bstr i (swap64 x)
else set_int64_ne bstr i x
let set_int8 = set_uint8
let set_uint16_ne = set_int16_ne
let set_uint16_be = set_int16_be
let set_uint16_le = set_int16_le
external unsafe_sub : t -> (int[@untagged]) -> (int[@untagged]) -> t
= "bstr_bytecode_unsafe_sub" "bstr_native_unsafe_sub"
let sub bstr ~off ~len =
if off < 0 || len < 0 || off > length bstr - len then invalid_arg "Bstr.sub";
unsafe_sub bstr off len
let[@inline always] unsafe_blit src ~src_off dst ~dst_off ~len =
unsafe_memmove src src_off dst dst_off len
let blit src ~src_off dst ~dst_off ~len =
if
len < 0
|| src_off < 0
|| src_off > length src - len
|| dst_off < 0
|| dst_off > length dst - len
then invalid_arg "Bstr.blit";
unsafe_blit src ~src_off dst ~dst_off ~len
external unsafe_blit_to_bytes :
t
-> src_off:(int[@untagged])
-> bytes
-> dst_off:(int[@untagged])
-> len:(int[@untagged])
-> unit
= "bstr_bytecode_unsafe_blit_to_bytes" "bstr_native_unsafe_blit_to_bytes"
[@@noalloc]
external unsafe_blit_from_bytes :
bytes
-> src_off:(int[@untagged])
-> t
-> dst_off:(int[@untagged])
-> len:(int[@untagged])
-> unit
= "bstr_bytecode_unsafe_blit_from_bytes" "bstr_native_unsafe_blit_from_bytes"
[@@noalloc]
let blit_from_bytes src ~src_off bstr ~dst_off ~len =
if
len < 0
|| src_off < 0
|| src_off > Bytes.length src - len
|| dst_off < 0
|| dst_off > length bstr - len
then invalid_arg "Bstr.blit_from_bytes";
unsafe_blit_from_bytes src ~src_off bstr ~dst_off ~len
let blit_from_string src ~src_off bstr ~dst_off ~len =
blit_from_bytes (Bytes.unsafe_of_string src) ~src_off bstr ~dst_off ~len
let blit_to_bytes bstr ~src_off dst ~dst_off ~len =
if
len < 0
|| src_off < 0
|| src_off > length bstr - len
|| dst_off < 0
|| dst_off > Bytes.length dst - len
then invalid_arg "Bstr.blit_to_bytes";
unsafe_blit_to_bytes bstr ~src_off dst ~dst_off ~len
let of_string str =
let len = String.length str in
let bstr = create len in
unsafe_blit_from_bytes
(Bytes.unsafe_of_string str)
~src_off:0 bstr ~dst_off:0 ~len;
bstr
let string ?(off = 0) ?len str =
let len =
match len with Some len -> len | None -> String.length str - off
in
if off < 0 || len < 0 || off > String.length str - len then
invalid_arg "Bstr.string";
let bstr = create len in
unsafe_blit_from_bytes
(Bytes.unsafe_of_string str)
~src_off:off bstr ~dst_off:0 ~len;
bstr
let unsafe_sub_string bstr src_off len =
let buf = Bytes.create len in
unsafe_blit_to_bytes bstr ~src_off buf ~dst_off:0 ~len;
Bytes.unsafe_to_string buf
let sub_string bstr ~off ~len =
if len < 0 || off < 0 || off > length bstr - len then
invalid_arg "Bstr.sub_string";
unsafe_sub_string bstr off len
let to_string bstr =
if length bstr <= 0 then "" else unsafe_sub_string bstr 0 (length bstr)
let is_empty bstr = length bstr == 0
let is_prefix ~affix bstr =
let len_affix = String.length affix in
let len_bstr = length bstr in
if len_affix > len_bstr then false
else
let max_idx_affix = len_affix - 1 in
let rec go idx =
if idx > max_idx_affix then true
else if String.unsafe_get affix idx != unsafe_get bstr idx then false
else go (idx + 1)
in
go 0
let starts_with ~prefix bstr =
let len_prefix = length prefix in
let len_bstr = length bstr in
if len_prefix > len_bstr then false
else
let max_idx_prefix = len_prefix - 1 in
let rec go idx =
if idx > max_idx_prefix then true
else if unsafe_get prefix idx != unsafe_get bstr idx then false
else go (idx + 1)
in
go 0
let is_infix ~affix bstr =
let len_affix = String.length affix in
let len_bstr = length bstr in
if len_affix > len_bstr then false
else
let max_idx_affix = len_affix - 1 in
let max_idx_bstr = len_bstr - len_affix in
let rec go idx k =
if idx > max_idx_bstr then false
else if k > max_idx_affix then true
else if k > 0 then
if affix.[k] == bstr.{idx + k} then go idx (succ k) else go (succ idx) 0
else if affix.[0] = bstr.{idx} then go idx 1
else go (idx + 1) 0
in
go 0 0
let is_suffix ~affix bstr =
let max_idx_affix = String.length affix - 1 in
let max_idx_bstr = length bstr - 1 in
if max_idx_affix > max_idx_bstr then false
else
let rec go idx =
if idx > max_idx_affix then true
else if affix.[max_idx_affix - idx] != bstr.{max_idx_bstr - idx} then
false
else go (idx + 1)
in
go 0
let ends_with ~suffix bstr =
let max_idx_suffix = length suffix - 1 in
let max_idx_bstr = length bstr - 1 in
if max_idx_suffix > max_idx_bstr then false
else
let rec go idx =
if idx > max_idx_suffix then true
else if
unsafe_get suffix (max_idx_suffix - idx)
!= unsafe_get bstr (max_idx_bstr - idx)
then false
else go (idx + 1)
in
go 0
exception Break
let for_all sat bstr =
try
for idx = 0 to length bstr - 1 do
if sat (unsafe_get bstr idx) == false then raise_notrace Break
done;
true
with Break -> false
let contains bstr ?(off = 0) ?len chr =
let len = match len with Some len -> len | None -> length bstr - off in
memchr bstr ~off ~len chr != -1
let index bstr ?(off = 0) ?len chr =
let len = match len with Some len -> len | None -> length bstr - off in
match memchr bstr ~off ~len chr with -1 -> None | value -> Some value
let compare a b =
let len_a = length a and len_b = length b in
if len_a < len_b then -1
else if len_a > len_b then 1
else unsafe_memcmp a 0 b 0 len_a
let equal a b = compare a b == 0
let constant_equal ~len a b =
let len1 = len asr 1 in
let r = ref 0 in
for i = 0 to pred len1 do
r :=
!r lor (unsafe_get_uint16_ne a (i * 2) lxor unsafe_get_uint16_ne b (i * 2))
done;
for _ = 1 to len land 1 do
r := !r lor (unsafe_get_uint8 a (len - 1) lxor unsafe_get_uint8 b (len - 1))
done;
!r == 0
let constant_equal a b =
let al = length a in
let bl = length b in
if al != bl then false else constant_equal ~len:al a b
let with_range ?(first = 0) ?(len = max_int) bstr =
if len < 0 then invalid_arg "Bstr.with_range";
if len == 0 then empty
else
let bstr_len = length bstr in
let max_idx = bstr_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 = 0 && last = max_idx then bstr
else unsafe_sub bstr first (last + 1 - first)
let with_index_range ?(first = 0) ?last bstr =
let bstr_len = length bstr in
let max_idx = bstr_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 bstr
else unsafe_sub bstr first (last + 1 - first)
let is_white chr = chr == ' ' || chr == '\t'
let trim ?(drop = is_white) bstr =
let len = length bstr in
if len == 0 then bstr
else
let max_idx = len - 1 in
let rec left_pos idx =
if idx > max_idx then len
else if drop bstr.{idx} then left_pos (succ idx)
else idx
in
let rec right_pos idx =
if idx < 0 then 0
else if drop bstr.{idx} then right_pos (pred idx)
else succ idx
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 bstr
else unsafe_sub bstr left (right - left)
let fspan ?(min = 0) ?(max = max_int) ?(sat = Fun.const true) bstr =
if min < 0 then invalid_arg "Bstr.fspan";
if max < 0 then invalid_arg "Bstr.fspan";
if min > max || max == 0 then (empty, bstr)
else
let len = length bstr 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 go idx =
if idx <= max_idx && sat bstr.{idx} then go (succ idx)
else if idx < need_idx || idx == 0 then (empty, bstr)
else if idx == len then (bstr, empty)
else
let a = unsafe_sub bstr 0 idx in
let b = unsafe_sub bstr idx (len - idx) in
(a, b)
in
go 0
let rspan ?(min = 0) ?(max = max_int) ?(sat = Fun.const true) bstr =
if min < 0 then invalid_arg "Bstr.rspan";
if max < 0 then invalid_arg "Bstr.rspan";
if min > max || max == 0 then (bstr, empty)
else
let len = length bstr 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 = len - min - 1 in
let rec go idx =
if idx >= min_idx && sat (unsafe_get bstr idx) then go (idx - 1)
else if idx > need_idx || idx == max_idx then (bstr, empty)
else if idx < 0 then (empty, bstr)
else
let cut = idx + 1 in
let a = unsafe_sub bstr 0 cut in
let b = unsafe_sub bstr cut (len - cut) in
(a, b)
in
go max_idx
let span ?(rev = false) ?min ?max ?sat bstr =
match rev with
| true -> rspan ?min ?max ?sat bstr
| false -> fspan ?min ?max ?sat bstr
let take ?(rev = false) ?min ?max ?sat bstr =
let a, b = span ~rev ?min ?max ?sat bstr in
if rev then b else a
let drop ?(rev = false) ?min ?max ?sat bstr =
let a, b = span ~rev ?min ?max ?sat bstr in
if rev then a else b
let fcut ~sep bstr =
let sep_len = String.length sep in
let len = length bstr in
if sep_len == 0 then invalid_arg "cut: empty separator";
let max_sep_zidx = sep_len - 1 in
let max_s_zidx = len - sep_len in
let rec check_sep i k =
if k > max_sep_zidx then
let a = unsafe_sub bstr 0 i in
let b = unsafe_sub bstr (i + sep_len) (len - i - sep_len) in
Some (a, b)
else if unsafe_get bstr (i + k) == String.unsafe_get sep k then
check_sep i (k + 1)
else scan (i + 1)
and scan i =
if i > max_s_zidx then None
else if unsafe_get bstr i == String.unsafe_get sep 0 then check_sep i 1
else scan (i + 1)
in
scan 0
let rcut ~sep bstr =
let sep_len = String.length sep in
let len = length bstr in
if sep_len == 0 then invalid_arg "cut: empty separator";
let max_sep_zidx = sep_len - 1 in
let max_s_zidx = len - 1 in
let rec check_sep i k =
if k > max_sep_zidx then
let a = sub ~off:0 ~len:i bstr in
let b = sub ~off:(i + sep_len) ~len:(len - i - sep_len) bstr in
Some (a, b)
else if unsafe_get bstr (i + k) == String.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 bstr i == String.unsafe_get sep 0 then check_sep i 1
else rscan (i - 1)
in
rscan (max_s_zidx - max_sep_zidx)
let cut ?(rev = false) ~sep bstr =
match rev with true -> rcut ~sep bstr | false -> fcut ~sep bstr
let shift bstr off =
if off > length bstr || off < 0 then invalid_arg "Bstr.shift";
let len = length bstr - off in
unsafe_sub bstr off len
let split_on_char sep bstr =
let lst = ref [] in
let max = ref (length bstr) in
for idx = length bstr - 1 downto 0 do
if unsafe_get bstr idx == sep then begin
lst := sub bstr ~off:(idx + 1) ~len:(!max - idx - 1) :: !lst;
max := idx
end
done;
sub bstr ~off:0 ~len:!max :: !lst
let concat sep = function
| [] -> empty
| x :: r as lst ->
let sep_len = String.length sep in
let fn acc bstr = acc + sep_len + length bstr in
let res_len = List.fold_left fn (length x) r in
let res = create res_len in
let first = ref true in
let dst_off = ref 0 in
let fn bstr =
let len = length bstr in
if !first then begin
blit bstr ~src_off:0 res ~dst_off:!dst_off ~len;
first := false;
dst_off := !dst_off + len
end
else begin
blit_from_string sep ~src_off:0 res ~dst_off:!dst_off ~len:sep_len;
dst_off := !dst_off + sep_len;
blit bstr ~src_off:0 res ~dst_off:!dst_off ~len;
dst_off := !dst_off + len
end
in
List.iter fn lst; res
let ( ++ ) a b =
let c = a + b in
match (a < 0, b < 0, c < 0) with
| true, true, false | false, false, true -> invalid_arg "Bstr.extend"
| _ -> c
let extend bstr left right =
let len = length bstr ++ left ++ right in
let res = make len '\000' in
let src_off, dst_off = if left < 0 then (-left, 0) else (0, left) in
let copy = Int.min (length bstr - src_off) (len - dst_off) in
if copy > 0 then unsafe_blit bstr ~src_off res ~dst_off ~len:copy;
res
let iter fn t =
for i = 0 to length t - 1 do
fn (unsafe_get t i)
done
let to_seq bstr =
let rec go idx () =
if idx == length bstr then Seq.Nil
else
let chr = unsafe_get bstr idx in
Seq.Cons (chr, go (idx + 1))
in
go 0
let to_seqi bstr =
let rec go idx () =
if idx == length bstr then Seq.Nil
else
let chr = unsafe_get bstr idx in
Seq.Cons ((idx, chr), go (idx + 1))
in
go 0
let of_seq seq =
let n = ref 0 in
let buf = ref (make 0x7ff '\000') in
let resize () =
let new_len = min (2 * length !buf) Sys.max_string_length in
(* TODO(dinosaure): should we keep this limit? *)
if length !buf == new_len then failwith "Bstr.of_seq: cannot grow bigstring";
let new_buf = make new_len '\000' in
Bigarray.Array1.blit !buf (sub new_buf ~off:0 ~len:(length !buf));
buf := new_buf
in
let fn chr =
if !n == length !buf then resize ();
unsafe_set !buf !n chr;
incr n
in
Seq.iter fn seq; sub !buf ~off:0 ~len:!n

View file

@ -0,0 +1,605 @@
(** A small library for manipulating bigstrings.
A bigstring is a mutable data structure that contains a fixed-length
sequence of bytes. Each byte can be indexed in constant time for reading and
writing.
Given a byte sequence [bstr] of length [len], we can access each of the
[len] bytes of [bstr] via its index in the sequence. Indexes start at [0],
and will call an index valid in [bstr] if it falls within the range
[[0...len-1]] (inclusive). A position is the point between two bytes or at
the beginning or end of the sequence. We call a position valid in [bstr] if
it falls within the range [[0...len]] (inclusive). Note that byte at index
[n] is between positions [n] and [n+1].
Two parameters [off] and [len] are said to designate a valid range of [bstr]
if [len >= 0] and [off] and [off+len] are valid positions in [bstr].
Byte sequences can be modified in place, for instance via the {!val:set} and
{!val:blit} functions described below.
{1:bigarray Bigstrings & Bigarrays.}
Bigstring is a specialised version of {!module:Bigarray} that not only
handles bytes in the form of {!module:Char}acter but also imposes a "C-like"
(see {!val:Bigarray.c_layout}) view as described above and allows common
functions such as [memcpy(3)] or [memmove(3)] to be offered.
For more details about Bigstrings and Bigarrays, we invite you to read the
{!module:Bigarray} documentation, which offers more general functions that
can be applied to Bigstrings.
{1:bytes Bigstrings & Bytes.}
Like bytes, a bigstring is a mutable data structure that contains a
fixed-length sequence of bytes. However, a bigstring has a few special
features that can make it more interesting to use than bytes.
{2:location Bigstrings and the Garbage Collector.}
A bigstring is not allocated in the same way as a standard OCaml value. In
fact, the byte sequence that the bigstring refers to is found in the
{i C heap} (rather than the OCaml heap). This means that the byte sequence
can come from a [malloc(3)] or a function requesting a particular memory
area from the system such as [Unix.map_file].
This particularity has an implication with the GC: the byte sequence is
{b not relocatable}. That is to say that during the cycle of the Garbage
Collector, this byte sequence does not move in contrast, a [bytes] can be
moved by the GC (typically, from the minor heap to the major heap).
Thus, bigstrings have advantages and disadvantages compared to bytes due to
this particularity:
- Creating a bigstring can be expensive. Whether it is with
[malloc(3)]/{!val:create} or [Unix.map_file], creating a bigstring will
always be more expensive than creating bytes with OCaml. For small byte
sequences, it is therefore preferable to use bytes.
- Since a bigstring cannot be moved, its position can be shared by [Thread]s
and/or [Domain]s without interacting with the GC. An example is being able
to perform a complex computation in parallel from the bytes of this
sequence without {i blocking} the Garbage Collector during this
computation.
Depending on these characteristics, it may be more advantageous to use a
bigstring rather than [bytes]. This basically depends on your usage, and the
special features of bigstrings can unlock opportunities to outperform byte
calculations or analysis.
{2:sub Bigstring and slice.}
Another advantage of bigstrings is that copying is avoided when extracting
part of a larger bigstring. This is because the {!val:sub} function returns
a "proxy" of the original bigstring.
In this respect, and to be very precise, {!val:sub} avoids copying but the
creation of this "proxy" {b remains} costly. In addition, this library is
distributed with a new {!module:Slice_bstr} module. The latter offers a new
type whose {!val:Slice_bstr.sub} function is much less costly than
{!val:sub}.
{1 Bigstrings.} *)
type t = (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t
(** {2 Constructors.} *)
val empty : t
(** [empty] is an empty bigstring. *)
val create : int -> t
(** [create len] returns a new byte sequence of length [len]. The sequence
{b is unitialized} and contains arbitrary bytes. *)
val make : int -> char -> t
(** [make len chr] is {!type:t} of length [len] with each index holding the
character [chr]. *)
val copy : t -> t
(** [copy t] returns a new byte sequence that contains the same bytes as the
argument. *)
val init : int -> (int -> char) -> t
(** [init len fn] returns a fresh byte sequence of length [len], with character
[idx] initialized to the result of [fn idx] (in increasing index order). *)
(** {2 Memory-safe Operations.} *)
val of_string : string -> t
(** [of_string str] returns a new {!type:t} that contains the contents of the
given string [str]. *)
val string : ?off:int -> ?len:int -> string -> t
(** [string ~off ~len str] is the sub-buffer of [str] that starts at position
[off] (defaults to [0]) and stops at position [off + len] (defaults to
[String.length str]). [str] is fully-replaced by a fresh allocated
{!type:t}.
@raise Invalid_argument
if [off] and [len] do not designate a valid range of [str]. *)
val sub_string : t -> off:int -> len:int -> string
(** [sub_string bstr ~off ~len] returns a string of length [len] containing the
bytes of [bstr] starting at [off].
@raise Invalid_argument
if [off] and [len] do not designate a valid range of [t]. *)
val to_string : t -> string
(** [to_string bstr] is equivalent to
[sub_string bstr ~off:0 ~len:(length bstr)]. *)
val length : t -> int
(** [length bstr] is the number of bytes in [bstr]. *)
val get : t -> int -> char
(** [get bstr i] is the byte of [bstr]' at index [i]. This is equivalent to the
[bstr.{i}] notation.
@raise Invalid_argument if [i] is not an index of [bstr]. *)
val set : t -> int -> char -> unit
(** [set t i chr] modifies [t] in place, replacing the byte at index [i] with
[chr].
@raise Invalid_argument if [i] is not a valid index in [t]. *)
val unsafe_get : t -> int -> char
(** [unsafe_get t idx] is like {!val:get} except no bounds checking is
performed. *)
val unsafe_set : t -> int -> char -> unit
(** [unsafe_set t idx chr] is like {!val:set} except no bounds checking is
performed. *)
val chop : ?rev:bool -> t -> char option
(** [chop bstr] returns the first element of [bstr] or the last element if
[rev = true]. If [bstr] is empty, it returns [None]. *)
val concat : string -> t list -> t
(** [concat sep ts] concatenates the list of bigstrings [ts], inserting the
separator string [sep] between each. *)
val extend : t -> int -> int -> t
(** [extend bstr left right] returns a new bigstring that contains the bytes of
[bstr], with [left] zero bytes prepended and [right] zero byte appended to
it. If [left] or [right] is negative, then bytes are removed (instead of
appended) from the corresponding side of [bstr].
@raise Invalid_argument if the result length is negative *)
(** {2 Copy operation from one byte sequence to another.} *)
val blit : t -> src_off:int -> t -> dst_off:int -> len:int -> unit
(** [blit src ~src_off dst ~dst_off ~len] copies [len] bytes from byte sequence
[src], starting at index [src_off], to byte sequence [dst], starting at
index [dst_off]. It works correctly even if [src] and [dst] are (physically)
the same byte sequence, and the source and destination intervals overlap.
@raise Invalid_argument
if [src_off] and [len] do not designate a valid range of [src], or if
[dst_off] and [len] do not designate a valid range of [dst]. *)
val blit_from_string :
string -> src_off:int -> t -> dst_off:int -> len:int -> unit
(** Just like {!val:blit}, but with a string as source one.
{b Note}: since it is impossible for [src] to overlap [dst], {!val:memcpy}
is used to do the copy.
@raise Invalid_argument
if [src_pos] and [len] do not designate a valid range of [src], or if
[dst_off] and [len] do not designate a valid range of [dst]. *)
val blit_from_bytes :
bytes -> src_off:int -> t -> dst_off:int -> len:int -> unit
(** Just like {!val:blit}, but with a bytes as source one.
{b Note}: since it is impossible for [src] to overlap [dst], {!val:memcpy}
is used to do the copy.
@raise Invalid_argument
if [src_pos] and [len] do not designate a valid range of [src], or if
[dst_off] and [len] do not designate a valid range of [dst]. *)
val blit_to_bytes : t -> src_off:int -> bytes -> dst_off:int -> len:int -> unit
(** [blit_to_bytes src ~src_off dst ~dst_off ~len] copies [len] bytes from
[src], starting at index [src_off], to byte sequence [dst], starting at
index [dst_off].
{b Note}: since it is impossible for [src] to overlap [dst], {!val:memcpy}
is used to do the copy.
@raise Invalid_argument
if [src_off] and [len] do not designate a valid range of [src], or if
[dst_off] and [len] do not designate a valid range of [dst]. *)
val memcpy : t -> src_off:int -> t -> dst_off:int -> len:int -> unit
(** [memcpy src ~src_off dst ~dst_off ~len] copies [len] bytes from [src] to
[dst]. [src] {b must not} overlap [dst]. Use {!val:memmove} if [src] & [dst]
do overlap.
You can check whether two buffers overlap using {!val:overlap}. If this
returns [None], the two values do not refer to a common memory area and it
is safe to use memcpy.
@raise Invalid_argument
if [src_off] and [len] do not designate a valid range of [src], or if
[dst_off] and [len] do not designate a valid range of [dst]. *)
val memcpy_mmaped : t -> src_off:int -> t -> dst_off:int -> len:int -> unit
(** [memcpy_mmaped] is like {!val:memcpy} but [src] and [dst] can be a
{i mmaped} bigarray (from [Unix.map_file]). In this specific case, copying
from one to the other can take some time because it involves reading/writing
to disk. The operation can take longer than if the two bigarrays were
allocated via [malloc()]/{!val:Bigarray.Array1.create}.
It may therefore be worthwhile to release the GC lock so that this specific
operation can be carried out in parallel (in a [Thread]) without
interruption by the GC.
Note that the bigarrays do not necessarily need to be {i mmaped}. This
function also applies to "normal" bigarrays. It may also be worthwhile to
use this function if you know that you are copying a large area and would
like to do it in parallel (in a [Thread]). *)
val memmove : t -> src_off:int -> t -> dst_off:int -> len:int -> unit
(** [memmove src ~src_off dst ~dst_off ~len] copies [len] bytes from [src] to
[dst]. [src] and [dst] may overlap: copying takes place as though the bytes
in [src] are first copied into a temporary array that does not overlap [src]
or [dst], and the bytes are then copied from the temporary array to [dst].
@raise Invalid_argument
if [src_off] and [len] do not designate a valid range of [src], or if
[dst_off] and [len] do not designate a valid range of [dst]. *)
val memmove_mmaped : t -> src_off:int -> t -> dst_off:int -> len:int -> unit
(** [memmove_mmaped] is like {!val:memmove} but [src] and [dst] can be a
{i mmaped} bigarray (from [Unix.map_file]). In this specific case, copying
from one to the other can take some time because it involves reading/writing
to disk. The operation can take longer than if the two bigarrays were
allocated via [malloc()]/{!val:Bigarray.Array1.create}.
It may therefore be worthwhile to release the GC lock so that this specific
operation can be carried out in parallel (in a [Thread]) without
interruption by the GC.
Note that the bigarrays do not necessarily need to be {i mmaped}. This
function also applies to "normal" bigarrays. It may also be worthwhile to
use this function if you know that you are copying a large area and would
like to do it in parallel (in a [Thread]). *)
val memcmp : t -> src_off:int -> t -> dst_off:int -> len:int -> int
(** [memcmp s1 ~src_off s2 ~dst_off ~len] compares the first [len] bytes of the
memory areas [s1] (starting at [src_off]) and [s2] (starting at [dst_off]).
[memcmp] returns [0] is [s1] and [s2] don't match.
@raise Invalid_argument
if [src_off] and [len] do not designate a valid range of [src], or if
[dst_off] and [len] do not designate a valid range of [dst]. *)
val memset : t -> off:int -> len:int -> char -> unit
(** [memset t ~off ~len chr] fills [len] bytes (starting at [off]) into [t] with
the constant byte [chr].
@raise Invalid_argument
if [off] and [len] do not designate a valid range of [t]. *)
val fill : t -> ?off:int -> ?len:int -> char -> unit
(** [fill t off len chr] modifies [t] in place, replacing [len] characters with
[chr], starting at [off].
@raise Invalid_argument
if [off] and [len] do not designate a valid range of [t]. *)
(** {2 Decode integers from a byte sequence.} *)
val get_int8 : t -> int -> int
(** [get_int8 bstr i] is [bstr]'s signed 8-bit integer starting at byte index
[i]. *)
val get_uint8 : t -> int -> int
(** [get_uint8 bstr i] is [bstr]'s unsigned 8-bit integer starting at byte index
[i]. *)
val get_uint16_ne : t -> int -> int
(** [get_int16_ne bstr i] is [bstr]'s native-endian unsigned 16-bit integer
starting at byte index [i]. *)
val get_uint16_le : t -> int -> int
(** [get_int16_le bstr i] is [bstr]'s little-endian unsigned 16-bit integer
starting at byte index [i]. *)
val get_uint16_be : t -> int -> int
(** [get_int16_be bstr i] is [bstr]'s big-endian unsigned 16-bit integer
starting at byte index [i]. *)
val get_int16_ne : t -> int -> int
(** [get_int16_ne bstr i] is [bstr]'s native-endian signed 16-bit integer
starting at byte index [i]. *)
val get_int16_le : t -> int -> int
(** [get_int16_le bstr i] is [bstr]'s little-endian signed 16-bit integer
starting at byte index [i]. *)
val get_int16_be : t -> int -> int
(** [get_int16_be bstr i] is [bstr]'s big-endian signed 16-bit integer starting
at byte index [i]. *)
val get_int32_ne : t -> int -> int32
(** [get_int32_ne bstr i] is [bstr]'s native-endian 32-bit integer starting at
byte index [i]. *)
val get_int32_le : t -> int -> int32
(** [get_int32_le bstr i] is [bstr]'s little-endian 32-bit integer starting at
byte index [i]. *)
val get_int32_be : t -> int -> int32
(** [get_int32_be bstr i] is [bstr]'s big-endian 32-bit integer starting at byte
index [i]. *)
val get_int64_ne : t -> int -> int64
(** [get_int64_ne bstr i] is [bstr]'s native-endian 64-bit integer starting at
byte index [i]. *)
val get_int64_le : t -> int -> int64
(** [get_int64_le bstr i] is [bstr]'s little-endian 64-bit integer starting at
byte index [i]. *)
val get_int64_be : t -> int -> int64
(** [get_int64_be bstr i] is [bstr]'s big-endian 64-bit integer starting at byte
index [i]. *)
val set_int8 : t -> int -> int -> unit
(** [set_int8 t i v] sets [t]'s signed 8-bit integer starting at byte index [i]
to [v]. *)
val set_uint8 : t -> int -> int -> unit
(** [set_uint8 t i v] sets [t]'s unsigned 8-bit integer starting at byte index
[i] to [v]. *)
val set_uint16_ne : t -> int -> int -> unit
(** [set_uint16_ne t i v] sets [t]'s native-endian unsigned 16-bit integer
starting at byte index [i] to [v]. *)
val set_uint16_le : t -> int -> int -> unit
(** [set_uint16_le t i v] sets [t]'s little-endian unsigned 16-bit integer
starting at byte index [i] to [v]. *)
val set_uint16_be : t -> int -> int -> unit
(** [set_uint16_le t i v] sets [t]'s big-endian unsigned 16-bit integer starting
at byte index [i] to [v]. *)
val set_int16_ne : t -> int -> int -> unit
(** [set_uint16_ne t i v] sets [t]'s native-endian signed 16-bit integer
starting at byte index [i] to [v]. *)
val set_int16_le : t -> int -> int -> unit
(** [set_uint16_le t i v] sets [t]'s little-endian signed 16-bit integer
starting at byte index [i] to [v]. *)
val set_int16_be : t -> int -> int -> unit
(** [set_uint16_le t i v] sets [t]'s big-endian signed 16-bit integer starting
at byte index [i] to [v]. *)
val set_int32_ne : t -> int -> int32 -> unit
(** [set_int32_ne t i v] sets [t]'s native-endian 32-bit integer starting at
byte index [i] to [v]. *)
val set_int32_le : t -> int -> int32 -> unit
(** [set_int32_ne t i v] sets [t]'s little-endian 32-bit integer starting at
byte index [i] to [v]. *)
val set_int32_be : t -> int -> int32 -> unit
(** [set_int32_ne t i v] sets [t]'s big-endian 32-bit integer starting at byte
index [i] to [v]. *)
val set_int64_ne : t -> int -> int64 -> unit
(** [set_int32_ne t i v] sets [t]'s native-endian 64-bit integer starting at
byte index [i] to [v]. *)
val set_int64_le : t -> int -> int64 -> unit
(** [set_int32_ne t i v] sets [t]'s little-endian 64-bit integer starting at
byte index [i] to [v]. *)
val set_int64_be : t -> int -> int64 -> unit
(** [set_int32_ne t i v] sets [t]'s big-endian 64-bit integer starting at byte
index [i] to [v]. *)
val sub : t -> off:int -> len:int -> t
(** [sub bstr ~off ~len] does not allocate a bigstring, but instead returns a
new view into [bstr] starting at [off], and with length [len].
{b Note} [sub] does not allocate a new buffer, but instead shares the memory
area of [bstr] with the newly-returned bigstring. This means that the
changes ([set{,_*}] functions) made to the returned bigstring will also be
reflected in the [bstr] bigstring given.
{b Note} [sub] is more expensive than a [Slice.sub] (about 8 times slower).
If you want to focus on performance while avoiding copying, it's best to use
a [Slice]. *)
val shift : t -> int -> t
(** [shift bstr n] is [sub bstr n (length bstr - n)] (see {!val:sub} for more
details). *)
val overlap : t -> t -> (int * int * int) option
(** [overlap x y] returns the size (in bytes) of what is physically common
between [x] and [y], as well as the position of [y] in [x] and the position
of [x] in [y]. *)
(** {2 Predicates and comparaisons.} *)
val is_empty : t -> bool
(** [is_empty bstr] is [length bstr = 0]. *)
val is_prefix : affix:string -> t -> bool
(** [is_prefix ~affix bstr] is [true] iff [affix.[idx] = bstr.{idx}] for all
indices [idx] of [affix]. *)
val starts_with : prefix:t -> t -> bool
(** [starts_with ~prefix t] is like {!val:is_prefix} but the prefix is a
{!type:t} (instead of a [string]). *)
val is_infix : affix:string -> t -> bool
(** [is_infix ~affix bstr] is [true] iff there exists an index [j] in [bstr]
such that for all indices [i] of [affix] we have [affix.[i] = bstr.{j + i}].
*)
val is_suffix : affix:string -> t -> bool
(** [is_suffix ~affix bstr] is [true] iff [affix.[n - idx] = bstr.{m - idx}] for
all indices [idx] of [affix] with [n = String.length affix - 1] and
[m = length bstr - 1]. *)
val ends_with : suffix:t -> t -> bool
(** [ends_with ~suffix t] is like {!val:is_suffix} but the suffix is a {!type:t}
(instead of a [string]. *)
val for_all : (char -> bool) -> t -> bool
(** [for_all p bstr] is [true] iff for all indices [idx] of [bstr],
[p bstr.{idx} = true]. *)
val contains : t -> ?off:int -> ?len:int -> char -> bool
(** [contains bstr ?off ?len chr] is [true] if and only if [chr] appears in
[len] byte(s)'s [bstr] after position [off] (defaults to [0]). *)
val equal : t -> t -> bool
(** [equal a b] is [a = b]. *)
val constant_equal : t -> t -> bool
(** [constant_equal] gives the same result as {!val:equal} but the execution
time of the function, whether or not the two values are equivalent (as long
as they have the {b same} size) is the same.
Indeed, the {!val:equal} function ends as soon as a difference exists. This
function continues even if a difference exists. This function is useful when
comparing passwords and avoiding an {i timing attack}. *)
val compare : t -> t -> int
(** [compare bstr0 bstr1] sorts [bstr0] and [bstr1] in lexicographical order. *)
val index : t -> ?off:int -> ?len:int -> char -> int option
(** [index bstr ?off ?len chr] is the index of the first occurrence of [chr] in
[len] byte(s)'s [bstr] after position [off] (defaults to [0]). If [chr] does
not occur in given range of [bstr], we return [None].
@raise Invalid_argument
if [off] and [len] do not designate a valid range of [bstr]. *)
val memchr : t -> off:int -> len:int -> char -> int
(** [memchr t ~off ~len chr] scans [len] bytes (starting at [off]) of [t] for
the first instance of [chr]. It returns the position in [t] where the first
occurrence of [chr] is found. Otherwise, it returns [-1].
@raise Invalid_argument
if [off] and [len] do not designate a valid range of [t]. *)
(** {2 Extracting substrings.} *)
val with_range : ?first:int -> ?len:int -> t -> t
(** [with_range ~first ~len bstr] are the consecutive bytes of [bstr] whose
indices exist in the range \[[first];[first + len - 1]\].
[first] defaults to [0] and [len] to [max_int]. Note that [first] can be any
integer and [len] any positive integer. *)
val with_index_range : ?first:int -> ?last:int -> t -> t
(** [with_index_range ~first ~last bstr] are the consecutive bytes of [bstr]
whose indices exists in the range \[[first];[last]\].
[first] defaults to [0] and [last] to [length bstr - 1].
Note that both [first] and [last] can be any integer. If [first > last] the
interval is empty and the empty bigstring is returned. *)
val trim : ?drop:(char -> bool) -> t -> t
(** [trim ~drop bstr] is [bstr] with prefix and suffix bytes satisfying [drop]
in [bstr] removed. [drop] defaults to [fun chr -> chr = ' ']. *)
val span :
?rev:bool -> ?min:int -> ?max:int -> ?sat:(char -> bool) -> t -> t * t
(** [span ~rev ~min ~max ~sat bstr] is [(l, r)] where:
- if [rev] is [false] (default), [l] is at least [min] and at most [max]
consecutive [sat] satisfying initial bytes of [bstr] or {!empty} if there
are no such bytes. [r] are the remaining bytes of [bstr].
- if [rev] is [true], [r] is at least [min] and at most [max] consecutive
[sat] satisfying final bytes of [bstr] or {!empty} if there are no such
bytes. [l] are the remaining bytes of [bstr].
If [max] is unspecified the span is unlimited. If [min] is unspecified it
defaults to [0]. If [min > max] the condition can't be satisfied and the
left or right span, depending on [rev], is always empty. [sat] defaults to
[Fun.const true].
@raise Invalid_argument if [max] or [min] is negative. *)
val take : ?rev:bool -> ?min:int -> ?max:int -> ?sat:(char -> bool) -> t -> t
(** [take ~rev ~min ~max ~sat bstr] is the matching span of {!span} without the
remaining one. In other words:
{[
(if rev then snd else fst) (span ~rev ~min ~max ~sat bstr)
]} *)
val drop : ?rev:bool -> ?min:int -> ?max:int -> ?sat:(char -> bool) -> t -> t
(** [drop ~rev ~min ~max ~sat bstr] is the remaining span of {!span} without the
matching span. In other words:
{[
(if rev then fst else snd) (span ~rev ~min ~max ~sat bstr)
]} *)
val cut : ?rev:bool -> sep:string -> t -> (t * t) option
(** [cut ~sep bstr] is either the pair [Some (l, r)] of the two (possibly empty)
sub-buffers of [bstr] that are delimited by the first match of the non empty
separator string [sep] or [None] if [sep] can't be matched in [bstr].
Matching starts from the beginning of [bstr] ([rev] is [false], default) or
the end ([rev] is [true]).
The invariant [l ^ sep ^ r = s] holds.
For instance, the {i ABNF} expression:
{v
field_name := *PRINT
field_value := *ASCII
field := field_name ":" field_value
v}
can be translated to:
{[
match Bstr.cut ~sep:":" value with
| Some (field_name, field_value) -> ...
| None -> invalid_arg "Invalid field"
]}
@raise Invalid_argument if [sep] is the empty buffer. *)
val split_on_char : char -> t -> t list
(** [split_on_char sep t] is the list of all (possibly empty)
{!val:sub}-bigstrings of [t] that are delimited by the character [sep]. If
[t] is empty, the result is the singleton list [[empty]].
The function's result is specified by the following invariant:
- the list is not empty.
- concatenating its elements using [sep] as a separator returns a bigstring
equal to the input.
- no bigstring in the result contains the [sep] character. *)
(** {2 Traversing strings.} *)
val iter : (char -> unit) -> t -> unit
(** [iter fn t] applies function [fn] in turn to all the characters of [t]. It
is equivalent to [fn t.{0}; fn t.{1}; ...; fn t.{length t - 1}; ()]. *)
val to_seq : t -> char Seq.t
(** Iterate on the bigstring, in increasing index order. Modifications of the
bigstring during iteration will be reflected in the sequence. *)
val to_seqi : t -> (int * char) Seq.t
(** Iterate on the bigstring, in increasing order, yielding indices along chars.
*)
val of_seq : char Seq.t -> t
(** Create a bigstring from the generator. *)

View file

@ -0,0 +1,2 @@
lib/bstr.o
lib/bstr.cmx

View file

@ -0,0 +1,40 @@
(*
* Copyright (c) 2024 Romain Calascibetta <romain.calascibetta@gmail.com>
*
* Permission to use, copy, modify, and 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.
*)
include Bytes
let[@inline always] blit src ~src_off dst ~dst_off ~len =
Bytes.blit src src_off dst dst_off len
let[@inline always] fill t ~off ~len chr = Bytes.fill t off len chr
let[@inline always] blit_to_bytes src ~src_off dst ~dst_off ~len =
Bytes.blit src src_off dst dst_off len
let string ?(off = 0) ?len str =
let len =
match len with Some len -> len | None -> String.length str - off
in
if len < 0 || off < 0 || off > String.length str - len then
invalid_arg "Bytes.string";
let buf = String.sub str off len in
Bytes.unsafe_of_string buf
let overlap a b = if a == b then Some (Bytes.length a, 0, 0) else None
let sub t ~off ~len = Bytes.sub t off len
let blit_from_bytes src ~src_off dst ~dst_off ~len =
Bytes.blit src src_off dst dst_off len

View file

@ -0,0 +1,54 @@
(library
(name bstr)
(modules bstr)
(public_name bstr)
(foreign_stubs
(language c)
(names bstr)
(flags
(:standard -Wcast-align)))
(instrumentation
(backend bisect_ppx))
(wrapped false))
(library
(name slice)
(modules slice)
(public_name slice)
(instrumentation
(backend bisect_ppx))
(wrapped false))
(library
(name slice_bytes)
(modules bytes_labels slice_bytes)
(public_name slice.bytes)
(libraries slice)
(wrapped false))
(library
(name slice_bstr)
(modules slice_bstr)
(public_name slice.bstr)
(libraries bstr slice)
(wrapped false))
(rule
(target slice_bytes.ml)
(action
(run ./../bin/generate.exe -m S -n Bytes_labels -i %{dep:slice.ml.in} -o
%{target})))
(rule
(target slice_bstr.ml)
(action
(run ./../bin/generate.exe -m S -n Bstr -i %{dep:slice.ml.in} -o %{target})))
(library
(name bin)
(modules bin)
(public_name bin)
(libraries bstr slice)
(instrumentation
(backend bisect_ppx))
(wrapped false))

View file

@ -0,0 +1,183 @@
(*
* Copyright (c) 2024 Romain Calascibetta <romain.calascibetta@gmail.com>
*
* Permission to use, copy, modify, and 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.
*)
type 'a t = { buf: 'a; off: int; len: int }
let unsafe_make ~off ~len buf = { off; len; buf }
let unsafe_sub { off; buf; _ } off' len' = { off= off + off'; len= len'; buf }
let pp ppf { off; len; _ } =
Format.fprintf ppf "@[<hov>{ off=@ %d;@ len=@ %d;@ }@]" off len
let length { len; _ } = len
let is_empty { len; _ } = len == 0
let sub t ~off ~len =
let off' = t.off + off in
let top = off' + len in
let old = t.off + t.len in
if off' >= t.off && top <= old && off' <= top then { t with off= off'; len }
else invalid_arg "Slice.sub"
let shift t off =
if off > length t || off < 0 then invalid_arg "Slice.shift";
let len = length t - off in
unsafe_sub t off len
module type R = sig
type t
val make : int -> char -> t
val init : int -> (int -> char) -> t
val empty : t
val length : t -> int
val is_empty : t -> bool
val chop : ?rev:bool -> t -> char option
val hash : t -> int
val equal : t -> t -> bool
val compare : t -> t -> int
val get : t -> int -> char
val unsafe_get : t -> int -> char
val get_int8 : t -> int -> int
(** [get_int8 bstr i] is [bstr]'s signed 8-bit integer starting at byte index
[i]. *)
val get_uint8 : t -> int -> int
(** [get_uint8 bstr i] is [bstr]'s unsigned 8-bit integer starting at byte
index [i]. *)
val get_uint16_ne : t -> int -> int
(** [get_int16_ne bstr i] is [bstr]'s native-endian unsigned 16-bit integer
starting at byte index [i]. *)
val get_uint16_le : t -> int -> int
(** [get_int16_le bstr i] is [bstr]'s little-endian unsigned 16-bit integer
starting at byte index [i]. *)
val get_uint16_be : t -> int -> int
(** [get_int16_be bstr i] is [bstr]'s big-endian unsigned 16-bit integer
starting at byte index [i]. *)
val get_int16_ne : t -> int -> int
(** [get_int16_ne bstr i] is [bstr]'s native-endian signed 16-bit integer
starting at byte index [i]. *)
val get_int16_le : t -> int -> int
(** [get_int16_le bstr i] is [bstr]'s little-endian signed 16-bit integer
starting at byte index [i]. *)
val get_int16_be : t -> int -> int
(** [get_int16_be bstr i] is [bstr]'s big-endian signed 16-bit integer
starting at byte index [i]. *)
val get_int32_ne : t -> int -> int32
(** [get_int32_ne bstr i] is [bstr]'s native-endian 32-bit integer starting at
byte index [i]. *)
val get_int32_le : t -> int -> int32
(** [get_int32_le bstr i] is [bstr]'s little-endian 32-bit integer starting at
byte index [i]. *)
val get_int32_be : t -> int -> int32
(** [get_int32_be bstr i] is [bstr]'s big-endian 32-bit integer starting at
byte index [i]. *)
val get_int64_ne : t -> int -> int64
(** [get_int64_ne bstr i] is [bstr]'s native-endian 64-bit integer starting at
byte index [i]. *)
val get_int64_le : t -> int -> int64
(** [get_int64_le bstr i] is [bstr]'s little-endian 64-bit integer starting at
byte index [i]. *)
val get_int64_be : t -> int -> int64
(** [get_int64_be bstr i] is [bstr]'s big-endian 64-bit integer starting at
byte index [i]. *)
val filter : (char -> bool) -> t -> t
val filter_map : (char -> char option) -> t -> t
val map : (char -> char) -> t -> t
val mapi : (int -> char -> char) -> t -> t
val fold_left : ('a -> char -> 'a) -> 'a -> t -> 'a
val fold_right : (char -> 'a -> 'a) -> t -> 'a -> 'a
val iter : (char -> unit) -> t -> unit
val iteri : (int -> char -> unit) -> t -> unit
val hex : t -> string
val overlap : t -> t -> (int * int * int) option
val append : t -> t -> t
val starts_with : prefix:string -> t -> bool
val is_prefix : affix:string -> t -> bool
(** [is_prefix ~affix bstr] is [true] iff [affix.[idx] = bstr.{idx}] for all
indices [idx] of [affix]. *)
val ends_with : suffix:string -> t -> bool
val is_suffix : affix:string -> t -> bool
(** [is_suffix ~affix bstr] is [true] iff [affix.[n - idx] = bstr.{m - idx}]
for all indices [idx] of [affix] with [n = String.length affix - 1] and
[m = length bstr - 1]. *)
val is_infix : affix:string -> t -> bool
(** [is_infix ~affix bstr] is [true] iff there exists an index [j] in [bstr]
such that for all indices [i] of [affix] we have
[affix.[i] = bstr.{j + i}]. *)
val for_all : (char -> bool) -> t -> bool
val exists : (char -> bool) -> t -> bool
val trim : ?drop:(char -> bool) -> t -> t
val span :
?rev:bool -> ?min:int -> ?max:int -> ?sat:(char -> bool) -> t -> t * t
val take : ?rev:bool -> ?min:int -> ?max:int -> ?sat:(char -> bool) -> t -> t
val drop : ?rev:bool -> ?min:int -> ?max:int -> ?sat:(char -> bool) -> t -> t
val shift : t -> int -> t
val sub : t -> off:int -> len:int -> t
val split_on_char : char -> t -> t list
val cut : ?rev:bool -> sep:string -> t -> (t * t) option
val cuts : ?rev:bool -> ?empty:bool -> sep:string -> t -> t list
val index : t -> ?rev:bool -> ?from:int -> char -> int
val contains : t -> ?rev:bool -> ?from:int -> char -> bool
val concat : t -> t list -> t
val copy : t -> t
val sub_string : t -> off:int -> len:int -> string
val to_string : t -> string
end
module type W = sig
type t
val set : t -> int -> char -> unit
val unsafe_set : t -> int -> char -> unit
val set_int8 : t -> int -> int -> unit
val set_uint8 : t -> int -> int -> unit
val set_uint16_ne : t -> int -> int -> unit
val set_uint16_le : t -> int -> int -> unit
val set_uint16_be : t -> int -> int -> unit
val set_int16_ne : t -> int -> int -> unit
val set_int16_le : t -> int -> int -> unit
val set_int16_be : t -> int -> int -> unit
val set_int32_ne : t -> int -> int32 -> unit
val set_int32_le : t -> int -> int32 -> unit
val set_int32_be : t -> int -> int32 -> unit
val set_int64_ne : t -> int -> int64 -> unit
val set_int64_le : t -> int -> int64 -> unit
val set_int64_be : t -> int -> int64 -> unit
val fill : t -> off:int -> len:int -> char -> unit
val blit : t -> src_off:int -> t -> dst_off:int -> len:int -> unit
end

View file

@ -0,0 +1,148 @@
(*
* Copyright (c) 2024 Romain Calascibetta <romain.calascibetta@gmail.com>
*
* Permission to use, copy, modify, and 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.
*)
type t = S.t Slice.t
external ( < ) : 'a -> 'a -> bool = "%lessthan"
external ( <= ) : 'a -> 'a -> bool = "%lessequal"
external ( >= ) : 'a -> 'a -> bool = "%greaterequal"
external ( > ) : 'a -> 'a -> bool = "%greaterthan"
let ( > ) (x : int) y = x > y [@@inline]
let ( < ) (x : int) y = x < y [@@inline]
let ( <= ) (x : int) y = x <= y [@@inline]
let ( >= ) (x : int) y = x >= y [@@inline]
let min (a : int) b = if a <= b then a else b [@@inline]
let max (a : int) b = if a >= b then a else b [@@inline]
open Slice
let make ?(off= 0) ?len buf =
let len = match len with
| Some len -> len
| None -> S.length buf - off in
if len < 0
|| off < 0
|| off > S.length buf - len
then invalid_arg "Slice.make";
Slice.unsafe_make ~off ~len buf
let empty = unsafe_make ~off:0 ~len:0 S.empty
let length { len; _ } = len
let get { off; buf; _ } idx = S.get buf (off + idx)
let get_int8 { off; buf; _ } idx = S.get_int8 buf (off + idx)
let get_uint8 { off; buf; _ } idx = S.get_uint8 buf (off + idx)
let get_uint16_ne { off; buf; _ } idx = S.get_uint16_ne buf (off + idx)
let get_uint16_le { off; buf; _ } idx = S.get_uint16_le buf (off + idx)
let get_uint16_be { off; buf; _ } idx = S.get_uint16_be buf (off + idx)
let get_int16_ne { off; buf; _ } idx = S.get_int16_ne buf (off + idx)
let get_int16_le { off; buf; _ } idx = S.get_int16_ne buf (off + idx)
let get_int16_be { off; buf; _ } idx = S.get_int16_be buf (off + idx)
let get_int32_ne { off; buf; _ } idx = S.get_int32_ne buf (off + idx)
let get_int32_le { off; buf; _ } idx = S.get_int32_le buf (off + idx)
let get_int32_be { off; buf; _ } idx = S.get_int32_be buf (off + idx)
let get_int64_ne { off; buf; _ } idx = S.get_int64_ne buf (off + idx)
let get_int64_le { off; buf; _ } idx = S.get_int64_le buf (off + idx)
let get_int64_be { off; buf; _ } idx = S.get_int64_be buf (off + idx)
let set { off; buf; _ } idx v = S.set buf (off + idx) v
let set_int8 { off; buf; _ } idx v = S.set_int8 buf (off + idx) v
let set_uint8 { off; buf; _ } idx v = S.set_uint8 buf (off + idx) v
let set_uint16_ne { off; buf; _ } idx v = S.set_uint16_ne buf (off + idx) v
let set_uint16_le { off; buf; _ } idx v = S.set_uint16_le buf (off + idx) v
let set_uint16_be { off; buf; _ } idx v = S.set_uint16_be buf (off + idx) v
let set_int16_ne { off; buf; _ } idx v = S.set_int16_ne buf (off + idx) v
let set_int16_le { off; buf; _ } idx v = S.set_int16_ne buf (off + idx) v
let set_int16_be { off; buf; _ } idx v = S.set_int16_be buf (off + idx) v
let set_int32_ne { off; buf; _ } idx v = S.set_int32_ne buf (off + idx) v
let set_int32_le { off; buf; _ } idx v = S.set_int32_le buf (off + idx) v
let set_int32_be { off; buf; _ } idx v = S.set_int32_be buf (off + idx) v
let set_int64_ne { off; buf; _ } idx v = S.set_int64_ne buf (off + idx) v
let set_int64_le { off; buf; _ } idx v = S.set_int64_le buf (off + idx) v
let set_int64_be { off; buf; _ } idx v = S.set_int64_be buf (off + idx) v
let blit a b =
let len = Int.min a.len b.len in
S.blit a.buf ~src_off:a.off b.buf ~dst_off:b.off ~len:len
let blit_from_bytes src ~src_off { Slice.buf; off; _ } ?dst_off len =
let dst_off = match dst_off with
| Some dst_off -> dst_off + off
| None -> off in
if len < 0
|| dst_off < 0
|| dst_off > S.length buf - len
then invalid_arg "Slice.blit_from_bytes";
S.blit_from_bytes src ~src_off buf ~dst_off ~len
let blit_to_bytes { Slice.buf; off; _ } ?src_off dst ~dst_off ~len =
let src_off = match src_off with
| Some src_off -> src_off + off
| None -> off in
if len < 0
|| src_off < 0
|| src_off > S.length buf - len
then invalid_arg "Slice.blit_to_bytes";
S.blit_to_bytes buf ~src_off dst ~dst_off ~len
let fill { off; len; buf; } ?off:(off'= 0) ?len:len' chr =
let len' = match len' with
| Some len' -> len'
| None -> len - off' in
S.fill buf ~off:(off + off') ~len:len' chr
let sub t ~off ~len = Slice.sub t ~off ~len
let shift t n = Slice.shift t n
let is_empty t = Slice.is_empty t
let sub_string { Slice.buf; off; _ } ~off:off' ~len =
let dst = Bytes.create len in
S.blit_to_bytes buf ~src_off:(off + off') dst ~dst_off:0 ~len;
Bytes.unsafe_to_string dst
let to_string { Slice.buf; off= src_off; len } =
let dst = Bytes.create len in
S.blit_to_bytes buf ~src_off dst ~dst_off:0 ~len;
Bytes.unsafe_to_string dst
let of_string str =
let off = 0 and len = String.length str in
Slice.unsafe_make ~off ~len (S.of_string str)
let string ?(off= 0) ?len str =
let len = match len with
| None -> String.length str - off
| Some len -> len in
Slice.unsafe_make ~off:0 ~len (S.string ~off ~len str)
let overlap ({ buf= buf0; _ } as a) ({ buf= buf1; _ } as b) =
match S.overlap buf0 buf1 with
| None -> None
| Some (_, 0, 0) ->
let len =
max 0 (min (a.off + a.len) (b.off + b.len)) - max a.off b.off in
if a.off >= b.off && a.off < b.off + b.len
then
let offset = a.off - b.off in Some (len, 0, offset)
else if b.off >= a.off && b.off < a.off + a.len
then
let offset = b.off + a.off in Some (len, offset, 0)
else None
| Some _ ->
let a = S.sub buf0 ~off:a.off ~len:a.len
and b = S.sub buf1 ~off:b.off ~len:b.len in
S.overlap a b
(* TODO(dinosaure): this case appears only for bigstrings, but we could
optimize it and avoid [S.sub]. *)

View file

@ -0,0 +1,175 @@
type 'buf t = private { buf: 'buf; off: int; len: int }
val unsafe_make : off:int -> len:int -> 'buf -> 'buf t
val pp : Format.formatter -> 'a t -> unit
val length : 'a t -> int
val sub : 'a t -> off:int -> len:int -> 'a t
val shift : 'a t -> int -> 'a t
val is_empty : 'a t -> bool
module type R = sig
type t
val make : int -> char -> t
(** [make len chr] is {!type:t} of length [len] with each index holding the
character [chr]. *)
val init : int -> (int -> char) -> t
(** [init len fn] is {!type:t} of length [len] with index [idx] holding the
character [fn idx] (called in increasing index order). *)
val empty : t
(** An empty {!type:t}. *)
val length : t -> int
(** [length t] is the length (number of bytes/characters) of [t]. *)
val is_empty : t -> bool
(** [is_empty t] is [length t = 0]. *)
val chop : ?rev:bool -> t -> char option
(** [chop t] is [Some (get t idx)] with [idx = 0] if [rev = false] (default)
or [idx = length t - 1] if [rev = true]. [None] is returned if [t] is
empty. *)
val hash : t -> int
val equal : t -> t -> bool
val compare : t -> t -> int
val get : t -> int -> char
val unsafe_get : t -> int -> char
val get_int8 : t -> int -> int
(** [get_int8 bstr i] is [bstr]'s signed 8-bit integer starting at byte index
[i]. *)
val get_uint8 : t -> int -> int
(** [get_uint8 bstr i] is [bstr]'s unsigned 8-bit integer starting at byte
index [i]. *)
val get_uint16_ne : t -> int -> int
(** [get_int16_ne bstr i] is [bstr]'s native-endian unsigned 16-bit integer
starting at byte index [i]. *)
val get_uint16_le : t -> int -> int
(** [get_int16_le bstr i] is [bstr]'s little-endian unsigned 16-bit integer
starting at byte index [i]. *)
val get_uint16_be : t -> int -> int
(** [get_int16_be bstr i] is [bstr]'s big-endian unsigned 16-bit integer
starting at byte index [i]. *)
val get_int16_ne : t -> int -> int
(** [get_int16_ne bstr i] is [bstr]'s native-endian signed 16-bit integer
starting at byte index [i]. *)
val get_int16_le : t -> int -> int
(** [get_int16_le bstr i] is [bstr]'s little-endian signed 16-bit integer
starting at byte index [i]. *)
val get_int16_be : t -> int -> int
(** [get_int16_be bstr i] is [bstr]'s big-endian signed 16-bit integer
starting at byte index [i]. *)
val get_int32_ne : t -> int -> int32
(** [get_int32_ne bstr i] is [bstr]'s native-endian 32-bit integer starting at
byte index [i]. *)
val get_int32_le : t -> int -> int32
(** [get_int32_le bstr i] is [bstr]'s little-endian 32-bit integer starting at
byte index [i]. *)
val get_int32_be : t -> int -> int32
(** [get_int32_be bstr i] is [bstr]'s big-endian 32-bit integer starting at
byte index [i]. *)
val get_int64_ne : t -> int -> int64
(** [get_int64_ne bstr i] is [bstr]'s native-endian 64-bit integer starting at
byte index [i]. *)
val get_int64_le : t -> int -> int64
(** [get_int64_le bstr i] is [bstr]'s little-endian 64-bit integer starting at
byte index [i]. *)
val get_int64_be : t -> int -> int64
(** [get_int64_be bstr i] is [bstr]'s big-endian 64-bit integer starting at
byte index [i]. *)
val filter : (char -> bool) -> t -> t
(** [filter sat t] is a new {!type:t} made of the bytes of [t] that satisfy
[sat], in the same order. *)
val filter_map : (char -> char option) -> t -> t
(** [filter_map fn t] is a new {!type:t} made of the bytes of [t] as mapped by
[fn], in the same order. *)
val map : (char -> char) -> t -> t
val mapi : (int -> char -> char) -> t -> t
val fold_left : ('a -> char -> 'a) -> 'a -> t -> 'a
val fold_right : (char -> 'a -> 'a) -> t -> 'a -> 'a
val iter : (char -> unit) -> t -> unit
val iteri : (int -> char -> unit) -> t -> unit
val hex : t -> string
val overlap : t -> t -> (int * int * int) option
val append : t -> t -> t
val starts_with : prefix:string -> t -> bool
val is_prefix : affix:string -> t -> bool
(** [is_prefix ~affix bstr] is [true] iff [affix.[idx] = bstr.{idx}] for all
indices [idx] of [affix]. *)
val ends_with : suffix:string -> t -> bool
val is_suffix : affix:string -> t -> bool
(** [is_suffix ~affix bstr] is [true] iff [affix.[n - idx] = bstr.{m - idx}]
for all indices [idx] of [affix] with [n = String.length affix - 1] and
[m = length bstr - 1]. *)
val is_infix : affix:string -> t -> bool
(** [is_infix ~affix bstr] is [true] iff there exists an index [j] in [bstr]
such that for all indices [i] of [affix] we have
[affix.[i] = bstr.{j + i}]. *)
val for_all : (char -> bool) -> t -> bool
val exists : (char -> bool) -> t -> bool
val trim : ?drop:(char -> bool) -> t -> t
val span :
?rev:bool -> ?min:int -> ?max:int -> ?sat:(char -> bool) -> t -> t * t
val take : ?rev:bool -> ?min:int -> ?max:int -> ?sat:(char -> bool) -> t -> t
val drop : ?rev:bool -> ?min:int -> ?max:int -> ?sat:(char -> bool) -> t -> t
val shift : t -> int -> t
val sub : t -> off:int -> len:int -> t
val split_on_char : char -> t -> t list
val cut : ?rev:bool -> sep:string -> t -> (t * t) option
val cuts : ?rev:bool -> ?empty:bool -> sep:string -> t -> t list
val index : t -> ?rev:bool -> ?from:int -> char -> int
val contains : t -> ?rev:bool -> ?from:int -> char -> bool
val concat : t -> t list -> t
val copy : t -> t
val sub_string : t -> off:int -> len:int -> string
val to_string : t -> string
end
module type W = sig
type t
val set : t -> int -> char -> unit
val unsafe_set : t -> int -> char -> unit
val set_int8 : t -> int -> int -> unit
val set_uint8 : t -> int -> int -> unit
val set_uint16_ne : t -> int -> int -> unit
val set_uint16_le : t -> int -> int -> unit
val set_uint16_be : t -> int -> int -> unit
val set_int16_ne : t -> int -> int -> unit
val set_int16_le : t -> int -> int -> unit
val set_int16_be : t -> int -> int -> unit
val set_int32_ne : t -> int -> int32 -> unit
val set_int32_le : t -> int -> int32 -> unit
val set_int32_be : t -> int -> int32 -> unit
val set_int64_ne : t -> int -> int64 -> unit
val set_int64_le : t -> int -> int64 -> unit
val set_int64_be : t -> int -> int64 -> unit
val fill : t -> off:int -> len:int -> char -> unit
val blit : t -> src_off:int -> t -> dst_off:int -> len:int -> unit
end

View file

@ -0,0 +1,202 @@
type t = Bstr.t Slice.t
val make : ?off:int -> ?len:int -> Bstr.t -> t
val empty : t
(** [empty] is an empty slice. *)
val length : t -> int
(** [length slice] is the number of bytes in [slice]. *)
val get : t -> int -> char
(** [get slice i] is the byte of [slice]' at index [i].
@raise Invalid_argument if [i] is not an index of [slice]. *)
val get_int8 : t -> int -> int
(** [get_int8 slice i] is [slice]'s signed 8-bit integer starting at byte index
[i]. *)
val get_uint8 : t -> int -> int
(** [get_uint8 slice i] is [slice]'s unsigned 8-bit integer starting at byte
index [i]. *)
val get_uint16_ne : t -> int -> int
(** [get_int16_ne slice i] is [slice]'s native-endian unsigned 16-bit integer
starting at byte index [i]. *)
val get_uint16_le : t -> int -> int
(** [get_int16_le slice i] is [slice]'s little-endian unsigned 16-bit integer
starting at byte index [i]. *)
val get_uint16_be : t -> int -> int
(** [get_int16_be slice i] is [slice]'s big-endian unsigned 16-bit integer
starting at byte index [i]. *)
val get_int16_ne : t -> int -> int
(** [get_int16_ne slice i] is [slice]'s native-endian signed 16-bit integer
starting at byte index [i]. *)
val get_int16_le : t -> int -> int
(** [get_int16_le slice i] is [slice]'s little-endian signed 16-bit integer
starting at byte index [i]. *)
val get_int16_be : t -> int -> int
(** [get_int16_be slice i] is [slice]'s big-endian signed 16-bit integer
starting at byte index [i]. *)
val get_int32_ne : t -> int -> int32
(** [get_int32_ne slice i] is [slice]'s native-endian 32-bit integer starting at
byte index [i]. *)
val get_int32_le : t -> int -> int32
(** [get_int32_le slice i] is [slice]'s little-endian 32-bit integer starting at
byte index [i]. *)
val get_int32_be : t -> int -> int32
(** [get_int32_be slice i] is [slice]'s big-endian 32-bit integer starting at
byte index [i]. *)
val get_int64_ne : t -> int -> int64
(** [get_int64_ne slice i] is [slice]'s native-endian 64-bit integer starting at
byte index [i]. *)
val get_int64_le : t -> int -> int64
(** [get_int64_le slice i] is [slice]'s little-endian 64-bit integer starting at
byte index [i]. *)
val get_int64_be : t -> int -> int64
(** [get_int64_be slice i] is [slice]'s big-endian 64-bit integer starting at
byte index [i]. *)
val set : t -> int -> char -> unit
(** [set t i chr] modifies [t] in place, replacing the byte at index [i] with
[chr].
@raise Invalid_argument if [i] is not a valid index in [t]. *)
val set_int8 : t -> int -> int -> unit
(** [set_int8 t i v] sets [t]'s signed 8-bit integer starting at byte index [i]
to [v]. *)
val set_uint8 : t -> int -> int -> unit
(** [set_uint8 t i v] sets [t]'s unsigned 8-bit integer starting at byte index
[i] to [v]. *)
val set_uint16_ne : t -> int -> int -> unit
(** [set_uint16_ne t i v] sets [t]'s native-endian unsigned 16-bit integer
starting at byte index [i] to [v]. *)
val set_uint16_le : t -> int -> int -> unit
(** [set_uint16_le t i v] sets [t]'s little-endian unsigned 16-bit integer
starting at byte index [i] to [v]. *)
val set_uint16_be : t -> int -> int -> unit
(** [set_uint16_le t i v] sets [t]'s big-endian unsigned 16-bit integer starting
at byte index [i] to [v]. *)
val set_int16_ne : t -> int -> int -> unit
(** [set_uint16_ne t i v] sets [t]'s native-endian signed 16-bit integer
starting at byte index [i] to [v]. *)
val set_int16_le : t -> int -> int -> unit
(** [set_uint16_le t i v] sets [t]'s little-endian signed 16-bit integer
starting at byte index [i] to [v]. *)
val set_int16_be : t -> int -> int -> unit
(** [set_uint16_le t i v] sets [t]'s big-endian signed 16-bit integer starting
at byte index [i] to [v]. *)
val set_int32_ne : t -> int -> int32 -> unit
(** [set_int32_ne t i v] sets [t]'s native-endian 32-bit integer starting at
byte index [i] to [v]. *)
val set_int32_le : t -> int -> int32 -> unit
(** [set_int32_ne t i v] sets [t]'s little-endian 32-bit integer starting at
byte index [i] to [v]. *)
val set_int32_be : t -> int -> int32 -> unit
(** [set_int32_ne t i v] sets [t]'s big-endian 32-bit integer starting at byte
index [i] to [v]. *)
val set_int64_ne : t -> int -> int64 -> unit
(** [set_int32_ne t i v] sets [t]'s native-endian 64-bit integer starting at
byte index [i] to [v]. *)
val set_int64_le : t -> int -> int64 -> unit
(** [set_int32_ne t i v] sets [t]'s little-endian 64-bit integer starting at
byte index [i] to [v]. *)
val set_int64_be : t -> int -> int64 -> unit
(** [set_int32_ne t i v] sets [t]'s big-endian 64-bit integer starting at byte
index [i] to [v]. *)
val blit : t -> t -> unit
(** [blit src dst] copies all bytes of [src] into [dst]. *)
val blit_from_bytes : bytes -> src_off:int -> t -> ?dst_off:int -> int -> unit
(** [blit_from_bytes src ~src_off dst ~dst_off ~len] copies [len] bytes from
byte sequence [src], starting at index [src_off], to slice [dst], starting
at index [dst_off].
@raise Invalid_argument
if [src_off] and [len] do not designate a valid range of [src], or if
[dst_off] and [len] do not designate a valid range of [dst]. *)
val blit_to_bytes : t -> ?src_off:int -> bytes -> dst_off:int -> len:int -> unit
(** Just like {!val:blit_from_bytes}, but the source is a slice and the
destination is a [byte]s sequence.
@raise Invalid_argument
if [src_off] and [len] do not designate a valid range of [src], or if
[dst_off] and [len] do not designate a valid range of [dst]. *)
val fill : t -> ?off:int -> ?len:int -> char -> unit
(** [fill t off len chr] modifies [t] in place, replacing [len] characters with
[chr], starting at [off].
@raise Invalid_argument
if [off] and [len] do not designate a valid range of [t]. *)
val sub : t -> off:int -> len:int -> t
(** [sub slice ~off ~len] does not allocate a new [bigstring], but instead
returns a new view into [t.buf] starting at [off], and with length [len].
{b Note} that this does not allocate a new buffer, but instead shares the
buffer of [t.buf] with the newly-returned slice. *)
val shift : t -> int -> t
(** [shift slice n] is [sub slice n (length slice - n)] (see {!val:sub} for more
details). *)
val sub_string : t -> off:int -> len:int -> string
(** [sub_string slice ~off ~len] returns a string of length [len] containing the
bytes of [slice] starting at [off].
@raise Invalid_argument
if [off] and [len] do not designate a valid range of [t]. *)
val to_string : t -> string
(** [to_string slice] is equivalent to
[sub_string slice ~off:0 ~len:(length slice)]. *)
val is_empty : t -> bool
(** [is_empty bstr] is [length bstr = 0]. *)
val of_string : string -> t
(** [of_string str] returns a new {!type:t} that contains the contents of the
given string [str]. *)
val string : ?off:int -> ?len:int -> string -> t
(** [string ~off ~len str] is the sub-buffer of [str] that starts at position
[off] (defaults to [0]) and stops at position [off + len] (defaults to
[String.length str]). [str] is fully-replaced by a fresh allocated
{!type:t}.
@raise Invalid_argument
if [off] and [len] do not designate a valid range of [str]. *)
val overlap : t -> t -> (int * int * int) option
(** [overlap x y] returns the size (in bytes) of what is physically common
between [x] and [y], as well as the position of [y] in [x] and the position
of [x] in [y]. *)

View file

@ -0,0 +1,196 @@
type t = bytes Slice.t
val make : ?off:int -> ?len:int -> bytes -> t
val empty : t
(** [empty] is an empty slice. *)
val length : t -> int
(** [length slice] is the number of bytes in [slice]. *)
val get : t -> int -> char
(** [get slice i] is the byte of [slice]' at index [i].
@raise Invalid_argument if [i] is not an index of [slice]. *)
val get_int8 : t -> int -> int
(** [get_int8 slice i] is [slice]'s signed 8-bit integer starting at byte index
[i]. *)
val get_uint8 : t -> int -> int
(** [get_uint8 slice i] is [slice]'s unsigned 8-bit integer starting at byte
index [i]. *)
val get_uint16_ne : t -> int -> int
(** [get_int16_ne slice i] is [slice]'s native-endian unsigned 16-bit integer
starting at byte index [i]. *)
val get_uint16_le : t -> int -> int
(** [get_int16_le slice i] is [slice]'s little-endian unsigned 16-bit integer
starting at byte index [i]. *)
val get_uint16_be : t -> int -> int
(** [get_int16_be slice i] is [slice]'s big-endian unsigned 16-bit integer
starting at byte index [i]. *)
val get_int16_ne : t -> int -> int
(** [get_int16_ne slice i] is [slice]'s native-endian signed 16-bit integer
starting at byte index [i]. *)
val get_int16_le : t -> int -> int
(** [get_int16_le slice i] is [slice]'s little-endian signed 16-bit integer
starting at byte index [i]. *)
val get_int16_be : t -> int -> int
(** [get_int16_be slice i] is [slice]'s big-endian signed 16-bit integer
starting at byte index [i]. *)
val get_int32_ne : t -> int -> int32
(** [get_int32_ne slice i] is [slice]'s native-endian 32-bit integer starting at
byte index [i]. *)
val get_int32_le : t -> int -> int32
(** [get_int32_le slice i] is [slice]'s little-endian 32-bit integer starting at
byte index [i]. *)
val get_int32_be : t -> int -> int32
(** [get_int32_be slice i] is [slice]'s big-endian 32-bit integer starting at
byte index [i]. *)
val get_int64_ne : t -> int -> int64
(** [get_int64_ne slice i] is [slice]'s native-endian 64-bit integer starting at
byte index [i]. *)
val get_int64_le : t -> int -> int64
(** [get_int64_le slice i] is [slice]'s little-endian 64-bit integer starting at
byte index [i]. *)
val get_int64_be : t -> int -> int64
(** [get_int64_be slice i] is [slice]'s big-endian 64-bit integer starting at
byte index [i]. *)
val set : t -> int -> char -> unit
(** [set t i chr] modifies [t] in place, replacing the byte at index [i] with
[chr].
@raise Invalid_argument if [i] is not a valid index in [t]. *)
val set_int8 : t -> int -> int -> unit
(** [set_int8 t i v] sets [t]'s signed 8-bit integer starting at byte index [i]
to [v]. *)
val set_uint8 : t -> int -> int -> unit
(** [set_uint8 t i v] sets [t]'s unsigned 8-bit integer starting at byte index
[i] to [v]. *)
val set_uint16_ne : t -> int -> int -> unit
(** [set_uint16_ne t i v] sets [t]'s native-endian unsigned 16-bit integer
starting at byte index [i] to [v]. *)
val set_uint16_le : t -> int -> int -> unit
(** [set_uint16_le t i v] sets [t]'s little-endian unsigned 16-bit integer
starting at byte index [i] to [v]. *)
val set_uint16_be : t -> int -> int -> unit
(** [set_uint16_le t i v] sets [t]'s big-endian unsigned 16-bit integer starting
at byte index [i] to [v]. *)
val set_int16_ne : t -> int -> int -> unit
(** [set_uint16_ne t i v] sets [t]'s native-endian signed 16-bit integer
starting at byte index [i] to [v]. *)
val set_int16_le : t -> int -> int -> unit
(** [set_uint16_le t i v] sets [t]'s little-endian signed 16-bit integer
starting at byte index [i] to [v]. *)
val set_int16_be : t -> int -> int -> unit
(** [set_uint16_le t i v] sets [t]'s big-endian signed 16-bit integer starting
at byte index [i] to [v]. *)
val set_int32_ne : t -> int -> int32 -> unit
(** [set_int32_ne t i v] sets [t]'s native-endian 32-bit integer starting at
byte index [i] to [v]. *)
val set_int32_le : t -> int -> int32 -> unit
(** [set_int32_ne t i v] sets [t]'s little-endian 32-bit integer starting at
byte index [i] to [v]. *)
val set_int32_be : t -> int -> int32 -> unit
(** [set_int32_ne t i v] sets [t]'s big-endian 32-bit integer starting at byte
index [i] to [v]. *)
val set_int64_ne : t -> int -> int64 -> unit
(** [set_int32_ne t i v] sets [t]'s native-endian 64-bit integer starting at
byte index [i] to [v]. *)
val set_int64_le : t -> int -> int64 -> unit
(** [set_int32_ne t i v] sets [t]'s little-endian 64-bit integer starting at
byte index [i] to [v]. *)
val set_int64_be : t -> int -> int64 -> unit
(** [set_int32_ne t i v] sets [t]'s big-endian 64-bit integer starting at byte
index [i] to [v]. *)
val blit : t -> t -> unit
(** [blit src dst] copies all bytes of [src] into [dst]. *)
val blit_from_bytes : bytes -> src_off:int -> t -> ?dst_off:int -> int -> unit
(** [blit_from_bytes src ~src_off dst ~dst_off ~len] copies [len] bytes from
byte sequence [src], starting at index [src_off], to slice [dst], starting
at index [dst_off].
@raise Invalid_argument
if [src_off] and [len] do not designate a valid range of [src], or if
[dst_off] and [len] do not designate a valid range of [dst]. *)
val blit_to_bytes : t -> ?src_off:int -> bytes -> dst_off:int -> len:int -> unit
(** Just like {!val:blit_from_bytes}, but the source is a slice and the
destination is a [byte]s sequence.
@raise Invalid_argument
if [src_off] and [len] do not designate a valid range of [src], or if
[dst_off] and [len] do not designate a valid range of [dst]. *)
val fill : t -> ?off:int -> ?len:int -> char -> unit
(** [fill t off len chr] modifies [t] in place, replacing [len] characters with
[chr], starting at [off].
@raise Invalid_argument
if [off] and [len] do not designate a valid range of [t]. *)
val sub : t -> off:int -> len:int -> t
(** [sub slice ~off ~len] does not allocate a new [bytes], but instead returns a
new view into [t.buf] starting at [off], and with length [len].
{b Note} that this does not allocate a new buffer, but instead shares the
buffer of [t.buf] with the newly-returned slice. *)
val shift : t -> int -> t
(** [shift slice n] is [sub slice n (length slice - n)] (see {!val:sub} for more
details). *)
val sub_string : t -> off:int -> len:int -> string
(** [sub_string slice ~off ~len] returns a string of length [len] containing the
bytes of [slice] starting at [off]. *)
val to_string : t -> string
(** [to_string slice] is equivalent to
[sub_string slice ~off:0 ~len:(length slice)]. *)
val is_empty : t -> bool
(** [is_empty bstr] is [length bstr = 0]. *)
val of_string : string -> t
(** [of_string str] returns a new {!type:t} that contains the contents of the
given string [str]. *)
val string : ?off:int -> ?len:int -> string -> t
(** [string ~off ~len str] is the sub-buffer of [str] that starts at position
[off] (defaults to [0]) and stops at position [off + len] (defaults to
[String.length str]). [str] is fully-replaced by a fresh allocated
{!type:t}. *)
val overlap : t -> t -> (int * int * int) option
(** [overlap x y] returns the size (in bytes) of what is physically common
between [x] and [y], as well as the position of [y] in [x] and the position
of [x] in [y]. *)