diff --git a/CHANGELOG.md b/CHANGELOG.md
index bc4ff3c699..1e014fd81c 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -23,6 +23,7 @@
- Support renaming object fields of `@obj` external ppx with `@as` attribute. [#6391](https://github.com/rescript-lang/rescript-compiler/pull/6412)
- 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
#### :boom: Breaking Change
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..4591fdadac
--- /dev/null
+++ b/jscomp/build_tests/unboxed_bool_with_const/input.js
@@ -0,0 +1,26 @@
+//@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.slice(out.stdout.indexOf("Main.res:3:3-14")),
+ `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..023a483cec 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..aca376049f 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 = 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
+ }
+}