diff --git a/src/ctypes/bigarray_stubs.ml b/src/ctypes/bigarray_stubs.ml index c9a62e19..f9364e00 100644 --- a/src/ctypes/bigarray_stubs.ml +++ b/src/ctypes/bigarray_stubs.ml @@ -6,21 +6,48 @@ *) type _ kind = - Kind_float32 : float kind - | Kind_float64 : float kind - | Kind_int8_signed : int kind - | Kind_int8_unsigned : int kind - | Kind_int16_signed : int kind - | Kind_int16_unsigned : int kind - | Kind_int32 : int32 kind - | Kind_int64 : int64 kind - | Kind_int : int kind - | Kind_nativeint : nativeint kind - | Kind_complex32 : Complex.t kind - | Kind_complex64 : Complex.t kind - | Kind_char : char kind - -external kind : ('a, 'b) Bigarray.kind -> 'a kind +| Ba_float32 : < element: float; + ba_repr: Bigarray.float32_elt; + storage_type: float > kind +| Ba_float64 : < element: float; + ba_repr: Bigarray.float64_elt; + storage_type: float > kind +| Ba_int8_signed : < element: int; + ba_repr: Bigarray.int8_signed_elt; + storage_type: int > kind +| Ba_int8_unsigned : < element: int; + ba_repr: Bigarray.int8_unsigned_elt; + storage_type: Unsigned.uint8 > kind +| Ba_int16_signed : < element: int; + ba_repr: Bigarray.int16_signed_elt; + storage_type: int > kind +| Ba_int16_unsigned : < element: int; + ba_repr: Bigarray.int16_unsigned_elt; + storage_type: Unsigned.uint16 > kind +| Ba_int32 : < element: int32; + ba_repr: Bigarray.int32_elt; + storage_type: int32 > kind +| Ba_int64 : < element: int64; + ba_repr: Bigarray.int64_elt; + storage_type: int64 > kind +| Ba_int : < element: int; + ba_repr: Bigarray.int_elt; + storage_type: int > kind +| Ba_nativeint : < element: nativeint; + ba_repr: Bigarray.nativeint_elt; + storage_type: nativeint > kind +| Ba_complex32 : < element: Complex.t; + ba_repr: Bigarray.complex32_elt; + storage_type: Complex.t > kind +| Ba_complex64 : < element: Complex.t; + ba_repr: Bigarray.complex64_elt; + storage_type: Complex.t > kind +| Ba_char : < element: char; + ba_repr: Bigarray.int8_unsigned_elt; + storage_type: char > kind + +external kind : ('a, 'b) Bigarray.kind -> + < element: 'a; ba_repr: 'b; storage_type: 'c > kind (* Bigarray.kind is simply an int whose values are consecutively numbered starting from zero, so we can directly transform its values to a variant with appropriately-ordered constructors. @@ -34,18 +61,18 @@ external kind : ('a, 'b) Bigarray.kind -> 'a kind external address : 'b -> Ctypes_raw.voidp = "ctypes_bigarray_address" -external view : 'a kind -> dims:int array -> Ctypes_raw.voidp -> offset:int -> - ('a, 'b, Bigarray.c_layout) Bigarray.Genarray.t +external view : < element: 'a; .. > kind -> dims:int array -> + Ctypes_raw.voidp -> offset:int -> ('a, 'b, Bigarray.c_layout) Bigarray.Genarray.t = "ctypes_bigarray_view" -external view1 : 'a kind -> dims:int array -> Ctypes_raw.voidp -> offset:int -> - ('a, 'b, Bigarray.c_layout) Bigarray.Array1.t +external view1 : < element: 'a; .. > kind -> dims:int array -> + Ctypes_raw.voidp -> offset:int -> ('a, 'b, Bigarray.c_layout) Bigarray.Array1.t = "ctypes_bigarray_view" -external view2 : 'a kind -> dims:int array -> Ctypes_raw.voidp -> offset:int -> - ('a, 'b, Bigarray.c_layout) Bigarray.Array2.t +external view2 : < element: 'a; .. > kind -> dims:int array -> + Ctypes_raw.voidp -> offset:int -> ('a, 'b, Bigarray.c_layout) Bigarray.Array2.t = "ctypes_bigarray_view" -external view3 : 'a kind -> dims:int array -> Ctypes_raw.voidp -> offset:int -> - ('a, 'b, Bigarray.c_layout) Bigarray.Array3.t +external view3 : < element: 'a; .. > kind -> dims:int array -> + Ctypes_raw.voidp -> offset:int -> ('a, 'b, Bigarray.c_layout) Bigarray.Array3.t = "ctypes_bigarray_view" diff --git a/src/ctypes/ctypes.mli b/src/ctypes/ctypes.mli index f4dcdecb..33532969 100644 --- a/src/ctypes/ctypes.mli +++ b/src/ctypes/ctypes.mli @@ -178,7 +178,7 @@ val string : string typ val string_opt : string option typ (** A high-level representation of the string type. This behaves like {!string}, - except that null pointers appear in OCaml as [None]. + except that null pointers appear in OCaml as [None]. *) (** {3 Array types} *) @@ -206,44 +206,105 @@ type _ bigarray_class val genarray : < element: 'a; ba_repr: 'b; + storage_type: 'c; bigarray: ('a, 'b, Bigarray.c_layout) Bigarray.Genarray.t; - carray: 'a array; + carray: 'c array; dims: int std_array > bigarray_class (** The class of {!Bigarray.Genarray.t} values *) val array1 : < element: 'a; ba_repr: 'b; + storage_type: 'c; bigarray: ('a, 'b, Bigarray.c_layout) Bigarray.Array1.t; - carray: 'a array; + carray: 'c array; dims: int > bigarray_class (** The class of {!Bigarray.Array1.t} values *) val array2 : < element: 'a; ba_repr: 'b; + storage_type: 'c; bigarray: ('a, 'b, Bigarray.c_layout) Bigarray.Array2.t; - carray: 'a array array; + carray: 'c array array; dims: int * int > bigarray_class (** The class of {!Bigarray.Array2.t} values *) val array3 : < element: 'a; ba_repr: 'b; + storage_type: 'c; bigarray: ('a, 'b, Bigarray.c_layout) Bigarray.Array3.t; - carray: 'a array array array; + carray: 'c array array array; dims: int * int * int > bigarray_class (** The class of {!Bigarray.Array3.t} values *) +type _ bigarray_kind + +val ba_float32 : < element: float; + ba_repr: Bigarray.float32_elt; + storage_type: float > bigarray_kind + +val ba_float64 : < element: float; + ba_repr: Bigarray.float64_elt; + storage_type: float > bigarray_kind + +val ba_complex32 : < element: Complex.t; + ba_repr: Bigarray.complex32_elt; + storage_type: Complex.t > bigarray_kind + +val ba_complex64 : < element: Complex.t; + ba_repr: Bigarray.complex64_elt; + storage_type: Complex.t > bigarray_kind + +val ba_int8_signed : < element: int; + ba_repr: Bigarray.int8_signed_elt; + storage_type: int > bigarray_kind + +val ba_int8_unsigned : < element: int; + ba_repr: Bigarray.int8_unsigned_elt; + storage_type: uint8 > bigarray_kind + +val ba_int16_signed : < element: int; + ba_repr: Bigarray.int16_signed_elt; + storage_type: int > bigarray_kind + +val ba_int16_unsigned : < element: int; + ba_repr: Bigarray.int16_unsigned_elt; + storage_type: uint16 > bigarray_kind + +val ba_int : < element: int; + ba_repr: Bigarray.int_elt; + storage_type: int > bigarray_kind + +val ba_int32 : < element: int32; + ba_repr: Bigarray.int32_elt; + storage_type: int32 > bigarray_kind + +val ba_int64 : < element: int64; + ba_repr: Bigarray.int64_elt; + storage_type: int64 > bigarray_kind + +val ba_nativeint : < element: nativeint; + ba_repr: Bigarray.nativeint_elt; + storage_type: nativeint > bigarray_kind + +val ba_char : < element: char; + ba_repr: Bigarray.int8_unsigned_elt; + storage_type: char > bigarray_kind + val bigarray : < element: 'a; ba_repr: 'b; + storage_type: 'c; dims: 'dims; bigarray: 'bigarray; carray: _ > bigarray_class -> - 'dims -> ('a, 'b) Bigarray.kind -> 'bigarray typ + 'dims -> + < element: 'a; ba_repr: 'b; storage_type: 'c > bigarray_kind -> + 'bigarray typ (** Construct a sized bigarray type representation from a bigarray class, the - dimensions, and the {!Bigarray.kind}. *) + dimensions, and an element of {!bigarray_kind}. *) (** {3 Function types} *) @@ -526,33 +587,43 @@ end (** {4 Bigarray values} *) val bigarray_start : < element: 'a; - ba_repr: _; + ba_repr: 'r; + storage_type: 'c; bigarray: 'b; carray: _; - dims: _ > bigarray_class -> 'b -> 'a ptr + dims: _ > bigarray_class -> + < element: 'a; + ba_repr: 'r; + storage_type: 'c > bigarray_kind -> 'b -> 'c ptr (** Return the address of the first element of the given Bigarray value. *) val bigarray_of_ptr : < element: 'a; ba_repr: 'f; + storage_type: 'c; bigarray: 'b; carray: _; dims: 'i > bigarray_class -> - 'i -> ('a, 'f) Bigarray.kind -> 'a ptr -> 'b + 'i -> < element: 'a; ba_repr: 'f; storage_type: 'c > bigarray_kind -> 'c ptr -> 'b (** Convert a C pointer to a bigarray value. *) -val array_of_bigarray : < element: _; - ba_repr: _; +val array_of_bigarray : < element: 'e; + ba_repr: 'r; + storage_type: 's; bigarray: 'b; carray: 'c; - dims: _ > bigarray_class -> 'b -> 'c + dims: _ > bigarray_class -> + < element: 'e; + ba_repr: 'r; + storage_type: 's > bigarray_kind -> 'b -> 'c (** Convert a Bigarray value to a C array. *) val bigarray_of_array : < element: 'a; ba_repr: 'f; + storage_type: 's; bigarray: 'b; carray: 'c array; dims: 'i > bigarray_class -> - ('a, 'f) Bigarray.kind -> 'c array -> 'b + < element: 'a; ba_repr: 'f; storage_type: 's > bigarray_kind -> 'c array -> 'b (** Convert a C array to a Bigarray value. *) diff --git a/src/ctypes/ctypes_bigarray.ml b/src/ctypes/ctypes_bigarray.ml index 8fb76f6a..1053271f 100644 --- a/src/ctypes/ctypes_bigarray.ml +++ b/src/ctypes/ctypes_bigarray.ml @@ -7,41 +7,77 @@ open Bigarray_stubs -let prim_of_kind : type a. a kind -> a Primitives.prim +type 'a kind = 'a Bigarray_stubs.kind + +module Kinds = struct + let ba_float32 = Ba_float32 + let ba_float64 = Ba_float64 + let ba_int8_signed = Ba_int8_signed + let ba_int8_unsigned = Ba_int8_unsigned + let ba_int16_signed = Ba_int16_signed + let ba_int16_unsigned = Ba_int16_unsigned + let ba_int32 = Ba_int32 + let ba_int64 = Ba_int64 + let ba_nativeint = Ba_nativeint + let ba_complex32 = Ba_complex32 + let ba_complex64 = Ba_complex64 + let ba_int = Ba_int + let ba_char = Ba_char +end + +let storage_type_of_kind : type a b c. + < element: a; ba_repr: b; storage_type: c > kind -> c Primitives.prim = let open Primitives in function - Kind_float32 -> Float - | Kind_float64 -> Double - | Kind_int8_signed -> Int8_t - | Kind_int8_unsigned -> Int8_t - | Kind_int16_signed -> Int16_t - | Kind_int16_unsigned -> Int16_t - | Kind_int32 -> Int32_t - | Kind_int64 -> Int64_t - | Kind_int -> Camlint - | Kind_nativeint -> Nativeint - | Kind_complex32 -> Complex32 - | Kind_complex64 -> Complex64 - | Kind_char -> Char + Ba_float32 -> Float + | Ba_float64 -> Double + | Ba_int8_signed -> Int8_t + | Ba_int8_unsigned -> Uint8_t + | Ba_int16_signed -> Int16_t + | Ba_int16_unsigned -> Uint16_t + | Ba_int32 -> Int32_t + | Ba_int64 -> Int64_t + | Ba_int -> Camlint + | Ba_nativeint -> Nativeint + | Ba_complex32 -> Complex32 + | Ba_complex64 -> Complex64 + | Ba_char -> Char + +let ba_kind_of_kind : type a b c. + < element: a; ba_repr: b; storage_type: c> kind -> (a, b) Bigarray.kind = + let open Bigarray in function + Ba_float32 -> float32 + | Ba_float64 -> float64 + | Ba_int8_signed -> int8_signed + | Ba_int8_unsigned -> int8_unsigned + | Ba_int16_signed -> int16_signed + | Ba_int16_unsigned -> int16_unsigned + | Ba_int32 -> int32 + | Ba_int64 -> int64 + | Ba_int -> int + | Ba_nativeint -> nativeint + | Ba_complex32 -> complex32 + | Ba_complex64 -> complex64 + | Ba_char -> char let string_of_kind : type a. a kind -> string = function - Kind_float32 -> "float32" - | Kind_float64 -> "float64" - | Kind_int8_signed -> "int8_signed" - | Kind_int8_unsigned -> "int8_unsigned" - | Kind_int16_signed -> "int16_signed" - | Kind_int16_unsigned -> "int16_unsigned" - | Kind_int32 -> "int32" - | Kind_int64 -> "int64" - | Kind_int -> "int" - | Kind_nativeint -> "nativeint" - | Kind_complex32 -> "complex32" - | Kind_complex64 -> "complex64" - | Kind_char -> "char" - -let bigarray_kind_sizeof k = Ctypes_primitives.sizeof (prim_of_kind k) - -let bigarray_kind_alignment k = Ctypes_primitives.alignment (prim_of_kind k) + Ba_float32 -> "float32" + | Ba_float64 -> "float64" + | Ba_int8_signed -> "int8_signed" + | Ba_int8_unsigned -> "int8_unsigned" + | Ba_int16_signed -> "int16_signed" + | Ba_int16_unsigned -> "int16_unsigned" + | Ba_int32 -> "int32" + | Ba_int64 -> "int64" + | Ba_int -> "int" + | Ba_nativeint -> "nativeint" + | Ba_complex32 -> "complex32" + | Ba_complex64 -> "complex64" + | Ba_char -> "char" + +let bigarray_kind_sizeof k = Ctypes_primitives.sizeof (storage_type_of_kind k) + +let bigarray_kind_alignment k = Ctypes_primitives.alignment (storage_type_of_kind k) type (_, _) dims = | DimsGen : int array -> ('a, ('a, _, Bigarray.c_layout) Bigarray.Genarray.t) dims @@ -49,7 +85,8 @@ type (_, _) dims = | Dims2 : int * int -> ('a, ('a, _, Bigarray.c_layout) Bigarray.Array2.t) dims | Dims3 : int * int * int -> ('a, ('a, _, Bigarray.c_layout) Bigarray.Array3.t) dims -type ('a, 'b) t = ('a, 'b) dims * 'a kind +type ('a, 'b) t = + T : ('a, 'b) dims * < element: 'a; ba_repr: _; storage_type: _ > kind -> ('a, 'b) t let elements : type a b. (b, a) dims -> int = function | DimsGen ds -> Array.fold_left ( * ) 1 ds @@ -57,14 +94,14 @@ let elements : type a b. (b, a) dims -> int = function | Dims2 (d1, d2) -> d1 * d2 | Dims3 (d1, d2, d3) -> d1 * d2 * d3 -let sizeof (d, k) = elements d * bigarray_kind_sizeof k +let sizeof (T (d, k)) = elements d * bigarray_kind_sizeof k -let alignment (d, k) = bigarray_kind_alignment k +let alignment (T (d, k)) = bigarray_kind_alignment k -let bigarray ds k = (DimsGen ds, kind k) -let bigarray1 d k = (Dims1 d, kind k) -let bigarray2 d1 d2 k = (Dims2 (d1, d2), kind k) -let bigarray3 d1 d2 d3 k = (Dims3 (d1, d2, d3), kind k) +let bigarray ds k = T (DimsGen ds, kind k) +let bigarray1 d k = T (Dims1 d, kind k) +let bigarray2 d1 d2 k = T (Dims2 (d1, d2), kind k) +let bigarray3 d1 d2 d3 k = T (Dims3 (d1, d2, d3), kind k) let format_kind fmt k = Format.pp_print_string fmt (string_of_kind k) @@ -75,19 +112,17 @@ let format_dims : type a b. _ -> (b, a) dims -> unit | Dims2 (d1, d2) -> Format.fprintf fmt "[%d][%d]" d1 d2 | Dims3 (d1, d2, d3) -> Format.fprintf fmt "[%d][%d][%d]" d1 d2 d3 -let format fmt (t, ck) = +let format fmt (T (t, ck)) = begin format_kind fmt ck; format_dims fmt t end -let prim_of_kind k = prim_of_kind (kind k) - let address _ b = Bigarray_stubs.address b let view : type a b. (a, b) t -> ?ref:Obj.t -> Ctypes_raw.voidp -> offset:int -> b = let open Bigarray_stubs in - fun (dims, kind) ?ref ptr ~offset -> let ba : b = match dims with + fun (T (dims, kind)) ?ref ptr ~offset -> let ba : b = match dims with | DimsGen ds -> view kind ds ptr offset | Dims1 d -> view1 kind [| d |] ptr offset | Dims2 (d1, d2) -> view2 kind [| d1; d2 |] ptr offset diff --git a/src/ctypes/ctypes_bigarray.mli b/src/ctypes/ctypes_bigarray.mli index 56d6f2f6..566ce7ff 100644 --- a/src/ctypes/ctypes_bigarray.mli +++ b/src/ctypes/ctypes_bigarray.mli @@ -12,6 +12,50 @@ type ('a, 'b) t [(a, b) t] can be used to read and write values of type [b] at particular addresses. *) +type _ kind + +module Kinds : sig + val ba_float32 : < element: float; + ba_repr: Bigarray.float32_elt; + storage_type: float > kind + val ba_float64 : < element: float; + ba_repr: Bigarray.float64_elt; + storage_type: float > kind + val ba_int8_signed : < element: int; + ba_repr: Bigarray.int8_signed_elt; + storage_type: int > kind + val ba_int8_unsigned : < element: int; + ba_repr: Bigarray.int8_unsigned_elt; + storage_type: Unsigned.uint8 > kind + val ba_int16_signed : < element: int; + ba_repr: Bigarray.int16_signed_elt; + storage_type: int > kind + val ba_int16_unsigned : < element: int; + ba_repr: Bigarray.int16_unsigned_elt; + storage_type: Unsigned.uint16 > kind + val ba_int32 : < element: int32; + ba_repr: Bigarray.int32_elt; + storage_type: int32 > kind + val ba_int64 : < element: int64; + ba_repr: Bigarray.int64_elt; + storage_type: int64 > kind + val ba_nativeint : < element: nativeint; + ba_repr: Bigarray.nativeint_elt; + storage_type: nativeint > kind + val ba_complex32 : < element: Complex.t; + ba_repr: Bigarray.complex32_elt; + storage_type: Complex.t > kind + val ba_complex64 : < element: Complex.t; + ba_repr: Bigarray.complex64_elt; + storage_type: Complex.t > kind + val ba_int : < element: int; + ba_repr: Bigarray.int_elt; + storage_type: int > kind + val ba_char : < element: char; + ba_repr: Bigarray.int8_unsigned_elt; + storage_type: char > kind +end + (** {3 Type constructors *) val bigarray : int array -> ('a, 'b) Bigarray.kind -> @@ -30,7 +74,11 @@ val bigarray3 : int -> int -> int -> ('a, 'b) Bigarray.kind -> ('a, ('a, 'b, Bigarray.c_layout) Bigarray.Array3.t) t (** Create a {!t} value for the {!Bigarray.Array3.t} type. *) -val prim_of_kind : ('a, _) Bigarray.kind -> 'a Primitives.prim +val ba_kind_of_kind : < element: 'a; ba_repr: 'b; storage_type: _> kind -> + ('a, 'b) Bigarray.kind + +val storage_type_of_kind : < element: 'a; ba_repr: 'b; storage_type: 'c > kind -> + 'c Primitives.prim (** Create a {!Ctypes_raw.Types.ctype} for a {!Bigarray.kind}. *) (** {3 Type eliminators *) diff --git a/src/ctypes/memory.ml b/src/ctypes/memory.ml index 14d92203..f3dd6863 100644 --- a/src/ctypes/memory.ml +++ b/src/ctypes/memory.ml @@ -219,48 +219,58 @@ let addr { structured } = structured open Bigarray +include Ctypes_bigarray.Kinds + let _bigarray_start kind typ ba = let raw_address = Ctypes_bigarray.address typ ba in - let reftype = Primitive (Ctypes_bigarray.prim_of_kind kind) in + let reftype = Primitive (Ctypes_bigarray.storage_type_of_kind kind) in { reftype = reftype ; raw_ptr = raw_address ; pmanaged = Some (Obj.repr ba) ; pbyte_offset = 0 } -let bigarray_start : type a b c d f. +let bigarray_start : type a b c d e f. < element: a; ba_repr: f; bigarray: b; carray: c; - dims: d > bigarray_class -> b -> a ptr - = fun spec ba -> match spec with + storage_type: e; + dims: d > bigarray_class -> + < element: a; + ba_repr: f; + storage_type: e > Ctypes_bigarray.kind -> b -> e ptr + = fun spec k ba -> match spec with | Genarray -> let kind = Genarray.kind ba in let dims = Genarray.dims ba in - _bigarray_start kind (Ctypes_bigarray.bigarray dims kind) ba + _bigarray_start k (Ctypes_bigarray.bigarray dims kind) ba | Array1 -> let kind = Array1.kind ba in let d = Array1.dim ba in - _bigarray_start kind (Ctypes_bigarray.bigarray1 d kind) ba + _bigarray_start k (Ctypes_bigarray.bigarray1 d kind) ba | Array2 -> let kind = Array2.kind ba in let d1 = Array2.dim1 ba and d2 = Array2.dim2 ba in - _bigarray_start kind (Ctypes_bigarray.bigarray2 d1 d2 kind) ba + _bigarray_start k (Ctypes_bigarray.bigarray2 d1 d2 kind) ba | Array3 -> let kind = Array3.kind ba in let d1 = Array3.dim1 ba and d2 = Array3.dim2 ba and d3 = Array3.dim3 ba in - _bigarray_start kind (Ctypes_bigarray.bigarray3 d1 d2 d3 kind) ba + _bigarray_start k (Ctypes_bigarray.bigarray3 d1 d2 d3 kind) ba let castp reftype p = { p with reftype } -let array_of_bigarray : type a b c d e. +let array_of_bigarray : type a b c d e f. < element: a; ba_repr: e; + storage_type: f; bigarray: b; carray: c; - dims: d > bigarray_class -> b -> c - = fun spec ba -> - let { reftype } as element_ptr = bigarray_start spec ba in + dims: d > bigarray_class -> + < element: a; + ba_repr: e; + storage_type: f > Ctypes_bigarray.kind -> b -> c + = fun spec k ba -> + let { reftype } as element_ptr = bigarray_start spec k ba in match spec with | Genarray -> let ds = Genarray.dims ba in @@ -275,9 +285,10 @@ let array_of_bigarray : type a b c d e. let d1 = Array3.dim1 ba and d2 = Array3.dim2 ba and d3 = Array3.dim3 ba in Array.from_ptr (castp (array d2 (array d3 reftype)) element_ptr) d1 -let bigarray_elements : type a b c d f. +let bigarray_elements : type a b c d e f. < element: a; ba_repr: f; + storage_type: e; bigarray: b; carray: c; dims: d > bigarray_class -> d -> int @@ -290,9 +301,10 @@ let bigarray_elements : type a b c d f. let bigarray_of_ptr spec dims kind ptr = !@ (castp (bigarray spec dims kind) ptr) -let array_dims : type a b c d f. +let array_dims : type a b c d e f. < element: a; ba_repr: f; + storage_type: e; bigarray: b; carray: c array; dims: d > bigarray_class -> c array -> d = diff --git a/src/ctypes/static.ml b/src/ctypes/static.ml index fffe0822..0808a793 100644 --- a/src/ctypes/static.ml +++ b/src/ctypes/static.ml @@ -77,26 +77,32 @@ type _ bigarray_class = < element: 'a; dims: int std_array; ba_repr: 'b; + storage_type: 'c; bigarray: ('a, 'b, Bigarray.c_layout) Bigarray.Genarray.t; - carray: 'a array > bigarray_class + carray: 'c array > bigarray_class | Array1 : < element: 'a; dims: int; ba_repr: 'b; + storage_type: 'c; bigarray: ('a, 'b, Bigarray.c_layout) Bigarray.Array1.t; - carray: 'a array > bigarray_class + carray: 'c array > bigarray_class | Array2 : < element: 'a; dims: int * int; ba_repr: 'b; + storage_type: 'c; bigarray: ('a, 'b, Bigarray.c_layout) Bigarray.Array2.t; - carray: 'a array array > bigarray_class + carray: 'c array array > bigarray_class | Array3 : < element: 'a; dims: int * int * int; ba_repr: 'b; + storage_type: 'c; bigarray: ('a, 'b, Bigarray.c_layout) Bigarray.Array3.t; - carray: 'a array array array > bigarray_class + carray: 'c array array array > bigarray_class + +type 'a bigarray_kind = 'a Ctypes_bigarray.kind type _ fn = | Returns : 'a typ -> 'a fn @@ -183,20 +189,21 @@ let ( @->) f t = let abstract ~name ~size ~alignment = Abstract { aname = name; asize = size; aalignment = alignment } let view ?format_typ ~read ~write ty = View { read; write; format_typ; ty } -let bigarray : type a b c d e. +let bigarray : type a b c d e f. < element: a; dims: b; ba_repr: c; + storage_type: f; bigarray: d; carray: e > bigarray_class -> - b -> (a, c) Bigarray.kind -> d typ = + b -> < element: a; ba_repr: c; storage_type: f > Ctypes_bigarray.kind -> d typ = fun spec dims kind -> match spec with - | Genarray -> Bigarray (Ctypes_bigarray.bigarray dims kind) - | Array1 -> Bigarray (Ctypes_bigarray.bigarray1 dims kind) + | Genarray -> Bigarray Ctypes_bigarray.(bigarray dims (ba_kind_of_kind kind)) + | Array1 -> Bigarray Ctypes_bigarray.(bigarray1 dims (ba_kind_of_kind kind)) | Array2 -> let d1, d2 = dims in - Bigarray (Ctypes_bigarray.bigarray2 d1 d2 kind) + Bigarray Ctypes_bigarray.(bigarray2 d1 d2 (ba_kind_of_kind kind)) | Array3 -> let d1, d2, d3 = dims in - Bigarray (Ctypes_bigarray.bigarray3 d1 d2 d3 kind) + Bigarray Ctypes_bigarray.(bigarray3 d1 d2 d3 (ba_kind_of_kind kind)) let returning v = if not (passable v) then raise (Unsupported "Unsupported return type") diff --git a/tests/test-alignment/test_alignment.ml b/tests/test-alignment/test_alignment.ml index 80cc2f8b..c88a994b 100644 --- a/tests/test-alignment/test_alignment.ml +++ b/tests/test-alignment/test_alignment.ml @@ -232,21 +232,21 @@ let test_struct_tail_padding () = let test_bigarray_alignment () = let module M = struct module B = Bigarray - type k = K : ('a, 'b) Bigarray.kind * int -> k + type k = K : < element: _; ba_repr: _; storage_type: _ > bigarray_kind * int -> k let kind_alignments = [ - K (B.float32, alignment float); - K (B.float64, alignment double); - K (B.int8_signed, alignment int8_t); - K (B.int8_unsigned, alignment uint8_t); - K (B.int16_signed, alignment int16_t); - K (B.int16_unsigned, alignment uint16_t); - K (B.int32, alignment int32_t); - K (B.int64, alignment int64_t); - K (B.int, alignment (ptr void)); - K (B.nativeint, alignment (ptr void)); - K (B.complex32, alignment complex32); - K (B.complex64, alignment complex64); - K (B.char, alignment char); + K (ba_float32, alignment float); + K (ba_float64, alignment double); + K (ba_int8_signed, alignment int8_t); + K (ba_int8_unsigned, alignment uint8_t); + K (ba_int16_signed, alignment int16_t); + K (ba_int16_unsigned, alignment uint16_t); + K (ba_int32, alignment int32_t); + K (ba_int64, alignment int64_t); + K (ba_int, alignment (ptr void)); + K (ba_nativeint, alignment (ptr void)); + K (ba_complex32, alignment complex32); + K (ba_complex64, alignment complex64); + K (ba_char, alignment char); ] let () = begin diff --git a/tests/test-bigarrays/test_bigarrays.ml b/tests/test-bigarrays/test_bigarrays.ml index d116b9e4..6da68f8f 100644 --- a/tests/test-bigarrays/test_bigarrays.ml +++ b/tests/test-bigarrays/test_bigarrays.ml @@ -30,9 +30,9 @@ let array_of_list3 typ list3 = let list2_of_array array = List.map Array.to_list (Array.to_list array) -let matrix l = bigarray_of_array array2 BA.float64 (array_of_list2 double l) +let matrix l = bigarray_of_array array2 ba_float64 (array_of_list2 double l) -let unmatrix m = list2_of_array (array_of_bigarray array2 m) +let unmatrix m = list2_of_array (array_of_bigarray array2 ba_float64 m) let castp typ p = from_voidp typ (to_voidp p) @@ -43,7 +43,7 @@ let castp typ p = from_voidp typ (to_voidp p) let test_bigarray_of_ctypes_array () = (* One-dimensional Genarrays *) let a1 = Array.of_list int8_t [10; 20; 30; 40] in - let b1 = bigarray_of_array genarray BA.int8_signed a1 in + let b1 = bigarray_of_array genarray ba_int8_signed a1 in let () = begin assert_equal (Array.length a1) (BA.Genarray.nth_dim b1 0); for i = 0 to Array.length a1 - 1 do @@ -62,7 +62,7 @@ let test_bigarray_of_ctypes_array () = {re = 0.2; im = 2.0}; {re = 0.3; im = 3.0}; {re = 0.4; im = 4.0}]) in - let b2 = bigarray_of_array array1 BA.complex32 a2 in + let b2 = bigarray_of_array array1 ba_complex32 a2 in let () = begin assert_equal (Array.length a2) (BA.Array1.dim b2); for i = 0 to Array.length a2 - 1 do @@ -71,30 +71,31 @@ let test_bigarray_of_ctypes_array () = end in (* Two-dimensional Genarrays *) - let uint16 = view uint16_t - ~read:Unsigned.UInt16.to_int ~write:Unsigned.UInt16.of_int in - let a3 = array_of_list2 uint16 - [[5; 10; 15]; - [3; 6; 9]; - [2; 4; 6]; - [1; 2; 3]] in - let b3 = BA.reshape (bigarray_of_array genarray BA.int16_unsigned + let a3 = array_of_list2 uint16_t + (List.map (List.map Unsigned.UInt16.of_int) + [[5; 10; 15]; + [3; 6; 9]; + [2; 4; 6]; + [1; 2; 3]]) in + let b3 = BA.reshape (bigarray_of_array genarray ba_int16_unsigned (Array.from_ptr - (castp uint16 (Array.start a3)) 12)) + (castp uint16_t (Array.start a3)) 12)) [| 4; 3 |] in let () = begin assert_equal (Array.length a3) (BA.Genarray.nth_dim b3 0); assert_equal (Array.length a3.(0)) (BA.Genarray.nth_dim b3 1); for i = 0 to Array.length a3 - 1 do for j = 0 to Array.length a3.(0) - 1 do - assert_equal a3.(i).(j) (BA.Genarray.get b3 [|i; j|]) + assert_equal + (Unsigned.UInt16.to_int a3.(i).(j)) + (BA.Genarray.get b3 [|i; j|]) done done end in (* Array2 *) let a4 = array_of_list2 nativeint [[5n; 10n]; [3n; 6n]; [1n; 2n]] in - let b4 = bigarray_of_array array2 BA.nativeint a4 in + let b4 = bigarray_of_array array2 ba_nativeint a4 in let () = begin assert_equal (Array.length a4) (BA.Array2.dim1 b4); assert_equal (Array.length a4.(0)) (BA.Array2.dim2 b4); @@ -115,7 +116,7 @@ let test_bigarray_of_ctypes_array () = [200L; 400L; 600L; 800L; 1000L]]] in let b5 = BA.reshape - (bigarray_of_array genarray BA.int64 + (bigarray_of_array genarray ba_int64 (Array.from_ptr (castp int64_t (Array.start a5)) 30)) [| 3; 2; 5 |] in let () = begin @@ -140,7 +141,7 @@ let test_bigarray_of_ctypes_array () = [[100.; 200.; 300.; 400.]; [200.; 400.; 600.; 800.]]] in - let b6 = bigarray_of_array array3 BA.float64 a6 in + let b6 = bigarray_of_array array3 ba_float64 a6 in let () = begin assert_equal (Array.length a6) (BA.Array3.dim1 b6); assert_equal (Array.length a6.(0)) (BA.Array3.dim2 b6); @@ -164,7 +165,7 @@ let test_ctypes_array_of_bigarray () = (* One-dimensional Genarrays *) let b1_dim = 6 in let b1 = BA.(Genarray.create float32 c_layout) [| b1_dim |] in - let a1 = array_of_bigarray genarray b1 in + let a1 = array_of_bigarray genarray ba_float32 b1 in begin assert_equal (BA.Genarray.nth_dim b1 0) (Array.length a1); @@ -179,7 +180,7 @@ let test_ctypes_array_of_bigarray () = (* Array1 *) let b2_dim = 7 in let b2 = BA.(Array1.create int8_unsigned c_layout) b2_dim in - let a2 = array_of_bigarray array1 b2 in + let a2 = array_of_bigarray array1 ba_int8_unsigned b2 in begin assert_equal (BA.Array1.dim b2) (Array.length a2); @@ -188,7 +189,7 @@ let test_ctypes_array_of_bigarray () = [ 2; 4; 6; 8; 10; 12; 14 ]; for i = 0 to b2_dim - 1 do - assert_equal b2.{i} a2.(i) + assert_equal b2.{i} (Unsigned.UInt8.to_int a2.(i)) done end; @@ -196,7 +197,7 @@ let test_ctypes_array_of_bigarray () = let b3_dim1 = 4 and b3_dim2 = 2 in let b3 = BA.(Genarray.create int16_signed c_layout) [| b3_dim1; b3_dim2 |] in let a3 = Array.from_ptr - (castp (array b3_dim2 int16_t) (bigarray_start genarray b3)) + (castp (array b3_dim2 int16_t) (bigarray_start genarray ba_int16_signed b3)) b3_dim1 in begin assert_equal (BA.Genarray.nth_dim b3 0) (Array.length a3); @@ -220,7 +221,7 @@ let test_ctypes_array_of_bigarray () = (* Array2 *) let b4_dim1 = 3 and b4_dim2 = 4 in let b4 = BA.(Array2.create int32 c_layout) b4_dim1 b4_dim2 in - let a4 = array_of_bigarray array2 b4 in + let a4 = array_of_bigarray array2 ba_int32 b4 in begin assert_equal (BA.Array2.dim1 b4) (Array.length a4); assert_equal (BA.Array2.dim2 b4) (Array.length a4.(0)); @@ -243,7 +244,7 @@ let test_ctypes_array_of_bigarray () = let b5_dim1 = 4 and b5_dim2 = 2 and b5_dim3 = 5 in let b5 = BA.(Genarray.create int c_layout) [| b5_dim1; b5_dim2; b5_dim3 |] in let a5 = Array.from_ptr - (castp (array b5_dim2 (array b5_dim3 camlint)) (bigarray_start genarray b5)) + (castp (array b5_dim2 (array b5_dim3 camlint)) (bigarray_start genarray ba_int b5)) b5_dim1 in begin assert_equal @@ -284,7 +285,7 @@ let test_ctypes_array_of_bigarray () = abs_float (lre -. rre) < eps64 && abs_float (lim -. rim) < eps64 in let b6_dim1 = 3 and b6_dim2 = 4 and b6_dim3 = 2 in let b6 = BA.(Array3.create complex64 c_layout) b6_dim1 b6_dim2 b6_dim3 in - let a6 = array_of_bigarray array3 b6 in + let a6 = array_of_bigarray array3 ba_complex64 b6 in begin assert_equal (BA.Array3.dim1 b6) (Array.length a6); assert_equal (BA.Array3.dim2 b6) (Array.length a6.(0)); @@ -334,7 +335,7 @@ let test_passing_bigarrays () = let o = BA.Array2.dim1 r and p = BA.Array2.dim2 r in assert (n = o); let product = BA.(Array2.(create (kind l)) c_layout) m p in - let addr = bigarray_start array2 in + let addr = bigarray_start array2 ba_float64 in matrix_mul m n p (addr l) (addr r) (addr product); product in assert_equal @@ -366,8 +367,8 @@ let test_returning_bigarrays () = let transpose m = (* For the purposes of the test we'll just leak the allocated memory. *) let rows = BA.Array2.dim1 m and cols = BA.Array2.dim2 m in - bigarray_of_ptr array2 (cols, rows) BA.float64 - (matrix_transpose rows cols (bigarray_start array2 m)) in + bigarray_of_ptr array2 (cols, rows) ba_float64 + (matrix_transpose rows cols (bigarray_start array2 ba_float64 m)) in assert_equal [[25.; 1.]; [15.; 2.]; @@ -400,7 +401,7 @@ let test_bigarray_lifetime_with_ctypes_reference () = begin ba.{0,0} <- 1; Gc.finalise finalise ba; - bigarray_start array2 ba + bigarray_start array2 ba_int ba end in (* The bigarray is out of scope, but the ctypes object is still live, so @@ -441,7 +442,7 @@ let test_ctypes_memory_lifetime_with_bigarray_reference () = let a = Array.make ~finalise int64_t 5 in begin for i = 0 to 4 do a.(i) <- Int64.(add (of_int i) one) done; - bigarray_of_array array1 BA.int64 a + bigarray_of_array array1 ba_int64 a end in (* The ctypes object is out of scope, but the bigarray is still live, so diff --git a/tests/test-coercions/test_coercions.ml b/tests/test-coercions/test_coercions.ml index 5b587ac1..0dcccc51 100644 --- a/tests/test-coercions/test_coercions.ml +++ b/tests/test-coercions/test_coercions.ml @@ -25,7 +25,7 @@ let test_pointer_coercions () = T complex64; T (ptr double); T string; - T (bigarray array1 10 Bigarray.int32); + T (bigarray array1 10 ba_int32); T (array 5 int32_t); T (structure "s"); T (union "u"); @@ -143,7 +143,7 @@ let test_unsupported_coercions () = T float; T short; T complex64; - T (bigarray array1 10 Bigarray.int32); + T (bigarray array1 10 ba_int32); T (array 5 int32_t); T (structure "s"); T (union "u"); diff --git a/tests/test-passable/test_passable.ml b/tests/test-passable/test_passable.ml index 626f69bc..f7339782 100644 --- a/tests/test-passable/test_passable.ml +++ b/tests/test-passable/test_passable.ml @@ -122,35 +122,35 @@ let test_arrays_are_not_passable () = let test_bigarrays_are_not_passable () = assert_raises ~msg:"bigarray type rejected as argument" (Unsupported "Unsupported argument type") - (fun () -> bigarray genarray [|1|] Bigarray.int @-> returning void); + (fun () -> bigarray genarray [|1|] ba_int @-> returning void); assert_raises ~msg:"bigarray1 type rejected as argument" (Unsupported "Unsupported argument type") - (fun () -> bigarray array1 1 Bigarray.int @-> returning void); + (fun () -> bigarray array1 1 ba_int @-> returning void); assert_raises ~msg:"bigarray2 type rejected as argument" (Unsupported "Unsupported argument type") - (fun () -> bigarray array2 (1, 2) Bigarray.int @-> returning void); + (fun () -> bigarray array2 (1, 2) ba_int @-> returning void); assert_raises ~msg:"bigarray3 type rejected as argument" (Unsupported "Unsupported argument type") - (fun () -> bigarray array3 (1, 2, 3) Bigarray.int @-> returning void); + (fun () -> bigarray array3 (1, 2, 3) ba_int @-> returning void); assert_raises ~msg:"bigarray type rejected as return type" (Unsupported "Unsupported return type") - (fun () -> void @-> returning (bigarray genarray [|1|] Bigarray.int)); + (fun () -> void @-> returning (bigarray genarray [|1|] ba_int)); assert_raises ~msg:"bigarray1 type rejected as return type" (Unsupported "Unsupported return type") - (fun () -> void @-> returning (bigarray array1 1 Bigarray.int)); + (fun () -> void @-> returning (bigarray array1 1 ba_int)); assert_raises ~msg:"bigarray2 type rejected as return type" (Unsupported "Unsupported return type") - (fun () -> void @-> returning (bigarray array2 (1, 2) Bigarray.int)); + (fun () -> void @-> returning (bigarray array2 (1, 2) ba_int)); assert_raises ~msg:"bigarray3 type rejected as return type" (Unsupported "Unsupported return type") - (fun () -> void @-> returning (bigarray array3 (1, 2, 3) Bigarray.int)) + (fun () -> void @-> returning (bigarray array3 (1, 2, 3) ba_int)) (* diff --git a/tests/test-sizeof/test_sizeof.ml b/tests/test-sizeof/test_sizeof.ml index 6992ee87..4af11095 100644 --- a/tests/test-sizeof/test_sizeof.ml +++ b/tests/test-sizeof/test_sizeof.ml @@ -158,21 +158,21 @@ end let test_sizeof_bigarrays () = let module M = struct module B = Bigarray - type k = K : ('a, 'b) Bigarray.kind * int -> k + type k = K : < element: _; ba_repr: _; storage_type: _ > bigarray_kind * int -> k let kind_sizes = [ - K (B.float32, 4); - K (B.float64, 8); - K (B.int8_signed, 1); - K (B.int8_unsigned, 1); - K (B.int16_signed, 2); - K (B.int16_unsigned, 2); - K (B.int32, 4); - K (B.int64, 8); - K (B.int, sizeof (ptr void)); - K (B.nativeint, sizeof (ptr void)); - K (B.complex32, 8); - K (B.complex64, 16); - K (B.char, 1); + K (ba_float32, 4); + K (ba_float64, 8); + K (ba_int8_signed, 1); + K (ba_int8_unsigned, 1); + K (ba_int16_signed, 2); + K (ba_int16_unsigned, 2); + K (ba_int32, 4); + K (ba_int64, 8); + K (ba_int, sizeof (ptr void)); + K (ba_nativeint, sizeof (ptr void)); + K (ba_complex32, 8); + K (ba_complex64, 16); + K (ba_char, 1); ] let () = begin diff --git a/tests/test-type_printing/test_type_printing.ml b/tests/test-type_printing/test_type_printing.ml index 07a5cbc0..f5453724 100644 --- a/tests/test-type_printing/test_type_printing.ml +++ b/tests/test-type_printing/test_type_printing.ml @@ -389,44 +389,44 @@ let test_array_printing () = let test_bigarray_printing () = begin assert_typ_printed_as "" - (bigarray genarray [|10; 100|] Bigarray.float32); + (bigarray genarray [|10; 100|] ba_float32); assert_typ_printed_as "" - (bigarray genarray [|20; 30; 40|] Bigarray.float64); + (bigarray genarray [|20; 30; 40|] ba_float64); assert_typ_printed_as "" - (bigarray genarray [|1; 3|] Bigarray.int8_signed); + (bigarray genarray [|1; 3|] ba_int8_signed); assert_typ_printed_as "" - (bigarray array1 2 Bigarray.int8_unsigned); + (bigarray array1 2 ba_int8_unsigned); assert_typ_printed_as "" - (bigarray array1 3 Bigarray.int16_signed); + (bigarray array1 3 ba_int16_signed); assert_typ_printed_as "" - (bigarray array1 4 Bigarray.int16_unsigned); + (bigarray array1 4 ba_int16_unsigned); assert_typ_printed_as "" - (bigarray array2 (5, 6) Bigarray.int32); + (bigarray array2 (5, 6) ba_int32); assert_typ_printed_as "" - (bigarray array2 (7, 8) Bigarray.int64); + (bigarray array2 (7, 8) ba_int64); assert_typ_printed_as "" - (bigarray array2 (9, 10) Bigarray.int); + (bigarray array2 (9, 10) ba_int); assert_typ_printed_as "" - (bigarray array3 (13, 14, 15) Bigarray.nativeint); + (bigarray array3 (13, 14, 15) ba_nativeint); assert_typ_printed_as "" - (bigarray array3 (16, 17, 18) Bigarray.complex32); + (bigarray array3 (16, 17, 18) ba_complex32); assert_typ_printed_as "" - (bigarray array3 (19, 20, 21) Bigarray.complex64); + (bigarray array3 (19, 20, 21) ba_complex64); assert_typ_printed_as ~name:"b" "int (*b[10])( *)" (array 10 - (Foreign.funptr (ptr (bigarray genarray [|5|] Bigarray.int) @-> + (Foreign.funptr (ptr (bigarray genarray [|5|] ba_int) @-> returning int))); end