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 252 253
|
(***********************************************************************)
(* *)
(* Objective Caml *)
(* *)
(* 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. *)
(* *)
(***********************************************************************)
(* $Id: bigarray.ml 8911 2008-07-14 09:09:53Z xleroy $ *)
(* 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"
let dim a = Genarray.nth_dim a 0
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"
let dim1 a = Genarray.nth_dim a 0
let dim2 a = Genarray.nth_dim a 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_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"
let dim1 a = Genarray.nth_dim a 0
let dim2 a = Genarray.nth_dim a 1
let dim3 a = Genarray.nth_dim a 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_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"
|