forked from colinbenner/ocaml-llvm
-
Notifications
You must be signed in to change notification settings - Fork 16
/
bigarray.ml
251 lines (230 loc) · 9.93 KB
/
bigarray.ml
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
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
(***********************************************************************)
(* *)
(* OCaml *)
(* *)
(* Manuel Serrano et Xavier Leroy, INRIA Rocquencourt *)
(* *)
(* Copyright 2000 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../../LICENSE. *)
(* *)
(***********************************************************************)
(* Module [Bigarray]: large, multi-dimensional, numerical arrays *)
external init : unit -> unit = "caml_ba_init"
let _ = init()
type ('a, 'b) kind = int
type int8_signed_elt
type int8_unsigned_elt
type int16_signed_elt
type int16_unsigned_elt
type int_elt
type int32_elt
type int64_elt
type nativeint_elt
type float32_elt
type float64_elt
type complex32_elt
type complex64_elt
(* Keep those constants in sync with the caml_ba_kind enumeration
in bigarray.h *)
let float32 = 0
let float64 = 1
let int8_signed = 2
let int8_unsigned = 3
let int16_signed = 4
let int16_unsigned = 5
let int32 = 6
let int64 = 7
let int = 8
let nativeint = 9
let char = int8_unsigned
let complex32 = 10
let complex64 = 11
type 'a layout = int
type c_layout
type fortran_layout
(* Keep those constants in sync with the caml_ba_layout enumeration
in bigarray.h *)
let c_layout = 0
let fortran_layout = 0x100
module Genarray = struct
type ('a, 'b, 'c) t
external create: ('a, 'b) kind -> 'c layout -> int array -> ('a, 'b, 'c) t
= "caml_ba_create"
external get: ('a, 'b, 'c) t -> int array -> 'a
= "caml_ba_get_generic"
external set: ('a, 'b, 'c) t -> int array -> 'a -> unit
= "caml_ba_set_generic"
external num_dims: ('a, 'b, 'c) t -> int = "caml_ba_num_dims"
external nth_dim: ('a, 'b, 'c) t -> int -> int = "caml_ba_dim"
let dims a =
let n = num_dims a in
let d = Array.make n 0 in
for i = 0 to n-1 do d.(i) <- nth_dim a i done;
d
external kind: ('a, 'b, 'c) t -> ('a, 'b) kind = "caml_ba_kind"
external layout: ('a, 'b, 'c) t -> 'c layout = "caml_ba_layout"
external sub_left: ('a, 'b, c_layout) t -> int -> int -> ('a, 'b, c_layout) t
= "caml_ba_sub"
external sub_right: ('a, 'b, fortran_layout) t -> int -> int ->
('a, 'b, fortran_layout) t
= "caml_ba_sub"
external slice_left: ('a, 'b, c_layout) t -> int array ->
('a, 'b, c_layout) t
= "caml_ba_slice"
external slice_right: ('a, 'b, fortran_layout) t -> int array ->
('a, 'b, fortran_layout) t
= "caml_ba_slice"
external blit: ('a, 'b, 'c) t -> ('a, 'b, 'c) t -> unit
= "caml_ba_blit"
external fill: ('a, 'b, 'c) t -> 'a -> unit = "caml_ba_fill"
external map_internal: Unix.file_descr -> ('a, 'b) kind -> 'c layout ->
bool -> int array -> int64 -> ('a, 'b, 'c) t
= "caml_ba_map_file_bytecode" "caml_ba_map_file"
let map_file fd ?(pos = 0L) kind layout shared dims =
map_internal fd kind layout shared dims pos
end
module Array1 = struct
type ('a, 'b, 'c) t = ('a, 'b, 'c) Genarray.t
let create kind layout dim =
Genarray.create kind layout [|dim|]
external get: ('a, 'b, 'c) t -> int -> 'a = "%caml_ba_ref_1"
external set: ('a, 'b, 'c) t -> int -> 'a -> unit = "%caml_ba_set_1"
external unsafe_get: ('a, 'b, 'c) t -> int -> 'a = "%caml_ba_unsafe_ref_1"
external unsafe_set: ('a, 'b, 'c) t -> int -> 'a -> unit = "%caml_ba_unsafe_set_1"
external dim: ('a, 'b, 'c) t -> int = "%caml_ba_dim_1"
external kind: ('a, 'b, 'c) t -> ('a, 'b) kind = "caml_ba_kind"
external layout: ('a, 'b, 'c) t -> 'c layout = "caml_ba_layout"
external sub: ('a, 'b, 'c) t -> int -> int -> ('a, 'b, 'c) t = "caml_ba_sub"
external blit: ('a, 'b, 'c) t -> ('a, 'b, 'c) t -> unit = "caml_ba_blit"
external fill: ('a, 'b, 'c) t -> 'a -> unit = "caml_ba_fill"
let of_array kind layout data =
let ba = create kind layout (Array.length data) in
let ofs = if layout = c_layout then 0 else 1 in
for i = 0 to Array.length data - 1 do unsafe_set ba (i + ofs) data.(i) done;
ba
let map_file fd ?pos kind layout shared dim =
Genarray.map_file fd ?pos kind layout shared [|dim|]
end
module Array2 = struct
type ('a, 'b, 'c) t = ('a, 'b, 'c) Genarray.t
let create kind layout dim1 dim2 =
Genarray.create kind layout [|dim1; dim2|]
external get: ('a, 'b, 'c) t -> int -> int -> 'a = "%caml_ba_ref_2"
external set: ('a, 'b, 'c) t -> int -> int -> 'a -> unit = "%caml_ba_set_2"
external unsafe_get: ('a, 'b, 'c) t -> int -> int -> 'a = "%caml_ba_unsafe_ref_2"
external unsafe_set: ('a, 'b, 'c) t -> int -> int -> 'a -> unit = "%caml_ba_unsafe_set_2"
external dim1: ('a, 'b, 'c) t -> int = "%caml_ba_dim_1"
external dim2: ('a, 'b, 'c) t -> int = "%caml_ba_dim_2"
external kind: ('a, 'b, 'c) t -> ('a, 'b) kind = "caml_ba_kind"
external layout: ('a, 'b, 'c) t -> 'c layout = "caml_ba_layout"
external sub_left: ('a, 'b, c_layout) t -> int -> int -> ('a, 'b, c_layout) t
= "caml_ba_sub"
external sub_right:
('a, 'b, fortran_layout) t -> int -> int -> ('a, 'b, fortran_layout) t
= "caml_ba_sub"
let slice_left a n = Genarray.slice_left a [|n|]
let slice_right a n = Genarray.slice_right a [|n|]
external blit: ('a, 'b, 'c) t -> ('a, 'b, 'c) t -> unit = "caml_ba_blit"
external fill: ('a, 'b, 'c) t -> 'a -> unit = "caml_ba_fill"
let of_array kind layout data =
let dim1 = Array.length data in
let dim2 = if dim1 = 0 then 0 else Array.length data.(0) in
let ba = create kind layout dim1 dim2 in
let ofs = if layout = c_layout then 0 else 1 in
for i = 0 to dim1 - 1 do
let row = data.(i) in
if Array.length row <> dim2 then
invalid_arg("Bigarray.Array2.of_array: non-rectangular data");
for j = 0 to dim2 - 1 do
unsafe_set ba (i + ofs) (j + ofs) row.(j)
done
done;
ba
let map_file fd ?pos kind layout shared dim1 dim2 =
Genarray.map_file fd ?pos kind layout shared [|dim1;dim2|]
end
module Array3 = struct
type ('a, 'b, 'c) t = ('a, 'b, 'c) Genarray.t
let create kind layout dim1 dim2 dim3 =
Genarray.create kind layout [|dim1; dim2; dim3|]
external get: ('a, 'b, 'c) t -> int -> int -> int -> 'a = "%caml_ba_ref_3"
external set: ('a, 'b, 'c) t -> int -> int -> int -> 'a -> unit
= "%caml_ba_set_3"
external unsafe_get: ('a, 'b, 'c) t -> int -> int -> int -> 'a = "%caml_ba_unsafe_ref_3"
external unsafe_set: ('a, 'b, 'c) t -> int -> int -> int -> 'a -> unit = "%caml_ba_unsafe_set_3"
external dim1: ('a, 'b, 'c) t -> int = "%caml_ba_dim_1"
external dim2: ('a, 'b, 'c) t -> int = "%caml_ba_dim_2"
external dim3: ('a, 'b, 'c) t -> int = "%caml_ba_dim_3"
external kind: ('a, 'b, 'c) t -> ('a, 'b) kind = "caml_ba_kind"
external layout: ('a, 'b, 'c) t -> 'c layout = "caml_ba_layout"
external sub_left: ('a, 'b, c_layout) t -> int -> int -> ('a, 'b, c_layout) t
= "caml_ba_sub"
external sub_right:
('a, 'b, fortran_layout) t -> int -> int -> ('a, 'b, fortran_layout) t
= "caml_ba_sub"
let slice_left_1 a n m = Genarray.slice_left a [|n; m|]
let slice_right_1 a n m = Genarray.slice_right a [|n; m|]
let slice_left_2 a n = Genarray.slice_left a [|n|]
let slice_right_2 a n = Genarray.slice_right a [|n|]
external blit: ('a, 'b, 'c) t -> ('a, 'b, 'c) t -> unit = "caml_ba_blit"
external fill: ('a, 'b, 'c) t -> 'a -> unit = "caml_ba_fill"
let of_array kind layout data =
let dim1 = Array.length data in
let dim2 = if dim1 = 0 then 0 else Array.length data.(0) in
let dim3 = if dim2 = 0 then 0 else Array.length data.(0).(0) in
let ba = create kind layout dim1 dim2 dim3 in
let ofs = if layout = c_layout then 0 else 1 in
for i = 0 to dim1 - 1 do
let row = data.(i) in
if Array.length row <> dim2 then
invalid_arg("Bigarray.Array3.of_array: non-cubic data");
for j = 0 to dim2 - 1 do
let col = row.(j) in
if Array.length col <> dim3 then
invalid_arg("Bigarray.Array3.of_array: non-cubic data");
for k = 0 to dim3 - 1 do
unsafe_set ba (i + ofs) (j + ofs) (k + ofs) col.(k)
done
done
done;
ba
let map_file fd ?pos kind layout shared dim1 dim2 dim3 =
Genarray.map_file fd ?pos kind layout shared [|dim1;dim2;dim3|]
end
external genarray_of_array1: ('a, 'b, 'c) Array1.t -> ('a, 'b, 'c) Genarray.t
= "%identity"
external genarray_of_array2: ('a, 'b, 'c) Array2.t -> ('a, 'b, 'c) Genarray.t
= "%identity"
external genarray_of_array3: ('a, 'b, 'c) Array3.t -> ('a, 'b, 'c) Genarray.t
= "%identity"
let array1_of_genarray a =
if Genarray.num_dims a = 1 then a
else invalid_arg "Bigarray.array1_of_genarray"
let array2_of_genarray a =
if Genarray.num_dims a = 2 then a
else invalid_arg "Bigarray.array2_of_genarray"
let array3_of_genarray a =
if Genarray.num_dims a = 3 then a
else invalid_arg "Bigarray.array3_of_genarray"
external reshape:
('a, 'b, 'c) Genarray.t -> int array -> ('a, 'b, 'c) Genarray.t
= "caml_ba_reshape"
let reshape_1 a dim1 = reshape a [|dim1|]
let reshape_2 a dim1 dim2 = reshape a [|dim1;dim2|]
let reshape_3 a dim1 dim2 dim3 = reshape a [|dim1;dim2;dim3|]
(* Force caml_ba_get_{1,2,3,N} to be linked in, since we don't refer
to those primitives directly in this file *)
let _ =
let _ = Genarray.get in
let _ = Array1.get in
let _ = Array2.get in
let _ = Array3.get in
()
external get1: unit -> unit = "caml_ba_get_1"
external get2: unit -> unit = "caml_ba_get_2"
external get3: unit -> unit = "caml_ba_get_3"
external set1: unit -> unit = "caml_ba_set_1"
external set2: unit -> unit = "caml_ba_set_2"
external set3: unit -> unit = "caml_ba_set_3"