From b9c00e98f59f475d5f386d4407064f6a1a9b6614 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?M=C3=A9di-R=C3=A9mi=20Hashim?= Date: Fri, 22 Aug 2025 13:04:57 +0200 Subject: [PATCH 1/2] Add support for ArrayBuffer to @unboxed --- compiler/ml/ast_untagged_variants.ml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/compiler/ml/ast_untagged_variants.ml b/compiler/ml/ast_untagged_variants.ml index 064bb1029b..f2c8754e0b 100644 --- a/compiler/ml/ast_untagged_variants.ml +++ b/compiler/ml/ast_untagged_variants.ml @@ -1,7 +1,8 @@ module Instance = struct - type t = Array | Blob | Date | File | Promise | RegExp + type t = Array | ArrayBuffer | Blob | Date | File | Promise | RegExp let to_string = function | Array -> "Array" + | ArrayBuffer -> "ArrayBuffer" | Blob -> "Blob" | Date -> "Date" | File -> "File" @@ -200,6 +201,7 @@ let type_to_instanceof_backed_obj (t : Types.type_expr) = | Tconstr (path, _, _) when Path.same path Predef.path_array -> Some Array | Tconstr (path, _, _) -> ( match Path.name path with + | "Stdlib_ArrayBuffer.t" -> Some ArrayBuffer | "Stdlib_Date.t" -> Some Date | "Stdlib_RegExp.t" -> Some RegExp | "Js_file.t" -> Some File From 3a3f1d68dc1d18ec0a12003886f4b8f9e3664f9b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?M=C3=A9di-R=C3=A9mi=20Hashim?= Date: Fri, 22 Aug 2025 13:22:55 +0200 Subject: [PATCH 2/2] Add support for typed arrays to @unboxed --- compiler/ml/ast_untagged_variants.ml | 95 +++++++++++++++++++++------- tests/tests/src/UntaggedVariants.mjs | 62 ++++++++++++++++-- tests/tests/src/UntaggedVariants.res | 36 +++++++++-- 3 files changed, 156 insertions(+), 37 deletions(-) diff --git a/compiler/ml/ast_untagged_variants.ml b/compiler/ml/ast_untagged_variants.ml index f2c8754e0b..0a8de20d52 100644 --- a/compiler/ml/ast_untagged_variants.ml +++ b/compiler/ml/ast_untagged_variants.ml @@ -1,13 +1,44 @@ module Instance = struct - type t = Array | ArrayBuffer | Blob | Date | File | Promise | RegExp + type t = + | Array + | ArrayBuffer + | BigInt64Array + | BigUint64Array + | Blob + | DataView + | Date + | File + | Float32Array + | Float64Array + | Int16Array + | Int32Array + | Int8Array + | Promise + | RegExp + | Uint16Array + | Uint32Array + | Uint8Array + | Uint8ClampedArray let to_string = function | Array -> "Array" | ArrayBuffer -> "ArrayBuffer" + | BigInt64Array -> "BigInt64Array" + | BigUint64Array -> "BigUint64Array" | Blob -> "Blob" + | DataView -> "DataView" | Date -> "Date" | File -> "File" + | Float32Array -> "Float32Array" + | Float64Array -> "Float64Array" + | Int16Array -> "Int16Array" + | Int32Array -> "Int32Array" + | Int8Array -> "Int8Array" | Promise -> "Promise" | RegExp -> "RegExp" + | Uint16Array -> "Uint16Array" + | Uint32Array -> "Uint32Array" + | Uint8Array -> "Uint8Array" + | Uint8ClampedArray -> "Uint8ClampedArray" end type untagged_error = @@ -202,37 +233,53 @@ let type_to_instanceof_backed_obj (t : Types.type_expr) = | Tconstr (path, _, _) -> ( match Path.name path with | "Stdlib_ArrayBuffer.t" -> Some ArrayBuffer + | "Stdlib.BigInt64Array.t" -> Some BigInt64Array + | "Stdlib.BigUint64Array.t" -> Some BigUint64Array + | "Stdlib.DataView.t" -> Some DataView | "Stdlib_Date.t" -> Some Date + | "Stdlib.Float32Array.t" -> Some Float32Array + | "Stdlib.Float64Array.t" -> Some Float64Array + | "Stdlib.Int16Array.t" -> Some Int16Array + | "Stdlib.Int32Array.t" -> Some Int32Array + | "Stdlib.Int8Array.t" -> Some Int8Array | "Stdlib_RegExp.t" -> Some RegExp + | "Stdlib.Uint16Array.t" -> Some Uint16Array + | "Stdlib.Uint32Array.t" -> Some Uint32Array + | "Stdlib.Uint8Array.t" -> Some Uint8Array + | "Stdlib.Uint8ClampedArray.t" -> Some Uint8ClampedArray | "Js_file.t" -> Some File | "Js_blob.t" -> Some Blob | _ -> None) | _ -> None let get_block_type_from_typ ~env (t : Types.type_expr) : block_type option = - let t = !expand_head env t in - match t with - | {desc = Tconstr (path, _, _)} when Path.same path Predef.path_string -> - Some StringType - | {desc = Tconstr (path, _, _)} when Path.same path Predef.path_int -> - Some IntType - | {desc = Tconstr (path, _, _)} when Path.same path Predef.path_float -> - Some FloatType - | {desc = Tconstr (path, _, _)} when Path.same path Predef.path_bigint -> - Some BigintType - | {desc = Tconstr (path, _, _)} when Path.same path Predef.path_bool -> - Some BooleanType - | {desc = Tarrow _} -> Some FunctionType - | {desc = Tconstr (path, _, _)} when Path.same path Predef.path_string -> - Some StringType - | {desc = Tconstr _} as t when type_is_builtin_object t -> Some ObjectType - | {desc = Tconstr _} as t - when type_to_instanceof_backed_obj t |> Option.is_some -> ( - match type_to_instanceof_backed_obj t with - | None -> None - | Some instance_type -> Some (InstanceType instance_type)) - | {desc = Ttuple _} -> Some (InstanceType Array) - | _ -> None + (* First check the original (unexpanded) type for typed arrays and other instance types *) + match type_to_instanceof_backed_obj t with + | Some instance_type -> Some (InstanceType instance_type) + | None -> ( + (* If original type didn't match, expand and try standard checks *) + let expanded_t = !expand_head env t in + match expanded_t with + | {desc = Tconstr (path, _, _)} when Path.same path Predef.path_string -> + Some StringType + | {desc = Tconstr (path, _, _)} when Path.same path Predef.path_int -> + Some IntType + | {desc = Tconstr (path, _, _)} when Path.same path Predef.path_float -> + Some FloatType + | {desc = Tconstr (path, _, _)} when Path.same path Predef.path_bigint -> + Some BigintType + | {desc = Tconstr (path, _, _)} when Path.same path Predef.path_bool -> + Some BooleanType + | {desc = Tarrow _} -> Some FunctionType + | {desc = Tconstr _} as expanded_t when type_is_builtin_object expanded_t -> + Some ObjectType + | {desc = Tconstr _} as expanded_t + when type_to_instanceof_backed_obj expanded_t |> Option.is_some -> ( + match type_to_instanceof_backed_obj expanded_t with + | None -> None + | Some instance_type -> Some (InstanceType instance_type)) + | {desc = Ttuple _} -> Some (InstanceType Array) + | _ -> None) let get_block_type ~env (cstr : Types.constructor_declaration) : block_type option = diff --git a/tests/tests/src/UntaggedVariants.mjs b/tests/tests/src/UntaggedVariants.mjs index eab12455bb..56001fc9d6 100644 --- a/tests/tests/src/UntaggedVariants.mjs +++ b/tests/tests/src/UntaggedVariants.mjs @@ -2,7 +2,6 @@ import * as Js_dict from "rescript/lib/es6/Js_dict.js"; import * as Belt_Array from "rescript/lib/es6/Belt_Array.js"; -import * as Primitive_array from "rescript/lib/es6/Primitive_array.js"; import * as Primitive_option from "rescript/lib/es6/Primitive_option.js"; function classify(x) { @@ -289,7 +288,7 @@ let OverlapObject = { function classify$7(v) { if (Array.isArray(v)) { - return Primitive_array.get(v, 0); + return v[0]; } else { return v.x; } @@ -303,7 +302,7 @@ function classify$8(v) { if (typeof v === "object" && !Array.isArray(v)) { return v.x; } else { - return Primitive_array.get(v, 0); + return v[0]; } } @@ -356,7 +355,7 @@ let OptionUnboxingHeuristic = { function classify$9(v) { if (Array.isArray(v)) { - return Primitive_array.get(v, 0); + return v[0]; } switch (typeof v) { case "object" : @@ -522,6 +521,58 @@ async function classifyAll(t) { console.log(t.size); return; } + if (t instanceof ArrayBuffer) { + console.log("ArrayBuffer"); + return; + } + if (t instanceof Int8Array) { + console.log("Int8Array"); + return; + } + if (t instanceof Int16Array) { + console.log("Int16Array"); + return; + } + if (t instanceof Int32Array) { + console.log("Int32Array"); + return; + } + if (t instanceof Uint8Array) { + console.log("Uint8Array"); + return; + } + if (t instanceof Uint8ClampedArray) { + console.log("Uint8ClampedArray"); + return; + } + if (t instanceof Uint16Array) { + console.log("Uint16Array"); + return; + } + if (t instanceof Uint32Array) { + console.log("Uint32Array"); + return; + } + if (t instanceof Float32Array) { + console.log("Float32Array"); + return; + } + if (t instanceof Float64Array) { + console.log("Float64Array"); + return; + } + if (t instanceof BigInt64Array) { + console.log("BigInt64Array"); + return; + } + if (t instanceof BigUint64Array) { + console.log("BigUint64Array"); + return; + } + if (t instanceof DataView) { + console.log("DataView"); + return; + } switch (typeof t) { case "string" : console.log(t); @@ -606,8 +657,6 @@ let RecursiveType = { } }; -let $$Array; - let i = 42; let i2 = 42.5; @@ -622,7 +671,6 @@ let w = { }; export { - $$Array, i, i2, s, diff --git a/tests/tests/src/UntaggedVariants.res b/tests/tests/src/UntaggedVariants.res index e35fec2afd..ab707dc940 100644 --- a/tests/tests/src/UntaggedVariants.res +++ b/tests/tests/src/UntaggedVariants.res @@ -1,5 +1,3 @@ -module Array = Ocaml_Array - @unboxed type t = A | I(int) | S(string) @unboxed @@ -182,7 +180,7 @@ let classify (x : t) : tagged_t = else if Js_array2.isArray x then JSONArray (Obj.magic x) else - JSONObject (Obj.magic x) + JSONObject (Obj.magic x) */ } @@ -249,7 +247,7 @@ module RecordIsObject = { let classify = v => switch v { | Record({x}) => x - | Array(a) => a[0] + | Array(a) => a->Array.getUnsafe(0) } } @@ -260,7 +258,7 @@ module ArrayAndObject = { let classify = v => switch v { | Record({x}) => x - | Array(a) => a[0] + | Array(a) => a->Array.getUnsafe(0) } } @@ -303,7 +301,7 @@ module TestFunctionCase = { let classify = v => switch v { | Record({x}) => x - | Array(a) => a[0] + | Array(a) => a->Array.getUnsafe(0) | Function(f) => f(3) } @@ -402,6 +400,19 @@ module AllInstanceofTypes = { | RegExp(Stdlib_RegExp.t) | File(Js.File.t) | Blob(Js.Blob.t) + | ArrayBuffer(ArrayBuffer.t) + | Int8Array(Int8Array.t) + | Int16Array(Int16Array.t) + | Int32Array(Int32Array.t) + | Uint8Array(Uint8Array.t) + | Uint8ClampedArray(Uint8ClampedArray.t) + | Uint16Array(Uint16Array.t) + | Uint32Array(Uint32Array.t) + | Float32Array(Float32Array.t) + | Float64Array(Float64Array.t) + | BigInt64Array(BigInt64Array.t) + | BigUint64Array(BigUint64Array.t) + | DataView(DataView.t) let classifyAll = async (t: t) => switch t { @@ -413,6 +424,19 @@ module AllInstanceofTypes = { | Array(arr) => Js.log(arr->Belt.Array.joinWith("-", x => x)) | File(file) => Js.log(file->fileName) | Blob(blob) => Js.log(blob->blobSize) + | ArrayBuffer(_) => Js.log("ArrayBuffer") + | Int8Array(_) => Js.log("Int8Array") + | Int16Array(_) => Js.log("Int16Array") + | Int32Array(_) => Js.log("Int32Array") + | Uint8Array(_) => Js.log("Uint8Array") + | Uint8ClampedArray(_) => Js.log("Uint8ClampedArray") + | Uint16Array(_) => Js.log("Uint16Array") + | Uint32Array(_) => Js.log("Uint32Array") + | Float32Array(_) => Js.log("Float32Array") + | Float64Array(_) => Js.log("Float64Array") + | BigInt64Array(_) => Js.log("BigInt64Array") + | BigUint64Array(_) => Js.log("BigUint64Array") + | DataView(_) => Js.log("DataView") } }