Skip to content

Commit

Permalink
Lib: Update typing of typed arrays to support Wasm, and test Typed_ar…
Browse files Browse the repository at this point in the history 
…ray.Bytes (#1656)


Co-authored-by: Jérôme Vouillon <[email protected]>
Co-authored-by: Hugo Heuzard <[email protected]>
  • Loading branch information
@OlivierNicole @vouillon @hhugo
3 people committed Sep 13, 2024
1 parent 886855c commit 818dcd6
Show file tree
Hide file tree
Showing 4 changed files with 162 additions and 86 deletions.
1 change: 1 addition & 0 deletions CHANGES.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -14,6 +14,7 @@
* Runtime: change Sys.os_type on windows (Cygwin -> Win32)
* Runtime: backtraces are really expensive, they need to be be explicitly
requested at compile time (--enable with-js-error) or at startup (OCAMLRUNPARAM=b=1)
* Lib: Modify Typed_array API for compatibility with WebAssembly


## Bug fixes
Expand Down
79 changes: 45 additions & 34 deletions lib/js_of_ocaml/typed_array.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -20,8 +20,6 @@
open! Import
open Js

type uint32 = float

class type arrayBuffer = object
method byteLength : int readonly_prop

Expand All @@ -40,7 +38,7 @@ class type arrayBufferView = object
method byteLength : int readonly_prop
end

class type ['a, 'b] typedArray = object
class type ['a, 'b, 'c] typedArray = object
inherit arrayBufferView

method _BYTES_PER_ELEMENT : int readonly_prop
Expand All @@ -49,47 +47,60 @@ class type ['a, 'b] typedArray = object

method set_fromArray : 'a js_array t -> int -> unit meth

method set_fromTypedArray : ('a, 'b) typedArray t -> int -> unit meth
method set_fromTypedArray : ('a, 'b, 'c) typedArray t -> int -> unit meth

method subarray : int -> int -> ('a, 'b) typedArray t meth
method subarray : int -> int -> ('a, 'b, 'c) typedArray t meth

method subarray_toEnd : int -> ('a, 'b) typedArray t meth
method subarray_toEnd : int -> ('a, 'b, 'c) typedArray t meth

method slice : int -> int -> ('a, 'b) typedArray t meth
method slice : int -> int -> ('a, 'b, 'c) typedArray t meth

method slice_toEnd : int -> ('a, 'b) typedArray t meth
method slice_toEnd : int -> ('a, 'b, 'c) typedArray t meth

(* This fake method is needed for typing purposes.
Without it, ['b] would not be constrained. *)
method _content_type_ : 'b optdef readonly_prop
method _content_type_ : ('b * 'c) optdef readonly_prop
end

type int8Array = (int, Bigarray.int8_signed_elt) typedArray
type int8Array = (int, int, Bigarray.int8_signed_elt) typedArray

type uint8Array = (int, int, Bigarray.int8_unsigned_elt) typedArray

type uint8Array = (int, Bigarray.int8_unsigned_elt) typedArray
type int16Array = (int, int, Bigarray.int16_signed_elt) typedArray

type int16Array = (int, Bigarray.int16_signed_elt) typedArray
type uint16Array = (int, int, Bigarray.int16_unsigned_elt) typedArray

type uint16Array = (int, Bigarray.int16_unsigned_elt) typedArray
type int32Array = (number_t, Int32.t, Bigarray.int32_elt) typedArray

type int32Array = (int32, Bigarray.int32_elt) typedArray
type uint32Array = (number_t, Int32.t, Bigarray.int32_elt) typedArray

type uint32Array = (int32, Bigarray.int32_elt) typedArray
type float32Array = (number_t, float, Bigarray.float32_elt) typedArray

type float32Array = (float, Bigarray.float32_elt) typedArray
type float64Array = (number_t, float, Bigarray.float64_elt) typedArray

type float64Array = (float, Bigarray.float64_elt) typedArray
type (_, _, _) kind =
| Int8_signed : (int, int, Bigarray.int8_signed_elt) kind
| Int8_unsigned : (int, int, Bigarray.int8_unsigned_elt) kind
| Int16_signed : (int, int, Bigarray.int16_signed_elt) kind
| Int16_unsigned : (int, int, Bigarray.int16_unsigned_elt) kind
| Int32_signed : (number_t, Int32.t, Bigarray.int32_elt) kind
| Int32_unsigned : (number_t, Int32.t, Bigarray.int32_elt) kind
| Float32 : (number_t, float, Bigarray.float32_elt) kind
| Float64 : (number_t, float, Bigarray.float64_elt) kind

external kind : ('a, 'b) typedArray t -> ('a, 'b) Bigarray.kind
external kind :
('typed_array, 'bigarray, 'elt) typedArray t -> ('bigarray, 'elt) Bigarray.kind
= "caml_ba_kind_of_typed_array"

external from_genarray :
('a, 'b, Bigarray.c_layout) Bigarray.Genarray.t -> ('a, 'b) typedArray t
= "caml_ba_to_typed_array"
external from_genarray_impl :
('bigarray, 'elt, Bigarray.c_layout) Bigarray.Genarray.t
-> ('typed_array, 'bigarray, 'elt) typedArray t = "caml_ba_to_typed_array"

external to_genarray :
('a, 'b) typedArray t -> ('a, 'b, Bigarray.c_layout) Bigarray.Genarray.t
= "caml_ba_from_typed_array"
('typed_array, 'bigarray, 'elt) typedArray t
-> ('bigarray, 'elt, Bigarray.c_layout) Bigarray.Genarray.t = "caml_ba_from_typed_array"

let from_genarray (_ : ('typed_array, 'bigarray, 'elt) kind) a = from_genarray_impl a

let int8Array = Js.Unsafe.global##._Int8Array

Expand Down Expand Up @@ -171,12 +182,12 @@ let float64Array_fromBuffer = float64Array

let float64Array_inBuffer = float64Array

let set : ('a, 'b) typedArray t -> int -> 'a -> unit =
let set : ('a, _, _) typedArray t -> int -> 'a -> unit =
fun a i v -> array_set (Unsafe.coerce a) i v

let get : ('a, 'b) typedArray t -> int -> 'a optdef = fun a i -> Js.Unsafe.get a i
let get : ('a, _, _) typedArray t -> int -> 'a optdef = fun a i -> Js.Unsafe.get a i

let unsafe_get : ('a, 'b) typedArray t -> int -> 'a = fun a i -> Js.Unsafe.get a i
let unsafe_get : ('a, _, _) typedArray t -> int -> 'a = fun a i -> Js.Unsafe.get a i

class type dataView = object
inherit arrayBufferView
Expand All @@ -193,13 +204,13 @@ class type dataView = object

method getUint16_ : int -> bool t -> int meth

method getInt32 : int -> int meth
method getInt32 : int -> number_t meth

method getInt32_ : int -> bool t -> int meth
method getInt32_ : int -> bool t -> number_t meth

method getUint32 : int -> uint32 meth
method getUint32 : int -> number_t meth

method getUint32_ : int -> bool t -> uint32 meth
method getUint32_ : int -> bool t -> number_t meth

method getFloat32 : int -> number_t meth

Expand All @@ -221,13 +232,13 @@ class type dataView = object

method setUint16_ : int -> int -> bool t -> unit meth

method setInt32 : int -> int -> unit meth
method setInt32 : int -> number_t -> unit meth

method setInt32_ : int -> int -> bool t -> unit meth
method setInt32_ : int -> number_t -> bool t -> unit meth

method setUint32 : int -> uint32 -> unit meth
method setUint32 : int -> number_t -> unit meth

method setUint32_ : int -> uint32 -> bool t -> unit meth
method setUint32_ : int -> number_t -> bool t -> unit meth

method setFloat32 : int -> number_t -> unit meth

Expand Down
82 changes: 50 additions & 32 deletions lib/js_of_ocaml/typed_array.mli
View file
Original file line number Diff line number Diff line change
Expand Up @@ -22,8 +22,6 @@

open Js

type uint32 = float

class type arrayBuffer = object
method byteLength : int readonly_prop

Expand All @@ -42,7 +40,7 @@ class type arrayBufferView = object
method byteLength : int readonly_prop
end

class type ['a, 'b] typedArray = object
class type ['a, 'b, 'c] typedArray = object
inherit arrayBufferView

method _BYTES_PER_ELEMENT : int readonly_prop
Expand All @@ -51,41 +49,61 @@ class type ['a, 'b] typedArray = object

method set_fromArray : 'a js_array t -> int -> unit meth

method set_fromTypedArray : ('a, 'b) typedArray t -> int -> unit meth
method set_fromTypedArray : ('a, 'b, 'c) typedArray t -> int -> unit meth

method subarray : int -> int -> ('a, 'b) typedArray t meth
method subarray : int -> int -> ('a, 'b, 'c) typedArray t meth

method subarray_toEnd : int -> ('a, 'b) typedArray t meth
method subarray_toEnd : int -> ('a, 'b, 'c) typedArray t meth

method slice : int -> int -> ('a, 'b) typedArray t meth
method slice : int -> int -> ('a, 'b, 'c) typedArray t meth

method slice_toEnd : int -> ('a, 'b) typedArray t meth
method slice_toEnd : int -> ('a, 'b, 'c) typedArray t meth

method _content_type_ : 'b optdef readonly_prop
(* This fake method is needed for typing purposes. Without it, ['b] would not
be constrained. *)
method _content_type_ : ('b * 'c) optdef readonly_prop
end

type int8Array = (int, Bigarray.int8_signed_elt) typedArray
type int8Array = (int, int, Bigarray.int8_signed_elt) typedArray

type uint8Array = (int, int, Bigarray.int8_unsigned_elt) typedArray

type uint8Array = (int, Bigarray.int8_unsigned_elt) typedArray
type int16Array = (int, int, Bigarray.int16_signed_elt) typedArray

type int16Array = (int, Bigarray.int16_signed_elt) typedArray
type uint16Array = (int, int, Bigarray.int16_unsigned_elt) typedArray

type uint16Array = (int, Bigarray.int16_unsigned_elt) typedArray
type int32Array = (number_t, Int32.t, Bigarray.int32_elt) typedArray

type int32Array = (int32, Bigarray.int32_elt) typedArray
type uint32Array = (number_t, Int32.t, Bigarray.int32_elt) typedArray

type uint32Array = (int32, Bigarray.int32_elt) typedArray
type float32Array = (number_t, float, Bigarray.float32_elt) typedArray

type float32Array = (float, Bigarray.float32_elt) typedArray
type float64Array = (number_t, float, Bigarray.float64_elt) typedArray

type float64Array = (float, Bigarray.float64_elt) typedArray
(** The first type parameter is the type of values that can be read and written
in the {!classtype:typedArray}. The last two type parameters define the
kind of bigarrays that can be converted to and from the
{!classtype:typedArray}. See {!type:Bigarray.kind}. *)
type (_, _, _) kind =
| Int8_signed : (int, int, Bigarray.int8_signed_elt) kind
| Int8_unsigned : (int, int, Bigarray.int8_unsigned_elt) kind
| Int16_signed : (int, int, Bigarray.int16_signed_elt) kind
| Int16_unsigned : (int, int, Bigarray.int16_unsigned_elt) kind
| Int32_signed : (number_t, Int32.t, Bigarray.int32_elt) kind
| Int32_unsigned : (number_t, Int32.t, Bigarray.int32_elt) kind
| Float32 : (number_t, float, Bigarray.float32_elt) kind
| Float64 : (number_t, float, Bigarray.float64_elt) kind

val kind : ('a, 'b) typedArray t -> ('a, 'b) Bigarray.kind
val kind : ('typed_array, 'bigarray, 'elt) typedArray t -> ('bigarray, 'elt) Bigarray.kind

val from_genarray :
('a, 'b, Bigarray.c_layout) Bigarray.Genarray.t -> ('a, 'b) typedArray t
('typed_array, 'bigarray, 'elt) kind
-> ('bigarray, 'elt, Bigarray.c_layout) Bigarray.Genarray.t
-> ('typed_array, 'bigarray, 'elt) typedArray t

val to_genarray : ('a, 'b) typedArray t -> ('a, 'b, Bigarray.c_layout) Bigarray.Genarray.t
val to_genarray :
('typed_array, 'bigarray, 'elt) typedArray t
-> ('bigarray, 'elt, Bigarray.c_layout) Bigarray.Genarray.t

val int8Array : (int -> int8Array t) constr

Expand Down Expand Up @@ -139,7 +157,7 @@ val int32Array_inBuffer : (arrayBuffer t -> int -> int -> int32Array t) constr

val uint32Array : (int -> uint32Array t) constr

val uint32Array_fromArray : (uint32 js_array t -> uint32Array t) constr
val uint32Array_fromArray : (number_t js_array t -> uint32Array t) constr

val uint32Array_fromTypedArray : (uint32Array t -> uint32Array t) constr

Expand Down Expand Up @@ -167,11 +185,11 @@ val float64Array_fromBuffer : (arrayBuffer t -> float64Array t) constr

val float64Array_inBuffer : (arrayBuffer t -> int -> int -> float64Array t) constr

val set : ('a, 'b) typedArray t -> int -> 'a -> unit
val set : ('a, _, _) typedArray t -> int -> 'a -> unit

val get : ('a, 'b) typedArray t -> int -> 'a optdef
val get : ('a, _, _) typedArray t -> int -> 'a optdef

val unsafe_get : ('a, 'b) typedArray t -> int -> 'a
val unsafe_get : ('a, _, _) typedArray t -> int -> 'a

class type dataView = object
inherit arrayBufferView
Expand All @@ -188,13 +206,13 @@ class type dataView = object

method getUint16_ : int -> bool t -> int meth

method getInt32 : int -> int meth
method getInt32 : int -> number_t meth

method getInt32_ : int -> bool t -> int meth
method getInt32_ : int -> bool t -> number_t meth

method getUint32 : int -> uint32 meth
method getUint32 : int -> number_t meth

method getUint32_ : int -> bool t -> uint32 meth
method getUint32_ : int -> bool t -> number_t meth

method getFloat32 : int -> number_t meth

Expand All @@ -216,13 +234,13 @@ class type dataView = object

method setUint16_ : int -> int -> bool t -> unit meth

method setInt32 : int -> int -> unit meth
method setInt32 : int -> number_t -> unit meth

method setInt32_ : int -> int -> bool t -> unit meth
method setInt32_ : int -> number_t -> bool t -> unit meth

method setUint32 : int -> uint32 -> unit meth
method setUint32 : int -> number_t -> unit meth

method setUint32_ : int -> uint32 -> bool t -> unit meth
method setUint32_ : int -> number_t -> bool t -> unit meth

method setFloat32 : int -> number_t -> unit meth

Expand Down
Loading

0 comments on commit 818dcd6

Please sign in to comment.