Fix super-linear compilation of guarded shared-or active-pattern matches

docs/release-notes/.FSharp.Compiler.Service/11.0.100.md

@@ -1,5 +1,6 @@
 ### Fixed
 
+* Fix exponential (2^N) compile time, assembly size and eventual stack overflow when a single match clause has N disjuncts that share one `when` guard and whose disjuncts contain partial active patterns. Each disjunct contributed both a fail edge and a guard-false edge to the same residual decision state, which pattern-match compilation re-investigated along all 2^N paths. Identical residual states are now compiled once into a shared let-bound join point, making compilation linear while preserving exact runtime behaviour (active patterns are evaluated the same number of times, in the same order, with the same side effects). ([Issue #18425](https://github.com/dotnet/fsharp/issues/18425), [PR #20244](https://github.com/dotnet/fsharp/pull/20244))
 * Fix incorrect `StructLayout(Size = 1)` emission for data-less struct unions where the compiler-generated tag field makes the actual runtime size larger. ([PR #19759](https://github.com/dotnet/fsharp/pull/19759))
 * Fix FS0750 "This construct may only be used within computation expressions" incorrectly raised for `let!`/`use!`/`do!` appearing in the right-hand side of a plain `let` binding inside a computation expression. The right-hand side is now desugared as a nested computation of the same builder whose result is bound with `let!`, keeping its bindings correctly scoped. ([Issue #19457](https://github.com/dotnet/fsharp/issues/19457), [PR #19868](https://github.com/dotnet/fsharp/pull/19868))
 * Stop leaking a `System.Diagnostics.Metrics.MeterListener` per `Cache` in DEBUG builds. Each cache created a `CacheMetrics.CacheMetricsListener` (which starts a `MeterListener` registered in the process-global metrics registry) and never disposed it, so listeners accumulated for the lifetime of the process. Because every cache hit/miss/add published to all registered listeners, the per-operation cost grew linearly with the number of leaked listeners, so repeated checks (and Debug FCS test runs) slowed down over time. The per-cache `CacheMetricsListener` and the per-instance `cacheId` tag are removed; `DebugDisplay` and tests now read the existing name-aggregated stats populated by the single `ListenToAll` listener, so no per-cache listener is created and no per-operation cost is added. ([PR #19995](https://github.com/dotnet/fsharp/pull/19995))

src/Compiler/Checking/Expressions/CheckExpressionsOps.fs

@@ -85,7 +85,7 @@ let CompilePatternForMatch
     =
     let g = cenv.g
 
-    let dtree, targets =
+    let dtree, targets, joins =
         CompilePattern
             g
             env.DisplayEnv
@@ -101,7 +101,10 @@ let CompilePatternForMatch
             inputTy
             resultTy
 
-    mkAndSimplifyMatch DebugPointAtBinding.NoneAtInvisible mExpr mMatch resultTy dtree targets
+    let matchExpr =
+        mkAndSimplifyMatch DebugPointAtBinding.NoneAtInvisible mExpr mMatch resultTy dtree targets
+
+    List.foldBack (fun (v, rhs) acc -> mkInvisibleLet mMatch v rhs acc) joins matchExpr
 
 /// Invoke pattern match compilation
 let CompilePatternForMatchClauses (cenv: TcFileState) env mExpr mMatch warnOnUnused actionOnFailure inputExprOpt inputTy resultTy tclauses =

src/Compiler/Checking/PatternMatchCompilation.fsi

@@ -69,7 +69,7 @@ val internal CompilePattern:
         TType ->
         // result type
         TType ->
-            DecisionTree * DecisionTreeTarget list
+            DecisionTree * DecisionTreeTarget list * (Val * Expr) list
 
 /// Exception raised when a pattern match is incomplete.
 /// Fields: isComputationExpression * (counterExample * isShownAsFieldPattern) option * range

tests/FSharp.Compiler.ComponentTests/Conformance/Expressions/ExpressionQuotations/QuotationRendering/QuotationRenderingTests.fs

@@ -58,3 +58,51 @@ module QuotationRendering =
     [<Fact>]
     let Decimal () =
         quoteShouldRender "Decimal" """<@ fun (x: decimal) -> match x with 1m -> "a" | _ -> "b" @>"""
+
+    // --- Issue #18425: join-point sharing of a guarded shared-or residual, as reflected in quotations. ---
+    //
+    // A single match clause whose disjuncts share one `when` guard and contain PARTIAL active patterns used
+    // to duplicate the residual decision subtree once per disjunct. That expansion is the 2^N compile-time /
+    // DLL-size / StackOverflow blow-up of #18425. The fix compiles each distinct residual state ONCE into a
+    // let-bound `joinThunk` lambda that every later path calls, e.g.:
+    //       Let (joinThunk, Lambda (unitArg, <the shared residual>),
+    //            <body that reaches the residual by calling joinThunk ()>)
+    // Because quotations reflect the elaborated decision tree, the change is directly observable here.
+    //
+    // Sharing only kicks in once a residual is reached MORE than the promotion threshold (32) times, so all
+    // ordinary matches keep their pristine quotation verbatim (the N=6 control below is byte-identical); only
+    // the exponential #18425 shape crosses the threshold (N>=7 here) and shares. Tests assert on the
+    // stamp-free `joinThunk` marker rather than a full .bsl snapshot, which would churn on unrelated
+    // `activePatternResultNNN` stamp shifts.
+    let private renderGuardedOrQuote (quoteExpr: string) : string =
+        let prelude =
+            "let (|E|_|) (n: int) (x: int) = if x = n then Some x else None\n"
+            + "let (|A|_|) (x: int) = if x % 2 = 0 then Some (x / 2) else None\n"
+            + "let g (p: int) = p > 1000\n"
+        let result =
+            Fsx (prelude + sprintf "printfn \"%%A\" %s" quoteExpr)
+            |> evalInSharedSession fsiSession
+            |> shouldSucceed
+        match result.RunOutput with
+        | Some (EvalOutput e) -> e.StdOut |> normalizeNewlines
+        | _ -> failwith "Expected eval output from shared FSI session."
+
+    [<Fact>]
+    let ``Issue 18425 - guarded shared-or below the sharing threshold keeps the pristine quotation`` () =
+        // Six disjuncts stay under the promotion threshold, so no join is introduced: an ordinary match is
+        // compiled exactly as the pristine compiler would.
+        let rendered = renderGuardedOrQuote """<@ fun (x: int) -> match x with (E 1 _ | E 2 _ | E 3 _ | E 4 _ | E 5 _ | E 6 _) when g 0 -> 1 | _ -> 0 @>"""
+        Assert.DoesNotContain("joinThunk", rendered)
+
+    [<Fact>]
+    let ``Issue 18425 - guarded shared-or shares the residual as a single join above the threshold`` () =
+        // Above the threshold the shared residual is compiled once into a join that every path calls.
+        let rendered = renderGuardedOrQuote """<@ fun (x: int) -> match x with (E 1 _ | E 2 _ | E 3 _ | E 4 _ | E 5 _ | E 6 _ | E 7 _ | E 8 _) when g 0 -> 1 | _ -> 0 @>"""
+        Assert.Contains("joinThunk", rendered)
+
+    [<Fact>]
+    let ``Issue 18425 - shared join threads a bound pattern variable through the tuple or-pattern`` () =
+        // The canonical #18425 shape: a shared partial AP in column 0 binds `p`, read by the shared guard and
+        // result; the join captures and forwards `p` through its parameter.
+        let rendered = renderGuardedOrQuote """<@ fun (a: int) (b: int) -> match a, b with (A p, E 1 _) | (A p, E 2 _) | (A p, E 3 _) | (A p, E 4 _) | (A p, E 5 _) | (A p, E 6 _) | (A p, E 7 _) | (A p, E 8 _) when g p -> p | _ -> 0 @>"""
+        Assert.Contains("joinThunk", rendered)

tests/FSharp.Compiler.ComponentTests/Conformance/PatternMatching/GuardedOrPatternComplexity.fs

@@ -0,0 +1,113 @@
+// Copyright (c) Microsoft Corporation.  All Rights Reserved.  See License.txt in the project root for license information.
+
+namespace Conformance.PatternMatching
+
+open Xunit
+open FSharp.Test.Compiler
+
+module GuardedOrPatternComplexity =
+
+    // https://github.com/dotnet/fsharp/issues/18425
+    // A single match clause of N disjuncts that SHARE one `when` guard, whose disjuncts contain
+    // partial active patterns, used to compile in exponential (2^N) time and space: each disjunct
+    // contributes both a fail edge and a guard-false edge to the same residual decision state, which
+    // the pattern-match compiler re-investigated along all 2^N paths, blowing up compile time, DLL
+    // size and finally the stack. Join-point memoization compiles each distinct residual state once,
+    // making it linear while preserving exact runtime behaviour.
+    let private guardedOrSource n =
+        let disjuncts =
+            [ for k in 1..n -> sprintf "    | (A p, E %d _)" k ]
+            |> String.concat "\n"
+
+        let template = """module Test
+let (|A|_|) (x: int) = if x % 2 = 0 then Some(x / 2) else None
+let (|E|_|) (n: int) (x: int) = if x = n then Some x else None
+let g (p: int) = p > 1000
+let f (a: int) (b: int) =
+    match a, b with
+__DISJUNCTS__
+        when g p -> p
+    | _ -> -1
+[<EntryPoint>]
+let main _ =
+    // 8 -> A matches (p = 4), b = 3 -> disjunct (A p, E 3 _) matches, guard g 4 is false -> -1
+    let r1 = f 8 3
+    // 4000 -> A matches (p = 2000), b = 1 -> disjunct (A p, E 1 _) matches, guard g 2000 is true -> 2000
+    let r2 = f 4000 1
+    printfn "r1=%d r2=%d" r1 r2
+    0
+"""
+
+        template.Replace("__DISJUNCTS__", disjuncts)
+
+    // A 24-disjunct guarded shared-or match: on the pre-fix compiler this exhausts the stack during
+    // analysis (never produces an assembly). It must now compile, run and yield the exact results a
+    // linear left-to-right evaluation of the clause would give.
+    [<Fact>]
+    let ``Issue 18425 - guarded shared-or partial active pattern match compiles and runs`` () =
+        guardedOrSource 24
+        |> FSharp
+        |> asExe
+        |> compileExeAndRun
+        |> shouldSucceed
+        |> withStdOutContains "r1=-1 r2=2000"
+
+    // Join-point memoization must never FUSE two residual states that bind the same clause variable to a
+    // DIFFERENT projection of the match input. Here `x` is bound at a different tuple position in each of the
+    // eight disjuncts of one guarded clause: the states share an (empty) active set and captures but differ
+    // in which element feeds the guard and the result, so fusing them would bake one projection into all of
+    // them and miscompile. Eight disjuncts cross the promotion threshold, so the memo path is exercised; each
+    // `f` call must still return the element that made the guard true.
+    [<Fact>]
+    let ``Issue 18425 - shared guard binding a variable at different positions is not over-fused`` () =
+        """module Test
+let (|Z|_|) (v: int) = if v = 0 then Some() else None
+let (|Pos|_|) (v: int) = if v > 100 then Some v else None
+let f (t: int*int*int*int*int*int*int*int) =
+    match t with
+    | (Pos x, Z, Z, Z, Z, Z, Z, Z)
+    | (Z, Pos x, Z, Z, Z, Z, Z, Z)
+    | (Z, Z, Pos x, Z, Z, Z, Z, Z)
+    | (Z, Z, Z, Pos x, Z, Z, Z, Z)
+    | (Z, Z, Z, Z, Pos x, Z, Z, Z)
+    | (Z, Z, Z, Z, Z, Pos x, Z, Z)
+    | (Z, Z, Z, Z, Z, Z, Pos x, Z)
+    | (Z, Z, Z, Z, Z, Z, Z, Pos x) when x > 100 -> x
+    | _ -> -1
+[<EntryPoint>]
+let main _ =
+    printfn "%d %d %d %d" (f (150,0,0,0,0,0,0,0)) (f (0,0,0,160,0,0,0,0)) (f (0,0,0,0,0,0,0,170)) (f (1,2,3,4,5,6,7,8))
+    0
+"""
+        |> FSharp
+        |> asExe
+        |> compileExeAndRun
+        |> shouldSucceed
+        |> withStdOutContains "150 160 170 -1"
+
+    // A join thunk is an FSharpFunc over the captured locals returning the match result, but the CLR forbids a
+    // byref-like type (here byref<int>) as a generic type argument, so a promoted state returning one would emit
+    // FSharpFunc<_, int&> and fail with FS0412. This guarded shared-or match returns a byref and has enough
+    // disjuncts to cross the promotion threshold, so memoization must recognise the byref result and leave the
+    // state inline exactly as the pristine compiler does. It must compile and mutate through the returned byref.
+    [<Fact>]
+    let ``Issue 18425 - guarded shared-or returning a byref stays inline and compiles`` () =
+        """module Test
+let (|E|_|) (n: int) (x: int) = if x = n then Some x else None
+let f (arr: int[]) (b: int) : byref<int> =
+    match b with
+    | E 1 _ | E 2 _ | E 3 _ | E 4 _ | E 5 _ | E 6 _ | E 7 _ | E 8 _ when arr.Length > 2 -> &arr[0]
+    | _ -> &arr[1]
+[<EntryPoint>]
+let main _ =
+    let arr = [| 10; 20; 30 |]
+    (f arr 3) <- 99
+    (f arr 42) <- 77
+    printfn "%d %d" arr[0] arr[1]
+    0
+"""
+        |> FSharp
+        |> asExe
+        |> compileExeAndRun
+        |> shouldSucceed
+        |> withStdOutContains "99 77"

tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj

@@ -155,6 +155,7 @@
     <Compile Include="Conformance\PatternMatching\Simple\Simple.fs" />
     <Compile Include="Conformance\PatternMatching\Array\Array.fs" />
     <Compile Include="Conformance\PatternMatching\And\And.fs" />
+    <Compile Include="Conformance\PatternMatching\GuardedOrPatternComplexity.fs" />
     <Compile Include="Conformance\PatternMatching\As\As.fs" />
     <Compile Include="Conformance\PatternMatching\ConsList\ConsList.fs" />
     <Compile Include="Conformance\PatternMatching\DynamicTypeTest\DynamicTypeTest.fs" />