b6449cae87
* `lib_stdlib`: basic extended OCaml stdlib and generic data structures * `lib_data_encoding`: almost independant 'Data_encoding' * `lib_error_monad`: almost independant 'Error_monad' * `lib_stdlib_lwt`: extended Lwt library * `lib_crypto`: all the crypto stuff (hashing, signing, cryptobox). * `lib_base`: - basic type definitions (Block_header, Operation, ...) - a module `TzPervasives` to bind them all and to be the single module opened everywhere. In the process, I splitted `Tezos_data` and `Hash` in multiple submodules, thus removing a lot of `-open`. The following two modules may not have found their place yet: - Base58 (currently in `lib_crypto`) - Cli_entries (currently in `lib_stdlib_lwt`)
102 lines
3.2 KiB
OCaml
102 lines
3.2 KiB
OCaml
(**************************************************************************)
|
|
(* *)
|
|
(* Copyright (c) 2014 - 2017. *)
|
|
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
|
|
(* *)
|
|
(* All rights reserved. No warranty, explicit or implicit, provided. *)
|
|
(* *)
|
|
(**************************************************************************)
|
|
|
|
open Bigarray
|
|
|
|
type t = (char, int8_unsigned_elt, c_layout) Array1.t
|
|
|
|
let create sz = Array1.create char c_layout sz
|
|
let length = Array1.dim
|
|
let sub = Array1.sub
|
|
let shift ba off = sub ba off (length ba - off)
|
|
let blit src srcoff dst dstoff len =
|
|
Array1.blit (sub src srcoff len) (sub dst dstoff len)
|
|
let copy ba =
|
|
let ba' = create (Array1.dim ba) in
|
|
Array1.blit ba ba';
|
|
ba'
|
|
|
|
(** Adapted from ocaml-cstruct. *)
|
|
|
|
external unsafe_blit_string_to_bigstring
|
|
: string -> int -> t -> int -> int -> unit
|
|
= "caml_blit_string_to_bigstring" [@@noalloc]
|
|
|
|
external unsafe_blit_bigstring_to_bytes
|
|
: t -> int -> bytes -> int -> int -> unit
|
|
= "caml_blit_bigstring_to_string" [@@noalloc]
|
|
|
|
(** HACK: force Cstruct at link which provides the previous primitives. *)
|
|
let _dummy = Cstruct.byte_to_int
|
|
|
|
let invalid_bounds j l =
|
|
invalid_arg (Printf.sprintf "invalid bounds (index %d, length %d)" j l)
|
|
|
|
let blit_from_string src srcoff dst dstoff len =
|
|
if len < 0 || srcoff < 0 || dstoff < 0 || String.length src - srcoff < len then
|
|
raise (Invalid_argument (invalid_bounds srcoff len));
|
|
if length dst - dstoff < len then
|
|
raise (Invalid_argument (invalid_bounds dstoff len));
|
|
unsafe_blit_string_to_bigstring src srcoff dst dstoff len
|
|
|
|
let blit_to_bytes src srcoff dst dstoff len =
|
|
if len < 0 || srcoff < 0 || dstoff < 0 || length src - srcoff < len then
|
|
raise (Invalid_argument (invalid_bounds srcoff len));
|
|
if Bytes.length dst - dstoff < len then
|
|
raise (Invalid_argument (invalid_bounds dstoff len));
|
|
unsafe_blit_bigstring_to_bytes src srcoff dst dstoff len
|
|
|
|
let to_string buf =
|
|
let sz = length buf in
|
|
let s = Bytes.create sz in
|
|
unsafe_blit_bigstring_to_bytes buf 0 s 0 sz;
|
|
Bytes.unsafe_to_string s
|
|
|
|
let of_string buf =
|
|
let buflen = String.length buf in
|
|
let c = create buflen in
|
|
unsafe_blit_string_to_bigstring buf 0 c 0 buflen;
|
|
c
|
|
|
|
let substring src srcoff len =
|
|
if len < 0 || srcoff < 0 || length src - srcoff < len then
|
|
raise (Invalid_argument (invalid_bounds srcoff len));
|
|
let s = Bytes.create len in
|
|
unsafe_blit_bigstring_to_bytes src srcoff s 0 len;
|
|
Bytes.unsafe_to_string s
|
|
|
|
include EndianBigstring.BigEndian
|
|
|
|
let of_float f =
|
|
let buf = create 8 in
|
|
set_float buf 0 f;
|
|
buf
|
|
|
|
module LE = struct
|
|
include EndianBigstring.LittleEndian
|
|
end
|
|
|
|
|
|
let (=) = ((=) : t -> t -> bool)
|
|
let (<>) = ((<>) : t -> t -> bool)
|
|
let (<) = ((<) : t -> t -> bool)
|
|
let (<=) = ((<=) : t -> t -> bool)
|
|
let (>=) = ((>=) : t -> t -> bool)
|
|
let (>) = ((>) : t -> t -> bool)
|
|
let compare = Pervasives.compare
|
|
|
|
let concat b1 b2 =
|
|
let l1 = length b1 in
|
|
let l2 = length b2 in
|
|
let b = create (l1 + l2) in
|
|
blit b1 0 b 0 l1 ;
|
|
blit b2 0 b l1 l2 ;
|
|
b
|
|
|