Merge branch 'main' into vsinterrupt

.github/workflows/add_to_project.yml

@@ -5,9 +5,10 @@ on:
     types:
       - opened
       - transferred
-  pull_request:
+  pull_request_target:
     types:
       - opened
+    branches: ['main']
 
 permissions:
   issues: write
@@ -16,7 +17,7 @@ permissions:
 jobs:
   cleanup_old_runs:
       runs-on: ubuntu-20.04
-      if: github.event_name != 'pull_request'
+      if: github.event_name != 'pull_request_target'
       permissions:
         actions: write
       env:
@@ -42,7 +43,7 @@ jobs:
           github-token: ${{ secrets.REPO_PROJECT_PAT }}
   apply-label:
     runs-on: ubuntu-latest
-    if: github.event_name != 'pull_request'
+    if: github.event_name != 'pull_request_target'
     steps:
       - uses: actions/github-script@v6
         with:
@@ -55,7 +56,7 @@ jobs:
             })
   apply-milestone:
     runs-on: ubuntu-latest
-    if: github.event_name != 'pull_request'
+    if: github.event_name != 'pull_request_target'
     steps:
       - uses: actions/github-script@v6
         with:

FSharp.Profiles.props

@@ -14,8 +14,4 @@
     </Otherwise>
   </Choose>
 
-  <PropertyGroup>
-     <!-- Override the setting for the Arcade UserRuntimeConfig for fsc on .NET Core -->
-    <ServerGarbageCollection>true</ServerGarbageCollection>
-  </PropertyGroup>
 </Project>

src/Compiler/Checking/CheckDeclarations.fs

@@ -969,6 +969,20 @@ module MutRecBindingChecking =
                     | rest -> rest
 
                 let prelimRecValues = [ for x in defnAs do match x with Phase2AMember bind -> yield bind.RecBindingInfo.Val | _ -> () ]
+
+                let tyconOpt =
+                    if cenv.g.langVersion.SupportsFeature(LanguageFeature.CSharpExtensionAttributeNotRequired) then
+                        tyconOpt
+                        |> Option.map (fun tycon ->
+                            tryAddExtensionAttributeIfNotAlreadyPresent
+                                (fun tryFindExtensionAttribute ->
+                                    tycon.MembersOfFSharpTyconSorted
+                                    |> Seq.tryPick (fun m -> tryFindExtensionAttribute m.Attribs)
+                                )
+                                tycon
+                        )
+                    else
+                        tyconOpt
                 let defnAs = MutRecShape.Tycon(TyconBindingsPhase2A(tyconOpt, declKind, prelimRecValues, tcref, copyOfTyconTypars, thisTy, defnAs))
                 defnAs, (tpenv, recBindIdx, uncheckedBindsRev))
 
@@ -3161,7 +3175,10 @@ module EstablishTypeDefinitionCores =
                 | None -> ()
                 | Some spats ->
                     let ctorArgNames, _ = TcSimplePatsOfUnknownType cenv true CheckCxs envinner tpenv spats
-                    if not ctorArgNames.IsEmpty then errorR (Error(FSComp.SR.parsOnlyClassCanTakeValueArguments(), m))
+                    if not ctorArgNames.IsEmpty then
+                        match spats with
+                        | SynSimplePats.SimplePats(_, m) -> errorR (Error(FSComp.SR.parsOnlyClassCanTakeValueArguments(), m))
+                        | SynSimplePats.Typed(_, _, m) -> errorR (Error(FSComp.SR.parsOnlyClassCanTakeValueArguments(), m))
 
             let envinner = AddDeclaredTypars CheckForDuplicateTypars (tycon.Typars m) envinner
             let envinner = MakeInnerEnvForTyconRef envinner thisTyconRef false
@@ -4225,6 +4242,50 @@ module TcDeclarations =
         // Check the members and decide on representations for types with implicit constructors.
         let withBindings, envFinal = TcMutRecDefns_Phase2 cenv envInitial m scopem mutRecNSInfo envMutRecPrelimWithReprs withEnvs isMutRec
 
+        let withBindings =
+            if cenv.g.langVersion.SupportsFeature(LanguageFeature.CSharpExtensionAttributeNotRequired) then
+                // If any of the types has a member with the System.Runtime.CompilerServices.ExtensionAttribute,
+                // or a recursive module has a binding with the System.Runtime.CompilerServices.ExtensionAttribute,
+                // that type/recursive module should also received the ExtensionAttribute if it is not yet present.
+                // Example:
+                // open System.Runtime.CompilerServices
+                //
+                // type Int32Extensions =
+                //      [<Extension>]
+                //      static member PlusOne (a:int) : int = a + 1
+                //
+                // or
+                //
+                // module rec Foo
+                //
+                // [<System.Runtime.CompilerServices.Extension>]
+                // let PlusOne (a:int) = a + 1
+                withBindings
+                |> List.map (function
+                    | MutRecShape.Tycon (Some tycon, bindings) ->
+                        let tycon =
+                            tryAddExtensionAttributeIfNotAlreadyPresent
+                                (fun tryFindExtensionAttribute ->
+                                    tycon.MembersOfFSharpTyconSorted
+                                    |> Seq.tryPick (fun m -> tryFindExtensionAttribute m.Attribs)
+                                )
+                                tycon
+                        MutRecShape.Tycon (Some tycon, bindings)
+                    | MutRecShape.Module ((MutRecDefnsPhase2DataForModule(moduleOrNamespaceType, entity), env), shapes) ->
+                        let entity =
+                            tryAddExtensionAttributeIfNotAlreadyPresent
+                                (fun tryFindExtensionAttribute ->
+                                    moduleOrNamespaceType.Value.AllValsAndMembers
+                                    |> Seq.filter(fun v -> v.IsModuleBinding)
+                                    |> Seq.tryPick (fun v -> tryFindExtensionAttribute v.Attribs)
+                                )
+                                entity
+
+                        MutRecShape.Module ((MutRecDefnsPhase2DataForModule(moduleOrNamespaceType, entity), env), shapes)
+                    | shape -> shape)
+                else
+                    withBindings
+
         // Generate the hash/compare/equality bindings for all tycons.
         //
         // Note: generating these bindings must come after generating the members, since some in the case of structs some fields
@@ -4763,6 +4824,31 @@ let rec TcModuleOrNamespaceElementNonMutRec (cenv: cenv) parent typeNames scopem
 
               // Get the inferred type of the decls and record it in the modul. 
               moduleEntity.entity_modul_type <- MaybeLazy.Strict moduleTyAcc.Value
+
+              let moduleEntity =
+                if cenv.g.langVersion.SupportsFeature(LanguageFeature.CSharpExtensionAttributeNotRequired) then
+                    // If any of the let bindings inside the module has the System.Runtime.CompilerServices.ExtensionAttribute,
+                    // that module should also received the ExtensionAttribute if it is not yet present.
+                    // Example:
+                    // module Foo
+                    //
+                    //[<System.Runtime.CompilerServices.Extension>]
+                    //let PlusOne (a:int) = a + 1
+                    tryAddExtensionAttributeIfNotAlreadyPresent
+                        (fun tryFindExtensionAttribute ->
+                            match moduleContents with
+                            | ModuleOrNamespaceContents.TMDefs(defs) ->
+                                defs
+                                |> Seq.tryPick (function
+                                    | ModuleOrNamespaceContents.TMDefLet (Binding.TBind(var = v),_) ->
+                                        tryFindExtensionAttribute v.Attribs
+                                    | _ -> None)
+                            | _ -> None
+                        )
+                        moduleEntity
+                else
+                    moduleEntity
+
               let moduleDef = TMDefRec(false, [], [], [ModuleOrNamespaceBinding.Module(moduleEntity, moduleContents)], m)
 
               PublishModuleDefn cenv env moduleEntity 

src/Compiler/Checking/CheckExpressions.fs

@@ -1822,19 +1822,19 @@ let BuildFieldMap (cenv: cenv) env isPartial ty (flds: ((Ident list * Ident) * '
                 rfinfo1.TypeInst, rfinfo1.TyconRef
 
     let fldsmap, rfldsList =
-        ((Map.empty, []), fldResolutions) ||> List.fold (fun (fs, rfldsList) (fld, frefs, fldExpr) ->
+        ((Map.empty, []), fldResolutions) ||> List.fold (fun (fs, rfldsList) ((_, ident), frefs, fldExpr) ->
                 match frefs |> List.filter (fun (FieldResolution(rfinfo2, _)) -> tyconRefEq g tcref rfinfo2.TyconRef) with
                 | [FieldResolution(rfinfo2, showDeprecated)] ->
 
                     // Record the precise resolution of the field for intellisense
                     let item = Item.RecdField(rfinfo2)
-                    CallNameResolutionSink cenv.tcSink ((snd fld).idRange, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, ad)
+                    CallNameResolutionSink cenv.tcSink (ident.idRange, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, ad)
 
                     let fref2 = rfinfo2.RecdFieldRef
 
                     CheckRecdFieldAccessible cenv.amap m env.eAccessRights fref2 |> ignore
 
-                    CheckFSharpAttributes g fref2.PropertyAttribs m |> CommitOperationResult
+                    CheckFSharpAttributes g fref2.PropertyAttribs ident.idRange |> CommitOperationResult
 
                     if Map.containsKey fref2.FieldName fs then
                         errorR (Error(FSComp.SR.tcFieldAppearsTwiceInRecord(fref2.FieldName), m))
@@ -2169,7 +2169,8 @@ module GeneralizationHelpers =
             match memberFlags.MemberKind with
             // can't infer extra polymorphism for properties
             | SynMemberKind.PropertyGet
-            | SynMemberKind.PropertySet ->
+            | SynMemberKind.PropertySet
+            | SynMemberKind.PropertyGetSet ->
                  if not (isNil declaredTypars) then
                      errorR(Error(FSComp.SR.tcPropertyRequiresExplicitTypeParameters(), m))
             | SynMemberKind.Constructor ->

src/Compiler/Checking/NameResolution.fs

@@ -530,14 +530,18 @@ let IsMethInfoPlainCSharpStyleExtensionMember g m isEnclExtTy (minfo: MethInfo)
 /// Get the info for all the .NET-style extension members listed as static members in the type.
 let private GetCSharpStyleIndexedExtensionMembersForTyconRef (amap: Import.ImportMap) m  (tcrefOfStaticClass: TyconRef) =
     let g = amap.g
-
-    if IsTyconRefUsedForCSharpStyleExtensionMembers g m tcrefOfStaticClass then
-        let pri = NextExtensionMethodPriority()
+
+    if g.langVersion.SupportsFeature(LanguageFeature.CSharpExtensionAttributeNotRequired) then
         let ty = generalizedTyconRef g tcrefOfStaticClass
+
+        let minfos =
+            GetImmediateIntrinsicMethInfosOfType (None, AccessorDomain.AccessibleFromSomeFSharpCode) g amap m ty
+            |> List.filter (IsMethInfoPlainCSharpStyleExtensionMember g m true)
 
-        let minfos = GetImmediateIntrinsicMethInfosOfType (None, AccessorDomain.AccessibleFromSomeFSharpCode) g amap m ty
-        [ for minfo in minfos do
-            if IsMethInfoPlainCSharpStyleExtensionMember g m true minfo then
+        if IsTyconRefUsedForCSharpStyleExtensionMembers g m tcrefOfStaticClass || not minfos.IsEmpty then
+            let pri = NextExtensionMethodPriority()
+
+            [ for minfo in minfos do
                 let ilExtMem = ILExtMem (tcrefOfStaticClass, minfo, pri)
 
                 // The results are indexed by the TyconRef of the first 'this' argument, if any.
@@ -584,9 +588,60 @@ let private GetCSharpStyleIndexedExtensionMembersForTyconRef (amap: Import.Impor
                 | None -> ()
                 | Some (Some tcref) -> yield Choice1Of2(tcref, ilExtMem)
                 | Some None -> yield Choice2Of2 ilExtMem ]
+        else
+            []
     else
-        []
-
+        if IsTyconRefUsedForCSharpStyleExtensionMembers g m tcrefOfStaticClass then
+            let pri = NextExtensionMethodPriority()
+            let ty = generalizedTyconRef g tcrefOfStaticClass
+            let minfos = GetImmediateIntrinsicMethInfosOfType (None, AccessorDomain.AccessibleFromSomeFSharpCode) g amap m ty
+
+            [ for minfo in minfos do
+                if IsMethInfoPlainCSharpStyleExtensionMember g m true minfo then
+                    let ilExtMem = ILExtMem (tcrefOfStaticClass, minfo, pri)
+                    // The results are indexed by the TyconRef of the first 'this' argument, if any.
+                    // So we need to go and crack the type of the 'this' argument.
+                    //
+                    // This is convoluted because we only need the ILTypeRef of the first argument, and we don't
+                    // want to read any other metadata as it can trigger missing-assembly errors. It turns out ImportILTypeRef
+                    // is less eager in reading metadata than GetParamTypes.
+                    //
+                    // We don't use the index for the IL extension method for tuple of F# function types (e.g. if extension
+                    // methods for tuple occur in C# code)
+                    let thisTyconRef =
+                     try
+                        let rs =
+                            match metadataOfTycon tcrefOfStaticClass.Deref, minfo with
+                            | ILTypeMetadata (TILObjectReprData(scoref, _, _)), ILMeth(_, ILMethInfo(_, _, _, ilMethod, _), _) ->
+                                match ilMethod.ParameterTypes with
+                                | firstTy :: _ ->
+                                    match firstTy with
+                                    | ILType.Boxed  tspec | ILType.Value tspec ->
+                                        let tref = (tspec |> rescopeILTypeSpec scoref).TypeRef
+                                        if Import.CanImportILTypeRef amap m tref then
+                                            let tcref = tref |> Import.ImportILTypeRef amap m
+                                            if isCompiledTupleTyconRef g tcref || tyconRefEq g tcref g.fastFunc_tcr then None
+                                            else Some tcref
+                                        else None
+                                    | _ -> None
+                                | _ -> None
+                            | _ ->
+                                // The results are indexed by the TyconRef of the first 'this' argument, if any.
+                                // So we need to go and crack the type of the 'this' argument.
+                                let thisTy = minfo.GetParamTypes(amap, m, generalizeTypars minfo.FormalMethodTypars).Head.Head
+                                match thisTy with
+                                | AppTy g (tcrefOfTypeExtended, _) when not (isByrefTy g thisTy) -> Some tcrefOfTypeExtended
+                                | _ -> None
+                        Some rs
+                      with e -> // Import of the ILType may fail, if so report the error and skip on
+                        errorRecovery e m
+                        None
+                    match thisTyconRef with
+                    | None -> ()
+                    | Some (Some tcref) -> yield Choice1Of2(tcref, ilExtMem)
+                    | Some None -> yield Choice2Of2 ilExtMem ]
+        else
+            []
 
 /// Query the declared properties of a type (including inherited properties)
 let IntrinsicPropInfosOfTypeInScope (infoReader: InfoReader) optFilter ad findFlag m ty =

src/Compiler/FSComp.txt

@@ -1560,6 +1560,7 @@ featureRequiredProperties,"support for required properties"
 featureInitProperties,"support for consuming init properties"
 featureLowercaseDUWhenRequireQualifiedAccess,"Allow lowercase DU when RequireQualifiedAccess attribute"
 featureMatchNotAllowedForUnionCaseWithNoData,"Pattern match discard is not allowed for union case that takes no data."
+featureCSharpExtensionAttributeNotRequired,"Allow implicit Extension attribute on declaring types, modules"
 3353,fsiInvalidDirective,"Invalid directive '#%s %s'"
 3354,tcNotAFunctionButIndexerNamedIndexingNotYetEnabled,"This value supports indexing, e.g. '%s.[index]'. The syntax '%s[index]' requires /langversion:preview. See https://aka.ms/fsharp-index-notation."
 3354,tcNotAFunctionButIndexerIndexingNotYetEnabled,"This expression supports indexing, e.g. 'expr.[index]'. The syntax 'expr[index]' requires /langversion:preview. See https://aka.ms/fsharp-index-notation."

src/Compiler/Facilities/LanguageFeatures.fs

@@ -55,6 +55,7 @@ type LanguageFeature =
     | InterfacesWithAbstractStaticMembers
     | SelfTypeConstraints
     | MatchNotAllowedForUnionCaseWithNoData
+    | CSharpExtensionAttributeNotRequired
 
 /// LanguageVersion management
 type LanguageVersion(versionText) =
@@ -126,6 +127,8 @@ type LanguageVersion(versionText) =
                 // F# preview
                 LanguageFeature.FromEndSlicing, previewVersion
                 LanguageFeature.MatchNotAllowedForUnionCaseWithNoData, previewVersion
+                LanguageFeature.CSharpExtensionAttributeNotRequired, previewVersion
+
             ]
 
     static let defaultLanguageVersion = LanguageVersion("default")
@@ -233,6 +236,7 @@ type LanguageVersion(versionText) =
         | LanguageFeature.InterfacesWithAbstractStaticMembers -> FSComp.SR.featureInterfacesWithAbstractStaticMembers ()
         | LanguageFeature.SelfTypeConstraints -> FSComp.SR.featureSelfTypeConstraints ()
         | LanguageFeature.MatchNotAllowedForUnionCaseWithNoData -> FSComp.SR.featureMatchNotAllowedForUnionCaseWithNoData ()
+        | LanguageFeature.CSharpExtensionAttributeNotRequired -> FSComp.SR.featureCSharpExtensionAttributeNotRequired  ()
 
     /// Get a version string associated with the given feature.
     static member GetFeatureVersionString feature =

src/Compiler/Facilities/LanguageFeatures.fsi

@@ -45,6 +45,7 @@ type LanguageFeature =
     | InterfacesWithAbstractStaticMembers
     | SelfTypeConstraints
     | MatchNotAllowedForUnionCaseWithNoData
+    | CSharpExtensionAttributeNotRequired
 
 /// LanguageVersion management
 type LanguageVersion =

src/Compiler/TypedTree/TypedTreeOps.fs

@@ -10410,4 +10410,22 @@ let (|EmptyModuleOrNamespaces|_|) (moduleOrNamespaceContents: ModuleOrNamespaceC
             Some emptyModuleOrNamespaces
         else
             None
-    | _ -> None
+    | _ -> None
+
+let tryAddExtensionAttributeIfNotAlreadyPresent
+    (tryFindExtensionAttributeIn: (Attrib list -> Attrib option) -> Attrib option)
+    (entity: 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
+    else
+        match tryFindExtensionAttributeIn tryFindExtensionAttribute with
+        | None -> entity
+        | Some extensionAttrib -> { entity with entity_attribs = extensionAttrib :: entity.Attribs }

src/Compiler/TypedTree/TypedTreeOps.fsi

@@ -2687,3 +2687,7 @@ type TraitConstraintInfo with
 /// This will match anything that does not have any types or bindings.
 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

src/Compiler/xlf/FSComp.txt.cs.xlf

@@ -152,6 +152,11 @@
         <target state="translated">automatické generování vlastnosti Message pro deklarace exception</target>
         <note />
       </trans-unit>
+      <trans-unit id="featureCSharpExtensionAttributeNotRequired">
+        <source>Allow implicit Extension attribute on declaring types, modules</source>
+        <target state="new">Allow implicit Extension attribute on declaring types, modules</target>
+        <note />
+      </trans-unit>
       <trans-unit id="featureDefaultInterfaceMemberConsumption">
         <source>default interface member consumption</source>
         <target state="translated">využití člena výchozího rozhraní</target>