Skip to content

Commit fce0cf0

Browse files
authored
Refactor extension attribute addition for modules and types. (dotnet#16368)
* Refactor extension attribute addition for modules and types. * Use existing helper functions to find ExtensionAttribute.
1 parent fbfeb6d commit fce0cf0

File tree

4 files changed

+136
-22
lines changed

4 files changed

+136
-22
lines changed

src/Compiler/Checking/CheckDeclarations.fs

Lines changed: 51 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -1203,11 +1203,13 @@ module MutRecBindingChecking =
12031203
if cenv.g.langVersion.SupportsFeature(LanguageFeature.CSharpExtensionAttributeNotRequired) then
12041204
tyconOpt
12051205
|> Option.map (fun tycon ->
1206-
tryAddExtensionAttributeIfNotAlreadyPresent
1206+
tryAddExtensionAttributeIfNotAlreadyPresentForType
1207+
g
12071208
(fun tryFindExtensionAttribute ->
12081209
tycon.MembersOfFSharpTyconSorted
12091210
|> Seq.tryPick (fun m -> tryFindExtensionAttribute m.Attribs)
12101211
)
1212+
envForTycon.eModuleOrNamespaceTypeAccumulator
12111213
tycon
12121214
)
12131215
else
@@ -1437,7 +1439,25 @@ module MutRecBindingChecking =
14371439

14381440
let innerState = (tpenv, envInstance, envStatic, envNonRec, generalizedRecBinds, preGeneralizationRecBinds, uncheckedRecBindsTable)
14391441
Phase2BMember rbind.RecBindingInfo.Index, innerState)
1440-
1442+
1443+
let tyconOpt =
1444+
if not(cenv.g.langVersion.SupportsFeature(LanguageFeature.CSharpExtensionAttributeNotRequired)) then
1445+
tyconOpt
1446+
else
1447+
// We need to redo this check, which already happened in TcMutRecBindings_Phase2A_CreateRecursiveValuesAndCheckArgumentPatterns
1448+
// Because the environment is being reset in the case of recursive modules.
1449+
tyconOpt
1450+
|> Option.map (fun tycon ->
1451+
tryAddExtensionAttributeIfNotAlreadyPresentForType
1452+
g
1453+
(fun tryFindExtensionAttribute ->
1454+
tycon.MembersOfFSharpTyconSorted
1455+
|> Seq.tryPick (fun m -> tryFindExtensionAttribute m.Attribs)
1456+
)
1457+
envForTycon.eModuleOrNamespaceTypeAccumulator
1458+
tycon
1459+
)
1460+
14411461
let defnBs = MutRecShape.Tycon (TyconBindingsPhase2B(tyconOpt, tcref, defnBs))
14421462
let outerState = (tpenv, generalizedRecBinds, preGeneralizationRecBinds, uncheckedRecBindsTable, envNonRec)
14431463
defnBs, outerState)
@@ -4536,16 +4556,20 @@ module TcDeclarations =
45364556
|> List.map (function
45374557
| MutRecShape.Tycon (Some tycon, bindings) ->
45384558
let tycon =
4539-
tryAddExtensionAttributeIfNotAlreadyPresent
4559+
tryAddExtensionAttributeIfNotAlreadyPresentForType
4560+
g
45404561
(fun tryFindExtensionAttribute ->
45414562
tycon.MembersOfFSharpTyconSorted
45424563
|> Seq.tryPick (fun m -> tryFindExtensionAttribute m.Attribs)
45434564
)
4565+
envFinal.eModuleOrNamespaceTypeAccumulator
45444566
tycon
4567+
45454568
MutRecShape.Tycon (Some tycon, bindings)
45464569
| MutRecShape.Module ((MutRecDefnsPhase2DataForModule(moduleOrNamespaceType, entity), env), shapes) ->
45474570
let entity =
4548-
tryAddExtensionAttributeIfNotAlreadyPresent
4571+
tryAddExtensionAttributeIfNotAlreadyPresentForModule
4572+
g
45494573
(fun tryFindExtensionAttribute ->
45504574
moduleOrNamespaceType.Value.AllValsAndMembers
45514575
|> Seq.filter(fun v -> v.IsModuleBinding)
@@ -4667,8 +4691,28 @@ module TcDeclarations =
46674691
let envForTycon = AddDeclaredTypars CheckForDuplicateTypars declaredTyconTypars envForDecls
46684692
let envForTycon = MakeInnerEnvForTyconRef envForTycon tcref (declKind = ExtrinsicExtensionBinding)
46694693

4670-
TcTyconMemberSpecs cenv envForTycon (TyconContainerInfo(innerParent, tcref, declaredTyconTypars, NoSafeInitInfo)) declKind tpenv members)
4694+
let vals, env = TcTyconMemberSpecs cenv envForTycon (TyconContainerInfo(innerParent, tcref, declaredTyconTypars, NoSafeInitInfo)) declKind tpenv members
4695+
if not(cenv.g.langVersion.SupportsFeature(LanguageFeature.CSharpExtensionAttributeNotRequired)) then
4696+
vals, env
4697+
else
4698+
// Check if any of the vals has the `[<Extension>]` attribute
4699+
// If this is the case, add it to the type in the env.
4700+
let extensionAttributeOnVals =
4701+
vals
4702+
|> List.tryPick (fun v -> tryFindExtensionAttribute g v.Attribs)
4703+
4704+
let typeEntity =
4705+
envForTycon.eModuleOrNamespaceTypeAccumulator.Value.AllEntitiesByLogicalMangledName.TryFind(tcref.LogicalName)
46714706

4707+
match extensionAttributeOnVals, typeEntity with
4708+
| Some extensionAttribute, Some typeEntity ->
4709+
if Option.isNone (tryFindExtensionAttribute g typeEntity.Attribs) then
4710+
typeEntity.entity_attribs <- extensionAttribute :: typeEntity.Attribs
4711+
| _ -> ()
4712+
4713+
vals, env
4714+
4715+
)
46724716
// Do this for each 'val' declaration in a module
46734717
(fun envForDecls (containerInfo, valSpec) ->
46744718
let tpenv = emptyUnscopedTyparEnv
@@ -5138,7 +5182,8 @@ let rec TcModuleOrNamespaceElementNonMutRec (cenv: cenv) parent typeNames scopem
51385182
//
51395183
//[<System.Runtime.CompilerServices.Extension>]
51405184
//let PlusOne (a:int) = a + 1
5141-
tryAddExtensionAttributeIfNotAlreadyPresent
5185+
tryAddExtensionAttributeIfNotAlreadyPresentForModule
5186+
g
51425187
(fun tryFindExtensionAttribute ->
51435188
match moduleContents with
51445189
| ModuleOrNamespaceContents.TMDefs(defs) ->

src/Compiler/TypedTree/TypedTreeOps.fs

Lines changed: 32 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -10591,23 +10591,42 @@ let (|EmptyModuleOrNamespaces|_|) (moduleOrNamespaceContents: ModuleOrNamespaceC
1059110591
None
1059210592
| _ -> None
1059310593

10594-
let tryAddExtensionAttributeIfNotAlreadyPresent
10594+
let tryFindExtensionAttribute (g: TcGlobals) (attribs: Attrib list): Attrib option =
10595+
attribs
10596+
|> List.tryFind (IsMatchingFSharpAttribute g g.attrib_ExtensionAttribute)
10597+
10598+
let tryAddExtensionAttributeIfNotAlreadyPresentForModule
10599+
(g: TcGlobals)
10600+
(tryFindExtensionAttributeIn: (Attrib list -> Attrib option) -> Attrib option)
10601+
(moduleEntity: Entity)
10602+
: Entity
10603+
=
10604+
if Option.isSome (tryFindExtensionAttribute g moduleEntity.Attribs) then
10605+
moduleEntity
10606+
else
10607+
match tryFindExtensionAttributeIn (tryFindExtensionAttribute g) with
10608+
| None -> moduleEntity
10609+
| Some extensionAttrib ->
10610+
{ moduleEntity with entity_attribs = extensionAttrib :: moduleEntity.Attribs }
10611+
10612+
let tryAddExtensionAttributeIfNotAlreadyPresentForType
10613+
(g: TcGlobals)
1059510614
(tryFindExtensionAttributeIn: (Attrib list -> Attrib option) -> Attrib option)
10596-
(entity: Entity)
10615+
(moduleOrNamespaceTypeAccumulator: ModuleOrNamespaceType ref)
10616+
(typeEntity: Entity)
1059710617
: Entity
1059810618
=
10599-
let tryFindExtensionAttribute (attribs: Attrib list): Attrib option =
10600-
List.tryFind
10601-
(fun (a: Attrib) ->
10602-
a.TyconRef.CompiledRepresentationForNamedType.BasicQualifiedName = "System.Runtime.CompilerServices.ExtensionAttribute")
10603-
attribs
10604-
10605-
if Option.isSome (tryFindExtensionAttribute entity.Attribs) then
10606-
entity
10619+
if Option.isSome (tryFindExtensionAttribute g typeEntity.Attribs) then
10620+
typeEntity
1060710621
else
10608-
match tryFindExtensionAttributeIn tryFindExtensionAttribute with
10609-
| None -> entity
10610-
| Some extensionAttrib -> { entity with entity_attribs = extensionAttrib :: entity.Attribs }
10622+
match tryFindExtensionAttributeIn (tryFindExtensionAttribute g) with
10623+
| None -> typeEntity
10624+
| Some extensionAttrib ->
10625+
moduleOrNamespaceTypeAccumulator.Value.AllEntitiesByLogicalMangledName.TryFind(typeEntity.LogicalName)
10626+
|> Option.iter (fun e ->
10627+
e.entity_attribs <- extensionAttrib :: e.Attribs
10628+
)
10629+
typeEntity
1061110630

1061210631
type TypedTreeNode =
1061310632
{

src/Compiler/TypedTree/TypedTreeOps.fsi

Lines changed: 16 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -2727,9 +2727,22 @@ type TraitConstraintInfo with
27272727
val (|EmptyModuleOrNamespaces|_|):
27282728
moduleOrNamespaceContents: ModuleOrNamespaceContents -> (ModuleOrNamespace list) option
27292729

2730-
/// Add an System.Runtime.CompilerServices.ExtensionAttribute to the Entity if found via predicate and not already present.
2731-
val tryAddExtensionAttributeIfNotAlreadyPresent:
2732-
tryFindExtensionAttributeIn: ((Attrib list -> Attrib option) -> Attrib option) -> entity: Entity -> Entity
2730+
val tryFindExtensionAttribute: g: TcGlobals -> attribs: Attrib list -> Attrib option
2731+
2732+
/// Add an System.Runtime.CompilerServices.ExtensionAttribute to the module Entity if found via predicate and not already present.
2733+
val tryAddExtensionAttributeIfNotAlreadyPresentForModule:
2734+
g: TcGlobals ->
2735+
tryFindExtensionAttributeIn: ((Attrib list -> Attrib option) -> Attrib option) ->
2736+
moduleEntity: Entity ->
2737+
Entity
2738+
2739+
/// Add an System.Runtime.CompilerServices.ExtensionAttribute to the type Entity if found via predicate and not already present.
2740+
val tryAddExtensionAttributeIfNotAlreadyPresentForType:
2741+
g: TcGlobals ->
2742+
tryFindExtensionAttributeIn: ((Attrib list -> Attrib option) -> Attrib option) ->
2743+
moduleOrNamespaceTypeAccumulator: ModuleOrNamespaceType ref ->
2744+
typeEntity: Entity ->
2745+
Entity
27332746

27342747
/// Serialize an entity to a very basic json structure.
27352748
val serializeEntity: path: string -> entity: Entity -> unit

tests/FSharp.Compiler.ComponentTests/Language/ExtensionMethodTests.fs

Lines changed: 37 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -648,3 +648,40 @@ module M =
648648
|> withReferences [ csharp ]
649649

650650
fsharp |> compile |> shouldSucceed
651+
652+
[<Fact>]
653+
let ``F# CSharpStyleExtensionMethod consumed in F#`` () =
654+
let producer =
655+
FSharp
656+
"""
657+
namespace Producer
658+
659+
open System.Runtime.CompilerServices
660+
661+
type WidgetBuilder<'msg, 'marker>() = class end
662+
663+
type IMarkerOne = interface end
664+
665+
// Commenting out [<Extension>] breaks
666+
//[<Extension>]
667+
type WidgetBuilderExtensions =
668+
[<Extension>]
669+
static member inline one(this: WidgetBuilder<'msg, #IMarkerOne>) = this
670+
"""
671+
|> withLangVersion80
672+
|> withName "FSLibProducer"
673+
674+
let fsharp2 =
675+
FSharp
676+
"""
677+
namespace Consumer
678+
679+
open Producer
680+
681+
module FSLibConsumer =
682+
let x = WidgetBuilder<int, IMarkerOne>().one()
683+
"""
684+
|> withName "FSLibConsumer"
685+
|> withReferences [ producer ]
686+
687+
fsharp2 |> compile |> shouldSucceed

0 commit comments

Comments
 (0)