From 08048d9e0810752e6b5a67d58ed2499a9cc5e91c Mon Sep 17 00:00:00 2001 From: Dmitry Zakharov Date: Fri, 22 Sep 2023 02:14:31 +0300 Subject: [PATCH 1/5] Support bool in untagged variant --- .../unboxed_bool_with_const/bsconfig.json | 15 +++++ .../unboxed_bool_with_const/input.js | 31 ++++++++++ .../unboxed_bool_with_const/src/Main.res | 5 ++ jscomp/core/js_exp_make.ml | 1 + jscomp/ml/ast_untagged_variants.ml | 58 +++++++++++-------- jscomp/test/variantsMatching.gen.tsx | 3 + jscomp/test/variantsMatching.js | 23 ++++++++ jscomp/test/variantsMatching.res | 14 +++++ 8 files changed, 127 insertions(+), 23 deletions(-) create mode 100644 jscomp/build_tests/unboxed_bool_with_const/bsconfig.json create mode 100644 jscomp/build_tests/unboxed_bool_with_const/input.js create mode 100644 jscomp/build_tests/unboxed_bool_with_const/src/Main.res diff --git a/jscomp/build_tests/unboxed_bool_with_const/bsconfig.json b/jscomp/build_tests/unboxed_bool_with_const/bsconfig.json new file mode 100644 index 0000000000..1cbcace50a --- /dev/null +++ b/jscomp/build_tests/unboxed_bool_with_const/bsconfig.json @@ -0,0 +1,15 @@ +{ + "name": "unboxed_bool_with_const", + "version": "0.1.0", + "sources": [ + { + "dir": "src", + "subdirs": true + } + ], + "package-specs": { + "module": "commonjs", + "in-source": true + }, + "suffix": ".bs.js" +} diff --git a/jscomp/build_tests/unboxed_bool_with_const/input.js b/jscomp/build_tests/unboxed_bool_with_const/input.js new file mode 100644 index 0000000000..d116405629 --- /dev/null +++ b/jscomp/build_tests/unboxed_bool_with_const/input.js @@ -0,0 +1,31 @@ +//@ts-check + +var cp = require("child_process"); +var assert = require("assert"); +var rescript_exe = require("../../../scripts/bin_path").rescript_exe; + +var out = cp.spawnSync(rescript_exe, { + cwd: __dirname, + encoding: "utf8", +}); + +assert.equal( + out.stdout, + `Dependency Finished +rescript: [1/1] src/Main.cmj +FAILED: src/Main.cmj + + We've found a bug for you! + /Users/dzakh/code/DZakh-forks/rescript-compiler/jscomp/build_tests/unboxed_bool_with_const/src/Main.res:3:3-14 + + 1 │ @unboxed + 2 │ type t<'a> = + 3 │ | Bool(bool) + 4 │ | @as(false) False + 5 │ | @as(true) True + + This untagged variant definition is invalid: At most one case can be a boolean type. + +FAILED: cannot make progress due to previous errors. +` +); diff --git a/jscomp/build_tests/unboxed_bool_with_const/src/Main.res b/jscomp/build_tests/unboxed_bool_with_const/src/Main.res new file mode 100644 index 0000000000..6ed5758e7e --- /dev/null +++ b/jscomp/build_tests/unboxed_bool_with_const/src/Main.res @@ -0,0 +1,5 @@ +@unboxed +type t<'a> = + | Bool(bool) + | @as(false) False + | @as(true) True diff --git a/jscomp/core/js_exp_make.ml b/jscomp/core/js_exp_make.ml index cc8b517bbe..a807fa6531 100644 --- a/jscomp/core/js_exp_make.ml +++ b/jscomp/core/js_exp_make.ml @@ -805,6 +805,7 @@ let tag_type = function | Undefined -> undefined | Untagged IntType -> str "number" | Untagged FloatType -> str "number" + | Untagged BooleanType -> str "boolean" | Untagged FunctionType -> str "function" | Untagged StringType -> str "string" | Untagged (InstanceType i) -> str (Ast_untagged_variants.Instance.to_string i) ~delim:DNoQuotes diff --git a/jscomp/ml/ast_untagged_variants.ml b/jscomp/ml/ast_untagged_variants.ml index 48a0e3ca3c..7f4e85532c 100644 --- a/jscomp/ml/ast_untagged_variants.ml +++ b/jscomp/ml/ast_untagged_variants.ml @@ -22,6 +22,7 @@ type untaggedError = | AtMostOneFunction | AtMostOneString | AtMostOneNumber + | AtMostOneBoolean | DuplicateLiteral of string | ConstructorMoreThanOneArg of string type error = @@ -49,6 +50,7 @@ let report_error ppf = | AtMostOneInstance i -> "At most one case can be a " ^ (Instance.to_string i) ^ " type." | AtMostOneFunction -> "At most one case can be a function type." | AtMostOneString -> "At most one case can be a string type." + | AtMostOneBoolean -> "At most one case can be a boolean type." | AtMostOneNumber -> "At most one case can be a number type (int or float)." | DuplicateLiteral s -> "Duplicate literal " ^ s ^ "." @@ -59,6 +61,7 @@ type block_type = | IntType | StringType | FloatType + | BooleanType | InstanceType of Instance.t | FunctionType | ObjectType @@ -167,6 +170,8 @@ let get_block_type_from_typ ~env (t: Types.type_expr) : block_type option = Some IntType | {desc = Tconstr (path, _, _)} when Path.same path Predef.path_float -> Some FloatType + | {desc = Tconstr (path, _, _)} when Path.same path Predef.path_bool -> + Some BooleanType | ({desc = Tconstr _} as t) when Ast_uncurried_utils.typeIsUncurriedFun t -> Some FunctionType | {desc = Tarrow _} -> Some FunctionType @@ -232,6 +237,7 @@ let checkInvariant ~isUntaggedDef ~(consts : (Location.t * tag) list) let objectTypes = ref 0 in let stringTypes = ref 0 in let numberTypes = ref 0 in + let booleanTypes = ref 0 in let unknownTypes = ref 0 in let addStringLiteral ~loc s = if StringSet.mem s !string_literals then @@ -258,6 +264,10 @@ let checkInvariant ~isUntaggedDef ~(consts : (Location.t * tag) list) raise (Error (loc, InvalidUntaggedVariantDefinition AtMostOneString)); if !numberTypes > 1 then raise (Error (loc, InvalidUntaggedVariantDefinition AtMostOneNumber)); + if !booleanTypes > 1 then + raise (Error (loc, InvalidUntaggedVariantDefinition AtMostOneBoolean)); + if !booleanTypes > 0 && (StringSet.mem "true" !nonstring_literals || StringSet.mem "false" !nonstring_literals) then + raise (Error (loc, InvalidUntaggedVariantDefinition AtMostOneBoolean)); () in Ext_list.rev_iter consts (fun (loc, literal) -> @@ -267,34 +277,27 @@ let checkInvariant ~isUntaggedDef ~(consts : (Location.t * tag) list) | Some (Float f) -> addNonstringLiteral ~loc f | Some Null -> addNonstringLiteral ~loc "null" | Some Undefined -> addNonstringLiteral ~loc "undefined" - | Some (Bool b) -> - addNonstringLiteral ~loc (if b then "true" else "false") + | Some (Bool b) -> addNonstringLiteral ~loc (if b then "true" else "false") | Some (Untagged _) -> () | None -> addStringLiteral ~loc literal.name); if isUntaggedDef then Ext_list.rev_iter blocks (fun (loc, block) -> - let name = block.tag.name in - match block.block_type with - | Some UnknownType -> - incr unknownTypes; - invariant loc name - | Some ObjectType -> - incr objectTypes; - invariant loc name - | Some (InstanceType i) -> + match block.block_type with + | Some block_type -> + (match block_type with + | UnknownType -> incr unknownTypes; + | ObjectType -> incr objectTypes; + | (InstanceType i) -> let count = Hashtbl.find_opt instanceTypes i |> Option.value ~default:0 in Hashtbl.replace instanceTypes i (count + 1); - invariant loc name - | Some FunctionType -> - incr functionTypes; - invariant loc name - | Some (IntType | FloatType) -> - incr numberTypes; - invariant loc name - | Some StringType -> - incr stringTypes; - invariant loc name - | None -> ()) + | FunctionType -> incr functionTypes; + | (IntType | FloatType) -> incr numberTypes; + | BooleanType -> incr booleanTypes; + | StringType -> incr stringTypes; + ); + invariant loc block.tag.name + | None -> () + ) let names_from_type_variant ?(isUntaggedDef = false) ~env (cstrs : Types.constructor_declaration list) = @@ -353,6 +356,7 @@ module DynamicChecks = struct let function_ = Untagged FunctionType |> tag_type let string = Untagged StringType |> tag_type let number = Untagged IntType |> tag_type + let boolean = Untagged BooleanType |> tag_type let ( == ) x y = bin EqEqEq x y let ( != ) x y = bin NotEqEq x y @@ -371,6 +375,11 @@ module DynamicChecks = struct | Int _ | Float _ -> true | _ -> false) in + let literals_overlaps_with_boolean () = + Ext_list.exists literal_cases (function + | Bool _ -> true + | _ -> false) + in let literals_overlaps_with_object () = Ext_list.exists literal_cases (function | Null -> true @@ -386,6 +395,8 @@ module DynamicChecks = struct typeof e != number | FloatType when literals_overlaps_with_number () = false -> typeof e != number + | BooleanType when literals_overlaps_with_boolean () = false -> + typeof e != boolean | InstanceType i -> not (is_instance i e) | FunctionType -> typeof e != function_ | ObjectType when literals_overlaps_with_object () = false -> @@ -394,6 +405,7 @@ module DynamicChecks = struct | StringType (* overlap *) | IntType (* overlap *) | FloatType (* overlap *) + | BooleanType (* overlap *) | UnknownType -> ( (* We don't know the type of unknown, so we need to express: this is not one of the literals *) @@ -434,7 +446,7 @@ module DynamicChecks = struct let add_runtime_type_check ~tag_type ~(block_cases : block_type list) x y = let instances = Ext_list.filter_map block_cases (function InstanceType i -> Some i | _ -> None) in match tag_type with - | Untagged (IntType | StringType | FloatType | FunctionType) -> + | Untagged (IntType | StringType | FloatType | BooleanType | FunctionType) -> typeof y == x | Untagged ObjectType -> if instances <> [] then diff --git a/jscomp/test/variantsMatching.gen.tsx b/jscomp/test/variantsMatching.gen.tsx index 8718551676..46e2c4bdc4 100644 --- a/jscomp/test/variantsMatching.gen.tsx +++ b/jscomp/test/variantsMatching.gen.tsx @@ -19,3 +19,6 @@ export type MyNullable_t = null | undefined | a; // tslint:disable-next-line:interface-over-type-literal export type MyNullableExtended_t = null | undefined | "WhyNotAnotherOne" | a; + +// tslint:disable-next-line:interface-over-type-literal +export type UntaggedWithBool_t = string | number | boolean | string; diff --git a/jscomp/test/variantsMatching.js b/jscomp/test/variantsMatching.js index 859d348f0e..2573077d54 100644 --- a/jscomp/test/variantsMatching.js +++ b/jscomp/test/variantsMatching.js @@ -389,6 +389,28 @@ var CustomTagNotInline = { b: CustomTagNotInline_b }; +function classify(x) { + switch (typeof x) { + case "string" : + return "string"; + case "number" : + return "int"; + case "boolean" : + if (x) { + return "true"; + } else { + return "boolean"; + } + case "object" : + return "Object" + x.name; + + } +} + +var UntaggedWithBool = { + classify: classify +}; + exports.toEnum = toEnum; exports.toString = toString; exports.bar = bar; @@ -406,4 +428,5 @@ exports.MyNullable = MyNullable; exports.MyNullableExtended = MyNullableExtended; exports.TaggedUnions = TaggedUnions; exports.CustomTagNotInline = CustomTagNotInline; +exports.UntaggedWithBool = UntaggedWithBool; /* expectSeven Not a pure module */ diff --git a/jscomp/test/variantsMatching.res b/jscomp/test/variantsMatching.res index f8b3efd113..7501bde458 100644 --- a/jscomp/test/variantsMatching.res +++ b/jscomp/test/variantsMatching.res @@ -272,3 +272,17 @@ module CustomTagNotInline = { let a = A(10) let b = B(20) } + +module UntaggedWithBool = { + @unboxed @genType + type t<'a> = String(string) | Float(float) | Bool(bool) | Object({name: string}) + + let classify = x => + switch x { + | String(_) => "string" + | Float(_) => "int" + | Bool(true) => "true" + | Bool(_) => "boolean" + | Object({name}) => "Object" ++ name + } +} From 91b7257822771dd8c2b3c214278b0438a3963993 Mon Sep 17 00:00:00 2001 From: Dmitry Zakharov Date: Fri, 22 Sep 2023 11:16:05 +0300 Subject: [PATCH 2/5] Fix test --- jscomp/build_tests/unboxed_bool_with_const/input.js | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/jscomp/build_tests/unboxed_bool_with_const/input.js b/jscomp/build_tests/unboxed_bool_with_const/input.js index d116405629..a4fc7f08cc 100644 --- a/jscomp/build_tests/unboxed_bool_with_const/input.js +++ b/jscomp/build_tests/unboxed_bool_with_const/input.js @@ -10,10 +10,8 @@ var out = cp.spawnSync(rescript_exe, { }); assert.equal( - out.stdout, - `Dependency Finished -rescript: [1/1] src/Main.cmj -FAILED: src/Main.cmj + out.stdout.slice(out.stdout.indexOf("FAILED: src/Main.cmj")), + `FAILED: src/Main.cmj We've found a bug for you! /Users/dzakh/code/DZakh-forks/rescript-compiler/jscomp/build_tests/unboxed_bool_with_const/src/Main.res:3:3-14 From 651c6862dfceeef5a71e3d320196aca4bd03eb42 Mon Sep 17 00:00:00 2001 From: Dmitry Zakharov Date: Fri, 22 Sep 2023 11:16:34 +0300 Subject: [PATCH 3/5] Update changelog --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 73ce10beba..699a2001f6 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -21,6 +21,7 @@ - Support renaming fields in inline records with `@as` attribute. [#6391](https://github.com/rescript-lang/rescript-compiler/pull/6391) - Add builtin abstract types for File and Blob APIs. https://github.com/rescript-lang/rescript-compiler/pull/6383 - Untagged variants: Support `promise`, RegExes, Dates, File and Blob. https://github.com/rescript-lang/rescript-compiler/pull/6383 +- Untagged variants: Support `bool`. https://github.com/rescript-lang/rescript-compiler/pull/6368 - Support aliased types as payloads to untagged variants. https://github.com/rescript-lang/rescript-compiler/pull/6394 #### :nail_care: Polish From c9493366aa0b998ce02e2916e3ff088b6d8c64bc Mon Sep 17 00:00:00 2001 From: Dmitry Zakharov Date: Fri, 22 Sep 2023 13:05:36 +0300 Subject: [PATCH 4/5] Fix tests --- jscomp/build_tests/unboxed_bool_with_const/input.js | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/jscomp/build_tests/unboxed_bool_with_const/input.js b/jscomp/build_tests/unboxed_bool_with_const/input.js index a4fc7f08cc..4591fdadac 100644 --- a/jscomp/build_tests/unboxed_bool_with_const/input.js +++ b/jscomp/build_tests/unboxed_bool_with_const/input.js @@ -10,11 +10,8 @@ var out = cp.spawnSync(rescript_exe, { }); assert.equal( - out.stdout.slice(out.stdout.indexOf("FAILED: src/Main.cmj")), - `FAILED: src/Main.cmj - - We've found a bug for you! - /Users/dzakh/code/DZakh-forks/rescript-compiler/jscomp/build_tests/unboxed_bool_with_const/src/Main.res:3:3-14 + out.stdout.slice(out.stdout.indexOf("Main.res:3:3-14")), + `Main.res:3:3-14 1 │ @unboxed 2 │ type t<'a> = From 2fb0cf79dff9b51517026752febc76bf0c74b380 Mon Sep 17 00:00:00 2001 From: Dmitry Zakharov Date: Wed, 27 Sep 2023 19:31:07 +0300 Subject: [PATCH 5/5] Remove redundant type argument --- jscomp/test/variantsMatching.gen.tsx | 2 +- jscomp/test/variantsMatching.res | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/jscomp/test/variantsMatching.gen.tsx b/jscomp/test/variantsMatching.gen.tsx index 46e2c4bdc4..023a483cec 100644 --- a/jscomp/test/variantsMatching.gen.tsx +++ b/jscomp/test/variantsMatching.gen.tsx @@ -21,4 +21,4 @@ export type MyNullable_t = null | undefined | a; export type MyNullableExtended_t = null | undefined | "WhyNotAnotherOne" | a; // tslint:disable-next-line:interface-over-type-literal -export type UntaggedWithBool_t = string | number | boolean | string; +export type UntaggedWithBool_t = string | number | boolean | string; diff --git a/jscomp/test/variantsMatching.res b/jscomp/test/variantsMatching.res index 7501bde458..aca376049f 100644 --- a/jscomp/test/variantsMatching.res +++ b/jscomp/test/variantsMatching.res @@ -275,7 +275,7 @@ module CustomTagNotInline = { module UntaggedWithBool = { @unboxed @genType - type t<'a> = String(string) | Float(float) | Bool(bool) | Object({name: string}) + type t = String(string) | Float(float) | Bool(bool) | Object({name: string}) let classify = x => switch x {