diff --git a/CHANGELOG.md b/CHANGELOG.md index d92fa1dfcd..16b9f450ce 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -26,6 +26,7 @@ - Add `Dict.assignMany`, `Dict.concat`, `Dict.concatMany`, `Dict.concatAll`, `Array.concatAll` to the stdlib. https://github.com/rescript-lang/rescript/pull/8364 - Implement `for...of` and `for await...of` loops. https://github.com/rescript-lang/rescript/pull/7887 - Add support for dict spreads: `dict{...foo, "bar": 2, ...qux}`. https://github.com/rescript-lang/rescript/pull/8369 +- Narrow the residual row at `...rest` catch-alls in polymorphic-variant matches. `| ...rest =>` (and `...rest as r`) now binds `rest` to the scrutinee's row minus the tags matched by earlier arms — for closed and open rows, at top-level and nested positions (`Error(...rest)`, `{field: ...rest}`, tuples with permissive siblings). #### :bug: Bug fix diff --git a/compiler/ml/btype.ml b/compiler/ml/btype.ml index 2af606a084..a401da3ca6 100644 --- a/compiler/ml/btype.ml +++ b/compiler/ml/btype.ml @@ -186,6 +186,26 @@ let static_row row = | _ -> true) row.row_fields +(* Produce a residual row: the given [matched_tags] are marked [Rabsent]; + every other field is preserved as-is. [row_closed] and [row_fixed] are + inherited. [row_name] is dropped (the residual is anonymous) and + [row_more] is a fresh variable so subsequent unification on the + residual cannot leak into the source row. *) +let narrow_row_by_tags matched_tags row = + let row = row_repr row in + let fields = + row.row_fields + |> List.map (fun (tag, f) -> + if List.mem tag matched_tags then (tag, Rabsent) else (tag, f)) + in + { + row_fields = fields; + row_more = newgenvar (); + row_closed = row.row_closed; + row_fixed = row.row_fixed; + row_name = None; + } + let hash_variant s = let accu = ref 0 in for i = 0 to String.length s - 1 do diff --git a/compiler/ml/btype.mli b/compiler/ml/btype.mli index ef099af22b..c9468aa7fa 100644 --- a/compiler/ml/btype.mli +++ b/compiler/ml/btype.mli @@ -80,6 +80,11 @@ val row_fixed : row_desc -> bool val static_row : row_desc -> bool (* Return whether the row is static or not *) +val narrow_row_by_tags : string list -> row_desc -> row_desc +(* Return a copy of the row with the given tags marked [Rabsent]. Used to + compute the residual row bound to a polymorphic-variant narrowing + catch-all. *) + val hash_variant : label -> int (* Hash function for variant tags *) diff --git a/compiler/ml/typecore.ml b/compiler/ml/typecore.ml index 9f06915d2e..e8448dae08 100644 --- a/compiler/ml/typecore.ml +++ b/compiler/ml/typecore.ml @@ -642,6 +642,45 @@ let extract_type_from_pat_variant_spread env lid expected_ty = let build_ppat_or_for_variant_spread pat env expected_ty = match pat with + | { + ppat_desc = Ppat_type {txt = Longident.Lident name; loc = name_loc}; + ppat_attributes; + ppat_loc; + } + when Variant_coercion.has_res_pat_variant_spread_attribute ppat_attributes + && + match (Ctype.expand_head !env expected_ty).desc with + | Tvariant _ -> true + | _ -> false -> + (* Polymorphic-variant narrowing: rewrite to [Ppat_var] carrying the + matched-tags attribute attached by the pre-pass. The [Ppat_var] + handler reads the attribute and constructs the narrowed binding + type from [expected_ty]. The residual type returned here is used + by [Ppat_alias] to propagate the narrowed type onto any outer + [as] alias. *) + let row = + match (Ctype.expand_head !env expected_ty).desc with + | Tvariant row -> row + | _ -> assert false + in + let matched_tags = + Variant_type_spread.get_poly_variant_narrow_matched_tags ppat_attributes + |> Option.value ~default:[] + in + let narrowed_ty = + Btype.newgenty (Tvariant (Btype.narrow_row_by_tags matched_tags row)) + in + let matched_tags_attr = + Variant_type_spread.mk_poly_variant_narrow_matched_tags_attr matched_tags + in + let new_pat = + { + ppat_desc = Ppat_var (Location.mkloc name name_loc); + ppat_loc; + ppat_attributes = matched_tags_attr :: ppat_attributes; + } + in + Some (new_pat, narrowed_ty) | {ppat_desc = Ppat_type lident; ppat_attributes} when Variant_coercion.has_res_pat_variant_spread_attribute ppat_attributes -> @@ -1182,6 +1221,182 @@ let set_state s env = Ctype.set_levels s.levels; env := s.env +(* Polymorphic-variant narrowing: a `...rest` pattern on a poly-variant + position binds [rest] to the residual row (the scrutinee's row at that + position minus the tags matched by earlier arms at the same path). + + Implementation is an attribute-based pre-pass. Before typing, each + `Ppat_type + res.patFromVariantSpread` node is annotated with a + [res.polyVariantNarrowMatchedTags] attribute carrying the list of tag + names matched at the node's structural path by earlier (unguarded) arms. + During typing, [build_ppat_or_for_variant_spread] decides — based on the + expected type at that position — whether to rewrite the node to a + [Ppat_var] (poly-variant case: produce a narrowed row) or to continue + with the existing regular-variant spread expansion. The matched-tags + attribute is ignored on the regular-variant path. *) + +type narrow_path_step = + | Step_construct of string + | Step_variant of string + | Step_tuple of int + | Step_record of string + +let rec longident_to_string = function + | Longident.Lident s -> s + | Longident.Ldot (l, s) -> longident_to_string l ^ "." ^ s + | Longident.Lapply (l1, l2) -> + longident_to_string l1 ^ "(" ^ longident_to_string l2 ^ ")" + +(* Set of (path, tag) pairs. Paths are leaf-first lists of path steps. *) +type matched_set = (narrow_path_step list * string) list + +let union_matched (a : matched_set) (b : matched_set) : matched_set = + List.fold_left (fun acc x -> if List.mem x acc then acc else x :: acc) a b + +(* A sub-pattern is "permissive" at its position if it matches every value + of the expected type there. Only permissive siblings allow us to lift a + deeper tag match to the parent position unconditionally: in [(#A, #B)] + neither #A nor #B is lifted (each is conditional on the sibling), but in + [(#A, _)] the #A is unconditional. *) +let rec is_permissive_pattern (p : Parsetree.pattern) = + match p.ppat_desc with + | Ppat_any | Ppat_var _ -> true + | Ppat_alias (p, _) | Ppat_constraint (p, _) -> is_permissive_pattern p + | _ -> false + +let rec extract_matched_at_path (path : narrow_path_step list) + (p : Parsetree.pattern) : matched_set = + match p.ppat_desc with + | Ppat_variant (tag, None) -> [(path, tag)] + | Ppat_variant (tag, Some payload) -> + (path, tag) :: extract_matched_at_path (Step_variant tag :: path) payload + | Ppat_or (p1, p2) -> + (* An or-pattern handles every tag either branch handles. *) + union_matched + (extract_matched_at_path path p1) + (extract_matched_at_path path p2) + | Ppat_alias (p, _) | Ppat_constraint (p, _) -> extract_matched_at_path path p + | Ppat_construct ({txt}, Some payload) -> + extract_matched_at_path + (Step_construct (longident_to_string txt) :: path) + payload + | Ppat_construct (_, None) -> [] + | Ppat_tuple ps -> + let items = List.mapi (fun i p -> (i, p)) ps in + List.concat_map + (fun (i, p) -> + if List.for_all (fun (j, q) -> j = i || is_permissive_pattern q) items + then extract_matched_at_path (Step_tuple i :: path) p + else []) + items + | Ppat_record (fields, _) -> + List.concat_map + (fun (re : _ Parsetree.record_element) -> + if + List.for_all + (fun (re' : _ Parsetree.record_element) -> + re'.lid.txt = re.lid.txt || is_permissive_pattern re'.x) + fields + then + extract_matched_at_path + (Step_record (longident_to_string re.lid.txt) :: path) + re.x + else []) + fields + | _ -> [] + +let matched_tags_at_path (matched : matched_set) (path : narrow_path_step list) + = + List.filter_map (fun (p, t) -> if p = path then Some t else None) matched + +(* Walk [p] at [path] annotating each Ppat_type+spread-attr node with the + tags matched at that path in [matched]. *) +let rec annotate_rest_at_path (matched : matched_set) + (path : narrow_path_step list) (p : Parsetree.pattern) : Parsetree.pattern = + match p.ppat_desc with + | Ppat_type _ + when Variant_coercion.has_res_pat_variant_spread_attribute p.ppat_attributes + -> + let tags = matched_tags_at_path matched path in + { + p with + ppat_attributes = + Variant_type_spread.mk_poly_variant_narrow_matched_tags_attr tags + :: p.ppat_attributes; + } + | Ppat_alias (inner, name) -> + { + p with + ppat_desc = Ppat_alias (annotate_rest_at_path matched path inner, name); + } + | Ppat_or (p1, p2) -> + { + p with + ppat_desc = + Ppat_or + ( annotate_rest_at_path matched path p1, + annotate_rest_at_path matched path p2 ); + } + | Ppat_constraint (inner, ct) -> + { + p with + ppat_desc = Ppat_constraint (annotate_rest_at_path matched path inner, ct); + } + | Ppat_construct (ctor, Some payload) -> + let step = Step_construct (longident_to_string ctor.txt) in + { + p with + ppat_desc = + Ppat_construct + (ctor, Some (annotate_rest_at_path matched (step :: path) payload)); + } + | Ppat_variant (tag, Some payload) -> + let step = Step_variant tag in + { + p with + ppat_desc = + Ppat_variant + (tag, Some (annotate_rest_at_path matched (step :: path) payload)); + } + | Ppat_tuple ps -> + { + p with + ppat_desc = + Ppat_tuple + (List.mapi + (fun i p -> annotate_rest_at_path matched (Step_tuple i :: path) p) + ps); + } + | Ppat_record (fields, flag) -> + { + p with + ppat_desc = + Ppat_record + ( List.map + (fun (re : _ Parsetree.record_element) -> + { + re with + x = + annotate_rest_at_path matched + (Step_record (longident_to_string re.lid.txt) :: path) + re.x; + }) + fields, + flag ); + } + | _ -> p + +let annotate_rest_nodes_with_matched_tags (caselist : Parsetree.case list) : + Parsetree.case list = + let earlier_matched : matched_set ref = ref [] in + List.map + (fun ({pc_lhs; pc_guard} as case : Parsetree.case) -> + let new_lhs = annotate_rest_at_path !earlier_matched [] pc_lhs in + if pc_guard = None then + earlier_matched := !earlier_matched @ extract_matched_at_path [] pc_lhs; + {case with pc_lhs = new_lhs}) + caselist + (* type_pat does not generate local constraints inside or patterns *) type type_pat_mode = | Normal @@ -1239,11 +1454,26 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env sp expected_ty k else k' Tpat_any | Ppat_var name -> + let binding_ty = + match + Variant_type_spread.get_poly_variant_narrow_matched_tags + sp.ppat_attributes + with + | Some matched_tags -> ( + match (Ctype.expand_head !env expected_ty).desc with + | Tvariant row -> + Btype.newgenty (Tvariant (Btype.narrow_row_by_tags matched_tags row)) + | _ -> expected_ty) + | None -> expected_ty + in let id = (* PR#7330 *) if name.txt = "*extension*" then Ident.create name.txt - else enter_variable loc name expected_ty + else enter_variable loc name binding_ty in + (* Keep [pat_type] at [expected_ty] so arm-wise unification in + [type_cases] sees a full catch-all; the narrowed type only + affects the variable's binding. *) rp k { pat_desc = Tpat_var (id, name); @@ -4080,6 +4310,7 @@ and type_cases ~(call_context : [`LetUnwrap | `Switch | `Function | `Try]) ?in_function env ty_arg ty_res partial_flag loc caselist : _ * Typedtree.partial = (* ty_arg is _fully_ generalized *) + let caselist = annotate_rest_nodes_with_matched_tags caselist in let patterns = List.map (fun {pc_lhs = p} -> p) caselist in let contains_polyvars = List.exists contains_polymorphic_variant patterns in let erase_either = contains_polyvars && contains_variant_either ty_arg diff --git a/compiler/ml/variant_type_spread.ml b/compiler/ml/variant_type_spread.ml index 029d98c5f9..9e6640b3bb 100644 --- a/compiler/ml/variant_type_spread.ml +++ b/compiler/ml/variant_type_spread.ml @@ -11,6 +11,36 @@ let is_pat_from_variant_spread_attr pat = | {txt = "res.patFromVariantSpread"}, PStr [] -> true | _ -> false) +(* Attribute carrying the tags matched by earlier arms at this pattern's + structural path. Attached by the type_cases pre-pass, consumed by + build_ppat_or_for_variant_spread (on a poly-variant expected type) and + by the Ppat_var handler (after rewriting). *) +let mk_poly_variant_narrow_matched_tags_attr (tags : string list) : + Parsetree.attribute = + let items = + tags + |> List.map (fun tag -> + Ast_helper.Str.eval + (Ast_helper.Exp.constant (Pconst_string (tag, None)))) + in + (Location.mknoloc "res.polyVariantNarrowMatchedTags", PStr items) + +let get_poly_variant_narrow_matched_tags (attrs : Parsetree.attributes) = + attrs + |> List.find_map (fun (a : Parsetree.attribute) -> + match a with + | {txt = "res.polyVariantNarrowMatchedTags"}, PStr items -> + Some + (items + |> List.filter_map (fun (item : Parsetree.structure_item) -> + match item.pstr_desc with + | Pstr_eval + ({pexp_desc = Pexp_constant (Pconst_string (s, _))}, _) + -> + Some s + | _ -> None)) + | _ -> None) + type variant_type_spread_error = | CouldNotFindType | HasTypeParams diff --git a/tests/build_tests/super_errors/expected/polyvariant_narrow_unreachable.res.expected b/tests/build_tests/super_errors/expected/polyvariant_narrow_unreachable.res.expected new file mode 100644 index 0000000000..a0937c1c75 --- /dev/null +++ b/tests/build_tests/super_errors/expected/polyvariant_narrow_unreachable.res.expected @@ -0,0 +1,11 @@ + + Warning number 11 + /.../fixtures/polyvariant_narrow_unreachable.res:5:5-12 + + 3 ┆ | #A => 1 + 4 ┆ | #B => 2 + 5 ┆ | ..._rest => 3 + 6 ┆ } + 7 ┆ + + this match case is unused. \ No newline at end of file diff --git a/tests/build_tests/super_errors/expected/polyvariant_narrow_wrong_type.res.expected b/tests/build_tests/super_errors/expected/polyvariant_narrow_wrong_type.res.expected new file mode 100644 index 0000000000..877a75afbc --- /dev/null +++ b/tests/build_tests/super_errors/expected/polyvariant_narrow_wrong_type.res.expected @@ -0,0 +1,18 @@ + + We've found a bug for you! + /.../fixtures/polyvariant_narrow_wrong_type.res:9:22-25 + + 7 ┆ switch x { + 8 ┆ | #A => "a" + 9 ┆ | ...rest => onlyB(rest) + 10 ┆ } + 11 ┆ + + This has type: [#B | #C] + But this function argument is expecting: [#B] + + The second polymorphic variant is closed and doesn't include the constructor: #C. + + Possible solutions: + - Either make the second variant open so it can accept additional constructors. To do this, make sure the type starts with [> instead of [ + - Or add the missing constructor to it. \ No newline at end of file diff --git a/tests/build_tests/super_errors/fixtures/polyvariant_narrow_unreachable.res b/tests/build_tests/super_errors/fixtures/polyvariant_narrow_unreachable.res new file mode 100644 index 0000000000..fd8a427857 --- /dev/null +++ b/tests/build_tests/super_errors/fixtures/polyvariant_narrow_unreachable.res @@ -0,0 +1,6 @@ +let fn = (x: [#A | #B]) => + switch x { + | #A => 1 + | #B => 2 + | ..._rest => 3 + } diff --git a/tests/build_tests/super_errors/fixtures/polyvariant_narrow_wrong_type.res b/tests/build_tests/super_errors/fixtures/polyvariant_narrow_wrong_type.res new file mode 100644 index 0000000000..4114cf683e --- /dev/null +++ b/tests/build_tests/super_errors/fixtures/polyvariant_narrow_wrong_type.res @@ -0,0 +1,10 @@ +let onlyB = (x: [#B]) => + switch x { + | #B => "b" + } + +let fn = (x: [#A | #B | #C]) => + switch x { + | #A => "a" + | ...rest => onlyB(rest) + } diff --git a/tests/tests/src/poly_variant_narrow_test.mjs b/tests/tests/src/poly_variant_narrow_test.mjs new file mode 100644 index 0000000000..0b3bcd64b4 --- /dev/null +++ b/tests/tests/src/poly_variant_narrow_test.mjs @@ -0,0 +1,354 @@ +// Generated by ReScript, PLEASE EDIT WITH CARE + +import * as Mocha from "mocha"; +import * as Test_utils from "./test_utils.mjs"; + +function handleBC(x) { + if (x === "C") { + return "c"; + } else { + return "b"; + } +} + +function narrowBasic(x) { + if (x === "A") { + return "a"; + } else { + return handleBC(x); + } +} + +function handleCD(x) { + if (x === "D") { + return 4; + } else { + return 3; + } +} + +function narrowOrPattern(x) { + if (x === "B" || x === "A") { + return 1; + } else { + return handleCD(x); + } +} + +function handleYZ(x) { + if (x === "Z") { + return 20; + } else { + return 10; + } +} + +function narrowWithAlias(x) { + if (x === "X") { + return 0; + } else { + return handleYZ(x) + handleYZ(x) | 0; + } +} + +function handlePQR(x) { + if (x === "Q") { + return 200; + } else if (x === "R") { + return 300; + } else { + return 100; + } +} + +function narrowGuardedArm(x, cond) { + if (x === "P" && cond) { + return 1; + } else { + return handlePQR(x); + } +} + +function handleBarBaz(x) { + if (x === "Baz") { + return 22; + } else { + return 11; + } +} + +function narrowNested(r) { + if (r.TAG === "Ok") { + return r._0; + } + let rest = r._0; + if (rest === "Foo") { + return 0; + } else { + return handleBarBaz(rest); + } +} + +function narrowOpenRow(x) { + if (x === "A") { + return "a"; + } else { + return handleBC(x); + } +} + +function narrowOpenAnnotated(x) { + if (x === "A") { + return "a"; + } else { + return handleBC(x); + } +} + +function narrowRecordField(w) { + let rest = w.inner; + if (rest === "A") { + return "a"; + } else { + return handleBC(rest); + } +} + +function narrowTupleSibling(p) { + if (p[0] === 0 && p[1] === "A") { + return "zero-a"; + } + let rest = p[1]; + if (rest === "A") { + return "nonzero-a"; + } else { + return handleBC(rest); + } +} + +function handleXY(x) { + if (x === "Y") { + return "y"; + } else { + return "x"; + } +} + +function narrowMultiConstructor(e) { + if (e.TAG === "First") { + let rest = e._0; + if (rest === "A") { + return "first-a"; + } else { + return handleBC(rest); + } + } + let rest$1 = e._0; + if (rest$1 === "Z") { + return "second-z"; + } else { + return handleXY(rest$1); + } +} + +function narrowRestWithGuard(x, skip) { + if (x === "A") { + return 1; + } else if (skip) { + return 99; + } else if (handleBC(x) === "b") { + return 2; + } else { + return 3; + } +} + +function handleInnerBC(x) { + if (x === "InnerC") { + return "ic"; + } else { + return "ib"; + } +} + +function narrowVariantInVariant(x) { + let rest = x.VAL; + if (rest === "InnerA") { + return "ia"; + } else { + return handleInnerBC(rest); + } +} + +function handleOpenBC(x) { + if (x === "B") { + return "b"; + } else if (x === "C") { + return "c"; + } else { + return "other"; + } +} + +function narrowFixedRow(x) { + if (x === "A") { + return "a"; + } else { + return handleOpenBC(x); + } +} + +Mocha.describe("poly variant narrow", () => { + Mocha.test("basic single-tag subtraction", () => { + Test_utils.eq("File \"poly_variant_narrow_test.res\", line 160, characters 7-14", narrowBasic("A"), "a"); + Test_utils.eq("File \"poly_variant_narrow_test.res\", line 161, characters 7-14", narrowBasic("B"), "b"); + Test_utils.eq("File \"poly_variant_narrow_test.res\", line 162, characters 7-14", narrowBasic("C"), "c"); + }); + Mocha.test("or-pattern subtracts both tags", () => { + Test_utils.eq("File \"poly_variant_narrow_test.res\", line 166, characters 7-14", narrowOrPattern("A"), 1); + Test_utils.eq("File \"poly_variant_narrow_test.res\", line 167, characters 7-14", narrowOrPattern("B"), 1); + Test_utils.eq("File \"poly_variant_narrow_test.res\", line 168, characters 7-14", narrowOrPattern("C"), 3); + Test_utils.eq("File \"poly_variant_narrow_test.res\", line 169, characters 7-14", narrowOrPattern("D"), 4); + }); + Mocha.test("...rest as r binds both names", () => { + Test_utils.eq("File \"poly_variant_narrow_test.res\", line 173, characters 7-14", narrowWithAlias("X"), 0); + Test_utils.eq("File \"poly_variant_narrow_test.res\", line 174, characters 7-14", narrowWithAlias("Y"), 20); + Test_utils.eq("File \"poly_variant_narrow_test.res\", line 175, characters 7-14", narrowWithAlias("Z"), 40); + }); + Mocha.test("guarded arms are not subtracted", () => { + Test_utils.eq("File \"poly_variant_narrow_test.res\", line 179, characters 7-14", narrowGuardedArm("P", true), 1); + Test_utils.eq("File \"poly_variant_narrow_test.res\", line 180, characters 7-14", narrowGuardedArm("P", false), 100); + Test_utils.eq("File \"poly_variant_narrow_test.res\", line 181, characters 7-14", narrowGuardedArm("Q", true), 200); + Test_utils.eq("File \"poly_variant_narrow_test.res\", line 182, characters 7-14", narrowGuardedArm("R", false), 300); + }); + Mocha.test("nested: ...rest inside Error(...)", () => { + Test_utils.eq("File \"poly_variant_narrow_test.res\", line 186, characters 7-14", narrowNested({ + TAG: "Error", + _0: "Foo" + }), 0); + Test_utils.eq("File \"poly_variant_narrow_test.res\", line 187, characters 7-14", narrowNested({ + TAG: "Error", + _0: "Bar" + }), 11); + Test_utils.eq("File \"poly_variant_narrow_test.res\", line 188, characters 7-14", narrowNested({ + TAG: "Error", + _0: "Baz" + }), 22); + Test_utils.eq("File \"poly_variant_narrow_test.res\", line 189, characters 7-14", 42, 42); + }); + Mocha.test("open row: residual stays open", () => { + Test_utils.eq("File \"poly_variant_narrow_test.res\", line 193, characters 7-14", narrowOpenRow("A"), "a"); + Test_utils.eq("File \"poly_variant_narrow_test.res\", line 194, characters 7-14", narrowOpenRow("B"), "b"); + Test_utils.eq("File \"poly_variant_narrow_test.res\", line 195, characters 7-14", narrowOpenRow("C"), "c"); + }); + Mocha.test("explicit [> ...] annotation narrows", () => { + Test_utils.eq("File \"poly_variant_narrow_test.res\", line 199, characters 7-14", narrowOpenAnnotated("A"), "a"); + Test_utils.eq("File \"poly_variant_narrow_test.res\", line 200, characters 7-14", narrowOpenAnnotated("B"), "b"); + Test_utils.eq("File \"poly_variant_narrow_test.res\", line 201, characters 7-14", narrowOpenAnnotated("C"), "c"); + }); + Mocha.test("record field nesting", () => { + Test_utils.eq("File \"poly_variant_narrow_test.res\", line 205, characters 7-14", narrowRecordField({ + inner: "A" + }), "a"); + Test_utils.eq("File \"poly_variant_narrow_test.res\", line 206, characters 7-14", narrowRecordField({ + inner: "B" + }), "b"); + Test_utils.eq("File \"poly_variant_narrow_test.res\", line 207, characters 7-14", narrowRecordField({ + inner: "C" + }), "c"); + }); + Mocha.test("tuple with permissive sibling", () => { + Test_utils.eq("File \"poly_variant_narrow_test.res\", line 211, characters 7-14", narrowTupleSibling([ + 0, + "A" + ]), "zero-a"); + Test_utils.eq("File \"poly_variant_narrow_test.res\", line 212, characters 7-14", narrowTupleSibling([ + 1, + "A" + ]), "nonzero-a"); + Test_utils.eq("File \"poly_variant_narrow_test.res\", line 213, characters 7-14", narrowTupleSibling([ + 0, + "B" + ]), "b"); + Test_utils.eq("File \"poly_variant_narrow_test.res\", line 214, characters 7-14", narrowTupleSibling([ + 1, + "C" + ]), "c"); + }); + Mocha.test("multiple constructors at independent paths", () => { + Test_utils.eq("File \"poly_variant_narrow_test.res\", line 218, characters 7-14", narrowMultiConstructor({ + TAG: "First", + _0: "A" + }), "first-a"); + Test_utils.eq("File \"poly_variant_narrow_test.res\", line 219, characters 7-14", narrowMultiConstructor({ + TAG: "First", + _0: "B" + }), "b"); + Test_utils.eq("File \"poly_variant_narrow_test.res\", line 220, characters 7-14", narrowMultiConstructor({ + TAG: "First", + _0: "C" + }), "c"); + Test_utils.eq("File \"poly_variant_narrow_test.res\", line 221, characters 7-14", narrowMultiConstructor({ + TAG: "Second", + _0: "X" + }), "x"); + Test_utils.eq("File \"poly_variant_narrow_test.res\", line 222, characters 7-14", narrowMultiConstructor({ + TAG: "Second", + _0: "Y" + }), "y"); + Test_utils.eq("File \"poly_variant_narrow_test.res\", line 223, characters 7-14", narrowMultiConstructor({ + TAG: "Second", + _0: "Z" + }), "second-z"); + }); + Mocha.test("guard on the ...rest arm itself", () => { + Test_utils.eq("File \"poly_variant_narrow_test.res\", line 227, characters 7-14", narrowRestWithGuard("A", true), 1); + Test_utils.eq("File \"poly_variant_narrow_test.res\", line 228, characters 7-14", narrowRestWithGuard("B", true), 99); + Test_utils.eq("File \"poly_variant_narrow_test.res\", line 229, characters 7-14", narrowRestWithGuard("B", false), 2); + Test_utils.eq("File \"poly_variant_narrow_test.res\", line 230, characters 7-14", narrowRestWithGuard("C", false), 3); + }); + Mocha.test("variant within variant", () => { + Test_utils.eq("File \"poly_variant_narrow_test.res\", line 234, characters 7-14", narrowVariantInVariant({ + NAME: "Outer", + VAL: "InnerA" + }), "ia"); + Test_utils.eq("File \"poly_variant_narrow_test.res\", line 235, characters 7-14", narrowVariantInVariant({ + NAME: "Outer", + VAL: "InnerB" + }), "ib"); + Test_utils.eq("File \"poly_variant_narrow_test.res\", line 236, characters 7-14", narrowVariantInVariant({ + NAME: "Outer", + VAL: "InnerC" + }), "ic"); + }); + Mocha.test("prenex-quantified row (row_fixed) still narrows", () => { + Test_utils.eq("File \"poly_variant_narrow_test.res\", line 240, characters 7-14", narrowFixedRow("A"), "a"); + Test_utils.eq("File \"poly_variant_narrow_test.res\", line 241, characters 7-14", narrowFixedRow("B"), "b"); + Test_utils.eq("File \"poly_variant_narrow_test.res\", line 242, characters 7-14", narrowFixedRow("C"), "c"); + }); +}); + +export { + handleBC, + narrowBasic, + handleCD, + narrowOrPattern, + handleYZ, + narrowWithAlias, + handlePQR, + narrowGuardedArm, + handleBarBaz, + narrowNested, + narrowOpenRow, + narrowOpenAnnotated, + narrowRecordField, + narrowTupleSibling, + handleXY, + narrowMultiConstructor, + narrowRestWithGuard, + handleInnerBC, + narrowVariantInVariant, + handleOpenBC, + narrowFixedRow, +} +/* Not a pure module */ diff --git a/tests/tests/src/poly_variant_narrow_test.res b/tests/tests/src/poly_variant_narrow_test.res new file mode 100644 index 0000000000..f235c0eb88 --- /dev/null +++ b/tests/tests/src/poly_variant_narrow_test.res @@ -0,0 +1,244 @@ +open Mocha +open Test_utils + +let handleBC = (x: [#B | #C]) => + switch x { + | #B => "b" + | #C => "c" + } + +let narrowBasic = (x: [#A | #B | #C]) => + switch x { + | #A => "a" + | ...rest => handleBC(rest) + } + +let handleCD = (x: [#C | #D]) => + switch x { + | #C => 3 + | #D => 4 + } + +let narrowOrPattern = (x: [#A | #B | #C | #D]) => + switch x { + | #A | #B => 1 + | ...rest => handleCD(rest) + } + +let handleYZ = (x: [#Y | #Z]) => + switch x { + | #Y => 10 + | #Z => 20 + } + +let narrowWithAlias = (x: [#X | #Y | #Z]) => + switch x { + | #X => 0 + | ...rest as r => handleYZ(rest) + handleYZ(r) + } + +let handlePQR = (x: [#P | #Q | #R]) => + switch x { + | #P => 100 + | #Q => 200 + | #R => 300 + } + +let narrowGuardedArm = (x: [#P | #Q | #R], cond: bool) => + switch x { + | #P if cond => 1 + | ...rest => handlePQR(rest) + } + +// Nested: ...rest inside an Error(...) constructor on a result<_, poly-variant>. +let handleBarBaz = (x: [#Bar | #Baz]) => + switch x { + | #Bar => 11 + | #Baz => 22 + } + +let narrowNested = (r: result) => + switch r { + | Error(#Foo) => 0 + | Error(...rest) => handleBarBaz(rest) + | Ok(a) => a + } + +// Open row: scrutinee type inferred (not annotated). Residual stays open +// but can unify with a closed consumer when the remaining tags line up. +let narrowOpenRow = x => + switch x { + | #A => "a" + | ...rest => handleBC(rest) + } + +// Explicit open-row annotation — same story as the inferred case. +let narrowOpenAnnotated = (x: [> #A | #B | #C]) => + switch x { + | #A => "a" + | ...rest => handleBC(rest) + } + +// Record nesting: ...rest at a record field whose type is a poly-variant. +type wrap<'a> = {inner: 'a} + +let narrowRecordField = (w: wrap<[#A | #B | #C]>) => + switch w { + | {inner: #A} => "a" + | {inner: ...rest} => handleBC(rest) + } + +// Tuple with permissive sibling: narrowing fires at the position with the rest. +let narrowTupleSibling = (p: (int, [#A | #B | #C])) => + switch p { + | (0, #A) => "zero-a" + | (_, #A) => "nonzero-a" + | (_, ...rest) => handleBC(rest) + } + +// Multiple constructors each carrying their own poly-variant: paths keep them +// independent. +let handleXY = (x: [#X | #Y]) => + switch x { + | #X => "x" + | #Y => "y" + } + +type twoErrors<'a, 'b> = First('a) | Second('b) + +let narrowMultiConstructor = (e: twoErrors<[#A | #B | #C], [#X | #Y | #Z]>) => + switch e { + | First(#A) => "first-a" + | Second(#Z) => "second-z" + | First(...rest) => handleBC(rest) + | Second(...rest) => handleXY(rest) + } + +// Guard on the rest arm itself — the rest arm's own matched set is empty +// (it doesn't match a specific tag syntactically), so later arms see +// everything the earlier unguarded arms matched. +let narrowRestWithGuard = (x: [#A | #B | #C], skip: bool) => + switch x { + | #A => 1 + | ...rest if skip => 99 + | ...rest => handleBC(rest) == "b" ? 2 : 3 + } + +// Variant within variant: ...rest inside #Outer(#Inner(...)). +let handleInnerBC = (x: [#InnerB | #InnerC]) => + switch x { + | #InnerB => "ib" + | #InnerC => "ic" + } + +let narrowVariantInVariant = (x: [#Outer([#InnerA | #InnerB | #InnerC])]) => + switch x { + | #Outer(#InnerA) => "ia" + | #Outer(...rest) => handleInnerBC(rest) + } + +// row_fixed via prenex-quantified type annotation. The scrutinee's row is +// universally quantified inside the body, so row_more is a Tunivar (which +// makes row_fixed trigger in Btype.row_fixed). Narrowing must still compute +// the correct residual; here we pass the residual to a consumer expecting +// another open-row type. +let handleOpenBC: 'b. ([> #B | #C] as 'b) => string = x => + switch x { + | #B => "b" + | #C => "c" + | _ => "other" + } + +let narrowFixedRow: 'a. ([> #A | #B | #C] as 'a) => string = x => + switch x { + | #A => "a" + | ...rest => handleOpenBC(rest) + } + +describe("poly variant narrow", () => { + test("basic single-tag subtraction", () => { + eq(__LOC__, narrowBasic(#A), "a") + eq(__LOC__, narrowBasic(#B), "b") + eq(__LOC__, narrowBasic(#C), "c") + }) + + test("or-pattern subtracts both tags", () => { + eq(__LOC__, narrowOrPattern(#A), 1) + eq(__LOC__, narrowOrPattern(#B), 1) + eq(__LOC__, narrowOrPattern(#C), 3) + eq(__LOC__, narrowOrPattern(#D), 4) + }) + + test("...rest as r binds both names", () => { + eq(__LOC__, narrowWithAlias(#X), 0) + eq(__LOC__, narrowWithAlias(#Y), 20) + eq(__LOC__, narrowWithAlias(#Z), 40) + }) + + test("guarded arms are not subtracted", () => { + eq(__LOC__, narrowGuardedArm(#P, true), 1) + eq(__LOC__, narrowGuardedArm(#P, false), 100) + eq(__LOC__, narrowGuardedArm(#Q, true), 200) + eq(__LOC__, narrowGuardedArm(#R, false), 300) + }) + + test("nested: ...rest inside Error(...)", () => { + eq(__LOC__, narrowNested(Error(#Foo)), 0) + eq(__LOC__, narrowNested(Error(#Bar)), 11) + eq(__LOC__, narrowNested(Error(#Baz)), 22) + eq(__LOC__, narrowNested(Ok(42)), 42) + }) + + test("open row: residual stays open", () => { + eq(__LOC__, narrowOpenRow(#A), "a") + eq(__LOC__, narrowOpenRow(#B), "b") + eq(__LOC__, narrowOpenRow(#C), "c") + }) + + test("explicit [> ...] annotation narrows", () => { + eq(__LOC__, narrowOpenAnnotated(#A), "a") + eq(__LOC__, narrowOpenAnnotated(#B), "b") + eq(__LOC__, narrowOpenAnnotated(#C), "c") + }) + + test("record field nesting", () => { + eq(__LOC__, narrowRecordField({inner: #A}), "a") + eq(__LOC__, narrowRecordField({inner: #B}), "b") + eq(__LOC__, narrowRecordField({inner: #C}), "c") + }) + + test("tuple with permissive sibling", () => { + eq(__LOC__, narrowTupleSibling((0, #A)), "zero-a") + eq(__LOC__, narrowTupleSibling((1, #A)), "nonzero-a") + eq(__LOC__, narrowTupleSibling((0, #B)), "b") + eq(__LOC__, narrowTupleSibling((1, #C)), "c") + }) + + test("multiple constructors at independent paths", () => { + eq(__LOC__, narrowMultiConstructor(First(#A)), "first-a") + eq(__LOC__, narrowMultiConstructor(First(#B)), "b") + eq(__LOC__, narrowMultiConstructor(First(#C)), "c") + eq(__LOC__, narrowMultiConstructor(Second(#X)), "x") + eq(__LOC__, narrowMultiConstructor(Second(#Y)), "y") + eq(__LOC__, narrowMultiConstructor(Second(#Z)), "second-z") + }) + + test("guard on the ...rest arm itself", () => { + eq(__LOC__, narrowRestWithGuard(#A, true), 1) + eq(__LOC__, narrowRestWithGuard(#B, true), 99) + eq(__LOC__, narrowRestWithGuard(#B, false), 2) + eq(__LOC__, narrowRestWithGuard(#C, false), 3) + }) + + test("variant within variant", () => { + eq(__LOC__, narrowVariantInVariant(#Outer(#InnerA)), "ia") + eq(__LOC__, narrowVariantInVariant(#Outer(#InnerB)), "ib") + eq(__LOC__, narrowVariantInVariant(#Outer(#InnerC)), "ic") + }) + + test("prenex-quantified row (row_fixed) still narrows", () => { + eq(__LOC__, narrowFixedRow(#A), "a") + eq(__LOC__, narrowFixedRow(#B), "b") + eq(__LOC__, narrowFixedRow(#C), "c") + }) +})