diff --git a/src/fsharp/vs/Reactor.fs b/src/fsharp/vs/Reactor.fs index 96b5149e8c1..87c9c5fa449 100755 --- a/src/fsharp/vs/Reactor.fs +++ b/src/fsharp/vs/Reactor.fs @@ -19,7 +19,7 @@ type internal IReactorOperations = [] type internal ReactorCommands = /// Kick off a build. - | SetBackgroundOp of ( (* userOpName: *) string * (* opName: *) string * (* opArg: *) string * (CompilationThreadToken -> bool)) option + | SetBackgroundOp of ( (* userOpName: *) string * (* opName: *) string * (* opArg: *) string * (CompilationThreadToken -> CancellationToken -> bool)) option /// Do some work not synchronized in the mailbox. | Op of userOpName: string * opName: string * opArg: string * CancellationToken * (CompilationThreadToken -> unit) * (unit -> unit) /// Finish the background building @@ -39,6 +39,7 @@ type Reactor() = // so that when the reactor picks up a thread from the threadpool we can set the culture let culture = new CultureInfo(CultureInfo.CurrentUICulture.Name) + let mutable bgOpCts = new CancellationTokenSource() /// Mailbox dispatch function. let builder = MailboxProcessor<_>.Start <| fun inbox -> @@ -74,6 +75,7 @@ type Reactor() = | Some (SetBackgroundOp bgOpOpt) -> //Trace.TraceInformation("Reactor: --> set background op, remaining {0}", inbox.CurrentQueueLength) return! loop (bgOpOpt, onComplete, false) + | Some (Op (userOpName, opName, opArg, ct, op, ccont)) -> if ct.IsCancellationRequested then ccont() else Trace.TraceInformation("Reactor: {0:n3} --> {1}.{2} ({3}), remaining {4}", DateTime.Now.TimeOfDay.TotalSeconds, userOpName, opName, opArg, inbox.CurrentQueueLength) @@ -92,13 +94,21 @@ type Reactor() = | None -> () | Some (bgUserOpName, bgOpName, bgOpArg, bgOp) -> Trace.TraceInformation("Reactor: {0:n3} --> wait for background {1}.{2} ({3}), remaining {4}", DateTime.Now.TimeOfDay.TotalSeconds, bgUserOpName, bgOpName, bgOpArg, inbox.CurrentQueueLength) - while bgOp ctok do + bgOpCts.Dispose() + bgOpCts <- new CancellationTokenSource() + while not bgOpCts.IsCancellationRequested && bgOp ctok bgOpCts.Token do () + + if bgOpCts.IsCancellationRequested then + Trace.TraceInformation("FCS: <-- wait for background was cancelled {0}.{1}", bgUserOpName, bgOpName) + channel.Reply(()) return! loop (None, onComplete, false) + | Some (CompleteAllQueuedOps channel) -> Trace.TraceInformation("Reactor: {0:n3} --> stop background work and complete all queued ops, remaining {1}", DateTime.Now.TimeOfDay.TotalSeconds, inbox.CurrentQueueLength) return! loop (None, Some channel, false) + | None -> match bgOpOpt, onComplete with | _, Some onComplete -> onComplete.Reply() @@ -106,7 +116,11 @@ type Reactor() = Trace.TraceInformation("Reactor: {0:n3} --> background step {1}.{2} ({3})", DateTime.Now.TimeOfDay.TotalSeconds, bgUserOpName, bgOpName, bgOpArg) let time = Stopwatch() time.Start() - let res = bgOp ctok + bgOpCts.Dispose() + bgOpCts <- new CancellationTokenSource() + let res = bgOp ctok bgOpCts.Token + if bgOpCts.IsCancellationRequested then + Trace.TraceInformation("FCS: <-- background step {0}.{1}, was cancelled", bgUserOpName, bgOpName) time.Stop() let taken = time.Elapsed.TotalMilliseconds //if span.TotalMilliseconds > 100.0 then @@ -126,8 +140,13 @@ type Reactor() = // [Foreground Mailbox Accessors] ----------------------------------------------------------- member r.SetBackgroundOp(bgOpOpt) = Trace.TraceInformation("Reactor: {0:n3} enqueue start background, length {1}", DateTime.Now.TimeOfDay.TotalSeconds, builder.CurrentQueueLength) + bgOpCts.Cancel() builder.Post(SetBackgroundOp bgOpOpt) + member r.CancelBackgroundOp() = + Trace.TraceInformation("FCS: trying to cancel any active background work") + bgOpCts.Cancel() + member r.EnqueueOp(userOpName, opName, opArg, op) = Trace.TraceInformation("Reactor: {0:n3} enqueue {1}.{2} ({3}), length {4}", DateTime.Now.TimeOfDay.TotalSeconds, userOpName, opName, opArg, builder.CurrentQueueLength) builder.Post(Op(userOpName, opName, opArg, CancellationToken.None, op, (fun () -> ()))) diff --git a/src/fsharp/vs/Reactor.fsi b/src/fsharp/vs/Reactor.fsi index 12fee56b3f7..eadec3144b3 100755 --- a/src/fsharp/vs/Reactor.fsi +++ b/src/fsharp/vs/Reactor.fsi @@ -26,7 +26,10 @@ type internal Reactor = /// Set the background building function, which is called repeatedly /// until it returns 'false'. If None then no background operation is used. - member SetBackgroundOp : ( (* userOpName:*) string * (* opName: *) string * (* opArg: *) string * (CompilationThreadToken -> bool)) option -> unit + member SetBackgroundOp : ( (* userOpName:*) string * (* opName: *) string * (* opArg: *) string * (CompilationThreadToken -> CancellationToken -> bool)) option -> unit + + /// Cancel any work being don by the background building function. + member CancelBackgroundOp : unit -> unit /// Block until the current implicit background build is complete. Unit test only. member WaitForBackgroundOpCompletion : unit -> unit diff --git a/src/fsharp/vs/service.fs b/src/fsharp/vs/service.fs index 378ab842a7d..c4a85008920 100644 --- a/src/fsharp/vs/service.fs +++ b/src/fsharp/vs/service.fs @@ -1424,7 +1424,7 @@ module internal Parser = type TypeCheckAborted = Yes | No of TypeCheckInfo // Type check a single file against an initial context, gleaning both errors and intellisense information. - let TypeCheckOneFile + let CheckOneFile (parseResults: FSharpParseFileResults, source: string, mainInputFileName: string, @@ -1542,7 +1542,7 @@ module internal Parser = |> Eventually.repeatedlyProgressUntilDoneOrTimeShareOverOrCanceled maxTimeShareMilliseconds ct (fun ctok f -> f ctok) |> Eventually.forceAsync (fun work -> - reactorOps.EnqueueAndAwaitOpAsync(userOpName, "TypeCheckOneFile.Fragment", mainInputFileName, + reactorOps.EnqueueAndAwaitOpAsync(userOpName, "CheckOneFile.Fragment", mainInputFileName, fun ctok -> // This work is not cancellable let res = @@ -2102,7 +2102,7 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC /// creates an incremental builder used by the command line compiler. let CreateOneIncrementalBuilder (ctok, options:FSharpProjectOptions, userOpName) = cancellable { - + Trace.TraceInformation("FCS: {0}.{1} ({2})", userOpName, "CreateOneIncrementalBuilder", options.ProjectFileName) let projectReferences = [ for (nm,opts) in options.ReferencedProjects do @@ -2116,6 +2116,7 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC { new IProjectReference with member x.EvaluateRawContents(ctok) = cancellable { + Trace.TraceInformation("FCS: {0}.{1} ({2})", userOpName, "ParseAndCheckProjectImpl", nm) let! r = self.ParseAndCheckProjectImpl(opts, ctok, userOpName + ".CheckReferencedProject("+nm+")") return r.RawFSharpAssemblyData } @@ -2276,7 +2277,7 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC match cachedResults with | Some (parseResults, _checkResults,_,_) -> return parseResults | _ -> - Trace.TraceInformation("Reactor: {0}.{1} ({2})", userOpName, "ParseFileInProject.CacheMiss", filename) + Trace.TraceInformation("FCS: {0}.{1} ({2})", userOpName, "ParseFileInProject.CacheMiss", filename) foregroundParseCount <- foregroundParseCount + 1 let! builderOpt,creationErrors,decrement = getOrCreateBuilderAndKeepAlive (ctok, options, userOpName) use _unwind = decrement @@ -2352,7 +2353,7 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC /// 6. Starts whole project background compilation. /// /// 7. Releases the file "lock". - member private bc.CheckOneFile + member private bc.CheckOneFileImpl (parseResults: FSharpParseFileResults, source: string, fileName: string, @@ -2366,7 +2367,7 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC async { let beingCheckedFileKey = fileName, options, fileVersion - let stopwatch = Diagnostics.Stopwatch.StartNew() + let stopwatch = Stopwatch.StartNew() let rec loop() = async { // results may appear while we were waiting for the lock, let's recheck if it's the case @@ -2381,8 +2382,8 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC // For scripts, this will have been recorded by GetProjectOptionsFromScript. let loadClosure = scriptClosureCacheLock.AcquireLock (fun ltok -> scriptClosureCache.TryGet (ltok, options)) let! tcErrors, tcFileResult = - Parser.TypeCheckOneFile(parseResults, source, fileName, options.ProjectFileName, tcPrior.TcConfig, tcPrior.TcGlobals, tcPrior.TcImports, - tcPrior.TcState, loadClosure, tcPrior.Errors, reactorOps, (fun () -> builder.IsAlive), textSnapshotInfo, userOpName) + Parser.CheckOneFile(parseResults, source, fileName, options.ProjectFileName, tcPrior.TcConfig, tcPrior.TcGlobals, tcPrior.TcImports, + tcPrior.TcState, loadClosure, tcPrior.Errors, reactorOps, (fun () -> builder.IsAlive), textSnapshotInfo, userOpName) let checkAnswer = MakeCheckFileAnswer(fileName, tcFileResult, options, builder, tcPrior.TcDependencyFiles, creationErrors, parseResults.Errors, tcErrors) bc.RecordTypeCheckFileInProjectResults(fileName, options, parseResults, fileVersion, tcPrior.TimeStamp, Some checkAnswer, source) return checkAnswer @@ -2404,6 +2405,9 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC let execWithReactorAsync action = reactor.EnqueueAndAwaitOpAsync(userOpName, "CheckFileInProjectAllowingStaleCachedResults ", filename, action >> cancellable.Return) async { try + if implicitlyStartBackgroundWork then + reactor.CancelBackgroundOp() // cancel the background work, since we will start new work after we're done + let! cachedResults = execWithReactorAsync <| fun ctok -> match incrementalBuildersCache.TryGetAny (ctok, options) with @@ -2417,14 +2421,14 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC | None -> return None | Some (_, _, Some x) -> return Some x | Some (builder, creationErrors, None) -> - Trace.TraceInformation("Reactor: {0}.{1} ({2})", userOpName, "CheckFileInProjectAllowingStaleCachedResults.CacheMiss", filename) + Trace.TraceInformation("FCS: {0}.{1} ({2})", userOpName, "CheckFileInProjectAllowingStaleCachedResults.CacheMiss", filename) let! tcPrior = execWithReactorAsync <| fun ctok -> DoesNotRequireCompilerThreadTokenAndCouldPossiblyBeMadeConcurrent ctok builder.GetCheckResultsBeforeFileInProjectEvenIfStale filename match tcPrior with | Some tcPrior -> - let! checkResults = bc.CheckOneFile(parseResults, source, filename, options, textSnapshotInfo, fileVersion, builder, tcPrior, creationErrors, userOpName) + let! checkResults = bc.CheckOneFileImpl(parseResults, source, filename, options, textSnapshotInfo, fileVersion, builder, tcPrior, creationErrors, userOpName) return Some checkResults | None -> return None // the incremental builder was not up to date finally @@ -2435,55 +2439,63 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC member bc.CheckFileInProject(parseResults: FSharpParseFileResults, filename, fileVersion, source, options, textSnapshotInfo, userOpName) = let execWithReactorAsync action = reactor.EnqueueAndAwaitOpAsync(userOpName, "CheckFileInProject", filename, action) async { - let! builderOpt,creationErrors, decrement = execWithReactorAsync (fun ctok -> getOrCreateBuilderAndKeepAlive (ctok, options, userOpName)) - use _unwind = decrement - match builderOpt with - | None -> return FSharpCheckFileAnswer.Succeeded (MakeCheckFileResultsEmpty(filename, creationErrors)) - | Some builder -> - // Check the cache. We can only use cached results when there is no work to do to bring the background builder up-to-date - let cachedResults = bc.GetCachedCheckFileResult(builder, filename, source, options) + try + if implicitlyStartBackgroundWork then + reactor.CancelBackgroundOp() // cancel the background work, since we will start new work after we're done + let! builderOpt,creationErrors, decrement = execWithReactorAsync (fun ctok -> getOrCreateBuilderAndKeepAlive (ctok, options, userOpName)) + use _unwind = decrement + match builderOpt with + | None -> return FSharpCheckFileAnswer.Succeeded (MakeCheckFileResultsEmpty(filename, creationErrors)) + | Some builder -> + // Check the cache. We can only use cached results when there is no work to do to bring the background builder up-to-date + let cachedResults = bc.GetCachedCheckFileResult(builder, filename, source, options) - match cachedResults with - | Some (_, checkResults) -> return FSharpCheckFileAnswer.Succeeded checkResults - | _ -> - Trace.TraceInformation("Reactor: {0}.{1} ({2})", userOpName, "CheckFileInProject.CacheMiss", filename) - let! tcPrior = execWithReactorAsync <| fun ctok -> builder.GetCheckResultsBeforeFileInProject (ctok, filename) - let! checkAnswer = bc.CheckOneFile(parseResults, source, filename, options, textSnapshotInfo, fileVersion, builder, tcPrior, creationErrors, userOpName) - bc.ImplicitlyStartCheckProjectInBackground(options, userOpName) - return checkAnswer + match cachedResults with + | Some (_, checkResults) -> return FSharpCheckFileAnswer.Succeeded checkResults + | _ -> + Trace.TraceInformation("FCS: {0}.{1} ({2})", userOpName, "CheckFileInProject.CacheMiss", filename) + let! tcPrior = execWithReactorAsync <| fun ctok -> builder.GetCheckResultsBeforeFileInProject (ctok, filename) + let! checkAnswer = bc.CheckOneFileImpl(parseResults, source, filename, options, textSnapshotInfo, fileVersion, builder, tcPrior, creationErrors, userOpName) + return checkAnswer + finally + bc.ImplicitlyStartCheckProjectInBackground(options, userOpName) } /// Parses and checks the source file and returns untyped AST and check results. member bc.ParseAndCheckFileInProject (filename:string, fileVersion, source, options:FSharpProjectOptions, textSnapshotInfo, userOpName) = let execWithReactorAsync action = reactor.EnqueueAndAwaitOpAsync(userOpName, "ParseAndCheckFileInProject", filename, action) async { - let! builderOpt,creationErrors,decrement = execWithReactorAsync (fun ctok -> getOrCreateBuilderAndKeepAlive (ctok, options, userOpName)) - use _unwind = decrement - match builderOpt with - | None -> - let parseResults = FSharpParseFileResults(List.toArray creationErrors, None, true, []) - return (parseResults, FSharpCheckFileAnswer.Aborted) + try + if implicitlyStartBackgroundWork then + reactor.CancelBackgroundOp() // cancel the background work, since we will start new work after we're done + let! builderOpt,creationErrors,decrement = execWithReactorAsync (fun ctok -> getOrCreateBuilderAndKeepAlive (ctok, options, userOpName)) + use _unwind = decrement + match builderOpt with + | None -> + let parseResults = FSharpParseFileResults(List.toArray creationErrors, None, true, []) + return (parseResults, FSharpCheckFileAnswer.Aborted) - | Some builder -> - let cachedResults = bc.GetCachedCheckFileResult(builder, filename, source, options) - - match cachedResults with - | Some (parseResults, checkResults) -> return parseResults, FSharpCheckFileAnswer.Succeeded checkResults - | _ -> - Trace.TraceInformation("Reactor: {0}.{1} ({2})", userOpName, "ParseAndCheckFileInProject.CacheMiss", filename) - // todo this blocks the Reactor queue until all files up to the current are type checked. It's OK while editing the file, - // but results with non cooperative blocking when a firts file from a project opened. - let! tcPrior = execWithReactorAsync <| fun ctok -> builder.GetCheckResultsBeforeFileInProject (ctok, filename) + | Some builder -> + let cachedResults = bc.GetCachedCheckFileResult(builder, filename, source, options) + + match cachedResults with + | Some (parseResults, checkResults) -> return parseResults, FSharpCheckFileAnswer.Succeeded checkResults + | _ -> + Trace.TraceInformation("FCS: {0}.{1} ({2})", userOpName, "ParseAndCheckFileInProject.CacheMiss", filename) + // todo this blocks the Reactor queue until all files up to the current are type checked. It's OK while editing the file, + // but results with non cooperative blocking when a firts file from a project opened. + let! tcPrior = execWithReactorAsync <| fun ctok -> builder.GetCheckResultsBeforeFileInProject (ctok, filename) - // Do the parsing. - let! parseErrors, _matchPairs, inputOpt, anyErrors = - execWithReactorAsync <| fun ctok -> - Parser.ParseOneFile (ctok, source, false, true, filename, builder.SourceFiles, builder.TcConfig) |> cancellable.Return + // Do the parsing. + let! parseErrors, _matchPairs, inputOpt, anyErrors = + execWithReactorAsync <| fun ctok -> + Parser.ParseOneFile (ctok, source, false, true, filename, builder.SourceFiles, builder.TcConfig) |> cancellable.Return - let parseResults = FSharpParseFileResults(parseErrors, inputOpt, anyErrors, builder.AllDependenciesDeprecated) - let! checkResults = bc.CheckOneFile(parseResults, source, filename, options, textSnapshotInfo, fileVersion, builder, tcPrior, creationErrors, userOpName) - bc.ImplicitlyStartCheckProjectInBackground(options, userOpName) - return parseResults, checkResults + let parseResults = FSharpParseFileResults(parseErrors, inputOpt, anyErrors, builder.AllDependenciesDeprecated) + let! checkResults = bc.CheckOneFileImpl(parseResults, source, filename, options, textSnapshotInfo, fileVersion, builder, tcPrior, creationErrors, userOpName) + return parseResults, checkResults + finally + bc.ImplicitlyStartCheckProjectInBackground(options, userOpName) } /// Fetch the check information from the background compiler (which checks w.r.t. the FileSystem API) @@ -2545,7 +2557,7 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC // NOTE: This creation of the background builder is currently run as uncancellable. Creating background builders is generally // cheap though the timestamp computations look suspicious for transitive project references. - let builderOpt,_creationErrors,decrement = getOrCreateBuilderAndKeepAlive (ctok, options, userOpName + ".LogicalTimeStamp") |> Cancellable.runWithoutCancellation + let builderOpt,_creationErrors,decrement = getOrCreateBuilderAndKeepAlive (ctok, options, userOpName + ".TryGetLogicalTimeStampForProject") |> Cancellable.runWithoutCancellation use _unwind = decrement match builderOpt with | None -> None @@ -2638,15 +2650,19 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC }) member bc.CheckProjectInBackground (options, userOpName) = - reactor.SetBackgroundOp (Some (userOpName, "CheckProjectInBackground", options.ProjectFileName, (fun ctok -> + reactor.SetBackgroundOp (Some (userOpName, "CheckProjectInBackground", options.ProjectFileName, (fun ctok ct -> // The creation of the background builder can't currently be cancelled - let builderOpt,_,decrement = getOrCreateBuilderAndKeepAlive (ctok, options, userOpName) |> Cancellable.runWithoutCancellation - use _unwind = decrement - match builderOpt with - | None -> false - | Some builder -> - // The individual steps of the background build can't currently be cancelled - builder.Step(ctok) |> Cancellable.runWithoutCancellation))) + match getOrCreateBuilderAndKeepAlive (ctok, options, userOpName) |> Cancellable.run ct with + | ValueOrCancelled.Cancelled _ -> false + | ValueOrCancelled.Value (builderOpt,_,decrement) -> + use _unwind = decrement + match builderOpt with + | None -> false + | Some builder -> + // The individual steps of the background build + match builder.Step(ctok) |> Cancellable.run ct with + | ValueOrCancelled.Value v -> v + | ValueOrCancelled.Cancelled _ -> false))) member bc.StopBackgroundCompile () = reactor.SetBackgroundOp(None) @@ -2859,16 +2875,16 @@ type FSharpChecker(legacyReferenceResolver, projectCacheSize, keepAssemblyConten ic.ClearCachesAsync(?userOpName=userOpName) |> Async.Start // this cache clearance is not synchronous, it will happen when the background op gets run member ic.CheckMaxMemoryReached() = - if not maxMemoryReached && System.GC.GetTotalMemory(false) > int64 maxMB * 1024L * 1024L then - Trace.WriteLine("!!!!!!!! MAX MEMORY REACHED, DOWNSIZING F# COMPILER CACHES !!!!!!!!!!!!!!!") - // If the maxMB limit is reached, drastic action is taken - // - reduce strong cache sizes to a minimum - let userOpName = "MaxMemoryReached" - backgroundCompiler.CompleteAllQueuedOps() - maxMemoryReached <- true - braceMatchCache.Resize(AssumeAnyCallerThreadWithoutEvidence(), keepStrongly=10) - backgroundCompiler.DownsizeCaches(userOpName) |> Async.RunSynchronously - maxMemEvent.Trigger( () ) + if not maxMemoryReached && System.GC.GetTotalMemory(false) > int64 maxMB * 1024L * 1024L then + Trace.TraceWarning("!!!!!!!! MAX MEMORY REACHED, DOWNSIZING F# COMPILER CACHES !!!!!!!!!!!!!!!") + // If the maxMB limit is reached, drastic action is taken + // - reduce strong cache sizes to a minimum + let userOpName = "MaxMemoryReached" + backgroundCompiler.CompleteAllQueuedOps() + maxMemoryReached <- true + braceMatchCache.Resize(AssumeAnyCallerThreadWithoutEvidence(), keepStrongly=10) + backgroundCompiler.DownsizeCaches(userOpName) |> Async.RunSynchronously + maxMemEvent.Trigger( () ) // This is for unit testing only member ic.ClearLanguageServiceRootCachesAndCollectAndFinalizeAllTransients() = @@ -3020,7 +3036,7 @@ type FsiInteractiveChecker(legacyReferenceResolver, reactorOps: IReactorOperatio CompileOptions.ParseCompilerOptions (ignore, fsiCompilerOptions, [ ]) let loadClosure = LoadClosure.ComputeClosureOfSourceText(ctok, legacyReferenceResolver, defaultFSharpBinariesDir, filename, source, CodeContext.Editing, tcConfig.useSimpleResolution, tcConfig.useFsiAuxLib, new Lexhelp.LexResourceManager(), applyCompilerOptions, assumeDotNetFramework) - let! tcErrors, tcFileResult = Parser.TypeCheckOneFile(parseResults, source, filename, "project", tcConfig, tcGlobals, tcImports, tcState, Some loadClosure, backgroundDiagnostics, reactorOps, (fun () -> true), None, userOpName) + let! tcErrors, tcFileResult = Parser.CheckOneFile(parseResults, source, filename, "project", tcConfig, tcGlobals, tcImports, tcState, Some loadClosure, backgroundDiagnostics, reactorOps, (fun () -> true), None, userOpName) return match tcFileResult with