From 32975e2349918059a60d4a7c207969771efef0fa Mon Sep 17 00:00:00 2001 From: Jakub Majocha Date: Sat, 3 Feb 2024 15:17:56 +0100 Subject: [PATCH] restore NodeCode subtly different semantics --- src/Compiler/Driver/CompilerImports.fs | 2 +- src/Compiler/Facilities/BuildGraph.fs | 21 +++++- src/Compiler/Facilities/BuildGraph.fsi | 2 + src/Compiler/Facilities/DiagnosticsLogger.fs | 4 +- src/Compiler/Service/FSharpProjectSnapshot.fs | 3 +- src/Compiler/Service/IncrementalBuild.fs | 4 +- src/Compiler/Service/TransparentCompiler.fs | 6 +- src/Compiler/Utilities/illib.fs | 6 +- .../CompilerService/AsyncMemoize.fs | 74 +++++++++---------- .../ProjectGeneration.fs | 3 +- 10 files changed, 77 insertions(+), 48 deletions(-) diff --git a/src/Compiler/Driver/CompilerImports.fs b/src/Compiler/Driver/CompilerImports.fs index cc32d0bf935..33cb248ad77 100644 --- a/src/Compiler/Driver/CompilerImports.fs +++ b/src/Compiler/Driver/CompilerImports.fs @@ -2236,7 +2236,7 @@ and [] TcImports let runMethod = match tcConfig.parallelReferenceResolution with | ParallelReferenceResolution.On -> Async.Parallel - | ParallelReferenceResolution.Off -> Async.Sequential + | ParallelReferenceResolution.Off -> Async.SequentialFailFast let diagnosticsLogger = DiagnosticsThreadStatics.DiagnosticsLogger let! results = diff --git a/src/Compiler/Facilities/BuildGraph.fs b/src/Compiler/Facilities/BuildGraph.fs index ea1dbe20047..deebf21fa58 100644 --- a/src/Compiler/Facilities/BuildGraph.fs +++ b/src/Compiler/Facilities/BuildGraph.fs @@ -11,13 +11,32 @@ open Internal.Utilities.Library [] type Async = static member RunImmediateWithoutCancellation(computation) = - Async.RunImmediate(computation, CancellationToken.None) + try + let work = async { return! computation } + + Async + .StartImmediateAsTask(work, cancellationToken = CancellationToken.None) + .Result + + with :? AggregateException as ex when ex.InnerExceptions.Count = 1 -> + raise (ex.InnerExceptions[0]) static member FromCancellable(computation: Cancellable<'T>) = Cancellable.toAsync computation static member StartAsTask_ForTesting(computation: Async<'T>, ?ct: CancellationToken) = Async.StartAsTask(computation, cancellationToken = defaultArg ct CancellationToken.None) + static member SequentialFailFast(computations: Async<'T> seq) = + async { + let results = ResizeArray() + + for computation in computations do + let! result = computation + results.Add result + + return results.ToArray() + } + [] module GraphNode = diff --git a/src/Compiler/Facilities/BuildGraph.fsi b/src/Compiler/Facilities/BuildGraph.fsi index 0265bb54092..c5d44b5b360 100644 --- a/src/Compiler/Facilities/BuildGraph.fsi +++ b/src/Compiler/Facilities/BuildGraph.fsi @@ -21,6 +21,8 @@ type Async = /// Only used for testing, do not use static member StartAsTask_ForTesting: computation: Async<'T> * ?ct: CancellationToken -> Task<'T> + static member SequentialFailFast: computations: Async<'T> seq -> Async<'T array> + /// 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 f3423a64f10..4855193721b 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -543,7 +543,9 @@ let UseDiagnosticsLogger newLogger = UseTransformedDiagnosticsLogger(fun _ -> newLogger) let CaptureDiagnosticsConcurrently () = - let newLogger = ConcurrentCapturingDiagnosticsLogger("CaptureDiagnosticsConcurrently") + let newLogger = + ConcurrentCapturingDiagnosticsLogger("CaptureDiagnosticsConcurrently") + let oldLogger = DiagnosticsThreadStatics.DiagnosticsLogger DiagnosticsThreadStatics.DiagnosticsLogger <- newLogger diff --git a/src/Compiler/Service/FSharpProjectSnapshot.fs b/src/Compiler/Service/FSharpProjectSnapshot.fs index 148d39da787..6842bc00fcc 100644 --- a/src/Compiler/Service/FSharpProjectSnapshot.fs +++ b/src/Compiler/Service/FSharpProjectSnapshot.fs @@ -19,6 +19,7 @@ open System.Runtime.CompilerServices open FSharp.Compiler.Syntax open FSharp.Compiler.Diagnostics open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.BuildGraph type internal ProjectIdentifier = string * string @@ -567,7 +568,7 @@ and [] FSha async.Return <| FSharpReferencedProjectSnapshot.ILModuleReference(outputName, getStamp, getReader)) - |> Async.Sequential + |> Async.SequentialFailFast let referencesOnDisk, otherOptions = options.OtherOptions diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index b6f643158d2..8d0d2d0d94b 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()) |> Async.SequentialFailFast let! tcInfos = computedBoundModels |> Seq.map (fun boundModel -> async { return! boundModel.GetOrComputeTcInfo() }) - |> Async.Sequential + |> Async.SequentialFailFast // tcInfoExtras can be computed in parallel. This will check any previously skipped implementation files in parallel, too. let! latestImplFiles = diff --git a/src/Compiler/Service/TransparentCompiler.fs b/src/Compiler/Service/TransparentCompiler.fs index fdb4f6c6083..d3989e5ba82 100644 --- a/src/Compiler/Service/TransparentCompiler.fs +++ b/src/Compiler/Service/TransparentCompiler.fs @@ -542,8 +542,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 -> @@ -569,7 +569,7 @@ type internal TransparentCompiler let data = RawFSharpAssemblyData(ilModuleDef, ilAsmRefs) :> IRawFSharpAssemblyData return ProjectAssemblyDataResult.Available data } - |> NodeCode.FromCancellable + |> Async.FromCancellable member x.TryGetLogicalTimeStamp _ = getStamp () |> Some member x.FileName = nm diff --git a/src/Compiler/Utilities/illib.fs b/src/Compiler/Utilities/illib.fs index fca3cd54605..c4ff36263ab 100644 --- a/src/Compiler/Utilities/illib.fs +++ b/src/Compiler/Utilities/illib.fs @@ -160,11 +160,15 @@ module internal PervasiveAutoOpens = static member RunImmediate(computation: Async<'T>, ?cancellationToken) = let cancellationToken = defaultArg cancellationToken Async.DefaultCancellationToken +#if DEBUG let ts = TaskCompletionSource<'T>() - let task = ts.Task Async.StartWithContinuations(computation, (ts.SetResult), (ts.SetException), (fun _ -> ts.SetCanceled()), cancellationToken) + let task = ts.Task +#else + let task = Async.StartAsTask(computation, cancellationToken = cancellationToken) +#endif task.Result [] diff --git a/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs b/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs index e442335f940..3aca5ff8479 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 @@ -58,8 +58,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.RunImmediateWithoutCancellation let expected = [| 10; 10; 4; 10; 6; 4|] @@ -95,7 +95,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" @@ -110,13 +110,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_ForTesting( memoize.Get'(key, computation jobStarted.Set), ct = 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_ForTesting( memoize.Get'(key, computation ignore), ct = cts2.Token) + let _task3 = Async.StartAsTask_ForTesting( memoize.Get'(key, computation ignore), ct = cts3.Token) do! waitUntil (events.CountOf Requested) 3 @@ -146,7 +146,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 @@ -162,13 +162,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_ForTesting( memoize.Get'(key, computation key), ct = 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_ForTesting( memoize.Get'(key, computation key), ct = cts2.Token) + let _task3 = Async.StartAsTask_ForTesting( memoize.Get'(key, computation key), ct = cts3.Token) do! waitUntil (events.CountOf Requested) 3 @@ -197,7 +197,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 @@ -213,13 +213,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_ForTesting( memoize.Get'(key, computation key), ct = 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_ForTesting( memoize.Get'(key, computation key), ct = cts2.Token) + let _task3 = Async.StartAsTask_ForTesting( memoize.Get'(key, computation key), ct = cts3.Token) do! waitUntil (events.CountOf Requested) 3 @@ -275,21 +275,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) () @@ -331,7 +331,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_ForTesting(job, ct = cts.Token) cts.CancelAfter timeoutMs Interlocked.Increment &started |> ignore try @@ -385,7 +385,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 @@ -400,7 +400,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 @@ -410,7 +410,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 @@ -438,18 +438,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" @@ -481,7 +481,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() @@ -512,7 +512,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 @@ -524,8 +524,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 @@ -545,9 +545,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 } @@ -560,7 +560,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.Test.Utilities/ProjectGeneration.fs b/tests/FSharp.Test.Utilities/ProjectGeneration.fs index 144e535bccb..e32e8ae692e 100644 --- a/tests/FSharp.Test.Utilities/ProjectGeneration.fs +++ b/tests/FSharp.Test.Utilities/ProjectGeneration.fs @@ -27,6 +27,7 @@ open System.Xml open FSharp.Compiler.CodeAnalysis open FSharp.Compiler.CodeAnalysis.ProjectSnapshot open FSharp.Compiler.Diagnostics +open FSharp.Compiler.BuildGraph open FSharp.Compiler.Text open Xunit @@ -792,7 +793,7 @@ module ProjectOperations = let! projects = p.DependsOn |> Seq.map (absorbAutoGeneratedSignatures checker) - |> Async.Sequential + |> Async.SequentialFailFast return { p with SourceFiles = files