From 181cc8b0ad4c0a28ba00fc34f615085ff78db1de Mon Sep 17 00:00:00 2001 From: nojaf Date: Sat, 2 Dec 2023 12:45:23 +0100 Subject: [PATCH 1/2] Refactor extension attribute addition for modules and types. --- src/Compiler/Checking/CheckDeclarations.fs | 54 ++++++++++++++++--- src/Compiler/TypedTree/TypedTreeOps.fs | 43 ++++++++++----- src/Compiler/TypedTree/TypedTreeOps.fsi | 15 ++++-- .../Language/ExtensionMethodTests.fs | 37 +++++++++++++ 4 files changed, 127 insertions(+), 22 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index da3ecc9b0d9..5f05c4891b7 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -1069,11 +1069,12 @@ module MutRecBindingChecking = if cenv.g.langVersion.SupportsFeature(LanguageFeature.CSharpExtensionAttributeNotRequired) then tyconOpt |> Option.map (fun tycon -> - tryAddExtensionAttributeIfNotAlreadyPresent + tryAddExtensionAttributeIfNotAlreadyPresentForType (fun tryFindExtensionAttribute -> tycon.MembersOfFSharpTyconSorted |> Seq.tryPick (fun m -> tryFindExtensionAttribute m.Attribs) ) + envForTycon.eModuleOrNamespaceTypeAccumulator tycon ) else @@ -1303,7 +1304,24 @@ module MutRecBindingChecking = let innerState = (tpenv, envInstance, envStatic, envNonRec, generalizedRecBinds, preGeneralizationRecBinds, uncheckedRecBindsTable) Phase2BMember rbind.RecBindingInfo.Index, innerState) - + + let tyconOpt = + if not(cenv.g.langVersion.SupportsFeature(LanguageFeature.CSharpExtensionAttributeNotRequired)) then + tyconOpt + else + // We need to redo this check, which already happened in TcMutRecBindings_Phase2A_CreateRecursiveValuesAndCheckArgumentPatterns + // Because the environment is being reset in the case of recursive modules. + tyconOpt + |> Option.map (fun tycon -> + tryAddExtensionAttributeIfNotAlreadyPresentForType + (fun tryFindExtensionAttribute -> + tycon.MembersOfFSharpTyconSorted + |> Seq.tryPick (fun m -> tryFindExtensionAttribute m.Attribs) + ) + envForTycon.eModuleOrNamespaceTypeAccumulator + tycon + ) + let defnBs = MutRecShape.Tycon (TyconBindingsPhase2B(tyconOpt, tcref, defnBs)) let outerState = (tpenv, generalizedRecBinds, preGeneralizationRecBinds, uncheckedRecBindsTable, envNonRec) defnBs, outerState) @@ -4502,16 +4520,18 @@ module TcDeclarations = |> List.map (function | MutRecShape.Tycon (Some tycon, bindings) -> let tycon = - tryAddExtensionAttributeIfNotAlreadyPresent + tryAddExtensionAttributeIfNotAlreadyPresentForType (fun tryFindExtensionAttribute -> tycon.MembersOfFSharpTyconSorted |> Seq.tryPick (fun m -> tryFindExtensionAttribute m.Attribs) ) + envFinal.eModuleOrNamespaceTypeAccumulator tycon + MutRecShape.Tycon (Some tycon, bindings) | MutRecShape.Module ((MutRecDefnsPhase2DataForModule(moduleOrNamespaceType, entity), env), shapes) -> let entity = - tryAddExtensionAttributeIfNotAlreadyPresent + tryAddExtensionAttributeIfNotAlreadyPresentForModule (fun tryFindExtensionAttribute -> moduleOrNamespaceType.Value.AllValsAndMembers |> Seq.filter(fun v -> v.IsModuleBinding) @@ -4623,8 +4643,28 @@ module TcDeclarations = let envForTycon = AddDeclaredTypars CheckForDuplicateTypars declaredTyconTypars envForDecls let envForTycon = MakeInnerEnvForTyconRef envForTycon tcref (declKind = ExtrinsicExtensionBinding) - TcTyconMemberSpecs cenv envForTycon (TyconContainerInfo(innerParent, tcref, declaredTyconTypars, NoSafeInitInfo)) declKind tpenv members) - + let vals, env = TcTyconMemberSpecs cenv envForTycon (TyconContainerInfo(innerParent, tcref, declaredTyconTypars, NoSafeInitInfo)) declKind tpenv members + if not(cenv.g.langVersion.SupportsFeature(LanguageFeature.CSharpExtensionAttributeNotRequired)) then + vals, env + else + // Check if any of the vals has the `[]` attribute + // If this is the case, add it to the type in the env. + let extensionAttributeOnVals = + vals + |> List.tryPick (fun v -> tryFindExtensionAttribute v.Attribs) + + let typeEntity = + envForTycon.eModuleOrNamespaceTypeAccumulator.Value.AllEntitiesByLogicalMangledName.TryFind(tcref.LogicalName) + + match extensionAttributeOnVals, typeEntity with + | Some extensionAttribute, Some typeEntity -> + if Option.isNone (tryFindExtensionAttribute typeEntity.Attribs) then + typeEntity.entity_attribs <- extensionAttribute :: typeEntity.Attribs + | _ -> () + + vals, env + + ) // Do this for each 'val' declaration in a module (fun envForDecls (containerInfo, valSpec) -> let tpenv = emptyUnscopedTyparEnv @@ -5084,7 +5124,7 @@ let rec TcModuleOrNamespaceElementNonMutRec (cenv: cenv) parent typeNames scopem // //[] //let PlusOne (a:int) = a + 1 - tryAddExtensionAttributeIfNotAlreadyPresent + tryAddExtensionAttributeIfNotAlreadyPresentForModule (fun tryFindExtensionAttribute -> match moduleContents with | ModuleOrNamespaceContents.TMDefs(defs) -> diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index a3b987f46f6..119d7b9048f 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -10571,23 +10571,42 @@ let (|EmptyModuleOrNamespaces|_|) (moduleOrNamespaceContents: ModuleOrNamespaceC None | _ -> None -let tryAddExtensionAttributeIfNotAlreadyPresent +let tryFindExtensionAttribute (attribs: Attrib list): Attrib option = + List.tryFind + (fun (a: Attrib) -> + a.TyconRef.CompiledRepresentationForNamedType.BasicQualifiedName = "System.Runtime.CompilerServices.ExtensionAttribute") + attribs + +let tryAddExtensionAttributeIfNotAlreadyPresentForModule + (tryFindExtensionAttributeIn: (Attrib list -> Attrib option) -> Attrib option) + (moduleEntity: Entity) + : Entity + = + if Option.isSome (tryFindExtensionAttribute moduleEntity.Attribs) then + moduleEntity + else + match tryFindExtensionAttributeIn tryFindExtensionAttribute with + | None -> moduleEntity + | Some extensionAttrib -> + { moduleEntity with entity_attribs = extensionAttrib :: moduleEntity.Attribs } + +let tryAddExtensionAttributeIfNotAlreadyPresentForType (tryFindExtensionAttributeIn: (Attrib list -> Attrib option) -> Attrib option) - (entity: Entity) + (moduleOrNamespaceTypeAccumulator: ModuleOrNamespaceType ref) + (typeEntity: Entity) : Entity = - let tryFindExtensionAttribute (attribs: Attrib list): Attrib option = - List.tryFind - (fun (a: Attrib) -> - a.TyconRef.CompiledRepresentationForNamedType.BasicQualifiedName = "System.Runtime.CompilerServices.ExtensionAttribute") - attribs - - if Option.isSome (tryFindExtensionAttribute entity.Attribs) then - entity + if Option.isSome (tryFindExtensionAttribute typeEntity.Attribs) then + typeEntity else match tryFindExtensionAttributeIn tryFindExtensionAttribute with - | None -> entity - | Some extensionAttrib -> { entity with entity_attribs = extensionAttrib :: entity.Attribs } + | None -> typeEntity + | Some extensionAttrib -> + moduleOrNamespaceTypeAccumulator.Value.AllEntitiesByLogicalMangledName.TryFind(typeEntity.LogicalName) + |> Option.iter (fun e -> + e.entity_attribs <- extensionAttrib :: e.Attribs + ) + typeEntity type TypedTreeNode = { diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index 7cc531b71c7..28b01a75450 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -2722,9 +2722,18 @@ type TraitConstraintInfo with val (|EmptyModuleOrNamespaces|_|): moduleOrNamespaceContents: ModuleOrNamespaceContents -> (ModuleOrNamespace list) option -/// Add an System.Runtime.CompilerServices.ExtensionAttribute to the Entity if found via predicate and not already present. -val tryAddExtensionAttributeIfNotAlreadyPresent: - tryFindExtensionAttributeIn: ((Attrib list -> Attrib option) -> Attrib option) -> entity: Entity -> Entity +val tryFindExtensionAttribute: attribs: Attrib list -> Attrib option + +/// Add an System.Runtime.CompilerServices.ExtensionAttribute to the module Entity if found via predicate and not already present. +val tryAddExtensionAttributeIfNotAlreadyPresentForModule: + tryFindExtensionAttributeIn: ((Attrib list -> Attrib option) -> Attrib option) -> moduleEntity: Entity -> Entity + +/// Add an System.Runtime.CompilerServices.ExtensionAttribute to the type Entity if found via predicate and not already present. +val tryAddExtensionAttributeIfNotAlreadyPresentForType: + tryFindExtensionAttributeIn: ((Attrib list -> Attrib option) -> Attrib option) -> + moduleOrNamespaceTypeAccumulator: ModuleOrNamespaceType ref -> + typeEntity: Entity -> + Entity /// Serialize an entity to a very basic json structure. val serializeEntity: path: string -> entity: Entity -> unit diff --git a/tests/FSharp.Compiler.ComponentTests/Language/ExtensionMethodTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/ExtensionMethodTests.fs index 817b33a43d6..aa61a16cb35 100644 --- a/tests/FSharp.Compiler.ComponentTests/Language/ExtensionMethodTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Language/ExtensionMethodTests.fs @@ -609,3 +609,40 @@ type Bar = |> withReferences [ fsharp ] csharp |> compile |> shouldSucceed + + [] + let ``F# CSharpStyleExtensionMethod consumed in F#`` () = + let producer = + FSharp + """ +namespace Producer + +open System.Runtime.CompilerServices + +type WidgetBuilder<'msg, 'marker>() = class end + +type IMarkerOne = interface end + +// Commenting out [] breaks +//[] +type WidgetBuilderExtensions = + [] + static member inline one(this: WidgetBuilder<'msg, #IMarkerOne>) = this +""" + |> withLangVersion80 + |> withName "FSLibProducer" + + let fsharp2 = + FSharp + """ +namespace Consumer + +open Producer + +module FSLibConsumer = + let x = WidgetBuilder().one() +""" + |> withName "FSLibConsumer" + |> withReferences [ producer ] + + fsharp2 |> compile |> shouldSucceed From 5b29448dfa7d9433a6e64cdaf0df5d13d9268541 Mon Sep 17 00:00:00 2001 From: nojaf Date: Fri, 8 Dec 2023 09:57:42 +0100 Subject: [PATCH 2/2] Use existing helper functions to find ExtensionAttribute. --- src/Compiler/Checking/CheckDeclarations.fs | 9 +++++++-- src/Compiler/TypedTree/TypedTreeOps.fs | 18 +++++++++--------- src/Compiler/TypedTree/TypedTreeOps.fsi | 8 ++++++-- 3 files changed, 22 insertions(+), 13 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index 5f05c4891b7..66ade31a059 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -1070,6 +1070,7 @@ module MutRecBindingChecking = tyconOpt |> Option.map (fun tycon -> tryAddExtensionAttributeIfNotAlreadyPresentForType + g (fun tryFindExtensionAttribute -> tycon.MembersOfFSharpTyconSorted |> Seq.tryPick (fun m -> tryFindExtensionAttribute m.Attribs) @@ -1314,6 +1315,7 @@ module MutRecBindingChecking = tyconOpt |> Option.map (fun tycon -> tryAddExtensionAttributeIfNotAlreadyPresentForType + g (fun tryFindExtensionAttribute -> tycon.MembersOfFSharpTyconSorted |> Seq.tryPick (fun m -> tryFindExtensionAttribute m.Attribs) @@ -4521,6 +4523,7 @@ module TcDeclarations = | MutRecShape.Tycon (Some tycon, bindings) -> let tycon = tryAddExtensionAttributeIfNotAlreadyPresentForType + g (fun tryFindExtensionAttribute -> tycon.MembersOfFSharpTyconSorted |> Seq.tryPick (fun m -> tryFindExtensionAttribute m.Attribs) @@ -4532,6 +4535,7 @@ module TcDeclarations = | MutRecShape.Module ((MutRecDefnsPhase2DataForModule(moduleOrNamespaceType, entity), env), shapes) -> let entity = tryAddExtensionAttributeIfNotAlreadyPresentForModule + g (fun tryFindExtensionAttribute -> moduleOrNamespaceType.Value.AllValsAndMembers |> Seq.filter(fun v -> v.IsModuleBinding) @@ -4651,14 +4655,14 @@ module TcDeclarations = // If this is the case, add it to the type in the env. let extensionAttributeOnVals = vals - |> List.tryPick (fun v -> tryFindExtensionAttribute v.Attribs) + |> List.tryPick (fun v -> tryFindExtensionAttribute g v.Attribs) let typeEntity = envForTycon.eModuleOrNamespaceTypeAccumulator.Value.AllEntitiesByLogicalMangledName.TryFind(tcref.LogicalName) match extensionAttributeOnVals, typeEntity with | Some extensionAttribute, Some typeEntity -> - if Option.isNone (tryFindExtensionAttribute typeEntity.Attribs) then + if Option.isNone (tryFindExtensionAttribute g typeEntity.Attribs) then typeEntity.entity_attribs <- extensionAttribute :: typeEntity.Attribs | _ -> () @@ -5125,6 +5129,7 @@ let rec TcModuleOrNamespaceElementNonMutRec (cenv: cenv) parent typeNames scopem //[] //let PlusOne (a:int) = a + 1 tryAddExtensionAttributeIfNotAlreadyPresentForModule + g (fun tryFindExtensionAttribute -> match moduleContents with | ModuleOrNamespaceContents.TMDefs(defs) -> diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index 119d7b9048f..3b2408d36ca 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -10571,35 +10571,35 @@ let (|EmptyModuleOrNamespaces|_|) (moduleOrNamespaceContents: ModuleOrNamespaceC None | _ -> None -let tryFindExtensionAttribute (attribs: Attrib list): Attrib option = - List.tryFind - (fun (a: Attrib) -> - a.TyconRef.CompiledRepresentationForNamedType.BasicQualifiedName = "System.Runtime.CompilerServices.ExtensionAttribute") - attribs +let tryFindExtensionAttribute (g: TcGlobals) (attribs: Attrib list): Attrib option = + attribs + |> List.tryFind (IsMatchingFSharpAttribute g g.attrib_ExtensionAttribute) let tryAddExtensionAttributeIfNotAlreadyPresentForModule + (g: TcGlobals) (tryFindExtensionAttributeIn: (Attrib list -> Attrib option) -> Attrib option) (moduleEntity: Entity) : Entity = - if Option.isSome (tryFindExtensionAttribute moduleEntity.Attribs) then + if Option.isSome (tryFindExtensionAttribute g moduleEntity.Attribs) then moduleEntity else - match tryFindExtensionAttributeIn tryFindExtensionAttribute with + match tryFindExtensionAttributeIn (tryFindExtensionAttribute g) with | None -> moduleEntity | Some extensionAttrib -> { moduleEntity with entity_attribs = extensionAttrib :: moduleEntity.Attribs } let tryAddExtensionAttributeIfNotAlreadyPresentForType + (g: TcGlobals) (tryFindExtensionAttributeIn: (Attrib list -> Attrib option) -> Attrib option) (moduleOrNamespaceTypeAccumulator: ModuleOrNamespaceType ref) (typeEntity: Entity) : Entity = - if Option.isSome (tryFindExtensionAttribute typeEntity.Attribs) then + if Option.isSome (tryFindExtensionAttribute g typeEntity.Attribs) then typeEntity else - match tryFindExtensionAttributeIn tryFindExtensionAttribute with + match tryFindExtensionAttributeIn (tryFindExtensionAttribute g) with | None -> typeEntity | Some extensionAttrib -> moduleOrNamespaceTypeAccumulator.Value.AllEntitiesByLogicalMangledName.TryFind(typeEntity.LogicalName) diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index 28b01a75450..1a8d3d87c9e 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -2722,14 +2722,18 @@ type TraitConstraintInfo with val (|EmptyModuleOrNamespaces|_|): moduleOrNamespaceContents: ModuleOrNamespaceContents -> (ModuleOrNamespace list) option -val tryFindExtensionAttribute: attribs: Attrib list -> Attrib option +val tryFindExtensionAttribute: g: TcGlobals -> attribs: Attrib list -> Attrib option /// Add an System.Runtime.CompilerServices.ExtensionAttribute to the module Entity if found via predicate and not already present. val tryAddExtensionAttributeIfNotAlreadyPresentForModule: - tryFindExtensionAttributeIn: ((Attrib list -> Attrib option) -> Attrib option) -> moduleEntity: Entity -> Entity + g: TcGlobals -> + tryFindExtensionAttributeIn: ((Attrib list -> Attrib option) -> Attrib option) -> + moduleEntity: Entity -> + Entity /// Add an System.Runtime.CompilerServices.ExtensionAttribute to the type Entity if found via predicate and not already present. val tryAddExtensionAttributeIfNotAlreadyPresentForType: + g: TcGlobals -> tryFindExtensionAttributeIn: ((Attrib list -> Attrib option) -> Attrib option) -> moduleOrNamespaceTypeAccumulator: ModuleOrNamespaceType ref -> typeEntity: Entity ->