diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 60a7d9b364e..955f5dde824 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/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 diff --git a/src/Compiler/TypedTree/TcGlobals.fs b/src/Compiler/TypedTree/TcGlobals.fs index 9ab7cf2f723..2d74fe64c55 100755 --- a/src/Compiler/TypedTree/TcGlobals.fs +++ b/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" diff --git a/src/FSharp.Core/prim-types.fs b/src/FSharp.Core/prim-types.fs index a3019b1ec84..604abae7688 100644 --- a/src/FSharp.Core/prim-types.fs +++ b/src/FSharp.Core/prim-types.fs @@ -369,6 +369,11 @@ namespace Microsoft.FSharp.Core type ValueAsStaticPropertyAttribute() = inherit Attribute() + [] + [] + type NoCompilerInliningAttribute() = + inherit Attribute() + [] type float<[] 'Measure> = float [] type float32<[] 'Measure> = float32 [] type decimal<[] 'Measure> = decimal diff --git a/src/FSharp.Core/prim-types.fsi b/src/FSharp.Core/prim-types.fsi index e639f3cb85e..ff9ce073635 100644 --- a/src/FSharp.Core/prim-types.fsi +++ b/src/FSharp.Core/prim-types.fsi @@ -937,6 +937,19 @@ namespace Microsoft.FSharp.Core /// or an enclosing module opened. member Path: string + /// Indicates a value or a function that must not be inlined by the F# compiler, + /// but may be inlined by the JIT compiler. + /// + /// Attributes + [] + [] + type NoCompilerInliningAttribute = + inherit Attribute + + /// Creates an instance of the attribute + /// NoCompilerInliningAttribute + new: unit -> NoCompilerInliningAttribute + /// 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 diff --git a/tests/FSharp.Compiler.ComponentTests/EmittedIL/NoCompilerInlining.fs b/tests/FSharp.Compiler.ComponentTests/EmittedIL/NoCompilerInlining.fs new file mode 100644 index 00000000000..a85251c036f --- /dev/null +++ b/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`` = + [] + let ``Function marked with NoCompilerInlining is not inlined by the compiler``() = + FSharp """ +module NoCompilerInlining + +let functionInlined () = 3 + +[] +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 + }"""] + + [] + let ``Value marked with NoCompilerInlining is not inlined by the compiler``() = + FSharp """ +module NoCompilerInlining + +let valueInlined = 3 + +[] +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() + } +"""] \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj index b6ea2254387..d6466ca9622 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj +++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj @@ -102,6 +102,7 @@ + diff --git a/tests/FSharp.Core.UnitTests/SurfaceArea.fs b/tests/FSharp.Core.UnitTests/SurfaceArea.fs index 95d9db63cae..fd0fe854332 100644 --- a/tests/FSharp.Core.UnitTests/SurfaceArea.fs +++ b/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)