From 7a41d857a41ceccb0241e4fb6b0180edf3eee823 Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Fri, 23 Feb 2024 10:08:40 +0100 Subject: [PATCH 01/51] fix some inconsistencies --- src/Compiler/Driver/ParseAndCheckInputs.fs | 30 +++++++++++++--------- src/Compiler/Driver/fsc.fs | 4 +-- 2 files changed, 20 insertions(+), 14 deletions(-) diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fs b/src/Compiler/Driver/ParseAndCheckInputs.fs index 5a23c95ca7b..bdb0d1defd6 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fs +++ b/src/Compiler/Driver/ParseAndCheckInputs.fs @@ -1389,15 +1389,17 @@ let DiagnosticsLoggerForInput (tcConfig: TcConfig, input: ParsedInput, oldLogger /// Typecheck a single file (or interactive entry into F# Interactive) let CheckOneInputEntry (ctok, checkForErrors, tcConfig: TcConfig, tcImports, tcGlobals, prefixPathOpt) tcState input = - // Equip loggers to locally filter w.r.t. scope pragmas in each input - use _ = - UseTransformedDiagnosticsLogger(fun oldLogger -> DiagnosticsLoggerForInput(tcConfig, input, oldLogger)) + cancellable { + // Equip loggers to locally filter w.r.t. scope pragmas in each input + use _ = + UseTransformedDiagnosticsLogger(fun oldLogger -> DiagnosticsLoggerForInput(tcConfig, input, oldLogger)) - use _ = UseBuildPhase BuildPhase.TypeCheck + use _ = UseBuildPhase BuildPhase.TypeCheck - RequireCompilationThread ctok + RequireCompilationThread ctok - CheckOneInput(checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, TcResultsSink.NoSink, tcState, input) + return! CheckOneInput(checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, TcResultsSink.NoSink, tcState, input) + } |> Cancellable.runWithoutCancellation /// Finish checking multiple files (or one interactive entry into F# Interactive) @@ -1859,14 +1861,18 @@ let CheckMultipleInputsUsingGraphMode ((input, logger): ParsedInput * DiagnosticsLogger) ((currentTcState, _currentPriorErrors): State) : Finisher = - use _ = UseDiagnosticsLogger logger - let checkForErrors2 () = priorErrors || (logger.ErrorCount > 0) - let tcSink = TcResultsSink.NoSink let (Finisher(finisher = finisher)) = - CheckOneInputWithCallback - node - (checkForErrors2, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcSink, currentTcState, input, false) + cancellable { + use _ = UseDiagnosticsLogger logger + let checkForErrors2 () = priorErrors || (logger.ErrorCount > 0) + let tcSink = TcResultsSink.NoSink + + return! + CheckOneInputWithCallback + node + (checkForErrors2, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcSink, currentTcState, input, false) + } |> Cancellable.runWithoutCancellation Finisher( diff --git a/src/Compiler/Driver/fsc.fs b/src/Compiler/Driver/fsc.fs index 014ed840222..fe3b369b3c7 100644 --- a/src/Compiler/Driver/fsc.fs +++ b/src/Compiler/Driver/fsc.fs @@ -525,7 +525,7 @@ let main1 // Now install a delayed logger to hold all errors from flags until after all flags have been parsed (for example, --vserrors) let delayForFlagsLogger = CapturingDiagnosticsLogger("DelayFlagsLogger") - let _holder = UseDiagnosticsLogger delayForFlagsLogger + SetThreadDiagnosticsLoggerNoUnwind delayForFlagsLogger // Share intern'd strings across all lexing/parsing let lexResourceManager = Lexhelp.LexResourceManager() @@ -596,7 +596,7 @@ let main1 let diagnosticsLogger = diagnosticsLoggerProvider.CreateLogger(tcConfigB, exiter) // Install the global error logger and never remove it. This logger does have all command-line flags considered. - let _holder = UseDiagnosticsLogger diagnosticsLogger + SetThreadDiagnosticsLoggerNoUnwind diagnosticsLogger // Forward all errors from flags delayForFlagsLogger.CommitDelayedDiagnostics diagnosticsLogger From 22e955a0b58d98aa0ddbecd43e3348787a7dd26a Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Fri, 23 Feb 2024 12:11:15 +0100 Subject: [PATCH 02/51] we don't intend to dispose this ever --- src/Compiler/Driver/fsc.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Compiler/Driver/fsc.fs b/src/Compiler/Driver/fsc.fs index fe3b369b3c7..3cebc51d10f 100644 --- a/src/Compiler/Driver/fsc.fs +++ b/src/Compiler/Driver/fsc.fs @@ -749,7 +749,7 @@ let main2 GetDiagnosticsLoggerFilteringByScopedPragmas(true, scopedPragmas, tcConfig.diagnosticsOptions, oldLogger) - let _holder = UseDiagnosticsLogger diagnosticsLogger + SetThreadDiagnosticsLoggerNoUnwind diagnosticsLogger // Try to find an AssemblyVersion attribute let assemVerFromAttrib = From 8be519ea13c3d3fb5e28198d804a22a191808acc Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Mon, 26 Feb 2024 21:15:22 +0100 Subject: [PATCH 03/51] removed --- src/Compiler/Driver/CompilerConfig.fs | 2 +- src/Compiler/Driver/CompilerConfig.fsi | 2 +- src/Compiler/Driver/CompilerImports.fs | 26 +- src/Compiler/Driver/CompilerImports.fsi | 6 +- src/Compiler/Driver/fsc.fs | 4 +- src/Compiler/Facilities/AsyncMemoize.fs | 22 +- src/Compiler/Facilities/AsyncMemoize.fsi | 4 +- src/Compiler/Facilities/BuildGraph.fs | 226 +----------------- src/Compiler/Facilities/BuildGraph.fsi | 81 +------ src/Compiler/Facilities/DiagnosticsLogger.fs | 27 +-- src/Compiler/Facilities/DiagnosticsLogger.fsi | 1 + src/Compiler/Interactive/fsi.fs | 4 +- src/Compiler/Service/BackgroundCompiler.fs | 127 +++++----- src/Compiler/Service/BackgroundCompiler.fsi | 32 +-- src/Compiler/Service/IncrementalBuild.fs | 93 ++++--- src/Compiler/Service/IncrementalBuild.fsi | 30 +-- src/Compiler/Service/TransparentCompiler.fs | 140 +++++------ src/Compiler/Service/TransparentCompiler.fsi | 8 +- src/Compiler/Service/service.fs | 18 +- .../CompilerService/AsyncMemoize.fs | 74 +++--- .../BuildGraphTests.fs | 68 +++--- .../LanguageService/WorkspaceExtensions.fs | 7 +- 22 files changed, 340 insertions(+), 662 deletions(-) diff --git a/src/Compiler/Driver/CompilerConfig.fs b/src/Compiler/Driver/CompilerConfig.fs index 32298c0cf05..92ab18ab7d8 100644 --- a/src/Compiler/Driver/CompilerConfig.fs +++ b/src/Compiler/Driver/CompilerConfig.fs @@ -252,7 +252,7 @@ and IProjectReference = abstract FileName: string /// Evaluate raw contents of the assembly file generated by the project - abstract EvaluateRawContents: unit -> NodeCode + abstract EvaluateRawContents: unit -> Async /// Get the logical timestamp that would be the timestamp of the assembly file generated by the project /// diff --git a/src/Compiler/Driver/CompilerConfig.fsi b/src/Compiler/Driver/CompilerConfig.fsi index f59950f9e28..282e167bd1f 100644 --- a/src/Compiler/Driver/CompilerConfig.fsi +++ b/src/Compiler/Driver/CompilerConfig.fsi @@ -86,7 +86,7 @@ and IProjectReference = /// Evaluate raw contents of the assembly file generated by the project. /// 'None' may be returned if an in-memory view of the contents is, for some reason, /// not available. In this case the on-disk view of the contents will be preferred. - abstract EvaluateRawContents: unit -> NodeCode + abstract EvaluateRawContents: unit -> Async /// Get the logical timestamp that would be the timestamp of the assembly file generated by the project. /// diff --git a/src/Compiler/Driver/CompilerImports.fs b/src/Compiler/Driver/CompilerImports.fs index d8d9ccd9866..ee5b4afe87f 100644 --- a/src/Compiler/Driver/CompilerImports.fs +++ b/src/Compiler/Driver/CompilerImports.fs @@ -2158,14 +2158,14 @@ and [] TcImports ( ctok, r: AssemblyResolution - ) : NodeCode<(_ * (unit -> AvailableImportedAssembly list)) option> = - node { + ) : Async<(_ * (unit -> AvailableImportedAssembly list)) option> = + async { CheckDisposed() let m = r.originalReference.Range let fileName = r.resolvedPath let! contentsOpt = - node { + async { match r.ProjectReference with | Some ilb -> return! ilb.EvaluateRawContents() | None -> return ProjectAssemblyDataResult.Unavailable true @@ -2228,20 +2228,20 @@ and [] TcImports // NOTE: When used in the Language Service this can cause the transitive checking of projects. Hence it must be cancellable. member tcImports.RegisterAndImportReferencedAssemblies(ctok, nms: AssemblyResolution list) = - node { + async { CheckDisposed() let tcConfig = tcConfigP.Get ctok let runMethod = match tcConfig.parallelReferenceResolution with - | ParallelReferenceResolution.On -> NodeCode.Parallel - | ParallelReferenceResolution.Off -> NodeCode.Sequential + | ParallelReferenceResolution.On -> Async.Parallel + | ParallelReferenceResolution.Off -> Async.Sequential let! results = nms |> List.map (fun nm -> - node { + async { try return! tcImports.TryRegisterAndPrepareToImportReferencedDll(ctok, nm) with e -> @@ -2282,7 +2282,7 @@ and [] TcImports ReportWarnings warns tcImports.RegisterAndImportReferencedAssemblies(ctok, res) - |> NodeCode.RunImmediateWithoutCancellation + |> Async.RunImmediate |> ignore true @@ -2383,7 +2383,7 @@ and [] TcImports // we dispose TcImports is because we need to dispose type providers, and type providers are never included in the framework DLL set. // If a framework set ever includes type providers, you will not have to worry about explicitly calling Dispose as the Finalizer will handle it. static member BuildFrameworkTcImports(tcConfigP: TcConfigProvider, frameworkDLLs, nonFrameworkDLLs) = - node { + async { let ctok = CompilationThreadToken() let tcConfig = tcConfigP.Get ctok @@ -2460,7 +2460,7 @@ and [] TcImports resolvedAssemblies |> List.choose tryFindEquivPrimaryAssembly let! fslibCcu, fsharpCoreAssemblyScopeRef = - node { + async { if tcConfig.compilingFSharpCore then // When compiling FSharp.Core.dll, the fslibCcu reference to FSharp.Core.dll is a delayed ccu thunk fixed up during type checking return CcuThunk.CreateDelayed getFSharpCoreLibraryName, ILScopeRef.Local @@ -2553,7 +2553,7 @@ and [] TcImports dependencyProvider ) = - node { + async { let ctok = CompilationThreadToken() let tcConfig = tcConfigP.Get ctok @@ -2571,7 +2571,7 @@ and [] TcImports } static member BuildTcImports(tcConfigP: TcConfigProvider, dependencyProvider) = - node { + async { let ctok = CompilationThreadToken() let tcConfig = tcConfigP.Get ctok @@ -2603,7 +2603,7 @@ let RequireReferences (ctok, tcImports: TcImports, tcEnv, thisAssemblyName, reso let ccuinfos = tcImports.RegisterAndImportReferencedAssemblies(ctok, resolutions) - |> NodeCode.RunImmediateWithoutCancellation + |> Async.RunImmediate let asms = ccuinfos diff --git a/src/Compiler/Driver/CompilerImports.fsi b/src/Compiler/Driver/CompilerImports.fsi index ac06a25c2dc..9697e18968d 100644 --- a/src/Compiler/Driver/CompilerImports.fsi +++ b/src/Compiler/Driver/CompilerImports.fsi @@ -199,14 +199,14 @@ type TcImports = member internal Base: TcImports option static member BuildFrameworkTcImports: - TcConfigProvider * AssemblyResolution list * AssemblyResolution list -> NodeCode + TcConfigProvider * AssemblyResolution list * AssemblyResolution list -> Async static member BuildNonFrameworkTcImports: TcConfigProvider * TcImports * AssemblyResolution list * UnresolvedAssemblyReference list * DependencyProvider -> - NodeCode + Async static member BuildTcImports: - tcConfigP: TcConfigProvider * dependencyProvider: DependencyProvider -> NodeCode + tcConfigP: TcConfigProvider * dependencyProvider: DependencyProvider -> Async /// Process a group of #r in F# Interactive. /// Adds the reference to the tcImports and add the ccu to the type checking environment. diff --git a/src/Compiler/Driver/fsc.fs b/src/Compiler/Driver/fsc.fs index 014ed840222..a82c2621a03 100644 --- a/src/Compiler/Driver/fsc.fs +++ b/src/Compiler/Driver/fsc.fs @@ -614,7 +614,7 @@ let main1 // Import basic assemblies let tcGlobals, frameworkTcImports = TcImports.BuildFrameworkTcImports(foundationalTcConfigP, sysRes, otherRes) - |> NodeCode.RunImmediateWithoutCancellation + |> Async.RunImmediate let ilSourceDocs = [ @@ -663,7 +663,7 @@ let main1 let tcImports = TcImports.BuildNonFrameworkTcImports(tcConfigP, frameworkTcImports, otherRes, knownUnresolved, dependencyProvider) - |> NodeCode.RunImmediateWithoutCancellation + |> Async.RunImmediate // register tcImports to be disposed in future disposables.Register tcImports diff --git a/src/Compiler/Facilities/AsyncMemoize.fs b/src/Compiler/Facilities/AsyncMemoize.fs index d6ae83ada6e..b70f55627d0 100644 --- a/src/Compiler/Facilities/AsyncMemoize.fs +++ b/src/Compiler/Facilities/AsyncMemoize.fs @@ -50,11 +50,11 @@ type internal MemoizeReply<'TValue> = | New of CancellationToken | Existing of Task<'TValue> -type internal MemoizeRequest<'TValue> = GetOrCompute of NodeCode<'TValue> * CancellationToken +type internal MemoizeRequest<'TValue> = GetOrCompute of Async<'TValue> * CancellationToken [] type internal Job<'TValue> = - | Running of TaskCompletionSource<'TValue> * CancellationTokenSource * NodeCode<'TValue> * DateTime * ResizeArray + | Running of TaskCompletionSource<'TValue> * CancellationTokenSource * Async<'TValue> * DateTime * ResizeArray | Completed of 'TValue * (PhasedDiagnostic * FSharpDiagnosticSeverity) list | Canceled of DateTime | Failed of DateTime * exn // TODO: probably we don't need to keep this @@ -358,7 +358,7 @@ type internal AsyncMemoize<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'T DiagnosticsThreadStatics.DiagnosticsLogger <- cachingLogger try - let! result = computation |> Async.AwaitNodeCode + let! result = computation post (key, (JobCompleted(result, cachingLogger.CapturedDiagnostics))) return () finally @@ -481,14 +481,13 @@ type internal AsyncMemoize<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'T Version = key.GetVersion() } - node { - let! ct = NodeCode.CancellationToken + async { + let! ct = Async.CancellationToken let callerDiagnosticLogger = DiagnosticsThreadStatics.DiagnosticsLogger match! - processRequest post (key, GetOrCompute(computation, ct)) callerDiagnosticLogger - |> NodeCode.AwaitTask + processRequest post (key, GetOrCompute(computation, ct)) callerDiagnosticLogger |> Async.AwaitTask with | New internalCt -> @@ -496,8 +495,8 @@ type internal AsyncMemoize<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'T let cachingLogger = new CachingDiagnosticsLogger(Some callerDiagnosticLogger) try - return! - Async.StartAsTask( + return + Async.RunSynchronously( async { // TODO: Should unify starting and restarting let currentLogger = DiagnosticsThreadStatics.DiagnosticsLogger @@ -506,7 +505,7 @@ type internal AsyncMemoize<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'T log (Started, key) try - let! result = computation |> Async.AwaitNodeCode + let! result = computation post (key, (JobCompleted(result, cachingLogger.CapturedDiagnostics))) return result finally @@ -514,7 +513,6 @@ type internal AsyncMemoize<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'T }, cancellationToken = linkedCtSource.Token ) - |> NodeCode.AwaitTask with | TaskCancelled ex -> // TODO: do we need to do anything else here? Presumably it should be done by the registration on @@ -530,7 +528,7 @@ type internal AsyncMemoize<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'T post (key, (JobFailed(ex, cachingLogger.CapturedDiagnostics))) return raise ex - | Existing job -> return! job |> NodeCode.AwaitTask + | Existing job -> return! job |> Async.AwaitTask } diff --git a/src/Compiler/Facilities/AsyncMemoize.fsi b/src/Compiler/Facilities/AsyncMemoize.fsi index 1cce68cf999..6952d4802be 100644 --- a/src/Compiler/Facilities/AsyncMemoize.fsi +++ b/src/Compiler/Facilities/AsyncMemoize.fsi @@ -65,9 +65,9 @@ type internal AsyncMemoize<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'T member Clear: predicate: ('TKey -> bool) -> unit - member Get: key: ICacheKey<'TKey, 'TVersion> * computation: NodeCode<'TValue> -> NodeCode<'TValue> + member Get: key: ICacheKey<'TKey, 'TVersion> * computation: Async<'TValue> -> Async<'TValue> - member Get': key: 'TKey * computation: NodeCode<'TValue> -> NodeCode<'TValue> + member Get': key: 'TKey * computation: Async<'TValue> -> Async<'TValue> member TryGet: key: 'TKey * predicate: ('TVersion -> bool) -> 'TValue option diff --git a/src/Compiler/Facilities/BuildGraph.fs b/src/Compiler/Facilities/BuildGraph.fs index b4abe3ad1ed..b0ab87598ba 100644 --- a/src/Compiler/Facilities/BuildGraph.fs +++ b/src/Compiler/Facilities/BuildGraph.fs @@ -10,213 +10,6 @@ open System.Globalization open FSharp.Compiler.DiagnosticsLogger open Internal.Utilities.Library -[] -type NodeCode<'T> = Node of Async<'T> - -let wrapThreadStaticInfo computation = - async { - let diagnosticsLogger = DiagnosticsThreadStatics.DiagnosticsLogger - let phase = DiagnosticsThreadStatics.BuildPhase - - try - return! computation - finally - DiagnosticsThreadStatics.DiagnosticsLogger <- diagnosticsLogger - DiagnosticsThreadStatics.BuildPhase <- phase - } - -let unwrapNode (Node(computation)) = computation - -type Async<'T> with - - static member AwaitNodeCode(node: NodeCode<'T>) = - match node with - | Node(computation) -> wrapThreadStaticInfo computation - -[] -type NodeCodeBuilder() = - - static let zero = Node(async.Zero()) - - [] - member _.Zero() : NodeCode = zero - - [] - member _.Delay(f: unit -> NodeCode<'T>) = - Node( - async.Delay(fun () -> - match f () with - | Node(p) -> p) - ) - - [] - member _.Return value = Node(async.Return(value)) - - [] - member _.ReturnFrom(computation: NodeCode<_>) = computation - - [] - member _.Bind(Node(p): NodeCode<'a>, binder: 'a -> NodeCode<'b>) : NodeCode<'b> = - Node( - async.Bind( - p, - fun x -> - match binder x with - | Node p -> p - ) - ) - - [] - member _.TryWith(Node(p): NodeCode<'T>, binder: exn -> NodeCode<'T>) : NodeCode<'T> = - Node( - async.TryWith( - p, - fun ex -> - match binder ex with - | Node p -> p - ) - ) - - [] - member _.TryFinally(Node(p): NodeCode<'T>, binder: unit -> unit) : NodeCode<'T> = Node(async.TryFinally(p, binder)) - - [] - member _.For(xs: 'T seq, binder: 'T -> NodeCode) : NodeCode = - Node( - async.For( - xs, - fun x -> - match binder x with - | Node p -> p - ) - ) - - [] - member _.Combine(Node(p1): NodeCode, Node(p2): NodeCode<'T>) : NodeCode<'T> = Node(async.Combine(p1, p2)) - - [] - member _.Using(value: CompilationGlobalsScope, binder: CompilationGlobalsScope -> NodeCode<'U>) = - Node( - async { - DiagnosticsThreadStatics.DiagnosticsLogger <- value.DiagnosticsLogger - DiagnosticsThreadStatics.BuildPhase <- value.BuildPhase - - try - return! binder value |> Async.AwaitNodeCode - finally - (value :> IDisposable).Dispose() - } - ) - - [] - member _.Using(value: IDisposable, binder: IDisposable -> NodeCode<'U>) = - Node( - async { - use _ = value - return! binder value |> Async.AwaitNodeCode - } - ) - -let node = NodeCodeBuilder() - -[] -type NodeCode private () = - - static let cancellationToken = Node(wrapThreadStaticInfo Async.CancellationToken) - - static member RunImmediate(computation: NodeCode<'T>, ct: CancellationToken) = - let diagnosticsLogger = DiagnosticsThreadStatics.DiagnosticsLogger - let phase = DiagnosticsThreadStatics.BuildPhase - - try - try - let work = - async { - DiagnosticsThreadStatics.DiagnosticsLogger <- diagnosticsLogger - DiagnosticsThreadStatics.BuildPhase <- phase - return! computation |> Async.AwaitNodeCode - } - - Async.StartImmediateAsTask(work, cancellationToken = ct).Result - finally - DiagnosticsThreadStatics.DiagnosticsLogger <- diagnosticsLogger - DiagnosticsThreadStatics.BuildPhase <- phase - with :? AggregateException as ex when ex.InnerExceptions.Count = 1 -> - raise (ex.InnerExceptions[0]) - - static member RunImmediateWithoutCancellation(computation: NodeCode<'T>) = - NodeCode.RunImmediate(computation, CancellationToken.None) - - static member StartAsTask_ForTesting(computation: NodeCode<'T>, ?ct: CancellationToken) = - let diagnosticsLogger = DiagnosticsThreadStatics.DiagnosticsLogger - let phase = DiagnosticsThreadStatics.BuildPhase - - try - let work = - async { - DiagnosticsThreadStatics.DiagnosticsLogger <- diagnosticsLogger - DiagnosticsThreadStatics.BuildPhase <- phase - return! computation |> Async.AwaitNodeCode - } - - Async.StartAsTask(work, cancellationToken = defaultArg ct CancellationToken.None) - finally - DiagnosticsThreadStatics.DiagnosticsLogger <- diagnosticsLogger - DiagnosticsThreadStatics.BuildPhase <- phase - - static member CancellationToken = cancellationToken - - static member FromCancellable(computation: Cancellable<'T>) = - Node(wrapThreadStaticInfo (Cancellable.toAsync computation)) - - static member AwaitAsync(computation: Async<'T>) = Node(wrapThreadStaticInfo computation) - - static member AwaitTask(task: Task<'T>) = - Node(wrapThreadStaticInfo (Async.AwaitTask task)) - - static member AwaitTask(task: Task) = - Node(wrapThreadStaticInfo (Async.AwaitTask task)) - - static member AwaitWaitHandle_ForTesting(waitHandle: WaitHandle) = - Node(wrapThreadStaticInfo (Async.AwaitWaitHandle(waitHandle))) - - static member Sleep(ms: int) = - Node(wrapThreadStaticInfo (Async.Sleep(ms))) - - static member Sequential(computations: NodeCode<'T> seq) = - node { - let results = ResizeArray() - - for computation in computations do - let! res = computation - results.Add(res) - - return results.ToArray() - } - - static member Parallel(computations: NodeCode<'T> seq) = - node { - let concurrentLogging = new CaptureDiagnosticsConcurrently() - let phase = DiagnosticsThreadStatics.BuildPhase - // Why does it return just IDisposable? - use _ = concurrentLogging - - let injectLogger i computation = - let logger = concurrentLogging.GetLoggerForTask($"NodeCode.Parallel {i}") - - async { - DiagnosticsThreadStatics.DiagnosticsLogger <- logger - DiagnosticsThreadStatics.BuildPhase <- phase - return! unwrapNode computation - } - - return! - computations - |> Seq.mapi injectLogger - |> Async.Parallel - |> wrapThreadStaticInfo - |> Node - } [] module GraphNode = @@ -237,13 +30,13 @@ module GraphNode = | None -> () [] -type GraphNode<'T> private (computation: NodeCode<'T>, cachedResult: ValueOption<'T>, cachedResultNode: NodeCode<'T>) = +type GraphNode<'T> private (computation: Async<'T>, cachedResult: ValueOption<'T>, cachedResultNode: Async<'T>) = let mutable computation = computation let mutable requestCount = 0 let mutable cachedResult = cachedResult - let mutable cachedResultNode: NodeCode<'T> = cachedResultNode + let mutable cachedResultNode: Async<'T> = cachedResultNode let isCachedResultNodeNotNull () = not (obj.ReferenceEquals(cachedResultNode, null)) @@ -255,11 +48,11 @@ type GraphNode<'T> private (computation: NodeCode<'T>, cachedResult: ValueOption if isCachedResultNodeNotNull () then cachedResultNode else - node { + async { Interlocked.Increment(&requestCount) |> ignore try - let! ct = NodeCode.CancellationToken + let! ct = Async.CancellationToken // We must set 'taken' before any implicit cancellation checks // occur, making sure we are under the protection of the 'try'. @@ -278,22 +71,21 @@ type GraphNode<'T> private (computation: NodeCode<'T>, cachedResult: ValueOption ||| TaskContinuationOptions.NotOnFaulted ||| TaskContinuationOptions.ExecuteSynchronously) ) - |> NodeCode.AwaitTask + |> Async.AwaitTask match cachedResult with | ValueSome value -> return value | _ -> let tcs = TaskCompletionSource<'T>() - let (Node(p)) = computation Async.StartWithContinuations( async { Thread.CurrentThread.CurrentUICulture <- GraphNode.culture - return! p + return! computation }, (fun res -> cachedResult <- ValueSome res - cachedResultNode <- node.Return res + cachedResultNode <- async.Return res computation <- Unchecked.defaultof<_> tcs.SetResult(res)), (fun ex -> tcs.SetException(ex)), @@ -301,7 +93,7 @@ type GraphNode<'T> private (computation: NodeCode<'T>, cachedResult: ValueOption ct ) - return! tcs.Task |> NodeCode.AwaitTask + return! tcs.Task |> Async.AwaitTask finally if taken then semaphore.Release() |> ignore @@ -316,7 +108,7 @@ type GraphNode<'T> private (computation: NodeCode<'T>, cachedResult: ValueOption member _.IsComputing = requestCount > 0 static member FromResult(result: 'T) = - let nodeResult = node.Return result + let nodeResult = async.Return result GraphNode(nodeResult, ValueSome result, nodeResult) new(computation) = GraphNode(computation, ValueNone, Unchecked.defaultof<_>) diff --git a/src/Compiler/Facilities/BuildGraph.fsi b/src/Compiler/Facilities/BuildGraph.fsi index afbf9d2898b..8ea1bcf8cf5 100644 --- a/src/Compiler/Facilities/BuildGraph.fsi +++ b/src/Compiler/Facilities/BuildGraph.fsi @@ -9,83 +9,6 @@ open System.Threading.Tasks open FSharp.Compiler.DiagnosticsLogger open Internal.Utilities.Library -/// Represents code that can be run as part of the build graph. -/// -/// This is essentially cancellable async code where the only asynchronous waits are on nodes. -/// When a node is evaluated the evaluation is run synchronously on the thread of the -/// first requestor. -[] -type NodeCode<'T> - -type Async<'T> with - - /// Asynchronously await code in the build graph - static member AwaitNodeCode: node: NodeCode<'T> -> Async<'T> - -/// A standard builder for node code. -[] -type NodeCodeBuilder = - - member Bind: NodeCode<'T> * ('T -> NodeCode<'U>) -> NodeCode<'U> - - member Zero: unit -> NodeCode - - member Delay: (unit -> NodeCode<'T>) -> NodeCode<'T> - - member Return: 'T -> NodeCode<'T> - - member ReturnFrom: NodeCode<'T> -> NodeCode<'T> - - member TryWith: NodeCode<'T> * (exn -> NodeCode<'T>) -> NodeCode<'T> - - member TryFinally: NodeCode<'T> * (unit -> unit) -> NodeCode<'T> - - member For: xs: 'T seq * binder: ('T -> NodeCode) -> NodeCode - - member Combine: x1: NodeCode * x2: NodeCode<'T> -> NodeCode<'T> - - /// A limited form 'use' for establishing the compilation globals. - member Using: CompilationGlobalsScope * (CompilationGlobalsScope -> NodeCode<'T>) -> NodeCode<'T> - - /// A generic 'use' that disposes of the IDisposable at the end of the computation. - member Using: IDisposable * (IDisposable -> NodeCode<'T>) -> NodeCode<'T> - -/// Specifies code that can be run as part of the build graph. -val node: NodeCodeBuilder - -/// Contains helpers to specify code that can be run as part of the build graph. -[] -type NodeCode = - - /// Only used for testing, do not use - static member RunImmediate: computation: NodeCode<'T> * ct: CancellationToken -> 'T - - /// Used in places where we don't care about cancellation, e.g. the command line compiler - /// and F# Interactive - static member RunImmediateWithoutCancellation: computation: NodeCode<'T> -> 'T - - static member CancellationToken: NodeCode - - static member Sequential: computations: NodeCode<'T> seq -> NodeCode<'T[]> - - static member Parallel: computations: (NodeCode<'T> seq) -> NodeCode<'T[]> - - static member AwaitAsync: computation: Async<'T> -> NodeCode<'T> - - static member AwaitTask: task: Task<'T> -> NodeCode<'T> - - static member AwaitTask: task: Task -> NodeCode - - /// Execute the cancellable computation synchronously using the ambient cancellation token of - /// the NodeCode. - static member FromCancellable: computation: Cancellable<'T> -> NodeCode<'T> - - /// Only used for testing, do not use - static member StartAsTask_ForTesting: computation: NodeCode<'T> * ?ct: CancellationToken -> Task<'T> - - /// Only used for testing, do not use - static member AwaitWaitHandle_ForTesting: waitHandle: WaitHandle -> NodeCode - /// Contains helpers related to the build graph [] module internal GraphNode = @@ -102,7 +25,7 @@ module internal GraphNode = type internal GraphNode<'T> = /// - computation - The computation code to run. - new: computation: NodeCode<'T> -> GraphNode<'T> + new: computation: Async<'T> -> GraphNode<'T> /// Creates a GraphNode with given result already cached. static member FromResult: 'T -> GraphNode<'T> @@ -110,7 +33,7 @@ type internal GraphNode<'T> = /// Return NodeCode which, when executed, will get the value of the computation if already computed, or /// await an existing in-progress computation for the node if one exists, or else will synchronously /// start the computation on the current thread. - member GetOrComputeValue: unit -> NodeCode<'T> + member GetOrComputeValue: unit -> Async<'T> /// Return 'Some' if the computation has already been computed, else None if /// the computation is in-progress or has not yet been started. diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fs b/src/Compiler/Facilities/DiagnosticsLogger.fs index 75dfaaef39e..ee978e683f8 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -14,6 +14,7 @@ open System.Threading open Internal.Utilities.Library open Internal.Utilities.Library.Extras open System.Collections.Concurrent +open System.Threading /// Represents the style being used to format errors [] @@ -375,29 +376,25 @@ type CapturingDiagnosticsLogger(nm, ?eagerFormat) = let errors = diagnostics.ToArray() errors |> Array.iter diagnosticsLogger.DiagnosticSink +let buildPhase = AsyncLocal<_>() +let diagnosticsLogger = AsyncLocal<_>() + /// Type holds thread-static globals for use by the compiler. type internal DiagnosticsThreadStatics = - [] - static val mutable private buildPhase: BuildPhase - [] - static val mutable private diagnosticsLogger: DiagnosticsLogger + static member Init() = + buildPhase.Value <- BuildPhase.DefaultPhase + diagnosticsLogger.Value <- AssertFalseDiagnosticsLogger - static member BuildPhaseUnchecked = DiagnosticsThreadStatics.buildPhase + static member BuildPhaseUnchecked = buildPhase.Value static member BuildPhase - with get () = - match box DiagnosticsThreadStatics.buildPhase with - | Null -> BuildPhase.DefaultPhase - | _ -> DiagnosticsThreadStatics.buildPhase - and set v = DiagnosticsThreadStatics.buildPhase <- v + with get () = buildPhase.Value + and set v = buildPhase.Value <- v static member DiagnosticsLogger - with get () = - match box DiagnosticsThreadStatics.diagnosticsLogger with - | Null -> AssertFalseDiagnosticsLogger - | _ -> DiagnosticsThreadStatics.diagnosticsLogger - and set v = DiagnosticsThreadStatics.diagnosticsLogger <- v + with get () = diagnosticsLogger.Value + and set v = diagnosticsLogger.Value <- v [] module DiagnosticsLoggerExtensions = diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fsi b/src/Compiler/Facilities/DiagnosticsLogger.fsi index bcbdd197b73..aea467ae80a 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fsi +++ b/src/Compiler/Facilities/DiagnosticsLogger.fsi @@ -229,6 +229,7 @@ type CapturingDiagnosticsLogger = /// Thread statics for the installed diagnostic logger [] type DiagnosticsThreadStatics = + static member Init: unit -> unit static member BuildPhase: BuildPhase with get, set diff --git a/src/Compiler/Interactive/fsi.fs b/src/Compiler/Interactive/fsi.fs index e5ff5b6c754..403ca376b27 100644 --- a/src/Compiler/Interactive/fsi.fs +++ b/src/Compiler/Interactive/fsi.fs @@ -4594,7 +4594,7 @@ type FsiEvaluationSession let tcConfig = tcConfigP.Get(ctokStartup) checker.FrameworkImportsCache.Get tcConfig - |> NodeCode.RunImmediateWithoutCancellation + |> Async.RunImmediate with e -> stopProcessingRecovery e range0 failwithf "Error creating evaluation session: %A" e @@ -4608,7 +4608,7 @@ type FsiEvaluationSession unresolvedReferences, fsiOptions.DependencyProvider ) - |> NodeCode.RunImmediateWithoutCancellation + |> Async.RunImmediate with e -> stopProcessingRecovery e range0 failwithf "Error creating evaluation session: %A" e diff --git a/src/Compiler/Service/BackgroundCompiler.fs b/src/Compiler/Service/BackgroundCompiler.fs index d0af1284f14..ac907a549fc 100644 --- a/src/Compiler/Service/BackgroundCompiler.fs +++ b/src/Compiler/Service/BackgroundCompiler.fs @@ -57,7 +57,7 @@ type internal IBackgroundCompiler = sourceText: ISourceText * options: FSharpProjectOptions * userOpName: string -> - NodeCode + Async /// Type-check the result obtained by parsing, but only if the antecedent type checking context is available. abstract member CheckFileInProjectAllowingStaleCachedResults: @@ -67,7 +67,7 @@ type internal IBackgroundCompiler = sourceText: ISourceText * options: FSharpProjectOptions * userOpName: string -> - NodeCode + Async abstract member ClearCache: options: seq * userOpName: string -> unit @@ -83,31 +83,31 @@ type internal IBackgroundCompiler = symbol: FSharp.Compiler.Symbols.FSharpSymbol * canInvalidateProject: bool * userOpName: string -> - NodeCode> + Async> abstract member FindReferencesInFile: fileName: string * projectSnapshot: FSharpProjectSnapshot * symbol: FSharp.Compiler.Symbols.FSharpSymbol * userOpName: string -> - NodeCode> + Async> abstract member GetAssemblyData: options: FSharpProjectOptions * outputFileName: string * userOpName: string -> - NodeCode + Async abstract member GetAssemblyData: projectSnapshot: FSharpProjectSnapshot * outputFileName: string * userOpName: string -> - NodeCode + Async /// Fetch the check information from the background compiler (which checks w.r.t. the FileSystem API) abstract member GetBackgroundCheckResultsForFileInProject: - fileName: string * options: FSharpProjectOptions * userOpName: string -> NodeCode + fileName: string * options: FSharpProjectOptions * userOpName: string -> Async /// Fetch the parse information from the background compiler (which checks w.r.t. the FileSystem API) abstract member GetBackgroundParseResultsForFileInProject: - fileName: string * options: FSharpProjectOptions * userOpName: string -> NodeCode + fileName: string * options: FSharpProjectOptions * userOpName: string -> Async abstract member GetCachedCheckFileResult: builder: IncrementalBuilder * fileName: string * sourceText: ISourceText * options: FSharpProjectOptions -> - NodeCode<(FSharpParseFileResults * FSharpCheckFileResults) option> + Async<(FSharpParseFileResults * FSharpCheckFileResults) option> abstract member GetProjectOptionsFromScript: fileName: string * @@ -139,33 +139,33 @@ type internal IBackgroundCompiler = abstract member GetSemanticClassificationForFile: fileName: string * options: FSharpProjectOptions * userOpName: string -> - NodeCode + Async abstract member GetSemanticClassificationForFile: fileName: string * snapshot: FSharpProjectSnapshot * userOpName: string -> - NodeCode + Async abstract member InvalidateConfiguration: options: FSharpProjectOptions * userOpName: string -> unit abstract InvalidateConfiguration: projectSnapshot: FSharpProjectSnapshot * userOpName: string -> unit - abstract member NotifyFileChanged: fileName: string * options: FSharpProjectOptions * userOpName: string -> NodeCode + abstract member NotifyFileChanged: fileName: string * options: FSharpProjectOptions * userOpName: string -> Async abstract member NotifyProjectCleaned: options: FSharpProjectOptions * userOpName: string -> Async /// Parses and checks the source file and returns untyped AST and check results. abstract member ParseAndCheckFileInProject: fileName: string * fileVersion: int * sourceText: ISourceText * options: FSharpProjectOptions * userOpName: string -> - NodeCode + Async abstract member ParseAndCheckFileInProject: fileName: string * projectSnapshot: FSharpProjectSnapshot * userOpName: string -> - NodeCode + Async /// Parse and typecheck the whole project. - abstract member ParseAndCheckProject: options: FSharpProjectOptions * userOpName: string -> NodeCode + abstract member ParseAndCheckProject: options: FSharpProjectOptions * userOpName: string -> Async - abstract member ParseAndCheckProject: projectSnapshot: FSharpProjectSnapshot * userOpName: string -> NodeCode + abstract member ParseAndCheckProject: projectSnapshot: FSharpProjectSnapshot * userOpName: string -> Async abstract member ParseFile: fileName: string * sourceText: ISourceText * options: FSharpParsingOptions * cache: bool * flatErrors: bool * userOpName: string -> @@ -314,7 +314,7 @@ type internal BackgroundCompiler then { new IProjectReference with member x.EvaluateRawContents() = - node { + async { Trace.TraceInformation("FCS: {0}.{1} ({2})", userOpName, "GetAssemblyData", nm) return! self.GetAssemblyData(opts, userOpName + ".CheckReferencedProject(" + nm + ")") } @@ -328,8 +328,8 @@ type internal BackgroundCompiler | FSharpReferencedProject.PEReference(getStamp, delayedReader) -> { new IProjectReference with member x.EvaluateRawContents() = - node { - let! ilReaderOpt = delayedReader.TryGetILModuleReader() |> NodeCode.FromCancellable + async { + let! ilReaderOpt = delayedReader.TryGetILModuleReader() |> Cancellable.toAsync match ilReaderOpt with | Some ilReader -> @@ -355,7 +355,7 @@ type internal BackgroundCompiler let data = RawFSharpAssemblyData(ilModuleDef, ilAsmRefs) :> IRawFSharpAssemblyData return ProjectAssemblyDataResult.Available data } - |> NodeCode.FromCancellable + |> Cancellable.toAsync member x.TryGetLogicalTimeStamp _ = getStamp () |> Some member x.FileName = nm @@ -365,7 +365,7 @@ type internal BackgroundCompiler /// CreateOneIncrementalBuilder (for background type checking). Note that fsc.fs also /// creates an incremental builder used by the command line compiler. let CreateOneIncrementalBuilder (options: FSharpProjectOptions, userOpName) = - node { + async { use _ = Activity.start "BackgroundCompiler.CreateOneIncrementalBuilder" [| Activity.Tags.project, options.ProjectFileName |] @@ -472,14 +472,14 @@ type internal BackgroundCompiler let tryGetBuilderNode options = incrementalBuildersCache.TryGet(AnyCallerThread, options) - let tryGetBuilder options : NodeCode option = + let tryGetBuilder options : Async option = tryGetBuilderNode options |> Option.map (fun x -> x.GetOrComputeValue()) - let tryGetSimilarBuilder options : NodeCode option = + let tryGetSimilarBuilder options : Async option = incrementalBuildersCache.TryGetSimilar(AnyCallerThread, options) |> Option.map (fun x -> x.GetOrComputeValue()) - let tryGetAnyBuilder options : NodeCode option = + let tryGetAnyBuilder options : Async option = incrementalBuildersCache.TryGetAny(AnyCallerThread, options) |> Option.map (fun x -> x.GetOrComputeValue()) @@ -493,16 +493,16 @@ type internal BackgroundCompiler getBuilderNode) let createAndGetBuilder (options, userOpName) = - node { - let! ct = NodeCode.CancellationToken + async { + let! ct = Async.CancellationToken let getBuilderNode = createBuilderNode (options, userOpName, ct) return! getBuilderNode.GetOrComputeValue() } - let getOrCreateBuilder (options, userOpName) : NodeCode = + let getOrCreateBuilder (options, userOpName) : Async = match tryGetBuilder options with | Some getBuilder -> - node { + async { match! getBuilder with | builderOpt, creationDiags when builderOpt.IsNone || not builderOpt.Value.IsReferencesInvalidated -> return builderOpt, creationDiags @@ -554,7 +554,7 @@ type internal BackgroundCompiler | _ -> let res = GraphNode( - node { + async { let! res = self.CheckOneFileImplAux( parseResults, @@ -640,7 +640,7 @@ type internal BackgroundCompiler /// Fetch the parse information from the background compiler (which checks w.r.t. the FileSystem API) member _.GetBackgroundParseResultsForFileInProject(fileName, options, userOpName) = - node { + async { use _ = Activity.start "BackgroundCompiler.GetBackgroundParseResultsForFileInProject" @@ -680,7 +680,7 @@ type internal BackgroundCompiler } member _.GetCachedCheckFileResult(builder: IncrementalBuilder, fileName, sourceText: ISourceText, options) = - node { + async { use _ = Activity.start "BackgroundCompiler.GetCachedCheckFileResult" [| Activity.Tags.fileName, fileName |] @@ -717,9 +717,9 @@ type internal BackgroundCompiler tcPrior: PartialCheckResults, tcInfo: TcInfo, creationDiags: FSharpDiagnostic[] - ) : NodeCode = + ) : Async = - node { + async { // Get additional script #load closure information if applicable. // For scripts, this will have been recorded by GetProjectOptionsFromScript. let tcConfig = tcPrior.TcConfig @@ -747,7 +747,7 @@ type internal BackgroundCompiler keepAssemblyContents, suggestNamesForErrors ) - |> NodeCode.FromCancellable + |> Cancellable.toAsync GraphNode.SetPreferredUILang tcConfig.preferredUiLang return (parseResults, checkAnswer, sourceText.GetHashCode() |> int64, tcPrior.ProjectTimeStamp) @@ -766,7 +766,7 @@ type internal BackgroundCompiler creationDiags: FSharpDiagnostic[] ) = - node { + async { match! bc.GetCachedCheckFileResult(builder, fileName, sourceText, options) with | Some(_, results) -> return FSharpCheckFileAnswer.Succeeded results | _ -> @@ -787,7 +787,7 @@ type internal BackgroundCompiler options, userOpName ) = - node { + async { use _ = Activity.start "BackgroundCompiler.CheckFileInProjectAllowingStaleCachedResults" @@ -798,7 +798,7 @@ type internal BackgroundCompiler |] let! cachedResults = - node { + async { let! builderOpt, creationDiags = getAnyBuilder (options, userOpName) match builderOpt with @@ -847,7 +847,7 @@ type internal BackgroundCompiler options, userOpName ) = - node { + async { use _ = Activity.start "BackgroundCompiler.CheckFileInProject" @@ -895,7 +895,7 @@ type internal BackgroundCompiler options: FSharpProjectOptions, userOpName ) = - node { + async { use _ = Activity.start "BackgroundCompiler.ParseAndCheckFileInProject" @@ -930,7 +930,7 @@ type internal BackgroundCompiler ) GraphNode.SetPreferredUILang tcPrior.TcConfig.preferredUiLang - let! ct = NodeCode.CancellationToken + let! ct = Async.CancellationToken let parseDiagnostics, parseTree, anyErrors = ParseAndCheckFile.parseFile ( @@ -964,7 +964,7 @@ type internal BackgroundCompiler } member _.NotifyFileChanged(fileName, options, userOpName) = - node { + async { use _ = Activity.start "BackgroundCompiler.NotifyFileChanged" @@ -983,7 +983,7 @@ type internal BackgroundCompiler /// Fetch the check information from the background compiler (which checks w.r.t. the FileSystem API) member _.GetBackgroundCheckResultsForFileInProject(fileName, options, userOpName) = - node { + async { use _ = Activity.start "BackgroundCompiler.ParseAndCheckFileInProject" @@ -1095,7 +1095,7 @@ type internal BackgroundCompiler canInvalidateProject: bool, userOpName: string ) = - node { + async { use _ = Activity.start "BackgroundCompiler.FindReferencesInFile" @@ -1123,7 +1123,7 @@ type internal BackgroundCompiler } member _.GetSemanticClassificationForFile(fileName: string, options: FSharpProjectOptions, userOpName: string) = - node { + async { use _ = Activity.start "BackgroundCompiler.GetSemanticClassificationForFile" @@ -1190,7 +1190,7 @@ type internal BackgroundCompiler /// Parse and typecheck the whole project (the implementation, called recursively as project graph is evaluated) member private _.ParseAndCheckProjectImpl(options, userOpName) = - node { + async { let! builderOpt, creationDiags = getOrCreateBuilder (options, userOpName) @@ -1263,7 +1263,7 @@ type internal BackgroundCompiler } member _.GetAssemblyData(options, userOpName) = - node { + async { use _ = Activity.start "BackgroundCompiler.GetAssemblyData" @@ -1516,7 +1516,7 @@ type internal BackgroundCompiler sourceText: ISourceText, options: FSharpProjectOptions, userOpName: string - ) : NodeCode = + ) : Async = self.CheckFileInProject(parseResults, fileName, fileVersion, sourceText, options, userOpName) member _.CheckFileInProjectAllowingStaleCachedResults @@ -1527,7 +1527,7 @@ type internal BackgroundCompiler sourceText: ISourceText, options: FSharpProjectOptions, userOpName: string - ) : NodeCode = + ) : Async = self.CheckFileInProjectAllowingStaleCachedResults(parseResults, fileName, fileVersion, sourceText, options, userOpName) member _.ClearCache(options: seq, userOpName: string) : unit = self.ClearCache(options, userOpName) @@ -1546,7 +1546,7 @@ type internal BackgroundCompiler symbol: FSharpSymbol, canInvalidateProject: bool, userOpName: string - ) : NodeCode> = + ) : Async> = self.FindReferencesInFile(fileName, options, symbol, canInvalidateProject, userOpName) member this.FindReferencesInFile(fileName, projectSnapshot, symbol, userOpName) = @@ -1559,7 +1559,7 @@ type internal BackgroundCompiler options: FSharpProjectOptions, _fileName: string, userOpName: string - ) : NodeCode = + ) : Async = self.GetAssemblyData(options, userOpName) member _.GetAssemblyData @@ -1567,7 +1567,7 @@ type internal BackgroundCompiler projectSnapshot: FSharpProjectSnapshot, _fileName: string, userOpName: string - ) : NodeCode = + ) : Async = self.GetAssemblyData(projectSnapshot.ToOptions(), userOpName) member _.GetBackgroundCheckResultsForFileInProject @@ -1575,7 +1575,7 @@ type internal BackgroundCompiler fileName: string, options: FSharpProjectOptions, userOpName: string - ) : NodeCode = + ) : Async = self.GetBackgroundCheckResultsForFileInProject(fileName, options, userOpName) member _.GetBackgroundParseResultsForFileInProject @@ -1583,7 +1583,7 @@ type internal BackgroundCompiler fileName: string, options: FSharpProjectOptions, userOpName: string - ) : NodeCode = + ) : Async = self.GetBackgroundParseResultsForFileInProject(fileName, options, userOpName) member _.GetCachedCheckFileResult @@ -1592,7 +1592,7 @@ type internal BackgroundCompiler fileName: string, sourceText: ISourceText, options: FSharpProjectOptions - ) : NodeCode<(FSharpParseFileResults * FSharpCheckFileResults) option> = + ) : Async<(FSharpParseFileResults * FSharpCheckFileResults) option> = self.GetCachedCheckFileResult(builder, fileName, sourceText, options) member _.GetProjectOptionsFromScript @@ -1662,7 +1662,7 @@ type internal BackgroundCompiler fileName: string, options: FSharpProjectOptions, userOpName: string - ) : NodeCode = + ) : Async = self.GetSemanticClassificationForFile(fileName, options, userOpName) member _.GetSemanticClassificationForFile @@ -1670,7 +1670,7 @@ type internal BackgroundCompiler fileName: string, snapshot: FSharpProjectSnapshot, userOpName: string - ) : NodeCode = + ) : Async = self.GetSemanticClassificationForFile(fileName, snapshot.ToOptions(), userOpName) member _.InvalidateConfiguration(options: FSharpProjectOptions, userOpName: string) : unit = @@ -1680,7 +1680,7 @@ type internal BackgroundCompiler let options = projectSnapshot.ToOptions() self.InvalidateConfiguration(options, userOpName) - member _.NotifyFileChanged(fileName: string, options: FSharpProjectOptions, userOpName: string) : NodeCode = + member _.NotifyFileChanged(fileName: string, options: FSharpProjectOptions, userOpName: string) : Async = self.NotifyFileChanged(fileName, options, userOpName) member _.NotifyProjectCleaned(options: FSharpProjectOptions, userOpName: string) : Async = @@ -1693,7 +1693,7 @@ type internal BackgroundCompiler sourceText: ISourceText, options: FSharpProjectOptions, userOpName: string - ) : NodeCode = + ) : Async = self.ParseAndCheckFileInProject(fileName, fileVersion, sourceText, options, userOpName) member _.ParseAndCheckFileInProject @@ -1701,22 +1701,22 @@ type internal BackgroundCompiler fileName: string, projectSnapshot: FSharpProjectSnapshot, userOpName: string - ) : NodeCode = - node { + ) : Async = + async { let fileSnapshot = projectSnapshot.ProjectSnapshot.SourceFiles |> Seq.find (fun f -> f.FileName = fileName) - let! sourceText = fileSnapshot.GetSource() |> NodeCode.AwaitTask + let! sourceText = fileSnapshot.GetSource() |> Async.AwaitTask let options = projectSnapshot.ToOptions() return! self.ParseAndCheckFileInProject(fileName, 0, sourceText, options, userOpName) } - member _.ParseAndCheckProject(options: FSharpProjectOptions, userOpName: string) : NodeCode = + member _.ParseAndCheckProject(options: FSharpProjectOptions, userOpName: string) : Async = self.ParseAndCheckProject(options, userOpName) - member _.ParseAndCheckProject(projectSnapshot: FSharpProjectSnapshot, userOpName: string) : NodeCode = + member _.ParseAndCheckProject(projectSnapshot: FSharpProjectSnapshot, userOpName: string) : Async = self.ParseAndCheckProject(projectSnapshot.ToOptions(), userOpName) member _.ParseFile @@ -1734,7 +1734,6 @@ type internal BackgroundCompiler let options = projectSnapshot.ToOptions() self.GetBackgroundParseResultsForFileInProject(fileName, options, userOpName) - |> Async.AwaitNodeCode member _.ProjectChecked: IEvent = self.ProjectChecked diff --git a/src/Compiler/Service/BackgroundCompiler.fsi b/src/Compiler/Service/BackgroundCompiler.fsi index fff6324be35..6d35bf40705 100644 --- a/src/Compiler/Service/BackgroundCompiler.fsi +++ b/src/Compiler/Service/BackgroundCompiler.fsi @@ -32,7 +32,7 @@ type internal IBackgroundCompiler = sourceText: ISourceText * options: FSharpProjectOptions * userOpName: string -> - NodeCode + Async /// Type-check the result obtained by parsing, but only if the antecedent type checking context is available. abstract CheckFileInProjectAllowingStaleCachedResults: @@ -42,7 +42,7 @@ type internal IBackgroundCompiler = sourceText: ISourceText * options: FSharpProjectOptions * userOpName: string -> - NodeCode + Async abstract ClearCache: options: FSharpProjectOptions seq * userOpName: string -> unit @@ -57,7 +57,7 @@ type internal IBackgroundCompiler = projectSnapshot: FSharpProjectSnapshot * symbol: FSharp.Compiler.Symbols.FSharpSymbol * userOpName: string -> - NodeCode + Async abstract FindReferencesInFile: fileName: string * @@ -65,28 +65,28 @@ type internal IBackgroundCompiler = symbol: FSharp.Compiler.Symbols.FSharpSymbol * canInvalidateProject: bool * userOpName: string -> - NodeCode + Async abstract GetAssemblyData: projectSnapshot: FSharpProjectSnapshot * outputFileName: string * userOpName: string -> - NodeCode + Async abstract GetAssemblyData: options: FSharpProjectOptions * outputFileName: string * userOpName: string -> - NodeCode + Async /// Fetch the check information from the background compiler (which checks w.r.t. the FileSystem API) abstract GetBackgroundCheckResultsForFileInProject: fileName: string * options: FSharpProjectOptions * userOpName: string -> - NodeCode + Async /// Fetch the parse information from the background compiler (which checks w.r.t. the FileSystem API) abstract GetBackgroundParseResultsForFileInProject: - fileName: string * options: FSharpProjectOptions * userOpName: string -> NodeCode + fileName: string * options: FSharpProjectOptions * userOpName: string -> Async abstract GetCachedCheckFileResult: builder: IncrementalBuilder * fileName: string * sourceText: ISourceText * options: FSharpProjectOptions -> - NodeCode<(FSharpParseFileResults * FSharpCheckFileResults) option> + Async<(FSharpParseFileResults * FSharpCheckFileResults) option> abstract GetProjectOptionsFromScript: fileName: string * @@ -118,23 +118,23 @@ type internal IBackgroundCompiler = abstract GetSemanticClassificationForFile: fileName: string * snapshot: FSharpProjectSnapshot * userOpName: string -> - NodeCode + Async abstract GetSemanticClassificationForFile: fileName: string * options: FSharpProjectOptions * userOpName: string -> - NodeCode + Async abstract InvalidateConfiguration: options: FSharpProjectOptions * userOpName: string -> unit abstract InvalidateConfiguration: projectSnapshot: FSharpProjectSnapshot * userOpName: string -> unit - abstract NotifyFileChanged: fileName: string * options: FSharpProjectOptions * userOpName: string -> NodeCode + abstract NotifyFileChanged: fileName: string * options: FSharpProjectOptions * userOpName: string -> Async abstract NotifyProjectCleaned: options: FSharpProjectOptions * userOpName: string -> Async abstract ParseAndCheckFileInProject: fileName: string * projectSnapshot: FSharpProjectSnapshot * userOpName: string -> - NodeCode + Async /// Parses and checks the source file and returns untyped AST and check results. abstract ParseAndCheckFileInProject: @@ -143,14 +143,14 @@ type internal IBackgroundCompiler = sourceText: ISourceText * options: FSharpProjectOptions * userOpName: string -> - NodeCode + Async abstract ParseAndCheckProject: - projectSnapshot: FSharpProjectSnapshot * userOpName: string -> NodeCode + projectSnapshot: FSharpProjectSnapshot * userOpName: string -> Async /// Parse and typecheck the whole project. abstract ParseAndCheckProject: - options: FSharpProjectOptions * userOpName: string -> NodeCode + options: FSharpProjectOptions * userOpName: string -> Async abstract ParseFile: fileName: string * projectSnapshot: FSharpProjectSnapshot * userOpName: string -> Async diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index f59a1e9b6a5..1704af36bef 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -136,7 +136,7 @@ module IncrementalBuildSyntaxTree = ), sourceRange, fileName, [||] let parse (source: FSharpSource) = - node { + async { IncrementalBuilderEventTesting.MRU.Add(IncrementalBuilderEventTesting.IBEParsed fileName) use _ = Activity.start "IncrementalBuildSyntaxTree.parse" @@ -149,9 +149,9 @@ module IncrementalBuildSyntaxTree = let diagnosticsLogger = CompilationDiagnosticLogger("Parse", tcConfig.diagnosticsOptions) // Return the disposable object that cleans up use _holder = new CompilationGlobalsScope(diagnosticsLogger, BuildPhase.Parse) - use! text = source.GetTextContainer() |> NodeCode.AwaitAsync + use! text = source.GetTextContainer() let input = - match text :?> TextContainer with + match text with | TextContainer.Stream(stream) -> ParseOneInputStream(tcConfig, lexResourceManager, fileName, isLastCompiland, diagnosticsLogger, false, stream) | TextContainer.SourceText(sourceText) -> @@ -252,8 +252,8 @@ type BoundModel private ( ?tcStateOpt: GraphNode * GraphNode ) = - let getTypeCheck (syntaxTree: SyntaxTree) : NodeCode = - node { + let getTypeCheck (syntaxTree: SyntaxTree) : Async = + async { let! input, _sourceRange, fileName, parseErrors = syntaxTree.ParseNode.GetOrComputeValue() use _ = Activity.start "BoundModel.TypeCheck" [|Activity.Tags.fileName, fileName|] @@ -277,7 +277,7 @@ type BoundModel private ( None, TcResultsSink.WithSink sink, prevTcInfo.tcState, input ) - |> NodeCode.FromCancellable + |> Cancellable.toAsync fileChecked.Trigger fileName @@ -322,13 +322,13 @@ type BoundModel private ( | _ -> None let getTcInfo (typeCheck: GraphNode) = - node { + async { let! tcInfo , _, _, _, _ = typeCheck.GetOrComputeValue() return tcInfo } |> GraphNode let getTcInfoExtras (typeCheck: GraphNode) = - node { + async { let! _ , sink, implFile, fileName, _ = typeCheck.GetOrComputeValue() // Build symbol keys let itemKeyStore, semanticClassification = @@ -366,17 +366,17 @@ type BoundModel private ( } } |> GraphNode - let defaultTypeCheck = node { return prevTcInfo, TcResultsSinkImpl(tcGlobals), None, "default typecheck - no syntaxTree", [||] } + let defaultTypeCheck = async { return prevTcInfo, TcResultsSinkImpl(tcGlobals), None, "default typecheck - no syntaxTree", [||] } let typeCheckNode = syntaxTreeOpt |> Option.map getTypeCheck |> Option.defaultValue defaultTypeCheck |> GraphNode let tcInfoExtras = getTcInfoExtras typeCheckNode let diagnostics = - node { + async { let! _, _, _, _, diags = typeCheckNode.GetOrComputeValue() return diags } |> GraphNode let startComputingFullTypeCheck = - node { + async { let! _ = tcInfoExtras.GetOrComputeValue() return! diagnostics.GetOrComputeValue() } @@ -391,7 +391,7 @@ type BoundModel private ( GraphNode.FromResult tcInfo, tcInfoExtras | _ -> // start computing extras, so that typeCheckNode can be GC'd quickly - startComputingFullTypeCheck |> Async.AwaitNodeCode |> Async.Catch |> Async.Ignore |> Async.Start + startComputingFullTypeCheck |> Async.Catch |> Async.Ignore |> Async.Start getTcInfo typeCheckNode, tcInfoExtras member val Diagnostics = diagnostics @@ -417,13 +417,13 @@ type BoundModel private ( member this.GetOrComputeTcInfoExtras = this.TcInfoExtras.GetOrComputeValue - member this.GetOrComputeTcInfoWithExtras() = node { + member this.GetOrComputeTcInfoWithExtras() = async { let! tcInfo = this.TcInfo.GetOrComputeValue() let! tcInfoExtras = this.TcInfoExtras.GetOrComputeValue() return tcInfo, tcInfoExtras } - member this.Next(syntaxTree) = node { + member this.Next(syntaxTree) = async { let! tcInfo = this.TcInfo.GetOrComputeValue() return BoundModel( @@ -442,7 +442,7 @@ type BoundModel private ( } member this.Finish(finalTcDiagnosticsRev, finalTopAttribs) = - node { + async { let! tcInfo = this.TcInfo.GetOrComputeValue() let finishState = { tcInfo with tcDiagnosticsRev = finalTcDiagnosticsRev; topAttribs = finalTopAttribs } return @@ -536,7 +536,7 @@ type FrameworkImportsCache(size) = match frameworkTcImportsCache.TryGet (AnyCallerThread, key) with | Some lazyWork -> lazyWork | None -> - let lazyWork = GraphNode(node { + let lazyWork = GraphNode(async { let tcConfigP = TcConfigProvider.Constant tcConfig return! TcImports.BuildFrameworkTcImports (tcConfigP, frameworkDLLs, nonFrameworkResolutions) }) @@ -548,7 +548,7 @@ type FrameworkImportsCache(size) = /// This function strips the "System" assemblies from the tcConfig and returns a age-cached TcImports for them. member this.Get(tcConfig: TcConfig) = - node { + async { // Split into installed and not installed. let frameworkDLLs, nonFrameworkResolutions, unresolved = TcAssemblyResolutions.SplitNonFoundationalResolutions(tcConfig) let node = this.GetNode(tcConfig, frameworkDLLs, nonFrameworkResolutions) @@ -579,13 +579,13 @@ type PartialCheckResults (boundModel: BoundModel, timeStamp: DateTime, projectTi member _.GetOrComputeTcInfoWithExtras() = boundModel.GetOrComputeTcInfoWithExtras() member _.GetOrComputeItemKeyStoreIfEnabled() = - node { + async { let! info = boundModel.GetOrComputeTcInfoExtras() return info.itemKeyStore } member _.GetOrComputeSemanticClassificationIfEnabled() = - node { + async { let! info = boundModel.GetOrComputeTcInfoExtras() return info.semanticClassificationKeyStore } @@ -658,14 +658,14 @@ module IncrementalBuilderHelpers = #if !NO_TYPEPROVIDERS ,importsInvalidatedByTypeProvider: Event #endif - ) : NodeCode = + ) : Async = - node { + async { let diagnosticsLogger = CompilationDiagnosticLogger("CombineImportedAssembliesTask", tcConfig.diagnosticsOptions) use _ = new CompilationGlobalsScope(diagnosticsLogger, BuildPhase.Parameter) let! tcImports = - node { + async { try let! tcImports = TcImports.BuildNonFrameworkTcImports(tcConfigP, frameworkTcImports, nonFrameworkResolutions, unresolvedReferences, dependencyProvider) #if !NO_TYPEPROVIDERS @@ -736,28 +736,28 @@ module IncrementalBuilderHelpers = /// Finish up the typechecking to produce outputs for the rest of the compilation process let FinalizeTypeCheckTask (tcConfig: TcConfig) tcGlobals partialCheck assemblyName outfile (boundModels: GraphNode seq) = - node { + async { let diagnosticsLogger = CompilationDiagnosticLogger("FinalizeTypeCheckTask", tcConfig.diagnosticsOptions) use _ = new CompilationGlobalsScope(diagnosticsLogger, BuildPhase.TypeCheck) - let! computedBoundModels = boundModels |> Seq.map (fun g -> g.GetOrComputeValue()) |> NodeCode.Sequential + let! computedBoundModels = boundModels |> Seq.map (fun g -> g.GetOrComputeValue()) |> Async.Sequential let! tcInfos = computedBoundModels - |> Seq.map (fun boundModel -> node { return! boundModel.GetOrComputeTcInfo() }) - |> NodeCode.Sequential + |> Seq.map (fun boundModel -> async { return! boundModel.GetOrComputeTcInfo() }) + |> Async.Sequential // tcInfoExtras can be computed in parallel. This will check any previously skipped implementation files in parallel, too. let! latestImplFiles = computedBoundModels - |> Seq.map (fun boundModel -> node { + |> Seq.map (fun boundModel -> async { if partialCheck then return None else let! tcInfoExtras = boundModel.GetOrComputeTcInfoExtras() return tcInfoExtras.latestImplFile }) - |> NodeCode.Parallel + |> Async.Parallel let results = [ for tcInfo, latestImplFile in Seq.zip tcInfos latestImplFiles -> @@ -826,7 +826,7 @@ module IncrementalBuilderHelpers = let! partialDiagnostics = computedBoundModels |> Seq.map (fun m -> m.Diagnostics.GetOrComputeValue()) - |> NodeCode.Parallel + |> Async.Parallel let diagnostics = [ diagnosticsLogger.GetDiagnostics() yield! partialDiagnostics |> Seq.rev @@ -949,13 +949,13 @@ module IncrementalBuilderStateHelpers = type BuildStatus = Invalidated | Good let createBoundModelGraphNode (prevBoundModel: GraphNode) syntaxTree = - GraphNode(node { + GraphNode(async { let! prevBoundModel = prevBoundModel.GetOrComputeValue() return! prevBoundModel.Next(syntaxTree) }) let createFinalizeBoundModelGraphNode (initialState: IncrementalBuilderInitialState) (boundModels: GraphNode seq) = - GraphNode(node { + GraphNode(async { use _ = Activity.start "GetCheckResultsAndImplementationsForProject" [|Activity.Tags.project, initialState.outfile|] let! result = FinalizeTypeCheckTask @@ -1123,7 +1123,7 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc tryGetSlot state (slot - 1) let evalUpToTargetSlot (state: IncrementalBuilderState) targetSlot = - node { + async { if targetSlot < 0 then return Some(initialBoundModel, defaultTimeStamp) else @@ -1155,8 +1155,8 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc let mutable currentState = state let setCurrentState state cache (ct: CancellationToken) = - node { - do! semaphore.WaitAsync(ct) |> NodeCode.AwaitTask + async { + do! semaphore.WaitAsync(ct) |> Async.AwaitTask try ct.ThrowIfCancellationRequested() currentState <- computeStampedFileNames initialState state cache @@ -1165,8 +1165,8 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc } let checkFileTimeStamps (cache: TimeStampCache) = - node { - let! ct = NodeCode.CancellationToken + async { + let! ct = Async.CancellationToken do! setCurrentState currentState cache ct } @@ -1196,7 +1196,7 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc member _.AllDependenciesDeprecated = allDependencies member _.PopulatePartialCheckingResults () = - node { + async { let cache = TimeStampCache defaultTimeStamp // One per step do! checkFileTimeStamps cache let! _ = currentState.finalizedBoundModel.GetOrComputeValue() @@ -1238,7 +1238,7 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc (builder.TryGetCheckResultsBeforeFileInProject fileName).IsSome member builder.GetCheckResultsBeforeSlotInProject slotOfFile = - node { + async { let cache = TimeStampCache defaultTimeStamp do! checkFileTimeStamps cache let! result = evalUpToTargetSlot currentState (slotOfFile - 1) @@ -1250,7 +1250,7 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc } member builder.GetFullCheckResultsBeforeSlotInProject slotOfFile = - node { + async { let cache = TimeStampCache defaultTimeStamp do! checkFileTimeStamps cache let! result = evalUpToTargetSlot currentState (slotOfFile - 1) @@ -1275,7 +1275,7 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc builder.GetFullCheckResultsBeforeSlotInProject slotOfFile member builder.GetFullCheckResultsAfterFileInProject fileName = - node { + async { let slotOfFile = builder.GetSlotOfFileName fileName + 1 let! result = builder.GetFullCheckResultsBeforeSlotInProject(slotOfFile) return result @@ -1285,7 +1285,7 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc builder.GetCheckResultsBeforeSlotInProject(builder.GetSlotsCount()) member builder.GetCheckResultsAndImplementationsForProject() = - node { + async { let cache = TimeStampCache(defaultTimeStamp) do! checkFileTimeStamps cache let! result = currentState.finalizedBoundModel.GetOrComputeValue() @@ -1297,7 +1297,7 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc } member builder.GetFullCheckResultsAndImplementationsForProject() = - node { + async { let! result = builder.GetCheckResultsAndImplementationsForProject() let results, _, _, _ = result let! _ = results.GetOrComputeTcInfoWithExtras() // Make sure we forcefully evaluate the info @@ -1342,14 +1342,13 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc let slotOfFile = builder.GetSlotOfFileName fileName let syntaxTree = currentState.slots[slotOfFile].SyntaxTree syntaxTree.ParseNode.GetOrComputeValue() - |> Async.AwaitNodeCode |> Async.RunSynchronously member builder.NotifyFileChanged(fileName, timeStamp) = - node { + async { let slotOfFile = builder.GetSlotOfFileName fileName let cache = TimeStampCache defaultTimeStamp - let! ct = NodeCode.CancellationToken + let! ct = Async.CancellationToken do! setCurrentState { currentState with slots = currentState.slots |> List.updateAt slotOfFile (currentState.slots[slotOfFile].Notify timeStamp) } @@ -1388,14 +1387,14 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc let useSimpleResolutionSwitch = "--simpleresolution" - node { + async { // Trap and report diagnostics from creation. let delayedLogger = CapturingDiagnosticsLogger("IncrementalBuilderCreation") use _ = new CompilationGlobalsScope(delayedLogger, BuildPhase.Parameter) let! builderOpt = - node { + async { try // Create the builder. diff --git a/src/Compiler/Service/IncrementalBuild.fsi b/src/Compiler/Service/IncrementalBuild.fsi index 0dedfb02948..f3bbe6a40d6 100644 --- a/src/Compiler/Service/IncrementalBuild.fsi +++ b/src/Compiler/Service/IncrementalBuild.fsi @@ -38,7 +38,7 @@ type internal FrameworkImportsCacheKey = type internal FrameworkImportsCache = new: size: int -> FrameworkImportsCache - member Get: TcConfig -> NodeCode + member Get: TcConfig -> Async member Clear: unit -> unit @@ -121,25 +121,25 @@ type internal PartialCheckResults = /// Compute the "TcInfo" part of the results. If `enablePartialTypeChecking` is false then /// extras will also be available. - member GetOrComputeTcInfo: unit -> NodeCode + member GetOrComputeTcInfo: unit -> Async /// Compute both the "TcInfo" and "TcInfoExtras" parts of the results. /// Can cause a second type-check if `enablePartialTypeChecking` is true in the checker. /// Only use when it's absolutely necessary to get rich information on a file. - member GetOrComputeTcInfoWithExtras: unit -> NodeCode + member GetOrComputeTcInfoWithExtras: unit -> Async /// Compute the "ItemKeyStore" parts of the results. /// Can cause a second type-check if `enablePartialTypeChecking` is true in the checker. /// Only use when it's absolutely necessary to get rich information on a file. /// /// Will return 'None' for enableBackgroundItemKeyStoreAndSemanticClassification=false. - member GetOrComputeItemKeyStoreIfEnabled: unit -> NodeCode + member GetOrComputeItemKeyStoreIfEnabled: unit -> Async /// Can cause a second type-check if `enablePartialTypeChecking` is true in the checker. /// Only use when it's absolutely necessary to get rich information on a file. /// /// Will return 'None' for enableBackgroundItemKeyStoreAndSemanticClassification=false. - member GetOrComputeSemanticClassificationIfEnabled: unit -> NodeCode + member GetOrComputeSemanticClassificationIfEnabled: unit -> Async member TimeStamp: DateTime @@ -194,7 +194,7 @@ type internal IncrementalBuilder = member AllDependenciesDeprecated: string[] /// The project build. Return true if the background work is finished. - member PopulatePartialCheckingResults: unit -> NodeCode + member PopulatePartialCheckingResults: unit -> Async /// Get the preceding typecheck state of a slot, without checking if it is up-to-date w.r.t. /// the timestamps on files and referenced DLLs prior to this one. Return None if the result is not available. @@ -228,38 +228,38 @@ type internal IncrementalBuilder = /// Get the preceding typecheck state of a slot. Compute the entire type check of the project up /// to the necessary point if the result is not available. This may be a long-running operation. - member GetCheckResultsBeforeFileInProject: fileName: string -> NodeCode + member GetCheckResultsBeforeFileInProject: fileName: string -> Async /// Get the preceding typecheck state of a slot. Compute the entire type check of the project up /// to the necessary point if the result is not available. This may be a long-running operation. /// This will get full type-check info for the file, meaning no partial type-checking. - member GetFullCheckResultsBeforeFileInProject: fileName: string -> NodeCode + member GetFullCheckResultsBeforeFileInProject: fileName: string -> Async /// Get the typecheck state after checking a file. Compute the entire type check of the project up /// to the necessary point if the result is not available. This may be a long-running operation. - member GetCheckResultsAfterFileInProject: fileName: string -> NodeCode + member GetCheckResultsAfterFileInProject: fileName: string -> Async /// Get the typecheck state after checking a file. Compute the entire type check of the project up /// to the necessary point if the result is not available. This may be a long-running operation. /// This will get full type-check info for the file, meaning no partial type-checking. - member GetFullCheckResultsAfterFileInProject: fileName: string -> NodeCode + member GetFullCheckResultsAfterFileInProject: fileName: string -> Async /// Get the typecheck result after the end of the last file. The typecheck of the project is not 'completed'. /// This may be a long-running operation. - member GetCheckResultsAfterLastFileInProject: unit -> NodeCode + member GetCheckResultsAfterLastFileInProject: unit -> Async /// Get the final typecheck result. If 'generateTypedImplFiles' was set on Create then the CheckedAssemblyAfterOptimization will contain implementations. /// This may be a long-running operation. member GetCheckResultsAndImplementationsForProject: unit -> - NodeCode + Async /// Get the final typecheck result. If 'generateTypedImplFiles' was set on Create then the CheckedAssemblyAfterOptimization will contain implementations. /// This may be a long-running operation. /// This will get full type-check info for the project, meaning no partial type-checking. member GetFullCheckResultsAndImplementationsForProject: unit -> - NodeCode + Async /// Get the logical time stamp that is associated with the output of the project if it were fully built immediately member GetLogicalTimeStampForProject: TimeStampCache -> DateTime @@ -273,7 +273,7 @@ type internal IncrementalBuilder = member GetParseResultsForFile: fileName: string -> ParsedInput * range * string * (PhasedDiagnostic * FSharpDiagnosticSeverity)[] - member NotifyFileChanged: fileName: string * timeStamp: DateTime -> NodeCode + member NotifyFileChanged: fileName: string * timeStamp: DateTime -> Async /// Create the incremental builder static member TryCreateIncrementalBuilderForProjectOptions: @@ -299,7 +299,7 @@ type internal IncrementalBuilder = getSource: (string -> Async) option * useChangeNotifications: bool * useSyntaxTreeCache: bool -> - NodeCode + Async /// Generalized Incremental Builder. This is exposed only for unit testing purposes. module internal IncrementalBuild = diff --git a/src/Compiler/Service/TransparentCompiler.fs b/src/Compiler/Service/TransparentCompiler.fs index c5ecfba812f..70466c5d7e8 100644 --- a/src/Compiler/Service/TransparentCompiler.fs +++ b/src/Compiler/Service/TransparentCompiler.fs @@ -417,7 +417,7 @@ type internal TransparentCompiler caches.ScriptClosure.Get( key, - node { + async { let reduceMemoryUsage = ReduceMemoryFlag.Yes let applyCompilerOptions tcConfig = @@ -467,7 +467,7 @@ type internal TransparentCompiler caches.FrameworkImports.Get( key, - node { + async { use _ = Activity.start "ComputeFrameworkImports" [] let tcConfigP = TcConfigProvider.Constant tcConfig @@ -491,14 +491,14 @@ type internal TransparentCompiler importsInvalidatedByTypeProvider: Event ) = - node { + async { let diagnosticsLogger = CompilationDiagnosticLogger("CombineImportedAssembliesTask", tcConfig.diagnosticsOptions) use _ = new CompilationGlobalsScope(diagnosticsLogger, BuildPhase.Parameter) let! tcImports = - node { + async { try let! tcImports = TcImports.BuildNonFrameworkTcImports( @@ -603,7 +603,7 @@ type internal TransparentCompiler then { new IProjectReference with member x.EvaluateRawContents() = - node { + async { Trace.TraceInformation("FCS: {0}.{1} ({2})", userOpName, "GetAssemblyData", nm) return! @@ -623,8 +623,8 @@ type internal TransparentCompiler | FSharpReferencedProjectSnapshot.PEReference(getStamp, delayedReader) -> { new IProjectReference with member x.EvaluateRawContents() = - node { - let! ilReaderOpt = delayedReader.TryGetILModuleReader() |> NodeCode.FromCancellable + async { + let! ilReaderOpt = delayedReader.TryGetILModuleReader() |> Cancellable.toAsync match ilReaderOpt with | Some ilReader -> @@ -650,7 +650,7 @@ type internal TransparentCompiler let data = RawFSharpAssemblyData(ilModuleDef, ilAsmRefs) :> IRawFSharpAssemblyData return ProjectAssemblyDataResult.Available data } - |> NodeCode.FromCancellable + |> Cancellable.toAsync member x.TryGetLogicalTimeStamp _ = getStamp () |> Some member x.FileName = nm @@ -658,7 +658,7 @@ type internal TransparentCompiler ] let ComputeTcConfigBuilder (projectSnapshot: ProjectSnapshot) = - node { + async { let useSimpleResolutionSwitch = "--simpleresolution" let commandLineArgs = projectSnapshot.CommandLineOptions let defaultFSharpBinariesDir = FSharpCheckerResultsSettings.defaultFSharpBinariesDir @@ -678,8 +678,8 @@ type internal TransparentCompiler let! (loadClosureOpt: LoadClosure option) = match projectSnapshot.SourceFiles, projectSnapshot.UseScriptResolutionRules with | [ fsxFile ], true -> // assuming UseScriptResolutionRules and a single source file means we are doing this for a script - node { - let! source = fsxFile.GetSource() |> NodeCode.AwaitTask + async { + let! source = fsxFile.GetSource() |> Async.AwaitTask let! closure = ComputeScriptClosure @@ -697,7 +697,7 @@ type internal TransparentCompiler return (Some closure) } - | _ -> node { return None } + | _ -> async { return None } let sdkDirOverride = match loadClosureOpt with @@ -775,7 +775,7 @@ type internal TransparentCompiler caches.BootstrapInfoStatic.Get( cacheKey, - node { + async { use _ = Activity.start "ComputeBootstrapInfoStatic" @@ -856,7 +856,7 @@ type internal TransparentCompiler ) let computeBootstrapInfoInner (projectSnapshot: ProjectSnapshot) = - node { + async { let! tcConfigB, sourceFiles, loadClosureOpt = ComputeTcConfigBuilder projectSnapshot @@ -932,7 +932,7 @@ type internal TransparentCompiler caches.BootstrapInfo.Get( projectSnapshot.NoFileVersionsKey, - node { + async { use _ = Activity.start "ComputeBootstrapInfo" [| Activity.Tags.project, projectSnapshot.ProjectFileName |> Path.GetFileName |] @@ -941,7 +941,7 @@ type internal TransparentCompiler use _ = new CompilationGlobalsScope(delayedLogger, BuildPhase.Parameter) let! bootstrapInfoOpt = - node { + async { try return! computeBootstrapInfoInner projectSnapshot with exn -> @@ -974,8 +974,8 @@ type internal TransparentCompiler // TODO: Not sure if we should cache this. For VS probably not. Maybe it can be configurable by FCS user. let LoadSource (file: FSharpFileSnapshot) isExe isLastCompiland = - node { - let! source = file.GetSource() |> NodeCode.AwaitTask + async { + let! source = file.GetSource() |> Async.AwaitTask return FSharpFileSnapshotWithSource( @@ -988,13 +988,13 @@ type internal TransparentCompiler } let LoadSources (bootstrapInfo: BootstrapInfo) (projectSnapshot: ProjectSnapshot) = - node { + async { let isExe = bootstrapInfo.TcConfig.target.IsExe let! sources = projectSnapshot.SourceFiles |> Seq.map (fun f -> LoadSource f isExe (f.FileName = bootstrapInfo.LastFileName)) - |> NodeCode.Parallel + |> Async.Parallel return ProjectSnapshotWithSources(projectSnapshot.ProjectCore, sources |> Array.toList) @@ -1018,7 +1018,7 @@ type internal TransparentCompiler caches.ParseFile.Get( key, - node { + async { use _ = Activity.start "ComputeParseFile" @@ -1062,7 +1062,7 @@ type internal TransparentCompiler |> Graph.make let computeDependencyGraph (tcConfig: TcConfig) parsedInputs (processGraph: Graph -> Graph) = - node { + async { let sourceFiles: FileInProject array = parsedInputs |> Seq.toArray @@ -1196,7 +1196,7 @@ type internal TransparentCompiler caches.TcIntermediate.Get( key, - node { + async { let file = projectSnapshot.SourceFiles[index] @@ -1274,7 +1274,6 @@ type internal TransparentCompiler input, true) |> Cancellable.toAsync - |> NodeCode.AwaitAsync //fileChecked.Trigger fileName @@ -1302,7 +1301,6 @@ type internal TransparentCompiler let! tcIntermediate = ComputeTcIntermediate projectSnapshot dependencyFiles index fileNode bootstrapInfo tcInfo - |> Async.AwaitNodeCode let (Finisher(node = node; finisher = finisher)) = tcIntermediate.finisher @@ -1401,11 +1399,11 @@ type internal TransparentCompiler } let parseSourceFiles (projectSnapshot: ProjectSnapshotWithSources) tcConfig = - node { + async { let! parsedInputs = projectSnapshot.SourceFiles |> Seq.map (ComputeParseFile projectSnapshot tcConfig) - |> NodeCode.Parallel + |> Async.Parallel return ProjectSnapshotBase<_>(projectSnapshot.ProjectCore, parsedInputs |> Array.toList) } @@ -1416,7 +1414,7 @@ type internal TransparentCompiler caches.TcLastFile.Get( projectSnapshot.FileKey fileName, - node { + async { let file = projectSnapshot.SourceFiles |> List.last use _ = @@ -1431,7 +1429,6 @@ type internal TransparentCompiler graph (processGraphNode projectSnapshot bootstrapInfo dependencyFiles false) bootstrapInfo.InitialTcInfo - |> NodeCode.AwaitAsync let lastResult = results |> List.head |> snd @@ -1440,7 +1437,7 @@ type internal TransparentCompiler ) let getParseResult (projectSnapshot: ProjectSnapshot) creationDiags file (tcConfig: TcConfig) = - node { + async { let! parsedFile = ComputeParseFile projectSnapshot tcConfig file let parseDiagnostics = @@ -1473,7 +1470,7 @@ type internal TransparentCompiler let ComputeParseAndCheckFileInProject (fileName: string) (projectSnapshot: ProjectSnapshot) = caches.ParseAndCheckFileInProject.Get( projectSnapshot.FileKeyWithExtraFileSnapshotVersion fileName, - node { + async { use _ = Activity.start "ComputeParseAndCheckFileInProject" [| Activity.Tags.fileName, fileName |> Path.GetFileName |] @@ -1585,7 +1582,7 @@ type internal TransparentCompiler let ComputeParseAndCheckAllFilesInProject (bootstrapInfo: BootstrapInfo) (projectSnapshot: ProjectSnapshotWithSources) = caches.ParseAndCheckAllFilesInProject.Get( projectSnapshot.FullKey, - node { + async { use _ = Activity.start "ComputeParseAndCheckAllFilesInProject" @@ -1600,7 +1597,6 @@ type internal TransparentCompiler graph (processGraphNode projectSnapshot bootstrapInfo dependencyFiles true) bootstrapInfo.InitialTcInfo - |> NodeCode.AwaitAsync } ) @@ -1630,7 +1626,7 @@ type internal TransparentCompiler let ComputeProjectExtras (bootstrapInfo: BootstrapInfo) (projectSnapshot: ProjectSnapshotWithSources) = caches.ProjectExtras.Get( projectSnapshot.SignatureKey, - node { + async { let! results, finalInfo = ComputeParseAndCheckAllFilesInProject bootstrapInfo projectSnapshot @@ -1723,7 +1719,7 @@ type internal TransparentCompiler let ComputeAssemblyData (projectSnapshot: ProjectSnapshot) fileName = caches.AssemblyData.Get( projectSnapshot.SignatureKey, - node { + async { try @@ -1772,7 +1768,7 @@ type internal TransparentCompiler let ComputeParseAndCheckProject (projectSnapshot: ProjectSnapshot) = caches.ParseAndCheckProject.Get( projectSnapshot.FullKey, - node { + async { match! ComputeBootstrapInfo projectSnapshot with | None, creationDiags -> @@ -1844,7 +1840,7 @@ type internal TransparentCompiler ) let tryGetSink (fileName: string) (projectSnapshot: ProjectSnapshot) = - node { + async { match! ComputeBootstrapInfo projectSnapshot with | None, _ -> return None | Some bootstrapInfo, _creationDiags -> @@ -1859,7 +1855,7 @@ type internal TransparentCompiler let ComputeSemanticClassification (fileName: string, projectSnapshot: ProjectSnapshot) = caches.SemanticClassification.Get( projectSnapshot.FileKey fileName, - node { + async { use _ = Activity.start "ComputeSemanticClassification" [| Activity.Tags.fileName, fileName |> Path.GetFileName |] @@ -1889,7 +1885,7 @@ type internal TransparentCompiler let ComputeItemKeyStore (fileName: string, projectSnapshot: ProjectSnapshot) = caches.ItemKeyStore.Get( projectSnapshot.FileKey fileName, - node { + async { use _ = Activity.start "ComputeItemKeyStore" [| Activity.Tags.fileName, fileName |> Path.GetFileName |] @@ -1924,7 +1920,7 @@ type internal TransparentCompiler ) member _.ParseFile(fileName, projectSnapshot: ProjectSnapshot, _userOpName) = - node { + async { //use _ = // Activity.start "ParseFile" [| Activity.Tags.fileName, fileName |> Path.GetFileName |] @@ -1954,7 +1950,7 @@ type internal TransparentCompiler member _.FindReferencesInFile(fileName: string, projectSnapshot: ProjectSnapshot, symbol: FSharpSymbol, userOpName: string) = ignore userOpName - node { + async { match! ComputeItemKeyStore(fileName, projectSnapshot) with | None -> return Seq.empty | Some itemKeyStore -> return itemKeyStore.FindAll symbol.Item @@ -1979,11 +1975,10 @@ type internal TransparentCompiler sourceText: ISourceText, options: FSharpProjectOptions, userOpName: string - ) : NodeCode = - node { + ) : Async = + async { let! snapshot = FSharpProjectSnapshot.FromOptions(options, fileName, fileVersion, sourceText, documentSource) - |> NodeCode.AwaitAsync ignore parseResults @@ -2000,11 +1995,10 @@ type internal TransparentCompiler sourceText: ISourceText, options: FSharpProjectOptions, userOpName: string - ) : NodeCode = - node { + ) : Async = + async { let! snapshot = FSharpProjectSnapshot.FromOptions(options, fileName, fileVersion, sourceText, documentSource) - |> NodeCode.AwaitAsync ignore parseResults @@ -2052,13 +2046,12 @@ type internal TransparentCompiler symbol: FSharpSymbol, canInvalidateProject: bool, userOpName: string - ) : NodeCode> = - node { + ) : Async> = + async { ignore canInvalidateProject let! snapshot = FSharpProjectSnapshot.FromOptions(options, documentSource) - |> NodeCode.AwaitAsync return! this.FindReferencesInFile(fileName, snapshot.ProjectSnapshot, symbol, userOpName) } @@ -2069,11 +2062,10 @@ type internal TransparentCompiler member _.FrameworkImportsCache: FrameworkImportsCache = backgroundCompiler.FrameworkImportsCache - member this.GetAssemblyData(options: FSharpProjectOptions, fileName, userOpName: string) : NodeCode = - node { + member this.GetAssemblyData(options: FSharpProjectOptions, fileName, userOpName: string) : Async = + async { let! snapshot = FSharpProjectSnapshot.FromOptions(options, documentSource) - |> NodeCode.AwaitAsync return! this.GetAssemblyData(snapshot.ProjectSnapshot, fileName, userOpName) } @@ -2083,7 +2075,7 @@ type internal TransparentCompiler projectSnapshot: FSharpProjectSnapshot, fileName, userOpName: string - ) : NodeCode = + ) : Async = this.GetAssemblyData(projectSnapshot.ProjectSnapshot, fileName, userOpName) member this.GetBackgroundCheckResultsForFileInProject @@ -2091,11 +2083,10 @@ type internal TransparentCompiler fileName: string, options: FSharpProjectOptions, userOpName: string - ) : NodeCode = - node { + ) : Async = + async { let! snapshot = FSharpProjectSnapshot.FromOptions(options, documentSource) - |> NodeCode.AwaitAsync match! this.ParseAndCheckFileInProject(fileName, snapshot.ProjectSnapshot, userOpName) with | parseResult, FSharpCheckFileAnswer.Succeeded checkResult -> return parseResult, checkResult @@ -2107,11 +2098,10 @@ type internal TransparentCompiler fileName: string, options: FSharpProjectOptions, userOpName: string - ) : NodeCode = - node { + ) : Async = + async { let! snapshot = FSharpProjectSnapshot.FromOptions(options, documentSource) - |> NodeCode.AwaitAsync return! this.ParseFile(fileName, snapshot.ProjectSnapshot, userOpName) } @@ -2122,13 +2112,12 @@ type internal TransparentCompiler fileName: string, sourceText: ISourceText, options: FSharpProjectOptions - ) : NodeCode<(FSharpParseFileResults * FSharpCheckFileResults) option> = - node { + ) : Async<(FSharpParseFileResults * FSharpCheckFileResults) option> = + async { ignore builder let! snapshot = FSharpProjectSnapshot.FromOptions(options, fileName, 1, sourceText, documentSource) - |> NodeCode.AwaitAsync match! this.ParseAndCheckFileInProject(fileName, snapshot.ProjectSnapshot, "GetCachedCheckFileResult") with | parseResult, FSharpCheckFileAnswer.Succeeded checkResult -> return Some(parseResult, checkResult) @@ -2222,7 +2211,6 @@ type internal TransparentCompiler (projectFileName, fileName) (List.ofArray otherFlags) optionsStamp - |> Async.AwaitNodeCode let otherFlags = [ @@ -2283,7 +2271,7 @@ type internal TransparentCompiler } member this.GetSemanticClassificationForFile(fileName: string, snapshot: FSharpProjectSnapshot, userOpName: string) = - node { + async { ignore userOpName return! ComputeSemanticClassification(fileName, snapshot.ProjectSnapshot) } @@ -2293,13 +2281,12 @@ type internal TransparentCompiler fileName: string, options: FSharpProjectOptions, userOpName: string - ) : NodeCode = - node { + ) : Async = + async { ignore userOpName let! snapshot = FSharpProjectSnapshot.FromOptions(options, documentSource) - |> NodeCode.AwaitAsync return! ComputeSemanticClassification(fileName, snapshot.ProjectSnapshot) } @@ -2313,7 +2300,7 @@ type internal TransparentCompiler this.Caches.Clear(Set.singleton (ProjectIdentifier(projectFileName, outputFileName))) - member this.NotifyFileChanged(fileName: string, options: FSharpProjectOptions, userOpName: string) : NodeCode = + member this.NotifyFileChanged(fileName: string, options: FSharpProjectOptions, userOpName: string) : Async = backgroundCompiler.NotifyFileChanged(fileName, options, userOpName) member this.NotifyProjectCleaned(options: FSharpProjectOptions, userOpName: string) : Async = @@ -2326,11 +2313,10 @@ type internal TransparentCompiler sourceText: ISourceText, options: FSharpProjectOptions, userOpName: string - ) : NodeCode = - node { + ) : Async = + async { let! snapshot = FSharpProjectSnapshot.FromOptions(options, fileName, fileVersion, sourceText, documentSource) - |> NodeCode.AwaitAsync return! this.ParseAndCheckFileInProject(fileName, snapshot.ProjectSnapshot, userOpName) } @@ -2338,26 +2324,24 @@ type internal TransparentCompiler member this.ParseAndCheckFileInProject(fileName: string, projectSnapshot: FSharpProjectSnapshot, userOpName: string) = this.ParseAndCheckFileInProject(fileName, projectSnapshot.ProjectSnapshot, userOpName) - member this.ParseAndCheckProject(options: FSharpProjectOptions, userOpName: string) : NodeCode = - node { + member this.ParseAndCheckProject(options: FSharpProjectOptions, userOpName: string) : Async = + async { ignore userOpName let! snapshot = FSharpProjectSnapshot.FromOptions(options, documentSource) - |> NodeCode.AwaitAsync return! ComputeParseAndCheckProject snapshot.ProjectSnapshot } - member this.ParseAndCheckProject(projectSnapshot: FSharpProjectSnapshot, userOpName: string) : NodeCode = - node { + member this.ParseAndCheckProject(projectSnapshot: FSharpProjectSnapshot, userOpName: string) : Async = + async { ignore userOpName return! ComputeParseAndCheckProject projectSnapshot.ProjectSnapshot } member this.ParseFile(fileName, projectSnapshot, userOpName) = this.ParseFile(fileName, projectSnapshot.ProjectSnapshot, userOpName) - |> Async.AwaitNodeCode member this.ParseFile ( diff --git a/src/Compiler/Service/TransparentCompiler.fsi b/src/Compiler/Service/TransparentCompiler.fsi index 8e581872d84..ad57dca1a40 100644 --- a/src/Compiler/Service/TransparentCompiler.fsi +++ b/src/Compiler/Service/TransparentCompiler.fsi @@ -159,19 +159,19 @@ type internal TransparentCompiler = member FindReferencesInFile: fileName: string * projectSnapshot: ProjectSnapshot.ProjectSnapshot * symbol: FSharpSymbol * userOpName: string -> - NodeCode + Async member GetAssemblyData: projectSnapshot: ProjectSnapshot.ProjectSnapshot * fileName: string * _userOpName: string -> - NodeCode + Async member ParseAndCheckFileInProject: fileName: string * projectSnapshot: ProjectSnapshot.ProjectSnapshot * userOpName: string -> - NodeCode + Async member ParseFile: fileName: string * projectSnapshot: ProjectSnapshot.ProjectSnapshot * _userOpName: 'a -> - NodeCode + Async member SetCacheSizeFactor: sizeFactor: int -> unit diff --git a/src/Compiler/Service/service.fs b/src/Compiler/Service/service.fs index 103c84e63cf..686d7ccceab 100644 --- a/src/Compiler/Service/service.fs +++ b/src/Compiler/Service/service.fs @@ -325,13 +325,11 @@ type FSharpChecker let userOpName = defaultArg userOpName "Unknown" backgroundCompiler.GetBackgroundParseResultsForFileInProject(fileName, options, userOpName) - |> Async.AwaitNodeCode member _.GetBackgroundCheckResultsForFileInProject(fileName, options, ?userOpName: string) = let userOpName = defaultArg userOpName "Unknown" backgroundCompiler.GetBackgroundCheckResultsForFileInProject(fileName, options, userOpName) - |> Async.AwaitNodeCode /// Try to get recent approximate type check results for a file. member _.TryGetRecentCheckResultsForFile(fileName: string, options: FSharpProjectOptions, ?sourceText, ?userOpName: string) = @@ -398,7 +396,6 @@ type FSharpChecker let userOpName = defaultArg userOpName "Unknown" backgroundCompiler.NotifyFileChanged(fileName, options, userOpName) - |> Async.AwaitNodeCode /// Typecheck a source code file, returning a handle to the results of the /// parse including the reconstructed types in the file. @@ -421,7 +418,6 @@ type FSharpChecker options, userOpName ) - |> Async.AwaitNodeCode /// Typecheck a source code file, returning a handle to the results of the /// parse including the reconstructed types in the file. @@ -437,7 +433,6 @@ type FSharpChecker let userOpName = defaultArg userOpName "Unknown" backgroundCompiler.CheckFileInProject(parseResults, fileName, fileVersion, sourceText, options, userOpName) - |> Async.AwaitNodeCode /// Typecheck a source code file, returning a handle to the results of the /// parse including the reconstructed types in the file. @@ -452,25 +447,21 @@ type FSharpChecker let userOpName = defaultArg userOpName "Unknown" backgroundCompiler.ParseAndCheckFileInProject(fileName, fileVersion, sourceText, options, userOpName) - |> Async.AwaitNodeCode member _.ParseAndCheckFileInProject(fileName: string, projectSnapshot: FSharpProjectSnapshot, ?userOpName: string) = let userOpName = defaultArg userOpName "Unknown" backgroundCompiler.ParseAndCheckFileInProject(fileName, projectSnapshot, userOpName) - |> Async.AwaitNodeCode member _.ParseAndCheckProject(options: FSharpProjectOptions, ?userOpName: string) = let userOpName = defaultArg userOpName "Unknown" backgroundCompiler.ParseAndCheckProject(options, userOpName) - |> Async.AwaitNodeCode member _.ParseAndCheckProject(projectSnapshot: FSharpProjectSnapshot, ?userOpName: string) = let userOpName = defaultArg userOpName "Unknown" backgroundCompiler.ParseAndCheckProject(projectSnapshot, userOpName) - |> Async.AwaitNodeCode member _.FindBackgroundReferencesInFile ( @@ -484,7 +475,7 @@ type FSharpChecker let canInvalidateProject = defaultArg canInvalidateProject true let userOpName = defaultArg userOpName "Unknown" - node { + async { if fastCheck <> Some true || not captureIdentifiersWhenParsing then return! backgroundCompiler.FindReferencesInFile(fileName, options, symbol, canInvalidateProject, userOpName) else @@ -498,15 +489,13 @@ type FSharpChecker else return Seq.empty } - |> Async.AwaitNodeCode member _.FindBackgroundReferencesInFile(fileName: string, projectSnapshot: FSharpProjectSnapshot, symbol: FSharpSymbol, ?userOpName: string) = let userOpName = defaultArg userOpName "Unknown" - node { + async { let! parseResults = backgroundCompiler.ParseFile(fileName, projectSnapshot, userOpName) - |> NodeCode.AwaitAsync if parseResults.ParseTree.Identifiers |> Set.contains symbol.DisplayNameCore @@ -516,19 +505,16 @@ type FSharpChecker else return Seq.empty } - |> Async.AwaitNodeCode member _.GetBackgroundSemanticClassificationForFile(fileName: string, options: FSharpProjectOptions, ?userOpName) = let userOpName = defaultArg userOpName "Unknown" backgroundCompiler.GetSemanticClassificationForFile(fileName, options, userOpName) - |> Async.AwaitNodeCode member _.GetBackgroundSemanticClassificationForFile(fileName: string, snapshot: FSharpProjectSnapshot, ?userOpName) = let userOpName = defaultArg userOpName "Unknown" backgroundCompiler.GetSemanticClassificationForFile(fileName, snapshot, userOpName) - |> Async.AwaitNodeCode /// For a given script file, get the ProjectOptions implied by the #load closure member _.GetProjectOptionsFromScript diff --git a/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs b/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs index 7c252019e2d..51631e0c466 100644 --- a/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs +++ b/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs @@ -28,9 +28,9 @@ let waitUntil condition value = } let rec internal spinFor (duration: TimeSpan) = - node { + async { let sw = Stopwatch.StartNew() - do! Async.Sleep 10 |> NodeCode.AwaitAsync + do! Async.Sleep 10 let remaining = duration - sw.Elapsed if remaining > TimeSpan.Zero then return! spinFor remaining @@ -60,8 +60,8 @@ type internal EventRecorder<'a, 'b, 'c when 'a : equality and 'b : equality>(mem [] let ``Basics``() = - let computation key = node { - do! Async.Sleep 1 |> NodeCode.AwaitAsync + let computation key = async { + do! Async.Sleep 1 return key * 2 } @@ -77,8 +77,8 @@ let ``Basics``() = memoize.Get'(3, computation 3) memoize.Get'(2, computation 2) } - |> NodeCode.Parallel - |> NodeCode.RunImmediateWithoutCancellation + |> Async.Parallel + |> Async.RunSynchronously let expected = [| 10; 10; 4; 10; 6; 4|] @@ -97,7 +97,7 @@ let ``We can cancel a job`` () = let jobStarted = new ManualResetEvent(false) - let computation action = node { + let computation action = async { action() |> ignore do! spinFor timeout failwith "Should be canceled before it gets here" @@ -112,13 +112,13 @@ let ``We can cancel a job`` () = let key = 1 - let _task1 = NodeCode.StartAsTask_ForTesting( memoize.Get'(key, computation jobStarted.Set), ct = cts1.Token) + let _task1 = Async.StartAsTask( memoize.Get'(key, computation jobStarted.Set), cancellationToken = cts1.Token) waitFor jobStarted jobStarted.Reset() |> ignore - let _task2 = NodeCode.StartAsTask_ForTesting( memoize.Get'(key, computation ignore), ct = cts2.Token) - let _task3 = NodeCode.StartAsTask_ForTesting( memoize.Get'(key, computation ignore), ct = cts3.Token) + let _task2 = Async.StartAsTask( memoize.Get'(key, computation ignore), cancellationToken = cts2.Token) + let _task3 = Async.StartAsTask( memoize.Get'(key, computation ignore), cancellationToken = cts3.Token) do! waitUntil (events.CountOf Requested) 3 @@ -148,7 +148,7 @@ let ``Job is restarted if first requestor cancels`` () = let jobCanComplete = new ManualResetEvent(false) - let computation key = node { + let computation key = async { jobStarted.Set() |> ignore waitFor jobCanComplete return key * 2 @@ -164,13 +164,13 @@ let ``Job is restarted if first requestor cancels`` () = let key = 1 - let _task1 = NodeCode.StartAsTask_ForTesting( memoize.Get'(key, computation key), ct = cts1.Token) + let _task1 = Async.StartAsTask( memoize.Get'(key, computation key), cancellationToken = cts1.Token) waitFor jobStarted jobStarted.Reset() |> ignore - let _task2 = NodeCode.StartAsTask_ForTesting( memoize.Get'(key, computation key), ct = cts2.Token) - let _task3 = NodeCode.StartAsTask_ForTesting( memoize.Get'(key, computation key), ct = cts3.Token) + let _task2 = Async.StartAsTask( memoize.Get'(key, computation key), cancellationToken = cts2.Token) + let _task3 = Async.StartAsTask( memoize.Get'(key, computation key), cancellationToken = cts3.Token) do! waitUntil (events.CountOf Requested) 3 @@ -199,7 +199,7 @@ let ``Job is restarted if first requestor cancels but keeps running if second re let jobCanComplete = new ManualResetEvent(false) - let computation key = node { + let computation key = async { jobStarted.Set() |> ignore waitFor jobCanComplete return key * 2 @@ -215,13 +215,13 @@ let ``Job is restarted if first requestor cancels but keeps running if second re let key = 1 - let _task1 = NodeCode.StartAsTask_ForTesting( memoize.Get'(key, computation key), ct = cts1.Token) + let _task1 = Async.StartAsTask( memoize.Get'(key, computation key), cancellationToken = cts1.Token) waitFor jobStarted jobStarted.Reset() |> ignore - let _task2 = NodeCode.StartAsTask_ForTesting( memoize.Get'(key, computation key), ct = cts2.Token) - let _task3 = NodeCode.StartAsTask_ForTesting( memoize.Get'(key, computation key), ct = cts3.Token) + let _task2 = Async.StartAsTask( memoize.Get'(key, computation key), cancellationToken = cts2.Token) + let _task3 = Async.StartAsTask( memoize.Get'(key, computation key), cancellationToken = cts3.Token) do! waitUntil (events.CountOf Requested) 3 @@ -277,21 +277,21 @@ let ``Stress test`` () = while (int s.ElapsedMilliseconds) < durationMs do number <- number + 1 % 12345 return [result] - } |> NodeCode.AwaitAsync + } let rec sleepyComputation durationMs result = - node { + async { if rng.NextDouble() < (exceptionProbability / (float durationMs / float stepMs)) then raise (ExpectedException()) if durationMs > 0 then - do! Async.Sleep (min stepMs durationMs) |> NodeCode.AwaitAsync + do! Async.Sleep (min stepMs durationMs) return! sleepyComputation (durationMs - stepMs) result else return [result] } let rec mixedComputation durationMs result = - node { + async { if durationMs > 0 then if rng.NextDouble() < 0.5 then let! _ = intenseComputation (min stepMs durationMs) () @@ -333,7 +333,7 @@ let ``Stress test`` () = let result = key * 2 let job = cache.Get'(key, computation durationMs result) let cts = new CancellationTokenSource() - let runningJob = NodeCode.StartAsTask_ForTesting(job, ct = cts.Token) + let runningJob = Async.StartAsTask(job, cancellationToken = cts.Token) cts.CancelAfter timeoutMs Interlocked.Increment &started |> ignore try @@ -387,7 +387,7 @@ let ``Cancel running jobs with the same key`` cancelDuplicate expectFinished = let job2started = new ManualResetEvent(false) let job2finished = new ManualResetEvent(false) - let work onStart onFinish = node { + let work onStart onFinish = async { Interlocked.Increment &started |> ignore onStart() |> ignore waitFor jobCanContinue @@ -402,7 +402,7 @@ let ``Cancel running jobs with the same key`` cancelDuplicate expectFinished = member _.GetVersion() = 1 member _.GetLabel() = "key1" } - cache.Get(key1, work job1started.Set job1finished.Set) |> Async.AwaitNodeCode |> Async.Start + cache.Get(key1, work job1started.Set job1finished.Set) |> Async.Start waitFor job1started @@ -412,7 +412,7 @@ let ``Cancel running jobs with the same key`` cancelDuplicate expectFinished = member _.GetVersion() = key1.GetVersion() + 1 member _.GetLabel() = "key2" } - cache.Get(key2, work job2started.Set job2finished.Set ) |> Async.AwaitNodeCode |> Async.Start + cache.Get(key2, work job2started.Set job2finished.Set ) |> Async.Start waitFor job2started @@ -440,18 +440,18 @@ let ``Preserve thread static diagnostics`` () = let job1Cache = AsyncMemoize() let job2Cache = AsyncMemoize() - let job1 (input: string) = node { - let! _ = Async.Sleep (rng.Next(1, 30)) |> NodeCode.AwaitAsync + let job1 (input: string) = async { + let! _ = Async.Sleep (rng.Next(1, 30)) let ex = DummyException("job1 error") DiagnosticsThreadStatics.DiagnosticsLogger.ErrorR(ex) return Ok input } - let job2 (input: int) = node { + let job2 (input: int) = async { DiagnosticsThreadStatics.DiagnosticsLogger.Warning(DummyException("job2 error 1")) - let! _ = Async.Sleep (rng.Next(1, 30)) |> NodeCode.AwaitAsync + let! _ = Async.Sleep (rng.Next(1, 30)) let key = { new ICacheKey<_, _> with member _.GetKey() = "job1" @@ -483,7 +483,7 @@ let ``Preserve thread static diagnostics`` () = member _.GetVersion() = rng.Next(1, 10) member _.GetLabel() = "job2" } - let! result = job2Cache.Get(key, job2 (i % 10)) |> Async.AwaitNodeCode + let! result = job2Cache.Get(key, job2 (i % 10)) let diagnostics = diagnosticsLogger.GetDiagnostics() @@ -514,7 +514,7 @@ let ``Preserve thread static diagnostics already completed job`` () = member _.GetVersion() = 1 member _.GetLabel() = "job1" } - let job (input: string) = node { + let job (input: string) = async { let ex = DummyException($"job {input} error") DiagnosticsThreadStatics.DiagnosticsLogger.ErrorR(ex) return Ok input @@ -526,8 +526,8 @@ let ``Preserve thread static diagnostics already completed job`` () = use _ = new CompilationGlobalsScope(diagnosticsLogger, BuildPhase.Optimize) - let! _ = cache.Get(key, job "1" ) |> Async.AwaitNodeCode - let! _ = cache.Get(key, job "2" ) |> Async.AwaitNodeCode + let! _ = cache.Get(key, job "1" ) + let! _ = cache.Get(key, job "2" ) let diagnosticMessages = diagnosticsLogger.GetDiagnostics() |> Array.map (fun (d, _) -> d.Exception.Message) |> Array.toList @@ -547,9 +547,9 @@ let ``We get diagnostics from the job that failed`` () = member _.GetVersion() = 1 member _.GetLabel() = "job1" } - let job (input: int) = node { + let job (input: int) = async { let ex = DummyException($"job {input} error") - do! Async.Sleep 100 |> NodeCode.AwaitAsync + do! Async.Sleep 100 DiagnosticsThreadStatics.DiagnosticsLogger.Error(ex) return 5 } @@ -562,7 +562,7 @@ let ``We get diagnostics from the job that failed`` () = use _ = new CompilationGlobalsScope(diagnosticsLogger, BuildPhase.Optimize) try - let! _ = cache.Get(key, job i ) |> Async.AwaitNodeCode + let! _ = cache.Get(key, job i ) () with _ -> () diff --git a/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs b/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs index d07b23a5e99..9997bad02dc 100644 --- a/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs +++ b/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs @@ -16,14 +16,14 @@ module BuildGraphTests = [] let private createNode () = let o = obj () - GraphNode(node { + GraphNode(async { Assert.shouldBeTrue (o <> null) return 1 }), WeakReference(o) [] let ``Intialization of graph node should not have a computed value``() = - let node = GraphNode(node { return 1 }) + let node = GraphNode(async { return 1 }) Assert.shouldBeTrue(node.TryPeekValue().IsNone) Assert.shouldBeFalse(node.HasValue) @@ -33,23 +33,23 @@ module BuildGraphTests = let resetEventInAsync = new ManualResetEvent(false) let graphNode = - GraphNode(node { + GraphNode(async { resetEventInAsync.Set() |> ignore - let! _ = NodeCode.AwaitWaitHandle_ForTesting(resetEvent) + let! _ = Async.AwaitWaitHandle(resetEvent) return 1 }) let task1 = - node { + async { let! _ = graphNode.GetOrComputeValue() () - } |> NodeCode.StartAsTask_ForTesting + } |> Async.StartAsTask let task2 = - node { + async { let! _ = graphNode.GetOrComputeValue() () - } |> NodeCode.StartAsTask_ForTesting + } |> Async.StartAsTask resetEventInAsync.WaitOne() |> ignore resetEvent.Set() |> ignore @@ -66,12 +66,12 @@ module BuildGraphTests = let mutable computationCount = 0 let graphNode = - GraphNode(node { + GraphNode(async { computationCount <- computationCount + 1 return 1 }) - let work = Async.Parallel(Array.init requests (fun _ -> graphNode.GetOrComputeValue() |> Async.AwaitNodeCode)) + let work = Async.Parallel(Array.init requests (fun _ -> graphNode.GetOrComputeValue())) Async.RunImmediate(work) |> ignore @@ -82,9 +82,9 @@ module BuildGraphTests = let ``Many requests to get a value asynchronously should get the correct value``() = let requests = 10000 - let graphNode = GraphNode(node { return 1 }) + let graphNode = GraphNode(async { return 1 }) - let work = Async.Parallel(Array.init requests (fun _ -> graphNode.GetOrComputeValue() |> Async.AwaitNodeCode)) + let work = Async.Parallel(Array.init requests (fun _ -> graphNode.GetOrComputeValue())) let result = Async.RunImmediate(work) @@ -101,7 +101,7 @@ module BuildGraphTests = Assert.shouldBeTrue weak.IsAlive - NodeCode.RunImmediateWithoutCancellation(graphNode.GetOrComputeValue()) + Async.RunImmediate(graphNode.GetOrComputeValue()) |> ignore GC.Collect(2, GCCollectionMode.Forced, true) @@ -118,7 +118,7 @@ module BuildGraphTests = Assert.shouldBeTrue weak.IsAlive - Async.RunImmediate(Async.Parallel(Array.init requests (fun _ -> graphNode.GetOrComputeValue() |> Async.AwaitNodeCode))) + Async.RunImmediate(Async.Parallel(Array.init requests (fun _ -> graphNode.GetOrComputeValue()))) |> ignore GC.Collect(2, GCCollectionMode.Forced, true) @@ -128,21 +128,21 @@ module BuildGraphTests = [] let ``A request can cancel``() = let graphNode = - GraphNode(node { + GraphNode(async { return 1 }) use cts = new CancellationTokenSource() let work = - node { + async { cts.Cancel() return! graphNode.GetOrComputeValue() } let ex = try - NodeCode.RunImmediate(work, ct = cts.Token) + Async.RunImmediate(work, cancellationToken = cts.Token) |> ignore failwith "Should have canceled" with @@ -156,23 +156,23 @@ module BuildGraphTests = let resetEvent = new ManualResetEvent(false) let graphNode = - GraphNode(node { - let! _ = NodeCode.AwaitWaitHandle_ForTesting(resetEvent) + GraphNode(async { + let! _ = Async.AwaitWaitHandle(resetEvent) return 1 }) use cts = new CancellationTokenSource() let task = - node { + async { cts.Cancel() resetEvent.Set() |> ignore } - |> NodeCode.StartAsTask_ForTesting + |> Async.StartAsTask let ex = try - NodeCode.RunImmediate(graphNode.GetOrComputeValue(), ct = cts.Token) + Async.RunImmediate(graphNode.GetOrComputeValue(), cancellationToken = cts.Token) |> ignore failwith "Should have canceled" with @@ -190,9 +190,9 @@ module BuildGraphTests = let mutable computationCount = 0 let graphNode = - GraphNode(node { + GraphNode(async { computationCountBeforeSleep <- computationCountBeforeSleep + 1 - let! _ = NodeCode.AwaitWaitHandle_ForTesting(resetEvent) + let! _ = Async.AwaitWaitHandle(resetEvent) computationCount <- computationCount + 1 return 1 }) @@ -200,7 +200,7 @@ module BuildGraphTests = use cts = new CancellationTokenSource() let work = - node { + async { let! _ = graphNode.GetOrComputeValue() () } @@ -209,15 +209,15 @@ module BuildGraphTests = for i = 0 to requests - 1 do if i % 10 = 0 then - NodeCode.StartAsTask_ForTesting(work, ct = cts.Token) + Async.StartAsTask(work, cancellationToken = cts.Token) |> tasks.Add else - NodeCode.StartAsTask_ForTesting(work) + Async.StartAsTask(work) |> tasks.Add cts.Cancel() resetEvent.Set() |> ignore - NodeCode.RunImmediateWithoutCancellation(work) + Async.RunImmediate(work) |> ignore Assert.shouldBeTrue cts.IsCancellationRequested @@ -243,21 +243,21 @@ module BuildGraphTests = let rng = Random() fun n -> rng.Next n - let job phase i = node { - do! random 10 |> Async.Sleep |> NodeCode.AwaitAsync + let job phase i = async { + do! random 10 |> Async.Sleep Assert.Equal(phase, DiagnosticsThreadStatics.BuildPhase) DiagnosticsThreadStatics.DiagnosticsLogger.DebugDisplay() - |> Assert.shouldBe $"DiagnosticsLogger(NodeCode.Parallel {i})" + |> Assert.shouldBe $"DiagnosticsLogger(Async.Parallel {i})" errorR (ExampleException $"job {i}") } let work (phase: BuildPhase) = - node { + async { let n = 8 let logger = CapturingDiagnosticsLogger("test NodeCode") use _ = new CompilationGlobalsScope(logger, phase) - let! _ = Seq.init n (job phase) |> NodeCode.Parallel + let! _ = Seq.init n (job phase) |> Async.Parallel let diags = logger.Diagnostics |> List.map fst @@ -284,6 +284,6 @@ module BuildGraphTests = let pickRandomPhase _ = phases[random phases.Length] Seq.init 100 pickRandomPhase - |> Seq.map (work >> Async.AwaitNodeCode) + |> Seq.map work |> Async.Parallel |> Async.RunSynchronously diff --git a/vsintegration/src/FSharp.Editor/LanguageService/WorkspaceExtensions.fs b/vsintegration/src/FSharp.Editor/LanguageService/WorkspaceExtensions.fs index 154517ed6a1..6c3b04f1844 100644 --- a/vsintegration/src/FSharp.Editor/LanguageService/WorkspaceExtensions.fs +++ b/vsintegration/src/FSharp.Editor/LanguageService/WorkspaceExtensions.fs @@ -317,15 +317,14 @@ module private CheckerExtensions = snapshotCache.Get( key, - node { - let! ct = NodeCode.CancellationToken + async { + let! ct = Async.CancellationToken return! createProjectSnapshot snapshotAccumulatorOpt project options ct - |> NodeCode.AwaitTask + |> Async.AwaitTask } ) - |> Async.AwaitNodeCode let getProjectSnapshotForDocument (document: Document, options: FSharpProjectOptions) = getOrCreateSnapshotForProject document.Project (Some options) None From 8e9a815218b00e7e521094ed99426bcc6563dc27 Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Mon, 26 Feb 2024 22:45:56 +0100 Subject: [PATCH 04/51] multiple loggers --- src/Compiler/Driver/CompilerImports.fs | 4 +- src/Compiler/Facilities/DiagnosticsLogger.fs | 56 +++++++++++++++---- src/Compiler/Facilities/DiagnosticsLogger.fsi | 7 +-- 3 files changed, 50 insertions(+), 17 deletions(-) diff --git a/src/Compiler/Driver/CompilerImports.fs b/src/Compiler/Driver/CompilerImports.fs index ee5b4afe87f..68e91a7c158 100644 --- a/src/Compiler/Driver/CompilerImports.fs +++ b/src/Compiler/Driver/CompilerImports.fs @@ -2235,8 +2235,8 @@ and [] TcImports let runMethod = match tcConfig.parallelReferenceResolution with - | ParallelReferenceResolution.On -> Async.Parallel - | ParallelReferenceResolution.Off -> Async.Sequential + | ParallelReferenceResolution.On -> MultipleDiagnosticsLoggers.Parallel + | ParallelReferenceResolution.Off -> MultipleDiagnosticsLoggers.Sequential let! results = nms diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fs b/src/Compiler/Facilities/DiagnosticsLogger.fs index ee978e683f8..d90ce2429d5 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -15,6 +15,7 @@ open Internal.Utilities.Library open Internal.Utilities.Library.Extras open System.Collections.Concurrent open System.Threading +open System.Threading.Tasks /// Represents the style being used to format errors [] @@ -882,16 +883,49 @@ type StackGuard(maxDepth: int, name: string) = static member GetDepthOption(name: string) = GetEnvInteger ("FSHARP_" + name + "StackGuardDepth") StackGuard.DefaultDepth -type CaptureDiagnosticsConcurrently() = - let target = DiagnosticsThreadStatics.DiagnosticsLogger - let loggers = ResizeArray() +type CaptureDiagnosticsConcurrently<'T>(computations: Async<'T> seq, ?eagerFormat) = + let mutable errorCount = 0 - member _.GetLoggerForTask(name) : DiagnosticsLogger = - let logger = CapturingDiagnosticsLogger(name) - loggers.Add logger - logger + let injected, diags = [ + for i, computation in computations |> Seq.indexed do + let tcs = TaskCompletionSource<_>() + let logger = + { new CapturingDiagnosticsLogger($"CaptureDiagnosticsConcurrently {i}", ?eagerFormat = eagerFormat) with + override _.DiagnosticSink(d, severity) = + base.DiagnosticSink(d, severity) + if severity = FSharpDiagnosticSeverity.Error then + Interlocked.Increment &errorCount |> ignore + override _.ErrorCount = errorCount + } + let injected = + async { + try + SetThreadDiagnosticsLoggerNoUnwind logger + return! computation + finally + tcs.SetResult logger + } + injected, tcs ] |> List.unzip - interface IDisposable with - member _.Dispose() = - for logger in loggers do - logger.CommitDelayedDiagnostics target + let replayDiagnostics = backgroundTask { + let target = DiagnosticsThreadStatics.DiagnosticsLogger + for tcs in diags do + let! finishedLogger = tcs.Task + finishedLogger.CommitDelayedDiagnostics target + } + + member val Computations = injected |> Seq.ofList + member val ReplayDiagnostics = replayDiagnostics + +module MultipleDiagnosticsLoggers = + let run method (computations: Async<'T> seq) = + let c = CaptureDiagnosticsConcurrently(computations) + async { + try + return! c.Computations |> method + finally + c.ReplayDiagnostics.Result + } + + let Parallel computations = run Async.Parallel computations + let Sequential computations = run Async.Sequential computations \ No newline at end of file diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fsi b/src/Compiler/Facilities/DiagnosticsLogger.fsi index aea467ae80a..8334594a11e 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fsi +++ b/src/Compiler/Facilities/DiagnosticsLogger.fsi @@ -465,9 +465,8 @@ type CompilationGlobalsScope = member BuildPhase: BuildPhase -type CaptureDiagnosticsConcurrently = - new: unit -> CaptureDiagnosticsConcurrently +module MultipleDiagnosticsLoggers = - member GetLoggerForTask: string -> DiagnosticsLogger + val Parallel: computations: Async<'T> seq -> Async<'T array> - interface IDisposable + val Sequential: computations: Async<'T> seq -> Async<'T array> From 6dab1072bfac47c32e7b4d556cdad200a3b2ff05 Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Tue, 27 Feb 2024 00:53:50 +0100 Subject: [PATCH 05/51] fix RegisterAndImportReferencedAssemblies --- src/Compiler/Driver/CompilerImports.fs | 1 + src/Compiler/Facilities/DiagnosticsLogger.fs | 29 ++++++++++++++----- src/Compiler/Facilities/DiagnosticsLogger.fsi | 2 ++ 3 files changed, 25 insertions(+), 7 deletions(-) diff --git a/src/Compiler/Driver/CompilerImports.fs b/src/Compiler/Driver/CompilerImports.fs index 68e91a7c158..e9dcfbc55a3 100644 --- a/src/Compiler/Driver/CompilerImports.fs +++ b/src/Compiler/Driver/CompilerImports.fs @@ -2243,6 +2243,7 @@ and [] TcImports |> List.map (fun nm -> async { try + use _ = new CompilationGlobalsScope() return! tcImports.TryRegisterAndPrepareToImportReferencedDll(ctok, nm) with e -> errorR (Error(FSComp.SR.buildProblemReadingAssembly (nm.resolvedPath, e.Message), nm.originalReference.Range)) diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fs b/src/Compiler/Facilities/DiagnosticsLogger.fs index d90ce2429d5..f379a6f0705 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -377,6 +377,13 @@ type CapturingDiagnosticsLogger(nm, ?eagerFormat) = let errors = diagnostics.ToArray() errors |> Array.iter diagnosticsLogger.DiagnosticSink +let trace prefix (dl: DiagnosticsLogger) = + let name = + if box dl |> isNull then "NULL" + else dl.DebugDisplay() + Trace.WriteLine $"t:{Thread.CurrentThread.ManagedThreadId} {prefix} {name}" + dl + let buildPhase = AsyncLocal<_>() let diagnosticsLogger = AsyncLocal<_>() @@ -426,6 +433,7 @@ module DiagnosticsLoggerExtensions = type DiagnosticsLogger with member x.EmitDiagnostic(exn, severity) = + trace "error emitted to " x |> ignore match exn with | InternalError(s, _) | InternalException(_, s, _) @@ -507,12 +515,14 @@ let UseBuildPhase (phase: BuildPhase) = /// NOTE: The change will be undone when the returned "unwind" object disposes let UseTransformedDiagnosticsLogger (transformer: DiagnosticsLogger -> #DiagnosticsLogger) = - let oldLogger = DiagnosticsThreadStatics.DiagnosticsLogger - DiagnosticsThreadStatics.DiagnosticsLogger <- transformer oldLogger + let oldLogger = DiagnosticsThreadStatics.DiagnosticsLogger |> trace "old" + DiagnosticsThreadStatics.DiagnosticsLogger <- transformer oldLogger |> trace "new" + Trace.Indent() { new IDisposable with member _.Dispose() = - DiagnosticsThreadStatics.DiagnosticsLogger <- oldLogger + DiagnosticsThreadStatics.DiagnosticsLogger <-oldLogger |> trace "restore" + Trace.Unindent() } let UseDiagnosticsLogger newLogger = @@ -522,6 +532,7 @@ let SetThreadBuildPhaseNoUnwind (phase: BuildPhase) = DiagnosticsThreadStatics.BuildPhase <- phase let SetThreadDiagnosticsLoggerNoUnwind diagnosticsLogger = + //trace "no unwind" DiagnosticsThreadStatics.DiagnosticsLogger <- diagnosticsLogger /// This represents the thread-local state established as each task function runs as part of the build. @@ -531,6 +542,8 @@ type CompilationGlobalsScope(diagnosticsLogger: DiagnosticsLogger, buildPhase: B let unwindEL = UseDiagnosticsLogger diagnosticsLogger let unwindBP = UseBuildPhase buildPhase + new() = new CompilationGlobalsScope(diagnosticsLogger.Value, buildPhase.Value) + member _.DiagnosticsLogger = diagnosticsLogger member _.BuildPhase = buildPhase @@ -899,8 +912,8 @@ type CaptureDiagnosticsConcurrently<'T>(computations: Async<'T> seq, ?eagerForma } let injected = async { + SetThreadDiagnosticsLoggerNoUnwind logger try - SetThreadDiagnosticsLoggerNoUnwind logger return! computation finally tcs.SetResult logger @@ -912,6 +925,7 @@ type CaptureDiagnosticsConcurrently<'T>(computations: Async<'T> seq, ?eagerForma for tcs in diags do let! finishedLogger = tcs.Task finishedLogger.CommitDelayedDiagnostics target + return target } member val Computations = injected |> Seq.ofList @@ -919,12 +933,13 @@ type CaptureDiagnosticsConcurrently<'T>(computations: Async<'T> seq, ?eagerForma module MultipleDiagnosticsLoggers = let run method (computations: Async<'T> seq) = - let c = CaptureDiagnosticsConcurrently(computations) + let forks = CaptureDiagnosticsConcurrently(computations) async { try - return! c.Computations |> method + use _ = new CompilationGlobalsScope() + return! forks.Computations |> method finally - c.ReplayDiagnostics.Result + forks.ReplayDiagnostics.Wait() } let Parallel computations = run Async.Parallel computations diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fsi b/src/Compiler/Facilities/DiagnosticsLogger.fsi index 8334594a11e..8505cafe5f4 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fsi +++ b/src/Compiler/Facilities/DiagnosticsLogger.fsi @@ -459,6 +459,8 @@ type StackGuard = type CompilationGlobalsScope = new: diagnosticsLogger: DiagnosticsLogger * buildPhase: BuildPhase -> CompilationGlobalsScope + new: unit -> CompilationGlobalsScope + interface IDisposable member DiagnosticsLogger: DiagnosticsLogger From e0fbb8d1d63d6b5468ea69ef3647bc48ff5cb972 Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Tue, 27 Feb 2024 09:00:05 +0100 Subject: [PATCH 06/51] fix deadlock in fsi --- src/Compiler/Driver/CompilerImports.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Compiler/Driver/CompilerImports.fs b/src/Compiler/Driver/CompilerImports.fs index e9dcfbc55a3..504bbc88c7a 100644 --- a/src/Compiler/Driver/CompilerImports.fs +++ b/src/Compiler/Driver/CompilerImports.fs @@ -2604,7 +2604,7 @@ let RequireReferences (ctok, tcImports: TcImports, tcEnv, thisAssemblyName, reso let ccuinfos = tcImports.RegisterAndImportReferencedAssemblies(ctok, resolutions) - |> Async.RunImmediate + |> Async.RunSynchronously let asms = ccuinfos From 70beb11ed60c2144eb64be0b4f3b9297b7c926b0 Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Tue, 27 Feb 2024 09:34:11 +0100 Subject: [PATCH 07/51] fix some BuildGraphTests --- .../BuildGraphTests.fs | 36 +++++-------------- 1 file changed, 9 insertions(+), 27 deletions(-) diff --git a/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs b/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs index 9997bad02dc..95d789a9891 100644 --- a/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs +++ b/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs @@ -3,6 +3,7 @@ namespace FSharp.Compiler.UnitTests open System open System.Threading +open System.Threading.Tasks open System.Runtime.CompilerServices open Xunit open FSharp.Test @@ -134,22 +135,13 @@ module BuildGraphTests = use cts = new CancellationTokenSource() - let work = + let work(): Task = Async.StartAsTask( async { cts.Cancel() return! graphNode.GetOrComputeValue() - } - - let ex = - try - Async.RunImmediate(work, cancellationToken = cts.Token) - |> ignore - failwith "Should have canceled" - with - | :? OperationCanceledException as ex -> - ex + }, cancellationToken = cts.Token) - Assert.shouldBeTrue(ex <> null) + Assert.ThrowsAnyAsync(work).Wait() [] let ``A request can cancel 2``() = @@ -158,7 +150,7 @@ module BuildGraphTests = let graphNode = GraphNode(async { let! _ = Async.AwaitWaitHandle(resetEvent) - return 1 + failwith "Should have canceled" }) use cts = new CancellationTokenSource() @@ -170,17 +162,9 @@ module BuildGraphTests = } |> Async.StartAsTask - let ex = - try - Async.RunImmediate(graphNode.GetOrComputeValue(), cancellationToken = cts.Token) - |> ignore - failwith "Should have canceled" - with - | :? OperationCanceledException as ex -> - ex - - Assert.shouldBeTrue(ex <> null) - try task.Wait(1000) |> ignore with | :? TimeoutException -> reraise() | _ -> () + Assert.ThrowsAnyAsync(fun () -> + Async.StartImmediateAsTask(graphNode.GetOrComputeValue(), cancellationToken = cts.Token) + ) |> ignore [] let ``Many requests to get a value asynchronously might evaluate the computation more than once even when some requests get canceled``() = @@ -246,8 +230,6 @@ module BuildGraphTests = let job phase i = async { do! random 10 |> Async.Sleep Assert.Equal(phase, DiagnosticsThreadStatics.BuildPhase) - DiagnosticsThreadStatics.DiagnosticsLogger.DebugDisplay() - |> Assert.shouldBe $"DiagnosticsLogger(Async.Parallel {i})" errorR (ExampleException $"job {i}") } @@ -257,7 +239,7 @@ module BuildGraphTests = let n = 8 let logger = CapturingDiagnosticsLogger("test NodeCode") use _ = new CompilationGlobalsScope(logger, phase) - let! _ = Seq.init n (job phase) |> Async.Parallel + let! _ = Seq.init n (job phase) |> MultipleDiagnosticsLoggers.Parallel let diags = logger.Diagnostics |> List.map fst From 757d6cdc76d2cd2a27877c00d1be68c4d715920e Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Tue, 27 Feb 2024 09:48:20 +0100 Subject: [PATCH 08/51] restore asyncmemoize --- src/Compiler/Facilities/AsyncMemoize.fs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Compiler/Facilities/AsyncMemoize.fs b/src/Compiler/Facilities/AsyncMemoize.fs index b70f55627d0..7824c7c7940 100644 --- a/src/Compiler/Facilities/AsyncMemoize.fs +++ b/src/Compiler/Facilities/AsyncMemoize.fs @@ -495,8 +495,8 @@ type internal AsyncMemoize<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'T let cachingLogger = new CachingDiagnosticsLogger(Some callerDiagnosticLogger) try - return - Async.RunSynchronously( + return! + Async.StartAsTask( async { // TODO: Should unify starting and restarting let currentLogger = DiagnosticsThreadStatics.DiagnosticsLogger @@ -512,7 +512,7 @@ type internal AsyncMemoize<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'T DiagnosticsThreadStatics.DiagnosticsLogger <- currentLogger }, cancellationToken = linkedCtSource.Token - ) + ) |> Async.AwaitTask with | TaskCancelled ex -> // TODO: do we need to do anything else here? Presumably it should be done by the registration on From 3d568381b920acdde89957f351e09d85bb80f9df Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Tue, 27 Feb 2024 10:02:30 +0100 Subject: [PATCH 09/51] fix missing logger in test --- tests/service/ExprTests.fs | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/tests/service/ExprTests.fs b/tests/service/ExprTests.fs index 1371c24f231..6045ad957ff 100644 --- a/tests/service/ExprTests.fs +++ b/tests/service/ExprTests.fs @@ -736,6 +736,9 @@ let ignoreTestIfStackOverflowExpected () = [] [] let ``Test Unoptimized Declarations Project1`` useTransparentCompiler = + + use _ = new DiagnosticsScope(false) + let cleanup, options = Project1.createOptionsWithArgs [ "--langversion:preview" ] use _holder = cleanup let exprChecker = FSharpChecker.Create(keepAssemblyContents=true, useTransparentCompiler=useTransparentCompiler) @@ -877,6 +880,9 @@ let ``Test Unoptimized Declarations Project1`` useTransparentCompiler = [] [] let ``Test Optimized Declarations Project1`` useTransparentCompiler = + + use _ = new DiagnosticsScope(false) + let cleanup, options = Project1.createOptionsWithArgs [ "--langversion:preview" ] use _holder = cleanup let exprChecker = FSharpChecker.Create(keepAssemblyContents=true, useTransparentCompiler=useTransparentCompiler) From cb721560c3ca52ccc2614e6c9828a4aca61896a8 Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Tue, 27 Feb 2024 16:13:59 +0100 Subject: [PATCH 10/51] format --- src/Compiler/Facilities/AsyncMemoize.fs | 6 +- src/Compiler/Facilities/BuildGraph.fs | 1 - src/Compiler/Facilities/DiagnosticsLogger.fs | 93 ++++++++++--------- src/Compiler/Facilities/DiagnosticsLogger.fsi | 4 - src/Compiler/Interactive/fsi.fs | 3 +- src/Compiler/Service/BackgroundCompiler.fs | 7 +- src/Compiler/Service/BackgroundCompiler.fsi | 3 +- src/Compiler/Service/IncrementalBuild.fsi | 6 +- src/Compiler/Service/TransparentCompiler.fs | 33 +++---- src/Compiler/Service/service.fs | 3 +- 10 files changed, 68 insertions(+), 91 deletions(-) diff --git a/src/Compiler/Facilities/AsyncMemoize.fs b/src/Compiler/Facilities/AsyncMemoize.fs index 7824c7c7940..770ada1b7fe 100644 --- a/src/Compiler/Facilities/AsyncMemoize.fs +++ b/src/Compiler/Facilities/AsyncMemoize.fs @@ -487,7 +487,8 @@ type internal AsyncMemoize<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'T let callerDiagnosticLogger = DiagnosticsThreadStatics.DiagnosticsLogger match! - processRequest post (key, GetOrCompute(computation, ct)) callerDiagnosticLogger |> Async.AwaitTask + processRequest post (key, GetOrCompute(computation, ct)) callerDiagnosticLogger + |> Async.AwaitTask with | New internalCt -> @@ -512,7 +513,8 @@ type internal AsyncMemoize<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'T DiagnosticsThreadStatics.DiagnosticsLogger <- currentLogger }, cancellationToken = linkedCtSource.Token - ) |> Async.AwaitTask + ) + |> Async.AwaitTask with | TaskCancelled ex -> // TODO: do we need to do anything else here? Presumably it should be done by the registration on diff --git a/src/Compiler/Facilities/BuildGraph.fs b/src/Compiler/Facilities/BuildGraph.fs index b0ab87598ba..fada5ae8c24 100644 --- a/src/Compiler/Facilities/BuildGraph.fs +++ b/src/Compiler/Facilities/BuildGraph.fs @@ -10,7 +10,6 @@ open System.Globalization open FSharp.Compiler.DiagnosticsLogger open Internal.Utilities.Library - [] module GraphNode = diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fs b/src/Compiler/Facilities/DiagnosticsLogger.fs index f379a6f0705..b5317198057 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -345,13 +345,6 @@ let DiscardErrorsLogger = member _.ErrorCount = 0 } -let AssertFalseDiagnosticsLogger = - { new DiagnosticsLogger("AssertFalseDiagnosticsLogger") with - // TODO: reenable these asserts in the compiler service - member _.DiagnosticSink(diagnostic, severity) = (* assert false; *) () - member _.ErrorCount = (* assert false; *) 0 - } - type CapturingDiagnosticsLogger(nm, ?eagerFormat) = inherit DiagnosticsLogger(nm) let mutable errorCount = 0 @@ -378,9 +371,7 @@ type CapturingDiagnosticsLogger(nm, ?eagerFormat) = errors |> Array.iter diagnosticsLogger.DiagnosticSink let trace prefix (dl: DiagnosticsLogger) = - let name = - if box dl |> isNull then "NULL" - else dl.DebugDisplay() + let name = if box dl |> isNull then "NULL" else dl.DebugDisplay() Trace.WriteLine $"t:{Thread.CurrentThread.ManagedThreadId} {prefix} {name}" dl @@ -390,10 +381,6 @@ let diagnosticsLogger = AsyncLocal<_>() /// Type holds thread-static globals for use by the compiler. type internal DiagnosticsThreadStatics = - static member Init() = - buildPhase.Value <- BuildPhase.DefaultPhase - diagnosticsLogger.Value <- AssertFalseDiagnosticsLogger - static member BuildPhaseUnchecked = buildPhase.Value static member BuildPhase @@ -434,6 +421,7 @@ module DiagnosticsLoggerExtensions = member x.EmitDiagnostic(exn, severity) = trace "error emitted to " x |> ignore + match exn with | InternalError(s, _) | InternalException(_, s, _) @@ -516,12 +504,12 @@ let UseBuildPhase (phase: BuildPhase) = /// NOTE: The change will be undone when the returned "unwind" object disposes let UseTransformedDiagnosticsLogger (transformer: DiagnosticsLogger -> #DiagnosticsLogger) = let oldLogger = DiagnosticsThreadStatics.DiagnosticsLogger |> trace "old" - DiagnosticsThreadStatics.DiagnosticsLogger <- transformer oldLogger |> trace "new" + DiagnosticsThreadStatics.DiagnosticsLogger <- transformer oldLogger |> trace "new" Trace.Indent() { new IDisposable with member _.Dispose() = - DiagnosticsThreadStatics.DiagnosticsLogger <-oldLogger |> trace "restore" + DiagnosticsThreadStatics.DiagnosticsLogger <- oldLogger |> trace "restore" Trace.Unindent() } @@ -899,34 +887,46 @@ type StackGuard(maxDepth: int, name: string) = type CaptureDiagnosticsConcurrently<'T>(computations: Async<'T> seq, ?eagerFormat) = let mutable errorCount = 0 - let injected, diags = [ - for i, computation in computations |> Seq.indexed do - let tcs = TaskCompletionSource<_>() - let logger = - { new CapturingDiagnosticsLogger($"CaptureDiagnosticsConcurrently {i}", ?eagerFormat = eagerFormat) with - override _.DiagnosticSink(d, severity) = - base.DiagnosticSink(d, severity) - if severity = FSharpDiagnosticSeverity.Error then - Interlocked.Increment &errorCount |> ignore - override _.ErrorCount = errorCount - } - let injected = - async { - SetThreadDiagnosticsLoggerNoUnwind logger - try - return! computation - finally - tcs.SetResult logger - } - injected, tcs ] |> List.unzip - - let replayDiagnostics = backgroundTask { - let target = DiagnosticsThreadStatics.DiagnosticsLogger - for tcs in diags do - let! finishedLogger = tcs.Task - finishedLogger.CommitDelayedDiagnostics target - return target - } + let injected, diags = + [ + for i, computation in computations |> Seq.indexed do + let tcs = TaskCompletionSource<_>() + + let logger = + { new CapturingDiagnosticsLogger($"CaptureDiagnosticsConcurrently {i}", ?eagerFormat = eagerFormat) with + override _.DiagnosticSink(d, severity) = + base.DiagnosticSink(d, severity) + + if severity = FSharpDiagnosticSeverity.Error then + Interlocked.Increment &errorCount |> ignore + + override _.ErrorCount = errorCount + } + + let injected = + async { + SetThreadDiagnosticsLoggerNoUnwind logger + + try + return! computation + finally + tcs.SetResult logger + } + + injected, tcs + ] + |> List.unzip + + let replayDiagnostics = + backgroundTask { + let target = DiagnosticsThreadStatics.DiagnosticsLogger + + for tcs in diags do + let! finishedLogger = tcs.Task + finishedLogger.CommitDelayedDiagnostics target + + return target + } member val Computations = injected |> Seq.ofList member val ReplayDiagnostics = replayDiagnostics @@ -934,13 +934,14 @@ type CaptureDiagnosticsConcurrently<'T>(computations: Async<'T> seq, ?eagerForma module MultipleDiagnosticsLoggers = let run method (computations: Async<'T> seq) = let forks = CaptureDiagnosticsConcurrently(computations) + async { try use _ = new CompilationGlobalsScope() return! forks.Computations |> method finally - forks.ReplayDiagnostics.Wait() + forks.ReplayDiagnostics.Wait() } let Parallel computations = run Async.Parallel computations - let Sequential computations = run Async.Sequential computations \ No newline at end of file + let Sequential computations = run Async.Sequential computations diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fsi b/src/Compiler/Facilities/DiagnosticsLogger.fsi index 8505cafe5f4..c455afbd65f 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fsi +++ b/src/Compiler/Facilities/DiagnosticsLogger.fsi @@ -208,9 +208,6 @@ type DiagnosticsLogger = /// Represents a DiagnosticsLogger that discards diagnostics val DiscardErrorsLogger: DiagnosticsLogger -/// Represents a DiagnosticsLogger that ignores diagnostics and asserts -val AssertFalseDiagnosticsLogger: DiagnosticsLogger - /// Represents a DiagnosticsLogger that captures all diagnostics, optionally formatting them /// eagerly. type CapturingDiagnosticsLogger = @@ -229,7 +226,6 @@ type CapturingDiagnosticsLogger = /// Thread statics for the installed diagnostic logger [] type DiagnosticsThreadStatics = - static member Init: unit -> unit static member BuildPhase: BuildPhase with get, set diff --git a/src/Compiler/Interactive/fsi.fs b/src/Compiler/Interactive/fsi.fs index 403ca376b27..c48e4afe56c 100644 --- a/src/Compiler/Interactive/fsi.fs +++ b/src/Compiler/Interactive/fsi.fs @@ -4593,8 +4593,7 @@ type FsiEvaluationSession try let tcConfig = tcConfigP.Get(ctokStartup) - checker.FrameworkImportsCache.Get tcConfig - |> Async.RunImmediate + checker.FrameworkImportsCache.Get tcConfig |> Async.RunImmediate with e -> stopProcessingRecovery e range0 failwithf "Error creating evaluation session: %A" e diff --git a/src/Compiler/Service/BackgroundCompiler.fs b/src/Compiler/Service/BackgroundCompiler.fs index ac907a549fc..b56797dc6b9 100644 --- a/src/Compiler/Service/BackgroundCompiler.fs +++ b/src/Compiler/Service/BackgroundCompiler.fs @@ -1554,12 +1554,7 @@ type internal BackgroundCompiler member _.FrameworkImportsCache: FrameworkImportsCache = self.FrameworkImportsCache - member _.GetAssemblyData - ( - options: FSharpProjectOptions, - _fileName: string, - userOpName: string - ) : Async = + member _.GetAssemblyData(options: FSharpProjectOptions, _fileName: string, userOpName: string) : Async = self.GetAssemblyData(options, userOpName) member _.GetAssemblyData diff --git a/src/Compiler/Service/BackgroundCompiler.fsi b/src/Compiler/Service/BackgroundCompiler.fsi index 6d35bf40705..4b8ef09cd80 100644 --- a/src/Compiler/Service/BackgroundCompiler.fsi +++ b/src/Compiler/Service/BackgroundCompiler.fsi @@ -72,8 +72,7 @@ type internal IBackgroundCompiler = Async abstract GetAssemblyData: - options: FSharpProjectOptions * outputFileName: string * userOpName: string -> - Async + options: FSharpProjectOptions * outputFileName: string * userOpName: string -> Async /// Fetch the check information from the background compiler (which checks w.r.t. the FileSystem API) abstract GetBackgroundCheckResultsForFileInProject: diff --git a/src/Compiler/Service/IncrementalBuild.fsi b/src/Compiler/Service/IncrementalBuild.fsi index f3bbe6a40d6..0fd380631e4 100644 --- a/src/Compiler/Service/IncrementalBuild.fsi +++ b/src/Compiler/Service/IncrementalBuild.fsi @@ -251,15 +251,13 @@ type internal IncrementalBuilder = /// Get the final typecheck result. If 'generateTypedImplFiles' was set on Create then the CheckedAssemblyAfterOptimization will contain implementations. /// This may be a long-running operation. member GetCheckResultsAndImplementationsForProject: - unit -> - Async + unit -> Async /// Get the final typecheck result. If 'generateTypedImplFiles' was set on Create then the CheckedAssemblyAfterOptimization will contain implementations. /// This may be a long-running operation. /// This will get full type-check info for the project, meaning no partial type-checking. member GetFullCheckResultsAndImplementationsForProject: - unit -> - Async + unit -> Async /// Get the logical time stamp that is associated with the output of the project if it were fully built immediately member GetLogicalTimeStampForProject: TimeStampCache -> DateTime diff --git a/src/Compiler/Service/TransparentCompiler.fs b/src/Compiler/Service/TransparentCompiler.fs index 70466c5d7e8..2506247a701 100644 --- a/src/Compiler/Service/TransparentCompiler.fs +++ b/src/Compiler/Service/TransparentCompiler.fs @@ -1299,8 +1299,7 @@ type internal TransparentCompiler match fileNode with | NodeToTypeCheck.PhysicalFile index -> - let! tcIntermediate = - ComputeTcIntermediate projectSnapshot dependencyFiles index fileNode bootstrapInfo tcInfo + let! tcIntermediate = ComputeTcIntermediate projectSnapshot dependencyFiles index fileNode bootstrapInfo tcInfo let (Finisher(node = node; finisher = finisher)) = tcIntermediate.finisher @@ -1977,8 +1976,7 @@ type internal TransparentCompiler userOpName: string ) : Async = async { - let! snapshot = - FSharpProjectSnapshot.FromOptions(options, fileName, fileVersion, sourceText, documentSource) + let! snapshot = FSharpProjectSnapshot.FromOptions(options, fileName, fileVersion, sourceText, documentSource) ignore parseResults @@ -1997,8 +1995,7 @@ type internal TransparentCompiler userOpName: string ) : Async = async { - let! snapshot = - FSharpProjectSnapshot.FromOptions(options, fileName, fileVersion, sourceText, documentSource) + let! snapshot = FSharpProjectSnapshot.FromOptions(options, fileName, fileVersion, sourceText, documentSource) ignore parseResults @@ -2050,8 +2047,7 @@ type internal TransparentCompiler async { ignore canInvalidateProject - let! snapshot = - FSharpProjectSnapshot.FromOptions(options, documentSource) + let! snapshot = FSharpProjectSnapshot.FromOptions(options, documentSource) return! this.FindReferencesInFile(fileName, snapshot.ProjectSnapshot, symbol, userOpName) } @@ -2064,8 +2060,7 @@ type internal TransparentCompiler member this.GetAssemblyData(options: FSharpProjectOptions, fileName, userOpName: string) : Async = async { - let! snapshot = - FSharpProjectSnapshot.FromOptions(options, documentSource) + let! snapshot = FSharpProjectSnapshot.FromOptions(options, documentSource) return! this.GetAssemblyData(snapshot.ProjectSnapshot, fileName, userOpName) } @@ -2085,8 +2080,7 @@ type internal TransparentCompiler userOpName: string ) : Async = async { - let! snapshot = - FSharpProjectSnapshot.FromOptions(options, documentSource) + let! snapshot = FSharpProjectSnapshot.FromOptions(options, documentSource) match! this.ParseAndCheckFileInProject(fileName, snapshot.ProjectSnapshot, userOpName) with | parseResult, FSharpCheckFileAnswer.Succeeded checkResult -> return parseResult, checkResult @@ -2100,8 +2094,7 @@ type internal TransparentCompiler userOpName: string ) : Async = async { - let! snapshot = - FSharpProjectSnapshot.FromOptions(options, documentSource) + let! snapshot = FSharpProjectSnapshot.FromOptions(options, documentSource) return! this.ParseFile(fileName, snapshot.ProjectSnapshot, userOpName) } @@ -2116,8 +2109,7 @@ type internal TransparentCompiler async { ignore builder - let! snapshot = - FSharpProjectSnapshot.FromOptions(options, fileName, 1, sourceText, documentSource) + let! snapshot = FSharpProjectSnapshot.FromOptions(options, fileName, 1, sourceText, documentSource) match! this.ParseAndCheckFileInProject(fileName, snapshot.ProjectSnapshot, "GetCachedCheckFileResult") with | parseResult, FSharpCheckFileAnswer.Succeeded checkResult -> return Some(parseResult, checkResult) @@ -2285,8 +2277,7 @@ type internal TransparentCompiler async { ignore userOpName - let! snapshot = - FSharpProjectSnapshot.FromOptions(options, documentSource) + let! snapshot = FSharpProjectSnapshot.FromOptions(options, documentSource) return! ComputeSemanticClassification(fileName, snapshot.ProjectSnapshot) } @@ -2315,8 +2306,7 @@ type internal TransparentCompiler userOpName: string ) : Async = async { - let! snapshot = - FSharpProjectSnapshot.FromOptions(options, fileName, fileVersion, sourceText, documentSource) + let! snapshot = FSharpProjectSnapshot.FromOptions(options, fileName, fileVersion, sourceText, documentSource) return! this.ParseAndCheckFileInProject(fileName, snapshot.ProjectSnapshot, userOpName) } @@ -2328,8 +2318,7 @@ type internal TransparentCompiler async { ignore userOpName - let! snapshot = - FSharpProjectSnapshot.FromOptions(options, documentSource) + let! snapshot = FSharpProjectSnapshot.FromOptions(options, documentSource) return! ComputeParseAndCheckProject snapshot.ProjectSnapshot } diff --git a/src/Compiler/Service/service.fs b/src/Compiler/Service/service.fs index 686d7ccceab..afb561349ac 100644 --- a/src/Compiler/Service/service.fs +++ b/src/Compiler/Service/service.fs @@ -494,8 +494,7 @@ type FSharpChecker let userOpName = defaultArg userOpName "Unknown" async { - let! parseResults = - backgroundCompiler.ParseFile(fileName, projectSnapshot, userOpName) + let! parseResults = backgroundCompiler.ParseFile(fileName, projectSnapshot, userOpName) if parseResults.ParseTree.Identifiers |> Set.contains symbol.DisplayNameCore From afaf69255ccdeb8311a0f748b9b1b5fcc428fbac Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Tue, 27 Feb 2024 17:00:23 +0100 Subject: [PATCH 11/51] fix transparent compiler nre --- src/Compiler/Service/TransparentCompiler.fs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Compiler/Service/TransparentCompiler.fs b/src/Compiler/Service/TransparentCompiler.fs index 2506247a701..c304070dda2 100644 --- a/src/Compiler/Service/TransparentCompiler.fs +++ b/src/Compiler/Service/TransparentCompiler.fs @@ -1924,6 +1924,7 @@ type internal TransparentCompiler // Activity.start "ParseFile" [| Activity.Tags.fileName, fileName |> Path.GetFileName |] // TODO: might need to deal with exceptions here: + use _ = new CompilationGlobalsScope(DiscardErrorsLogger, BuildPhase.Parse) let! tcConfigB, sourceFileNames, _ = ComputeTcConfigBuilder projectSnapshot let tcConfig = TcConfig.Create(tcConfigB, validate = true) From cc7a6907eab838fe5522a4e86c8b05bf43548a51 Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Tue, 27 Feb 2024 17:04:33 +0100 Subject: [PATCH 12/51] cleanup --- src/Compiler/Facilities/BuildGraph.fs | 3 --- src/Compiler/Facilities/BuildGraph.fsi | 7 ------- src/Compiler/Facilities/DiagnosticsLogger.fs | 2 -- 3 files changed, 12 deletions(-) diff --git a/src/Compiler/Facilities/BuildGraph.fs b/src/Compiler/Facilities/BuildGraph.fs index fada5ae8c24..d31518b8d22 100644 --- a/src/Compiler/Facilities/BuildGraph.fs +++ b/src/Compiler/Facilities/BuildGraph.fs @@ -5,10 +5,7 @@ module FSharp.Compiler.BuildGraph open System open System.Threading open System.Threading.Tasks -open System.Diagnostics open System.Globalization -open FSharp.Compiler.DiagnosticsLogger -open Internal.Utilities.Library [] module GraphNode = diff --git a/src/Compiler/Facilities/BuildGraph.fsi b/src/Compiler/Facilities/BuildGraph.fsi index 8ea1bcf8cf5..2b3016bf99b 100644 --- a/src/Compiler/Facilities/BuildGraph.fsi +++ b/src/Compiler/Facilities/BuildGraph.fsi @@ -2,13 +2,6 @@ module internal FSharp.Compiler.BuildGraph -open System -open System.Diagnostics -open System.Threading -open System.Threading.Tasks -open FSharp.Compiler.DiagnosticsLogger -open Internal.Utilities.Library - /// Contains helpers related to the build graph [] module internal GraphNode = diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fs b/src/Compiler/Facilities/DiagnosticsLogger.fs index b5317198057..dd0be39b674 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -13,8 +13,6 @@ open System.Reflection open System.Threading open Internal.Utilities.Library open Internal.Utilities.Library.Extras -open System.Collections.Concurrent -open System.Threading open System.Threading.Tasks /// Represents the style being used to format errors From fd105bd4dd2d5db5ed67924716862e755e53f776 Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Tue, 27 Feb 2024 18:24:20 +0100 Subject: [PATCH 13/51] default value --- src/Compiler/Facilities/DiagnosticsLogger.fs | 45 +++++++++---------- src/Compiler/Facilities/DiagnosticsLogger.fsi | 7 +-- 2 files changed, 24 insertions(+), 28 deletions(-) diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fs b/src/Compiler/Facilities/DiagnosticsLogger.fs index dd0be39b674..cb4a0d4e449 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -343,6 +343,13 @@ let DiscardErrorsLogger = member _.ErrorCount = 0 } +let AssertFalseDiagnosticsLogger = + { new DiagnosticsLogger("AssertFalseDiagnosticsLogger") with + // TODO: reenable these asserts in the compiler service + member _.DiagnosticSink(diagnostic, severity) = (* assert false; *) () + member _.ErrorCount = (* assert false; *) 0 + } + type CapturingDiagnosticsLogger(nm, ?eagerFormat) = inherit DiagnosticsLogger(nm) let mutable errorCount = 0 @@ -368,26 +375,19 @@ type CapturingDiagnosticsLogger(nm, ?eagerFormat) = let errors = diagnostics.ToArray() errors |> Array.iter diagnosticsLogger.DiagnosticSink -let trace prefix (dl: DiagnosticsLogger) = - let name = if box dl |> isNull then "NULL" else dl.DebugDisplay() - Trace.WriteLine $"t:{Thread.CurrentThread.ManagedThreadId} {prefix} {name}" - dl - -let buildPhase = AsyncLocal<_>() -let diagnosticsLogger = AsyncLocal<_>() +let buildPhase = AsyncLocal() +let diagnosticsLogger = AsyncLocal() /// Type holds thread-static globals for use by the compiler. type internal DiagnosticsThreadStatics = - static member BuildPhaseUnchecked = buildPhase.Value - static member BuildPhase - with get () = buildPhase.Value - and set v = buildPhase.Value <- v + with get () = buildPhase.Value |> ValueOption.defaultValue BuildPhase.DefaultPhase + and set v = buildPhase.Value <- ValueSome v static member DiagnosticsLogger - with get () = diagnosticsLogger.Value - and set v = diagnosticsLogger.Value <- v + with get () = diagnosticsLogger.Value |> ValueOption.defaultValue AssertFalseDiagnosticsLogger + and set v = diagnosticsLogger.Value <- ValueSome v [] module DiagnosticsLoggerExtensions = @@ -418,7 +418,6 @@ module DiagnosticsLoggerExtensions = type DiagnosticsLogger with member x.EmitDiagnostic(exn, severity) = - trace "error emitted to " x |> ignore match exn with | InternalError(s, _) @@ -491,24 +490,21 @@ module DiagnosticsLoggerExtensions = /// NOTE: The change will be undone when the returned "unwind" object disposes let UseBuildPhase (phase: BuildPhase) = - let oldBuildPhase = DiagnosticsThreadStatics.BuildPhaseUnchecked + let oldBuildPhase = buildPhase.Value DiagnosticsThreadStatics.BuildPhase <- phase { new IDisposable with - member x.Dispose() = - DiagnosticsThreadStatics.BuildPhase <- oldBuildPhase + member x.Dispose() = buildPhase.Value <- oldBuildPhase } /// NOTE: The change will be undone when the returned "unwind" object disposes -let UseTransformedDiagnosticsLogger (transformer: DiagnosticsLogger -> #DiagnosticsLogger) = - let oldLogger = DiagnosticsThreadStatics.DiagnosticsLogger |> trace "old" - DiagnosticsThreadStatics.DiagnosticsLogger <- transformer oldLogger |> trace "new" - Trace.Indent() +let UseTransformedDiagnosticsLogger (transformer: DiagnosticsLogger -> DiagnosticsLogger) = + let oldLogger = DiagnosticsThreadStatics.DiagnosticsLogger + DiagnosticsThreadStatics.DiagnosticsLogger <- transformer oldLogger { new IDisposable with member _.Dispose() = - DiagnosticsThreadStatics.DiagnosticsLogger <- oldLogger |> trace "restore" - Trace.Unindent() + DiagnosticsThreadStatics.DiagnosticsLogger <- oldLogger } let UseDiagnosticsLogger newLogger = @@ -518,7 +514,6 @@ let SetThreadBuildPhaseNoUnwind (phase: BuildPhase) = DiagnosticsThreadStatics.BuildPhase <- phase let SetThreadDiagnosticsLoggerNoUnwind diagnosticsLogger = - //trace "no unwind" DiagnosticsThreadStatics.DiagnosticsLogger <- diagnosticsLogger /// This represents the thread-local state established as each task function runs as part of the build. @@ -528,7 +523,7 @@ type CompilationGlobalsScope(diagnosticsLogger: DiagnosticsLogger, buildPhase: B let unwindEL = UseDiagnosticsLogger diagnosticsLogger let unwindBP = UseBuildPhase buildPhase - new() = new CompilationGlobalsScope(diagnosticsLogger.Value, buildPhase.Value) + new() = new CompilationGlobalsScope(DiagnosticsThreadStatics.DiagnosticsLogger, DiagnosticsThreadStatics.BuildPhase) member _.DiagnosticsLogger = diagnosticsLogger member _.BuildPhase = buildPhase diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fsi b/src/Compiler/Facilities/DiagnosticsLogger.fsi index c455afbd65f..74b57158c5f 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fsi +++ b/src/Compiler/Facilities/DiagnosticsLogger.fsi @@ -208,6 +208,9 @@ type DiagnosticsLogger = /// Represents a DiagnosticsLogger that discards diagnostics val DiscardErrorsLogger: DiagnosticsLogger +/// Represents a DiagnosticsLogger that ignores diagnostics and asserts +val AssertFalseDiagnosticsLogger: DiagnosticsLogger + /// Represents a DiagnosticsLogger that captures all diagnostics, optionally formatting them /// eagerly. type CapturingDiagnosticsLogger = @@ -229,8 +232,6 @@ type DiagnosticsThreadStatics = static member BuildPhase: BuildPhase with get, set - static member BuildPhaseUnchecked: BuildPhase - static member DiagnosticsLogger: DiagnosticsLogger with get, set [] @@ -275,7 +276,7 @@ module DiagnosticsLoggerExtensions = val UseBuildPhase: phase: BuildPhase -> IDisposable /// NOTE: The change will be undone when the returned "unwind" object disposes -val UseTransformedDiagnosticsLogger: transformer: (DiagnosticsLogger -> #DiagnosticsLogger) -> IDisposable +val UseTransformedDiagnosticsLogger: transformer: (DiagnosticsLogger -> DiagnosticsLogger) -> IDisposable val UseDiagnosticsLogger: newLogger: DiagnosticsLogger -> IDisposable From 51ad4ce32675c37e23d15f6e3f855ab319962dfd Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Wed, 28 Feb 2024 07:36:25 +0100 Subject: [PATCH 14/51] add some comments --- src/Compiler/Facilities/DiagnosticsLogger.fs | 26 ++++++++++++-------- 1 file changed, 16 insertions(+), 10 deletions(-) diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fs b/src/Compiler/Facilities/DiagnosticsLogger.fs index cb4a0d4e449..5636deba63a 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -878,13 +878,15 @@ type StackGuard(maxDepth: int, name: string) = GetEnvInteger ("FSHARP_" + name + "StackGuardDepth") StackGuard.DefaultDepth type CaptureDiagnosticsConcurrently<'T>(computations: Async<'T> seq, ?eagerFormat) = + // Common error count for all computations. let mutable errorCount = 0 - let injected, diags = + let computationsWithLoggers, diagnosticsReady = [ for i, computation in computations |> Seq.indexed do - let tcs = TaskCompletionSource<_>() + let diagnosticsReady = TaskCompletionSource<_>() + // Diagnostics logger utilizing the common error count. let logger = { new CapturingDiagnosticsLogger($"CaptureDiagnosticsConcurrently {i}", ?eagerFormat = eagerFormat) with override _.DiagnosticSink(d, severity) = @@ -896,45 +898,49 @@ type CaptureDiagnosticsConcurrently<'T>(computations: Async<'T> seq, ?eagerForma override _.ErrorCount = errorCount } - let injected = + // Inject capturing loger into the computation. Signal the TaskCompletionSource when done. + let computationsWithLoggers = async { SetThreadDiagnosticsLoggerNoUnwind logger try return! computation finally - tcs.SetResult logger + diagnosticsReady.SetResult logger } - injected, tcs + computationsWithLoggers, diagnosticsReady ] |> List.unzip + // Commit diagnostics from computations as soon as it is possible, preserving the order. let replayDiagnostics = backgroundTask { let target = DiagnosticsThreadStatics.DiagnosticsLogger - for tcs in diags do + for tcs in diagnosticsReady do let! finishedLogger = tcs.Task finishedLogger.CommitDelayedDiagnostics target return target } - member val Computations = injected |> Seq.ofList + member val Computations = computationsWithLoggers |> Seq.ofList member val ReplayDiagnostics = replayDiagnostics module MultipleDiagnosticsLoggers = - let run method (computations: Async<'T> seq) = + // Capture diagnostics from multiple computations. + let run method computations = let forks = CaptureDiagnosticsConcurrently(computations) async { try + // We want to restore the current diagnostics context when finished. use _ = new CompilationGlobalsScope() return! forks.Computations |> method finally forks.ReplayDiagnostics.Wait() } - let Parallel computations = run Async.Parallel computations - let Sequential computations = run Async.Sequential computations + let Parallel computations = computations |> run Async.Parallel + let Sequential computations = computations |> run Async.Sequential From c271c57250758972d1d30fe4279b0153b2b43b7a Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Wed, 28 Feb 2024 08:20:31 +0100 Subject: [PATCH 15/51] foramt and notes to make it green if it's green --- docs/release-notes/.FSharp.Compiler.Service/8.0.300.md | 1 + docs/release-notes/.VisualStudio/17.10.md | 1 + src/Compiler/Facilities/DiagnosticsLogger.fs | 4 ++-- 3 files changed, 4 insertions(+), 2 deletions(-) diff --git a/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md b/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md index 5507157222e..913ba62ff10 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md +++ b/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md @@ -33,3 +33,4 @@ * Reverted [#16348](https://github.com/dotnet/fsharp/pull/16348) `ThreadStatic` `CancellationToken` changes to improve test stability and prevent potential unwanted cancellations. ([PR #16536](https://github.com/dotnet/fsharp/pull/16536)) * Refactored parenthesization API. ([PR #16461])(https://github.com/dotnet/fsharp/pull/16461)) * Optimize some interpolated strings by lowering to string concatenation. ([PR #16556](https://github.com/dotnet/fsharp/pull/16556)) +* AsyncLocal diagnostics context. ([PR #16779](https://github.com/dotnet/fsharp/pull/16779)) diff --git a/docs/release-notes/.VisualStudio/17.10.md b/docs/release-notes/.VisualStudio/17.10.md index a4b0a8a9f0d..1bff2a5c078 100644 --- a/docs/release-notes/.VisualStudio/17.10.md +++ b/docs/release-notes/.VisualStudio/17.10.md @@ -6,3 +6,4 @@ ### Changed * Use refactored parenthesization API in unnecessary parentheses code fix. ([PR #16461])(https://github.com/dotnet/fsharp/pull/16461)) +* Use AsyncLocal diagnostics context. ([PR #16779])(https://github.com/dotnet/fsharp/pull/16779)) diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fs b/src/Compiler/Facilities/DiagnosticsLogger.fs index 5636deba63a..73b0fc4f893 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -886,7 +886,7 @@ type CaptureDiagnosticsConcurrently<'T>(computations: Async<'T> seq, ?eagerForma for i, computation in computations |> Seq.indexed do let diagnosticsReady = TaskCompletionSource<_>() - // Diagnostics logger utilizing the common error count. + // Diagnostics logger utilizing the common error count. let logger = { new CapturingDiagnosticsLogger($"CaptureDiagnosticsConcurrently {i}", ?eagerFormat = eagerFormat) with override _.DiagnosticSink(d, severity) = @@ -942,5 +942,5 @@ module MultipleDiagnosticsLoggers = forks.ReplayDiagnostics.Wait() } - let Parallel computations = computations |> run Async.Parallel + let Parallel computations = computations |> run Async.Parallel let Sequential computations = computations |> run Async.Sequential From 0ca7fe608366eabf94d8da7b7f945a6615efd285 Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Wed, 28 Feb 2024 10:02:33 +0100 Subject: [PATCH 16/51] wrap any parallel computations that potentially push diagnostics --- src/Compiler/Facilities/DiagnosticsLogger.fs | 3 --- src/Compiler/Service/FSharpProjectSnapshot.fs | 4 ++-- src/Compiler/Service/IncrementalBuild.fs | 8 ++++---- src/Compiler/Service/TransparentCompiler.fs | 4 ++-- tests/service/ExprTests.fs | 4 ---- 5 files changed, 8 insertions(+), 15 deletions(-) diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fs b/src/Compiler/Facilities/DiagnosticsLogger.fs index 73b0fc4f893..748e6cca4ec 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -850,14 +850,11 @@ type StackGuard(maxDepth: int, name: string) = try if depth % maxDepth = 0 then - let diagnosticsLogger = DiagnosticsThreadStatics.DiagnosticsLogger - let buildPhase = DiagnosticsThreadStatics.BuildPhase let ct = Cancellable.Token async { do! Async.SwitchToNewThread() Thread.CurrentThread.Name <- $"F# Extra Compilation Thread for {name} (depth {depth})" - use _scope = new CompilationGlobalsScope(diagnosticsLogger, buildPhase) use _token = Cancellable.UsingToken ct return f () } diff --git a/src/Compiler/Service/FSharpProjectSnapshot.fs b/src/Compiler/Service/FSharpProjectSnapshot.fs index 76d9705890e..fd0319cf312 100644 --- a/src/Compiler/Service/FSharpProjectSnapshot.fs +++ b/src/Compiler/Service/FSharpProjectSnapshot.fs @@ -590,7 +590,7 @@ and [] FSha // TODO: check if options is a good key here if not (snapshotAccumulator.ContainsKey options) then - let! sourceFiles = options.SourceFiles |> Seq.map (getFileSnapshot options) |> Async.Parallel + let! sourceFiles = options.SourceFiles |> Seq.map (getFileSnapshot options) |> MultipleDiagnosticsLoggers.Parallel let! referencedProjects = options.ReferencedProjects @@ -607,7 +607,7 @@ and [] FSha async.Return <| FSharpReferencedProjectSnapshot.ILModuleReference(outputName, getStamp, getReader)) - |> Async.Sequential + |> MultipleDiagnosticsLoggers.Sequential let referencesOnDisk, otherOptions = options.OtherOptions diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index 1704af36bef..76056026c1d 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -740,12 +740,12 @@ module IncrementalBuilderHelpers = let diagnosticsLogger = CompilationDiagnosticLogger("FinalizeTypeCheckTask", tcConfig.diagnosticsOptions) use _ = new CompilationGlobalsScope(diagnosticsLogger, BuildPhase.TypeCheck) - let! computedBoundModels = boundModels |> Seq.map (fun g -> g.GetOrComputeValue()) |> Async.Sequential + let! computedBoundModels = boundModels |> Seq.map (fun g -> g.GetOrComputeValue()) |> MultipleDiagnosticsLoggers.Sequential let! tcInfos = computedBoundModels |> Seq.map (fun boundModel -> async { return! boundModel.GetOrComputeTcInfo() }) - |> Async.Sequential + |> MultipleDiagnosticsLoggers.Sequential // tcInfoExtras can be computed in parallel. This will check any previously skipped implementation files in parallel, too. let! latestImplFiles = @@ -757,7 +757,7 @@ module IncrementalBuilderHelpers = let! tcInfoExtras = boundModel.GetOrComputeTcInfoExtras() return tcInfoExtras.latestImplFile }) - |> Async.Parallel + |> MultipleDiagnosticsLoggers.Parallel let results = [ for tcInfo, latestImplFile in Seq.zip tcInfos latestImplFiles -> @@ -826,7 +826,7 @@ module IncrementalBuilderHelpers = let! partialDiagnostics = computedBoundModels |> Seq.map (fun m -> m.Diagnostics.GetOrComputeValue()) - |> Async.Parallel + |> MultipleDiagnosticsLoggers.Parallel let diagnostics = [ diagnosticsLogger.GetDiagnostics() yield! partialDiagnostics |> Seq.rev diff --git a/src/Compiler/Service/TransparentCompiler.fs b/src/Compiler/Service/TransparentCompiler.fs index c304070dda2..a95ead4a653 100644 --- a/src/Compiler/Service/TransparentCompiler.fs +++ b/src/Compiler/Service/TransparentCompiler.fs @@ -994,7 +994,7 @@ type internal TransparentCompiler let! sources = projectSnapshot.SourceFiles |> Seq.map (fun f -> LoadSource f isExe (f.FileName = bootstrapInfo.LastFileName)) - |> Async.Parallel + |> MultipleDiagnosticsLoggers.Parallel return ProjectSnapshotWithSources(projectSnapshot.ProjectCore, sources |> Array.toList) @@ -1402,7 +1402,7 @@ type internal TransparentCompiler let! parsedInputs = projectSnapshot.SourceFiles |> Seq.map (ComputeParseFile projectSnapshot tcConfig) - |> Async.Parallel + |> MultipleDiagnosticsLoggers.Parallel return ProjectSnapshotBase<_>(projectSnapshot.ProjectCore, parsedInputs |> Array.toList) } diff --git a/tests/service/ExprTests.fs b/tests/service/ExprTests.fs index 6045ad957ff..e8672f8b718 100644 --- a/tests/service/ExprTests.fs +++ b/tests/service/ExprTests.fs @@ -737,8 +737,6 @@ let ignoreTestIfStackOverflowExpected () = [] let ``Test Unoptimized Declarations Project1`` useTransparentCompiler = - use _ = new DiagnosticsScope(false) - let cleanup, options = Project1.createOptionsWithArgs [ "--langversion:preview" ] use _holder = cleanup let exprChecker = FSharpChecker.Create(keepAssemblyContents=true, useTransparentCompiler=useTransparentCompiler) @@ -881,8 +879,6 @@ let ``Test Unoptimized Declarations Project1`` useTransparentCompiler = [] let ``Test Optimized Declarations Project1`` useTransparentCompiler = - use _ = new DiagnosticsScope(false) - let cleanup, options = Project1.createOptionsWithArgs [ "--langversion:preview" ] use _holder = cleanup let exprChecker = FSharpChecker.Create(keepAssemblyContents=true, useTransparentCompiler=useTransparentCompiler) From ee4695551da63c32e6c0bd31b6e9666b120a7de9 Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Wed, 28 Feb 2024 10:03:06 +0100 Subject: [PATCH 17/51] try to fix buildgraphtests --- tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs b/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs index 95d789a9891..f939acde043 100644 --- a/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs +++ b/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs @@ -74,7 +74,7 @@ module BuildGraphTests = let work = Async.Parallel(Array.init requests (fun _ -> graphNode.GetOrComputeValue())) - Async.RunImmediate(work) + Async.RunSynchronously(work) |> ignore Assert.shouldBe 1 computationCount @@ -87,7 +87,7 @@ module BuildGraphTests = let work = Async.Parallel(Array.init requests (fun _ -> graphNode.GetOrComputeValue())) - let result = Async.RunImmediate(work) + let result = Async.RunSynchronously(work) Assert.shouldNotBeEmpty result Assert.shouldBe requests result.Length @@ -102,7 +102,7 @@ module BuildGraphTests = Assert.shouldBeTrue weak.IsAlive - Async.RunImmediate(graphNode.GetOrComputeValue()) + Async.RunSynchronously(graphNode.GetOrComputeValue()) |> ignore GC.Collect(2, GCCollectionMode.Forced, true) @@ -119,7 +119,7 @@ module BuildGraphTests = Assert.shouldBeTrue weak.IsAlive - Async.RunImmediate(Async.Parallel(Array.init requests (fun _ -> graphNode.GetOrComputeValue()))) + Async.RunSynchronously(Async.Parallel(Array.init requests (fun _ -> graphNode.GetOrComputeValue()))) |> ignore GC.Collect(2, GCCollectionMode.Forced, true) @@ -201,7 +201,7 @@ module BuildGraphTests = cts.Cancel() resetEvent.Set() |> ignore - Async.RunImmediate(work) + Async.RunSynchronously(work) |> ignore Assert.shouldBeTrue cts.IsCancellationRequested From 7c3cd98fba7c2335334a52cecb6d1dea53f5e983 Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Wed, 28 Feb 2024 11:07:59 +0100 Subject: [PATCH 18/51] try to eradicate deadlocks in tests --- src/Compiler/Driver/CompilerImports.fs | 2 +- src/Compiler/Facilities/BuildGraph.fs | 1 + src/Compiler/Service/FSharpProjectSnapshot.fs | 5 ++++- 3 files changed, 6 insertions(+), 2 deletions(-) diff --git a/src/Compiler/Driver/CompilerImports.fs b/src/Compiler/Driver/CompilerImports.fs index 504bbc88c7a..20e36e25b99 100644 --- a/src/Compiler/Driver/CompilerImports.fs +++ b/src/Compiler/Driver/CompilerImports.fs @@ -2283,7 +2283,7 @@ and [] TcImports ReportWarnings warns tcImports.RegisterAndImportReferencedAssemblies(ctok, res) - |> Async.RunImmediate + |> Async.RunSynchronously |> ignore true diff --git a/src/Compiler/Facilities/BuildGraph.fs b/src/Compiler/Facilities/BuildGraph.fs index d31518b8d22..3bc99d858e1 100644 --- a/src/Compiler/Facilities/BuildGraph.fs +++ b/src/Compiler/Facilities/BuildGraph.fs @@ -76,6 +76,7 @@ type GraphNode<'T> private (computation: Async<'T>, cachedResult: ValueOption<'T Async.StartWithContinuations( async { + do! Async.SwitchToThreadPool() Thread.CurrentThread.CurrentUICulture <- GraphNode.culture return! computation }, diff --git a/src/Compiler/Service/FSharpProjectSnapshot.fs b/src/Compiler/Service/FSharpProjectSnapshot.fs index fd0319cf312..244f9a298f5 100644 --- a/src/Compiler/Service/FSharpProjectSnapshot.fs +++ b/src/Compiler/Service/FSharpProjectSnapshot.fs @@ -590,7 +590,10 @@ and [] FSha // TODO: check if options is a good key here if not (snapshotAccumulator.ContainsKey options) then - let! sourceFiles = options.SourceFiles |> Seq.map (getFileSnapshot options) |> MultipleDiagnosticsLoggers.Parallel + let! sourceFiles = + options.SourceFiles + |> Seq.map (getFileSnapshot options) + |> MultipleDiagnosticsLoggers.Parallel let! referencedProjects = options.ReferencedProjects From 2d0a74e993ae2936b9b6e08692d2f54b7de718c3 Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Wed, 28 Feb 2024 12:16:39 +0100 Subject: [PATCH 19/51] fix buildgraph test --- .../FSharp.Compiler.UnitTests/BuildGraphTests.fs | 15 ++++++--------- 1 file changed, 6 insertions(+), 9 deletions(-) diff --git a/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs b/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs index f939acde043..256d3e870ca 100644 --- a/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs +++ b/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs @@ -135,13 +135,14 @@ module BuildGraphTests = use cts = new CancellationTokenSource() + cts.Cancel() + let work(): Task = Async.StartAsTask( async { - cts.Cancel() return! graphNode.GetOrComputeValue() }, cancellationToken = cts.Token) - Assert.ThrowsAnyAsync(work).Wait() + Assert.ThrowsAnyAsync(work).Wait(TimeSpan.FromSeconds 10) [] let ``A request can cancel 2``() = @@ -155,17 +156,13 @@ module BuildGraphTests = use cts = new CancellationTokenSource() - let task = - async { - cts.Cancel() - resetEvent.Set() |> ignore - } - |> Async.StartAsTask - Assert.ThrowsAnyAsync(fun () -> Async.StartImmediateAsTask(graphNode.GetOrComputeValue(), cancellationToken = cts.Token) ) |> ignore + cts.Cancel() + resetEvent.Set() |> ignore + [] let ``Many requests to get a value asynchronously might evaluate the computation more than once even when some requests get canceled``() = let requests = 10000 From adf0417dfe45c679802501abfc14555f1bc3698f Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Wed, 28 Feb 2024 13:04:19 +0100 Subject: [PATCH 20/51] disable for a moment --- tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs b/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs index 256d3e870ca..fc3e7e384b7 100644 --- a/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs +++ b/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs @@ -126,7 +126,7 @@ module BuildGraphTests = Assert.shouldBeFalse weak.IsAlive - [] + // [] let ``A request can cancel``() = let graphNode = GraphNode(async { @@ -144,7 +144,7 @@ module BuildGraphTests = Assert.ThrowsAnyAsync(work).Wait(TimeSpan.FromSeconds 10) - [] + // [] let ``A request can cancel 2``() = let resetEvent = new ManualResetEvent(false) From 3673b4693ce9aa7facca548ed2738d185d6604e3 Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Wed, 28 Feb 2024 19:57:10 +0100 Subject: [PATCH 21/51] flatten exceptions --- src/Compiler/Driver/fsc.fs | 4 ++-- src/Compiler/Facilities/DiagnosticsLogger.fs | 7 +++++++ src/Compiler/Facilities/DiagnosticsLogger.fsi | 3 +++ src/Compiler/Interactive/fsi.fs | 5 +++-- 4 files changed, 15 insertions(+), 4 deletions(-) diff --git a/src/Compiler/Driver/fsc.fs b/src/Compiler/Driver/fsc.fs index f745638d5ec..708d79fed42 100644 --- a/src/Compiler/Driver/fsc.fs +++ b/src/Compiler/Driver/fsc.fs @@ -614,7 +614,7 @@ let main1 // Import basic assemblies let tcGlobals, frameworkTcImports = TcImports.BuildFrameworkTcImports(foundationalTcConfigP, sysRes, otherRes) - |> Async.RunImmediate + |> Async.RunImmediateWithoutCancellation let ilSourceDocs = [ @@ -663,7 +663,7 @@ let main1 let tcImports = TcImports.BuildNonFrameworkTcImports(tcConfigP, frameworkTcImports, otherRes, knownUnresolved, dependencyProvider) - |> Async.RunImmediate + |> Async.RunImmediateWithoutCancellation // register tcImports to be disposed in future disposables.Register tcImports diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fs b/src/Compiler/Facilities/DiagnosticsLogger.fs index 748e6cca4ec..4dd34541879 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -941,3 +941,10 @@ module MultipleDiagnosticsLoggers = let Parallel computations = computations |> run Async.Parallel let Sequential computations = computations |> run Async.Sequential + +module Async = + let RunImmediateWithoutCancellation computation = + try + Async.RunImmediate(computation, CancellationToken.None) + with :? AggregateException as ex when ex.InnerExceptions.Count = 1 -> + raise (ex.InnerExceptions[0]) diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fsi b/src/Compiler/Facilities/DiagnosticsLogger.fsi index 74b57158c5f..c202493e5d6 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fsi +++ b/src/Compiler/Facilities/DiagnosticsLogger.fsi @@ -469,3 +469,6 @@ module MultipleDiagnosticsLoggers = val Parallel: computations: Async<'T> seq -> Async<'T array> val Sequential: computations: Async<'T> seq -> Async<'T array> + +module Async = + val RunImmediateWithoutCancellation: Async<'T> -> 'T diff --git a/src/Compiler/Interactive/fsi.fs b/src/Compiler/Interactive/fsi.fs index c48e4afe56c..310c7b07aff 100644 --- a/src/Compiler/Interactive/fsi.fs +++ b/src/Compiler/Interactive/fsi.fs @@ -4593,7 +4593,8 @@ type FsiEvaluationSession try let tcConfig = tcConfigP.Get(ctokStartup) - checker.FrameworkImportsCache.Get tcConfig |> Async.RunImmediate + checker.FrameworkImportsCache.Get tcConfig + |> Async.RunImmediateWithoutCancellation with e -> stopProcessingRecovery e range0 failwithf "Error creating evaluation session: %A" e @@ -4607,7 +4608,7 @@ type FsiEvaluationSession unresolvedReferences, fsiOptions.DependencyProvider ) - |> Async.RunImmediate + |> Async.RunImmediateWithoutCancellation with e -> stopProcessingRecovery e range0 failwithf "Error creating evaluation session: %A" e From fbb3a4a8bc8f0ddc880fb6039c65abaacff342fc Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Wed, 28 Feb 2024 20:47:19 +0100 Subject: [PATCH 22/51] reshuffle --- src/Compiler/Facilities/BuildGraph.fs | 13 +++++++++++-- src/Compiler/Facilities/DiagnosticsLogger.fs | 7 ------- src/Compiler/Facilities/DiagnosticsLogger.fsi | 3 --- src/Compiler/Utilities/illib.fs | 8 +++++++- src/Compiler/Utilities/illib.fsi | 3 +++ 5 files changed, 21 insertions(+), 13 deletions(-) diff --git a/src/Compiler/Facilities/BuildGraph.fs b/src/Compiler/Facilities/BuildGraph.fs index 3bc99d858e1..121c54000bf 100644 --- a/src/Compiler/Facilities/BuildGraph.fs +++ b/src/Compiler/Facilities/BuildGraph.fs @@ -7,6 +7,16 @@ open System.Threading open System.Threading.Tasks open System.Globalization +type Async with + + static member FlattenException(computation: Async<'T>) = + async { + try + return! computation + with :? AggregateException as ex when ex.InnerExceptions.Count = 1 -> + return raise (ex.InnerExceptions[0]) + } + [] module GraphNode = @@ -76,7 +86,6 @@ type GraphNode<'T> private (computation: Async<'T>, cachedResult: ValueOption<'T Async.StartWithContinuations( async { - do! Async.SwitchToThreadPool() Thread.CurrentThread.CurrentUICulture <- GraphNode.culture return! computation }, @@ -90,7 +99,7 @@ type GraphNode<'T> private (computation: Async<'T>, cachedResult: ValueOption<'T ct ) - return! tcs.Task |> Async.AwaitTask + return! tcs.Task |> Async.AwaitTask |> Async.FlattenException finally if taken then semaphore.Release() |> ignore diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fs b/src/Compiler/Facilities/DiagnosticsLogger.fs index 4dd34541879..748e6cca4ec 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -941,10 +941,3 @@ module MultipleDiagnosticsLoggers = let Parallel computations = computations |> run Async.Parallel let Sequential computations = computations |> run Async.Sequential - -module Async = - let RunImmediateWithoutCancellation computation = - try - Async.RunImmediate(computation, CancellationToken.None) - with :? AggregateException as ex when ex.InnerExceptions.Count = 1 -> - raise (ex.InnerExceptions[0]) diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fsi b/src/Compiler/Facilities/DiagnosticsLogger.fsi index c202493e5d6..74b57158c5f 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fsi +++ b/src/Compiler/Facilities/DiagnosticsLogger.fsi @@ -469,6 +469,3 @@ module MultipleDiagnosticsLoggers = val Parallel: computations: Async<'T> seq -> Async<'T array> val Sequential: computations: Async<'T> seq -> Async<'T array> - -module Async = - val RunImmediateWithoutCancellation: Async<'T> -> 'T diff --git a/src/Compiler/Utilities/illib.fs b/src/Compiler/Utilities/illib.fs index fca3cd54605..f33d77bc2d6 100644 --- a/src/Compiler/Utilities/illib.fs +++ b/src/Compiler/Utilities/illib.fs @@ -165,7 +165,13 @@ module internal PervasiveAutoOpens = Async.StartWithContinuations(computation, (ts.SetResult), (ts.SetException), (fun _ -> ts.SetCanceled()), cancellationToken) - task.Result + try + task.Result + with :? AggregateException as ex when ex.InnerExceptions.Count = 1 -> + raise (ex.InnerExceptions[0]) + + static member RunImmediateWithoutCancellation(computation: Async<'T>) = + Async.RunImmediate(computation, CancellationToken.None) [] type DelayInitArrayMap<'T, 'TDictKey, 'TDictValue>(f: unit -> 'T[]) = diff --git a/src/Compiler/Utilities/illib.fsi b/src/Compiler/Utilities/illib.fsi index a9ee48c4be9..d9ee787c2fb 100644 --- a/src/Compiler/Utilities/illib.fsi +++ b/src/Compiler/Utilities/illib.fsi @@ -90,6 +90,9 @@ module internal PervasiveAutoOpens = /// Runs the computation synchronously, always starting on the current thread. static member RunImmediate: computation: Async<'T> * ?cancellationToken: CancellationToken -> 'T + /// Runs the computation synchronously, always starting on the current thread, using CancellationToken.None. + static member RunImmediateWithoutCancellation: computation: Async<'T> -> 'T + val foldOn: p: ('a -> 'b) -> f: ('c -> 'b -> 'd) -> z: 'c -> x: 'a -> 'd val notFound: unit -> 'a From 46e81bd60803d9029237fb2d52173f519b91f7dc Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Wed, 28 Feb 2024 23:40:15 +0100 Subject: [PATCH 23/51] prevent graphnode deadlock --- src/Compiler/Facilities/BuildGraph.fs | 3 + .../BuildGraphTests.fs | 63 ++++++++++++------- 2 files changed, 45 insertions(+), 21 deletions(-) diff --git a/src/Compiler/Facilities/BuildGraph.fs b/src/Compiler/Facilities/BuildGraph.fs index 121c54000bf..c57dc92938e 100644 --- a/src/Compiler/Facilities/BuildGraph.fs +++ b/src/Compiler/Facilities/BuildGraph.fs @@ -79,6 +79,9 @@ type GraphNode<'T> private (computation: Async<'T>, cachedResult: ValueOption<'T ) |> Async.AwaitTask + // Prevent deadlocks. + do! Async.SwitchToThreadPool() + match cachedResult with | ValueSome value -> return value | _ -> diff --git a/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs b/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs index fc3e7e384b7..547b88b7d49 100644 --- a/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs +++ b/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs @@ -3,7 +3,6 @@ namespace FSharp.Compiler.UnitTests open System open System.Threading -open System.Threading.Tasks open System.Runtime.CompilerServices open Xunit open FSharp.Test @@ -72,9 +71,9 @@ module BuildGraphTests = return 1 }) - let work = Async.Parallel(Array.init requests (fun _ -> graphNode.GetOrComputeValue())) + let work = Async.Parallel(Array.init requests (fun _ -> graphNode.GetOrComputeValue() )) - Async.RunSynchronously(work) + Async.RunImmediate(work) |> ignore Assert.shouldBe 1 computationCount @@ -85,9 +84,9 @@ module BuildGraphTests = let graphNode = GraphNode(async { return 1 }) - let work = Async.Parallel(Array.init requests (fun _ -> graphNode.GetOrComputeValue())) + let work = Async.Parallel(Array.init requests (fun _ -> graphNode.GetOrComputeValue() )) - let result = Async.RunSynchronously(work) + let result = Async.RunImmediate(work) Assert.shouldNotBeEmpty result Assert.shouldBe requests result.Length @@ -102,7 +101,7 @@ module BuildGraphTests = Assert.shouldBeTrue weak.IsAlive - Async.RunSynchronously(graphNode.GetOrComputeValue()) + Async.RunImmediateWithoutCancellation(graphNode.GetOrComputeValue()) |> ignore GC.Collect(2, GCCollectionMode.Forced, true) @@ -119,14 +118,14 @@ module BuildGraphTests = Assert.shouldBeTrue weak.IsAlive - Async.RunSynchronously(Async.Parallel(Array.init requests (fun _ -> graphNode.GetOrComputeValue()))) + Async.RunImmediate(Async.Parallel(Array.init requests (fun _ -> graphNode.GetOrComputeValue() ))) |> ignore GC.Collect(2, GCCollectionMode.Forced, true) Assert.shouldBeFalse weak.IsAlive - // [] + [] let ``A request can cancel``() = let graphNode = GraphNode(async { @@ -135,33 +134,53 @@ module BuildGraphTests = use cts = new CancellationTokenSource() - cts.Cancel() - - let work(): Task = Async.StartAsTask( + let work = async { + cts.Cancel() return! graphNode.GetOrComputeValue() - }, cancellationToken = cts.Token) + } + + let ex = + try + Async.RunImmediate(work, cancellationToken = cts.Token) + |> ignore + failwith "Should have canceled" + with + | :? OperationCanceledException as ex -> + ex - Assert.ThrowsAnyAsync(work).Wait(TimeSpan.FromSeconds 10) + Assert.shouldBeTrue(ex <> null) - // [] + [] let ``A request can cancel 2``() = let resetEvent = new ManualResetEvent(false) let graphNode = GraphNode(async { let! _ = Async.AwaitWaitHandle(resetEvent) - failwith "Should have canceled" + return 1 }) use cts = new CancellationTokenSource() - Assert.ThrowsAnyAsync(fun () -> - Async.StartImmediateAsTask(graphNode.GetOrComputeValue(), cancellationToken = cts.Token) - ) |> ignore + let task = + async { + cts.Cancel() + resetEvent.Set() |> ignore + } + |> Async.StartAsTask + + let ex = + try + Async.RunImmediate(graphNode.GetOrComputeValue(), cancellationToken = cts.Token) + |> ignore + failwith "Should have canceled" + with + | :? OperationCanceledException as ex -> + ex - cts.Cancel() - resetEvent.Set() |> ignore + Assert.shouldBeTrue(ex <> null) + try task.Wait(1000) |> ignore with | :? TimeoutException -> reraise() | _ -> () [] let ``Many requests to get a value asynchronously might evaluate the computation more than once even when some requests get canceled``() = @@ -198,7 +217,7 @@ module BuildGraphTests = cts.Cancel() resetEvent.Set() |> ignore - Async.RunSynchronously(work) + Async.RunImmediateWithoutCancellation(work) |> ignore Assert.shouldBeTrue cts.IsCancellationRequested @@ -227,6 +246,8 @@ module BuildGraphTests = let job phase i = async { do! random 10 |> Async.Sleep Assert.Equal(phase, DiagnosticsThreadStatics.BuildPhase) + DiagnosticsThreadStatics.DiagnosticsLogger.DebugDisplay() + |> Assert.shouldBe $"DiagnosticsLogger(CaptureDiagnosticsConcurrently {i})" errorR (ExampleException $"job {i}") } From 29563c1426018025098bf609d3abcc3e7aa7ccfe Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Thu, 29 Feb 2024 01:21:01 +0100 Subject: [PATCH 24/51] yield --- src/Compiler/Driver/CompilerImports.fs | 4 +- src/Compiler/Facilities/AsyncMemoize.fs | 54 ++++++++++++------------- 2 files changed, 29 insertions(+), 29 deletions(-) diff --git a/src/Compiler/Driver/CompilerImports.fs b/src/Compiler/Driver/CompilerImports.fs index 20e36e25b99..5775d514dd4 100644 --- a/src/Compiler/Driver/CompilerImports.fs +++ b/src/Compiler/Driver/CompilerImports.fs @@ -2231,6 +2231,8 @@ and [] TcImports async { CheckDisposed() + do! Async.SwitchToThreadPool() + let tcConfig = tcConfigP.Get ctok let runMethod = @@ -2604,7 +2606,7 @@ let RequireReferences (ctok, tcImports: TcImports, tcEnv, thisAssemblyName, reso let ccuinfos = tcImports.RegisterAndImportReferencedAssemblies(ctok, resolutions) - |> Async.RunSynchronously + |> Async.RunImmediateWithoutCancellation let asms = ccuinfos diff --git a/src/Compiler/Facilities/AsyncMemoize.fs b/src/Compiler/Facilities/AsyncMemoize.fs index 770ada1b7fe..61b66c4b9d0 100644 --- a/src/Compiler/Facilities/AsyncMemoize.fs +++ b/src/Compiler/Facilities/AsyncMemoize.fs @@ -313,7 +313,7 @@ type internal AsyncMemoize<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'T let processStateUpdate post (key: KeyData<_, _>, action: StateUpdate<_>) = task { - do! Task.Delay 0 + do! Task.Yield() do! lock.Do(fun () -> @@ -343,36 +343,34 @@ type internal AsyncMemoize<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'T else // We need to restart the computation - Task.Run(fun () -> - Async.StartAsTask( - async { + Async.Start( + async { - let cachingLogger = new CachingDiagnosticsLogger(None) + let cachingLogger = new CachingDiagnosticsLogger(None) + + try + // TODO: Should unify starting and restarting + log (Restarted, key) + Interlocked.Increment &restarted |> ignore + System.Diagnostics.Trace.TraceInformation $"{name} Restarted {key.Label}" + let currentLogger = DiagnosticsThreadStatics.DiagnosticsLogger + DiagnosticsThreadStatics.DiagnosticsLogger <- cachingLogger try - // TODO: Should unify starting and restarting - log (Restarted, key) - Interlocked.Increment &restarted |> ignore - System.Diagnostics.Trace.TraceInformation $"{name} Restarted {key.Label}" - let currentLogger = DiagnosticsThreadStatics.DiagnosticsLogger - DiagnosticsThreadStatics.DiagnosticsLogger <- cachingLogger - - try - let! result = computation - post (key, (JobCompleted(result, cachingLogger.CapturedDiagnostics))) - return () - finally - DiagnosticsThreadStatics.DiagnosticsLogger <- currentLogger - with - | TaskCancelled _ -> - Interlocked.Increment &cancel_exception_subsequent |> ignore - post (key, CancelRequest) - () - | ex -> post (key, (JobFailed(ex, cachingLogger.CapturedDiagnostics))) - } - ), - cts.Token) - |> ignore + let! result = computation + post (key, (JobCompleted(result, cachingLogger.CapturedDiagnostics))) + return () + finally + DiagnosticsThreadStatics.DiagnosticsLogger <- currentLogger + with + | TaskCancelled _ -> + Interlocked.Increment &cancel_exception_subsequent |> ignore + post (key, CancelRequest) + () + | ex -> post (key, (JobFailed(ex, cachingLogger.CapturedDiagnostics))) + }, + cancellationToken = cts.Token + ) | CancelRequest, Some(Running(tcs, cts, _c, _, _)) -> From 24180d005af728dd2c7a8b8afbdf141d3e62e419 Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Thu, 29 Feb 2024 10:20:52 +0100 Subject: [PATCH 25/51] diff --- src/Compiler/Driver/CompilerImports.fs | 2 +- src/Compiler/Facilities/AsyncMemoize.fs | 52 +++++++++++++------------ tests/service/ExprTests.fs | 2 - 3 files changed, 28 insertions(+), 28 deletions(-) diff --git a/src/Compiler/Driver/CompilerImports.fs b/src/Compiler/Driver/CompilerImports.fs index 5775d514dd4..0beae1bc60f 100644 --- a/src/Compiler/Driver/CompilerImports.fs +++ b/src/Compiler/Driver/CompilerImports.fs @@ -2285,7 +2285,7 @@ and [] TcImports ReportWarnings warns tcImports.RegisterAndImportReferencedAssemblies(ctok, res) - |> Async.RunSynchronously + |> Async.RunImmediateWithoutCancellation |> ignore true diff --git a/src/Compiler/Facilities/AsyncMemoize.fs b/src/Compiler/Facilities/AsyncMemoize.fs index 61b66c4b9d0..5554af166da 100644 --- a/src/Compiler/Facilities/AsyncMemoize.fs +++ b/src/Compiler/Facilities/AsyncMemoize.fs @@ -343,34 +343,36 @@ type internal AsyncMemoize<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'T else // We need to restart the computation - Async.Start( - async { + Task.Run(fun () -> + Async.StartAsTask( + async { - let cachingLogger = new CachingDiagnosticsLogger(None) - - try - // TODO: Should unify starting and restarting - log (Restarted, key) - Interlocked.Increment &restarted |> ignore - System.Diagnostics.Trace.TraceInformation $"{name} Restarted {key.Label}" - let currentLogger = DiagnosticsThreadStatics.DiagnosticsLogger - DiagnosticsThreadStatics.DiagnosticsLogger <- cachingLogger + let cachingLogger = new CachingDiagnosticsLogger(None) try - let! result = computation - post (key, (JobCompleted(result, cachingLogger.CapturedDiagnostics))) - return () - finally - DiagnosticsThreadStatics.DiagnosticsLogger <- currentLogger - with - | TaskCancelled _ -> - Interlocked.Increment &cancel_exception_subsequent |> ignore - post (key, CancelRequest) - () - | ex -> post (key, (JobFailed(ex, cachingLogger.CapturedDiagnostics))) - }, - cancellationToken = cts.Token - ) + // TODO: Should unify starting and restarting + log (Restarted, key) + Interlocked.Increment &restarted |> ignore + System.Diagnostics.Trace.TraceInformation $"{name} Restarted {key.Label}" + let currentLogger = DiagnosticsThreadStatics.DiagnosticsLogger + DiagnosticsThreadStatics.DiagnosticsLogger <- cachingLogger + + try + let! result = computation + post (key, (JobCompleted(result, cachingLogger.CapturedDiagnostics))) + return () + finally + DiagnosticsThreadStatics.DiagnosticsLogger <- currentLogger + with + | TaskCancelled _ -> + Interlocked.Increment &cancel_exception_subsequent |> ignore + post (key, CancelRequest) + () + | ex -> post (key, (JobFailed(ex, cachingLogger.CapturedDiagnostics))) + } + ), + cts.Token) + |> ignore | CancelRequest, Some(Running(tcs, cts, _c, _, _)) -> diff --git a/tests/service/ExprTests.fs b/tests/service/ExprTests.fs index e8672f8b718..1371c24f231 100644 --- a/tests/service/ExprTests.fs +++ b/tests/service/ExprTests.fs @@ -736,7 +736,6 @@ let ignoreTestIfStackOverflowExpected () = [] [] let ``Test Unoptimized Declarations Project1`` useTransparentCompiler = - let cleanup, options = Project1.createOptionsWithArgs [ "--langversion:preview" ] use _holder = cleanup let exprChecker = FSharpChecker.Create(keepAssemblyContents=true, useTransparentCompiler=useTransparentCompiler) @@ -878,7 +877,6 @@ let ``Test Unoptimized Declarations Project1`` useTransparentCompiler = [] [] let ``Test Optimized Declarations Project1`` useTransparentCompiler = - let cleanup, options = Project1.createOptionsWithArgs [ "--langversion:preview" ] use _holder = cleanup let exprChecker = FSharpChecker.Create(keepAssemblyContents=true, useTransparentCompiler=useTransparentCompiler) From 63492dca5503353e0959224e8fb884c9ef3d1e0a Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Thu, 29 Feb 2024 15:30:10 +0100 Subject: [PATCH 26/51] add some comments --- src/Compiler/Driver/CompilerImports.fs | 1 + src/Compiler/Facilities/DiagnosticsLogger.fsi | 7 +++++++ 2 files changed, 8 insertions(+) diff --git a/src/Compiler/Driver/CompilerImports.fs b/src/Compiler/Driver/CompilerImports.fs index 0beae1bc60f..698178d6261 100644 --- a/src/Compiler/Driver/CompilerImports.fs +++ b/src/Compiler/Driver/CompilerImports.fs @@ -2231,6 +2231,7 @@ and [] TcImports async { CheckDisposed() + // Prevent deadlocks in FSI. do! Async.SwitchToThreadPool() let tcConfig = tcConfigP.Get ctok diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fsi b/src/Compiler/Facilities/DiagnosticsLogger.fsi index 74b57158c5f..f897d11c936 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fsi +++ b/src/Compiler/Facilities/DiagnosticsLogger.fsi @@ -456,6 +456,7 @@ type StackGuard = type CompilationGlobalsScope = new: diagnosticsLogger: DiagnosticsLogger * buildPhase: BuildPhase -> CompilationGlobalsScope + /// When dispoed, restores caller's diagnostics logger and build phase. new: unit -> CompilationGlobalsScope interface IDisposable @@ -466,6 +467,12 @@ type CompilationGlobalsScope = module MultipleDiagnosticsLoggers = + /// Execute computations using Async.Parallel. + /// Captures the diagnostics in correct order and keeps a common error count for all computations. + /// When done, restores caller's build phase and diagnostics logger, commiting captured diagnostics. val Parallel: computations: Async<'T> seq -> Async<'T array> + /// Execute computations using Async.Sequential. + /// Captures the diagnostics in correct order and keeps a common error count for all computations. + /// When done, restores caller's build phase and diagnostics logger, commiting captured diagnostics. val Sequential: computations: Async<'T> seq -> Async<'T array> From 0e3f7269c68cf5039f0f33a9d1bcf4bff22ecdd0 Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Fri, 1 Mar 2024 09:42:34 +0100 Subject: [PATCH 27/51] add AsyncLocal test --- .../BuildGraphTests.fs | 104 +++++++++++++++++- 1 file changed, 103 insertions(+), 1 deletion(-) diff --git a/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs b/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs index 547b88b7d49..e6620139d19 100644 --- a/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs +++ b/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs @@ -3,13 +3,15 @@ namespace FSharp.Compiler.UnitTests open System open System.Threading +open System.Threading.Tasks open System.Runtime.CompilerServices open Xunit open FSharp.Test -open FSharp.Test.Compiler open FSharp.Compiler.BuildGraph open FSharp.Compiler.DiagnosticsLogger open Internal.Utilities.Library +open FSharp.Compiler.Diagnostics + module BuildGraphTests = @@ -287,3 +289,103 @@ module BuildGraphTests = |> Seq.map work |> Async.Parallel |> Async.RunSynchronously + + exception TestException + + type internal SimpleConcurrentLogger(name) = + inherit DiagnosticsLogger(name) + + let mutable errorCount = 0 + + override _.DiagnosticSink(d, s) = + if s = FSharpDiagnosticSeverity.Error then Interlocked.Increment(&errorCount) |> ignore + + override this.ErrorCount = errorCount + + [] + let ``AsyncLocal diagnostics context flows correctly`` () = + + let loggerShouldBe logger = + DiagnosticsThreadStatics.DiagnosticsLogger |> Assert.shouldBe logger + + let errorCountShouldBe ec = + DiagnosticsThreadStatics.DiagnosticsLogger.ErrorCount |> Assert.shouldBe ec + + let work logger = async { + use _ = UseDiagnosticsLogger logger + + errorR TestException + + loggerShouldBe logger + errorCountShouldBe 1 + + do! Async.SwitchToNewThread() + + errorR TestException + + loggerShouldBe logger + errorCountShouldBe 2 + + do! Async.SwitchToThreadPool() + + errorR TestException + + loggerShouldBe logger + errorCountShouldBe 3 + + let workInner = async { + do! async.Zero() + errorR TestException + loggerShouldBe logger + } + + let! child = workInner |> Async.StartChild + let! childTask = workInner |> Async.StartChildAsTask + + do! child + do! childTask |> Async.AwaitTask + errorCountShouldBe 5 + } + + let init n = + let name = $"AsyncLocal test {n}" + let logger = SimpleConcurrentLogger name + work logger + + Seq.init 10 init |> Async.Parallel |> Async.RunSynchronously |> ignore + + let logger = SimpleConcurrentLogger "main" + use _ = UseDiagnosticsLogger logger + + errorCountShouldBe 0 + + let btask = backgroundTask { + errorR TestException + do! Task.Yield() + errorR TestException + loggerShouldBe logger + } + + let task = task { + errorR TestException + do! Task.Yield() + errorR TestException + loggerShouldBe logger + } + + let thread = Thread(ThreadStart(fun () -> + errorR TestException + errorR TestException + loggerShouldBe logger)) + thread.Start() + thread.Join() + + btask.Wait() + task.Wait() + + Seq.init 11 (fun _ -> async { errorR TestException; loggerShouldBe logger } ) |> Async.Parallel |> Async.RunSynchronously |> ignore + + loggerShouldBe logger + errorCountShouldBe 17 + + From 779b11ba557589a9d7829652a121edac460fb4dc Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Fri, 1 Mar 2024 11:18:44 +0100 Subject: [PATCH 28/51] more testing --- .../BuildGraphTests.fs | 49 +++++++++++++++++-- 1 file changed, 46 insertions(+), 3 deletions(-) diff --git a/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs b/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs index e6620139d19..2129746b710 100644 --- a/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs +++ b/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs @@ -312,7 +312,7 @@ module BuildGraphTests = DiagnosticsThreadStatics.DiagnosticsLogger.ErrorCount |> Assert.shouldBe ec let work logger = async { - use _ = UseDiagnosticsLogger logger + SetThreadDiagnosticsLoggerNoUnwind logger errorR TestException @@ -366,6 +366,14 @@ module BuildGraphTests = loggerShouldBe logger } + let noErrorsTask = backgroundTask { + SetThreadDiagnosticsLoggerNoUnwind DiscardErrorsLogger + errorR TestException + do! Task.Yield() + errorR TestException + loggerShouldBe DiscardErrorsLogger + } + let task = task { errorR TestException do! Task.Yield() @@ -380,12 +388,47 @@ module BuildGraphTests = thread.Start() thread.Join() - btask.Wait() - task.Wait() + Task.WaitAll(noErrorsTask, btask, task) Seq.init 11 (fun _ -> async { errorR TestException; loggerShouldBe logger } ) |> Async.Parallel |> Async.RunSynchronously |> ignore loggerShouldBe logger errorCountShouldBe 17 + async { + // Async.Parallel flows back from the last that finished. + do! + [ async { SetThreadDiagnosticsLoggerNoUnwind DiscardErrorsLogger } ] + |> Async.Parallel + |> Async.Ignore + loggerShouldBe DiscardErrorsLogger + + do! async { + do! Async.SwitchToNewThread() + SetThreadDiagnosticsLoggerNoUnwind logger + } + + loggerShouldBe logger + } + |> Async.RunImmediate + + // This becomes fully synchronous: + async { + SetThreadDiagnosticsLoggerNoUnwind DiscardErrorsLogger } + |> Async.RunImmediate + loggerShouldBe DiscardErrorsLogger + + SetThreadDiagnosticsLoggerNoUnwind logger + // This creates new async context: + async { + do! Async.Sleep 0 + SetThreadDiagnosticsLoggerNoUnwind DiscardErrorsLogger } + |> Async.RunImmediate + loggerShouldBe logger + + + + + + From 69e49a70afeb5e6164252c69f641755a12b28597 Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Thu, 7 Mar 2024 00:11:12 +0100 Subject: [PATCH 29/51] not needed after all? --- src/Compiler/Facilities/BuildGraph.fs | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/src/Compiler/Facilities/BuildGraph.fs b/src/Compiler/Facilities/BuildGraph.fs index c57dc92938e..9ca3bae30a3 100644 --- a/src/Compiler/Facilities/BuildGraph.fs +++ b/src/Compiler/Facilities/BuildGraph.fs @@ -79,13 +79,10 @@ type GraphNode<'T> private (computation: Async<'T>, cachedResult: ValueOption<'T ) |> Async.AwaitTask - // Prevent deadlocks. - do! Async.SwitchToThreadPool() - match cachedResult with | ValueSome value -> return value | _ -> - let tcs = TaskCompletionSource<'T>() + let tcs = TaskCompletionSource<'T>(TaskCreationOptions.RunContinuationsAsynchronously) Async.StartWithContinuations( async { From bd6f5c147130206f30c3ac2e9ce3ceff93012c47 Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Thu, 7 Mar 2024 00:12:00 +0100 Subject: [PATCH 30/51] test --- .../BuildGraphTests.fs | 22 ++++++++++++++----- 1 file changed, 16 insertions(+), 6 deletions(-) diff --git a/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs b/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs index 2129746b710..10393404286 100644 --- a/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs +++ b/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs @@ -396,9 +396,11 @@ module BuildGraphTests = errorCountShouldBe 17 async { - // Async.Parallel flows back from the last that finished. + // Async.Parallel continues context from the last computation that finished. do! - [ async { SetThreadDiagnosticsLoggerNoUnwind DiscardErrorsLogger } ] + [ async { + do! Async.SwitchToNewThread() + SetThreadDiagnosticsLoggerNoUnwind DiscardErrorsLogger } ] |> Async.Parallel |> Async.Ignore loggerShouldBe DiscardErrorsLogger @@ -412,17 +414,25 @@ module BuildGraphTests = } |> Async.RunImmediate - // This becomes fully synchronous: + // Synchronus code will affect current context: + + // This is synchrouous, caller's context is affected async { - SetThreadDiagnosticsLoggerNoUnwind DiscardErrorsLogger } + SetThreadDiagnosticsLoggerNoUnwind DiscardErrorsLogger + do! Async.SwitchToNewThread() + loggerShouldBe DiscardErrorsLogger + } |> Async.RunImmediate loggerShouldBe DiscardErrorsLogger SetThreadDiagnosticsLoggerNoUnwind logger - // This creates new async context: + // This runs in async continuation, so the context is forked. async { do! Async.Sleep 0 - SetThreadDiagnosticsLoggerNoUnwind DiscardErrorsLogger } + SetThreadDiagnosticsLoggerNoUnwind DiscardErrorsLogger + do! Async.SwitchToNewThread() + loggerShouldBe DiscardErrorsLogger + } |> Async.RunImmediate loggerShouldBe logger From a650e0483c9c6644bc9831cec8eac78838976274 Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Thu, 7 Mar 2024 11:20:24 +0100 Subject: [PATCH 31/51] format --- src/Compiler/Facilities/BuildGraph.fs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Compiler/Facilities/BuildGraph.fs b/src/Compiler/Facilities/BuildGraph.fs index 9ca3bae30a3..62fac1d5bc8 100644 --- a/src/Compiler/Facilities/BuildGraph.fs +++ b/src/Compiler/Facilities/BuildGraph.fs @@ -82,7 +82,8 @@ type GraphNode<'T> private (computation: Async<'T>, cachedResult: ValueOption<'T match cachedResult with | ValueSome value -> return value | _ -> - let tcs = TaskCompletionSource<'T>(TaskCreationOptions.RunContinuationsAsynchronously) + let tcs = + TaskCompletionSource<'T>(TaskCreationOptions.RunContinuationsAsynchronously) Async.StartWithContinuations( async { From 6eba6887621718502c38eda40b65983715fa5278 Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Thu, 7 Mar 2024 12:54:11 +0100 Subject: [PATCH 32/51] revert --- src/Compiler/Facilities/BuildGraph.fs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/Compiler/Facilities/BuildGraph.fs b/src/Compiler/Facilities/BuildGraph.fs index 62fac1d5bc8..c57dc92938e 100644 --- a/src/Compiler/Facilities/BuildGraph.fs +++ b/src/Compiler/Facilities/BuildGraph.fs @@ -79,11 +79,13 @@ type GraphNode<'T> private (computation: Async<'T>, cachedResult: ValueOption<'T ) |> Async.AwaitTask + // Prevent deadlocks. + do! Async.SwitchToThreadPool() + match cachedResult with | ValueSome value -> return value | _ -> - let tcs = - TaskCompletionSource<'T>(TaskCreationOptions.RunContinuationsAsynchronously) + let tcs = TaskCompletionSource<'T>() Async.StartWithContinuations( async { From fb915452ae3772b13e9c8942a9275ed0ecc42dc6 Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Fri, 8 Mar 2024 16:26:25 +0100 Subject: [PATCH 33/51] try RunContinuationsAsynchronously --- src/Compiler/Driver/GraphChecking/GraphProcessing.fs | 3 ++- src/Compiler/Facilities/AsyncMemoize.fs | 8 +++++++- src/Compiler/Facilities/BuildGraph.fs | 6 ++---- src/Compiler/Facilities/DiagnosticsLogger.fs | 3 ++- src/Compiler/Utilities/illib.fs | 5 ++++- tests/FSharp.Test.Utilities/Utilities.fs | 2 +- tests/service/Common.fs | 2 +- 7 files changed, 19 insertions(+), 10 deletions(-) diff --git a/src/Compiler/Driver/GraphChecking/GraphProcessing.fs b/src/Compiler/Driver/GraphChecking/GraphProcessing.fs index 37ecc35041d..4b316dca185 100644 --- a/src/Compiler/Driver/GraphChecking/GraphProcessing.fs +++ b/src/Compiler/Driver/GraphChecking/GraphProcessing.fs @@ -180,7 +180,8 @@ let processGraphAsync<'Item, 'Result when 'Item: equality and 'Item: comparison> let! parentCt = Async.CancellationToken use localCts = new CancellationTokenSource() - let completionSignal = TaskCompletionSource() + let completionSignal = + TaskCompletionSource(TaskCreationOptions.RunContinuationsAsynchronously) use _ = parentCt.Register(fun () -> completionSignal.TrySetCanceled() |> ignore) diff --git a/src/Compiler/Facilities/AsyncMemoize.fs b/src/Compiler/Facilities/AsyncMemoize.fs index 5554af166da..6de999c8908 100644 --- a/src/Compiler/Facilities/AsyncMemoize.fs +++ b/src/Compiler/Facilities/AsyncMemoize.fs @@ -285,7 +285,13 @@ type internal AsyncMemoize<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'T key.Key, key.Version, key.Label, - (Running(TaskCompletionSource(), cts, computation, DateTime.Now, ResizeArray())) + (Running( + TaskCompletionSource(TaskCreationOptions.RunContinuationsAsynchronously), + cts, + computation, + DateTime.Now, + ResizeArray() + )) ) otherVersions diff --git a/src/Compiler/Facilities/BuildGraph.fs b/src/Compiler/Facilities/BuildGraph.fs index c57dc92938e..62fac1d5bc8 100644 --- a/src/Compiler/Facilities/BuildGraph.fs +++ b/src/Compiler/Facilities/BuildGraph.fs @@ -79,13 +79,11 @@ type GraphNode<'T> private (computation: Async<'T>, cachedResult: ValueOption<'T ) |> Async.AwaitTask - // Prevent deadlocks. - do! Async.SwitchToThreadPool() - match cachedResult with | ValueSome value -> return value | _ -> - let tcs = TaskCompletionSource<'T>() + let tcs = + TaskCompletionSource<'T>(TaskCreationOptions.RunContinuationsAsynchronously) Async.StartWithContinuations( async { diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fs b/src/Compiler/Facilities/DiagnosticsLogger.fs index 748e6cca4ec..57cf75a7b49 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -881,7 +881,8 @@ type CaptureDiagnosticsConcurrently<'T>(computations: Async<'T> seq, ?eagerForma let computationsWithLoggers, diagnosticsReady = [ for i, computation in computations |> Seq.indexed do - let diagnosticsReady = TaskCompletionSource<_>() + let diagnosticsReady = + TaskCompletionSource<_>(TaskCreationOptions.RunContinuationsAsynchronously) // Diagnostics logger utilizing the common error count. let logger = diff --git a/src/Compiler/Utilities/illib.fs b/src/Compiler/Utilities/illib.fs index f33d77bc2d6..ca2bcb96717 100644 --- a/src/Compiler/Utilities/illib.fs +++ b/src/Compiler/Utilities/illib.fs @@ -160,7 +160,10 @@ module internal PervasiveAutoOpens = static member RunImmediate(computation: Async<'T>, ?cancellationToken) = let cancellationToken = defaultArg cancellationToken Async.DefaultCancellationToken - let ts = TaskCompletionSource<'T>() + + let ts = + TaskCompletionSource<'T>(TaskCreationOptions.RunContinuationsAsynchronously) + let task = ts.Task Async.StartWithContinuations(computation, (ts.SetResult), (ts.SetException), (fun _ -> ts.SetCanceled()), cancellationToken) diff --git a/tests/FSharp.Test.Utilities/Utilities.fs b/tests/FSharp.Test.Utilities/Utilities.fs index 897837c6bce..5124a6c1947 100644 --- a/tests/FSharp.Test.Utilities/Utilities.fs +++ b/tests/FSharp.Test.Utilities/Utilities.fs @@ -122,7 +122,7 @@ module Utilities = type Async with static member RunImmediate (computation: Async<'T>, ?cancellationToken ) = let cancellationToken = defaultArg cancellationToken Async.DefaultCancellationToken - let ts = TaskCompletionSource<'T>() + let ts = TaskCompletionSource<'T>(TaskCreationOptions.RunContinuationsAsynchronously) let task = ts.Task Async.StartWithContinuations( computation, diff --git a/tests/service/Common.fs b/tests/service/Common.fs index 8516948626a..642fb65454e 100644 --- a/tests/service/Common.fs +++ b/tests/service/Common.fs @@ -20,7 +20,7 @@ open FSharp.Test.Utilities type Async with static member RunImmediate (computation: Async<'T>, ?cancellationToken ) = let cancellationToken = defaultArg cancellationToken Async.DefaultCancellationToken - let ts = TaskCompletionSource<'T>() + let ts = TaskCompletionSource<'T>(TaskCreationOptions.RunContinuationsAsynchronously) let task = ts.Task Async.StartWithContinuations( computation, From 00821e3b15eec1e952a20d25b0a03bb126d8384b Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Sun, 10 Mar 2024 11:08:09 +0100 Subject: [PATCH 34/51] try to deal with deadlock another way --- src/Compiler/Driver/CompilerImports.fs | 4 ++-- src/Compiler/Driver/fsc.fs | 4 ++-- src/Compiler/Interactive/fsi.fs | 5 ++--- src/Compiler/Utilities/illib.fs | 3 --- src/Compiler/Utilities/illib.fsi | 3 --- tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs | 4 ++-- 6 files changed, 8 insertions(+), 15 deletions(-) diff --git a/src/Compiler/Driver/CompilerImports.fs b/src/Compiler/Driver/CompilerImports.fs index 1eb383405c3..5e29aeb07df 100644 --- a/src/Compiler/Driver/CompilerImports.fs +++ b/src/Compiler/Driver/CompilerImports.fs @@ -2287,7 +2287,7 @@ and [] TcImports ReportWarnings warns tcImports.RegisterAndImportReferencedAssemblies(ctok, res) - |> Async.RunImmediateWithoutCancellation + |> Async.RunImmediate |> ignore true @@ -2609,7 +2609,7 @@ let RequireReferences (ctok, tcImports: TcImports, tcEnv, thisAssemblyName, reso let ccuinfos = tcImports.RegisterAndImportReferencedAssemblies(ctok, resolutions) - |> Async.RunImmediateWithoutCancellation + |> Async.RunImmediate let asms = ccuinfos diff --git a/src/Compiler/Driver/fsc.fs b/src/Compiler/Driver/fsc.fs index 708d79fed42..f745638d5ec 100644 --- a/src/Compiler/Driver/fsc.fs +++ b/src/Compiler/Driver/fsc.fs @@ -614,7 +614,7 @@ let main1 // Import basic assemblies let tcGlobals, frameworkTcImports = TcImports.BuildFrameworkTcImports(foundationalTcConfigP, sysRes, otherRes) - |> Async.RunImmediateWithoutCancellation + |> Async.RunImmediate let ilSourceDocs = [ @@ -663,7 +663,7 @@ let main1 let tcImports = TcImports.BuildNonFrameworkTcImports(tcConfigP, frameworkTcImports, otherRes, knownUnresolved, dependencyProvider) - |> Async.RunImmediateWithoutCancellation + |> Async.RunImmediate // register tcImports to be disposed in future disposables.Register tcImports diff --git a/src/Compiler/Interactive/fsi.fs b/src/Compiler/Interactive/fsi.fs index d286e7f2431..3959d6721ec 100644 --- a/src/Compiler/Interactive/fsi.fs +++ b/src/Compiler/Interactive/fsi.fs @@ -4596,8 +4596,7 @@ type FsiEvaluationSession try let tcConfig = tcConfigP.Get(ctokStartup) - checker.FrameworkImportsCache.Get tcConfig - |> Async.RunImmediateWithoutCancellation + checker.FrameworkImportsCache.Get tcConfig |> Async.RunImmediate with e -> stopProcessingRecovery e range0 failwithf "Error creating evaluation session: %A" e @@ -4611,7 +4610,7 @@ type FsiEvaluationSession unresolvedReferences, fsiOptions.DependencyProvider ) - |> Async.RunImmediateWithoutCancellation + |> Async.RunSynchronously with e -> stopProcessingRecovery e range0 failwithf "Error creating evaluation session: %A" e diff --git a/src/Compiler/Utilities/illib.fs b/src/Compiler/Utilities/illib.fs index ca2bcb96717..28bb8ed443f 100644 --- a/src/Compiler/Utilities/illib.fs +++ b/src/Compiler/Utilities/illib.fs @@ -173,9 +173,6 @@ module internal PervasiveAutoOpens = with :? AggregateException as ex when ex.InnerExceptions.Count = 1 -> raise (ex.InnerExceptions[0]) - static member RunImmediateWithoutCancellation(computation: Async<'T>) = - Async.RunImmediate(computation, CancellationToken.None) - [] type DelayInitArrayMap<'T, 'TDictKey, 'TDictValue>(f: unit -> 'T[]) = let syncObj = obj () diff --git a/src/Compiler/Utilities/illib.fsi b/src/Compiler/Utilities/illib.fsi index d9ee787c2fb..a9ee48c4be9 100644 --- a/src/Compiler/Utilities/illib.fsi +++ b/src/Compiler/Utilities/illib.fsi @@ -90,9 +90,6 @@ module internal PervasiveAutoOpens = /// Runs the computation synchronously, always starting on the current thread. static member RunImmediate: computation: Async<'T> * ?cancellationToken: CancellationToken -> 'T - /// Runs the computation synchronously, always starting on the current thread, using CancellationToken.None. - static member RunImmediateWithoutCancellation: computation: Async<'T> -> 'T - val foldOn: p: ('a -> 'b) -> f: ('c -> 'b -> 'd) -> z: 'c -> x: 'a -> 'd val notFound: unit -> 'a diff --git a/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs b/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs index 10393404286..b492251d198 100644 --- a/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs +++ b/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs @@ -103,7 +103,7 @@ module BuildGraphTests = Assert.shouldBeTrue weak.IsAlive - Async.RunImmediateWithoutCancellation(graphNode.GetOrComputeValue()) + Async.RunImmediate(graphNode.GetOrComputeValue()) |> ignore GC.Collect(2, GCCollectionMode.Forced, true) @@ -219,7 +219,7 @@ module BuildGraphTests = cts.Cancel() resetEvent.Set() |> ignore - Async.RunImmediateWithoutCancellation(work) + Async.RunImmediate(work) |> ignore Assert.shouldBeTrue cts.IsCancellationRequested From 75e4457d2c9d9ab2fc5c38a952a5596ecf24308e Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Mon, 11 Mar 2024 16:36:08 +0100 Subject: [PATCH 35/51] nope --- src/Compiler/Facilities/BuildGraph.fs | 8 ++++++-- src/Compiler/Utilities/illib.fs | 2 +- tests/FSharp.Test.Utilities/Utilities.fs | 2 +- tests/service/Common.fs | 2 +- 4 files changed, 9 insertions(+), 5 deletions(-) diff --git a/src/Compiler/Facilities/BuildGraph.fs b/src/Compiler/Facilities/BuildGraph.fs index 62fac1d5bc8..e6cac70ed0a 100644 --- a/src/Compiler/Facilities/BuildGraph.fs +++ b/src/Compiler/Facilities/BuildGraph.fs @@ -83,7 +83,7 @@ type GraphNode<'T> private (computation: Async<'T>, cachedResult: ValueOption<'T | ValueSome value -> return value | _ -> let tcs = - TaskCompletionSource<'T>(TaskCreationOptions.RunContinuationsAsynchronously) + TaskCompletionSource<'T>() Async.StartWithContinuations( async { @@ -100,13 +100,17 @@ type GraphNode<'T> private (computation: Async<'T>, cachedResult: ValueOption<'T ct ) - return! tcs.Task |> Async.AwaitTask |> Async.FlattenException + let! result = tcs.Task |> Async.AwaitTask + do! Async.SwitchToThreadPool() + + return result finally if taken then semaphore.Release() |> ignore finally Interlocked.Decrement(&requestCount) |> ignore } + |> Async.FlattenException member _.TryPeekValue() = cachedResult diff --git a/src/Compiler/Utilities/illib.fs b/src/Compiler/Utilities/illib.fs index 28bb8ed443f..6127c715222 100644 --- a/src/Compiler/Utilities/illib.fs +++ b/src/Compiler/Utilities/illib.fs @@ -162,7 +162,7 @@ module internal PervasiveAutoOpens = let cancellationToken = defaultArg cancellationToken Async.DefaultCancellationToken let ts = - TaskCompletionSource<'T>(TaskCreationOptions.RunContinuationsAsynchronously) + TaskCompletionSource<'T>() let task = ts.Task diff --git a/tests/FSharp.Test.Utilities/Utilities.fs b/tests/FSharp.Test.Utilities/Utilities.fs index 5124a6c1947..897837c6bce 100644 --- a/tests/FSharp.Test.Utilities/Utilities.fs +++ b/tests/FSharp.Test.Utilities/Utilities.fs @@ -122,7 +122,7 @@ module Utilities = type Async with static member RunImmediate (computation: Async<'T>, ?cancellationToken ) = let cancellationToken = defaultArg cancellationToken Async.DefaultCancellationToken - let ts = TaskCompletionSource<'T>(TaskCreationOptions.RunContinuationsAsynchronously) + let ts = TaskCompletionSource<'T>() let task = ts.Task Async.StartWithContinuations( computation, diff --git a/tests/service/Common.fs b/tests/service/Common.fs index 642fb65454e..8516948626a 100644 --- a/tests/service/Common.fs +++ b/tests/service/Common.fs @@ -20,7 +20,7 @@ open FSharp.Test.Utilities type Async with static member RunImmediate (computation: Async<'T>, ?cancellationToken ) = let cancellationToken = defaultArg cancellationToken Async.DefaultCancellationToken - let ts = TaskCompletionSource<'T>(TaskCreationOptions.RunContinuationsAsynchronously) + let ts = TaskCompletionSource<'T>() let task = ts.Task Async.StartWithContinuations( computation, From 6bd5a08d6460c708d7a509324a5f967e4e6587e4 Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Mon, 11 Mar 2024 19:52:27 +0100 Subject: [PATCH 36/51] revert --- src/Compiler/Facilities/BuildGraph.fs | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/src/Compiler/Facilities/BuildGraph.fs b/src/Compiler/Facilities/BuildGraph.fs index e6cac70ed0a..e9fada96857 100644 --- a/src/Compiler/Facilities/BuildGraph.fs +++ b/src/Compiler/Facilities/BuildGraph.fs @@ -79,11 +79,13 @@ type GraphNode<'T> private (computation: Async<'T>, cachedResult: ValueOption<'T ) |> Async.AwaitTask + // Prevent deadlocks. + do! Async.SwitchToThreadPool() + match cachedResult with | ValueSome value -> return value | _ -> - let tcs = - TaskCompletionSource<'T>() + let tcs = TaskCompletionSource<'T>() Async.StartWithContinuations( async { @@ -100,10 +102,7 @@ type GraphNode<'T> private (computation: Async<'T>, cachedResult: ValueOption<'T ct ) - let! result = tcs.Task |> Async.AwaitTask - do! Async.SwitchToThreadPool() - - return result + return! tcs.Task |> Async.AwaitTask finally if taken then semaphore.Release() |> ignore From 778385046390798717c94aa162f6a6376acc6d8b Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Tue, 12 Mar 2024 10:55:18 +0100 Subject: [PATCH 37/51] format --- src/Compiler/Utilities/illib.fs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/Compiler/Utilities/illib.fs b/src/Compiler/Utilities/illib.fs index 6127c715222..36b4c206cfb 100644 --- a/src/Compiler/Utilities/illib.fs +++ b/src/Compiler/Utilities/illib.fs @@ -161,8 +161,7 @@ module internal PervasiveAutoOpens = static member RunImmediate(computation: Async<'T>, ?cancellationToken) = let cancellationToken = defaultArg cancellationToken Async.DefaultCancellationToken - let ts = - TaskCompletionSource<'T>() + let ts = TaskCompletionSource<'T>() let task = ts.Task From 862870b78412c1ff4f75db211c32829fad0451f9 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Mon, 29 Apr 2024 20:16:59 +0200 Subject: [PATCH 38/51] restore release notes --- docs/release-notes/.FSharp.Compiler.Service/8.0.400.md | 1 + docs/release-notes/.VisualStudio/17.10.md | 1 - docs/release-notes/.VisualStudio/17.11.md | 4 ++++ 3 files changed, 5 insertions(+), 1 deletion(-) diff --git a/docs/release-notes/.FSharp.Compiler.Service/8.0.400.md b/docs/release-notes/.FSharp.Compiler.Service/8.0.400.md index 674a2ec7d47..b1653d16ef7 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/8.0.400.md +++ b/docs/release-notes/.FSharp.Compiler.Service/8.0.400.md @@ -13,3 +13,4 @@ ### Added * Generate new `Equals` overload to avoid boxing for structural comparison ([PR #16857](https://github.com/dotnet/fsharp/pull/16857)) +* AsyncLocal diagnostics context. ([PR #16779](https://github.com/dotnet/fsharp/pull/16779)) \ No newline at end of file diff --git a/docs/release-notes/.VisualStudio/17.10.md b/docs/release-notes/.VisualStudio/17.10.md index bd6d25c3d0b..45bcbf80406 100644 --- a/docs/release-notes/.VisualStudio/17.10.md +++ b/docs/release-notes/.VisualStudio/17.10.md @@ -6,4 +6,3 @@ ### Changed * Use refactored parenthesization API in unnecessary parentheses code fix. ([PR #16461])(https://github.com/dotnet/fsharp/pull/16461)) -* Use AsyncLocal diagnostics context. ([PR #16779])(https://github.com/dotnet/fsharp/pull/16779)) diff --git a/docs/release-notes/.VisualStudio/17.11.md b/docs/release-notes/.VisualStudio/17.11.md index faf48e2e377..d02f192462e 100644 --- a/docs/release-notes/.VisualStudio/17.11.md +++ b/docs/release-notes/.VisualStudio/17.11.md @@ -1,3 +1,7 @@ ### Fixed * Make tooltips work in file with no solution. ([PR #17054](https://github.com/dotnet/fsharp/pull/17054)) + +### Changed + +* Use AsyncLocal diagnostics context. ([PR #16779])(https://github.com/dotnet/fsharp/pull/16779)) From 1f2c7f3dd3af5c130bb3e5cfb83a61785bb29982 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Tue, 30 Apr 2024 15:35:29 +0200 Subject: [PATCH 39/51] add test for ListParallel --- .../BuildGraphTests.fs | 57 ++++++++++++++++--- 1 file changed, 50 insertions(+), 7 deletions(-) diff --git a/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs b/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs index b492251d198..da3b109bc0a 100644 --- a/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs +++ b/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs @@ -12,7 +12,6 @@ open FSharp.Compiler.DiagnosticsLogger open Internal.Utilities.Library open FSharp.Compiler.Diagnostics - module BuildGraphTests = [] @@ -302,14 +301,45 @@ module BuildGraphTests = override this.ErrorCount = errorCount + let loggerShouldBe logger = + DiagnosticsThreadStatics.DiagnosticsLogger |> Assert.shouldBe logger + + let errorCountShouldBe ec = + DiagnosticsThreadStatics.DiagnosticsLogger.ErrorCount |> Assert.shouldBe ec + [] - let ``AsyncLocal diagnostics context flows correctly`` () = + let ``AsyncLocal diagnostics context works with TPL`` () = + + let task1 () = + List.init 100 (sprintf "ListParallel logger %d") + |> Extras.ListParallel.map (fun name -> + let logger = CapturingDiagnosticsLogger(name) + use _ = UseDiagnosticsLogger logger + for _ in 1 .. 10 do + errorR TestException + Thread.Sleep 5 + errorCountShouldBe 10 + loggerShouldBe logger ) + |> ignore + + let task2 () = + let commonLogger = SimpleConcurrentLogger "ListParallel concurrent logger" + use _ = UseDiagnosticsLogger commonLogger + + [1 .. 100] + |> Extras.ListParallel.map (fun _ -> + for _ in 1 .. 10 do + errorR TestException + Thread.Sleep 5 + loggerShouldBe commonLogger ) + |> ignore + errorCountShouldBe 1000 + loggerShouldBe commonLogger - let loggerShouldBe logger = - DiagnosticsThreadStatics.DiagnosticsLogger |> Assert.shouldBe logger + Tasks.Parallel.Invoke(task1, task2) - let errorCountShouldBe ec = - DiagnosticsThreadStatics.DiagnosticsLogger.ErrorCount |> Assert.shouldBe ec + [] + let ``AsyncLocal diagnostics context flows correctly`` () = let work logger = async { SetThreadDiagnosticsLoggerNoUnwind logger @@ -381,10 +411,23 @@ module BuildGraphTests = loggerShouldBe logger } + // A thread with inner logger. + let thread = Thread(ThreadStart(fun () -> + use _ = UseDiagnosticsLogger (CapturingDiagnosticsLogger("Thread logger")) + errorR TestException + errorR TestException + errorCountShouldBe 2 + )) + thread.Start() + thread.Join() + + loggerShouldBe logger + + // Ambient logger flows into this thread. let thread = Thread(ThreadStart(fun () -> errorR TestException errorR TestException - loggerShouldBe logger)) + )) thread.Start() thread.Join() From e05cfe56a754423dad14847d03d7dcde24080f13 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Sat, 4 May 2024 09:07:05 +0200 Subject: [PATCH 40/51] speed up test --- tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs b/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs index da3b109bc0a..7666f5c92a1 100644 --- a/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs +++ b/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs @@ -311,7 +311,7 @@ module BuildGraphTests = let ``AsyncLocal diagnostics context works with TPL`` () = let task1 () = - List.init 100 (sprintf "ListParallel logger %d") + List.init 20 (sprintf "ListParallel logger %d") |> Extras.ListParallel.map (fun name -> let logger = CapturingDiagnosticsLogger(name) use _ = UseDiagnosticsLogger logger @@ -326,14 +326,14 @@ module BuildGraphTests = let commonLogger = SimpleConcurrentLogger "ListParallel concurrent logger" use _ = UseDiagnosticsLogger commonLogger - [1 .. 100] + [1 .. 20] |> Extras.ListParallel.map (fun _ -> for _ in 1 .. 10 do errorR TestException Thread.Sleep 5 loggerShouldBe commonLogger ) |> ignore - errorCountShouldBe 1000 + errorCountShouldBe 200 loggerShouldBe commonLogger Tasks.Parallel.Invoke(task1, task2) From b9b01eb3aaf85e270458b755bb24e263746e4f1c Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Sun, 5 May 2024 12:36:45 +0200 Subject: [PATCH 41/51] improve test --- .../FSharp.Compiler.UnitTests/BuildGraphTests.fs | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs b/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs index 7666f5c92a1..a53c0a611c1 100644 --- a/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs +++ b/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs @@ -439,20 +439,23 @@ module BuildGraphTests = errorCountShouldBe 17 async { - // Async.Parallel continues context from the last computation that finished. + + // After Async.Parallel the continuation runs in the context of the last computation that finished. do! [ async { - do! Async.SwitchToNewThread() SetThreadDiagnosticsLoggerNoUnwind DiscardErrorsLogger } ] |> Async.Parallel |> Async.Ignore loggerShouldBe DiscardErrorsLogger - do! async { - do! Async.SwitchToNewThread() - SetThreadDiagnosticsLoggerNoUnwind logger - } + SetThreadDiagnosticsLoggerNoUnwind logger + // On the other hand, MultipleDiagnosticsLoggers.Parallel restores caller's context. + do! + [ async { + SetThreadDiagnosticsLoggerNoUnwind DiscardErrorsLogger } ] + |> MultipleDiagnosticsLoggers.Parallel + |> Async.Ignore loggerShouldBe logger } |> Async.RunImmediate From 87ccfa358fe25ff9e8c7879799edd9df1464559c Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Tue, 7 May 2024 00:29:34 +0200 Subject: [PATCH 42/51] simpler MultipleDiagnosticsLoggers --- src/Compiler/Facilities/DiagnosticsLogger.fs | 106 ++++++++----------- 1 file changed, 47 insertions(+), 59 deletions(-) diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fs b/src/Compiler/Facilities/DiagnosticsLogger.fs index d7172a93033..497506e5e87 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -894,71 +894,59 @@ type StackGuard(maxDepth: int, name: string) = static member GetDepthOption(name: string) = GetEnvInteger ("FSHARP_" + name + "StackGuardDepth") StackGuard.DefaultDepth -type CaptureDiagnosticsConcurrently<'T>(computations: Async<'T> seq, ?eagerFormat) = - // Common error count for all computations. - let mutable errorCount = 0 - - let computationsWithLoggers, diagnosticsReady = - [ - for i, computation in computations |> Seq.indexed do - let diagnosticsReady = - TaskCompletionSource<_>(TaskCreationOptions.RunContinuationsAsynchronously) - - // Diagnostics logger utilizing the common error count. - let logger = - { new CapturingDiagnosticsLogger($"CaptureDiagnosticsConcurrently {i}", ?eagerFormat = eagerFormat) with - override _.DiagnosticSink(d, severity) = - base.DiagnosticSink(d, severity) - - if severity = FSharpDiagnosticSeverity.Error then - Interlocked.Increment &errorCount |> ignore - - override _.ErrorCount = errorCount - } - - // Inject capturing loger into the computation. Signal the TaskCompletionSource when done. - let computationsWithLoggers = - async { - SetThreadDiagnosticsLoggerNoUnwind logger - - try - return! computation - finally - diagnosticsReady.SetResult logger - } - - computationsWithLoggers, diagnosticsReady - ] - |> List.unzip - - // Commit diagnostics from computations as soon as it is possible, preserving the order. - let replayDiagnostics = - backgroundTask { - let target = DiagnosticsThreadStatics.DiagnosticsLogger - - for tcs in diagnosticsReady do - let! finishedLogger = tcs.Task - finishedLogger.CommitDelayedDiagnostics target - - return target - } - - member val Computations = computationsWithLoggers |> Seq.ofList - member val ReplayDiagnostics = replayDiagnostics - module MultipleDiagnosticsLoggers = - // Capture diagnostics from multiple computations. - let run method computations = - let forks = CaptureDiagnosticsConcurrently(computations) + let Parallel computations = + let computationsWithLoggers, diagnosticsReady = + [ + for i, computation in computations |> Seq.indexed do + let diagnosticsReady = + TaskCompletionSource<_>(TaskCreationOptions.RunContinuationsAsynchronously) + + let logger = CapturingDiagnosticsLogger($"CaptureDiagnosticsConcurrently {i}") + + // Inject capturing loger into the computation. Signal the TaskCompletionSource when done. + let computationsWithLoggers = + async { + SetThreadDiagnosticsLoggerNoUnwind logger + + try + return! computation + finally + diagnosticsReady.SetResult logger + } + + computationsWithLoggers, diagnosticsReady + ] + |> List.unzip + + // Commit diagnostics from computations as soon as it is possible, preserving the order. + let replayDiagnostics = + backgroundTask { + let target = DiagnosticsThreadStatics.DiagnosticsLogger + + for tcs in diagnosticsReady do + let! finishedLogger = tcs.Task + finishedLogger.CommitDelayedDiagnostics target + + return target + } async { try // We want to restore the current diagnostics context when finished. use _ = new CompilationGlobalsScope() - return! forks.Computations |> method + return! Async.Parallel computationsWithLoggers finally - forks.ReplayDiagnostics.Wait() + replayDiagnostics.Wait() } - let Parallel computations = computations |> run Async.Parallel - let Sequential computations = computations |> run Async.Sequential + let Sequential computations = + async { + let results = ResizeArray() + + for computation in computations do + let! result = computation + results.Add result + + return results.ToArray() + } From f4cf7e64f665bbb2ff0587d484d27af3aaabca97 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Tue, 7 May 2024 00:29:53 +0200 Subject: [PATCH 43/51] rename and speedup test --- tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs b/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs index a53c0a611c1..093f132efe8 100644 --- a/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs +++ b/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs @@ -239,13 +239,13 @@ module BuildGraphTests = type ExampleException(msg) = inherit System.Exception(msg) [] - let internal ``NodeCode preserves DiagnosticsThreadStatics`` () = + let internal ``DiagnosticsThreadStatics preserved in async`` () = let random = let rng = Random() fun n -> rng.Next n let job phase i = async { - do! random 10 |> Async.Sleep + do! random 5 |> Async.Sleep Assert.Equal(phase, DiagnosticsThreadStatics.BuildPhase) DiagnosticsThreadStatics.DiagnosticsLogger.DebugDisplay() |> Assert.shouldBe $"DiagnosticsLogger(CaptureDiagnosticsConcurrently {i})" @@ -262,7 +262,7 @@ module BuildGraphTests = let diags = logger.Diagnostics |> List.map fst - diags |> List.map _.Phase |> Set |> Assert.shouldBe (Set.singleton phase) + diags |> List.map _.Phase |> List.distinct |> Assert.shouldBe [ phase ] diags |> List.map _.Exception.Message |> Assert.shouldBe (List.init n <| sprintf "job %d") @@ -284,7 +284,7 @@ module BuildGraphTests = |] let pickRandomPhase _ = phases[random phases.Length] - Seq.init 100 pickRandomPhase + Seq.init 20 pickRandomPhase |> Seq.map work |> Async.Parallel |> Async.RunSynchronously From f94c3daecabb5e20e3cb5f9d8537c5071db45312 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Tue, 7 May 2024 15:42:09 +0200 Subject: [PATCH 44/51] parallel logging perf --- src/Compiler/Facilities/DiagnosticsLogger.fs | 7 ++----- tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs | 4 ++-- 2 files changed, 4 insertions(+), 7 deletions(-) diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fs b/src/Compiler/Facilities/DiagnosticsLogger.fs index 497506e5e87..b26c9a8598d 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -899,12 +899,11 @@ module MultipleDiagnosticsLoggers = let computationsWithLoggers, diagnosticsReady = [ for i, computation in computations |> Seq.indexed do - let diagnosticsReady = - TaskCompletionSource<_>(TaskCreationOptions.RunContinuationsAsynchronously) + let diagnosticsReady = TaskCompletionSource<_>() let logger = CapturingDiagnosticsLogger($"CaptureDiagnosticsConcurrently {i}") - // Inject capturing loger into the computation. Signal the TaskCompletionSource when done. + // Inject capturing logger into the computation. Signal the TaskCompletionSource when done. let computationsWithLoggers = async { SetThreadDiagnosticsLoggerNoUnwind logger @@ -927,8 +926,6 @@ module MultipleDiagnosticsLoggers = for tcs in diagnosticsReady do let! finishedLogger = tcs.Task finishedLogger.CommitDelayedDiagnostics target - - return target } async { diff --git a/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs b/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs index 093f132efe8..7276ddce4ab 100644 --- a/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs +++ b/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs @@ -245,7 +245,7 @@ module BuildGraphTests = fun n -> rng.Next n let job phase i = async { - do! random 5 |> Async.Sleep + do! random 10 |> Async.Sleep Assert.Equal(phase, DiagnosticsThreadStatics.BuildPhase) DiagnosticsThreadStatics.DiagnosticsLogger.DebugDisplay() |> Assert.shouldBe $"DiagnosticsLogger(CaptureDiagnosticsConcurrently {i})" @@ -284,7 +284,7 @@ module BuildGraphTests = |] let pickRandomPhase _ = phases[random phases.Length] - Seq.init 20 pickRandomPhase + Seq.init 100 pickRandomPhase |> Seq.map work |> Async.Parallel |> Async.RunSynchronously From 27dd98971c379cbc2f4b728ca33889bb40dc184e Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Wed, 8 May 2024 21:59:23 +0200 Subject: [PATCH 45/51] remove SwitchToThreadPool --- src/Compiler/Driver/CompilerImports.fs | 2 -- src/Compiler/Facilities/BuildGraph.fs | 3 --- src/Compiler/Interactive/fsi.fs | 2 +- 3 files changed, 1 insertion(+), 6 deletions(-) diff --git a/src/Compiler/Driver/CompilerImports.fs b/src/Compiler/Driver/CompilerImports.fs index 12b623c95e7..76573599919 100644 --- a/src/Compiler/Driver/CompilerImports.fs +++ b/src/Compiler/Driver/CompilerImports.fs @@ -2232,8 +2232,6 @@ and [] TcImports async { CheckDisposed() - // Prevent deadlocks in FSI. - do! Async.SwitchToThreadPool() let tcConfig = tcConfigP.Get ctok diff --git a/src/Compiler/Facilities/BuildGraph.fs b/src/Compiler/Facilities/BuildGraph.fs index 414c49e8b32..e928498c657 100644 --- a/src/Compiler/Facilities/BuildGraph.fs +++ b/src/Compiler/Facilities/BuildGraph.fs @@ -75,9 +75,6 @@ type GraphNode<'T> private (computation: Async<'T>, cachedResult: ValueOption<'T ) |> Async.AwaitTask - // Prevent deadlocks. - do! Async.SwitchToThreadPool() - match cachedResult with | ValueSome value -> return value | _ -> diff --git a/src/Compiler/Interactive/fsi.fs b/src/Compiler/Interactive/fsi.fs index 35cdb9e6f76..d932b95eda1 100644 --- a/src/Compiler/Interactive/fsi.fs +++ b/src/Compiler/Interactive/fsi.fs @@ -4617,7 +4617,7 @@ type FsiEvaluationSession unresolvedReferences, fsiOptions.DependencyProvider ) - |> Async.RunSynchronously + |> Async.RunImmediate with e -> stopProcessingRecovery e range0 failwithf "Error creating evaluation session: %A" e From 8c77c0cad9fe340fb3ed71c7ab79fb541622965c Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Thu, 9 May 2024 08:39:14 +0200 Subject: [PATCH 46/51] sequential --- src/Compiler/Facilities/DiagnosticsLogger.fs | 3 +++ src/Compiler/Facilities/DiagnosticsLogger.fsi | 13 +++++++------ 2 files changed, 10 insertions(+), 6 deletions(-) diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fs b/src/Compiler/Facilities/DiagnosticsLogger.fs index b26c9a8598d..921f836f5ea 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -895,6 +895,7 @@ type StackGuard(maxDepth: int, name: string) = GetEnvInteger ("FSHARP_" + name + "StackGuardDepth") StackGuard.DefaultDepth module MultipleDiagnosticsLoggers = + let Parallel computations = let computationsWithLoggers, diagnosticsReady = [ @@ -942,6 +943,8 @@ module MultipleDiagnosticsLoggers = let results = ResizeArray() for computation in computations do + // Encapsulate computation's diagnostics scope. + use _ = new CompilationGlobalsScope() let! result = computation results.Add result diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fsi b/src/Compiler/Facilities/DiagnosticsLogger.fsi index aa0974f5b72..42e1b2cb07b 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fsi +++ b/src/Compiler/Facilities/DiagnosticsLogger.fsi @@ -474,12 +474,13 @@ type CompilationGlobalsScope = module MultipleDiagnosticsLoggers = - /// Execute computations using Async.Parallel. - /// Captures the diagnostics in correct order and keeps a common error count for all computations. - /// When done, restores caller's build phase and diagnostics logger, commiting captured diagnostics. + /// Runs computations using Async.Parallel. + /// Capturing the diagnostics from each separately. + /// When done, restores caller's BuildPhase and DiagnosticsLogger + /// and commits captured diagnostics preserving the order. val Parallel: computations: Async<'T> seq -> Async<'T array> - /// Execute computations using Async.Sequential. - /// Captures the diagnostics in correct order and keeps a common error count for all computations. - /// When done, restores caller's build phase and diagnostics logger, commiting captured diagnostics. + /// Run computations sequentially starting on current thread + /// using caller's DiagnosticsLogger and BuildPhase for each computation. + /// When done, restores caller's BuildPhase and DiagnosticsLogger. val Sequential: computations: Async<'T> seq -> Async<'T array> From 76ae65f9647f5ea9302335e4bd655198e005d673 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Thu, 9 May 2024 09:46:04 +0200 Subject: [PATCH 47/51] Revert "sequential" This reverts commit 8c77c0cad9fe340fb3ed71c7ab79fb541622965c. --- src/Compiler/Facilities/DiagnosticsLogger.fs | 3 --- src/Compiler/Facilities/DiagnosticsLogger.fsi | 13 ++++++------- 2 files changed, 6 insertions(+), 10 deletions(-) diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fs b/src/Compiler/Facilities/DiagnosticsLogger.fs index 921f836f5ea..b26c9a8598d 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -895,7 +895,6 @@ type StackGuard(maxDepth: int, name: string) = GetEnvInteger ("FSHARP_" + name + "StackGuardDepth") StackGuard.DefaultDepth module MultipleDiagnosticsLoggers = - let Parallel computations = let computationsWithLoggers, diagnosticsReady = [ @@ -943,8 +942,6 @@ module MultipleDiagnosticsLoggers = let results = ResizeArray() for computation in computations do - // Encapsulate computation's diagnostics scope. - use _ = new CompilationGlobalsScope() let! result = computation results.Add result diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fsi b/src/Compiler/Facilities/DiagnosticsLogger.fsi index 42e1b2cb07b..aa0974f5b72 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fsi +++ b/src/Compiler/Facilities/DiagnosticsLogger.fsi @@ -474,13 +474,12 @@ type CompilationGlobalsScope = module MultipleDiagnosticsLoggers = - /// Runs computations using Async.Parallel. - /// Capturing the diagnostics from each separately. - /// When done, restores caller's BuildPhase and DiagnosticsLogger - /// and commits captured diagnostics preserving the order. + /// Execute computations using Async.Parallel. + /// Captures the diagnostics in correct order and keeps a common error count for all computations. + /// When done, restores caller's build phase and diagnostics logger, commiting captured diagnostics. val Parallel: computations: Async<'T> seq -> Async<'T array> - /// Run computations sequentially starting on current thread - /// using caller's DiagnosticsLogger and BuildPhase for each computation. - /// When done, restores caller's BuildPhase and DiagnosticsLogger. + /// Execute computations using Async.Sequential. + /// Captures the diagnostics in correct order and keeps a common error count for all computations. + /// When done, restores caller's build phase and diagnostics logger, commiting captured diagnostics. val Sequential: computations: Async<'T> seq -> Async<'T array> From aec045130b52472af9ee812904b08d10fcc9dd8d Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Tue, 14 May 2024 14:47:55 +0200 Subject: [PATCH 48/51] revert spurious change --- src/Compiler/Driver/GraphChecking/GraphProcessing.fs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/Compiler/Driver/GraphChecking/GraphProcessing.fs b/src/Compiler/Driver/GraphChecking/GraphProcessing.fs index 4b316dca185..37ecc35041d 100644 --- a/src/Compiler/Driver/GraphChecking/GraphProcessing.fs +++ b/src/Compiler/Driver/GraphChecking/GraphProcessing.fs @@ -180,8 +180,7 @@ let processGraphAsync<'Item, 'Result when 'Item: equality and 'Item: comparison> let! parentCt = Async.CancellationToken use localCts = new CancellationTokenSource() - let completionSignal = - TaskCompletionSource(TaskCreationOptions.RunContinuationsAsynchronously) + let completionSignal = TaskCompletionSource() use _ = parentCt.Register(fun () -> completionSignal.TrySetCanceled() |> ignore) From f7111567a7d5a7ec280e0a25e0aeacc6679f27a9 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Tue, 14 May 2024 14:48:11 +0200 Subject: [PATCH 49/51] fix comments --- src/Compiler/Facilities/DiagnosticsLogger.fsi | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fsi b/src/Compiler/Facilities/DiagnosticsLogger.fsi index 507c837785e..69aa0eddec1 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fsi +++ b/src/Compiler/Facilities/DiagnosticsLogger.fsi @@ -464,7 +464,7 @@ type StackGuard = type CompilationGlobalsScope = new: diagnosticsLogger: DiagnosticsLogger * buildPhase: BuildPhase -> CompilationGlobalsScope - /// When dispoed, restores caller's diagnostics logger and build phase. + /// When disposed, restores caller's diagnostics logger and build phase. new: unit -> CompilationGlobalsScope interface IDisposable @@ -475,12 +475,10 @@ type CompilationGlobalsScope = module MultipleDiagnosticsLoggers = - /// Execute computations using Async.Parallel. - /// Captures the diagnostics in correct order and keeps a common error count for all computations. - /// When done, restores caller's build phase and diagnostics logger, commiting captured diagnostics. + /// Run computations using Async.Parallel. + /// Captures the diagnostics from each computation and commits them to the caller's logger preserving their order. + /// When done, restores caller's build phase and diagnostics logger. val Parallel: computations: Async<'T> seq -> Async<'T array> - /// Execute computations using Async.Sequential. - /// Captures the diagnostics in correct order and keeps a common error count for all computations. - /// When done, restores caller's build phase and diagnostics logger, commiting captured diagnostics. + /// Run computations sequentially starting immediately on the current thread. val Sequential: computations: Async<'T> seq -> Async<'T array> From a2641f5ac4ebccb1e83f95abd6b5cbc0f343d25c Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Tue, 14 May 2024 17:18:58 +0200 Subject: [PATCH 50/51] test MultipleDiagnosticsLoggers --- .../BuildGraphTests.fs | 40 +++++++++++++++++++ 1 file changed, 40 insertions(+) diff --git a/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs b/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs index 7276ddce4ab..67cb41b259b 100644 --- a/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs +++ b/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs @@ -11,6 +11,7 @@ open FSharp.Compiler.BuildGraph open FSharp.Compiler.DiagnosticsLogger open Internal.Utilities.Library open FSharp.Compiler.Diagnostics +open FSharp.Compiler.Tokenization.FSharpTokenTag module BuildGraphTests = @@ -338,6 +339,45 @@ module BuildGraphTests = Tasks.Parallel.Invoke(task1, task2) + + type internal DiagnosticsLoggerWithCallback(callback) = + inherit CapturingDiagnosticsLogger("test") + override _.DiagnosticSink(e, s) = + base.DiagnosticSink(e, s) + callback e.Exception.Message |> ignore + + [] + let ``MultipleDiagnosticsLoggers capture diagnostics in correct order`` () = + + let mutable prevError = "000." + + let errorCommitted msg = + // errors come in correct order + Assert.shouldBeTrue (msg > prevError) + prevError <- msg + + let work i = async { + for c in 'A' .. 'F' do + do! Async.SwitchToThreadPool() + errorR (ExampleException $"%03d{i}{c}") + } + + let tasks = Seq.init 100 work + + let logger = DiagnosticsLoggerWithCallback errorCommitted + use _ = UseDiagnosticsLogger logger + tasks |> Seq.take 50 |> MultipleDiagnosticsLoggers.Parallel |> Async.Ignore |> Async.RunImmediate + + // all errors committed + errorCountShouldBe 300 + + tasks |> Seq.skip 50 |> MultipleDiagnosticsLoggers.Sequential |> Async.Ignore |> Async.RunImmediate + + errorCountShouldBe 600 + + + + [] let ``AsyncLocal diagnostics context flows correctly`` () = From afdd04102ff133dbdb37f45a7b33a8c703bff269 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Tue, 14 May 2024 21:29:41 +0200 Subject: [PATCH 51/51] add comment and clean up --- src/Compiler/Facilities/DiagnosticsLogger.fs | 2 ++ tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs | 1 - 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fs b/src/Compiler/Facilities/DiagnosticsLogger.fs index ee2edb008fc..bdec9ba40b4 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -909,6 +909,8 @@ type StackGuard(maxDepth: int, name: string) = static member GetDepthOption(name: string) = GetEnvInteger ("FSHARP_" + name + "StackGuardDepth") StackGuard.DefaultDepth +// UseMultipleDiagnosticLoggers in ParseAndCheckProject.fs provides similar functionality. +// We should probably adapt and reuse that code. module MultipleDiagnosticsLoggers = let Parallel computations = let computationsWithLoggers, diagnosticsReady = diff --git a/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs b/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs index 67cb41b259b..e1ba5c1b420 100644 --- a/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs +++ b/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs @@ -11,7 +11,6 @@ open FSharp.Compiler.BuildGraph open FSharp.Compiler.DiagnosticsLogger open Internal.Utilities.Library open FSharp.Compiler.Diagnostics -open FSharp.Compiler.Tokenization.FSharpTokenTag module BuildGraphTests =