diff --git a/docs/release-notes/.FSharp.Compiler.Service/11.0.100.md b/docs/release-notes/.FSharp.Compiler.Service/11.0.100.md index ed1e382d6c7..bef594822b7 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/11.0.100.md +++ b/docs/release-notes/.FSharp.Compiler.Service/11.0.100.md @@ -1,5 +1,6 @@ ### Fixed +* Fix `StackOverflowException` when checking a long `seq { ... }` body. ([PR #20480](https://github.com/dotnet/fsharp/pull/20480)) * Fix `NativePtr.stackalloc` nested in a larger expression (e.g. a call argument or the right of an assignment) producing an assembly that throws `InvalidProgramException` at load. ([Issue #8083](https://github.com/dotnet/fsharp/issues/8083), [PR #20302](https://github.com/dotnet/fsharp/pull/20302)) * Fix internal error "Unexpected generalized type variables when compiling an active pattern" when an active pattern is used in a `let` binding whose right-hand side is a generic value, e.g. `let (T) = id`. Such a binding is now checked like the equivalent `match` and is not generalized. ([Issue #16856](https://github.com/dotnet/fsharp/issues/16856), [PR #20383](https://github.com/dotnet/fsharp/pull/20383)) * 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)) diff --git a/src/Compiler/Checking/Expressions/CheckSequenceExpressions.fs b/src/Compiler/Checking/Expressions/CheckSequenceExpressions.fs index 89c5afea9c6..1e4f6214d6e 100644 --- a/src/Compiler/Checking/Expressions/CheckSequenceExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckSequenceExpressions.fs @@ -412,45 +412,46 @@ let TcSequenceExpression (cenv: TcFileState) env tpenv comp (overallTy: OverallT resExpr, tpenv and tcSequenceExprBodyAsSequenceOrStatement env genOuterTy tpenv comp = - match tryTcSequenceExprBody env genOuterTy tpenv comp with - | Some(expr, tpenv) -> Choice1Of2 expr, tpenv - | None -> - - let env = - { env with - eContextInfo = ContextInfo.SequenceExpression genOuterTy - } - - if enableImplicitYield then - // The body is speculatively type-checked once to classify it as a statement or a yielded - // element. Reporting is buffered so the kept interpretation reports exactly once (else - // format-specifier locations and diagnostics double - #16419): a unit statement keeps the - // probe result and its buffered reporting is committed; a yielded element drops it and - // TcExprFlex re-checks with the element's target type. - let hasTypeUnit, _ty, expr, tpenv = - RunWithBufferedReporting - cenv.tcSink - "SeqImplicitYieldProbe" - (fun () -> TryTcStmt cenv env tpenv comp) - (fun (hasTypeUnit, _, _, _) -> hasTypeUnit) - - if hasTypeUnit then - Choice2Of2 expr, tpenv + cenv.stackGuard.Guard(fun () -> + match tryTcSequenceExprBody env genOuterTy tpenv comp with + | Some(expr, tpenv) -> Choice1Of2 expr, tpenv + | None -> + + let env = + { env with + eContextInfo = ContextInfo.SequenceExpression genOuterTy + } + + if enableImplicitYield then + // The body is speculatively type-checked once to classify it as a statement or a yielded + // element. Reporting is buffered so the kept interpretation reports exactly once (else + // format-specifier locations and diagnostics double - #16419): a unit statement keeps the + // probe result and its buffered reporting is committed; a yielded element drops it and + // TcExprFlex re-checks with the element's target type. + let hasTypeUnit, _ty, expr, tpenv = + RunWithBufferedReporting + cenv.tcSink + "SeqImplicitYieldProbe" + (fun () -> TryTcStmt cenv env tpenv comp) + (fun (hasTypeUnit, _, _, _) -> hasTypeUnit) + + if hasTypeUnit then + Choice2Of2 expr, tpenv + else + let genResultTy = NewInferenceType g + let mExpr = expr.Range + UnifyTypes cenv env mExpr genOuterTy (mkSeqTy cenv.g genResultTy) + let expr, tpenv = TcExprFlex cenv flex true genResultTy env tpenv comp + let exprTy = tyOfExpr cenv.g expr + AddCxTypeMustSubsumeType env.eContextInfo env.DisplayEnv cenv.css mExpr NoTrace genResultTy exprTy + + let resExpr = + mkCallSeqSingleton cenv.g mExpr genResultTy (mkCoerceExpr (expr, genResultTy, mExpr, exprTy)) + + Choice1Of2 resExpr, tpenv else - let genResultTy = NewInferenceType g - let mExpr = expr.Range - UnifyTypes cenv env mExpr genOuterTy (mkSeqTy cenv.g genResultTy) - let expr, tpenv = TcExprFlex cenv flex true genResultTy env tpenv comp - let exprTy = tyOfExpr cenv.g expr - AddCxTypeMustSubsumeType env.eContextInfo env.DisplayEnv cenv.css mExpr NoTrace genResultTy exprTy - - let resExpr = - mkCallSeqSingleton cenv.g mExpr genResultTy (mkCoerceExpr (expr, genResultTy, mExpr, exprTy)) - - Choice1Of2 resExpr, tpenv - else - let stmt, tpenv = TcStmtThatCantBeCtorBody cenv env tpenv comp - Choice2Of2 stmt, tpenv + let stmt, tpenv = TcStmtThatCantBeCtorBody cenv env tpenv comp + Choice2Of2 stmt, tpenv) let coreExpr, tpenv = tcSequenceExprBody env overallTy.Commit tpenv comp let delayedExpr = mkSeqDelayedExpr coreExpr.Range coreExpr diff --git a/src/Compiler/Checking/PostInferenceChecks.fs b/src/Compiler/Checking/PostInferenceChecks.fs index 1d5798320b4..d0ce757f677 100644 --- a/src/Compiler/Checking/PostInferenceChecks.fs +++ b/src/Compiler/Checking/PostInferenceChecks.fs @@ -761,7 +761,7 @@ let (|OptionalCoerce|) expr = let CheckNoReraise cenv freesOpt (body: Expr) = if cenv.reportErrors then // Avoid recomputing the free variables - let fvs = match freesOpt with None -> freeInExpr CollectLocals body | Some fvs -> fvs + let fvs = match freesOpt with None -> freeInExpr (CollectLocalsWithStackGuard()) body | Some fvs -> fvs if fvs.UsesUnboundRethrow then errorR(Error(FSComp.SR.chkErrorContainsCallToRethrow(), body.Range)) diff --git a/tests/FSharp.Compiler.ComponentTests/Language/SequenceExpressions/SequenceExpressionTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/SequenceExpressions/SequenceExpressionTests.fs index 049971fb261..534dc156f27 100644 --- a/tests/FSharp.Compiler.ComponentTests/Language/SequenceExpressions/SequenceExpressionTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Language/SequenceExpressions/SequenceExpressionTests.fs @@ -789,4 +789,18 @@ let f1() = |> asExe |> ignoreWarnings |> compileAndRun - |> shouldSucceed \ No newline at end of file + |> shouldSucceed + + [] + let ``Long sequence of implicit yields does not overflow the stack``() = + let elements = String.concat "\n" [ for i in 1..1000 -> $" {{ Name = \"n{i}\"; Id = {i} }}" ] + FSharp $""" +module M +type Data = {{ Name: string; Id: int }} +let all = + seq {{ +{elements} + }} +""" + |> typecheck + |> shouldSucceed