Optimizer: don't inline named functions in debug builds

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

@@ -22,3 +22,4 @@
 
 * Added warning FS3884 when a function or delegate value is used as an interpolated string argument. ([PR #19289](https://github.com/dotnet/fsharp/pull/19289))
 * Add `#version;;` directive to F# Interactive to display version and environment information. ([Issue #13307](https://github.com/dotnet/fsharp/issues/13307), [PR #19332](https://github.com/dotnet/fsharp/pull/19332))
+* Optimizer: don't inline named functions in debug builds ([PR #19548](https://github.com/dotnet/fsharp/pull/19548)

src/Compiler/Driver/CompilerConfig.fs

@@ -600,6 +600,8 @@ type TcConfigBuilder =
 
         mutable strictIndentation: bool option
 
+        mutable inlineNamedFunctions: bool option
+
         mutable exename: string option
 
         // If true - the compiler will copy FSharp.Core.dll along the produced binaries
@@ -853,6 +855,7 @@ type TcConfigBuilder =
             dumpSignatureData = false
             realsig = false
             strictIndentation = None
+            inlineNamedFunctions = None
             compilationMode = TcGlobals.CompilationMode.Unset
         }
 
@@ -1253,6 +1256,7 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) =
     member _.fsiMultiAssemblyEmit = data.fsiMultiAssemblyEmit
     member _.FxResolver = data.FxResolver
     member _.strictIndentation = data.strictIndentation
+    member _.inlineNamedFunctions = data.inlineNamedFunctions
     member _.primaryAssembly = data.primaryAssembly
     member _.noFeedback = data.noFeedback
     member _.stackReserveSize = data.stackReserveSize

src/Compiler/Driver/CompilerConfig.fsi

@@ -472,6 +472,8 @@ type TcConfigBuilder =
 
         mutable strictIndentation: bool option
 
+        mutable inlineNamedFunctions: bool option
+
         mutable exename: string option
 
         mutable copyFSharpCore: CopyFSharpCoreFlag
@@ -814,6 +816,8 @@ type TcConfig =
 
     member strictIndentation: bool option
 
+    member inlineNamedFunctions: bool option
+
     member GetTargetFrameworkDirectories: unit -> string list
 
     /// Get the loaded sources that exist and issue a warning for the ones that don't

src/Compiler/Driver/CompilerOptions.fs

@@ -1207,6 +1207,14 @@ let languageFlags tcConfigB =
             None,
             Some(FSComp.SR.optsStrictIndentation (formatOptionSwitch (Option.defaultValue false tcConfigB.strictIndentation)))
         )
+
+        CompilerOption(
+            "inline-named-functions",
+            tagNone,
+            OptionSwitch(fun switch -> tcConfigB.inlineNamedFunctions <- Some(switch = OptionSwitch.On)),
+            None,
+            Some(FSComp.SR.optsInlineNamedFunctions ())
+        )
     ]
 
 // OptionBlock: Advanced user options

src/Compiler/Driver/OptimizeInputs.fs

@@ -327,13 +327,17 @@ let ApplyAllOptimizations
             // Only do abstractBigTargets in the first phase, and only when TLR is on.
             abstractBigTargets = tcConfig.doTLR
             reportingPhase = true
+            inlineNamedFunctions =
+                tcConfig.inlineNamedFunctions
+                |> Option.defaultValue (not tcConfig.debuginfo || tcConfig.optSettings.LocalOptimizationsEnabled)
         }
 
     // Only do these two steps in the first phase.
     let extraAndFinalLoopSettings =
         { firstLoopSettings with
             abstractBigTargets = false
             reportingPhase = false
+            inlineNamedFunctions = false
         }
 
     let addPhaseDiagnostics (f: PhaseFunc) (info: Phase) =

src/Compiler/FSComp.txt

@@ -1560,6 +1560,7 @@ optsSetLangVersion,"Specify language version such as 'latest' or 'preview'."
 optsDisableLanguageFeature,"Disable a specific language feature by name."
 optsSupportedLangVersions,"Supported language versions:"
 optsStrictIndentation,"Override indentation rules implied by the language version (%s by default)"
+optsInlineNamedFunctions,"Inline named 'inline' functions"
 nativeResourceFormatError,"Stream does not begin with a null resource and is not in '.RES' format."
 nativeResourceHeaderMalformed,"Resource header beginning at offset %s is malformed."
 formatDashItem," - %s"

src/Compiler/Optimize/Optimizer.fs

@@ -23,6 +23,7 @@ open FSharp.Compiler.Text.LayoutRender
 open FSharp.Compiler.Text.TaggedText
 open FSharp.Compiler.TypedTree 
 open FSharp.Compiler.TypedTreeBasics
+open FSharp.Compiler.Xml
 open FSharp.Compiler.TypedTreeOps
 open FSharp.Compiler.TypedTreeOps.DebugPrint
 open FSharp.Compiler.TypedTreePickle
@@ -327,6 +328,8 @@ type OptimizationSettings =
       reportTotalSizes : bool
 
       processingMode : OptimizationProcessingMode
+
+      inlineNamedFunctions: bool
     }
 
     static member Defaults = 
@@ -344,6 +347,7 @@ type OptimizationSettings =
           reportHasEffect = false
           reportTotalSizes = false
           processingMode = OptimizationProcessingMode.Parallel
+          inlineNamedFunctions = false
         }
 
     /// Determines if JIT optimizations are enabled
@@ -432,6 +436,8 @@ type cenv =
       stackGuard: StackGuard
 
       realsig: bool
+
+      specializedInlineVals: HashMultiMap<Stamp, TType * Expr>
     }
 
     override x.ToString() = "<cenv>"
@@ -500,8 +506,9 @@ let CheckInlineValueIsComplete (v: Val) res =
         errorR(Error(FSComp.SR.optValueMarkedInlineButIncomplete(v.DisplayName), v.Range))
         //System.Diagnostics.Debug.Assert(false, sprintf "Break for incomplete inline value %s" v.DisplayName)
 
-let check (vref: ValRef) (res: ValInfo) =
-    CheckInlineValueIsComplete vref.Deref res.ValExprInfo
+let check (cenv: cenv) (vref: ValRef) (res: ValInfo) =
+    if cenv.settings.inlineNamedFunctions then
+        CheckInlineValueIsComplete vref.Deref res.ValExprInfo
     (vref, res)
 
 //-------------------------------------------------------------------------
@@ -691,7 +698,7 @@ let GetInfoForVal cenv env m (vref: ValRef) =
 
 let GetInfoForValWithCheck cenv env m (vref: ValRef) =  
     let res = GetInfoForVal cenv env m vref
-    check vref res |> ignore
+    check cenv vref res |> ignore
     res
 
 let IsPartialExpr cenv env m x =
@@ -1325,7 +1332,7 @@ let CombineValueInfos einfos res =
 let CombineValueInfosUnknown einfos = CombineValueInfos einfos UnknownValue
 
 /// Hide information because of a signature
-let AbstractLazyModulInfoByHiding isAssemblyBoundary mhi =
+let AbstractLazyModulInfoByHiding isAssemblyBoundary (cenv: cenv) mhi =
 
     // The freevars and FreeTyvars can indicate if the non-public (hidden) items have been used.
     // Under those checks, the further hidden* checks may be subsumed (meaning, not required anymore).
@@ -1353,6 +1360,7 @@ let AbstractLazyModulInfoByHiding isAssemblyBoundary mhi =
 
         // Check for escape in lambda 
         | CurriedLambdaValue (_, _, _, expr, _) | ConstExprValue(_, expr) when            
+            cenv.settings.inlineNamedFunctions &&
             (let fvs = freeInExpr CollectAll expr
              (isAssemblyBoundary && not (freeVarsAllPublic fvs)) || 
              Zset.exists hiddenVal fvs.FreeLocals ||
@@ -1399,8 +1407,9 @@ let AbstractLazyModulInfoByHiding isAssemblyBoundary mhi =
          { ModuleOrNamespaceInfos = NameMap.map abstractLazyModulInfo ss.ModuleOrNamespaceInfos
            ValInfos = 
                ValInfos(ss.ValInfos.Entries 
-                         |> Seq.filter (fun (vref, _) -> not (hiddenVal vref.Deref))
-                         |> Seq.map (fun (vref, e) -> check (* "its implementation uses a binding hidden by a signature" m *) vref (abstractValInfo e) )) } 
+                         |> Seq.filter (fun (vref, _) ->
+                             not (hiddenVal vref.Deref) || not cenv.settings.inlineNamedFunctions && vref.Deref.ShouldInline)
+                         |> Seq.map (fun (vref, e) -> check cenv vref (abstractValInfo e) )) }
 
     and abstractLazyModulInfo (ss: LazyModuleInfo) = 
           ss.Force() |> abstractModulInfo |> notlazy
@@ -1419,7 +1428,7 @@ let AbstractOptimizationInfoToEssentials =
     abstractLazyModulInfo
 
 /// Hide information because of a "let ... in ..." or "let rec ... in ... "
-let AbstractExprInfoByVars (boundVars: Val list, boundTyVars) ivalue =
+let AbstractExprInfoByVars (cenv: cenv) (boundVars: Val list, boundTyVars) ivalue =
     // Module and member bindings can be skipped when checking abstraction, since abstraction of these values has already been done when 
     // we hit the end of the module and called AbstractLazyModulInfoByHiding. If we don't skip these then we end up quadratically retraversing  
     // the inferred optimization data, i.e. at each binding all the way up a sequences of 'lets' in a module. 
@@ -1479,7 +1488,7 @@ let AbstractExprInfoByVars (boundVars: Val list, boundTyVars) ivalue =
       let rec abstractModulInfo ss =
          { ModuleOrNamespaceInfos = ss.ModuleOrNamespaceInfos |> NameMap.map (InterruptibleLazy.force >> abstractModulInfo >> notlazy) 
            ValInfos = ss.ValInfos.Map (fun (vref, e) -> 
-               check vref (abstractValInfo e) ) }
+               check cenv vref (abstractValInfo e)) }
 
       abstractExprInfo ivalue
 
@@ -1519,9 +1528,9 @@ let RemapOptimizationInfo g tmenv =
     remapLazyModulInfo
 
 /// Hide information when a value is no longer visible
-let AbstractAndRemapModulInfo g (repackage, hidden) info =
+let AbstractAndRemapModulInfo g (cenv: cenv) (repackage, hidden) info =
     let mrpi = mkRepackageRemapping repackage
-    let info = info |> AbstractLazyModulInfoByHiding false hidden
+    let info = info |> AbstractLazyModulInfoByHiding false cenv hidden
     let info = info |> RemapOptimizationInfo g mrpi
     info
 
@@ -1692,6 +1701,7 @@ let TryEliminateBinding cenv _env bind e2 _m =
        not vspec1.IsCompilerGenerated then 
        None 
     elif vspec1.IsFixed then None 
+    elif vspec1.InlineInfo = ValInline.InlinedDefinition then None
     elif vspec1.LogicalName.StartsWithOrdinal stackVarPrefix ||
          vspec1.LogicalName.Contains suffixForVariablesThatMayNotBeEliminated then None
     else
@@ -2334,6 +2344,17 @@ let inline IsStateMachineExpr g overallExpr =
         isReturnsResumableCodeTy g valRef.TauType
     | _ -> false
 
+let shouldForceInlineMembersInDebug (g: TcGlobals) (tcref: EntityRef) =
+    match g.fslibForceInlineModules.TryGetValue tcref.LogicalName with
+    | true, modRef -> tyconRefEq g tcref modRef 
+    | _ -> false
+
+let shouldForceInlineInDebug (g: TcGlobals) (vref: ValRef) : bool =
+    ValHasWellKnownAttribute g WellKnownValAttributes.NoDynamicInvocationAttribute_True vref.Deref ||
+    ValHasWellKnownAttribute g WellKnownValAttributes.NoDynamicInvocationAttribute_False vref.Deref ||
+
+    vref.HasDeclaringEntity && shouldForceInlineMembersInDebug g vref.DeclaringEntity
+
 /// Optimize/analyze an expression
 let rec OptimizeExpr cenv (env: IncrementalOptimizationEnv) expr =
     cenv.stackGuard.Guard <| fun () ->
@@ -2832,7 +2853,7 @@ and OptimizeLetRec cenv env (binds, bodyExpr, m) =
         let fvs = List.fold (fun acc x -> unionFreeVars acc (fst x |> freeInBindingRhs CollectLocals)) fvs0 bindsR
         SplitValuesByIsUsedOrHasEffect cenv (fun () -> fvs.FreeLocals) bindsR
     // Trim out any optimization info that involves escaping values 
-    let evalueR = AbstractExprInfoByVars (vs, []) einfo.Info 
+    let evalueR = AbstractExprInfoByVars cenv (vs, []) einfo.Info
     // REVIEW: size of constructing new closures - should probably add #freevars + #recfixups here 
     let bodyExprR = Expr.LetRec (bindsRR, bodyExprR, m, Construct.NewFreeVarsCache()) 
     let info = CombineValueInfos (einfo :: bindinfos) evalueR 
@@ -2908,7 +2929,7 @@ and OptimizeLinearExpr cenv env expr contf =
               Info = UnknownValue }
         else 
             // On the way back up: Trim out any optimization info that involves escaping values on the way back up
-            let evalueR = AbstractExprInfoByVars ([bindR.Var], []) bodyInfo.Info 
+            let evalueR = AbstractExprInfoByVars cenv ([bindR.Var], []) bodyInfo.Info
 
             // Preserve the debug points for eliminated bindings that have debug points. 
             let bodyR =
@@ -3421,8 +3442,67 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) =
     | _ -> None
 
 /// Attempt to inline an application of a known value at callsites
-and TryInlineApplication cenv env finfo (tyargs: TType list, args: Expr list, m) =
+and TryInlineApplication cenv env finfo (valExpr: Expr) (tyargs: TType list, args: Expr list, m) =
     let g = cenv.g
+
+    match cenv.settings.inlineNamedFunctions, stripExpr valExpr with
+    | false, Expr.Val(vref, _, _) when vref.ShouldInline && not (shouldForceInlineInDebug cenv.g vref) ->
+        let origFinfo = GetInfoForValWithCheck cenv env m vref
+        match stripValue origFinfo.ValExprInfo with
+        | CurriedLambdaValue(origLambdaId, _, _, origLambda, origLambdaTy) when not (Zset.contains origLambdaId env.dontInline) ->
+            let argsR = args |> List.map (OptimizeExpr cenv env >> fst)
+            let info = { TotalSize = 1; FunctionSize = 1; HasEffect = true; MightMakeCriticalTailcall = false; Info = UnknownValue }
+
+            let hasNoTraits =
+                let tps, _ = tryDestForallTy g vref.Type
+                GetTraitConstraintInfosOfTypars g tps |> List.isEmpty
+
+            let allTyargsAreConcrete =
+                tyargs |> List.forall (fun t -> (freeInType CollectTyparsNoCaching t).FreeTypars.IsEmpty)
+
+            let canCallDirectly =
+                hasNoTraits || (not allTyargsAreConcrete && vref.ValReprInfo.IsSome)
+
+            if canCallDirectly then
+                Some(mkApps g ((exprForValRef m vref, vref.Type), [tyargs], argsR, m), info)
+            else
+                let f2R = CopyExprForInlining cenv true origLambda m
+                let specLambda = MakeApplicationAndBetaReduce g (f2R, origLambdaTy, [tyargs], [], m)
+                let specLambdaTy = tyOfExpr g specLambda
+
+                let specLambdaR =
+                    if allTyargsAreConcrete then
+                        match cenv.specializedInlineVals.FindAll(origLambdaId) |> List.tryFind (fun (ty, _) -> typeEquiv g ty specLambdaTy) with
+                        | Some (_, body) -> copyExpr g CloneAll body
+                        | None ->
+
+                        let specLambdaR, _ = OptimizeExpr cenv { env with dontInline = Zset.add origLambdaId env.dontInline } specLambda
+                        cenv.specializedInlineVals.Add(origLambdaId, (specLambdaTy, specLambdaR))
+                        specLambdaR
+                    else
+                        let specLambdaR, _ = OptimizeExpr cenv { env with dontInline = Zset.add origLambdaId env.dontInline } specLambda
+                        specLambdaR
+
+                let debugVal =
+                    let name = $"<{vref.LogicalName}>__debug"
+                    // When tyargs have free type variables, omit ValReprInfo so IlxGen compiles this
+                    // as a closure that captures type variables and witnesses from the enclosing scope.
+                    let valReprInfo =
+                        if allTyargsAreConcrete then
+                            Some(InferValReprInfoOfExpr g AllowTypeDirectedDetupling.No specLambdaTy [] [] specLambdaR)
+                        else
+                            None
+
+                    Construct.NewVal(name, m, None, specLambdaTy, Immutable, true, valReprInfo, taccessPublic, ValNotInRecScope, None,
+                        NormalVal, [], ValInline.InlinedDefinition, XmlDoc.Empty, false, false, false, false, false, false, None,
+                        ParentNone)
+
+                let callExpr = mkApps g ((exprForVal m debugVal, specLambdaTy), [], argsR, m)
+                Some(mkCompGenLet m debugVal specLambdaR callExpr, info)
+
+        | _ -> None
+    | _ ->
+
     // Considering inlining app 
     match finfo.Info with 
     | StripLambdaValue (lambdaId, arities, size, f2, f2ty) when
@@ -3621,7 +3701,7 @@ and OptimizeApplication cenv env (f0, f0ty, tyargs, args, m) =
         OptimizeExpr cenv env remade
     | Choice2Of2 (newf0, remake) -> 
 
-    match TryInlineApplication cenv env finfo (tyargs, args, m) with 
+    match TryInlineApplication cenv env finfo f0 (tyargs, args, m) with 
     | Some (res, info) ->
         // inlined
         (res |> remake), info
@@ -3869,6 +3949,10 @@ and OptimizeLambdas (vspec: Val option) cenv env valReprInfo expr exprTy =
 
         // can't inline any values with semi-recursive object references to self or base 
         let value_ =   
+          match vspec with
+          | Some v when v.InlineInfo = ValInline.InlinedDefinition -> UnknownValue
+          | _ ->
+
           match baseValOpt with 
           | None -> CurriedLambdaValue (lambdaId, arities, bsize, exprR, exprTy) 
           | Some baseVal -> 
@@ -4017,7 +4101,7 @@ and OptimizeDecisionTreeTarget cenv env _m (TTarget(vs, expr, flags)) =
     let env = BindInternalValsToUnknown cenv vs env 
     let exprR, einfo = OptimizeExpr cenv env expr 
     let exprR, einfo = ConsiderSplitToMethod cenv.settings.abstractBigTargets cenv.settings.bigTargetSize cenv env (exprR, einfo) 
-    let evalueR = AbstractExprInfoByVars (vs, []) einfo.Info 
+    let evalueR = AbstractExprInfoByVars cenv (vs, []) einfo.Info
     TTarget(vs, exprR, flags), 
     { TotalSize=einfo.TotalSize 
       FunctionSize=einfo.FunctionSize
@@ -4301,7 +4385,7 @@ and OptimizeModuleExprWithSig cenv env mty def  =
 
             elimModuleDefn def 
 
-        let info = AbstractAndRemapModulInfo g rpi info
+        let info = AbstractAndRemapModulInfo g cenv rpi info
 
         def, info 
 
@@ -4374,14 +4458,14 @@ and OptimizeImplFileInternal cenv env isIncrementalFragment hidden implFile =
             // This optimizes and builds minfo ignoring the signature
             let (defR, minfo), (_env, _bindInfosColl) = OptimizeModuleContents cenv (env, []) contents
             let hidden = ComputeImplementationHidingInfoAtAssemblyBoundary defR hidden
-            let minfo = AbstractLazyModulInfoByHiding false hidden minfo
+            let minfo = AbstractLazyModulInfoByHiding false cenv hidden minfo
             let env = BindValsInModuleOrNamespace cenv minfo env
             env, defR, minfo, hidden
         else
             // This optimizes and builds minfo w.r.t. the signature
             let mexprR, minfo = OptimizeModuleExprWithSig cenv env signature contents
             let hidden = ComputeSignatureHidingInfoAtAssemblyBoundary signature hidden
-            let minfoExternal = AbstractLazyModulInfoByHiding true hidden minfo
+            let minfoExternal = AbstractLazyModulInfoByHiding true cenv hidden minfo
             let env = BindValsInModuleOrNamespace cenv minfo env
             env, mexprR, minfoExternal, hidden
 
@@ -4403,6 +4487,7 @@ let OptimizeImplFile (settings, ccu, tcGlobals, tcVal, importMap, optEnv, isIncr
           casApplied=Dictionary<Stamp, bool>() 
           stackGuard = StackGuard("OptimizerStackGuardDepth")
           realsig = tcGlobals.realsig
+          specializedInlineVals = HashMultiMap(HashIdentity.Structural, true)
         }
 
     let env, _, _, _ as results = OptimizeImplFileInternal cenv optEnv isIncrementalFragment hidden mimpls

src/Compiler/Optimize/Optimizer.fsi

@@ -51,6 +51,8 @@ type OptimizationSettings =
         reportTotalSizes: bool
 
         processingMode: OptimizationProcessingMode
+
+        inlineNamedFunctions: bool
     }
 
     member JitOptimizationsEnabled: bool

src/Compiler/Symbols/Symbols.fs

@@ -1857,7 +1857,7 @@ type FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) =
         match v.InlineInfo with 
         | ValInline.Always -> FSharpInlineAnnotation.AlwaysInline
         | ValInline.Optional -> FSharpInlineAnnotation.OptionalInline
-        | ValInline.Never -> FSharpInlineAnnotation.NeverInline
+        | ValInline.Never | ValInline.InlinedDefinition -> FSharpInlineAnnotation.NeverInline
 
     member _.IsMutable = 
         if isUnresolved() then false else