Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Allow usage of [<TailCall>] with older FSharp.Core package versions #16373

Merged
merged 12 commits into from
Dec 13, 2023
Merged
3 changes: 2 additions & 1 deletion docs/release-notes/FSharp.Compiler.Service/8.0.200.md
Original file line number Diff line number Diff line change
Expand Up @@ -3,4 +3,5 @@
- Parens analysis: fix some parenthesization corner-cases in record expressions - https://github.com/dotnet/fsharp/pull/16370
- Parens analysis: keep parens in method calls in dot-lambdas - https://github.com/dotnet/fsharp/pull/16395
- Fixes #16359 - correctly handle imports with 0 length public key tokens - https://github.com/dotnet/fsharp/pull/16363
- Raise a new error when interfaces with auto properties are implemented on constructor-less types - https://github.com/dotnet/fsharp/pull/16352
- Raise a new error when interfaces with auto properties are implemented on constructor-less types - https://github.com/dotnet/fsharp/pull/16352
- Allow usage of `[<TailCall>]` with older `FSharp.Core` package versions - https://github.com/dotnet/fsharp/pull/16373
7 changes: 2 additions & 5 deletions src/Compiler/Checking/TailCallChecks.fs
Original file line number Diff line number Diff line change
Expand Up @@ -738,10 +738,7 @@ let CheckModuleBinding cenv (isRec: bool) (TBind _ as bind) =
| Some info -> info.HasNoArgs
| _ -> false

if
(not isRec || isNotAFunction)
&& HasFSharpAttribute cenv.g cenv.g.attrib_TailCallAttribute bind.Var.Attribs
then
if (not isRec || isNotAFunction) && cenv.g.HasTailCallAttrib bind.Var.Attribs then
warning (Error(FSComp.SR.chkTailCallAttrOnNonRec (), bind.Var.Range))

// Check if a let binding to the result of a rec expression is not inside the rec expression
Expand Down Expand Up @@ -807,7 +804,7 @@ and CheckDefnInModule cenv mdef =
let mustTailCall =
Seq.fold
(fun mustTailCall (v: Val) ->
if HasFSharpAttribute cenv.g cenv.g.attrib_TailCallAttribute v.Attribs then
if cenv.g.HasTailCallAttrib v.Attribs then
let newSet = Zset.add v mustTailCall
newSet
else
Expand Down
5 changes: 4 additions & 1 deletion src/Compiler/TypedTree/TcGlobals.fs
Original file line number Diff line number Diff line change
Expand Up @@ -1532,7 +1532,6 @@ type TcGlobals(
member val attrib_CompilerFeatureRequiredAttribute = findSysAttrib "System.Runtime.CompilerServices.CompilerFeatureRequiredAttribute"
member val attrib_SetsRequiredMembersAttribute = findSysAttrib "System.Diagnostics.CodeAnalysis.SetsRequiredMembersAttribute"
member val attrib_RequiredMemberAttribute = findSysAttrib "System.Runtime.CompilerServices.RequiredMemberAttribute"
member val attrib_TailCallAttribute = mk_MFCore_attrib "TailCallAttribute"

member g.improveType tcref tinst = improveTy tcref tinst

Expand Down Expand Up @@ -1870,6 +1869,10 @@ type TcGlobals(

member _.DebuggerNonUserCodeAttribute = debuggerNonUserCodeAttribute

member _.HasTailCallAttrib (attribs: Attribs) =
attribs
|> List.exists (fun a -> a.TyconRef.CompiledRepresentationForNamedType.FullName = "Microsoft.FSharp.Core.TailCallAttribute")

dawedawe marked this conversation as resolved.
Show resolved Hide resolved
member _.MakeInternalsVisibleToAttribute(simpleAssemName) =
mkILCustomAttribute (tref_InternalsVisibleToAttribute, [ilg.typ_String], [ILAttribElem.String (Some simpleAssemName)], [])

Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -1486,3 +1486,29 @@ namespace N
Message =
"The TailCall attribute should only be applied to recursive functions." }
]

[<FSharp.Test.FactForNETCOREAPP>]
let ``Warn about self-defined attribute`` () = // is the analysis available for users of older FSharp.Core versions
"""
module Microsoft.FSharp.Core

open System

[<AttributeUsage(AttributeTargets.Method)>]
type TailCallAttribute() = inherit Attribute()

[<TailCall>]
let rec f x = 1 + f x
"""
|> FSharp
|> compile
|> shouldFail
|> withResults [
{ Error = Warning 3569
Range = { StartLine = 10
StartColumn = 23
EndLine = 10
EndColumn = 26 }
Message =
"The member or function 'f' has the 'TailCallAttribute' attribute, but is not being used in a tail recursive way." }
]
Original file line number Diff line number Diff line change
@@ -0,0 +1,6 @@
module Microsoft.FSharp.Core

open System

[<AttributeUsage(AttributeTargets.Method)>]
type TailCallAttribute() = inherit Attribute()
13 changes: 13 additions & 0 deletions tests/projects/misc/SelfDefinedTailCallAttribute/Program.fs
Original file line number Diff line number Diff line change
@@ -0,0 +1,13 @@
namespace N

module M =

open Microsoft.FSharp.Core

[<TailCall>]
let rec f x = 1 + f x

[<EntryPoint>]
let main argv =
printfn "Hello from F#"
0
Original file line number Diff line number Diff line change
@@ -0,0 +1,20 @@
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<OutputType>Exe</OutputType>
<TargetFramework>net6.0</TargetFramework>
<DisableImplicitFSharpCoreReference>true</DisableImplicitFSharpCoreReference>
<LangVersion>preview</LangVersion>
</PropertyGroup>

<PropertyGroup>
<DotnetFscCompilerPath>$(MSBuildThisFileDirectory)../../../../artifacts/bin/fsc/Debug/net8.0/fsc.dll</DotnetFscCompilerPath>
</PropertyGroup>

<ItemGroup>
<Compile Include="Attribute.fs" />
<Compile Include="Program.fs" />
</ItemGroup>
<ItemGroup>
<PackageReference Include="FSharp.Core" Version="6.0.7" />
</ItemGroup>
</Project>