From b35f4859eb820544c68ef916f591e566dec70bdb Mon Sep 17 00:00:00 2001 From: Christoph Knittel Date: Sat, 24 Oct 2026 06:17:11 +0000 Subject: [PATCH] Keep cases handled by a default arm out of the arms a switch names Why: A `switch` on an untagged variant with a `_` arm let the cases it does not name reach the arms it names: a `Date` matched the object arm, since only arrays were guarded, and an `@as("lit")` literal matched the string arm, since the literal test was skipped when the switch names no literal (#8995). The `switch (typeof x)` is preceded by a guard sending every instance case without an arm to the default, as it already did for arrays. The literal test is skipped only when no literal of the variant would pass the check of a payload arm. Rules 7 and 9 of the spec state both. JS modified (an instance handled by the default): Example: @unboxed type t = D(Date.t) | R(RegExp.t) | O({x: int}) | S(string) | I(int) | F(int => int) let f = v => switch v { | O(_) => "O" | S(_) => "S" | _ => "other" } Before (js): switch (typeof v) { case "object" : return "O"; After (js): if (v instanceof RegExp || v instanceof Date) { return "other"; } switch (typeof v) { case "object" : return "O"; JS modified (a literal handled by the default): Example: @unboxed type t = | @as("lit") Lit | S(string) | I(int) | B(bool) | O({x: int}) | F(int => int) let f = v => switch v { | S(_) => "S" | O(_) => "O" | _ => "other" } Before (js): switch (typeof v) { case "string" : return "S"; After (js): if (v === "lit") { return "other"; } switch (typeof v) { case "string" : return "S"; Fixes: #8995 Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01CMkrYaktctdKc4M41WF36t Signed-off-by: Christoph Knittel --- changes/untagged-default-arm.fix.md | 1 + compiler/core/lam_compile.ml | 75 +++++++++++++------ compiler/ml/UntaggedVariants.md | 25 ++++--- tests/tests/src/untagged_default_arm_test.mjs | 63 ++++++++++++++++ tests/tests/src/untagged_default_arm_test.res | 44 +++++++++++ 5 files changed, 174 insertions(+), 34 deletions(-) create mode 100644 changes/untagged-default-arm.fix.md create mode 100644 tests/tests/src/untagged_default_arm_test.mjs create mode 100644 tests/tests/src/untagged_default_arm_test.res diff --git a/changes/untagged-default-arm.fix.md b/changes/untagged-default-arm.fix.md new file mode 100644 index 0000000000..d0f84fcff6 --- /dev/null +++ b/changes/untagged-default-arm.fix.md @@ -0,0 +1 @@ +- Fix untagged variant switches with a default arm matching class instances in the object case and literals in a payload case of their kind. diff --git a/compiler/core/lam_compile.ml b/compiler/core/lam_compile.ml index 05fbf7762b..22cc6b68ac 100644 --- a/compiler/core/lam_compile.ml +++ b/compiler/core/lam_compile.ml @@ -780,10 +780,34 @@ let compile output_prefix = | NonComplete, NonComplete -> true | _ -> false in + (* A literal handled by the default would otherwise pass the + check of a payload arm of its kind *) + let a_literal_reaches_an_arm () = + let arm_types = + Ext_list.filter_map sw_blocks (fun (key, _) -> + match tag_of_switch_key key with + | Some {tag_type = Some (Payload_shape block_type)} -> + Some block_type + | Some _ | None -> None) + in + Ext_list.exists literal_cases + (fun (literal : Variant_runtime.literal_tag) -> + Ext_list.exists arm_types + (fun (block_type : Variant_runtime.block_type) -> + match (literal, block_type) with + | String _, StringType + | (Int _ | Float _), (IntType | FloatType) + | BigInt _, BigintType + | Bool _, BooleanType + | _, UnknownType -> + true + | _, _ -> false)) + in if untagged && List.length sw_consts = 0 && eq_default sw_num_default sw_blocks_default + && not (a_literal_reaches_an_arm ()) then let has_null_case = List.mem Variant_runtime.Null literal_cases in compile_cases ~untagged ~cxt @@ -864,26 +888,25 @@ let compile output_prefix = | _ -> false) typeof_clauses in - let clauses_have_array_case = - List.exists - (function - | Variant_runtime.Payload_shape (InstanceType Array), _ -> true - | _ -> false) - not_typeof_clauses - in - let type_has_array_case = - List.exists - (function - | Variant_runtime.InstanceType Array -> true - | _ -> false) - block_cases - in - (* When there's an ObjectType typeof case, null and arrays can - incorrectly match it (typeof null === typeof [] === "object"). - Guard against them when they should fall through to default. *) + (* When there's an ObjectType typeof case, null, arrays and class + instances can incorrectly match it (typeof null === typeof [] === + "object"). Guard against them when they should fall through to + default: null, and the instance cases without an arm of their own. *) let needs_null_guard = has_object_typeof && has_null_case in - let needs_array_guard = - has_object_typeof && type_has_array_case && not clauses_have_array_case + let unmatched_instances = + if not has_object_typeof then [] + else + Ext_list.filter_map block_cases (function + | Variant_runtime.InstanceType instance + when not + (List.exists + (function + | Variant_runtime.Payload_shape (InstanceType i), _ -> + i = instance + | _ -> false) + not_typeof_clauses) -> + Some instance + | _ -> None) in let rec build_if_chain remaining_clauses = match remaining_clauses with @@ -898,12 +921,16 @@ let compile output_prefix = let typeof_switch () = S.string_switch ?default ?declaration (E.typeof e) typeof_clauses in + let guards = + (if needs_null_guard then [E.is_null e] else []) + @ List.map + (fun instance -> E.emit_check (IsInstanceOf (instance, Expr e))) + unmatched_instances + in let guard = - match (needs_null_guard, needs_array_guard) with - | true, true -> Some (E.or_ (E.is_null e) (E.is_array e)) - | true, false -> Some (E.is_null e) - | false, true -> Some (E.is_array e) - | false, false -> None + match guards with + | [] -> None + | first :: rest -> Some (List.fold_left E.or_ first rest) in match (guard, default) with | Some guard, Some default_body -> diff --git a/compiler/ml/UntaggedVariants.md b/compiler/ml/UntaggedVariants.md index a3e21a8352..daaad8e6f4 100644 --- a/compiler/ml/UntaggedVariants.md +++ b/compiler/ml/UntaggedVariants.md @@ -192,7 +192,10 @@ constructor: The "is a literal case" test is the smaller of two equivalent expressions: the disjunction of `x === literal` over the literal cases, or the conjunction of the negated payload checks (with a payload check replaced by the literal -disjunction where a literal overlaps it). +disjunction where a literal overlaps it). A `switch` whose arms name no +literal case still tests the literals first when one of them would pass the +check of a payload arm, such as `@as("lit")` beside a `string` arm, so that +it reaches the default arm. - Implementation: `lam_compile.ml:compile_switch`, `ast_untagged_variants.ml:Dynamic_checks.is_a_literal_case`. @@ -227,12 +230,13 @@ number, integral or not. ### 9. `null` and arrays are not objects -`typeof null` and `typeof []` are `"object"`. The object case never receives -`null` when the variant has an `@as(null)` case, and never receives an array -when the variant has an array or tuple case: the two-arm form adds the checks -of rule 8, and the `switch (typeof x)` form is preceded by -`x === null` / `Array.isArray(x)` guards that send those values to the default -arm when their own arm is absent. +`typeof null` and `typeof []` are `"object"`, and so is the `typeof` of a +class instance. The object case never receives `null` when the variant has an +`@as(null)` case, and never receives a value of another instance case (array, +tuple or class): the two-arm form adds the checks of rule 8, and the +`switch (typeof x)` form is preceded by `x === null`, `Array.isArray(x)` and +`x instanceof C` guards that send those values to the default arm when their +own arm is absent. | Declaration | `switch` arms | Value | Arm | | --- | --- | --- | --- | @@ -241,9 +245,10 @@ arm when their own arm is absent. | | `GObject(_)`, `_` | `[]`, `null` | `_` | - Implementation: `lam_compile.ml:compile_untagged_cases` (`needs_null_guard`, - `needs_array_guard`), `Dynamic_checks.add_runtime_type_check`. -- Tests: `spec_test` rule 9; `UntaggedVariants.res` (`ObjectAndNull`, `Json`). -- Shaped by #6219, #7303, #8253, #8255, #8279. + `unmatched_instances`), `Dynamic_checks.add_runtime_type_check`. +- Tests: `spec_test` rule 9; `UntaggedVariants.res` (`ObjectAndNull`, `Json`); + `tests/tests/src/untagged_default_arm_test.res`. +- Shaped by #6219, #7303, #8253, #8255, #8279, #8995. ### 10. Values outside every case diff --git a/tests/tests/src/untagged_default_arm_test.mjs b/tests/tests/src/untagged_default_arm_test.mjs new file mode 100644 index 0000000000..49ddffd59e --- /dev/null +++ b/tests/tests/src/untagged_default_arm_test.mjs @@ -0,0 +1,63 @@ +// Generated by ReScript, PLEASE EDIT WITH CARE + +import * as Mocha from "mocha"; +import * as Test_utils from "./test_utils.mjs"; + +function id(x) { + return x; +} + +function objectOrString(value) { + if (value instanceof RegExp || value instanceof Date) { + return "other"; + } + switch (typeof value) { + case "object" : + return "O"; + case "string" : + return "S"; + default: + return "other"; + } +} + +function textOrRecord(value) { + if (value === "lit") { + return "other"; + } + switch (typeof value) { + case "string" : + return "text"; + case "object" : + return "record"; + default: + return "other"; + } +} + +Mocha.describe("Untagged_default_arm_test", () => { + Mocha.test("an instance handled by the default is not an object case", () => { + Test_utils.eq("File \"untagged_default_arm_test.res\", line 31, characters 7-14", "other", objectOrString(id(new Date()))); + Test_utils.eq("File \"untagged_default_arm_test.res\", line 32, characters 7-14", "other", objectOrString(id(/a/))); + Test_utils.eq("File \"untagged_default_arm_test.res\", line 33, characters 7-14", "O", objectOrString(id({ + x: 1 + }))); + Test_utils.eq("File \"untagged_default_arm_test.res\", line 34, characters 7-14", "S", objectOrString(id("s"))); + Test_utils.eq("File \"untagged_default_arm_test.res\", line 35, characters 7-14", "other", objectOrString(id(1))); + }); + Mocha.test("a literal handled by the default is not a string case", () => { + Test_utils.eq("File \"untagged_default_arm_test.res\", line 39, characters 7-14", "other", textOrRecord(id("lit"))); + Test_utils.eq("File \"untagged_default_arm_test.res\", line 40, characters 7-14", "text", textOrRecord(id("lit2"))); + Test_utils.eq("File \"untagged_default_arm_test.res\", line 41, characters 7-14", "record", textOrRecord(id({ + x: 1 + }))); + Test_utils.eq("File \"untagged_default_arm_test.res\", line 42, characters 7-14", "other", textOrRecord(id(1))); + }); +}); + +export { + id, + objectOrString, + textOrRecord, +} +/* Not a pure module */ diff --git a/tests/tests/src/untagged_default_arm_test.res b/tests/tests/src/untagged_default_arm_test.res new file mode 100644 index 0000000000..dce3172e6a --- /dev/null +++ b/tests/tests/src/untagged_default_arm_test.res @@ -0,0 +1,44 @@ +open Mocha +open Test_utils + +@inline(never) let id = x => x + +// A switch with a default arm keeps the cases it does not name out of the +// arms it names (#8995) +@unboxed +type instances = D(Date.t) | R(RegExp.t) | O({x: int}) | S(string) | I(int) | F(int => int) + +let objectOrString = value => + switch value { + | O(_) => "O" + | S(_) => "S" + | _ => "other" + } + +@unboxed +type literals = + | @as("lit") Lit | Text(string) | Count(int) | Flag(bool) | Rec({x: int}) | Fn(int => int) + +let textOrRecord = value => + switch value { + | Text(_) => "text" + | Rec(_) => "record" + | _ => "other" + } + +describe(__MODULE__, () => { + test("an instance handled by the default is not an object case", () => { + eq(__LOC__, "other", objectOrString(id(D(Date.make())))) + eq(__LOC__, "other", objectOrString(id(R(/a/)))) + eq(__LOC__, "O", objectOrString(id(O({x: 1})))) + eq(__LOC__, "S", objectOrString(id(S("s")))) + eq(__LOC__, "other", objectOrString(id(I(1)))) + }) + + test("a literal handled by the default is not a string case", () => { + eq(__LOC__, "other", textOrRecord(id(Lit))) + eq(__LOC__, "text", textOrRecord(id(Text("lit2")))) + eq(__LOC__, "record", textOrRecord(id(Rec({x: 1})))) + eq(__LOC__, "other", textOrRecord(id(Count(1)))) + }) +})