Skip to content

Commit 818dcd6

Browse files
OlivierNicolevouillonhhugo
authored
Lib: Update typing of typed arrays to support Wasm, and test Typed_array.Bytes (#1656)
 Co-authored-by: Jérôme Vouillon <jerome.vouillon@gmail.com> Co-authored-by: Hugo Heuzard <hugo.heuzard@gmail.com>
1 parent 886855c commit 818dcd6

File tree

4 files changed

+162
-86
lines changed

4 files changed

+162
-86
lines changed

‎CHANGES.md

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -14,6 +14,7 @@
1414
* Runtime: change Sys.os_type on windows (Cygwin -> Win32)
1515
* Runtime: backtraces are really expensive, they need to be be explicitly
1616
requested at compile time (--enable with-js-error) or at startup (OCAMLRUNPARAM=b=1)
17+
* Lib: Modify Typed_array API for compatibility with WebAssembly
1718

1819

1920
## Bug fixes

‎lib/js_of_ocaml/typed_array.ml

Lines changed: 45 additions & 34 deletions
Original file line numberDiff line numberDiff line change
@@ -20,8 +20,6 @@
2020
open! Import
2121
open Js
2222

23-
type uint32 = float
24-
2523
class type arrayBuffer = object
2624
method byteLength : int readonly_prop
2725

@@ -40,7 +38,7 @@ class type arrayBufferView = object
4038
method byteLength : int readonly_prop
4139
end
4240

43-
class type ['a, 'b] typedArray = object
41+
class type ['a, 'b, 'c] typedArray = object
4442
inherit arrayBufferView
4543

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

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

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

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

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

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

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

6260
(* This fake method is needed for typing purposes.
6361
Without it, ['b] would not be constrained. *)
64-
method _content_type_ : 'b optdef readonly_prop
62+
method _content_type_ : ('b * 'c) optdef readonly_prop
6563
end
6664

67-
type int8Array = (int, Bigarray.int8_signed_elt) typedArray
65+
type int8Array = (int, int, Bigarray.int8_signed_elt) typedArray
66+
67+
type uint8Array = (int, int, Bigarray.int8_unsigned_elt) typedArray
6868

69-
type uint8Array = (int, Bigarray.int8_unsigned_elt) typedArray
69+
type int16Array = (int, int, Bigarray.int16_signed_elt) typedArray
7070

71-
type int16Array = (int, Bigarray.int16_signed_elt) typedArray
71+
type uint16Array = (int, int, Bigarray.int16_unsigned_elt) typedArray
7272

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

75-
type int32Array = (int32, Bigarray.int32_elt) typedArray
75+
type uint32Array = (number_t, Int32.t, Bigarray.int32_elt) typedArray
7676

77-
type uint32Array = (int32, Bigarray.int32_elt) typedArray
77+
type float32Array = (number_t, float, Bigarray.float32_elt) typedArray
7878

79-
type float32Array = (float, Bigarray.float32_elt) typedArray
79+
type float64Array = (number_t, float, Bigarray.float64_elt) typedArray
8080

81-
type float64Array = (float, Bigarray.float64_elt) typedArray
81+
type (_, _, _) kind =
82+
| Int8_signed : (int, int, Bigarray.int8_signed_elt) kind
83+
| Int8_unsigned : (int, int, Bigarray.int8_unsigned_elt) kind
84+
| Int16_signed : (int, int, Bigarray.int16_signed_elt) kind
85+
| Int16_unsigned : (int, int, Bigarray.int16_unsigned_elt) kind
86+
| Int32_signed : (number_t, Int32.t, Bigarray.int32_elt) kind
87+
| Int32_unsigned : (number_t, Int32.t, Bigarray.int32_elt) kind
88+
| Float32 : (number_t, float, Bigarray.float32_elt) kind
89+
| Float64 : (number_t, float, Bigarray.float64_elt) kind
8290

83-
external kind : ('a, 'b) typedArray t -> ('a, 'b) Bigarray.kind
91+
external kind :
92+
('typed_array, 'bigarray, 'elt) typedArray t -> ('bigarray, 'elt) Bigarray.kind
8493
= "caml_ba_kind_of_typed_array"
8594

86-
external from_genarray :
87-
('a, 'b, Bigarray.c_layout) Bigarray.Genarray.t -> ('a, 'b) typedArray t
88-
= "caml_ba_to_typed_array"
95+
external from_genarray_impl :
96+
('bigarray, 'elt, Bigarray.c_layout) Bigarray.Genarray.t
97+
-> ('typed_array, 'bigarray, 'elt) typedArray t = "caml_ba_to_typed_array"
8998

9099
external to_genarray :
91-
('a, 'b) typedArray t -> ('a, 'b, Bigarray.c_layout) Bigarray.Genarray.t
92-
= "caml_ba_from_typed_array"
100+
('typed_array, 'bigarray, 'elt) typedArray t
101+
-> ('bigarray, 'elt, Bigarray.c_layout) Bigarray.Genarray.t = "caml_ba_from_typed_array"
102+
103+
let from_genarray (_ : ('typed_array, 'bigarray, 'elt) kind) a = from_genarray_impl a
93104

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

@@ -171,12 +182,12 @@ let float64Array_fromBuffer = float64Array
171182

172183
let float64Array_inBuffer = float64Array
173184

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

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

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

181192
class type dataView = object
182193
inherit arrayBufferView
@@ -193,13 +204,13 @@ class type dataView = object
193204

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

196-
method getInt32 : int -> int meth
207+
method getInt32 : int -> number_t meth
197208

198-
method getInt32_ : int -> bool t -> int meth
209+
method getInt32_ : int -> bool t -> number_t meth
199210

200-
method getUint32 : int -> uint32 meth
211+
method getUint32 : int -> number_t meth
201212

202-
method getUint32_ : int -> bool t -> uint32 meth
213+
method getUint32_ : int -> bool t -> number_t meth
203214

204215
method getFloat32 : int -> number_t meth
205216

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

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

224-
method setInt32 : int -> int -> unit meth
235+
method setInt32 : int -> number_t -> unit meth
225236

226-
method setInt32_ : int -> int -> bool t -> unit meth
237+
method setInt32_ : int -> number_t -> bool t -> unit meth
227238

228-
method setUint32 : int -> uint32 -> unit meth
239+
method setUint32 : int -> number_t -> unit meth
229240

230-
method setUint32_ : int -> uint32 -> bool t -> unit meth
241+
method setUint32_ : int -> number_t -> bool t -> unit meth
231242

232243
method setFloat32 : int -> number_t -> unit meth
233244

‎lib/js_of_ocaml/typed_array.mli

Lines changed: 50 additions & 32 deletions
Original file line numberDiff line numberDiff line change
@@ -22,8 +22,6 @@
2222

2323
open Js
2424

25-
type uint32 = float
26-
2725
class type arrayBuffer = object
2826
method byteLength : int readonly_prop
2927

@@ -42,7 +40,7 @@ class type arrayBufferView = object
4240
method byteLength : int readonly_prop
4341
end
4442

45-
class type ['a, 'b] typedArray = object
43+
class type ['a, 'b, 'c] typedArray = object
4644
inherit arrayBufferView
4745

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

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

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

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

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

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

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

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

67-
type int8Array = (int, Bigarray.int8_signed_elt) typedArray
67+
type int8Array = (int, int, Bigarray.int8_signed_elt) typedArray
68+
69+
type uint8Array = (int, int, Bigarray.int8_unsigned_elt) typedArray
6870

69-
type uint8Array = (int, Bigarray.int8_unsigned_elt) typedArray
71+
type int16Array = (int, int, Bigarray.int16_signed_elt) typedArray
7072

71-
type int16Array = (int, Bigarray.int16_signed_elt) typedArray
73+
type uint16Array = (int, int, Bigarray.int16_unsigned_elt) typedArray
7274

73-
type uint16Array = (int, Bigarray.int16_unsigned_elt) typedArray
75+
type int32Array = (number_t, Int32.t, Bigarray.int32_elt) typedArray
7476

75-
type int32Array = (int32, Bigarray.int32_elt) typedArray
77+
type uint32Array = (number_t, Int32.t, Bigarray.int32_elt) typedArray
7678

77-
type uint32Array = (int32, Bigarray.int32_elt) typedArray
79+
type float32Array = (number_t, float, Bigarray.float32_elt) typedArray
7880

79-
type float32Array = (float, Bigarray.float32_elt) typedArray
81+
type float64Array = (number_t, float, Bigarray.float64_elt) typedArray
8082

81-
type float64Array = (float, Bigarray.float64_elt) typedArray
83+
(** The first type parameter is the type of values that can be read and written
84+
in the {!classtype:typedArray}. The last two type parameters define the
85+
kind of bigarrays that can be converted to and from the
86+
{!classtype:typedArray}. See {!type:Bigarray.kind}. *)
87+
type (_, _, _) kind =
88+
| Int8_signed : (int, int, Bigarray.int8_signed_elt) kind
89+
| Int8_unsigned : (int, int, Bigarray.int8_unsigned_elt) kind
90+
| Int16_signed : (int, int, Bigarray.int16_signed_elt) kind
91+
| Int16_unsigned : (int, int, Bigarray.int16_unsigned_elt) kind
92+
| Int32_signed : (number_t, Int32.t, Bigarray.int32_elt) kind
93+
| Int32_unsigned : (number_t, Int32.t, Bigarray.int32_elt) kind
94+
| Float32 : (number_t, float, Bigarray.float32_elt) kind
95+
| Float64 : (number_t, float, Bigarray.float64_elt) kind
8296

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

8599
val from_genarray :
86-
('a, 'b, Bigarray.c_layout) Bigarray.Genarray.t -> ('a, 'b) typedArray t
100+
('typed_array, 'bigarray, 'elt) kind
101+
-> ('bigarray, 'elt, Bigarray.c_layout) Bigarray.Genarray.t
102+
-> ('typed_array, 'bigarray, 'elt) typedArray t
87103

88-
val to_genarray : ('a, 'b) typedArray t -> ('a, 'b, Bigarray.c_layout) Bigarray.Genarray.t
104+
val to_genarray :
105+
('typed_array, 'bigarray, 'elt) typedArray t
106+
-> ('bigarray, 'elt, Bigarray.c_layout) Bigarray.Genarray.t
89107

90108
val int8Array : (int -> int8Array t) constr
91109

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

140158
val uint32Array : (int -> uint32Array t) constr
141159

142-
val uint32Array_fromArray : (uint32 js_array t -> uint32Array t) constr
160+
val uint32Array_fromArray : (number_t js_array t -> uint32Array t) constr
143161

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

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

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

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

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

174-
val unsafe_get : ('a, 'b) typedArray t -> int -> 'a
192+
val unsafe_get : ('a, _, _) typedArray t -> int -> 'a
175193

176194
class type dataView = object
177195
inherit arrayBufferView
@@ -188,13 +206,13 @@ class type dataView = object
188206

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

191-
method getInt32 : int -> int meth
209+
method getInt32 : int -> number_t meth
192210

193-
method getInt32_ : int -> bool t -> int meth
211+
method getInt32_ : int -> bool t -> number_t meth
194212

195-
method getUint32 : int -> uint32 meth
213+
method getUint32 : int -> number_t meth
196214

197-
method getUint32_ : int -> bool t -> uint32 meth
215+
method getUint32_ : int -> bool t -> number_t meth
198216

199217
method getFloat32 : int -> number_t meth
200218

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

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

219-
method setInt32 : int -> int -> unit meth
237+
method setInt32 : int -> number_t -> unit meth
220238

221-
method setInt32_ : int -> int -> bool t -> unit meth
239+
method setInt32_ : int -> number_t -> bool t -> unit meth
222240

223-
method setUint32 : int -> uint32 -> unit meth
241+
method setUint32 : int -> number_t -> unit meth
224242

225-
method setUint32_ : int -> uint32 -> bool t -> unit meth
243+
method setUint32_ : int -> number_t -> bool t -> unit meth
226244

227245
method setFloat32 : int -> number_t -> unit meth
228246

0 commit comments

Comments
 (0)