diff --git a/src/fsharp/CompilerConfig.fs b/src/fsharp/CompilerConfig.fs index 060d3f864cc..3fe67f47a53 100644 --- a/src/fsharp/CompilerConfig.fs +++ b/src/fsharp/CompilerConfig.fs @@ -238,14 +238,6 @@ type UnresolvedAssemblyReference = UnresolvedAssemblyReference of string * Assem type ResolvedExtensionReference = ResolvedExtensionReference of string * AssemblyReference list * Tainted list #endif -/// The thread in which compilation calls will be enqueued and done work on. -/// Note: This is currently only used when disposing of type providers and will be extended to all the other type provider calls when compilations can be done in parallel. -/// Right now all calls in FCS to type providers are single-threaded through use of the reactor thread. -type ICompilationThread = - - /// Enqueue work to be done on a compilation thread. - abstract EnqueueWork: (CompilationThreadToken -> unit) -> unit - type ImportedAssembly = { ILScopeRef: ILScopeRef FSharpViewOfMetadata: CcuThunk @@ -442,7 +434,6 @@ type TcConfigBuilder = /// show messages about extension type resolution? mutable showExtensionTypeMessages: bool #endif - mutable compilationThread: ICompilationThread /// pause between passes? mutable pause: bool @@ -603,9 +594,6 @@ type TcConfigBuilder = #if !NO_EXTENSIONTYPING showExtensionTypeMessages = false #endif - compilationThread = - let ctok = CompilationThreadToken () - { new ICompilationThread with member __.EnqueueWork work = work ctok } pause = false alwaysCallVirt = true noDebugData = false @@ -1000,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 diff --git a/src/fsharp/CompilerConfig.fsi b/src/fsharp/CompilerConfig.fsi index 00e824b4054..a7f2d9d70df 100644 --- a/src/fsharp/CompilerConfig.fsi +++ b/src/fsharp/CompilerConfig.fsi @@ -92,14 +92,6 @@ type AssemblyReference = type UnresolvedAssemblyReference = UnresolvedAssemblyReference of string * AssemblyReference list -/// The thread in which compilation calls will be enqueued and done work on. -/// Note: This is currently only used when disposing of type providers and will be extended to all the other type provider calls when compilations can be done in parallel. -/// Right now all calls in FCS to type providers are single-threaded through use of the reactor thread. -type ICompilationThread = - - /// Enqueue work to be done on a compilation thread. - abstract EnqueueWork: (CompilationThreadToken -> unit) -> unit - [] type CompilerTarget = | WinExe @@ -251,7 +243,6 @@ type TcConfigBuilder = #if !NO_EXTENSIONTYPING mutable showExtensionTypeMessages: bool #endif - mutable compilationThread: ICompilationThread mutable pause: bool mutable alwaysCallVirt: bool mutable noDebugData: bool @@ -429,7 +420,6 @@ type TcConfig = #if !NO_EXTENSIONTYPING member showExtensionTypeMessages: bool #endif - member compilationThread: ICompilationThread member pause: bool member alwaysCallVirt: bool member noDebugData: bool diff --git a/src/fsharp/CompilerImports.fs b/src/fsharp/CompilerImports.fs index b54914696de..ea9fcc7c2c0 100644 --- a/src/fsharp/CompilerImports.fs +++ b/src/fsharp/CompilerImports.fs @@ -695,9 +695,9 @@ type RawFSharpAssemblyDataBackedByFileOnDisk (ilModule: ILModuleDef, ilAssemblyR type TcImportsSafeDisposal (disposeActions: ResizeArray unit>, #if !NO_EXTENSIONTYPING - disposeTypeProviderActions: ResizeArray unit>, + disposeTypeProviderActions: ResizeArray unit> #endif - compilationThread: ICompilationThread) = + ) = let mutable isDisposed = false @@ -707,9 +707,7 @@ 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()) + for action in disposeTypeProviderActions do action() #endif for action in disposeActions do action() @@ -760,8 +758,7 @@ and TcImportsWeakHack (tcImports: WeakReference) = /// 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 [] 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 +783,7 @@ and [] 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 @@ -1257,7 +1254,7 @@ and [] TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAsse for provider in providers do tcImportsStrong.AttachDisposeTypeProviderAction(fun () -> try - provider.PUntaintNoFailure(fun x -> x).Dispose() + provider.PUntaintNoFailure(fun x -> x.Dispose()) with e -> ()) @@ -1667,7 +1664,7 @@ and [] 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 = @@ -1801,7 +1798,7 @@ and [] 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 diff --git a/src/fsharp/ExtensionTyping.fs b/src/fsharp/ExtensionTyping.fs index 9a064ae17a0..215612e8e09 100644 --- a/src/fsharp/ExtensionTyping.fs +++ b/src/fsharp/ExtensionTyping.fs @@ -171,7 +171,7 @@ module internal ExtensionTyping = tpe.Iter(fun e -> errorR(NumberedError((e.Number, e.ContextualErrorMessage), m)) ) [] - let providers = Tainted<_>.CreateAll providerSpecs + let providers = Tainted<_>.CreateAll(providerSpecs) providers diff --git a/src/fsharp/service/IncrementalBuild.fs b/src/fsharp/service/IncrementalBuild.fs index ad7ae10b31b..68020be8df4 100755 --- a/src/fsharp/service/IncrementalBuild.fs +++ b/src/fsharp/service/IncrementalBuild.fs @@ -2085,14 +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 - ) - } - tcConfigB, sourceFilesNew match loadClosureOpt with diff --git a/src/fsharp/service/Reactor.fs b/src/fsharp/service/Reactor.fs index 5eeb29fe667..29cf0c9678b 100755 --- a/src/fsharp/service/Reactor.fs +++ b/src/fsharp/service/Reactor.fs @@ -42,6 +42,7 @@ type Reactor() = let mutable culture = CultureInfo(CultureInfo.CurrentUICulture.Name) let mutable bgOpCts = new CancellationTokenSource() + /// Mailbox dispatch function. let builder = MailboxProcessor<_>.Start <| fun inbox -> @@ -196,6 +197,7 @@ type Reactor() = ) return! resultCell.AsyncResult } + member __.PauseBeforeBackgroundWork with get() = pauseBeforeBackgroundWork and set v = pauseBeforeBackgroundWork <- v static member Singleton = theReactor diff --git a/src/fsharp/tainted.fs b/src/fsharp/tainted.fs index 15d2378b3fb..be352384b57 100644 --- a/src/fsharp/tainted.fs +++ b/src/fsharp/tainted.fs @@ -10,6 +10,13 @@ open Microsoft.FSharp.Core.CompilerServices open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AbstractIL.Internal.Library +[] +type internal TypeProviderToken() = interface LockToken + +[] +type internal TypeProviderLock() = + inherit Lock() + type internal TypeProviderError ( errNum : int, @@ -69,7 +76,7 @@ type internal TypeProviderError for msg in errors do f (new TypeProviderError(errNum, tpDesignation, m, [msg], typeNameContext, methodNameContext)) -type TaintedContext = { TypeProvider : ITypeProvider; TypeProviderAssemblyRef : ILScopeRef } +type TaintedContext = { TypeProvider : ITypeProvider; TypeProviderAssemblyRef : ILScopeRef; Lock: TypeProviderLock } [][] type internal Tainted<'T> (context : TaintedContext, value : 'T) = @@ -88,7 +95,7 @@ type internal Tainted<'T> (context : TaintedContext, value : 'T) = member this.Protect f (range:range) = try - f value + context.Lock.AcquireLock(fun _ -> f value) with | :? TypeProviderError -> reraise() | :? AggregateException as ae -> @@ -143,7 +150,7 @@ type internal Tainted<'T> (context : TaintedContext, value : 'T) = static member CreateAll(providerSpecs : (ITypeProvider * ILScopeRef) list) = [for (tp,nm) in providerSpecs do - yield Tainted<_>({ TypeProvider=tp; TypeProviderAssemblyRef=nm },tp) ] + yield Tainted<_>({ TypeProvider=tp; TypeProviderAssemblyRef=nm; Lock=TypeProviderLock() },tp) ] member this.OfType<'U> () = match box value with diff --git a/src/fsharp/tainted.fsi b/src/fsharp/tainted.fsi index c5220feb6cf..9b1e8cb2198 100644 --- a/src/fsharp/tainted.fsi +++ b/src/fsharp/tainted.fsi @@ -10,6 +10,15 @@ open System.Reflection open Microsoft.FSharp.Core.CompilerServices open FSharp.Compiler.Range open FSharp.Compiler.AbstractIL.IL +open FSharp.Compiler.AbstractIL.Internal.Library + +[] +type internal TypeProviderToken = + interface LockToken + +[] +type internal TypeProviderLock = + inherit Lock /// Stores and transports aggregated list of errors reported by the type provider type internal TypeProviderError =