Optimizer: don't inline named functions in debug builds

Author: auduchinok

src/Compiler/CodeGen/IlxGen.fs

@@ -312,6 +312,7 @@ type cenv =
         /// Guard the stack and move to a new one if necessary
         mutable stackGuard: StackGuard
 
+        emittedSpecializedInlineVals: HashSet<Stamp>
     }
 
     member cenv.options =
@@ -8567,6 +8568,8 @@ and GenBindingAfterDebugPoint cenv cgbuf eenv bind isStateVar startMarkOpt =
         GenExpr cenv cgbuf eenv cctorBody discard
 
     | Method(valReprInfo, _, mspec, mspecW, _, ctps, mtps, curriedArgInfos, paramInfos, witnessInfos, argTys, retInfo) when not isStateVar ->
+        if vspec.InlineInfo = ValInline.InlinedDefinition && not (cenv.emittedSpecializedInlineVals.Add(vspec.Stamp)) then
+            CommitStartScope cgbuf startMarkOpt else
 
         let methLambdaTypars, methLambdaCtorThisValOpt, methLambdaBaseValOpt, methLambdaCurriedVars, methLambdaBody, methLambdaBodyTy =
             IteratedAdjustLambdaToMatchValReprInfo g cenv.amap valReprInfo rhsExpr
@@ -12486,6 +12489,7 @@ type IlxAssemblyGenerator(amap: ImportMap, g: TcGlobals, tcVal: ConstraintSolver
             optimizeDuringCodeGen = (fun _flag expr -> expr)
             stackGuard = getEmptyStackGuard ()
             delayedGenMethods = Queue()
+            emittedSpecializedInlineVals = HashSet()
         }
 
     /// Register a set of referenced assemblies with the ILX code generator

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 * Val * Expr>
     }
 
     override x.ToString() = "<cenv>"
@@ -1692,6 +1698,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
@@ -3421,8 +3428,60 @@ 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 ->
+        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 canCallDirectly =
+                let hasNoTraits =
+                    match vref.ValReprInfo with
+                    | Some reprInfo ->
+                        let tps, _, _, _ = GetValReprTypeInFSharpForm g reprInfo vref.Type m
+                        GetTraitWitnessInfosOfTypars g 0 tps |> List.isEmpty
+                    | None -> false
+
+                let hasNoFreeTyargs =
+                    tyargs |> List.forall (fun t -> (freeInType CollectTyparsNoCaching t).FreeTypars.IsEmpty) |> not
+
+                hasNoTraits || hasNoFreeTyargs
+
+            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 debugVal, specLambdaR =
+                    match cenv.specializedInlineVals.FindAll(origLambdaId) |> List.tryFind (fun (ty, _, _) -> typeEquiv g ty specLambdaTy) with
+                    | Some (_, v, body) -> v, body
+                    | None ->
+
+                    let specLambdaR, _ = OptimizeExpr cenv { env with dontInline = Zset.add origLambdaId env.dontInline } specLambda
+                    let debugVal =
+                        let name = $"<{vref.LogicalName}>__debug"
+                        let valReprInfo = Some(InferValReprInfoOfExpr g AllowTypeDirectedDetupling.No specLambdaTy [] [] specLambdaR)
+
+                        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)
+
+                    cenv.specializedInlineVals.Add(origLambdaId, (specLambdaTy, debugVal, specLambdaR))
+                    debugVal, specLambdaR
+
+                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 +3680,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 +3928,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 -> 
@@ -4403,6 +4466,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 

src/Compiler/TypedTree/TypedTree.fs

@@ -41,21 +41,15 @@ type StampMap<'T> = Map<Stamp, 'T>
 
 [<RequireQualifiedAccess>]
 type ValInline =
-
-    /// Indicates the value is inlined but the .NET IL code for the function still exists, e.g. to satisfy interfaces on objects, but that it is also always inlined 
     | Always
-
-    /// Indicates the value may optionally be inlined by the optimizer
     | Optional
-
-    /// Indicates the value must never be inlined by the optimizer
     | Never
+    | InlinedDefinition
 
-    /// Returns true if the implementation of a value should be inlined
     member x.ShouldInline = 
         match x with 
         | ValInline.Always -> true 
-        | ValInline.Optional | ValInline.Never -> false
+        | ValInline.Optional | ValInline.Never | ValInline.InlinedDefinition -> false
 
 /// A flag associated with values that indicates whether the recursive scope of the value is currently being processed, and 
 /// if the value has been generalized or not as yet.
@@ -110,6 +104,7 @@ type ValFlags(flags: int64) =
                      (if isCompGen then                                      0b00000000000000001000L 
                       else                                                   0b000000000000000000000L) |||
                      (match inlineInfo with
+                                        | ValInline.InlinedDefinition ->     0b00000000000000000000L
                                         | ValInline.Always ->                0b00000000000000010000L
                                         | ValInline.Optional ->              0b00000000000000100000L
                                         | ValInline.Never ->                 0b00000000000000110000L) |||
@@ -166,7 +161,7 @@ type ValFlags(flags: int64) =
 
     member x.InlineInfo = 
                                   match (flags       &&&                     0b00000000000000110000L) with 
-                                                             |               0b00000000000000000000L
+                                                             |               0b00000000000000000000L -> ValInline.InlinedDefinition
                                                              |               0b00000000000000010000L -> ValInline.Always
                                                              |               0b00000000000000100000L -> ValInline.Optional
                                                              |               0b00000000000000110000L -> ValInline.Never