Fix a false negative of the [<TailCall>] analysis in combination with async (issue #17237)

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

@@ -1,5 +1,6 @@
 ### Fixed
 
+* Fix a false positive of the `[<TailCall>]` analysis in combination with async. ([Issue #17237](https://github.com/dotnet/fsharp/issues/17237), [PR #17241](https://github.com/dotnet/fsharp/pull/17241))
 * Fix internal error when dotting into delegates with multiple type parameters. ([PR #17227](https://github.com/dotnet/fsharp/pull/17227))
 * Error for partial implementation of interface with static and non-static abstract members. ([Issue #17138](https://github.com/dotnet/fsharp/issues/17138), [PR #17160](https://github.com/dotnet/fsharp/pull/17160))
 * Optimize simple mappings with preludes in computed collections. ([PR #17067](https://github.com/dotnet/fsharp/pull/17067))

src/Compiler/Checking/TailCallChecks.fs

@@ -756,7 +756,25 @@ let CheckModuleBinding cenv (isRec: bool) (TBind _ as bind) =
                 | Expr.Lambda(bodyExpr = bodyExpr) -> checkTailCall insideSubBindingOrTry bodyExpr
                 | Expr.DebugPoint(_debugPointAtLeafExpr, expr) -> checkTailCall insideSubBindingOrTry expr
                 | Expr.Let(binding = binding; bodyExpr = bodyExpr) ->
-                    checkTailCall true binding.Expr
+                    let isAsyncContinuation =
+                        match bodyExpr with
+                        | Expr.App(funcExpr = Expr.Val(valRef = valRef)) ->
+                            match valRef.GeneralizedType with
+                            | [ _ ],
+                              TType_fun(
+                                  domainType = TType_fun(
+                                      domainType = TType_app(tyconRef = funArgDomTypeTyconRef)
+                                      rangeType = TType_app(tyconRef = funArgRangeTypeTyconRef))
+                                  rangeType = TType_app(tyconRef = rangeTypeTyConRef)) when
+                                funArgDomTypeTyconRef.DemangledModuleOrNamespaceName = "AsyncActivation`1"
+                                && funArgRangeTypeTyconRef.DemangledModuleOrNamespaceName = "AsyncReturn"
+                                && rangeTypeTyConRef.DemangledModuleOrNamespaceName = "Async`1"
+                                ->
+                                true
+                            | _ -> false
+                        | _ -> false
+
+                    checkTailCall (not isAsyncContinuation) binding.Expr
 
                     let warnForBodyExpr =
                         insideSubBindingOrTry

tests/FSharp.Compiler.ComponentTests/ErrorMessages/TailCallAttribute.fs

@@ -1683,3 +1683,42 @@ module M =
               Message =
                 "The member or function 'traverseSequentials' has the 'TailCallAttribute' attribute, but is not being used in a tail recursive way." }
         ]
+
+    [<FSharp.Test.FactForNETCOREAPP>]
+    let ``Don't warn for rec call of async func that evaluates an async parameter in a match!`` () =
+        """
+namespace N
+
+module M =
+
+    [<TailCall>]
+    let rec f (g: bool Async) = async {
+        match! g with
+        | false -> ()
+        | true -> return! f g
+        }
+        """
+        |> FSharp
+        |> withLangVersion80
+        |> compile
+        |> shouldSucceed
+
+    [<FSharp.Test.FactForNETCOREAPP>]
+    let ``Don't warn for rec call of async func that evaluates an async parameter in a let!`` () =
+        """
+namespace N
+
+module M =
+
+    [<TailCall>]
+    let rec f (g: bool Async) = async {
+        let! x = g
+        match x with
+        | false -> ()
+        | true -> return! f g
+        }
+        """
+        |> FSharp
+        |> withLangVersion80
+        |> compile
+        |> shouldSucceed