diff --git a/CHANGELOG.md b/CHANGELOG.md index f936433aa0..0530224b88 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -30,6 +30,7 @@ - Make "rescript format" work with node 10 again and set minimum required node version to 10 in package.json. https://github.com/rescript-lang/rescript-compiler/pull/6186 - Fix partial application for uncurried functions with labeled args https://github.com/rescript-lang/rescript-compiler/pull/6198 - Add error messages for dangling doc comments/attributes and mutable in record type definition. https://github.com/rescript-lang/rescript-compiler/pull/6206 +- Fix issue with overlapping array and object in untagged variants https://github.com/rescript-lang/rescript-compiler/pull/6219 # 11.0.0-alpha.4 diff --git a/jscomp/core/lam_compile.ml b/jscomp/core/lam_compile.ml index 51a9c0382f..50bf2678b2 100644 --- a/jscomp/core/lam_compile.ml +++ b/jscomp/core/lam_compile.ml @@ -625,11 +625,11 @@ and use_compile_literal_cases table ~(get_tag : _ -> Ast_untagged_variants.tag o ) table (Some []) and compile_cases ?(untagged=false) ~cxt ~(switch_exp : E.t) ?(default = NonComplete) - ?(get_tag = fun _ -> None) cases : initialization = + ?(get_tag = fun _ -> None) ?(block_cases=[]) cases : initialization = match use_compile_literal_cases cases ~get_tag with | Some string_cases -> if untagged - then compile_untagged_cases ~cxt ~switch_exp ~default string_cases + then compile_untagged_cases ~cxt ~switch_exp ~block_cases ~default string_cases else compile_string_cases ~cxt ~switch_exp ~default string_cases | None -> cases |> compile_general_cases @@ -688,13 +688,13 @@ and compile_switch (switch_arg : Lam.t) (sw : Lam.lambda_switch) block @ if sw_consts_full && sw_consts = [] then - compile_cases + compile_cases ~block_cases ~untagged ~cxt ~switch_exp:(if untagged then e else E.tag ~name:tag_name e) ~default:sw_blocks_default ~get_tag:get_block_tag sw_blocks else if sw_blocks_full && sw_blocks = [] then - compile_cases ~cxt ~switch_exp:e ~default:sw_num_default ~get_tag:get_const_tag sw_consts + compile_cases ~cxt ~switch_exp:e ~block_cases ~default:sw_num_default ~get_tag:get_const_tag sw_consts else (* [e] will be used twice *) let dispatch e = @@ -706,11 +706,12 @@ and compile_switch (switch_arg : Lam.t) (sw : Lam.lambda_switch) else E.is_int_tag ~has_null_undefined_other:(has_null_undefined_other sw_names) e in S.if_ is_a_literal_case - (compile_cases ~cxt ~switch_exp:e ~default:sw_num_default ~get_tag:get_const_tag sw_consts) + (compile_cases ~cxt ~switch_exp:e ~block_cases ~default:sw_num_default ~get_tag:get_const_tag sw_consts) ~else_: (compile_cases ~untagged ~cxt ~switch_exp:(if untagged then e else E.tag ~name:tag_name e) + ~block_cases ~default:sw_blocks_default ~get_tag:get_block_tag sw_blocks) in @@ -749,13 +750,13 @@ and compile_string_cases ~cxt ~switch_exp ~default cases: initialization = S.string_switch ?default ?declaration e clauses) ~switch_exp ~default -and compile_untagged_cases ~cxt ~switch_exp ~default cases = +and compile_untagged_cases ~cxt ~switch_exp ~default ~block_cases cases = let mk_eq (i : Ast_untagged_variants.tag_type option) x j y = let check = match i, j with | Some tag_type, _ -> - Ast_untagged_variants.DynamicChecks.add_runtime_type_check ~tag_type (Expr x) (Expr y) + Ast_untagged_variants.DynamicChecks.add_runtime_type_check ~tag_type ~block_cases (Expr x) (Expr y) | _, Some tag_type -> - Ast_untagged_variants.DynamicChecks.add_runtime_type_check ~tag_type (Expr y) (Expr x) + Ast_untagged_variants.DynamicChecks.add_runtime_type_check ~tag_type ~block_cases (Expr y) (Expr x) | _ -> Ast_untagged_variants.DynamicChecks.(==) (Expr x) (Expr y) in diff --git a/jscomp/ml/ast_untagged_variants.ml b/jscomp/ml/ast_untagged_variants.ml index 461d3656c3..0708f558ee 100644 --- a/jscomp/ml/ast_untagged_variants.ml +++ b/jscomp/ml/ast_untagged_variants.ml @@ -328,11 +328,17 @@ module DynamicChecks = struct else (* (undefiled + other) || other *) typeof e != object_ - let add_runtime_type_check ~tag_type x y = match tag_type with + let add_runtime_type_check ~tag_type ~(block_cases: block_type list) x y = + let has_array() = Ext_list.exists block_cases (fun t -> t = ArrayType) in + match tag_type with | Untagged IntType | Untagged StringType - | Untagged FloatType - | Untagged ObjectType -> typeof y == x + | Untagged FloatType -> typeof y == x + | Untagged ObjectType -> + if has_array() then + typeof y == x &&& not (is_array y) + else + typeof y == x | Untagged ArrayType -> is_array y | Untagged UnknownType -> (* This should not happen because unknown must be the only non-literal case *) diff --git a/jscomp/test/UntaggedVariants.js b/jscomp/test/UntaggedVariants.js index 1e6962eb4a..97f82d7694 100644 --- a/jscomp/test/UntaggedVariants.js +++ b/jscomp/test/UntaggedVariants.js @@ -306,6 +306,18 @@ var RecordIsObject = { classify: classify$7 }; +function classify$8(v) { + if (typeof v === "object" && !Array.isArray(v)) { + return v.x; + } else { + return Caml_array.get(v, 0); + } +} + +var ArrayAndObject = { + classify: classify$8 +}; + var i = 42; var i2 = 42.5; @@ -344,4 +356,5 @@ exports.OverlapString = OverlapString; exports.OverlapNumber = OverlapNumber; exports.OverlapObject = OverlapObject; exports.RecordIsObject = RecordIsObject; +exports.ArrayAndObject = ArrayAndObject; /* l2 Not a pure module */ diff --git a/jscomp/test/UntaggedVariants.res b/jscomp/test/UntaggedVariants.res index 690749e9b1..6077501b70 100644 --- a/jscomp/test/UntaggedVariants.res +++ b/jscomp/test/UntaggedVariants.res @@ -239,13 +239,25 @@ module OverlapObject = { module RecordIsObject = { // @unboxed // this is not allowed - type r = {x:int} + type r = {x: int} @unboxed - type t = | Array(array) | Record(r) + type t = Array(array) | Record(r) - let classify = v => switch v { + let classify = v => + switch v { | Record({x}) => x | Array(a) => a[0] - } -} \ No newline at end of file + } +} + +module ArrayAndObject = { + @unboxed + type t = Record({x: int}) | Array(array) + + let classify = v => + switch v { + | Record({x}) => x + | Array(a) => a[0] + } +}