diff options
Diffstat (limited to 'otherlibs/bigarray')
-rw-r--r-- | otherlibs/bigarray/bigarray.h | 6 | ||||
-rw-r--r-- | otherlibs/bigarray/bigarray.mli | 34 | ||||
-rw-r--r-- | otherlibs/bigarray/bigarray_stubs.c | 14 | ||||
-rw-r--r-- | otherlibs/bigarray/mmap_unix.c | 4 | ||||
-rw-r--r-- | otherlibs/bigarray/mmap_win32.c | 4 |
5 files changed, 31 insertions, 31 deletions
diff --git a/otherlibs/bigarray/bigarray.h b/otherlibs/bigarray/bigarray.h index 695306544..63ac1078e 100644 --- a/otherlibs/bigarray/bigarray.h +++ b/otherlibs/bigarray/bigarray.h @@ -42,7 +42,7 @@ enum caml_ba_kind { CAML_BA_UINT16, /* Unsigned 16-bit integers */ CAML_BA_INT32, /* Signed 32-bit integers */ CAML_BA_INT64, /* Signed 64-bit integers */ - CAML_BA_CAML_INT, /* Caml-style integers (signed 31 or 63 bits) */ + CAML_BA_CAML_INT, /* OCaml-style integers (signed 31 or 63 bits) */ CAML_BA_NATIVE_INT, /* Platform-native long integers (32 or 64 bits) */ CAML_BA_COMPLEX32, /* Single-precision complex */ CAML_BA_COMPLEX64, /* Double-precision complex */ @@ -56,8 +56,8 @@ enum caml_ba_layout { }; enum caml_ba_managed { - CAML_BA_EXTERNAL = 0, /* Data is not allocated by Caml */ - CAML_BA_MANAGED = 0x200, /* Data is allocated by Caml */ + CAML_BA_EXTERNAL = 0, /* Data is not allocated by OCaml */ + CAML_BA_MANAGED = 0x200, /* Data is allocated by OCaml */ CAML_BA_MAPPED_FILE = 0x400, /* Data is a memory mapped file */ CAML_BA_MANAGED_MASK = 0x600 /* Mask for "managed" bits in flags field */ }; diff --git a/otherlibs/bigarray/bigarray.mli b/otherlibs/bigarray/bigarray.mli index ed60976f7..8b260bf79 100644 --- a/otherlibs/bigarray/bigarray.mli +++ b/otherlibs/bigarray/bigarray.mli @@ -18,13 +18,13 @@ This module implements multi-dimensional arrays of integers and floating-point numbers, thereafter referred to as ``big arrays''. The implementation allows efficient sharing of large numerical - arrays between Caml code and C or Fortran numerical libraries. + arrays between OCaml code and C or Fortran numerical libraries. Concerning the naming conventions, users of this module are encouraged to do [open Bigarray] in their source, then refer to array types and operations via short dot notation, e.g. [Array1.t] or [Array2.sub]. - Big arrays support all the Caml ad-hoc polymorphic operations: + Big arrays support all the OCaml ad-hoc polymorphic operations: - comparisons ([=], [<>], [<=], etc, as well as {!Pervasives.compare}); - hashing (module [Hash]); - and structured input-output ({!Pervasives.output_value} @@ -47,7 +47,7 @@ ({!Bigarray.int8_signed_elt} or {!Bigarray.int8_unsigned_elt}), - 16-bit integers (signed or unsigned) ({!Bigarray.int16_signed_elt} or {!Bigarray.int16_unsigned_elt}), -- Caml integers (signed, 31 bits on 32-bit architectures, +- OCaml integers (signed, 31 bits on 32-bit architectures, 63 bits on 64-bit architectures) ({!Bigarray.int_elt}), - 32-bit signed integer ({!Bigarray.int32_elt}), - 64-bit signed integers ({!Bigarray.int64_elt}), @@ -72,20 +72,20 @@ type int64_elt type nativeint_elt type ('a, 'b) kind -(** To each element kind is associated a Caml type, which is - the type of Caml values that can be stored in the big array +(** To each element kind is associated an OCaml type, which is + the type of OCaml values that can be stored in the big array or read back from it. This type is not necessarily the same as the type of the array elements proper: for instance, a big array whose elements are of kind [float32_elt] contains 32-bit single precision floats, but reading or writing one of - its elements from Caml uses the Caml type [float], which is + its elements from OCaml uses the OCaml type [float], which is 64-bit double precision floats. The abstract type [('a, 'b) kind] captures this association - of a Caml type ['a] for values read or written in the big array, + of an OCaml type ['a] for values read or written in the big array, and of an element kind ['b] which represents the actual contents of the big array. The following predefined values of type - [kind] list all possible associations of Caml types with + [kind] list all possible associations of OCaml types with element kinds: *) val float32 : (float, float32_elt) kind @@ -127,12 +127,12 @@ val nativeint : (nativeint, nativeint_elt) kind val char : (char, int8_unsigned_elt) kind (** As shown by the types of the values above, big arrays of kind [float32_elt] and [float64_elt] are - accessed using the Caml type [float]. Big arrays of complex kinds - [complex32_elt], [complex64_elt] are accessed with the Caml type + accessed using the OCaml type [float]. Big arrays of complex kinds + [complex32_elt], [complex64_elt] are accessed with the OCaml type {!Complex.t}. Big arrays of - integer kinds are accessed using the smallest Caml integer + integer kinds are accessed using the smallest OCaml integer type large enough to represent the array elements: - [int] for 8- and 16-bit integer bigarrays, as well as Caml-integer + [int] for 8- and 16-bit integer bigarrays, as well as OCaml-integer bigarrays; [int32] for 32-bit integer bigarrays; [int64] for 64-bit integer bigarrays; and [nativeint] for platform-native integer bigarrays. Finally, big arrays of @@ -195,7 +195,7 @@ module Genarray : The three type parameters to [Genarray.t] identify the array element kind and layout, as follows: - - the first parameter, ['a], is the Caml type for accessing array + - the first parameter, ['a], is the OCaml type for accessing array elements ([float], [int], [int32], [int64], [nativeint]); - the second parameter, ['b], is the actual kind of array elements ([float32_elt], [float64_elt], [int8_signed_elt], [int8_unsigned_elt], @@ -206,7 +206,7 @@ module Genarray : For instance, [(float, float32_elt, fortran_layout) Genarray.t] is the type of generic big arrays containing 32-bit floats in Fortran layout; reads and writes in this array use the - Caml type [float]. *) + OCaml type [float]. *) external create: ('a, 'b) kind -> 'c layout -> int array -> ('a, 'b, 'c) t = "caml_ba_create" @@ -440,7 +440,7 @@ module Genarray : module Array1 : sig type ('a, 'b, 'c) t (** The type of one-dimensional big arrays whose elements have - Caml type ['a], representation kind ['b], and memory layout ['c]. *) + OCaml type ['a], representation kind ['b], and memory layout ['c]. *) val create: ('a, 'b) kind -> 'c layout -> int -> ('a, 'b, 'c) t (** [Array1.create kind layout dim] returns a new bigarray of @@ -519,7 +519,7 @@ module Array2 : sig type ('a, 'b, 'c) t (** The type of two-dimensional big arrays whose elements have - Caml type ['a], representation kind ['b], and memory layout ['c]. *) + OCaml type ['a], representation kind ['b], and memory layout ['c]. *) val create: ('a, 'b) kind -> 'c layout -> int -> int -> ('a, 'b, 'c) t (** [Array2.create kind layout dim1 dim2] returns a new bigarray of @@ -622,7 +622,7 @@ module Array3 : sig type ('a, 'b, 'c) t (** The type of three-dimensional big arrays whose elements have - Caml type ['a], representation kind ['b], and memory layout ['c]. *) + OCaml type ['a], representation kind ['b], and memory layout ['c]. *) val create: ('a, 'b) kind -> 'c layout -> int -> int -> int -> ('a, 'b, 'c) t (** [Array3.create kind layout dim1 dim2 dim3] returns a new bigarray of diff --git a/otherlibs/bigarray/bigarray_stubs.c b/otherlibs/bigarray/bigarray_stubs.c index 7c751b7cf..ae9f73f97 100644 --- a/otherlibs/bigarray/bigarray_stubs.c +++ b/otherlibs/bigarray/bigarray_stubs.c @@ -130,8 +130,8 @@ caml_ba_multov(uintnat a, uintnat b, int * overflow) /* [caml_ba_alloc] will allocate a new bigarray object in the heap. If [data] is NULL, the memory for the contents is also allocated (with [malloc]) by [caml_ba_alloc]. - [data] cannot point into the Caml heap. - [dim] may point into an object in the Caml heap. + [data] cannot point into the OCaml heap. + [dim] may point into an object in the OCaml heap. */ CAMLexport value caml_ba_alloc(int flags, int num_dims, void * data, intnat * dim) @@ -190,7 +190,7 @@ CAMLexport value caml_ba_alloc_dims(int flags, int num_dims, void * data, ...) return res; } -/* Allocate a bigarray from Caml */ +/* Allocate a bigarray from OCaml */ CAMLprim value caml_ba_create(value vkind, value vlayout, value vdim) { @@ -773,7 +773,7 @@ static void caml_ba_serialize(value v, caml_ba_serialize_longarray(b->data, num_elts, -0x80000000, 0x7FFFFFFF); break; } - /* Compute required size in Caml heap. Assumes struct caml_ba_array + /* Compute required size in OCaml heap. Assumes struct caml_ba_array is exactly 4 + num_dims words */ Assert(sizeof(struct caml_ba_array) == 5 * sizeof(value)); *wsize_32 = (4 + b->num_dims) * 4; @@ -794,7 +794,7 @@ static void caml_ba_deserialize_longarray(void * dest, intnat num_elts) #else if (sixty) caml_deserialize_error("input_value: cannot read bigarray " - "with 64-bit Caml ints"); + "with 64-bit OCaml ints"); caml_deserialize_block_4(dest, num_elts); #endif } @@ -905,7 +905,7 @@ CAMLprim value caml_ba_slice(value vb, value vind) sub_data = (char *) b->data + offset * caml_ba_element_size[b->flags & CAML_BA_KIND_MASK]; - /* Allocate a Caml bigarray to hold the result */ + /* Allocate an OCaml bigarray to hold the result */ res = caml_ba_alloc(b->flags, b->num_dims - num_inds, sub_data, sub_dims); /* Create or update proxy in case of managed bigarray */ caml_ba_update_proxy(b, Caml_ba_array_val(res)); @@ -946,7 +946,7 @@ CAMLprim value caml_ba_sub(value vb, value vofs, value vlen) sub_data = (char *) b->data + ofs * mul * caml_ba_element_size[b->flags & CAML_BA_KIND_MASK]; - /* Allocate a Caml bigarray to hold the result */ + /* Allocate an OCaml bigarray to hold the result */ res = caml_ba_alloc(b->flags, b->num_dims, sub_data, b->dim); /* Doctor the changed dimension */ Caml_ba_array_val(res)->dim[changed_dim] = len; diff --git a/otherlibs/bigarray/mmap_unix.c b/otherlibs/bigarray/mmap_unix.c index 4d77c2e54..8e71664ab 100644 --- a/otherlibs/bigarray/mmap_unix.c +++ b/otherlibs/bigarray/mmap_unix.c @@ -55,7 +55,7 @@ CAMLprim value caml_ba_map_file(value vfd, value vkind, value vlayout, startpos = File_offset_val(vstart); num_dims = Wosize_val(vdim); major_dim = flags & CAML_BA_FORTRAN_LAYOUT ? num_dims - 1 : 0; - /* Extract dimensions from Caml array */ + /* Extract dimensions from OCaml array */ num_dims = Wosize_val(vdim); if (num_dims < 1 || num_dims > CAML_BA_MAX_NUM_DIMS) caml_invalid_argument("Bigarray.mmap: bad number of dimensions"); @@ -122,7 +122,7 @@ CAMLprim value caml_ba_map_file(value vfd, value vkind, value vlayout, caml_leave_blocking_section(); if (addr == (void *) MAP_FAILED) caml_sys_error(NO_ARG); addr = (void *) ((uintnat) addr + delta); - /* Build and return the Caml bigarray */ + /* Build and return the OCaml bigarray */ return caml_ba_alloc(flags | CAML_BA_MAPPED_FILE, num_dims, addr, dim); } diff --git a/otherlibs/bigarray/mmap_win32.c b/otherlibs/bigarray/mmap_win32.c index 067e3284a..ded2270ee 100644 --- a/otherlibs/bigarray/mmap_win32.c +++ b/otherlibs/bigarray/mmap_win32.c @@ -62,7 +62,7 @@ CAMLprim value caml_ba_map_file(value vfd, value vkind, value vlayout, startpos = Int64_val(vstart); num_dims = Wosize_val(vdim); major_dim = flags & CAML_BA_FORTRAN_LAYOUT ? num_dims - 1 : 0; - /* Extract dimensions from Caml array */ + /* Extract dimensions from OCaml array */ num_dims = Wosize_val(vdim); if (num_dims < 1 || num_dims > CAML_BA_MAX_NUM_DIMS) caml_invalid_argument("Bigarray.mmap: bad number of dimensions"); @@ -117,7 +117,7 @@ CAMLprim value caml_ba_map_file(value vfd, value vkind, value vlayout, addr = (void *) ((uintnat) addr + delta); /* Close the file mapping */ CloseHandle(fmap); - /* Build and return the Caml bigarray */ + /* Build and return the OCaml bigarray */ return caml_ba_alloc(flags | CAML_BA_MAPPED_FILE, num_dims, addr, dim); } |