Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
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
97 changes: 73 additions & 24 deletions compiler/ml/ast_untagged_variants.ml
Original file line number Diff line number Diff line change
@@ -1,12 +1,44 @@
module Instance = struct
type t = Array | 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 =
Expand Down Expand Up @@ -200,37 +232,54 @@ 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.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 *)
Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

The stdlib uses t = Stdlib_TypedArray.t<int> and t = Stdlib_TypedArray.t<float> for typed arrays, so we can't differentiate them by their expanded 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 =
Expand Down
62 changes: 55 additions & 7 deletions tests/tests/src/UntaggedVariants.mjs
Original file line number Diff line number Diff line change
Expand Up @@ -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) {
Expand Down Expand Up @@ -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;
}
Expand All @@ -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];
}
}

Expand Down Expand Up @@ -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" :
Expand Down Expand Up @@ -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);
Expand Down Expand Up @@ -606,8 +657,6 @@ let RecursiveType = {
}
};

let $$Array;

let i = 42;

let i2 = 42.5;
Expand All @@ -622,7 +671,6 @@ let w = {
};

export {
$$Array,
i,
i2,
s,
Expand Down
36 changes: 30 additions & 6 deletions tests/tests/src/UntaggedVariants.res
Original file line number Diff line number Diff line change
@@ -1,5 +1,3 @@
module Array = Ocaml_Array

Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I removed this line and replaced arr[0] with arr->Array.getUnsafe(0) in the test to make compiling with ./cli/bsc.js tests/tests/src/UntaggedVariants.res easier (bsc would complain about unknown dependency Ocaml_Array otherwise)

@unboxed
type t = A | I(int) | S(string)
@unboxed
Expand Down Expand Up @@ -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)
*/
}

Expand Down Expand Up @@ -249,7 +247,7 @@ module RecordIsObject = {
let classify = v =>
switch v {
| Record({x}) => x
| Array(a) => a[0]
| Array(a) => a->Array.getUnsafe(0)
}
}

Expand All @@ -260,7 +258,7 @@ module ArrayAndObject = {
let classify = v =>
switch v {
| Record({x}) => x
| Array(a) => a[0]
| Array(a) => a->Array.getUnsafe(0)
}
}

Expand Down Expand Up @@ -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)
}

Expand Down Expand Up @@ -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 {
Expand All @@ -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")
}
}

Expand Down
Loading