From bb596f736bfd7edbcba916876db78aafc2316270 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Tue, 9 Dec 2025 10:07:42 +0100 Subject: [PATCH] Fix exponential compilation blowup in pattern matching and boolean simplification This PR fixes two sources of exponential compilation time: 1. **Boolean expression simplification** (`js_exp_make.ml`): The `simplify_and_` function had O(3^n) recursive behavior when simplifying nested AND expressions. Added a depth limit (10) to prevent exponential blowup while preserving optimizations for normal cases. Fixes the issue reported in #8039 and #8042 (large unboxed variants). Note: PR #8039's diagnosis of "infinite recursion" was incorrect - the actual issue was exponential blowup, not infinite loops. 2. **Exhaustiveness checking** (`parmatch.ml`): The `exhaust_gadt` function had exponential complexity (~4^n) when checking exhaustiveness for dict pattern matching. Added a call count limit (1000) that conservatively reports non-exhaustive when exceeded, preventing hangs while maintaining correctness. Performance improvements: - Large unboxed variants (28 cases): 3.79s -> 0.03s (126x faster) - Dict pattern matching (6 cases): 0.94s -> 0.04s (24x faster) Added test cases for both scenarios. Closes #8074 Closes #8039 Closes #8042 --- CHANGELOG.md | 1 + compiler/core/js_exp_make.ml | 601 +++++++++--------- compiler/ml/parmatch.ml | 105 +-- .../src/DictPatternMatchingOptimization.mjs | 84 +++ .../src/DictPatternMatchingOptimization.res | 15 + .../src/LargeUnboxedVariantOptimization.mjs | 14 + .../src/LargeUnboxedVariantOptimization.res | 47 ++ 7 files changed, 525 insertions(+), 342 deletions(-) create mode 100644 tests/tests/src/DictPatternMatchingOptimization.mjs create mode 100644 tests/tests/src/DictPatternMatchingOptimization.res create mode 100644 tests/tests/src/LargeUnboxedVariantOptimization.mjs create mode 100644 tests/tests/src/LargeUnboxedVariantOptimization.res diff --git a/CHANGELOG.md b/CHANGELOG.md index 32ab2a29fa..744da2a53e 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -20,6 +20,7 @@ #### :bug: Bug fix +- Fix exponential compilation blowup with large unboxed variants and dict pattern matching. https://github.com/rescript-lang/rescript/pull/8078 - Rewatch: warnings for unsupported/unknown rescript.json fields. https://github.com/rescript-lang/rescript/pull/8031 - Fix missing `ignore` function in some Stdlib modules. https://github.com/rescript-lang/rescript/pull/8060 - Fix signature matching for externals when abstract alias hides function arity. https://github.com/rescript-lang/rescript/pull/8045 diff --git a/compiler/core/js_exp_make.ml b/compiler/core/js_exp_make.ml index 2703e1d8ca..210c0a58dd 100644 --- a/compiler/core/js_exp_make.ml +++ b/compiler/core/js_exp_make.ml @@ -686,6 +686,9 @@ let rec push_negation (e : t) : t option = | _ -> None) | _ -> None +(* Depth limit to prevent exponential blowup in simplify_and_/simplify_or_ *) +let simplify_max_depth = 10 + (** [simplify_and_ e1 e2] attempts to simplify the boolean AND expression [e1 && e2]. Returns [Some simplified] if simplification is possible, [None] otherwise. @@ -731,301 +734,309 @@ let rec simplify_and_ ~n (e1 : t) (e2 : t) : t option = Printf.eprintf "%s simplify_and %s %s\n" (String.make (n * 2) ' ') (!string_of_expression e1) (!string_of_expression e2); - let res = - match (e1.expression_desc, e2.expression_desc) with - | Bool false, _ -> Some false_ - | _, Bool false -> Some false_ - | Bool true, _ -> Some e2 - | _, Bool true -> Some e1 - | Bin (And, a, b), _ -> ( - let ao = simplify_and_ ~n:(n + 1) a e2 in - let bo = simplify_and_ ~n:(n + 1) b e2 in - match (ao, bo) with - | None, None -> ( - match simplify_and_ ~n:(n + 1) a b with - | None -> None - | Some e -> simplify_and_force ~n:(n + 1) e e2) - | Some a_, None -> simplify_and_force ~n:(n + 1) a_ b - | None, Some b_ -> simplify_and_force ~n:(n + 1) a b_ - | Some a_, Some b_ -> simplify_and_force ~n:(n + 1) a_ b_) - | _, Bin (And, a, b) -> - simplify_and_ ~n:(n + 1) - {expression_desc = Bin (And, e1, a); comment = None} - b - | Bin (Or, a, b), _ -> ( - let ao = simplify_and_ ~n:(n + 1) a e2 in - let bo = simplify_and_ ~n:(n + 1) b e2 in - match (ao, bo) with - | Some {expression_desc = Bool false}, None -> - Some {expression_desc = Bin (And, b, e2); comment = None} - | None, Some {expression_desc = Bool false} -> - Some {expression_desc = Bin (And, a, e2); comment = None} - | None, _ | _, None -> ( - match simplify_or_ ~n:(n + 1) a b with - | None -> None - | Some e -> simplify_and_force ~n:(n + 1) e e2) - | Some a_, Some b_ -> simplify_or_force ~n:(n + 1) a_ b_) - | ( Bin - ( ((EqEqEq | NotEqEq) as op1), - {expression_desc = Var i1}, - {expression_desc = Bool b1} ), - Bin - ( ((EqEqEq | NotEqEq) as op2), - {expression_desc = Var i2}, - {expression_desc = Bool b2} ) ) - when Js_op_util.same_vident i1 i2 -> - let op_eq = op1 = op2 in - let consistent = if op_eq then b1 = b2 else b1 <> b2 in - if consistent then Some e1 else Some false_ - | ( Bin - ( EqEqEq, - {expression_desc = Typeof {expression_desc = Var ia}}, - {expression_desc = Str {txt = "boolean"}} ), - (Bin (EqEqEq, {expression_desc = Var ib}, {expression_desc = Bool _}) as - b) ) - | ( (Bin (EqEqEq, {expression_desc = Var ib}, {expression_desc = Bool _}) as - b), - Bin - ( EqEqEq, - {expression_desc = Typeof {expression_desc = Var ia}}, - {expression_desc = Str {txt = "boolean"}} ) ) - when Js_op_util.same_vident ia ib -> - Some {expression_desc = b; comment = None} - | ( Bin - ( EqEqEq, - {expression_desc = Typeof {expression_desc = Var ia}}, - {expression_desc = Str {txt = "string"}} ), - (Bin (EqEqEq, {expression_desc = Var ib}, {expression_desc = Str _}) as - s) ) - | ( (Bin (EqEqEq, {expression_desc = Var ib}, {expression_desc = Str _}) as s), - Bin - ( EqEqEq, - {expression_desc = Typeof {expression_desc = Var ia}}, - {expression_desc = Str {txt = "string"}} ) ) - when Js_op_util.same_vident ia ib -> - Some {expression_desc = s; comment = None} - | ( Bin - ( EqEqEq, - {expression_desc = Typeof {expression_desc = Var ia}}, - {expression_desc = Str {txt = "number"}} ), - (Bin (EqEqEq, {expression_desc = Var ib}, {expression_desc = Number _}) - as i) ) - | ( (Bin (EqEqEq, {expression_desc = Var ib}, {expression_desc = Number _}) - as i), - Bin - ( EqEqEq, - {expression_desc = Typeof {expression_desc = Var ia}}, - {expression_desc = Str {txt = "number"}} ) ) - when Js_op_util.same_vident ia ib -> - Some {expression_desc = i; comment = None} - | ( Bin - ( EqEqEq, - {expression_desc = Typeof {expression_desc = Var ia}}, - {expression_desc = Str {txt = "boolean" | "string" | "number"}} ), - Bin - ( EqEqEq, - {expression_desc = Var ib}, - {expression_desc = Bool _ | Null | Undefined _ | Number _ | Str _} - ) ) - | ( Bin - ( EqEqEq, - {expression_desc = Var ib}, - {expression_desc = Bool _ | Null | Undefined _ | Number _ | Str _} - ), - Bin - ( EqEqEq, - {expression_desc = Typeof {expression_desc = Var ia}}, - {expression_desc = Str {txt = "boolean" | "string" | "number"}} ) ) - when Js_op_util.same_vident ia ib -> - (* Note: cases boolean / Bool _, number / Number _, string / Str _ are handled above *) - Some false_ - | ( Call - ( {expression_desc = Str {txt = "Array.isArray"}}, - [{expression_desc = Var ia}], - _ ), - Bin - ( EqEqEq, - {expression_desc = Var ib}, - {expression_desc = Bool _ | Null | Undefined _ | Number _ | Str _} - ) ) - | ( Bin - ( EqEqEq, - {expression_desc = Var ib}, - {expression_desc = Bool _ | Null | Undefined _ | Number _ | Str _} - ), - Call - ( {expression_desc = Str {txt = "Array.isArray"}}, - [{expression_desc = Var ia}], - _ ) ) - when Js_op_util.same_vident ia ib -> - Some false_ - | ( Bin - ( EqEqEq, - {expression_desc = Typeof {expression_desc = Var ia}}, - {expression_desc = Str {txt = "boolean"}} ), - Var ib ) - | ( Var ib, - Bin - ( EqEqEq, - {expression_desc = Typeof {expression_desc = Var ia}}, - {expression_desc = Str {txt = "boolean"}} ) ) - when Js_op_util.same_vident ia ib -> - Some - { - expression_desc = - Bin (EqEqEq, {expression_desc = Var ib; comment = None}, true_); - comment = None; - } - | ( Bin - ( EqEqEq, - {expression_desc = Typeof {expression_desc = Var ia}}, - {expression_desc = Str {txt = "boolean"}} ), - Js_not {expression_desc = Var ib} ) - | ( Js_not {expression_desc = Var ib}, - Bin - ( EqEqEq, - {expression_desc = Typeof {expression_desc = Var ia}}, - {expression_desc = Str {txt = "boolean"}} ) ) - when Js_op_util.same_vident ia ib -> - Some - { - expression_desc = - Bin (EqEqEq, {expression_desc = Var ib; comment = None}, false_); - comment = None; - } - | ( Bin - ( EqEqEq, - {expression_desc = Typeof {expression_desc = Var ia}}, - {expression_desc = Str {txt = "boolean"}} ), - Bin (NotEqEq, {expression_desc = Var ib}, {expression_desc = Bool b}) ) - | ( Bin (NotEqEq, {expression_desc = Var ib}, {expression_desc = Bool b}), - Bin - ( EqEqEq, - {expression_desc = Typeof {expression_desc = Var ia}}, - {expression_desc = Str {txt = "boolean"}} ) ) - when Js_op_util.same_vident ia ib -> - Some {expression_desc = Bool (not b); comment = None} - | ( Bin - ( EqEqEq, - {expression_desc = Typeof {expression_desc = Var ia}}, - {expression_desc = Str {txt = "string"}} ), - Bin (NotEqEq, {expression_desc = Var ib}, {expression_desc = Str _}) ) - | ( Bin (NotEqEq, {expression_desc = Var ib}, {expression_desc = Str _}), - Bin - ( EqEqEq, - {expression_desc = Typeof {expression_desc = Var ia}}, - {expression_desc = Str {txt = "string"}} ) ) - when Js_op_util.same_vident ia ib -> - None - | ( Bin - ( EqEqEq, - {expression_desc = Typeof {expression_desc = Var ia}}, - {expression_desc = Str {txt = "number"}} ), - Bin (NotEqEq, {expression_desc = Var ib}, {expression_desc = Number _}) - ) - | ( Bin (NotEqEq, {expression_desc = Var ib}, {expression_desc = Number _}), - Bin - ( EqEqEq, - {expression_desc = Typeof {expression_desc = Var ia}}, - {expression_desc = Str {txt = "number"}} ) ) - when Js_op_util.same_vident ia ib -> - None - | ( Bin - ( EqEqEq, - {expression_desc = Typeof {expression_desc = Var ia}}, - {expression_desc = Str {txt = "object"}} ), - Bin (NotEqEq, {expression_desc = Var ib}, {expression_desc = Null}) ) - | ( Bin (NotEqEq, {expression_desc = Var ib}, {expression_desc = Null}), - Bin - ( EqEqEq, - {expression_desc = Typeof {expression_desc = Var ia}}, - {expression_desc = Str {txt = "object"}} ) ) - when Js_op_util.same_vident ia ib -> - None - | ( (Bin - ( EqEqEq, - {expression_desc = Typeof {expression_desc = Var ia}}, - { - expression_desc = - Str {txt = "boolean" | "string" | "number" | "object"}; - } ) as typeof), - Bin - ( NotEqEq, - {expression_desc = Var ib}, - {expression_desc = Bool _ | Null | Undefined _ | Number _ | Str _} - ) ) - | ( Bin - ( NotEqEq, - {expression_desc = Var ib}, - {expression_desc = Bool _ | Null | Undefined _} ), - (Bin - ( EqEqEq, - {expression_desc = Typeof {expression_desc = Var ia}}, - { - expression_desc = - Str {txt = "boolean" | "string" | "number" | "object"}; - } ) as typeof) ) - when Js_op_util.same_vident ia ib -> - (* Note: cases boolean / Bool _, number / Number _, string / Str _, object / Null are handled above *) - Some {expression_desc = typeof; comment = None} - | ( (Call - ( {expression_desc = Str {txt = "Array.isArray"}}, - [{expression_desc = Var ia}], - _ ) as is_array), - Bin - ( NotEqEq, - {expression_desc = Var ib}, - {expression_desc = Bool _ | Null | Undefined _ | Number _ | Str _} - ) ) - | ( Bin - ( NotEqEq, - {expression_desc = Var ib}, - {expression_desc = Bool _ | Null | Undefined _ | Number _ | Str _} - ), - (Call - ( {expression_desc = Str {txt = "Array.isArray"}}, - [{expression_desc = Var ia}], - _ ) as is_array) ) - when Js_op_util.same_vident ia ib -> - Some {expression_desc = is_array; comment = None} - | _ when Js_analyzer.eq_expression e1 e2 -> Some e1 - | ( Bin - ( EqEqEq, - {expression_desc = Var ia}, - {expression_desc = Bool _ | Null | Undefined _ | Number _ | Str _} - ), - Bin - ( EqEqEq, - {expression_desc = Var ib}, - {expression_desc = Bool _ | Null | Undefined _ | Number _ | Str _} - ) ) - when Js_op_util.same_vident ia ib -> - (* Note: case x = y is handled above *) - Some false_ - | ( Bin - ( ((EqEqEq | NotEqEq) as op1), - {expression_desc = Var ia}, - ({expression_desc = Bool _ | Null | Undefined _ | Number _ | Str _} - as v1) ), - Bin - ( ((EqEqEq | NotEqEq) as op2), - {expression_desc = Var ib}, - ({expression_desc = Bool _ | Null | Undefined _ | Number _ | Str _} - as v2) ) ) - when Js_op_util.same_vident ia ib && op1 != op2 -> - if Js_analyzer.eq_expression v1 v2 then Some false_ - else if op1 = EqEqEq then Some e1 - else Some e2 - | _ -> None - in - (if debug then - match res with - | None -> () - | Some e -> - Printf.eprintf "%s = %s\n" - (String.make (n * 2) ' ') - (!string_of_expression e)); - res + (* Bail out if recursion is too deep to prevent exponential blowup *) + if n > simplify_max_depth then None + else + let res = + match (e1.expression_desc, e2.expression_desc) with + | Bool false, _ -> Some false_ + | _, Bool false -> Some false_ + | Bool true, _ -> Some e2 + | _, Bool true -> Some e1 + | Bin (And, a, b), _ -> ( + let ao = simplify_and_ ~n:(n + 1) a e2 in + let bo = simplify_and_ ~n:(n + 1) b e2 in + match (ao, bo) with + | None, None -> ( + match simplify_and_ ~n:(n + 1) a b with + | None -> None + | Some e -> simplify_and_force ~n:(n + 1) e e2) + | Some a_, None -> simplify_and_force ~n:(n + 1) a_ b + | None, Some b_ -> simplify_and_force ~n:(n + 1) a b_ + | Some a_, Some b_ -> simplify_and_force ~n:(n + 1) a_ b_) + | _, Bin (And, a, b) -> + simplify_and_ ~n:(n + 1) + {expression_desc = Bin (And, e1, a); comment = None} + b + | Bin (Or, a, b), _ -> ( + let ao = simplify_and_ ~n:(n + 1) a e2 in + let bo = simplify_and_ ~n:(n + 1) b e2 in + match (ao, bo) with + | Some {expression_desc = Bool false}, None -> + Some {expression_desc = Bin (And, b, e2); comment = None} + | None, Some {expression_desc = Bool false} -> + Some {expression_desc = Bin (And, a, e2); comment = None} + | None, _ | _, None -> ( + match simplify_or_ ~n:(n + 1) a b with + | None -> None + | Some e -> simplify_and_force ~n:(n + 1) e e2) + | Some a_, Some b_ -> simplify_or_force ~n:(n + 1) a_ b_) + | ( Bin + ( ((EqEqEq | NotEqEq) as op1), + {expression_desc = Var i1}, + {expression_desc = Bool b1} ), + Bin + ( ((EqEqEq | NotEqEq) as op2), + {expression_desc = Var i2}, + {expression_desc = Bool b2} ) ) + when Js_op_util.same_vident i1 i2 -> + let op_eq = op1 = op2 in + let consistent = if op_eq then b1 = b2 else b1 <> b2 in + if consistent then Some e1 else Some false_ + | ( Bin + ( EqEqEq, + {expression_desc = Typeof {expression_desc = Var ia}}, + {expression_desc = Str {txt = "boolean"}} ), + (Bin (EqEqEq, {expression_desc = Var ib}, {expression_desc = Bool _}) + as b) ) + | ( (Bin (EqEqEq, {expression_desc = Var ib}, {expression_desc = Bool _}) + as b), + Bin + ( EqEqEq, + {expression_desc = Typeof {expression_desc = Var ia}}, + {expression_desc = Str {txt = "boolean"}} ) ) + when Js_op_util.same_vident ia ib -> + Some {expression_desc = b; comment = None} + | ( Bin + ( EqEqEq, + {expression_desc = Typeof {expression_desc = Var ia}}, + {expression_desc = Str {txt = "string"}} ), + (Bin (EqEqEq, {expression_desc = Var ib}, {expression_desc = Str _}) + as s) ) + | ( (Bin (EqEqEq, {expression_desc = Var ib}, {expression_desc = Str _}) + as s), + Bin + ( EqEqEq, + {expression_desc = Typeof {expression_desc = Var ia}}, + {expression_desc = Str {txt = "string"}} ) ) + when Js_op_util.same_vident ia ib -> + Some {expression_desc = s; comment = None} + | ( Bin + ( EqEqEq, + {expression_desc = Typeof {expression_desc = Var ia}}, + {expression_desc = Str {txt = "number"}} ), + (Bin (EqEqEq, {expression_desc = Var ib}, {expression_desc = Number _}) + as i) ) + | ( (Bin (EqEqEq, {expression_desc = Var ib}, {expression_desc = Number _}) + as i), + Bin + ( EqEqEq, + {expression_desc = Typeof {expression_desc = Var ia}}, + {expression_desc = Str {txt = "number"}} ) ) + when Js_op_util.same_vident ia ib -> + Some {expression_desc = i; comment = None} + | ( Bin + ( EqEqEq, + {expression_desc = Typeof {expression_desc = Var ia}}, + {expression_desc = Str {txt = "boolean" | "string" | "number"}} ), + Bin + ( EqEqEq, + {expression_desc = Var ib}, + {expression_desc = Bool _ | Null | Undefined _ | Number _ | Str _} + ) ) + | ( Bin + ( EqEqEq, + {expression_desc = Var ib}, + {expression_desc = Bool _ | Null | Undefined _ | Number _ | Str _} + ), + Bin + ( EqEqEq, + {expression_desc = Typeof {expression_desc = Var ia}}, + {expression_desc = Str {txt = "boolean" | "string" | "number"}} ) + ) + when Js_op_util.same_vident ia ib -> + (* Note: cases boolean / Bool _, number / Number _, string / Str _ are handled above *) + Some false_ + | ( Call + ( {expression_desc = Str {txt = "Array.isArray"}}, + [{expression_desc = Var ia}], + _ ), + Bin + ( EqEqEq, + {expression_desc = Var ib}, + {expression_desc = Bool _ | Null | Undefined _ | Number _ | Str _} + ) ) + | ( Bin + ( EqEqEq, + {expression_desc = Var ib}, + {expression_desc = Bool _ | Null | Undefined _ | Number _ | Str _} + ), + Call + ( {expression_desc = Str {txt = "Array.isArray"}}, + [{expression_desc = Var ia}], + _ ) ) + when Js_op_util.same_vident ia ib -> + Some false_ + | ( Bin + ( EqEqEq, + {expression_desc = Typeof {expression_desc = Var ia}}, + {expression_desc = Str {txt = "boolean"}} ), + Var ib ) + | ( Var ib, + Bin + ( EqEqEq, + {expression_desc = Typeof {expression_desc = Var ia}}, + {expression_desc = Str {txt = "boolean"}} ) ) + when Js_op_util.same_vident ia ib -> + Some + { + expression_desc = + Bin (EqEqEq, {expression_desc = Var ib; comment = None}, true_); + comment = None; + } + | ( Bin + ( EqEqEq, + {expression_desc = Typeof {expression_desc = Var ia}}, + {expression_desc = Str {txt = "boolean"}} ), + Js_not {expression_desc = Var ib} ) + | ( Js_not {expression_desc = Var ib}, + Bin + ( EqEqEq, + {expression_desc = Typeof {expression_desc = Var ia}}, + {expression_desc = Str {txt = "boolean"}} ) ) + when Js_op_util.same_vident ia ib -> + Some + { + expression_desc = + Bin (EqEqEq, {expression_desc = Var ib; comment = None}, false_); + comment = None; + } + | ( Bin + ( EqEqEq, + {expression_desc = Typeof {expression_desc = Var ia}}, + {expression_desc = Str {txt = "boolean"}} ), + Bin (NotEqEq, {expression_desc = Var ib}, {expression_desc = Bool b}) + ) + | ( Bin (NotEqEq, {expression_desc = Var ib}, {expression_desc = Bool b}), + Bin + ( EqEqEq, + {expression_desc = Typeof {expression_desc = Var ia}}, + {expression_desc = Str {txt = "boolean"}} ) ) + when Js_op_util.same_vident ia ib -> + Some {expression_desc = Bool (not b); comment = None} + | ( Bin + ( EqEqEq, + {expression_desc = Typeof {expression_desc = Var ia}}, + {expression_desc = Str {txt = "string"}} ), + Bin (NotEqEq, {expression_desc = Var ib}, {expression_desc = Str _}) ) + | ( Bin (NotEqEq, {expression_desc = Var ib}, {expression_desc = Str _}), + Bin + ( EqEqEq, + {expression_desc = Typeof {expression_desc = Var ia}}, + {expression_desc = Str {txt = "string"}} ) ) + when Js_op_util.same_vident ia ib -> + None + | ( Bin + ( EqEqEq, + {expression_desc = Typeof {expression_desc = Var ia}}, + {expression_desc = Str {txt = "number"}} ), + Bin (NotEqEq, {expression_desc = Var ib}, {expression_desc = Number _}) + ) + | ( Bin (NotEqEq, {expression_desc = Var ib}, {expression_desc = Number _}), + Bin + ( EqEqEq, + {expression_desc = Typeof {expression_desc = Var ia}}, + {expression_desc = Str {txt = "number"}} ) ) + when Js_op_util.same_vident ia ib -> + None + | ( Bin + ( EqEqEq, + {expression_desc = Typeof {expression_desc = Var ia}}, + {expression_desc = Str {txt = "object"}} ), + Bin (NotEqEq, {expression_desc = Var ib}, {expression_desc = Null}) ) + | ( Bin (NotEqEq, {expression_desc = Var ib}, {expression_desc = Null}), + Bin + ( EqEqEq, + {expression_desc = Typeof {expression_desc = Var ia}}, + {expression_desc = Str {txt = "object"}} ) ) + when Js_op_util.same_vident ia ib -> + None + | ( (Bin + ( EqEqEq, + {expression_desc = Typeof {expression_desc = Var ia}}, + { + expression_desc = + Str {txt = "boolean" | "string" | "number" | "object"}; + } ) as typeof), + Bin + ( NotEqEq, + {expression_desc = Var ib}, + {expression_desc = Bool _ | Null | Undefined _ | Number _ | Str _} + ) ) + | ( Bin + ( NotEqEq, + {expression_desc = Var ib}, + {expression_desc = Bool _ | Null | Undefined _} ), + (Bin + ( EqEqEq, + {expression_desc = Typeof {expression_desc = Var ia}}, + { + expression_desc = + Str {txt = "boolean" | "string" | "number" | "object"}; + } ) as typeof) ) + when Js_op_util.same_vident ia ib -> + (* Note: cases boolean / Bool _, number / Number _, string / Str _, object / Null are handled above *) + Some {expression_desc = typeof; comment = None} + | ( (Call + ( {expression_desc = Str {txt = "Array.isArray"}}, + [{expression_desc = Var ia}], + _ ) as is_array), + Bin + ( NotEqEq, + {expression_desc = Var ib}, + {expression_desc = Bool _ | Null | Undefined _ | Number _ | Str _} + ) ) + | ( Bin + ( NotEqEq, + {expression_desc = Var ib}, + {expression_desc = Bool _ | Null | Undefined _ | Number _ | Str _} + ), + (Call + ( {expression_desc = Str {txt = "Array.isArray"}}, + [{expression_desc = Var ia}], + _ ) as is_array) ) + when Js_op_util.same_vident ia ib -> + Some {expression_desc = is_array; comment = None} + | _ when Js_analyzer.eq_expression e1 e2 -> Some e1 + | ( Bin + ( EqEqEq, + {expression_desc = Var ia}, + {expression_desc = Bool _ | Null | Undefined _ | Number _ | Str _} + ), + Bin + ( EqEqEq, + {expression_desc = Var ib}, + {expression_desc = Bool _ | Null | Undefined _ | Number _ | Str _} + ) ) + when Js_op_util.same_vident ia ib -> + (* Note: case x = y is handled above *) + Some false_ + | ( Bin + ( ((EqEqEq | NotEqEq) as op1), + {expression_desc = Var ia}, + ({ + expression_desc = Bool _ | Null | Undefined _ | Number _ | Str _; + } as v1) ), + Bin + ( ((EqEqEq | NotEqEq) as op2), + {expression_desc = Var ib}, + ({ + expression_desc = Bool _ | Null | Undefined _ | Number _ | Str _; + } as v2) ) ) + when Js_op_util.same_vident ia ib && op1 != op2 -> + if Js_analyzer.eq_expression v1 v2 then Some false_ + else if op1 = EqEqEq then Some e1 + else Some e2 + | _ -> None + in + (if debug then + match res with + | None -> () + | Some e -> + Printf.eprintf "%s = %s\n" + (String.make (n * 2) ' ') + (!string_of_expression e)); + res and simplify_and_force ~n (e1 : t) (e2 : t) : t option = match simplify_and_ ~n e1 e2 with diff --git a/compiler/ml/parmatch.ml b/compiler/ml/parmatch.ml index 8d1fe66c70..9e66800c8b 100644 --- a/compiler/ml/parmatch.ml +++ b/compiler/ml/parmatch.ml @@ -1386,17 +1386,27 @@ let print_pat pat = (* strictly more powerful than exhaust; however, exhaust was kept for backwards compatibility *) -let rec exhaust_gadt (ext : Path.t option) pss n = - match pss with - | [] -> Rsome [omegas n] - | [] :: _ -> Rnone - | pss -> ( - if not (all_coherent (simplified_first_col pss)) then - (* We're considering an ill-typed branch, we won't actually be able to + +(* Limit to prevent exponential blowup in exhaustiveness checking. + When the limit is exceeded, we conservatively report the pattern as + non-exhaustive (Rnone) which may cause false warnings but prevents hangs. *) +let exhaust_gadt_limit = 1000 + +let rec exhaust_gadt_aux count (ext : Path.t option) pss n = + (* Bail out if we've done too many recursive calls to prevent exponential blowup *) + if !count > exhaust_gadt_limit then Rnone + else ( + incr count; + match pss with + | [] -> Rsome [omegas n] + | [] :: _ -> Rnone + | pss -> ( + if not (all_coherent (simplified_first_col pss)) then + (* We're considering an ill-typed branch, we won't actually be able to produce a well typed value taking that branch. *) - Rnone - else - (* Assuming the first column is ill-typed but considered coherent, we + Rnone + else + (* Assuming the first column is ill-typed but considered coherent, we might end up producing an ill-typed witness of non-exhaustivity corresponding to the current branch. @@ -1406,29 +1416,29 @@ let rec exhaust_gadt (ext : Path.t option) pss n = If [exhaust] has been called by [do_check_fragile], then it is possible we might fail to warn the user that the matching is fragile. See for example testsuite/tests/warnings/w04_failure.ml. *) - let q0 = discr_pat omega pss in - match filter_all q0 pss with - (* first column of pss is made of variables only *) - | [] -> ( - match exhaust_gadt ext (filter_extra pss) (n - 1) with - | Rsome r -> Rsome (List.map (fun row -> q0 :: row) r) - | r -> r) - | constrs -> ( - let try_non_omega (p, pss) = - if is_absent_pat p then Rnone + let q0 = discr_pat omega pss in + match filter_all q0 pss with + (* first column of pss is made of variables only *) + | [] -> ( + match exhaust_gadt_aux count ext (filter_extra pss) (n - 1) with + | Rsome r -> Rsome (List.map (fun row -> q0 :: row) r) + | r -> r) + | constrs -> ( + let try_non_omega (p, pss) = + if is_absent_pat p then Rnone + else + match + exhaust_gadt_aux count ext pss + (List.length (simple_match_args p omega) + n - 1) + with + | Rsome r -> Rsome (List.map (fun row -> set_args p row) r) + | r -> r + in + let before = try_many_gadt try_non_omega constrs in + if full_match false constrs && not (should_extend ext constrs) then + before else - match - exhaust_gadt ext pss - (List.length (simple_match_args p omega) + n - 1) - with - | Rsome r -> Rsome (List.map (fun row -> set_args p row) r) - | r -> r - in - let before = try_many_gadt try_non_omega constrs in - if full_match false constrs && not (should_extend ext constrs) then - before - else - (* + (* D = filter_extra pss is the default matrix as it is included in pss, one can avoid recursive calls on specialized matrices, @@ -1436,23 +1446,24 @@ let rec exhaust_gadt (ext : Path.t option) pss n = * D exhaustive => pss exhaustive * D non-exhaustive => we have a non-filtered value *) - let r = exhaust_gadt ext (filter_extra pss) (n - 1) in - match r with - | Rnone -> before - | Rsome r -> ( - try - let p = build_other ext constrs in - let dug = List.map (fun tail -> p :: tail) r in - match before with - | Rnone -> Rsome dug - | Rsome x -> Rsome (x @ dug) - with - (* cannot occur, since constructors don't make a full signature *) - | Empty -> - fatal_error "Parmatch.exhaust"))) + let r = exhaust_gadt_aux count ext (filter_extra pss) (n - 1) in + match r with + | Rnone -> before + | Rsome r -> ( + try + let p = build_other ext constrs in + let dug = List.map (fun tail -> p :: tail) r in + match before with + | Rnone -> Rsome dug + | Rsome x -> Rsome (x @ dug) + with + (* cannot occur, since constructors don't make a full signature *) + | Empty -> + fatal_error "Parmatch.exhaust")))) let exhaust_gadt ext pss n = - let ret = exhaust_gadt ext pss n in + let count = ref 0 in + let ret = exhaust_gadt_aux count ext pss n in match ret with | Rnone -> Rnone | Rsome lst -> diff --git a/tests/tests/src/DictPatternMatchingOptimization.mjs b/tests/tests/src/DictPatternMatchingOptimization.mjs new file mode 100644 index 0000000000..60f9a611b6 --- /dev/null +++ b/tests/tests/src/DictPatternMatchingOptimization.mjs @@ -0,0 +1,84 @@ +// Generated by ReScript, PLEASE EDIT WITH CARE + + +function decode(data) { + let match = JSON.parse(data); + if (typeof match !== "object" || match === null || Array.isArray(match)) { + return []; + } + let match$1 = match.type; + let exit = 0; + if (typeof match$1 === "string") { + if (match$1 === "a") { + return ["A"]; + } + exit = 1; + } else { + exit = 1; + } + if (exit === 1) { + let match$2 = match.type; + let exit$1 = 0; + if (typeof match$2 === "string") { + if (match$2 === "b") { + return ["B"]; + } + exit$1 = 2; + } else { + exit$1 = 2; + } + if (exit$1 === 2) { + let match$3 = match.type; + let exit$2 = 0; + if (typeof match$3 === "string") { + if (match$3 === "c") { + return ["C"]; + } + exit$2 = 3; + } else { + exit$2 = 3; + } + if (exit$2 === 3) { + let match$4 = match.type; + let exit$3 = 0; + if (typeof match$4 === "string") { + if (match$4 === "d") { + return ["D"]; + } + exit$3 = 4; + } else { + exit$3 = 4; + } + if (exit$3 === 4) { + let match$5 = match.type; + let exit$4 = 0; + if (typeof match$5 === "string") { + if (match$5 === "e") { + return ["E"]; + } + exit$4 = 5; + } else { + exit$4 = 5; + } + if (exit$4 === 5) { + let match$6 = match.type; + if (typeof match$6 === "string") { + if (match$6 === "f") { + return ["F"]; + } else { + return []; + } + } else { + return []; + } + } + } + } + } + } +} + +export { + decode, +} +/* No side effect */ diff --git a/tests/tests/src/DictPatternMatchingOptimization.res b/tests/tests/src/DictPatternMatchingOptimization.res new file mode 100644 index 0000000000..8b8046c717 --- /dev/null +++ b/tests/tests/src/DictPatternMatchingOptimization.res @@ -0,0 +1,15 @@ +// Test for dict pattern matching compilation performance +// This used to cause exponential blowup in exhaustiveness checking (issue #8042) + +type inbound = A | B | C | D | E | F + +let decode = (~data: string): array => + switch JSON.parseOrThrow(data) { + | JSON.Object(dict{"type": JSON.String("a")}) => [A] + | JSON.Object(dict{"type": JSON.String("b")}) => [B] + | JSON.Object(dict{"type": JSON.String("c")}) => [C] + | JSON.Object(dict{"type": JSON.String("d")}) => [D] + | JSON.Object(dict{"type": JSON.String("e")}) => [E] + | JSON.Object(dict{"type": JSON.String("f")}) => [F] + | _ => [] + } diff --git a/tests/tests/src/LargeUnboxedVariantOptimization.mjs b/tests/tests/src/LargeUnboxedVariantOptimization.mjs new file mode 100644 index 0000000000..2659dfd433 --- /dev/null +++ b/tests/tests/src/LargeUnboxedVariantOptimization.mjs @@ -0,0 +1,14 @@ +// Generated by ReScript, PLEASE EDIT WITH CARE + + +function handleKey(state, key) { + if (key === "space" && state.active) { + doAction(state); + return; + } +} + +export { + handleKey, +} +/* No side effect */ diff --git a/tests/tests/src/LargeUnboxedVariantOptimization.res b/tests/tests/src/LargeUnboxedVariantOptimization.res new file mode 100644 index 0000000000..35ea2ac42d --- /dev/null +++ b/tests/tests/src/LargeUnboxedVariantOptimization.res @@ -0,0 +1,47 @@ +// Test for large unboxed variant compilation performance +// This used to cause exponential blowup in simplify_and_ (issue #8039) + +@unboxed +type key = + | @as("a") A + | @as("b") B + | @as("c") C + | @as("d") D + | @as("e") E + | @as("f") F + | @as("g") G + | @as("h") H + | @as("i") I + | @as("j") J + | @as("k") K + | @as("l") L + | @as("m") M + | @as("n") N + | @as("o") O + | @as("p") P + | @as("q") Q + | @as("r") R + | @as("s") S + | @as("t") T + | @as("u") U + | @as("v") V + | @as("w") W + | @as("x") X + | @as("y") Y + | @as("z") Z + | @as("space") Space + | @as("string") String(string) + +type state = {mutable active: bool} + +@val external doAction: state => unit = "doAction" + +let handleKey = (state: state, key: key) => { + switch key { + | Space => + if state.active { + doAction(state) + } + | _ => () + } +}