WIP - another take at resumable state-machine lowering in Debug

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

@@ -5,6 +5,7 @@
 * Fix Release-only (`--optimize+`) `System.InvalidProgramException` from `Seq.collect` / `yield!` over a value-type (struct) collection implementing `seq<'T>` (e.g. `ImmutableArray<_>`) when materialised with `List.ofSeq` / `Seq.toList` / `Seq.toArray` or a list/array comprehension. The collector lowering now boxes a struct sub-collection to `seq<'T>` before calling `AddMany`/`AddManyAndClose` (matching the coercion the type checker already inserts for `yield!`), and uses `unit` as the try/finally result type instead of the body type (removing a spurious `ldnull` store). ([Issue #20203](https://github.com/dotnet/fsharp/issues/20203))
 * Fix recursive inline SRTP resolution being truncated by one currying level (e.g. FSharpPlus `memoizeN`), a regression from the function-domain unification order change in [PR #15181](https://github.com/dotnet/fsharp/pull/15181); the contravariant domain now keeps the inference variable that still carries the pending member constraint. ([PR #20247](https://github.com/dotnet/fsharp/pull/20247))
 * Fix exponential (2^N) compile time in pattern matching with shared guards and partial active patterns. ([Issue #18425](https://github.com/dotnet/fsharp/issues/18425), [PR #20244](https://github.com/dotnet/fsharp/pull/20244))
+* Fix incorrect Debug lowering of inline builders that compose low-level resumable state machines. ([Issue #20466](https://github.com/dotnet/fsharp/issues/20466), [PR #20469](https://github.com/dotnet/fsharp/pull/20469))
 * 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/Optimize/Optimizer.fs

@@ -441,8 +441,7 @@ type cenv =
 
       specializedInlineVals: HashMultiMap<Stamp, TType * Expr>
 
-      /// Cache for 'HasFrameLocalBody'
-      frameLocalVals: Dictionary<Stamp, bool>
+      forcedInlineVals: Dictionary<Stamp, bool>
 
       signatureHidingInfo: SignatureHidingInfo
     }
@@ -2469,28 +2468,25 @@ let instrIsFrameLocal instr =
     | I_localloc -> true
     | _ -> false
 
-/// The FSharp.Core values expanding to frame-local IL are marked [<NoDynamicInvocation>] and so are
-/// always inlined. A user 'inline' function wrapping one inherits the property but not the
-/// attribute - the callee is already inlined into the recorded body, leaving only its IL - so
-/// recover it from the body and propagate it through further wrappers.
-/// See https://github.com/dotnet/fsharp/issues/20063.
-let rec HasFrameLocalBody cenv env (vref: ValRef) =
+/// Frame-local IL and resumable templates must remain in the caller's method.
+/// Inline wrappers inherit this requirement even when they do not inherit the callee's attributes.
+let rec HasForcedInlineBody cenv env (vref: ValRef) =
     let stamp = vref.Stamp
 
-    match cenv.frameLocalVals.TryGetValue stamp with
+    match cenv.forcedInlineVals.TryGetValue stamp with
     | true, res -> res
     | _ ->
         // Values bound within the body being walked have no info yet, but the walk covers them anyway.
         match TryGetInfoForVal cenv env vref |> Option.map (fun info -> stripValue info.ValExprInfo) with
         | Some(CurriedLambdaValue (_, _, _, body, _)) ->
-            cenv.frameLocalVals[stamp] <- false // Break cycles while the body is inspected
-            let res = ExprIsFrameLocal cenv env body
-            cenv.frameLocalVals[stamp] <- res
+            cenv.forcedInlineVals[stamp] <- false // Break cycles while the body is inspected
+            let res = ExprNeedsForcedInlining cenv env body
+            cenv.forcedInlineVals[stamp] <- res
             res
 
         | _ -> false
 
-and ExprIsFrameLocal cenv env expr =
+and ExprNeedsForcedInlining cenv env expr =
     let folder =
         { ExprFolder0 with
             exprIntercept =
@@ -2499,7 +2495,9 @@ and ExprIsFrameLocal cenv env expr =
 
                     match expr with
                     | Expr.Op (TOp.ILAsm (instrs, _), _, _, _) when List.exists instrIsFrameLocal instrs -> true
-                    | Expr.Val (vref, _, _) when vref.ShouldInline -> HasFrameLocalBody cenv env vref
+                    // Lowering must see the template and its resumable-code arguments in the same method.
+                    | StructStateMachineExpr cenv.g _ -> true
+                    | Expr.Val (vref, _, _) when vref.ShouldInline -> HasForcedInlineBody cenv env vref
                     | _ -> noInterceptF acc expr }
 
     FoldExpr folder false expr
@@ -2512,7 +2510,9 @@ let shouldForceInlineInDebug cenv env (vref: ValRef) : bool =
 
     (vref.HasDeclaringEntity && shouldForceInlineMembersInDebug g vref.DeclaringEntity) ||
 
-    HasFrameLocalBody cenv env vref
+    isReturnsResumableCodeTy g vref.TauType ||
+
+    HasForcedInlineBody cenv env vref
 
 /// Optimize/analyze an expression
 let rec OptimizeExpr cenv (env: IncrementalOptimizationEnv) expr =
@@ -3695,6 +3695,18 @@ and TryInlineApplication cenv env finfo (valExpr: Expr) (tyargs: TType list, arg
             let specLambda = MakeApplicationAndBetaReduce g (f2R, origLambdaTy, [tyargs], [], m)
             let specLambdaTy = tyOfExpr g specLambda
 
+            let hasStateMachineTemplate =
+                (false, specLambdaTy)
+                ||> SimplifyTypes.foldTypeButNotConstraints (stripTyEqns g) (fun found ty ->
+                    found ||
+                    (tryTcrefOfAppTy g ty |> ValueOption.exists (tyconRefEq g g.ResumableStateMachine_tcr)))
+
+            // A separate helper loses type parameters of the struct that replaces this template during lowering.
+            if hasStateMachineTemplate then
+                let cenv = { cenv with settings = { cenv.settings with alwaysInline = true } }
+                Some(OptimizeApplication cenv { env with debugInlineCallSite = Some m } (valExpr, vref.Type, tyargs, argsR, m))
+            else
+
             // Typars that flow in from the enclosing scope when tyargs are non-concrete. A tyarg can reach
             // only the body, and typars left unabstracted below are erased to 'object'.
             let freeTypars =
@@ -4843,7 +4855,7 @@ let OptimizeImplFile (settings, ccu, tcGlobals: TcGlobals, tcVal, importMap, opt
           stackGuard = StackGuard("OptimizerStackGuardDepth")
           realsig = tcGlobals.realsig
           specializedInlineVals = HashMultiMap(HashIdentity.Structural, true)
-          frameLocalVals = Dictionary<Stamp, bool>()
+          forcedInlineVals = Dictionary<Stamp, bool>()
           signatureHidingInfo = SignatureHidingInfo.Empty
         }
 

src/Compiler/TypedTree/TcGlobals.fsi

@@ -288,6 +288,8 @@ type internal TcGlobals =
 
     member ResumableCode_tcr: TypedTree.EntityRef
 
+    member ResumableStateMachine_tcr: TypedTree.EntityRef
+
     member System_Runtime_CompilerServices_RuntimeFeature_ty: TypedTree.TType option
 
     member addrof2_vref: TypedTree.ValRef

src/Compiler/TypedTree/TypedTreeOps.FreeVars.fs

@@ -1082,19 +1082,20 @@ module internal MemberRepresentation =
     module SimplifyTypes =
 
         // CAREFUL! This function does NOT walk constraints
-        let rec foldTypeButNotConstraints f z ty =
-            let ty = stripTyparEqns ty
+        let rec foldTypeButNotConstraints normalizeType f z ty =
+            let ty = normalizeType ty
             let z = f z ty
 
             match ty with
-            | TType_forall(_, bodyTy) -> foldTypeButNotConstraints f z bodyTy
+            | TType_forall(_, bodyTy) -> foldTypeButNotConstraints normalizeType f z bodyTy
 
             | TType_app(_, tys, _)
             | TType_ucase(_, tys)
             | TType_anon(_, tys)
-            | TType_tuple(_, tys) -> List.fold (foldTypeButNotConstraints f) z tys
+            | TType_tuple(_, tys) -> List.fold (foldTypeButNotConstraints normalizeType f) z tys
 
-            | TType_fun(domainTy, rangeTy, _) -> foldTypeButNotConstraints f (foldTypeButNotConstraints f z domainTy) rangeTy
+            | TType_fun(domainTy, rangeTy, _) ->
+                foldTypeButNotConstraints normalizeType f (foldTypeButNotConstraints normalizeType f z domainTy) rangeTy
 
             | TType_var _ -> z
 
@@ -1109,7 +1110,7 @@ module internal MemberRepresentation =
         let accTyparCounts z ty =
             // Walk type to determine typars and their counts (for pprinting decisions)
             (z, ty)
-            ||> foldTypeButNotConstraints (fun z ty ->
+            ||> foldTypeButNotConstraints stripTyparEqns (fun z ty ->
                 match ty with
                 | TType_var(tp, _) when tp.Rigidity = TyparRigidity.Rigid -> incM tp z
                 | _ -> z)

src/Compiler/TypedTree/TypedTreeOps.FreeVars.fsi

@@ -378,9 +378,12 @@ module internal MemberRepresentation =
 
     val prefixOfInferenceTypar: Typar -> string
 
-    /// Utilities used in simplifying types for visual presentation
+    /// Utilities for traversing and simplifying types
     module SimplifyTypes =
 
+        /// Fold normalized type structure without following type-parameter constraints.
+        val foldTypeButNotConstraints: (TType -> TType) -> ('State -> TType -> 'State) -> 'State -> TType -> 'State
+
         type TypeSimplificationInfo =
             { singletons: Typar Zset
               inplaceConstraints: Zmap<Typar, TType>

tests/FSharp.Compiler.ComponentTests/EmittedIL/DebugInlineAsCall.fs

@@ -1759,6 +1759,41 @@ let main _ =
         |> compileAndRun
         |> verifySequencePoints
 
+    [<Fact>]
+    let ``Resumable 04 - Builder Run is inlined`` () =
+        FSharp """
+open Microsoft.FSharp.Core.CompilerServices
+open Microsoft.FSharp.Core.CompilerServices.StateMachineHelpers
+
+#nowarn "3501"
+#nowarn "3513"
+
+type Builder() =
+    member inline _.Run(code: ResumableCode<unit, int>) =
+        if __useResumableCode then
+            __stateMachine<unit, int>
+                (MoveNextMethodImpl<_>(fun sm -> code.Invoke(&sm) |> ignore))
+                (SetStateMachineMethodImpl<_>(fun _ _ -> ()))
+                (AfterCode<_, _>(fun _ -> 42))
+        else
+            0
+
+let builder = Builder()
+
+[<EntryPoint>]
+let main _ =
+    let code = ResumableCode<unit, int>(fun _ -> true)
+    let result = builder.Run code
+    if result = 42 then 0 else 1
+"""
+        |> withDebug
+        |> withNoOptimize
+        |> asExe
+        |> compileAndRun
+        |> shouldSucceed
+        |> withExitCode 0
+        |> verifySequencePoints
+
     [<Fact>]
     let ``InlineIfLambda 01 - Debug`` () =
         FSharp """
@@ -1896,4 +1931,3 @@ let main _ =
         |> asExe
         |> compileAndRun
         |> verifySequencePoints
-

tests/FSharp.Compiler.ComponentTests/EmittedIL/DebugInlineAsCall/Resumable 01.bsl

@@ -8,35 +8,88 @@ let main _ =
 
 Test::main
   (6,13-6,17)  task
-    IL_0000:  call TaskBuilderModule::get_task
-    IL_0005:  stloc.1
-    IL_0006:  ldloc.1
-    IL_0007:  ldloc.1
-    IL_0008:  ldloc.1
-    IL_0009:  newobj t@6::.ctor
-    IL_000e:  callvirt TaskBuilderBase::Delay
-    IL_0013:  callvirt TaskBuilder::Run
-    IL_0018:  stloc.0
+    IL_0000:  ldloca.s 1
+    IL_0002:  initobj t@6
+    IL_0008:  ldloca.s 1
+    IL_000a:  stloc.2
+    IL_000b:  ldloc.2
+    IL_000c:  ldflda t@6::Data
+    IL_0011:  call Create
+    IL_0016:  stfld MethodBuilder
+    IL_001b:  ldloc.2
+    IL_001c:  ldflda t@6::Data
+    IL_0021:  ldflda MethodBuilder
+    IL_0026:  ldloc.2
+    IL_0027:  call Start
+    IL_002c:  ldloc.2
+    IL_002d:  ldflda t@6::Data
+    IL_0032:  ldflda MethodBuilder
+    IL_0037:  call get_Task
+    IL_003c:  stloc.0
 
   (7,5-7,25)  if t.Result = 1 then
-    IL_0019:  ldloc.0
-    IL_001a:  callvirt get_Result
-    IL_001f:  ldc.i4.1
-    IL_0020:  bne.un.s IL_0024
+    IL_003d:  ldloc.0
+    IL_003e:  callvirt get_Result
+    IL_0043:  ldc.i4.1
+    IL_0044:  bne.un.s IL_0048
 
   (7,26-7,27)  0
-    IL_0022:  ldc.i4.0
-    IL_0023:  ret
+    IL_0046:  ldc.i4.0
+    IL_0047:  ret
 
   (7,33-7,34)  1
-    IL_0024:  ldc.i4.1
-    IL_0025:  ret
+    IL_0048:  ldc.i4.1
+    IL_0049:  ret
 
-t@6::Invoke
-  (6,20-6,28)  return 1
+t@6::MoveNext
+  <hidden>
     IL_0000:  ldarg.0
-    IL_0001:  ldfld t@6::builder@
-    IL_0006:  ldc.i4.1
-    IL_0007:  tail.
-    IL_0009:  callvirt TaskBuilderBase::Return
-    IL_000e:  ret
+    IL_0001:  ldfld t@6::ResumptionPoint
+    IL_0006:  stloc.0
+
+  (6,20-6,28)  return 1
+    IL_0007:  ldc.i4.1
+    IL_0008:  stloc.3
+    IL_0009:  ldarg.0
+    IL_000a:  ldflda t@6::Data
+    IL_000f:  ldloc.3
+    IL_0010:  stfld Result
+    IL_0015:  ldc.i4.1
+    IL_0016:  stloc.2
+    IL_0017:  ldloc.2
+    IL_0018:  brfalse.s IL_0037
+
+  <hidden>
+    IL_001a:  ldarg.0
+    IL_001b:  ldflda t@6::Data
+    IL_0020:  ldflda MethodBuilder
+    IL_0025:  ldarg.0
+    IL_0026:  ldflda t@6::Data
+    IL_002b:  ldfld Result
+    IL_0030:  call SetResult
+    IL_0035:  leave.s IL_0045
+
+  <hidden>
+    IL_0037:  leave.s IL_0045
+    IL_0039:  castclass Exception
+    IL_003e:  stloc.s 4
+    IL_0040:  ldloc.s 4
+    IL_0042:  stloc.1
+    IL_0043:  leave.s IL_0045
+
+  <hidden>
+    IL_0045:  ldloc.1
+    IL_0046:  stloc.s 5
+    IL_0048:  ldloc.s 5
+    IL_004a:  brtrue.s IL_004d
+
+  <hidden>
+    IL_004c:  ret
+
+  <hidden>
+    IL_004d:  ldarg.0
+    IL_004e:  ldflda t@6::Data
+    IL_0053:  ldflda MethodBuilder
+    IL_0058:  ldloc.s 5
+    IL_005a:  call SetException
+    IL_005f:  ret