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