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,56 @@ let requireBuilderMethod methodName ceenv m1 m2 =
     if not (hasBuilderMethod ceenv m1 methodName) then
         error (Error(FSComp.SR.tcRequireBuilderMethod methodName, m2))
 
+/// Check if an expression is or contains a CE-only construct at any position.
+/// Used for checking e1 of Sequential where the expression stays in place after lifting.
+let rec private containsCEConstructAtAnyPosition 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) -> containsCEConstructAtAnyPosition body
+    | SynExpr.Sequential(expr1 = e1; expr2 = e2) -> containsCEConstructAtAnyPosition e1 || containsCEConstructAtAnyPosition e2
+    | _ -> false
+
+/// Detect whether an expression syntactically contains computation-expression-only constructs
+/// in positions that liftCEFromBindingRhs can successfully handle. This prevents infinite
+/// recursion: liftCEFromBindingRhs threads through LetOrUse and Sequential(e2), applying
+/// its continuation k at the tail. If the tail IS a CE construct (e.g. match!, do!), wrapping
+/// it with k reproduces the original expression, causing unbounded recursion. Therefore we
+/// only detect CE constructs that are:
+/// 1. LetOrUse with bang (let!/use!) - liftCEFromBindingRhs threads through these
+/// 2. In e1 of Sequential - liftCEFromBindingRhs keeps e1 in place, so CE constructs there are safe
+/// 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
+    // let!/use! bang bindings: liftCEFromBindingRhs handles SynExpr.LetOrUse by recursing into Body,
+    // so these are always in a liftable position.
+    | LetOrUse(_, true, _) -> true
+    // Sequential: e1 stays in place (any CE construct there is safe since liftCEFromBindingRhs
+    // only recurses into e2). For e2, apply the same tail-position rules recursively.
+    | SynExpr.Sequential(expr1 = e1; expr2 = e2) -> containsCEConstructAtAnyPosition e1 || exprContainsCEOnlyConstruct e2
+    // Plain let: recurse into body (same tail-position rules apply to the body)
+    | LetOrUse({ Body = body; IsRecursive = false }, false, false) -> exprContainsCEOnlyConstruct body
+    | _ -> 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 +1891,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({