Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Update typing of typed arrays to support Wasm, and test Typed_array.Bytes #1656

Merged
merged 12 commits into from
Sep 13, 2024
Merged

Update typing of typed arrays to support Wasm, and test Typed_array.Bytes #1656

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
12 commits
Select commit Hold shift + click to select a range
0c42fb7
Lib: update typing of typed arrays
vouillon Jul 24, 2023
cd285d8
Test new module Typed_array.Bytes
OlivierNicole Jul 18, 2024
27d2ccd
CR: rename `type'` to `kind`
OlivierNicole Sep 4, 2024
1e40d0d
CR: add type annotation
OlivierNicole Sep 4, 2024
0d1ccdc
Update changelog
OlivierNicole Sep 4, 2024
572262d
CR: remove int32 and uint32 type synonyms
OlivierNicole Sep 9, 2024
4e513ca
CR: Make char bigarray more consistent and test it
OlivierNicole Sep 9, 2024
8d5b974
CR
hhugo Sep 9, 2024
6631ec2
Revert "CR: Make char bigarray more consistent and test it"
OlivierNicole Sep 13, 2024
d4dbc7a
Forbid conversion of Char bigarrays to typed arrays
OlivierNicole Sep 13, 2024
6805fe6
CR: fix wrong method types
OlivierNicole Sep 13, 2024
c423a44
CR: Fix and document type parameters
OlivierNicole Sep 13, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions CHANGES.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -11,6 +11,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
Open in desktop
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
Open in desktop
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