Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
57 changes: 51 additions & 6 deletions src/Compiler/Checking/CheckDeclarations.fs
Original file line number Diff line number Diff line change
Expand Up @@ -1203,11 +1203,13 @@ module MutRecBindingChecking =
if cenv.g.langVersion.SupportsFeature(LanguageFeature.CSharpExtensionAttributeNotRequired) then
tyconOpt
|> Option.map (fun tycon ->
tryAddExtensionAttributeIfNotAlreadyPresent
tryAddExtensionAttributeIfNotAlreadyPresentForType
g
(fun tryFindExtensionAttribute ->
tycon.MembersOfFSharpTyconSorted
|> Seq.tryPick (fun m -> tryFindExtensionAttribute m.Attribs)
)
envForTycon.eModuleOrNamespaceTypeAccumulator
tycon
)
else
Expand Down Expand Up @@ -1437,7 +1439,25 @@ 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
g
(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)
Expand Down Expand Up @@ -4528,16 +4548,20 @@ module TcDeclarations =
|> List.map (function
| MutRecShape.Tycon (Some tycon, bindings) ->
let tycon =
tryAddExtensionAttributeIfNotAlreadyPresent
tryAddExtensionAttributeIfNotAlreadyPresentForType
g
(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
g
(fun tryFindExtensionAttribute ->
moduleOrNamespaceType.Value.AllValsAndMembers
|> Seq.filter(fun v -> v.IsModuleBinding)
Expand Down Expand Up @@ -4659,8 +4683,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 `[<Extension>]` attribute
// If this is the case, add it to the type in the env.
let extensionAttributeOnVals =
vals
|> 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 g 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
Expand Down Expand Up @@ -5130,7 +5174,8 @@ let rec TcModuleOrNamespaceElementNonMutRec (cenv: cenv) parent typeNames scopem
//
//[<System.Runtime.CompilerServices.Extension>]
//let PlusOne (a:int) = a + 1
tryAddExtensionAttributeIfNotAlreadyPresent
tryAddExtensionAttributeIfNotAlreadyPresentForModule
g
(fun tryFindExtensionAttribute ->
match moduleContents with
| ModuleOrNamespaceContents.TMDefs(defs) ->
Expand Down
45 changes: 32 additions & 13 deletions src/Compiler/TypedTree/TypedTreeOps.fs
Original file line number Diff line number Diff line change
Expand Up @@ -10591,23 +10591,42 @@ let (|EmptyModuleOrNamespaces|_|) (moduleOrNamespaceContents: ModuleOrNamespaceC
None
| _ -> None

let tryAddExtensionAttributeIfNotAlreadyPresent
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 g moduleEntity.Attribs) then
moduleEntity
else
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)
(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 g typeEntity.Attribs) then
typeEntity
else
match tryFindExtensionAttributeIn tryFindExtensionAttribute with
| None -> entity
| Some extensionAttrib -> { entity with entity_attribs = extensionAttrib :: entity.Attribs }
match tryFindExtensionAttributeIn (tryFindExtensionAttribute g) with
| None -> typeEntity
| Some extensionAttrib ->
moduleOrNamespaceTypeAccumulator.Value.AllEntitiesByLogicalMangledName.TryFind(typeEntity.LogicalName)
|> Option.iter (fun e ->
e.entity_attribs <- extensionAttrib :: e.Attribs
)
typeEntity

type TypedTreeNode =
{
Expand Down
19 changes: 16 additions & 3 deletions src/Compiler/TypedTree/TypedTreeOps.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -2727,9 +2727,22 @@ 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: 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:
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 ->
Entity

/// Serialize an entity to a very basic json structure.
val serializeEntity: path: string -> entity: Entity -> unit
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -648,3 +648,40 @@ module M =
|> withReferences [ csharp ]

fsharp |> compile |> shouldSucceed

[<Fact>]
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 [<Extension>] breaks
//[<Extension>]
type WidgetBuilderExtensions =
[<Extension>]
static member inline one(this: WidgetBuilder<'msg, #IMarkerOne>) = this
"""
|> withLangVersion80
|> withName "FSLibProducer"

let fsharp2 =
FSharp
"""
namespace Consumer

open Producer

module FSLibConsumer =
let x = WidgetBuilder<int, IMarkerOne>().one()
"""
|> withName "FSLibConsumer"
|> withReferences [ producer ]

fsharp2 |> compile |> shouldSucceed