1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
|
(* Unison file synchronizer: src/bytearray.ml *)
(* Copyright 1999-2010, Benjamin C. Pierce
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>.
*)
open Bigarray
type t = (char, int8_unsigned_elt, c_layout) Array1.t
let length = Bigarray.Array1.dim
let create l = Bigarray.Array1.create Bigarray.char Bigarray.c_layout l
(*
let unsafe_blit_from_string s i a j l =
for k = 0 to l - 1 do
a.{j + k} <- s.[i + k]
done
let unsafe_blit_to_string a i s j l =
for k = 0 to l - 1 do
s.[j + k] <- a.{i + k}
done
*)
external unsafe_blit_from_bytes : bytes -> int -> t -> int -> int -> unit
= "ml_blit_string_to_bigarray" "noalloc"
external unsafe_blit_to_bytes : t -> int -> bytes -> int -> int -> unit
= "ml_blit_bigarray_to_string" "noalloc"
let to_string a =
let l = length a in
if l > Sys.max_string_length then invalid_arg "Bytearray.to_bytes" else
let s = Bytes.create l in
unsafe_blit_to_bytes a 0 s 0 l;
s
let of_string s =
let l = String.length s in
let a = create l in
unsafe_blit_from_bytes (Bytes.of_string s) 0 a 0 l;
a
let sub a ofs len =
if
ofs < 0 || len < 0 || ofs > length a - len || len > Sys.max_string_length
then
invalid_arg "Bytearray.sub"
else begin
let s = Bytes.create len in
unsafe_blit_to_bytes a ofs s 0 len;
s
end
let rec prefix_rec a i a' i' l =
l = 0 ||
(a.{i} = a'.{i'} && prefix_rec a (i + 1) a' (i' + 1) (l - 1))
let prefix a a' i =
let l = length a in
let l' = length a' in
i <= l' - l &&
prefix_rec a 0 a' i l
let blit_from_bytes s i a j l =
if l < 0 || i < 0 || i > Bytes.length s - l
|| j < 0 || j > length a - l
then invalid_arg "Bytearray.blit_from_string"
else unsafe_blit_from_bytes s i a j l
let blit_to_bytes a i s j l =
if l < 0 || i < 0 || i > length a - l
|| j < 0 || j > Bytes.length s - l
then invalid_arg "Bytearray.blit_to_string"
else unsafe_blit_to_bytes a i s j l
external marshal : 'a -> Marshal.extern_flags list -> t
= "ml_marshal_to_bigarray"
external marshal_to_buffer : t -> int -> 'a -> Marshal.extern_flags list -> int
= "ml_marshal_to_bigarray_buffer"
external unmarshal : t -> int -> 'a
= "ml_unmarshal_from_bigarray"
|
