Detect recursive inline bindings and emit FS3888 diagnostic

src/Compiler/Checking/CheckDeclarations.fs

@@ -1501,52 +1501,61 @@ module MutRecBindingChecking =
         // Build an index ---> binding map
         let generalizedBindingsMap = generalizedRecBinds |> List.map (fun pgrbind -> (pgrbind.RecBindingInfo.Index, pgrbind)) |> Map.ofList
 
-        defnsBs |> MutRecShapes.mapTyconsAndLets 
+        let collectedBinds = ResizeArray()
 
-            // Phase2C: Fixup member bindings 
-            (fun (TyconBindingsPhase2B(tyconOpt, tcref, defnBs)) -> 
+        let result =
+            defnsBs |> MutRecShapes.mapTyconsAndLets 
 
-                let defnCs = 
-                    defnBs |> List.map (fun defnB -> 
+                // Phase2C: Fixup member bindings 
+                (fun (TyconBindingsPhase2B(tyconOpt, tcref, defnBs)) -> 
 
-                        // Phase2C: Generalise implicit ctor val 
-                        match defnB with
-                        | Phase2BIncrClassCtor (staticCtorInfo, incrCtorInfoOpt, safeThisValBindOpt) ->
-                            match incrCtorInfoOpt with
-                            | Some incrCtorInfo ->
-                                let valscheme = incrCtorInfo.InstanceCtorValScheme
-                                let valscheme = ChooseCanonicalValSchemeAfterInference g denv valscheme scopem
-                                AdjustRecType incrCtorInfo.InstanceCtorVal valscheme
-                            | None -> ()
-                            Phase2CIncrClassCtor (staticCtorInfo, incrCtorInfoOpt, safeThisValBindOpt)
-
-                        | Phase2BInherit inheritsExpr -> 
-                            Phase2CInherit inheritsExpr
-
-                        | Phase2BIncrClassBindings bindRs -> 
-                            Phase2CIncrClassBindings bindRs
-
-                        | Phase2BIncrClassCtorJustAfterSuperInit -> 
-                            Phase2CIncrClassCtorJustAfterSuperInit
+                    let defnCs = 
+                        defnBs |> List.map (fun defnB -> 
 
-                        | Phase2BIncrClassCtorJustAfterLastLet -> 
-                            Phase2CIncrClassCtorJustAfterLastLet
-
-                        | Phase2BMember idx ->
-                            // Phase2C: Fixup member bindings 
+                            // Phase2C: Generalise implicit ctor val 
+                            match defnB with
+                            | Phase2BIncrClassCtor (staticCtorInfo, incrCtorInfoOpt, safeThisValBindOpt) ->
+                                match incrCtorInfoOpt with
+                                | Some incrCtorInfo ->
+                                    let valscheme = incrCtorInfo.InstanceCtorValScheme
+                                    let valscheme = ChooseCanonicalValSchemeAfterInference g denv valscheme scopem
+                                    AdjustRecType incrCtorInfo.InstanceCtorVal valscheme
+                                | None -> ()
+                                Phase2CIncrClassCtor (staticCtorInfo, incrCtorInfoOpt, safeThisValBindOpt)
+
+                            | Phase2BInherit inheritsExpr -> 
+                                Phase2CInherit inheritsExpr
+
+                            | Phase2BIncrClassBindings bindRs -> 
+                                Phase2CIncrClassBindings bindRs
+
+                            | Phase2BIncrClassCtorJustAfterSuperInit -> 
+                                Phase2CIncrClassCtorJustAfterSuperInit
+
+                            | Phase2BIncrClassCtorJustAfterLastLet -> 
+                                Phase2CIncrClassCtorJustAfterLastLet
+
+                            | Phase2BMember idx ->
+                                // Phase2C: Fixup member bindings 
+                                let generalizedBinding = generalizedBindingsMap[idx] 
+                                let vxbind = TcLetrecAdjustMemberForSpecialVals cenv generalizedBinding
+                                let pgbrind = FixupLetrecBind cenv denv generalizedTyparsForRecursiveBlock vxbind
+                                collectedBinds.Add pgbrind
+                                Phase2CMember pgbrind)
+
+                    TyconBindingsPhase2C(tyconOpt, tcref, defnCs))
+
+                // Phase2C: Fixup let bindings 
+                (fun bindIdxs -> 
+                        [ for idx in bindIdxs do 
                             let generalizedBinding = generalizedBindingsMap[idx] 
                             let vxbind = TcLetrecAdjustMemberForSpecialVals cenv generalizedBinding
                             let pgbrind = FixupLetrecBind cenv denv generalizedTyparsForRecursiveBlock vxbind
-                            Phase2CMember pgbrind)
-
-                TyconBindingsPhase2C(tyconOpt, tcref, defnCs))
+                            collectedBinds.Add pgbrind
+                            yield pgbrind ])
 
-            // Phase2C: Fixup let bindings 
-            (fun bindIdxs -> 
-                    [ for idx in bindIdxs do 
-                        let generalizedBinding = generalizedBindingsMap[idx] 
-                        let vxbind = TcLetrecAdjustMemberForSpecialVals cenv generalizedBinding
-                        yield FixupLetrecBind cenv denv generalizedTyparsForRecursiveBlock vxbind ])
+        CheckRecursiveInlineGroup (List.ofSeq collectedBinds)
+        result
 
 
     // --- Extract field bindings from let-bindings 

src/Compiler/Checking/Expressions/CheckExpressions.fs

@@ -13071,6 +13071,52 @@ and FixupLetrecBind (cenv: cenv) denv generalizedTyparsForRecursiveBlock (bind:
 
 and unionGeneralizedTypars typarSets = List.foldBack (ListSet.unionFavourRight typarEq) typarSets []
 
+and CheckRecursiveInlineGroup (bindings: PreInitializationGraphEliminationBinding list) =
+    let inlineBindings =
+        bindings
+        |> List.filter (fun pgrbind ->
+            let (TBind(v, _, _)) = pgrbind.Binding
+            v.ShouldInline)
+    if not (List.isEmpty inlineBindings) then
+        let inlineStamps =
+            inlineBindings
+            |> List.map (fun pgrbind ->
+                let (TBind(v, _, _)) = pgrbind.Binding
+                v.Stamp)
+            |> Set.ofList
+        // Map from inline stamp to set of free-local stamps in its body.
+        let freeStampsByStamp =
+            inlineBindings
+            |> List.map (fun pgrbind ->
+                let (TBind(v, e, _)) = pgrbind.Binding
+                let freeVals = (freeInExpr CollectLocalsNoCaching e).FreeLocals
+                let frees = Zset.fold (fun (fv: Val) acc -> Set.add fv.Stamp acc) freeVals Set.empty
+                v.Stamp, frees)
+            |> Map.ofList
+        // For each inline binding, perform BFS through inline-only edges and
+        // detect whether we can return to ourselves. A self-loop or any cycle
+        // through other inline bindings counts.
+        for pgrbind in inlineBindings do
+            let (TBind(v, _, _)) = pgrbind.Binding
+            let startStamp = v.Stamp
+            let mutable foundCycle = false
+            let mutable visited = Set.empty
+            let mutable queue = [startStamp]
+            while not (List.isEmpty queue) && not foundCycle do
+                let cur = List.head queue
+                queue <- List.tail queue
+                let frees = freeStampsByStamp |> Map.tryFind cur |> Option.defaultValue Set.empty
+                for fv in frees do
+                    if not foundCycle then
+                        if fv = startStamp then
+                            foundCycle <- true
+                        elif Set.contains fv inlineStamps && not (Set.contains fv visited) then
+                            visited <- Set.add fv visited
+                            queue <- fv :: queue
+            if foundCycle then
+                errorR(Error(FSComp.SR.tcRecursiveInlineNotAllowed(v.DisplayName), v.Range))
+                v.SetInlineInfo ValInline.Never
+
 and TcLetrecBindings overridesOK (cenv: cenv) env tpenv (binds, bindsm, scopem) =
 
     let g = cenv.g
@@ -13104,6 +13150,8 @@ and TcLetrecBindings overridesOK (cenv: cenv) env tpenv (binds, bindsm, scopem)
     // Now that we know what we've generalized we can adjust the recursive references
     let vxbinds = vxbinds |> List.map (FixupLetrecBind cenv env.DisplayEnv generalizedTyparsForRecursiveBlock)
 
+    CheckRecursiveInlineGroup vxbinds
+
     // Now eliminate any initialization graphs
     let binds =
         let bindsWithoutLaziness = vxbinds

src/Compiler/Checking/Expressions/CheckExpressions.fsi

@@ -482,6 +482,10 @@ val FixupLetrecBind:
     bind: PostSpecialValsRecursiveBinding ->
         PreInitializationGraphEliminationBinding
 
+/// Detect recursive 'inline' bindings within a recursive binding group and
+/// emit FS3888. Mutates inline info to suppress downstream cascades.
+val CheckRecursiveInlineGroup: bindings: PreInitializationGraphEliminationBinding list -> unit
+
 /// Produce a fresh view of an object type, e.g. 'List<T>' becomes 'List<?>' for new
 /// inference variables with the given rigidity.
 val FreshenObjectArgType:

src/Compiler/FSComp.txt

@@ -1818,4 +1818,5 @@ featurePreprocessorElif,"#elif preprocessor directive"
 3885,parsLetBangCannotBeLastInCE,"'%s' cannot be the final expression in a computation expression. Finish with 'return', 'return!', or a simple expression."
 3886,tcListLiteralWithSingleTupleElement,"This list expression contains a single tuple element. Did you mean to use ';' instead of ',' to separate list elements?"
 3887,ilCustomAttrInvalidArrayElemType,"The type '%s' is not a valid custom attribute argument type. Custom attribute arrays must have elements of primitive types, enums, string, System.Type, or System.Object."
+3888,tcRecursiveInlineNotAllowed,"The value or member '%s' has been marked 'inline' but is part of a recursive binding group. F# does not support recursive 'inline' values. Either remove the 'inline' modifier or refactor the recursion."
 featureExceptionFieldSerializationSupport,"emit GetObjectData and field-restoring deserialization constructor for exception types"

src/Compiler/TypedTree/TypedTree.fs

@@ -172,6 +172,15 @@ type ValFlags(flags: int64) =
                                                              |               0b00000000000000110000L -> ValInline.Never
                                                              | _          -> failwith "unreachable"
 
+    member x.WithInlineInfo inlineInfo =
+            let flags =
+                     (flags       &&&                                     ~~~0b00000000000000110000L) |||
+                     (match inlineInfo with
+                                     | ValInline.Always ->                   0b00000000000000010000L
+                                     | ValInline.Optional ->                 0b00000000000000100000L
+                                     | ValInline.Never ->                    0b00000000000000110000L)
+            ValFlags flags
+
     member x.MutabilityInfo = 
                                   match (flags       &&&                     0b00000000000001000000L) with 
                                                              |               0b00000000000000000000L -> Immutable
@@ -3304,6 +3313,8 @@ type Val =
 
     member x.SetInlineIfLambda() = x.val_flags <- x.val_flags.WithInlineIfLambda
 
+    member x.SetInlineInfo (inlineInfo: ValInline) = x.val_flags <- x.val_flags.WithInlineInfo inlineInfo
+
     member x.SetIsImplied() = x.val_flags <- x.val_flags.WithIsImplied
 
     member x.SetValReprInfo info = 

src/Compiler/TypedTree/TypedTree.fsi

@@ -152,6 +152,8 @@ type ValFlags =
 
     member WithInlineIfLambda: ValFlags
 
+    member WithInlineInfo: inlineInfo: ValInline -> ValFlags
+
     member WithIsImplied: ValFlags
 
     member WithIsCompiledAsStaticPropertyWithoutField: ValFlags
@@ -2013,6 +2015,11 @@ type Val =
 
     member SetInlineIfLambda: unit -> unit
 
+    /// Sets the inline information for this value. Used by the type checker
+    /// to downgrade an erroneously-recursive inline binding to non-inline
+    /// so that the optimizer does not cascade further diagnostics.
+    member SetInlineInfo: inlineInfo: ValInline -> unit
+
     member SetIsImplied: unit -> unit
 
     member SetIsCompiledAsStaticPropertyWithoutField: unit -> unit