Add attribute to prevent fsc inlining but allow JIT inlining

src/Compiler/Checking/CheckExpressions.fs

@@ -2204,18 +2204,23 @@ module GeneralizationHelpers =
 // ComputeInlineFlag
 //-------------------------------------------------------------------------
 
-let ComputeInlineFlag (memFlagsOption: SynMemberFlags option) isInline isMutable m =
+let ComputeInlineFlag (memFlagsOption: SynMemberFlags option) isInline isMutable hasNoCompilerInliningAttribute m =
     let inlineFlag =
+        let isCtorOrAbstractSlot =
+            match memFlagsOption with
+            | None -> false
+            | Some x -> (x.MemberKind = SynMemberKind.Constructor) || x.IsDispatchSlot || x.IsOverrideOrExplicitImpl
+
         // Mutable values may never be inlined
         // Constructors may never be inlined
         // Calls to virtual/abstract slots may never be inlined
-        if isMutable ||
-           (match memFlagsOption with
-            | None -> false
-            | Some x -> (x.MemberKind = SynMemberKind.Constructor) || x.IsDispatchSlot || x.IsOverrideOrExplicitImpl) 
-        then ValInline.Never 
-        elif isInline then ValInline.Always 
-        else ValInline.Optional
+        // Values marked with NoCompilerInliningAttribute may never be inlined
+        if isMutable || isCtorOrAbstractSlot || hasNoCompilerInliningAttribute then
+            ValInline.Never 
+        elif isInline then
+            ValInline.Always 
+        else
+            ValInline.Optional
 
     if isInline && (inlineFlag <> ValInline.Always) then 
         errorR(Error(FSComp.SR.tcThisValueMayNotBeInlined(), m))
@@ -10281,8 +10286,9 @@ and TcNormalizedBinding declKind (cenv: cenv) env tpenv overallTy safeThisValOpt
             retAttribs, valAttribs, valSynData
 
         let isVolatile = HasFSharpAttribute g g.attrib_VolatileFieldAttribute valAttribs
+        let hasNoCompilerInliningAttribute = HasFSharpAttribute g g.attrib_NoCompilerInliningAttribute valAttribs
 
-        let inlineFlag = ComputeInlineFlag memberFlagsOpt isInline isMutable mBinding
+        let inlineFlag = ComputeInlineFlag memberFlagsOpt isInline isMutable hasNoCompilerInliningAttribute mBinding
 
         let argAttribs = 
             spatsL |> List.map (SynInfo.InferSynArgInfoFromSimplePats >> List.map (SynInfo.AttribsOfArgData >> TcAttrs AttributeTargets.Parameter false))
@@ -11403,8 +11409,9 @@ and AnalyzeAndMakeAndPublishRecursiveValue
 
     // Allocate the type inference variable for the inferred type
     let ty = NewInferenceType g
+    let hasNoCompilerInliningAttribute = HasFSharpAttribute g g.attrib_NoCompilerInliningAttribute bindingAttribs
 
-    let inlineFlag = ComputeInlineFlag memberFlagsOpt isInline isMutable mBinding
+    let inlineFlag = ComputeInlineFlag memberFlagsOpt isInline isMutable hasNoCompilerInliningAttribute mBinding
 
     if isMutable then errorR(Error(FSComp.SR.tcOnlyRecordFieldsAndSimpleLetCanBeMutable(), mBinding))
 
@@ -12020,6 +12027,7 @@ let TcAndPublishValSpec (cenv: cenv, env, containerInfo: ContainerInfo, declKind
 
     let attrs = TcAttributes cenv env attrTgt synAttrs
     let newOk = if canInferTypars then NewTyparsOK else NoNewTypars
+    let hasNoCompilerInliningAttribute = HasFSharpAttribute g g.attrib_NoCompilerInliningAttribute attrs
 
     let valinfos, tpenv = TcValSpec cenv env declKind newOk containerInfo memFlagsOpt None tpenv synValSig attrs
     let denv = env.DisplayEnv
@@ -12028,7 +12036,7 @@ let TcAndPublishValSpec (cenv: cenv, env, containerInfo: ContainerInfo, declKind
 
         let (ValSpecResult (altActualParent, memberInfoOpt, id, enclosingDeclaredTypars, declaredTypars, ty, prelimValReprInfo, declKind)) = valSpecResult
 
-        let inlineFlag = ComputeInlineFlag (memberInfoOpt |> Option.map (fun (PrelimMemberInfo(memberInfo, _, _)) -> memberInfo.MemberFlags)) isInline mutableFlag m
+        let inlineFlag = ComputeInlineFlag (memberInfoOpt |> Option.map (fun (PrelimMemberInfo(memberInfo, _, _)) -> memberInfo.MemberFlags)) isInline mutableFlag hasNoCompilerInliningAttribute m
 
         let freeInType = freeInTypeLeftToRight g false ty
 

src/Compiler/TypedTree/TcGlobals.fs

@@ -1427,6 +1427,7 @@ type TcGlobals(
   member val attrib_MeasureAttribute                       = mk_MFCore_attrib "MeasureAttribute"
   member val attrib_MeasureableAttribute                   = mk_MFCore_attrib "MeasureAnnotatedAbbreviationAttribute"
   member val attrib_NoDynamicInvocationAttribute           = mk_MFCore_attrib "NoDynamicInvocationAttribute"
+  member val attrib_NoCompilerInliningAttribute            = mk_MFCore_attrib "NoCompilerInliningAttribute"
   member val attrib_SecurityAttribute                      = tryFindSysAttrib "System.Security.Permissions.SecurityAttribute"
   member val attrib_SecurityCriticalAttribute              = findSysAttrib "System.Security.SecurityCriticalAttribute"
   member val attrib_SecuritySafeCriticalAttribute          = findSysAttrib "System.Security.SecuritySafeCriticalAttribute"

src/FSharp.Core/prim-types.fs

@@ -369,6 +369,11 @@ namespace Microsoft.FSharp.Core
     type ValueAsStaticPropertyAttribute() =
         inherit Attribute()
 
+    [<AttributeUsage(AttributeTargets.Method ||| AttributeTargets.Property, AllowMultiple=false)>]
+    [<Sealed>]
+    type NoCompilerInliningAttribute() =
+        inherit Attribute()
+
     [<MeasureAnnotatedAbbreviation>] type float<[<Measure>] 'Measure> = float 
     [<MeasureAnnotatedAbbreviation>] type float32<[<Measure>] 'Measure> = float32
     [<MeasureAnnotatedAbbreviation>] type decimal<[<Measure>] 'Measure> = decimal

src/FSharp.Core/prim-types.fsi

@@ -937,6 +937,19 @@ namespace Microsoft.FSharp.Core
         /// or an enclosing module opened.</summary>
         member Path: string
 
+    /// <summary>Indicates a value or a function that must not be inlined by the F# compiler,
+    /// but may be inlined by the JIT compiler.</summary>
+    ///
+    /// <category>Attributes</category>
+    [<AttributeUsage(AttributeTargets.Method ||| AttributeTargets.Property, AllowMultiple=false)>]
+    [<Sealed>]
+    type NoCompilerInliningAttribute =
+        inherit Attribute
+
+        /// <summary>Creates an instance of the attribute</summary>
+        /// <returns>NoCompilerInliningAttribute</returns>
+        new: unit -> NoCompilerInliningAttribute
+
     /// <summary>The type of double-precision floating point numbers, annotated with a unit of measure.
     /// The unit of measure is erased in compiled code and when values of this type
     /// are analyzed using reflection. The type is representationally equivalent to

tests/FSharp.Compiler.ComponentTests/EmittedIL/NoCompilerInlining.fs

@@ -0,0 +1,113 @@
+// Copyright (c) Microsoft Corporation.  All Rights Reserved.  See License.txt in the project root for license information.
+
+namespace FSharp.Compiler.ComponentTests.EmittedIL
+
+open Xunit
+open FSharp.Test.Compiler
+
+module ``NoCompilerInlining`` =
+    [<Fact>]
+    let ``Function marked with NoCompilerInlining is not inlined by the compiler``() =
+        FSharp """
+module NoCompilerInlining
+
+let functionInlined () = 3
+
+[<NoCompilerInliningAttribute>]
+let functionNotInlined () = 3
+
+let x () = functionInlined () + functionNotInlined ()
+"""
+         |> compile
+         |> shouldSucceed
+         |> verifyIL ["""
+  .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 07 00 00 00 00 00 ) 
+  .method public static int32  functionInlined() cil managed
+  {
+
+    .maxstack  8
+    IL_0000:  ldc.i4.3
+    IL_0001:  ret
+  }"""
+
+                      """
+  .method public static int32  functionNotInlined() cil managed
+  {
+    .custom instance void [FSharp.Core]Microsoft.FSharp.Core.NoCompilerInliningAttribute::.ctor() = ( 01 00 00 00 ) 
+
+    .maxstack  8
+    IL_0000:  ldc.i4.3
+    IL_0001:  ret
+  }"""
+
+                      """
+  .method public static int32  x() cil managed
+  {
+
+    .maxstack  8
+    IL_0000:  ldc.i4.3
+    IL_0001:  call       int32 NoCompilerInlining::functionNotInlined()
+    IL_0006:  add
+    IL_0007:  ret
+  }"""]
+
+    [<Fact>]
+    let ``Value marked with NoCompilerInlining is not inlined by the compiler``() =
+        FSharp """
+module NoCompilerInlining
+
+let valueInlined = 3
+
+[<NoCompilerInliningAttribute>]
+let valueNotInlined = 3
+
+let x () = valueInlined + valueNotInlined
+"""
+         |> compile
+         |> shouldSucceed
+         |> verifyIL ["""
+          get_valueInlined() cil managed
+  {
+    .custom instance void [runtime]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) 
+    .custom instance void [runtime]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) 
+
+    .maxstack  8
+    IL_0000:  ldc.i4.3
+    IL_0001:  ret
+  }"""
+
+                      """
+          get_valueNotInlined() cil managed
+  {
+    .custom instance void [runtime]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) 
+    .custom instance void [runtime]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) 
+
+    .maxstack  8
+    IL_0000:  ldc.i4.3
+    IL_0001:  ret
+  }"""
+
+                      """
+  .method public static int32  x() cil managed
+  {
+
+    .maxstack  8
+    IL_0000:  ldc.i4.3
+    IL_0001:  call       int32 NoCompilerInlining::get_valueNotInlined()
+    IL_0006:  add
+    IL_0007:  ret
+  }"""
+
+                      """
+  .property int32 valueInlined()
+  {
+    .get int32 NoCompilerInlining::get_valueInlined()
+  }"""
+
+                      """
+  .property int32 valueNotInlined()
+  {
+    .custom instance void [FSharp.Core]Microsoft.FSharp.Core.NoCompilerInliningAttribute::.ctor() = ( 01 00 00 00 ) 
+    .get int32 NoCompilerInlining::get_valueNotInlined()
+  } 
+"""]

tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj

@@ -102,6 +102,7 @@
     <Compile Include="EmittedIL\CompilerGeneratedAttributeOnAccessors.fs" />
     <Compile Include="EmittedIL\EmptyArray.fs" />
     <Compile Include="EmittedIL\Literals.fs" />
+    <Compile Include="EmittedIL\NoCompilerInlining.fs" />
     <Compile Include="EmittedIL\SkipLocalsInit.fs" />
     <Compile Include="EmittedIL\StringFormatAndInterpolation.fs" />
     <Compile Include="EmittedIL\StructGettersReadOnly.fs" />

tests/FSharp.Core.UnitTests/SurfaceArea.fs

@@ -1533,6 +1533,7 @@ Microsoft.FSharp.Core.MeasureAttribute: Void .ctor()
 Microsoft.FSharp.Core.NoComparisonAttribute: Void .ctor()
 Microsoft.FSharp.Core.NoDynamicInvocationAttribute: Void .ctor()
 Microsoft.FSharp.Core.NoEqualityAttribute: Void .ctor()
+Microsoft.FSharp.Core.NoCompilerInliningAttribute: Void .ctor()
 Microsoft.FSharp.Core.NumericLiterals+NumericLiteralI: System.Object FromInt64Dynamic(Int64)
 Microsoft.FSharp.Core.NumericLiterals+NumericLiteralI: System.Object FromStringDynamic(System.String)
 Microsoft.FSharp.Core.NumericLiterals+NumericLiteralI: T FromInt32[T](Int32)