Fix #19457: lift CE constructs from plain let RHS in computation expressions

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

@@ -1,5 +1,6 @@
 ### Fixed
 
+* Fix FS0750 "This construct may only be used within computation expressions" incorrectly raised for `let!`/`do!` appearing in the RHS of a plain `let` binding inside a computation expression. Such CE-only constructs are now lifted into the enclosing CE so the example from the issue compiles. ([Issue #19457](https://github.com/dotnet/fsharp/issues/19457), [PR #19868](https://github.com/dotnet/fsharp/pull/19868))
 * Reject non-function bindings for single-case and partial active pattern names with FS1209, matching the existing multi-case behavior. ([PR #19763](https://github.com/dotnet/fsharp/pull/19763))
 * Fix FS0421 "The address of the variable cannot be used at this point" incorrectly raised for the discard pattern `let _ = &expr` when `let x = &expr` compiles. ([Issue #18841](https://github.com/dotnet/fsharp/issues/18841), [PR #19811](https://github.com/dotnet/fsharp/pull/19811))
 * Honor `--nowarn` and `--warnaserror` for warnings emitted during command-line option parsing ([Issue #19576](https://github.com/dotnet/fsharp/issues/19576), [PR #19776](https://github.com/dotnet/fsharp/pull/19776))

src/Compiler/Checking/Expressions/CheckComputationExpressions.fs

@@ -1009,6 +1009,40 @@ let requireBuilderMethod methodName ceenv m1 m2 =
     if not (hasBuilderMethod ceenv m1 methodName) then
         error (Error(FSComp.SR.tcRequireBuilderMethod methodName, m2))
 
+/// Detect whether an expression syntactically contains computation-expression-only constructs
+/// (such as let!, use!, do!, return, return!, yield, yield!, match!, while!) that can only
+/// be legally type-checked inside a CE translation. Used to decide whether to "lift" these
+/// constructs out of the RHS of a plain 'let' binding inside a CE so that the surrounding
+/// CE translator can process them. We only recurse through positions where the lifted
+/// construct would syntactically remain in CE-evaluation position (Sequential tail,
+/// LetOrUse body); branches that open a new scope (lambdas, match clauses, if branches,
+/// nested CEs) are intentionally not traversed.
+let rec private exprContainsCEOnlyConstruct expr =
+    match expr with
+    | LetOrUse(_, true, _) -> true
+    | SynExpr.DoBang _
+    | SynExpr.MatchBang _
+    | SynExpr.WhileBang _
+    | SynExpr.YieldOrReturnFrom _
+    | SynExpr.YieldOrReturn _ -> true
+    | LetOrUse({ Body = body; IsRecursive = false }, false, false) -> exprContainsCEOnlyConstruct body
+    | SynExpr.Sequential(expr1 = e1; expr2 = e2) -> exprContainsCEOnlyConstruct e1 || exprContainsCEOnlyConstruct e2
+    | _ -> false
+
+/// Walk the binding RHS of a plain 'let p = rhs in body' that appears inside a computation expression,
+/// threading the binding 'let p = <hole> in body' to the value-position of 'rhs' so that any
+/// CE-only constructs (let!, do!, etc.) appearing as a prefix of 'rhs' end up lifted into the
+/// enclosing CE, where the CE translator can desugar them properly. See issue dotnet/fsharp#19457.
+let rec private liftCEFromBindingRhs (rhs: SynExpr) (k: SynExpr -> SynExpr) : SynExpr =
+    match rhs with
+    | SynExpr.LetOrUse data when not data.IsRecursive ->
+        SynExpr.LetOrUse
+            { data with
+                Body = liftCEFromBindingRhs data.Body k
+            }
+    | SynExpr.Sequential(sp, isTrueSeq, e1, e2, m, trivia) -> SynExpr.Sequential(sp, isTrueSeq, e1, liftCEFromBindingRhs e2 k, m, trivia)
+    | _ -> k rhs
+
 /// <summary>
 /// Try translate the syntax sugar
 /// </summary>
@@ -1841,51 +1875,113 @@ let rec TryTranslateComputationExpression
                    false,
                    false) ->
 
-            // For 'query' check immediately
-            if ceenv.isQuery then
-                match (List.map (BindingNormalization.NormalizeBinding ValOrMemberBinding cenv ceenv.env) binds) with
-                | [ NormalizedBinding(_, SynBindingKind.Normal, false, false, _, _, _, _, _, _, _, _) ] when not isRec -> ()
-                | normalizedBindings ->
-                    let failAt m =
-                        error (Error(FSComp.SR.tcNonSimpleLetBindingInQuery (), m))
+            // https://github.com/dotnet/fsharp/issues/19457
+            // If the (single) plain 'let p = rhs in body' binding's RHS is itself a chain of CE-only
+            // constructs (e.g. 'let! x = ...; x' or 'do! ...; rest'), rewrite the expression so that
+            // those constructs are lifted into the enclosing CE, where they desugar correctly.
+            // We only apply this when not in a query, when the binding is non-recursive and non-bang,
+            // and when there is exactly one binding (the case the issue is about). Otherwise we fall
+            // through to the standard plain-let handling.
+            let liftedRewrite =
+                if ceenv.isQuery || isRec then
+                    None
+                else
+                    match binds with
+                    | [ SynBinding(
+                            accessibility = a
+                            kind = bk
+                            isInline = isInline
+                            isMutable = isMutable
+                            attributes = attrs
+                            xmlDoc = xmlDoc
+                            valData = valData
+                            headPat = headPat
+                            returnInfo = returnInfo
+                            expr = rhsExpr
+                            range = bindRange
+                            debugPoint = debugPoint
+                            trivia = bindTrivia) ] when exprContainsCEOnlyConstruct rhsExpr ->
+                        let rewritten =
+                            liftCEFromBindingRhs rhsExpr (fun finalValue ->
+                                let newBinding =
+                                    SynBinding(
+                                        a,
+                                        bk,
+                                        isInline,
+                                        isMutable,
+                                        attrs,
+                                        xmlDoc,
+                                        valData,
+                                        headPat,
+                                        returnInfo,
+                                        finalValue,
+                                        bindRange,
+                                        debugPoint,
+                                        bindTrivia
+                                    )
 
-                    match normalizedBindings with
-                    | NormalizedBinding(mBinding = mBinding) :: _ -> failAt mBinding
-                    | _ -> failAt m
+                                SynExpr.LetOrUse
+                                    {
+                                        IsRecursive = isRec
+                                        IsFromSource = isFromSource
+                                        Bindings = [ newBinding ]
+                                        Body = innerComp
+                                        Range = m
+                                        Trivia = trivia
+                                    })
 
-            // Add the variables to the query variable space, on demand
-            let varSpace =
-                addVarsToVarSpace varSpace (fun mQueryOp env ->
-                    // Normalize the bindings before detecting the bound variables
-                    match (List.map (BindingNormalization.NormalizeBinding ValOrMemberBinding cenv env) binds) with
-                    | [ NormalizedBinding(kind = SynBindingKind.Normal; shouldInline = false; isMutable = false; pat = pat) ] ->
-                        // successful case
-                        use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink
+                        Some rewritten
+                    | _ -> None
 
-                        let _, _, vspecs, envinner, _ =
-                            TcMatchPattern cenv (NewInferenceType cenv.g) env ceenv.tpenv pat None TcTrueMatchClause.No
+            match liftedRewrite with
+            | Some rewritten -> Some(TranslateComputationExpression ceenv firstTry q varSpace rewritten translatedCtxt)
+            | None ->
 
-                        vspecs, envinner
-                    | _ ->
-                        // error case
-                        error (Error(FSComp.SR.tcCustomOperationMayNotBeUsedInConjunctionWithNonSimpleLetBindings (), mQueryOp)))
+                // For 'query' check immediately
+                if ceenv.isQuery then
+                    match (List.map (BindingNormalization.NormalizeBinding ValOrMemberBinding cenv ceenv.env) binds) with
+                    | [ NormalizedBinding(_, SynBindingKind.Normal, false, false, _, _, _, _, _, _, _, _) ] when not isRec -> ()
+                    | normalizedBindings ->
+                        let failAt m =
+                            error (Error(FSComp.SR.tcNonSimpleLetBindingInQuery (), m))
 
-            Some(
-                TranslateComputationExpression ceenv CompExprTranslationPass.Initial q varSpace innerComp (fun holeFill ->
-                    translatedCtxt (
-                        SynExpr.LetOrUse
-                            {
-                                IsRecursive = isRec
-                                //isUse = false,
-                                IsFromSource = isFromSource
-                                //isBang = false,
-                                Bindings = binds
-                                Body = holeFill
-                                Range = m
-                                Trivia = trivia
-                            }
-                    ))
-            )
+                        match normalizedBindings with
+                        | NormalizedBinding(mBinding = mBinding) :: _ -> failAt mBinding
+                        | _ -> failAt m
+
+                // Add the variables to the query variable space, on demand
+                let varSpace =
+                    addVarsToVarSpace varSpace (fun mQueryOp env ->
+                        // Normalize the bindings before detecting the bound variables
+                        match (List.map (BindingNormalization.NormalizeBinding ValOrMemberBinding cenv env) binds) with
+                        | [ NormalizedBinding(kind = SynBindingKind.Normal; shouldInline = false; isMutable = false; pat = pat) ] ->
+                            // successful case
+                            use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink
+
+                            let _, _, vspecs, envinner, _ =
+                                TcMatchPattern cenv (NewInferenceType cenv.g) env ceenv.tpenv pat None TcTrueMatchClause.No
+
+                            vspecs, envinner
+                        | _ ->
+                            // error case
+                            error (Error(FSComp.SR.tcCustomOperationMayNotBeUsedInConjunctionWithNonSimpleLetBindings (), mQueryOp)))
+
+                Some(
+                    TranslateComputationExpression ceenv CompExprTranslationPass.Initial q varSpace innerComp (fun holeFill ->
+                        translatedCtxt (
+                            SynExpr.LetOrUse
+                                {
+                                    IsRecursive = isRec
+                                    //isUse = false,
+                                    IsFromSource = isFromSource
+                                    //isBang = false,
+                                    Bindings = binds
+                                    Body = holeFill
+                                    Range = m
+                                    Trivia = trivia
+                                }
+                        ))
+                )
 
         // 'use x = expr in expr'
         | LetOrUse({

tests/FSharp.Compiler.ComponentTests/Language/ComputationExpressionTests.fs

@@ -2400,9 +2400,9 @@ let foo() =
         |> typecheck
         |> shouldSucceed
 
-    // https://github.com/dotnet/fsharp/issues/19456
+    // https://github.com/dotnet/fsharp/issues/19457
     [<Fact>]
-    let ``Issue 19456 - let bang nested in plain let binding inside task CE should raise FS0750`` () =
+    let ``Issue 19457 - let bang nested in plain let binding inside task CE should compile`` () =
         FSharp """
 open System.Threading.Tasks
 
@@ -2413,6 +2413,157 @@ let y() =
             b
         return a
     }
+        """
+        |> asLibrary
+        |> typecheck
+        |> shouldSucceed
+
+    // https://github.com/dotnet/fsharp/issues/19457
+    [<Fact>]
+    let ``Issue 19457 - let bang nested in plain let returns awaited value not Task`` () =
+        FSharp """
+module Test
+open System.Threading.Tasks
+let y() =
+    task {
+        let a =
+            let! b = Task.FromResult(42)
+            b
+        return a
+    }
+[<EntryPoint>]
+let main _ =
+    let r = y().Result
+    if r <> 42 then failwithf "expected 42, got %d" r
+    0
+        """
+        |> compileExeAndRun
+        |> shouldSucceed
+
+    // https://github.com/dotnet/fsharp/issues/19457
+    [<Fact>]
+    let ``Issue 19457 - do bang nested in plain let inside task CE compiles and runs`` () =
+        FSharp """
+module Test
+open System.Threading.Tasks
+let mutable x = 0
+let test() =
+    task {
+        let a =
+            do! Task.Delay(0)
+            x <- 1
+            42
+        return a
+    }
+[<EntryPoint>]
+let main _ =
+    let r = test().Result
+    if r <> 42 then failwithf "expected 42, got %d" r
+    if x <> 1 then failwithf "expected x=1, got %d" x
+    0
+        """
+        |> compileExeAndRun
+        |> shouldSucceed
+
+    // https://github.com/dotnet/fsharp/issues/19457
+    [<Fact>]
+    let ``Issue 19457 - multiple sequential let bang nested in plain let inside task CE`` () =
+        FSharp """
+module Test
+open System.Threading.Tasks
+let test() =
+    task {
+        let result =
+            let! a = Task.FromResult(1)
+            let! b = Task.FromResult(2)
+            a + b
+        return result
+    }
+[<EntryPoint>]
+let main _ =
+    let r = test().Result
+    if r <> 3 then failwithf "expected 3, got %d" r
+    0
+        """
+        |> compileExeAndRun
+        |> shouldSucceed
+
+    // https://github.com/dotnet/fsharp/issues/19457
+    [<Fact>]
+    let ``Issue 19457 - let bang nested in plain let inside async CE`` () =
+        FSharp """
+module Test
+let test() =
+    async {
+        let a =
+            let! b = async { return 42 }
+            b
+        return a
+    }
+[<EntryPoint>]
+let main _ =
+    let r = Async.RunSynchronously(test())
+    if r <> 42 then failwithf "expected 42, got %d" r
+    0
+        """
+        |> compileExeAndRun
+        |> shouldSucceed
+
+    // https://github.com/dotnet/fsharp/issues/19457
+    [<Fact>]
+    let ``Issue 19457 - let in let in let bang deep nesting inside task CE`` () =
+        FSharp """
+module Test
+open System.Threading.Tasks
+let test() =
+    task {
+        let a =
+            let c = 10
+            let! b = Task.FromResult(c)
+            b
+        return a
+    }
+[<EntryPoint>]
+let main _ =
+    let r = test().Result
+    if r <> 10 then failwithf "expected 10, got %d" r
+    0
+        """
+        |> compileExeAndRun
+        |> shouldSucceed
+
+    // https://github.com/dotnet/fsharp/issues/19457
+    [<Fact>]
+    let ``Issue 19457 - outer return uses awaited inner value`` () =
+        FSharp """
+module Test
+open System.Threading.Tasks
+let test() =
+    task {
+        let a =
+            let! b = Task.FromResult(42)
+            b
+        return a + 1
+    }
+[<EntryPoint>]
+let main _ =
+    let r = test().Result
+    if r <> 43 then failwithf "expected 43, got %d" r
+    0
+        """
+        |> compileExeAndRun
+        |> shouldSucceed
+
+    // https://github.com/dotnet/fsharp/issues/19457 - regression guard:
+    // let! outside any CE must still raise FS0750.
+    [<Fact>]
+    let ``Issue 19457 - let bang outside any CE still raises FS0750`` () =
+        FSharp """
+module Test
+open System.Threading.Tasks
+let bad() =
+    let! x = Task.FromResult(1)
+    x
         """
         |> asLibrary
         |> typecheck