Removed ICompilationThread and added TypeProviderLock singleton

Author: TIHan

src/absil/illib.fs

@@ -653,15 +653,6 @@ type Lock<'LockTokenType when 'LockTokenType :> LockToken>() =
 //---------------------------------------------------
 // Misc
 
-/// The thread in which compilation calls will be enqueued and done work on.
-type internal ICompilationThread =
-
-    /// Enqueue work to be done on a compilation thread.
-    abstract EnqueueWork: (CompilationThreadToken -> unit) -> unit
-
-    /// Enqueue work to be done on a compilation thread.
-    abstract EnqueueWorkAndWait: (CompilationThreadToken -> 'T) -> 'T
-
 /// Get an initialization hole 
 let getHole r = match !r with None -> failwith "getHole" | Some x -> x
 

src/fsharp/CompilerConfig.fs

@@ -434,7 +434,6 @@ type TcConfigBuilder =
       /// show messages about extension type resolution?
       mutable showExtensionTypeMessages: bool
 #endif
-      mutable compilationThread: ICompilationThread
 
       /// pause between passes? 
       mutable pause: bool
@@ -595,11 +594,6 @@ type TcConfigBuilder =
 #if !NO_EXTENSIONTYPING
           showExtensionTypeMessages = false
 #endif
-          compilationThread = 
-                let ctok = CompilationThreadToken ()
-                { new ICompilationThread with 
-                    member _.EnqueueWork work = work ctok
-                    member _.EnqueueWorkAndWait work = work ctok }
           pause = false 
           alwaysCallVirt = true
           noDebugData = false
@@ -994,7 +988,6 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) =
 #if !NO_EXTENSIONTYPING
     member x.showExtensionTypeMessages = data.showExtensionTypeMessages
 #endif
-    member x.compilationThread = data.compilationThread
     member x.pause = data.pause
     member x.alwaysCallVirt = data.alwaysCallVirt
     member x.noDebugData = data.noDebugData

src/fsharp/CompilerConfig.fsi

@@ -243,7 +243,6 @@ type TcConfigBuilder =
 #if !NO_EXTENSIONTYPING
       mutable showExtensionTypeMessages: bool
 #endif
-      mutable compilationThread: ICompilationThread
       mutable pause: bool 
       mutable alwaysCallVirt: bool
       mutable noDebugData: bool
@@ -421,7 +420,6 @@ type TcConfig =
 #if !NO_EXTENSIONTYPING
     member showExtensionTypeMessages: bool
 #endif
-    member compilationThread: ICompilationThread
     member pause: bool 
     member alwaysCallVirt: bool
     member noDebugData: bool

src/fsharp/CompilerImports.fs

@@ -695,9 +695,9 @@ type RawFSharpAssemblyDataBackedByFileOnDisk (ilModule: ILModuleDef, ilAssemblyR
 type TcImportsSafeDisposal
     (disposeActions: ResizeArray<unit -> unit>,
 #if !NO_EXTENSIONTYPING
-     disposeTypeProviderActions: ResizeArray<unit -> unit>,
+     disposeTypeProviderActions: ResizeArray<unit -> unit>
 #endif
-     compilationThread: ICompilationThread) =
+    ) =
 
     let mutable isDisposed = false
 
@@ -707,9 +707,11 @@ type TcImportsSafeDisposal
         if verbose then 
             dprintf "disposing of TcImports, %d binaries\n" disposeActions.Count
 #if !NO_EXTENSIONTYPING
-        let actions = disposeTypeProviderActions
-        if actions.Count > 0 then
-            compilationThread.EnqueueWork (fun _ -> for action in actions do action())
+        async {
+            let actions = disposeTypeProviderActions
+            if actions.Count > 0 then
+                TypeProviderLock.Singleton.AcquireLock(fun _ -> for action in actions do action())
+        } |> Async.Start // Make this async so we do not block dispose
 #endif
         for action in disposeActions do action()
 
@@ -760,8 +762,7 @@ and TcImportsWeakHack (tcImports: WeakReference<TcImports>) =
 /// Is a disposable object, but it is recommended not to explicitly call Dispose unless you absolutely know nothing will be using its contents after the disposal.
 /// Otherwise, simply allow the GC to collect this and it will properly call Dispose from the finalizer.
 and [<Sealed>] TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAssemblyResolutions, importsBase: TcImports option,
-                         ilGlobalsOpt, compilationThread: ICompilationThread, 
-                         dependencyProviderOpt: DependencyProvider option) as this = 
+                         ilGlobalsOpt, dependencyProviderOpt: DependencyProvider option) as this = 
 
     let mutable resolutions = initialResolutions
     let mutable importsBase: TcImports option = importsBase
@@ -786,7 +787,7 @@ and [<Sealed>] TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAsse
     let mutable tcImportsWeak = TcImportsWeakHack (WeakReference<_> this)
 #endif
 
-    let disposal = new TcImportsSafeDisposal(disposeActions, disposeTypeProviderActions, compilationThread)
+    let disposal = new TcImportsSafeDisposal(disposeActions, disposeTypeProviderActions)
 
     let CheckDisposed() =
         if disposed then assert false
@@ -1227,8 +1228,7 @@ and [<Sealed>] TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAsse
                    outputFile = tcConfig.outputFile
                    showResolutionMessages = tcConfig.showExtensionTypeMessages 
                    referencedAssemblies = Array.distinct [| for r in tcImportsStrong.AllAssemblyResolutions() -> r.resolvedPath |]
-                   temporaryFolder = FileSystem.GetTempPathShim()
-                   compilationThread = tcConfig.compilationThread }
+                   temporaryFolder = FileSystem.GetTempPathShim() }
 
             // The type provider should not hold strong references to disposed
             // TcImport objects. So the callbacks provided in the type provider config
@@ -1668,7 +1668,7 @@ and [<Sealed>] TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAsse
         let tcResolutions = TcAssemblyResolutions.BuildFromPriorResolutions(ctok, tcConfig, frameworkDLLs, [])
         let tcAltResolutions = TcAssemblyResolutions.BuildFromPriorResolutions(ctok, tcConfig, nonFrameworkDLLs, [])
 
-        let frameworkTcImports = new TcImports(tcConfigP, tcResolutions, None, None, tcConfig.compilationThread, None) 
+        let frameworkTcImports = new TcImports(tcConfigP, tcResolutions, None, None, None) 
 
         // Fetch the primaryAssembly from the referenced assemblies otherwise 
         let primaryAssemblyReference =
@@ -1802,7 +1802,7 @@ and [<Sealed>] TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAsse
         let tcConfig = tcConfigP.Get ctok
         let tcResolutions = TcAssemblyResolutions.BuildFromPriorResolutions(ctok, tcConfig, nonFrameworkReferences, knownUnresolved)
         let references = tcResolutions.GetAssemblyResolutions()
-        let tcImports = new TcImports(tcConfigP, tcResolutions, Some baseTcImports, Some tcGlobals.ilg, tcConfig.compilationThread, Some dependencyProvider)
+        let tcImports = new TcImports(tcConfigP, tcResolutions, Some baseTcImports, Some tcGlobals.ilg, Some dependencyProvider)
         let! _assemblies = tcImports.RegisterAndImportReferencedAssemblies(ctok, references)
         tcImports.ReportUnresolvedAssemblyReferences knownUnresolved
         return tcImports

src/fsharp/ExtensionTyping.fs

@@ -31,8 +31,7 @@ module internal ExtensionTyping =
           outputFile                : string option
           showResolutionMessages    : bool
           referencedAssemblies      : string[]
-          temporaryFolder           : string
-          compilationThread         : ICompilationThread }
+          temporaryFolder           : string }
 
     /// Load a the design-time part of a type-provider into the host process, and look for types
     /// marked with the TypeProviderAttribute attribute.
@@ -98,7 +97,7 @@ module internal ExtensionTyping =
         // reporting errors.
         let protect f =
             try 
-                resolutionEnvironment.compilationThread.EnqueueWorkAndWait(fun _ -> f ())
+                TypeProviderLock.Singleton.AcquireLock(fun _ -> f ())
             with err ->
                 let e = StripException (StripException err)
                 raise (TypeProviderError(FSComp.SR.etTypeProviderConstructorException(e.Message), typeProviderImplementationType.FullName, m))
@@ -172,7 +171,7 @@ module internal ExtensionTyping =
                     tpe.Iter(fun e -> errorR(NumberedError((e.Number, e.ContextualErrorMessage), m)) )
                     []
 
-        let providers = Tainted<_>.CreateAll(providerSpecs, resolutionEnvironment.compilationThread)
+        let providers = Tainted<_>.CreateAll(providerSpecs)
 
         providers
 

src/fsharp/ExtensionTyping.fsi

@@ -42,9 +42,6 @@ module internal ExtensionTyping =
 
         /// The folder for temporary files
         temporaryFolder             : string
-
-        /// The compilation thread
-        compilationThread           : ICompilationThread
       }
 
     /// Find and instantiate the set of ITypeProvider components for the given assembly reference

src/fsharp/service/IncrementalBuild.fs

@@ -2085,20 +2085,6 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput
                 // Never open PDB files for the language service, even if --standalone is specified
                 tcConfigB.openDebugInformationForLaterStaticLinking <- false
 
-                tcConfigB.compilationThread <- 
-                    { new ICompilationThread with 
-                        member __.EnqueueWork work = 
-                            Reactor.Singleton.EnqueueOp ("Unknown", "ICompilationThread.EnqueueWork", "work", fun ctok ->
-                                work ctok
-                            )
-                        member __.EnqueueWorkAndWait work =
-                            Reactor.Singleton.ExecuteOrEnqueueAndAwaitOpAsync("Unknown", "ICompilationThread.EnqueueWorkAndWait", "work", fun ctok ->
-                                cancellable {
-                                    return work ctok
-                                }
-                            ) |> Async.RunSynchronously
-                    }
-
                 tcConfigB, sourceFilesNew
 
             match loadClosureOpt with

src/fsharp/tainted.fs

@@ -10,6 +10,15 @@ open Microsoft.FSharp.Core.CompilerServices
 open FSharp.Compiler.AbstractIL.IL
 open FSharp.Compiler.AbstractIL.Internal.Library 
 
+[<Sealed>]
+type internal TypeProviderToken() = interface LockToken
+
+[<Sealed>]
+type internal TypeProviderLock() =
+    inherit Lock<TypeProviderToken>()
+
+    static member val Singleton = TypeProviderLock()
+
 type internal TypeProviderError
     (
         errNum : int,
@@ -69,7 +78,7 @@ type internal TypeProviderError
             for msg in errors do
                 f (new TypeProviderError(errNum, tpDesignation, m, [msg], typeNameContext, methodNameContext))
 
-type TaintedContext = { TypeProvider : ITypeProvider; TypeProviderAssemblyRef : ILScopeRef; CompilationThread: ICompilationThread }
+type TaintedContext = { TypeProvider : ITypeProvider; TypeProviderAssemblyRef : ILScopeRef }
 
 [<NoEquality>][<NoComparison>] 
 type internal Tainted<'T> (context : TaintedContext, value : 'T) =
@@ -88,7 +97,7 @@ type internal Tainted<'T> (context : TaintedContext, value : 'T) =
 
     member this.Protect f  (range:range) =
         try 
-            context.CompilationThread.EnqueueWorkAndWait (fun _ -> f value)
+            TypeProviderLock.Singleton.AcquireLock(fun _ -> f value)
         with
             |   :? TypeProviderError -> reraise()
             |   :? AggregateException as ae ->
@@ -141,9 +150,9 @@ type internal Tainted<'T> (context : TaintedContext, value : 'T) =
     /// Access the target object directly. Use with extreme caution.
     member this.AccessObjectDirectly = value
 
-    static member CreateAll(providerSpecs : (ITypeProvider * ILScopeRef) list, compilationThread) =
+    static member CreateAll(providerSpecs : (ITypeProvider * ILScopeRef) list) =
         [for (tp,nm) in providerSpecs do
-             yield Tainted<_>({ TypeProvider=tp; TypeProviderAssemblyRef=nm; CompilationThread=compilationThread },tp) ] 
+             yield Tainted<_>({ TypeProvider=tp; TypeProviderAssemblyRef=nm },tp) ] 
 
     member this.OfType<'U> () =
         match box value with

src/fsharp/tainted.fsi

@@ -12,6 +12,16 @@ open FSharp.Compiler.Range
 open FSharp.Compiler.AbstractIL.IL
 open FSharp.Compiler.AbstractIL.Internal.Library
 
+[<Sealed>]
+type internal TypeProviderToken = 
+    interface LockToken
+
+[<Sealed;Class>]
+type internal TypeProviderLock =
+    inherit Lock<TypeProviderToken>
+
+    static member Singleton : TypeProviderLock
+
 /// Stores and transports aggregated list of errors reported by the type provider
 type internal TypeProviderError =
     inherit System.Exception
@@ -43,7 +53,7 @@ type internal TypeProviderError =
 type internal Tainted<'T> =
 
     /// Create an initial tainted value
-    static member CreateAll : (ITypeProvider * ILScopeRef) list * ICompilationThread -> Tainted<ITypeProvider> list
+    static member CreateAll : (ITypeProvider * ILScopeRef) list -> Tainted<ITypeProvider> list
 
     /// A type provider that produced the value
     member TypeProvider : Tainted<ITypeProvider>