anil.recoil.org
My working unpac repository
1(**************************************************************************)
2(* *)
3(* OCaml *)
4(* *)
5(* Manuel Serrano et Xavier Leroy, INRIA Rocquencourt *)
6(* *)
7(* Copyright 2000 Institut National de Recherche en Informatique et *)
8(* en Automatique. *)
9(* *)
10(* All rights reserved. This file is distributed under the terms of *)
11(* the GNU Lesser General Public License version 2.1, with the *)
12(* special exception on linking described in the file LICENSE. *)
13(* *)
14(**************************************************************************)
15
16(* Module [Bigarray]: large, multi-dimensional, numerical arrays *)
17
18(* These types in must be kept in sync with the tables in
19 ../typing/typeopt.ml *)
20
21type float16_elt = Float16_elt
22type float32_elt = Float32_elt
23type float64_elt = Float64_elt
24type int8_signed_elt = Int8_signed_elt
25type int8_unsigned_elt = Int8_unsigned_elt
26type int16_signed_elt = Int16_signed_elt
27type int16_unsigned_elt = Int16_unsigned_elt
28type int32_elt = Int32_elt
29type int64_elt = Int64_elt
30type int_elt = Int_elt
31type nativeint_elt = Nativeint_elt
32type complex32_elt = Complex32_elt
33type complex64_elt = Complex64_elt
34
35(* Keep the order of these constructors in sync with the caml_ba_kind
36 enumeration in bigarray.h *)
37
38type ('a, 'b) kind =
39 | Float32 : (float, float32_elt) kind
40 | Float64 : (float, float64_elt) kind
41 | Int8_signed : (int, int8_signed_elt) kind
42 | Int8_unsigned : (int, int8_unsigned_elt) kind
43 | Int16_signed : (int, int16_signed_elt) kind
44 | Int16_unsigned : (int, int16_unsigned_elt) kind
45 | Int32 : (int32, int32_elt) kind
46 | Int64 : (int64, int64_elt) kind
47 | Int : (int, int_elt) kind
48 | Nativeint : (nativeint, nativeint_elt) kind
49 | Complex32 : (Complex.t, complex32_elt) kind
50 | Complex64 : (Complex.t, complex64_elt) kind
51 | Char : (char, int8_unsigned_elt) kind
52 | Float16 : (float, float16_elt) kind
53
54type c_layout = C_layout_typ
55type fortran_layout = Fortran_layout_typ (**)
56
57type 'a layout =
58 C_layout: c_layout layout
59 | Fortran_layout: fortran_layout layout
60
61let float16 = Float16
62let float32 = Float32
63let float64 = Float64
64let int8_signed = Int8_signed
65let int8_unsigned = Int8_unsigned
66let int16_signed = Int16_signed
67let int16_unsigned = Int16_unsigned
68let int32 = Int32
69let int64 = Int64
70let int = Int
71let nativeint = Nativeint
72let complex32 = Complex32
73let complex64 = Complex64
74let char = Char
75
76let kind_size_in_bytes : type a b. (a, b) kind -> int = function
77 | Float16 -> 2
78 | Float32 -> 4
79 | Float64 -> 8
80 | Int8_signed -> 1
81 | Int8_unsigned -> 1
82 | Int16_signed -> 2
83 | Int16_unsigned -> 2
84 | Int32 -> 4
85 | Int64 -> 8
86 | Int -> Sys.word_size / 8
87 | Nativeint -> Sys.word_size / 8
88 | Complex32 -> 8
89 | Complex64 -> 16
90 | Char -> 1
91
92(* Keep those constants in sync with the caml_ba_layout enumeration
93 in bigarray.h *)
94
95let c_layout = C_layout
96let fortran_layout = Fortran_layout
97
98module Genarray = struct
99 type (!'a, !'b, !'c) t
100 external create: ('a, 'b) kind -> 'c layout -> int array -> ('a, 'b, 'c) t
101 = "caml_ba_create"
102 external get: ('a, 'b, 'c) t -> int array -> 'a
103 = "caml_ba_get_generic"
104 external set: ('a, 'b, 'c) t -> int array -> 'a -> unit
105 = "caml_ba_set_generic"
106
107 let rec cloop arr idx f col max =
108 if col = Array.length idx then set arr idx (f idx)
109 else for j = 0 to pred max.(col) do
110 idx.(col) <- j;
111 cloop arr idx f (succ col) max
112 done
113 let rec floop arr idx f col max =
114 if col < 0 then set arr idx (f idx)
115 else for j = 1 to max.(col) do
116 idx.(col) <- j;
117 floop arr idx f (pred col) max
118 done
119 let init (type t) kind (layout : t layout) dims f =
120 let arr = create kind layout dims in
121 let dlen = Array.length dims in
122 match layout with
123 | C_layout -> cloop arr (Array.make dlen 0) f 0 dims; arr
124 | Fortran_layout -> floop arr (Array.make dlen 1) f (pred dlen) dims; arr
125
126 external num_dims: ('a, 'b, 'c) t -> int = "caml_ba_num_dims"
127 external nth_dim: ('a, 'b, 'c) t -> int -> int = "caml_ba_dim"
128 let dims a =
129 let n = num_dims a in
130 let d = Array.make n 0 in
131 for i = 0 to n-1 do d.(i) <- nth_dim a i done;
132 d
133
134 external kind: ('a, 'b, 'c) t -> ('a, 'b) kind = "caml_ba_kind"
135 external layout: ('a, 'b, 'c) t -> 'c layout = "caml_ba_layout"
136 external change_layout: ('a, 'b, 'c) t -> 'd layout -> ('a, 'b, 'd) t
137 = "caml_ba_change_layout"
138
139 let size_in_bytes arr =
140 (kind_size_in_bytes (kind arr)) * (Array.fold_left ( * ) 1 (dims arr))
141
142 external sub_left: ('a, 'b, c_layout) t -> int -> int -> ('a, 'b, c_layout) t
143 = "caml_ba_sub"
144 external sub_right: ('a, 'b, fortran_layout) t -> int -> int ->
145 ('a, 'b, fortran_layout) t
146 = "caml_ba_sub"
147 external slice_left: ('a, 'b, c_layout) t -> int array ->
148 ('a, 'b, c_layout) t
149 = "caml_ba_slice"
150 external slice_right: ('a, 'b, fortran_layout) t -> int array ->
151 ('a, 'b, fortran_layout) t
152 = "caml_ba_slice"
153 external blit: ('a, 'b, 'c) t -> ('a, 'b, 'c) t -> unit
154 = "caml_ba_blit"
155 external fill: ('a, 'b, 'c) t -> 'a -> unit = "caml_ba_fill"
156end
157
158module Array0 = struct
159 type (!'a, !'b, !'c) t = ('a, 'b, 'c) Genarray.t
160 let create kind layout =
161 Genarray.create kind layout [||]
162 let get arr = Genarray.get arr [||]
163 let set arr = Genarray.set arr [||]
164 external kind: ('a, 'b, 'c) t -> ('a, 'b) kind = "caml_ba_kind"
165 external layout: ('a, 'b, 'c) t -> 'c layout = "caml_ba_layout"
166
167 external change_layout: ('a, 'b, 'c) t -> 'd layout -> ('a, 'b, 'd) t
168 = "caml_ba_change_layout"
169
170 let size_in_bytes arr = kind_size_in_bytes (kind arr)
171
172 external blit: ('a, 'b, 'c) t -> ('a, 'b, 'c) t -> unit = "caml_ba_blit"
173 external fill: ('a, 'b, 'c) t -> 'a -> unit = "caml_ba_fill"
174
175 let of_value kind layout v =
176 let a = create kind layout in
177 set a v;
178 a
179 let init = of_value
180end
181
182module Array1 = struct
183 type (!'a, !'b, !'c) t = ('a, 'b, 'c) Genarray.t
184 let create kind layout dim =
185 Genarray.create kind layout [|dim|]
186 external get: ('a, 'b, 'c) t -> int -> 'a = "%caml_ba_ref_1"
187 external set: ('a, 'b, 'c) t -> int -> 'a -> unit = "%caml_ba_set_1"
188 external unsafe_get: ('a, 'b, 'c) t -> int -> 'a = "%caml_ba_unsafe_ref_1"
189 external unsafe_set: ('a, 'b, 'c) t -> int -> 'a -> unit
190 = "%caml_ba_unsafe_set_1"
191 external dim: ('a, 'b, 'c) t -> int = "%caml_ba_dim_1"
192 external kind: ('a, 'b, 'c) t -> ('a, 'b) kind = "caml_ba_kind"
193 external layout: ('a, 'b, 'c) t -> 'c layout = "caml_ba_layout"
194
195 external change_layout: ('a, 'b, 'c) t -> 'd layout -> ('a, 'b, 'd) t
196 = "caml_ba_change_layout"
197
198 let size_in_bytes arr =
199 (kind_size_in_bytes (kind arr)) * (dim arr)
200
201 external sub: ('a, 'b, 'c) t -> int -> int -> ('a, 'b, 'c) t = "caml_ba_sub"
202 let slice (type t) (a : (_, _, t) Genarray.t) n =
203 match layout a with
204 | C_layout -> (Genarray.slice_left a [|n|] : (_, _, t) Genarray.t)
205 | Fortran_layout -> (Genarray.slice_right a [|n|]: (_, _, t) Genarray.t)
206 external blit: ('a, 'b, 'c) t -> ('a, 'b, 'c) t -> unit = "caml_ba_blit"
207 external fill: ('a, 'b, 'c) t -> 'a -> unit = "caml_ba_fill"
208 let c_init arr dim f =
209 for i = 0 to pred dim do unsafe_set arr i (f i) done
210 let fortran_init arr dim f =
211 for i = 1 to dim do unsafe_set arr i (f i) done
212 let init (type t) kind (layout : t layout) dim f =
213 let arr = create kind layout dim in
214 match layout with
215 | C_layout -> c_init arr dim f; arr
216 | Fortran_layout -> fortran_init arr dim f; arr
217 let of_array (type t) kind (layout: t layout) data =
218 let ba = create kind layout (Array.length data) in
219 let ofs =
220 match layout with
221 C_layout -> 0
222 | Fortran_layout -> 1
223 in
224 for i = 0 to Array.length data - 1 do unsafe_set ba (i + ofs) data.(i) done;
225 ba
226end
227
228module Array2 = struct
229 type (!'a, !'b, !'c) t = ('a, 'b, 'c) Genarray.t
230 let create kind layout dim1 dim2 =
231 Genarray.create kind layout [|dim1; dim2|]
232 external get: ('a, 'b, 'c) t -> int -> int -> 'a = "%caml_ba_ref_2"
233 external set: ('a, 'b, 'c) t -> int -> int -> 'a -> unit = "%caml_ba_set_2"
234 external unsafe_get: ('a, 'b, 'c) t -> int -> int -> 'a
235 = "%caml_ba_unsafe_ref_2"
236 external unsafe_set: ('a, 'b, 'c) t -> int -> int -> 'a -> unit
237 = "%caml_ba_unsafe_set_2"
238 external dim1: ('a, 'b, 'c) t -> int = "%caml_ba_dim_1"
239 external dim2: ('a, 'b, 'c) t -> int = "%caml_ba_dim_2"
240 external kind: ('a, 'b, 'c) t -> ('a, 'b) kind = "caml_ba_kind"
241 external layout: ('a, 'b, 'c) t -> 'c layout = "caml_ba_layout"
242
243 external change_layout: ('a, 'b, 'c) t -> 'd layout -> ('a, 'b, 'd) t
244 = "caml_ba_change_layout"
245
246 let size_in_bytes arr =
247 (kind_size_in_bytes (kind arr)) * (dim1 arr) * (dim2 arr)
248
249 external sub_left: ('a, 'b, c_layout) t -> int -> int -> ('a, 'b, c_layout) t
250 = "caml_ba_sub"
251 external sub_right:
252 ('a, 'b, fortran_layout) t -> int -> int -> ('a, 'b, fortran_layout) t
253 = "caml_ba_sub"
254 let slice_left a n = Genarray.slice_left a [|n|]
255 let slice_right a n = Genarray.slice_right a [|n|]
256 external blit: ('a, 'b, 'c) t -> ('a, 'b, 'c) t -> unit = "caml_ba_blit"
257 external fill: ('a, 'b, 'c) t -> 'a -> unit = "caml_ba_fill"
258 let c_init arr dim1 dim2 f =
259 for i = 0 to pred dim1 do
260 for j = 0 to pred dim2 do
261 unsafe_set arr i j (f i j)
262 done
263 done
264 let fortran_init arr dim1 dim2 f =
265 for j = 1 to dim2 do
266 for i = 1 to dim1 do
267 unsafe_set arr i j (f i j)
268 done
269 done
270 let init (type t) kind (layout : t layout) dim1 dim2 f =
271 let arr = create kind layout dim1 dim2 in
272 match layout with
273 | C_layout -> c_init arr dim1 dim2 f; arr
274 | Fortran_layout -> fortran_init arr dim1 dim2 f; arr
275 let of_array (type t) kind (layout: t layout) data =
276 let dim1 = Array.length data in
277 let dim2 = if dim1 = 0 then 0 else Array.length data.(0) in
278 let ba = create kind layout dim1 dim2 in
279 let ofs =
280 match layout with
281 C_layout -> 0
282 | Fortran_layout -> 1
283 in
284 for i = 0 to dim1 - 1 do
285 let row = data.(i) in
286 if Array.length row <> dim2 then
287 invalid_arg("Bigarray.Array2.of_array: non-rectangular data");
288 for j = 0 to dim2 - 1 do
289 unsafe_set ba (i + ofs) (j + ofs) row.(j)
290 done
291 done;
292 ba
293end
294
295module Array3 = struct
296 type (!'a, !'b, !'c) t = ('a, 'b, 'c) Genarray.t
297 let create kind layout dim1 dim2 dim3 =
298 Genarray.create kind layout [|dim1; dim2; dim3|]
299 external get: ('a, 'b, 'c) t -> int -> int -> int -> 'a = "%caml_ba_ref_3"
300 external set: ('a, 'b, 'c) t -> int -> int -> int -> 'a -> unit
301 = "%caml_ba_set_3"
302 external unsafe_get: ('a, 'b, 'c) t -> int -> int -> int -> 'a
303 = "%caml_ba_unsafe_ref_3"
304 external unsafe_set: ('a, 'b, 'c) t -> int -> int -> int -> 'a -> unit
305 = "%caml_ba_unsafe_set_3"
306 external dim1: ('a, 'b, 'c) t -> int = "%caml_ba_dim_1"
307 external dim2: ('a, 'b, 'c) t -> int = "%caml_ba_dim_2"
308 external dim3: ('a, 'b, 'c) t -> int = "%caml_ba_dim_3"
309 external kind: ('a, 'b, 'c) t -> ('a, 'b) kind = "caml_ba_kind"
310 external layout: ('a, 'b, 'c) t -> 'c layout = "caml_ba_layout"
311
312 external change_layout: ('a, 'b, 'c) t -> 'd layout -> ('a, 'b, 'd) t
313 = "caml_ba_change_layout"
314
315 let size_in_bytes arr =
316 (kind_size_in_bytes (kind arr)) * (dim1 arr) * (dim2 arr) * (dim3 arr)
317
318 external sub_left: ('a, 'b, c_layout) t -> int -> int -> ('a, 'b, c_layout) t
319 = "caml_ba_sub"
320 external sub_right:
321 ('a, 'b, fortran_layout) t -> int -> int -> ('a, 'b, fortran_layout) t
322 = "caml_ba_sub"
323 let slice_left_1 a n m = Genarray.slice_left a [|n; m|]
324 let slice_right_1 a n m = Genarray.slice_right a [|n; m|]
325 let slice_left_2 a n = Genarray.slice_left a [|n|]
326 let slice_right_2 a n = Genarray.slice_right a [|n|]
327 external blit: ('a, 'b, 'c) t -> ('a, 'b, 'c) t -> unit = "caml_ba_blit"
328 external fill: ('a, 'b, 'c) t -> 'a -> unit = "caml_ba_fill"
329 let c_init arr dim1 dim2 dim3 f =
330 for i = 0 to pred dim1 do
331 for j = 0 to pred dim2 do
332 for k = 0 to pred dim3 do
333 unsafe_set arr i j k (f i j k)
334 done
335 done
336 done
337 let fortran_init arr dim1 dim2 dim3 f =
338 for k = 1 to dim3 do
339 for j = 1 to dim2 do
340 for i = 1 to dim1 do
341 unsafe_set arr i j k (f i j k)
342 done
343 done
344 done
345 let init (type t) kind (layout : t layout) dim1 dim2 dim3 f =
346 let arr = create kind layout dim1 dim2 dim3 in
347 match layout with
348 | C_layout -> c_init arr dim1 dim2 dim3 f; arr
349 | Fortran_layout -> fortran_init arr dim1 dim2 dim3 f; arr
350 let of_array (type t) kind (layout: t layout) data =
351 let dim1 = Array.length data in
352 let dim2 = if dim1 = 0 then 0 else Array.length data.(0) in
353 let dim3 = if dim2 = 0 then 0 else Array.length data.(0).(0) in
354 let ba = create kind layout dim1 dim2 dim3 in
355 let ofs =
356 match layout with
357 C_layout -> 0
358 | Fortran_layout -> 1
359 in
360 for i = 0 to dim1 - 1 do
361 let row = data.(i) in
362 if Array.length row <> dim2 then
363 invalid_arg("Bigarray.Array3.of_array: non-cubic data");
364 for j = 0 to dim2 - 1 do
365 let col = row.(j) in
366 if Array.length col <> dim3 then
367 invalid_arg("Bigarray.Array3.of_array: non-cubic data");
368 for k = 0 to dim3 - 1 do
369 unsafe_set ba (i + ofs) (j + ofs) (k + ofs) col.(k)
370 done
371 done
372 done;
373 ba
374end
375
376external genarray_of_array0: ('a, 'b, 'c) Array0.t -> ('a, 'b, 'c) Genarray.t
377 = "%identity"
378external genarray_of_array1: ('a, 'b, 'c) Array1.t -> ('a, 'b, 'c) Genarray.t
379 = "%identity"
380external genarray_of_array2: ('a, 'b, 'c) Array2.t -> ('a, 'b, 'c) Genarray.t
381 = "%identity"
382external genarray_of_array3: ('a, 'b, 'c) Array3.t -> ('a, 'b, 'c) Genarray.t
383 = "%identity"
384let array0_of_genarray a =
385 if Genarray.num_dims a = 0 then a
386 else invalid_arg "Bigarray.array0_of_genarray"
387let array1_of_genarray a =
388 if Genarray.num_dims a = 1 then a
389 else invalid_arg "Bigarray.array1_of_genarray"
390let array2_of_genarray a =
391 if Genarray.num_dims a = 2 then a
392 else invalid_arg "Bigarray.array2_of_genarray"
393let array3_of_genarray a =
394 if Genarray.num_dims a = 3 then a
395 else invalid_arg "Bigarray.array3_of_genarray"
396
397external reshape:
398 ('a, 'b, 'c) Genarray.t -> int array -> ('a, 'b, 'c) Genarray.t
399 = "caml_ba_reshape"
400let reshape_0 a = reshape a [||]
401let reshape_1 a dim1 = reshape a [|dim1|]
402let reshape_2 a dim1 dim2 = reshape a [|dim1;dim2|]
403let reshape_3 a dim1 dim2 dim3 = reshape a [|dim1;dim2;dim3|]
404
405(* Force caml_ba_get_{1,2,3,N} to be linked in, since we don't refer
406 to those primitives directly in this file *)
407
408let _ =
409 let _ = Genarray.get in
410 let _ = Array1.get in
411 let _ = Array2.get in
412 let _ = Array3.get in
413 ()
414
415[@@@ocaml.warning "-32"]
416external get1: unit -> unit = "caml_ba_get_1"
417external get2: unit -> unit = "caml_ba_get_2"
418external get3: unit -> unit = "caml_ba_get_3"
419external set1: unit -> unit = "caml_ba_set_1"
420external set2: unit -> unit = "caml_ba_set_2"
421external set3: unit -> unit = "caml_ba_set_3"