Intern provided namespaces to fix parallel-compilation resolution race

docs/release-notes/.FSharp.Compiler.Service/11.0.100.md

@@ -3,6 +3,7 @@
 * Restore packaging of an F# design-time type provider that is activated via a `ProjectReference` carrying `IsFSharpDesignTimeProvider="true"`. The provider assembly is again included under `fsharp41` when packing (including `pack --no-build`); `PackageFSharpDesignTimeTools` now resolves the provider via `GetTargetPath`, which works in `dotnet pack`'s `BuildProjectReferences=false` content build without forcing an early `ResolveReferences`. ([Issue #18924](https://github.com/dotnet/fsharp/issues/18924), [PR #19979](https://github.com/dotnet/fsharp/pull/19979))
 * Provided types used from multiple files no longer produce spurious FS0001 type mismatches under parallel compilation; provided-type entities are now interned so every file linking a given provided type shares one entity. ([PR #19969](https://github.com/dotnet/fsharp/pull/19969))
 * TypeProviders-SDK providers now load under an unoptimized compiler; the `systemRuntimeContainsType` closure field the SDK reflects on (`tcImports`) is captured stably regardless of optimization settings. ([PR #19969](https://github.com/dotnet/fsharp/pull/19969))
+* Provided namespaces are now interned and appended atomically alongside provided types, completing the #19969 fix: under parallel compilation two files linking the same provided namespace no longer build disjoint subtrees that strand the provided types under them (spurious FS0001/FS0039). ([Issue #20020](https://github.com/dotnet/fsharp/issues/20020), [PR #20021](https://github.com/dotnet/fsharp/pull/20021))
 * Fixed: Inheriting from an undefined type now reports `FS0039` exactly once instead of three times. Phase 1F and Phase 2A of inherit-clause type-checking now skip re-resolving a syntactic clause whose Phase 1D resolution already failed with `UndefinedName`, eliminating both the duplicate diagnostic and the redundant work. ([Issue #16432](https://github.com/dotnet/fsharp/issues/16432), [PR #19862](https://github.com/dotnet/fsharp/pull/19862))
 * Fix several F# editor semantic-classification errors: F# delegate declarations no longer highlight the `delegate of …` syntax as a method, computation-expression builders inside list/array comprehensions are classified as `ComputationExpression`, the closing `]` of an open-ended slice (e.g. `xs[0..]`) is no longer classified as `Function`/`Method`, and `open type T` is no longer reported as unused when its imported members (static members, static fields, or DU union cases) are used. ([Issue #19905](https://github.com/dotnet/fsharp/issues/19905), [PR #19960](https://github.com/dotnet/fsharp/pull/19960))
 * Diagnostic FS0027 now emits a parameter-specific message (suggesting a `let mutable x = x` shadow or `byref<_>`) instead of the illegal `let mutable x = expression` shadow when the assignment target is a function or method parameter. ([Issue #15803](https://github.com/dotnet/fsharp/issues/15803), [PR #19866](https://github.com/dotnet/fsharp/pull/19866))

src/Compiler/CodeGen/IlxGen.fs

@@ -2445,10 +2445,8 @@ type AnonTypeGenerationTable() =
         let isStruct = evalAnonInfoIsStruct anonInfo
         let key = anonInfo.Stamp
 
-        let at =
-            dict.GetOrAdd(key, lazy (generateAnonType cenv mgbuf genToStringMethod (isStruct, anonInfo.ILTypeRef, anonInfo.SortedNames)))
-
-        at.Force() |> ignore
+        dict.GetOrAddLazy(key, fun _ -> generateAnonType cenv mgbuf genToStringMethod (isStruct, anonInfo.ILTypeRef, anonInfo.SortedNames))
+        |> ignore
 
     member this.LookupAnonType(cenv, mgbuf, genToStringMethod, anonInfo: AnonRecdTypeInfo) =
         match dict.TryGetValue anonInfo.Stamp with

src/Compiler/Driver/CompilerImports.fs

@@ -1746,47 +1746,36 @@ and [<Sealed>] TcImports
         match remainingNamespace with
         | next :: rest ->
             // Inject the namespace entity
-            match entity.ModuleOrNamespaceType.ModulesAndNamespacesByDemangledName.TryFind next with
-            | Some childEntity ->
-                tcImports.InjectProvidedNamespaceOrTypeIntoEntity(
-                    typeProviderEnvironment,
-                    tcConfig,
-                    m,
-                    childEntity,
-                    next :: injectedNamespace,
-                    rest,
-                    provider,
-                    st
-                )
-            | None ->
-                // Build up the artificial namespace if there is not a real one.
-                let cpath =
-                    CompPath(
-                        ILScopeRef.Local,
-                        SyntaxAccess.Unknown,
-                        injectedNamespace
-                        |> List.rev
-                        |> List.map (fun n -> (n, ModuleOrNamespaceKind.Namespace true))
-                    )
-
-                let mid = ident (next, rangeStartup)
-                let mty = Construct.NewEmptyModuleOrNamespaceType(Namespace true)
-
-                let newNamespace =
-                    Construct.NewModuleOrNamespace (Some cpath) taccessPublic mid XmlDoc.Empty [] (MaybeLazy.Strict mty)
+            let childEntity =
+                entity.ModuleOrNamespaceType.GetOrInternNamespaceEntity(
+                    next,
+                    (fun () ->
+                        // Build up the artificial namespace if there is not a real one.
+                        let cpath =
+                            CompPath(
+                                ILScopeRef.Local,
+                                SyntaxAccess.Unknown,
+                                injectedNamespace
+                                |> List.rev
+                                |> List.map (fun n -> (n, ModuleOrNamespaceKind.Namespace true))
+                            )
 
-                entity.ModuleOrNamespaceType.AddModuleOrNamespaceByMutation newNamespace
+                        let mid = ident (next, rangeStartup)
+                        let mty = Construct.NewEmptyModuleOrNamespaceType(Namespace true)
 
-                tcImports.InjectProvidedNamespaceOrTypeIntoEntity(
-                    typeProviderEnvironment,
-                    tcConfig,
-                    m,
-                    newNamespace,
-                    next :: injectedNamespace,
-                    rest,
-                    provider,
-                    st
+                        Construct.NewModuleOrNamespace (Some cpath) taccessPublic mid XmlDoc.Empty [] (MaybeLazy.Strict mty))
                 )
+
+            tcImports.InjectProvidedNamespaceOrTypeIntoEntity(
+                typeProviderEnvironment,
+                tcConfig,
+                m,
+                childEntity,
+                next :: injectedNamespace,
+                rest,
+                provider,
+                st
+            )
         | [] ->
             match st with
             | Some st ->

src/Compiler/Interactive/fsihelp.fs

@@ -14,6 +14,7 @@ module Parser =
 
     open System.Xml
     open System.Collections.Concurrent
+    open Internal.Utilities.Library
 
     type Help =
         {
@@ -82,16 +83,15 @@ module Parser =
     let xmlDocCache = ConcurrentDictionary<string, Lazy<XmlDocument>>()
 
     let tryGetXmlDocument xmlPath =
-        let valueFactory xmlPath =
-            lazy
-                use stream = FileSystem.OpenFileForReadShim(xmlPath)
-                let rawXml = stream.ReadAllText()
-                let xmlDocument = XmlDocument()
-                xmlDocument.LoadXml(rawXml)
-                xmlDocument
+        let load xmlPath =
+            use stream = FileSystem.OpenFileForReadShim(xmlPath)
+            let rawXml = stream.ReadAllText()
+            let xmlDocument = XmlDocument()
+            xmlDocument.LoadXml(rawXml)
+            xmlDocument
 
         try
-            Some(xmlDocCache.GetOrAdd(xmlPath, valueFactory).Value)
+            Some(xmlDocCache.GetOrAddLazy(xmlPath, load))
         with _ ->
             None
 

src/Compiler/TypedTree/CompilerGlobalState.fs

@@ -7,6 +7,7 @@ module FSharp.Compiler.CompilerGlobalState
 open System
 open System.Collections.Concurrent
 open System.Threading
+open Internal.Utilities.Library
 open FSharp.Compiler.Syntax.PrettyNaming
 open FSharp.Compiler.Text
 
@@ -60,10 +61,7 @@ type StableNiceNameGenerator() =
     member x.GetUniqueCompilerGeneratedName (name, m: range, uniq) =
         let basicName = GetBasicNameOfPossibleCompilerGeneratedName name
         let key = basicName, uniq
-        let lazyName =
-            niceNames.GetOrAdd(key, fun (basicName, _) ->
-                lazy innerGenerator.FreshCompilerGeneratedNameOfBasicName(basicName, m))
-        lazyName.Value
+        niceNames.GetOrAddLazy(key, fun (basicName, _) -> innerGenerator.FreshCompilerGeneratedNameOfBasicName(basicName, m))
 
 [<Sealed>]
 type PerFileNamingScope internal (nng: NiceNameGenerator, fileIndex: int) =

src/Compiler/TypedTree/TypedTree.fs

@@ -2024,7 +2024,7 @@ type ModuleOrNamespaceType(kind: ModuleOrNamespaceKind, vals: QueueList<Val>, en
     let mutable entities = entities 
 
 #if !NO_TYPEPROVIDERS
-    // One Entity per provided type even when linked concurrently from several files (graph-based checking).
+    // One Entity per provided type or namespace even when linked concurrently from several files (graph-based checking).
     let mutable providedEntitiesByMangledName: ConcurrentDictionary<string, Lazy<Entity>> | null = null
 #endif
 
@@ -2041,12 +2041,12 @@ type ModuleOrNamespaceType(kind: ModuleOrNamespaceKind, vals: QueueList<Val>, en
     // We should probably change to 'mutable'.
     //
     // We do not need to lock most of this mutable state since it is only ever accessed from the compiler thread.
-    // The exception is the four lookup tables invalidated by mutating 'entities' (provided-type linking can run
-    // on several graph-based-checking threads): those are read through 'cacheOptByrefByVersion' tagged with
-    // 'entitiesVersion', which stays coherent under concurrent appends without any lock.
+    // The exception is the lookup tables invalidated by mutating 'entities' (provided-type and provided-namespace
+    // linking can run on several graph-based-checking threads): those are read through 'cacheOptByrefByVersion'
+    // tagged with 'entitiesVersion', which stays coherent under concurrent appends without any lock.
     let activePatternElemRefCache: NameMap<ActivePatternElemRef> option ref = ref None
 
-    let mutable modulesByDemangledNameCache: NameMap<ModuleOrNamespace> option = None
+    let mutable modulesByDemangledNameCache: (int * NameMap<ModuleOrNamespace>) option = None
 
     let mutable exconsByDemangledNameCache: NameMap<Tycon> option = None
 
@@ -2074,20 +2074,9 @@ type ModuleOrNamespaceType(kind: ModuleOrNamespaceKind, vals: QueueList<Val>, en
     ////     "FooException" --> Tycon with exception info
     member _.AllEntities = entities
 
-    /// Mutation used during compilation of FSharp.Core.dll
-    member _.AddModuleOrNamespaceByMutation(modul: ModuleOrNamespace) =
-        entities <- QueueList.appendOne entities modul
-        modulesByDemangledNameCache <- None          
-        allEntitiesByMangledNameCache <- None       
-        System.Threading.Interlocked.Increment(&entitiesVersion) |> ignore
-
-#if !NO_TYPEPROVIDERS
-    /// Mutation used in hosting scenarios to hold the hosted types in this module or namespace
-    member _.AddProvidedTypeEntity(entity: Entity) = 
-        // Several graph-based-checking threads may link provided types into this module at once, so append
-        // atomically with a CAS loop. Bump 'entitiesVersion' last (release): a reader observing the new version
-        // is guaranteed to also see 'entity' in 'entities', so the version-stamped lookup caches recompute and
-        // never strand a table missing it. The caches need no explicit invalidation - the version bump does it.
+    /// Append 'entity', then publish 'entitiesVersion' last (release) so a reader seeing the new version also sees
+    /// 'entity' in 'entities' - the version-stamped lookup caches recompute rather than strand it.
+    member private _.AppendEntityByMutation(entity: Entity) =
         let rec append () =
             let current = entities
             let updated = QueueList.appendOne current entity
@@ -2096,17 +2085,39 @@ type ModuleOrNamespaceType(kind: ModuleOrNamespaceKind, vals: QueueList<Val>, en
         append ()
         System.Threading.Interlocked.Increment(&entitiesVersion) |> ignore
 
+    /// Mutation used during compilation of FSharp.Core.dll
+    member mtyp.AddModuleOrNamespaceByMutation(modul: ModuleOrNamespace) =
+        mtyp.AppendEntityByMutation modul
+
+#if !NO_TYPEPROVIDERS
+    /// Mutation used in hosting scenarios to hold the hosted types in this module or namespace
+    member mtyp.AddProvidedTypeEntity(entity: Entity) =
+        mtyp.AppendEntityByMutation entity
+
+    member private _.ProvidedEntityInternTable =
+        match providedEntitiesByMangledName with
+        | null ->
+            let created = ConcurrentDictionary<string, Lazy<Entity>>()
+            match System.Threading.Interlocked.CompareExchange(&providedEntitiesByMangledName, created, null) with
+            | null -> created
+            | existing -> existing
+        | existing -> existing
+
     /// Interns a provided-type entity by mangled name; callers must use the returned entity.
     member mtyp.GetOrInternProvidedEntity(mangledName: string, create: unit -> Entity) : Entity =
-        let table =
-            match providedEntitiesByMangledName with
-            | null ->
-                let created = ConcurrentDictionary<string, Lazy<Entity>>()
-                match System.Threading.Interlocked.CompareExchange(&providedEntitiesByMangledName, created, null) with
-                | null -> created
-                | existing -> existing
-            | existing -> existing
-        table.GetOrAdd(mangledName, fun _ -> lazy (let entity = create () in mtyp.AddProvidedTypeEntity entity; entity)).Value
+        mtyp.ProvidedEntityInternTable.GetOrAddLazy(mangledName, fun _ -> let entity = create () in mtyp.AddProvidedTypeEntity entity; entity)
+
+    /// Interns a provided-namespace entity by mangled name, reusing any existing entity of that name; callers must use the returned entity.
+    member mtyp.GetOrInternNamespaceEntity(mangledName: string, create: unit -> Entity) : Entity =
+        mtyp.ProvidedEntityInternTable.GetOrAddLazy(
+            mangledName,
+            fun _ ->
+                match (mtyp.ModulesAndNamespacesByDemangledName: NameMap<ModuleOrNamespace>).TryFind mangledName with
+                | Some existing -> existing
+                | None ->
+                    let entity = create ()
+                    mtyp.AddModuleOrNamespaceByMutation entity
+                    entity)
 #endif 
 
     /// Return a new module or namespace type with an entity added.
@@ -2226,7 +2237,8 @@ type ModuleOrNamespaceType(kind: ModuleOrNamespaceKind, vals: QueueList<Val>, en
             if entity.IsModuleOrNamespace then 
                 NameMap.add entity.DemangledModuleOrNamespaceName entity acc
             else acc
-        cacheOptByref &modulesByDemangledNameCache (fun () -> 
+        let version = System.Threading.Volatile.Read(&entitiesVersion)
+        cacheOptByrefByVersion version &modulesByDemangledNameCache (fun () -> 
             QueueList.foldBack add entities Map.empty)
 
     [<DebuggerBrowsable(DebuggerBrowsableState.Never)>]
@@ -3615,13 +3627,15 @@ type NonLocalEntityRef =
                                 path[j],
                                 (fun () -> Construct.NewProvidedTycon(resolutionEnvironment, st, ccu.ImportProvidedType, false, m)))
                         else
-                            let cpath = entity.CompilationPath.NestedCompPath entity.LogicalName (ModuleOrNamespaceKind.Namespace false)
-                            let newEntity = 
-                                Construct.NewModuleOrNamespace 
-                                    (Some cpath) 
-                                    (TAccess []) (ident(path[k], m)) XmlDoc.Empty [] 
-                                    (MaybeLazy.Strict (Construct.NewEmptyModuleOrNamespaceType (Namespace true))) 
-                            entity.ModuleOrNamespaceType.AddModuleOrNamespaceByMutation newEntity
+                            let newEntity =
+                                entity.ModuleOrNamespaceType.GetOrInternNamespaceEntity(
+                                    path[k],
+                                    (fun () ->
+                                        let cpath = entity.CompilationPath.NestedCompPath entity.LogicalName (ModuleOrNamespaceKind.Namespace false)
+                                        Construct.NewModuleOrNamespace 
+                                            (Some cpath) 
+                                            (TAccess []) (ident(path[k], m)) XmlDoc.Empty [] 
+                                            (MaybeLazy.Strict (Construct.NewEmptyModuleOrNamespaceType (Namespace true)))))
                             injectNamespacesFromIToJ newEntity (k+1)
                     let newEntity = injectNamespacesFromIToJ entity i
 

src/Compiler/TypedTree/TypedTree.fsi

@@ -1393,6 +1393,10 @@ type ModuleOrNamespaceType =
     /// Interns a provided-type entity by mangled name so concurrent linking from multiple files yields one
     /// Entity. The first caller's 'create' wins; callers must use the returned entity.
     member GetOrInternProvidedEntity: mangledName: string * create: (unit -> Entity) -> Entity
+
+    /// Interns a provided-namespace entity by mangled name, reusing any existing entity of that name so concurrent
+    /// linking yields one Entity. Callers must use the returned entity.
+    member GetOrInternNamespaceEntity: mangledName: string * create: (unit -> Entity) -> Entity
 #endif
 
     /// Return a new module or namespace type with a value added.

src/Compiler/Utilities/illib.fs

@@ -848,6 +848,13 @@ type DictionaryExtensions() =
         | true, values -> values |> List.exists f
         | _ -> false
 
+[<Extension>]
+type ConcurrentDictionaryExtensions() =
+
+    [<Extension>]
+    static member GetOrAddLazy(dic: ConcurrentDictionary<'key, Lazy<'value>>, key: 'key, factory: 'key -> 'value) =
+        dic.GetOrAdd(key, (fun k -> lazy factory k)).Value
+
 module Lazy =
     let force (x: Lazy<'T>) = x.Force()
 

src/Compiler/Utilities/illib.fsi

@@ -4,6 +4,7 @@ namespace Internal.Utilities.Library
 
 open System
 open System.Threading
+open System.Collections.Concurrent
 open System.Collections.Generic
 open System.Runtime.CompilerServices
 
@@ -297,6 +298,15 @@ type internal DictionaryExtensions =
     static member inline BagExistsValueForKey:
         dic: Dictionary<'key, 'value list> * key: 'key * f: ('value -> bool) -> bool
 
+[<Extension; Class>]
+type internal ConcurrentDictionaryExtensions =
+
+    /// GetOrAdd whose value is produced by 'factory' at most once per key and then cached. The value is held
+    /// behind a Lazy, so under contention every caller observes the same instance and 'factory' runs once per key.
+    [<Extension>]
+    static member GetOrAddLazy:
+        dic: ConcurrentDictionary<'key, Lazy<'value>> * key: 'key * factory: ('key -> 'value) -> 'value
+
 module internal Lazy =
     val force: x: Lazy<'T> -> 'T