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
18external init : unit -> unit = "caml_ba_init"
19
20let _ = init()
21
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
35type ('a, 'b) kind =
36    Float32 : (float, float32_elt) kind
37  | Float64 : (float, float64_elt) kind
38  | Int8_signed : (int, int8_signed_elt) kind
39  | Int8_unsigned : (int, int8_unsigned_elt) kind
40  | Int16_signed : (int, int16_signed_elt) kind
41  | Int16_unsigned : (int, int16_unsigned_elt) kind
42  | Int32 : (int32, int32_elt) kind
43  | Int64 : (int64, int64_elt) kind
44  | Int : (int, int_elt) kind
45  | Nativeint : (nativeint, nativeint_elt) kind
46  | Complex32 : (Complex.t, complex32_elt) kind
47  | Complex64 : (Complex.t, complex64_elt) kind
48  | Char : (char, int8_unsigned_elt) kind
49
50(* Keep those constants in sync with the caml_ba_kind enumeration
51   in bigarray.h *)
52
53let float32 = Float32
54let float64 = Float64
55let int8_signed = Int8_signed
56let int8_unsigned = Int8_unsigned
57let int16_signed = Int16_signed
58let int16_unsigned = Int16_unsigned
59let int32 = Int32
60let int64 = Int64
61let int = Int
62let nativeint = Nativeint
63let complex32 = Complex32
64let complex64 = Complex64
65let char = Char
66
67let kind_size_in_bytes : type a b. (a, b) kind -> int = function
68  | Float32 -> 4
69  | Float64 -> 8
70  | Int8_signed -> 1
71  | Int8_unsigned -> 1
72  | Int16_signed -> 2
73  | Int16_unsigned -> 2
74  | Int32 -> 4
75  | Int64 -> 8
76  | Int -> Sys.word_size / 8
77  | Nativeint -> Sys.word_size / 8
78  | Complex32 -> 8
79  | Complex64 -> 16
80  | Char -> 1
81
82type c_layout = C_layout_typ
83type fortran_layout = Fortran_layout_typ
84
85type 'a layout =
86    C_layout: c_layout layout
87  | Fortran_layout: fortran_layout layout
88
89(* Keep those constants in sync with the caml_ba_layout enumeration
90   in bigarray.h *)
91
92let c_layout = C_layout
93let fortran_layout = Fortran_layout
94
95module Genarray = struct
96  type ('a, 'b, 'c) t
97  external create: ('a, 'b) kind -> 'c layout -> int array -> ('a, 'b, 'c) t
98     = "caml_ba_create"
99  external get: ('a, 'b, 'c) t -> int array -> 'a
100     = "caml_ba_get_generic"
101  external set: ('a, 'b, 'c) t -> int array -> 'a -> unit
102     = "caml_ba_set_generic"
103  external num_dims: ('a, 'b, 'c) t -> int = "caml_ba_num_dims"
104  external nth_dim: ('a, 'b, 'c) t -> int -> int = "caml_ba_dim"
105  let dims a =
106    let n = num_dims a in
107    let d = Array.make n 0 in
108    for i = 0 to n-1 do d.(i) <- nth_dim a i done;
109    d
110
111  external kind: ('a, 'b, 'c) t -> ('a, 'b) kind = "caml_ba_kind"
112  external layout: ('a, 'b, 'c) t -> 'c layout = "caml_ba_layout"
113  external change_layout: ('a, 'b, 'c) t -> 'd layout -> ('a, 'b, 'd) t
114     = "caml_ba_change_layout"
115
116  let size_in_bytes arr =
117    (kind_size_in_bytes (kind arr)) * (Array.fold_left ( * ) 1 (dims arr))
118
119  external sub_left: ('a, 'b, c_layout) t -> int -> int -> ('a, 'b, c_layout) t
120     = "caml_ba_sub"
121  external sub_right: ('a, 'b, fortran_layout) t -> int -> int ->
122                          ('a, 'b, fortran_layout) t
123     = "caml_ba_sub"
124  external slice_left: ('a, 'b, c_layout) t -> int array ->
125                          ('a, 'b, c_layout) t
126     = "caml_ba_slice"
127  external slice_right: ('a, 'b, fortran_layout) t -> int array ->
128                          ('a, 'b, fortran_layout) t
129     = "caml_ba_slice"
130  external blit: ('a, 'b, 'c) t -> ('a, 'b, 'c) t -> unit
131     = "caml_ba_blit"
132  external fill: ('a, 'b, 'c) t -> 'a -> unit = "caml_ba_fill"
133  external map_internal: Unix.file_descr -> ('a, 'b) kind -> 'c layout ->
134                     bool -> int array -> int64 -> ('a, 'b, 'c) t
135     = "caml_ba_map_file_bytecode" "caml_ba_map_file"
136  let map_file fd ?(pos = 0L) kind layout shared dims =
137    map_internal fd kind layout shared dims pos
138end
139
140module Array0 = struct
141  type ('a, 'b, 'c) t = ('a, 'b, 'c) Genarray.t
142  let create kind layout =
143    Genarray.create kind layout [||]
144  let get arr = Genarray.get arr [||]
145  let set arr = Genarray.set arr [||]
146  external kind: ('a, 'b, 'c) t -> ('a, 'b) kind = "caml_ba_kind"
147  external layout: ('a, 'b, 'c) t -> 'c layout = "caml_ba_layout"
148
149  let size_in_bytes arr = kind_size_in_bytes (kind arr)
150
151  external blit: ('a, 'b, 'c) t -> ('a, 'b, 'c) t -> unit = "caml_ba_blit"
152  external fill: ('a, 'b, 'c) t -> 'a -> unit = "caml_ba_fill"
153
154  let of_value kind layout v =
155    let a = create kind layout in
156    set a v;
157    a
158end
159
160module Array1 = struct
161  type ('a, 'b, 'c) t = ('a, 'b, 'c) Genarray.t
162  let create kind layout dim =
163    Genarray.create kind layout [|dim|]
164  external get: ('a, 'b, 'c) t -> int -> 'a = "%caml_ba_ref_1"
165  external set: ('a, 'b, 'c) t -> int -> 'a -> unit = "%caml_ba_set_1"
166  external unsafe_get: ('a, 'b, 'c) t -> int -> 'a = "%caml_ba_unsafe_ref_1"
167  external unsafe_set: ('a, 'b, 'c) t -> int -> 'a -> unit
168     = "%caml_ba_unsafe_set_1"
169  external dim: ('a, 'b, 'c) t -> int = "%caml_ba_dim_1"
170  external kind: ('a, 'b, 'c) t -> ('a, 'b) kind = "caml_ba_kind"
171  external layout: ('a, 'b, 'c) t -> 'c layout = "caml_ba_layout"
172
173  let size_in_bytes arr =
174    (kind_size_in_bytes (kind arr)) * (dim arr)
175
176  external sub: ('a, 'b, 'c) t -> int -> int -> ('a, 'b, 'c) t = "caml_ba_sub"
177  let slice (type t) (a : (_, _, t) Genarray.t) n =
178    match layout a with
179    | C_layout -> (Genarray.slice_left a [|n|] : (_, _, t) Genarray.t)
180    | Fortran_layout -> (Genarray.slice_right a [|n|]: (_, _, t) Genarray.t)
181  external blit: ('a, 'b, 'c) t -> ('a, 'b, 'c) t -> unit = "caml_ba_blit"
182  external fill: ('a, 'b, 'c) t -> 'a -> unit = "caml_ba_fill"
183  let of_array (type t) kind (layout: t layout) data =
184    let ba = create kind layout (Array.length data) in
185    let ofs =
186      match layout with
187        C_layout -> 0
188      | Fortran_layout -> 1
189    in
190    for i = 0 to Array.length data - 1 do unsafe_set ba (i + ofs) data.(i) done;
191    ba
192  let map_file fd ?pos kind layout shared dim =
193    Genarray.map_file fd ?pos kind layout shared [|dim|]
194end
195
196module Array2 = struct
197  type ('a, 'b, 'c) t = ('a, 'b, 'c) Genarray.t
198  let create kind layout dim1 dim2 =
199    Genarray.create kind layout [|dim1; dim2|]
200  external get: ('a, 'b, 'c) t -> int -> int -> 'a = "%caml_ba_ref_2"
201  external set: ('a, 'b, 'c) t -> int -> int -> 'a -> unit = "%caml_ba_set_2"
202  external unsafe_get: ('a, 'b, 'c) t -> int -> int -> 'a
203     = "%caml_ba_unsafe_ref_2"
204  external unsafe_set: ('a, 'b, 'c) t -> int -> int -> 'a -> unit
205     = "%caml_ba_unsafe_set_2"
206  external dim1: ('a, 'b, 'c) t -> int = "%caml_ba_dim_1"
207  external dim2: ('a, 'b, 'c) t -> int = "%caml_ba_dim_2"
208  external kind: ('a, 'b, 'c) t -> ('a, 'b) kind = "caml_ba_kind"
209  external layout: ('a, 'b, 'c) t -> 'c layout = "caml_ba_layout"
210
211  let size_in_bytes arr =
212    (kind_size_in_bytes (kind arr)) * (dim1 arr) * (dim2 arr)
213
214  external sub_left: ('a, 'b, c_layout) t -> int -> int -> ('a, 'b, c_layout) t
215     = "caml_ba_sub"
216  external sub_right:
217    ('a, 'b, fortran_layout) t -> int -> int -> ('a, 'b, fortran_layout) t
218     = "caml_ba_sub"
219  let slice_left a n = Genarray.slice_left a [|n|]
220  let slice_right a n = Genarray.slice_right a [|n|]
221  external blit: ('a, 'b, 'c) t -> ('a, 'b, 'c) t -> unit = "caml_ba_blit"
222  external fill: ('a, 'b, 'c) t -> 'a -> unit = "caml_ba_fill"
223  let of_array (type t) kind (layout: t layout) data =
224    let dim1 = Array.length data in
225    let dim2 = if dim1 = 0 then 0 else Array.length data.(0) in
226    let ba = create kind layout dim1 dim2 in
227    let ofs =
228      match layout with
229        C_layout -> 0
230      | Fortran_layout -> 1
231    in
232    for i = 0 to dim1 - 1 do
233      let row = data.(i) in
234      if Array.length row <> dim2 then
235        invalid_arg("Bigarray.Array2.of_array: non-rectangular data");
236      for j = 0 to dim2 - 1 do
237        unsafe_set ba (i + ofs) (j + ofs) row.(j)
238      done
239    done;
240    ba
241  let map_file fd ?pos kind layout shared dim1 dim2 =
242    Genarray.map_file fd ?pos kind layout shared [|dim1;dim2|]
243end
244
245module Array3 = struct
246  type ('a, 'b, 'c) t = ('a, 'b, 'c) Genarray.t
247  let create kind layout dim1 dim2 dim3 =
248    Genarray.create kind layout [|dim1; dim2; dim3|]
249  external get: ('a, 'b, 'c) t -> int -> int -> int -> 'a = "%caml_ba_ref_3"
250  external set: ('a, 'b, 'c) t -> int -> int -> int -> 'a -> unit
251     = "%caml_ba_set_3"
252  external unsafe_get: ('a, 'b, 'c) t -> int -> int -> int -> 'a
253     = "%caml_ba_unsafe_ref_3"
254  external unsafe_set: ('a, 'b, 'c) t -> int -> int -> int -> 'a -> unit
255     = "%caml_ba_unsafe_set_3"
256  external dim1: ('a, 'b, 'c) t -> int = "%caml_ba_dim_1"
257  external dim2: ('a, 'b, 'c) t -> int = "%caml_ba_dim_2"
258  external dim3: ('a, 'b, 'c) t -> int = "%caml_ba_dim_3"
259  external kind: ('a, 'b, 'c) t -> ('a, 'b) kind = "caml_ba_kind"
260  external layout: ('a, 'b, 'c) t -> 'c layout = "caml_ba_layout"
261
262  let size_in_bytes arr =
263    (kind_size_in_bytes (kind arr)) * (dim1 arr) * (dim2 arr) * (dim3 arr)
264
265  external sub_left: ('a, 'b, c_layout) t -> int -> int -> ('a, 'b, c_layout) t
266     = "caml_ba_sub"
267  external sub_right:
268     ('a, 'b, fortran_layout) t -> int -> int -> ('a, 'b, fortran_layout) t
269     = "caml_ba_sub"
270  let slice_left_1 a n m = Genarray.slice_left a [|n; m|]
271  let slice_right_1 a n m = Genarray.slice_right a [|n; m|]
272  let slice_left_2 a n = Genarray.slice_left a [|n|]
273  let slice_right_2 a n = Genarray.slice_right a [|n|]
274  external blit: ('a, 'b, 'c) t -> ('a, 'b, 'c) t -> unit = "caml_ba_blit"
275  external fill: ('a, 'b, 'c) t -> 'a -> unit = "caml_ba_fill"
276  let of_array (type t) kind (layout: t layout) data =
277    let dim1 = Array.length data in
278    let dim2 = if dim1 = 0 then 0 else Array.length data.(0) in
279    let dim3 = if dim2 = 0 then 0 else Array.length data.(0).(0) in
280    let ba = create kind layout dim1 dim2 dim3 in
281    let ofs =
282      match layout with
283        C_layout -> 0
284      | Fortran_layout -> 1
285    in
286    for i = 0 to dim1 - 1 do
287      let row = data.(i) in
288      if Array.length row <> dim2 then
289        invalid_arg("Bigarray.Array3.of_array: non-cubic data");
290      for j = 0 to dim2 - 1 do
291        let col = row.(j) in
292        if Array.length col <> dim3 then
293          invalid_arg("Bigarray.Array3.of_array: non-cubic data");
294        for k = 0 to dim3 - 1 do
295          unsafe_set ba (i + ofs) (j + ofs) (k + ofs) col.(k)
296        done
297      done
298    done;
299    ba
300  let map_file fd ?pos kind layout shared dim1 dim2 dim3 =
301    Genarray.map_file fd ?pos kind layout shared [|dim1;dim2;dim3|]
302end
303
304external genarray_of_array0: ('a, 'b, 'c) Array0.t -> ('a, 'b, 'c) Genarray.t
305   = "%identity"
306external genarray_of_array1: ('a, 'b, 'c) Array1.t -> ('a, 'b, 'c) Genarray.t
307   = "%identity"
308external genarray_of_array2: ('a, 'b, 'c) Array2.t -> ('a, 'b, 'c) Genarray.t
309   = "%identity"
310external genarray_of_array3: ('a, 'b, 'c) Array3.t -> ('a, 'b, 'c) Genarray.t
311   = "%identity"
312let array0_of_genarray a =
313  if Genarray.num_dims a = 0 then a
314  else invalid_arg "Bigarray.array0_of_genarray"
315let array1_of_genarray a =
316  if Genarray.num_dims a = 1 then a
317  else invalid_arg "Bigarray.array1_of_genarray"
318let array2_of_genarray a =
319  if Genarray.num_dims a = 2 then a
320  else invalid_arg "Bigarray.array2_of_genarray"
321let array3_of_genarray a =
322  if Genarray.num_dims a = 3 then a
323  else invalid_arg "Bigarray.array3_of_genarray"
324
325external reshape:
326   ('a, 'b, 'c) Genarray.t -> int array -> ('a, 'b, 'c) Genarray.t
327   = "caml_ba_reshape"
328let reshape_0 a = reshape a [||]
329let reshape_1 a dim1 = reshape a [|dim1|]
330let reshape_2 a dim1 dim2 = reshape a [|dim1;dim2|]
331let reshape_3 a dim1 dim2 dim3 = reshape a [|dim1;dim2;dim3|]
332
333(* Force caml_ba_get_{1,2,3,N} to be linked in, since we don't refer
334   to those primitives directly in this file *)
335
336let _ =
337  let _ = Genarray.get in
338  let _ = Array1.get in
339  let _ = Array2.get in
340  let _ = Array3.get in
341  ()
342
343[@@@ocaml.warning "-32"]
344external get1: unit -> unit = "caml_ba_get_1"
345external get2: unit -> unit = "caml_ba_get_2"
346external get3: unit -> unit = "caml_ba_get_3"
347external set1: unit -> unit = "caml_ba_set_1"
348external set2: unit -> unit = "caml_ba_set_2"
349external set3: unit -> unit = "caml_ba_set_3"
350